From 1e3eae905b861761f93643aa5fce14a8be5d9ed2 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 4 Aug 1999 04:15:20 +0000 Subject: initial h2xs --- FS/Changes | 5 +++++ FS/FS.pm | 51 +++++++++++++++++++++++++++++++++++++++++++++++++++ FS/MANIFEST | 5 +++++ FS/Makefile.PL | 7 +++++++ FS/test.pl | 20 ++++++++++++++++++++ 5 files changed, 88 insertions(+) create mode 100644 FS/Changes create mode 100644 FS/FS.pm create mode 100644 FS/MANIFEST create mode 100644 FS/Makefile.PL create mode 100644 FS/test.pl (limited to 'FS') 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..c7defbc7f --- /dev/null +++ b/FS/FS.pm @@ -0,0 +1,51 @@ +package FS; + +use strict; +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); + +require Exporter; + +@ISA = qw(Exporter AutoLoader); +# Items to export into callers namespace by default. Note: do not export +# names by default without a very good reason. Use EXPORT_OK instead. +# Do not simply export all your public functions/methods/constants. +@EXPORT = qw( + +); +$VERSION = '0.01'; + + +# Preloaded methods go here. + +# Autoload methods go after =cut, and are processed by the autosplit program. + +1; +__END__ +# Below is the stub of documentation for your module. You better edit it! + +=head1 NAME + +FS - Perl extension for blah blah blah + +=head1 SYNOPSIS + + use FS; + blah blah blah + +=head1 DESCRIPTION + +Stub documentation for FS was created by h2xs. It looks like the +author of the extension was negligent enough to leave the stub +unedited. + +Blah blah blah. + +=head1 AUTHOR + +A. U. Thor, a.u.thor@a.galaxy.far.far.away + +=head1 SEE ALSO + +perl(1). + +=cut diff --git a/FS/MANIFEST b/FS/MANIFEST new file mode 100644 index 000000000..c036308ed --- /dev/null +++ b/FS/MANIFEST @@ -0,0 +1,5 @@ +Changes +FS.pm +MANIFEST +Makefile.PL +test.pl diff --git a/FS/Makefile.PL b/FS/Makefile.PL new file mode 100644 index 000000000..22b412d21 --- /dev/null +++ b/FS/Makefile.PL @@ -0,0 +1,7 @@ +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. +WriteMakefile( + 'NAME' => 'FS', + 'VERSION_FROM' => 'FS.pm', # finds $VERSION +); diff --git a/FS/test.pl b/FS/test.pl new file mode 100644 index 000000000..dc3726236 --- /dev/null +++ b/FS/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; +$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): + -- cgit v1.2.1 From 75e22f3c399435c50ed5698cb7c19d0e9f2617f8 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 4 Aug 1999 07:34:15 +0000 Subject: initial FS manpage --- FS/FS.pm | 174 ++++++++++++++++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 149 insertions(+), 25 deletions(-) (limited to 'FS') diff --git a/FS/FS.pm b/FS/FS.pm index c7defbc7f..78317392a 100644 --- a/FS/FS.pm +++ b/FS/FS.pm @@ -1,51 +1,175 @@ package FS; use strict; -use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); +use vars qw($VERSION); -require Exporter; - -@ISA = qw(Exporter AutoLoader); -# Items to export into callers namespace by default. Note: do not export -# names by default without a very good reason. Use EXPORT_OK instead. -# Do not simply export all your public functions/methods/constants. -@EXPORT = qw( - -); $VERSION = '0.01'; - -# Preloaded methods go here. - -# Autoload methods go after =cut, and are processed by the autosplit program. - 1; __END__ -# Below is the stub of documentation for your module. You better edit it! =head1 NAME -FS - Perl extension for blah blah blah +FS - Freeside Perl modules =head1 SYNOPSIS - use FS; - blah blah blah +FS is the temporary prefix for many disparate modules written for the Freeside +ISP billing software. This includes: + +=head2 Database metadata classes + +=over 4 + +=item L - Database class + +=item L - Database table class + +=item L - Database column class + +=item L - Database column group class + +=item L - Database index class + +=item L - Database unique index class + +=back + +=head2 Utility classes + +=over 4 + +=item L - Simple wrappers around ssh and scp commands. + +=item L - Freeside configuration values + +=item L - User class (not yet OO) + +=item 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). + +=back + +=head2 Database record classes + +=over 4 + +=item L - Database record base class + +=item L - POP (Point of Presence, not Post +Office Protocol) class + +=item L - Referral class + +=item L - Locale (tax rate) class + +=item L - Service base class + +=item L - Account (shell, RADIUS, POP3) class + +=item L - Domain class + +=item L - Vitual mail alias class + +=item L - Service definition class + +=item L - Package (billing item) definition class + +=item L - Class linking package (billing item) +definitions (see L) with service definitions +(see L) + +=item L - Agent (reseller) class + +=item L - Agent type class + +=item L - Class linking agent types (see +L) with package (billing item) definitions +(see L) + +=item L - Service class + +=item L - Package (billing item) class + +=item L - Customer class + +=item L - Invoice destination +class + +=item L - Invoice class + +=item L - Invoice line item class + +=item L - Payment class + +=item L - Credit class + +=item L - Refund class + +=item L - Credit card transaction queue +class + +=back + +=head2 User Interface classes (under development; not yet usable) + +=over 4 + +=item L - User-interface base class + +=item L - Gtk user-interface class + +=item L - CGI (HTML) user-interface class + +=item L - agent table user-interface class + +=back + +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 -Stub documentation for FS was created by h2xs. It looks like the -author of the extension was negligent enough to leave the stub -unedited. +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 -Blah blah blah. +$Id: FS.pm,v 1.2 1999-08-04 07:34:15 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 -A. U. Thor, a.u.thor@a.galaxy.far.far.away +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). +perl(1), main Freeside documentation in htdocs/docs/ + +=head1 BUGS + +The version number of the FS Perl extension differs from the version of the +Freeside distribution, which are both different from the CVS version tag for +each file, which appears under the VERSION heading. + +Those modules which would be useful separately should be pulled out, +renamed appropriately and uploaded to CPAN. =cut + -- cgit v1.2.1 From 6cd87c0d3b5280446301c647fa5f1ec5a593fa3f Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 4 Aug 1999 09:03:53 +0000 Subject: initial checkin of module files for proper perl installation --- FS/FS/Bill.pm | 21 + FS/FS/CGI.pm | 211 ++++++++++ FS/FS/Conf.pm | 112 ++++++ FS/FS/Invoice.pm | 22 ++ FS/FS/Record.pm | 876 ++++++++++++++++++++++++++++++++++++++++ FS/FS/SSH.pm | 146 +++++++ FS/FS/UI/Base.pm | 194 +++++++++ FS/FS/UI/CGI.pm | 239 +++++++++++ FS/FS/UI/Gtk.pm | 224 +++++++++++ FS/FS/UI/agent.pm | 62 +++ FS/FS/UID.pm | 266 +++++++++++++ FS/FS/agent.pm | 160 ++++++++ FS/FS/agent_type.pm | 165 ++++++++ FS/FS/cust_bill.pm | 450 +++++++++++++++++++++ FS/FS/cust_bill_pkg.pm | 144 +++++++ FS/FS/cust_credit.pm | 174 ++++++++ FS/FS/cust_main.pm | 965 +++++++++++++++++++++++++++++++++++++++++++++ FS/FS/cust_main_county.pm | 111 ++++++ FS/FS/cust_main_invoice.pm | 181 +++++++++ FS/FS/cust_pay.pm | 188 +++++++++ FS/FS/cust_pay_batch.pm | 205 ++++++++++ FS/FS/cust_pkg.pm | 518 ++++++++++++++++++++++++ FS/FS/cust_refund.pm | 187 +++++++++ FS/FS/cust_svc.pm | 167 ++++++++ FS/FS/dbdef.pm | 140 +++++++ FS/FS/dbdef_colgroup.pm | 95 +++++ FS/FS/dbdef_column.pm | 174 ++++++++ FS/FS/dbdef_index.pm | 35 ++ FS/FS/dbdef_table.pm | 235 +++++++++++ FS/FS/dbdef_unique.pm | 36 ++ FS/FS/part_pkg.pm | 186 +++++++++ FS/FS/part_referral.pm | 110 ++++++ FS/FS/part_svc.pm | 165 ++++++++ FS/FS/pkg_svc.pm | 152 +++++++ FS/FS/svc_Common.pm | 204 ++++++++++ FS/FS/svc_acct.pm | 468 ++++++++++++++++++++++ FS/FS/svc_acct_pop.pm | 111 ++++++ FS/FS/svc_acct_sm.pm | 252 ++++++++++++ FS/FS/svc_domain.pm | 421 ++++++++++++++++++++ FS/FS/type_pkgs.pm | 113 ++++++ FS/MANIFEST | 42 ++ FS/MANIFEST.SKIP | 1 + FS/README | 6 + 43 files changed, 8934 insertions(+) create mode 100644 FS/FS/Bill.pm create mode 100644 FS/FS/CGI.pm create mode 100644 FS/FS/Conf.pm create mode 100644 FS/FS/Invoice.pm create mode 100644 FS/FS/Record.pm create mode 100644 FS/FS/SSH.pm create mode 100644 FS/FS/UI/Base.pm create mode 100644 FS/FS/UI/CGI.pm create mode 100644 FS/FS/UI/Gtk.pm create mode 100644 FS/FS/UI/agent.pm create mode 100644 FS/FS/UID.pm create mode 100644 FS/FS/agent.pm create mode 100644 FS/FS/agent_type.pm create mode 100644 FS/FS/cust_bill.pm create mode 100644 FS/FS/cust_bill_pkg.pm create mode 100644 FS/FS/cust_credit.pm create mode 100644 FS/FS/cust_main.pm create mode 100644 FS/FS/cust_main_county.pm create mode 100644 FS/FS/cust_main_invoice.pm create mode 100644 FS/FS/cust_pay.pm create mode 100644 FS/FS/cust_pay_batch.pm create mode 100644 FS/FS/cust_pkg.pm create mode 100644 FS/FS/cust_refund.pm create mode 100644 FS/FS/cust_svc.pm create mode 100644 FS/FS/dbdef.pm create mode 100644 FS/FS/dbdef_colgroup.pm create mode 100644 FS/FS/dbdef_column.pm create mode 100644 FS/FS/dbdef_index.pm create mode 100644 FS/FS/dbdef_table.pm create mode 100644 FS/FS/dbdef_unique.pm create mode 100644 FS/FS/part_pkg.pm create mode 100644 FS/FS/part_referral.pm create mode 100644 FS/FS/part_svc.pm create mode 100644 FS/FS/pkg_svc.pm create mode 100644 FS/FS/svc_Common.pm create mode 100644 FS/FS/svc_acct.pm create mode 100644 FS/FS/svc_acct_pop.pm create mode 100644 FS/FS/svc_acct_sm.pm create mode 100644 FS/FS/svc_domain.pm create mode 100644 FS/FS/type_pkgs.pm create mode 100644 FS/MANIFEST.SKIP create mode 100644 FS/README (limited to 'FS') diff --git a/FS/FS/Bill.pm b/FS/FS/Bill.pm new file mode 100644 index 000000000..11c8121c6 --- /dev/null +++ b/FS/FS/Bill.pm @@ -0,0 +1,21 @@ +package FS::Bill; + +use strict; +use vars qw(@ISA); +use FS::cust_main; + +@ISA = qw(FS::cust_main); + +warn "FS::Bill depriciated\n"; + +=head1 NAME + +FS::Bill - Legacy stub + +=head1 SYNOPSIS + +The functionality of FS::Bill has been integrated into FS::cust_main. + +=cut + +1; diff --git a/FS/FS/CGI.pm b/FS/FS/CGI.pm new file mode 100644 index 000000000..3577c14b8 --- /dev/null +++ b/FS/FS/CGI.pm @@ -0,0 +1,211 @@ +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(@_); + exit; +} + +=item popurl LEVEL + +Returns current URL with LEVEL levels of path removed from the end (default 0). + +=cut + +sub popurl { + my($up)=@_; + my($cgi)=&FS::UID::cgi; + my($url)=new URI::URL $cgi->url; + my(@path)=$url->path_components; + splice @path, 0-$up; + $url->path_components(@path); + my $x = $url->as_string; + $x .= '/' unless $x =~ /\/$/; + $x; +} + +=item table + +Returns HTML tag for beginning a table. + +=cut + +sub table { + my $col = shift; + if ( $col ) { + qq!!; + } 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/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/Invoice.pm b/FS/FS/Invoice.pm new file mode 100644 index 000000000..11894a6ad --- /dev/null +++ b/FS/FS/Invoice.pm @@ -0,0 +1,22 @@ +package FS::Invoice; + +use strict; +use vars qw(@ISA); +use FS::cust_bill; + +@ISA = qw(FS::cust_bill); + +warn "FS::Invoice depriciated\n"; + +=head1 NAME + +FS::Invoice - Legacy stub + +=head1 SYNOPSIS + +The functionality of FS::Invoice has been integrated in FS::cust_bill. + +=cut + +1; + diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm new file mode 100644 index 000000000..f5f928210 --- /dev/null +++ b/FS/FS/Record.pm @@ -0,0 +1,876 @@ +package FS::Record; + +use strict; +use vars qw($dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK); +use subs qw(reload_dbdef); +use Exporter; +use Carp qw(carp cluck croak confess); +use File::CounterFile; +use FS::UID qw(dbh checkruid swapuid getotaker datasrc); +use FS::dbdef; + +@ISA = qw(Exporter); +@EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef); + +#ask FS::UID to run this stuff for us later +$FS::UID::callback{'FS::Record'} = sub { + $File::CounterFile::DEFAULT_DIR = "/usr/local/etc/freeside/counters.". datasrc; + $dbdef_file = "/usr/local/etc/freeside/dbdef.". datasrc; + &reload_dbdef unless $setup_hack; #$setup_hack needed now? +}; + +=head1 NAME + +FS::Record - Database record objects + +=head1 SYNOPSIS + + use FS::Record; + use FS::Record qw(dbh fields qsearch qsearchs dbdef); + + $record = new FS::Record 'table', \%hash; + $record = new FS::Record 'table', { 'column' => 'value', ... }; + + $record = qsearchs FS::Record 'table', \%hash; + $record = qsearchs FS::Record 'table', { 'column' => 'value', ... }; + @records = qsearch FS::Record 'table', \%hash; + @records = qsearch FS::Record 'table', { 'column' => 'value', ... }; + + $table = $record->table; + $dbdef_table = $record->dbdef_table; + + $value = $record->get('column'); + $value = $record->getfield('column'); + $value = $record->column; + + $record->set( 'column' => 'value' ); + $record->setfield( 'column' => 'value' ); + $record->column('value'); + + %hash = $record->hash; + + $hashref = $record->hashref; + + $error = $record->insert; + #$error = $record->add; #depriciated + + $error = $record->delete; + #$error = $record->del; #depriciated + + $error = $new_record->replace($old_record); + #$error = $new_record->rep($old_record); #depriciated + + $value = $record->unique('column'); + + $value = $record->ut_float('column'); + $value = $record->ut_number('column'); + $value = $record->ut_numbern('column'); + $value = $record->ut_money('column'); + $value = $record->ut_text('column'); + $value = $record->ut_textn('column'); + $value = $record->ut_alpha('column'); + $value = $record->ut_alphan('column'); + $value = $record->ut_phonen('column'); + $value = $record->ut_anythingn('column'); + + $dbdef = reload_dbdef; + $dbdef = reload_dbdef "/non/standard/filename"; + $dbdef = dbdef; + + $quoted_value = _quote($value,'table','field'); + + #depriciated + $fields = hfields('table'); + if ( $fields->{Field} ) { # etc. + + @fields = fields 'table'; #as a subroutine + @fields = $record->fields; #as a method call + + +=head1 DESCRIPTION + +(Mostly) object-oriented interface to database records. Records are currently +implemented on top of DBI. FS::Record is intended as a base class for +table-specific classes to inherit from, i.e. FS::cust_main. + +=head1 CONSTRUCTORS + +=over 4 + +=item new [ TABLE, ] HASHREF + +Creates a new record. It doesn't store it in the database, though. See +L<"insert"> for that. + +Note that the object stores this hash reference, not a distinct copy of the +hash it points to. You can ask the object for a copy with the I +method. + +TABLE can only be omitted when a dervived class overrides the table method. + +=cut + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = {}; + bless ($self, $class); + + $self->{'Table'} = shift unless defined ( $self->table ); + + my $hashref = $self->{'Hash'} = shift; + + foreach my $field ( $self->fields ) { + $hashref->{$field}='' unless defined $hashref->{$field}; + #trim the '$' and ',' from money fields for Pg (belong HERE?) + #(what about Pg i18n?) + if ( datasrc =~ m/Pg/ + && $self->dbdef_table->column($field)->type eq 'money' ) { + ${$hashref}{$field} =~ s/^\$//; + ${$hashref}{$field} =~ s/\,//; + } + } + + $self; +} + +sub create { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = {}; + bless ($self, $class); + if ( defined $self->table ) { + cluck "create constructor is depriciated, use new!"; + $self->new(@_); + } else { + croak "FS::Record::create called (not from a subclass)!"; + } +} + +=item qsearch TABLE, HASHREF + +Searches the database for all records matching (at least) the key/value pairs +in HASHREF. Returns all the records found as `FS::TABLE' objects if that +module is loaded (i.e. via `use FS::cust_main;'), otherwise returns FS::Record +objects. + +=cut + +sub qsearch { + my($table,$record) = @_; + my($dbh) = dbh; + + my(@fields)=grep exists($record->{$_}), fields($table); + + my($sth); + my($statement) = "SELECT * FROM $table". ( @fields + ? " WHERE ". join(' AND ', + map { + $record->{$_} eq '' + ? ( datasrc =~ m/Pg/ + ? "$_ IS NULL" + : "( $_ IS NULL OR $_ = \"\" )" + ) + : "$_ = ". _quote($record->{$_},$table,$_) + } @fields + ) : '' + ); + $sth=$dbh->prepare($statement) + or croak $dbh->errstr; #is that a little too harsh? hmm. + #warn $statement #if $debug # or some such; + + if ( eval ' scalar(@FS::'. $table. '::ISA);' ) { + map { + eval 'new FS::'. $table. ' ( $sth->fetchrow_hashref );'; + } ( 1 .. $sth->execute ); + } else { + cluck "qsearch: warning: FS::$table not loaded; returning generic FS::Record objects"; + map { + new FS::Record ($table,$sth->fetchrow_hashref); + } ( 1 .. $sth->execute ); + } + +} + +=item qsearchs TABLE, HASHREF + +Same as qsearch, except that if more than one record matches, it 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 "warning: Multiple records in scalar search!" if scalar(@result) > 1; + #should warn more vehemently if the search was on a primary key? + $result[0]; +} + +=back + +=head1 METHODS + +=over 4 + +=item table + +Returns the table name. + +=cut + +sub table { +# cluck "warning: FS::Record::table depriciated; supply one in subclass!"; + my $self = shift; + $self -> {'Table'}; +} + +=item dbdef_table + +Returns the FS::dbdef_table object for the table. + +=cut + +sub dbdef_table { + my($self)=@_; + my($table)=$self->table; + $dbdef->table($table); +} + +=item get, getfield COLUMN + +Returns the value of the column/field/key COLUMN. + +=cut + +sub get { + my($self,$field) = @_; + # to avoid "Use of unitialized value" errors + if ( defined ( $self->{Hash}->{$field} ) ) { + $self->{Hash}->{$field}; + } else { + ''; + } +} +sub getfield { + my $self = shift; + $self->get(@_); +} + +=item set, setfield COLUMN, VALUE + +Sets the value of the column/field/key COLUMN to VALUE. Returns VALUE. + +=cut + +sub set { + my($self,$field,$value) = @_; + $self->{'Hash'}->{$field} = $value; +} +sub setfield { + my $self = shift; + $self->set(@_); +} + +=item AUTLOADED METHODS + +$record->column is a synonym for $record->get('column'); + +$record->column('value') is a synonym for $record->set('column','value'); + +=cut + +sub AUTOLOAD { + my($self,$value)=@_; + my($field)=$AUTOLOAD; + $field =~ s/.*://; + if ( defined($value) ) { + $self->setfield($field,$value); + } else { + $self->getfield($field); + } +} + +=item hash + +Returns a list of the column/value pairs, usually for assigning to a new hash. + +To make a distinct duplicate of an FS::Record object, you can do: + + $new = new FS::Record ( $old->table, { $old->hash } ); + +=cut + +sub hash { + my($self) = @_; + %{ $self->{'Hash'} }; +} + +=item hashref + +Returns a reference to the column/value hash. + +=cut + +sub hashref { + my($self) = @_; + $self->{'Hash'}; +} + +=item insert + +Inserts this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +sub insert { + my $self = shift; + + my $error = $self->check; + return $error if $error; + + #single-field unique keys are given a value if false + #(like MySQL's AUTO_INCREMENT) + foreach ( $self->dbdef_table->unique->singles ) { + $self->unique($_) unless $self->getfield($_); + } + #and also the primary key + my $primary_key = $self->dbdef_table->primary_key; + $self->unique($primary_key) + if $primary_key && ! $self->getfield($primary_key); + + my @fields = + grep defined($self->getfield($_)) && $self->getfield($_) ne "", + $self->fields + ; + + my $statement = "INSERT INTO ". $self->table. " ( ". + join(', ',@fields ). + ") VALUES (". + join(', ',map(_quote($self->getfield($_),$self->table,$_), @fields)). + ")" + ; + my $sth = dbh->prepare($statement) or return dbh->errstr; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + $sth->execute or return $sth->errstr; + + ''; +} + +=item add + +Depriciated (use insert instead). + +=cut + +sub add { + cluck "warning: FS::Record::add depriciated!"; + insert @_; #call method in this scope +} + +=item delete + +Delete this record from the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +sub delete { + my $self = shift; + + my($statement)="DELETE FROM ". $self->table. " WHERE ". join(' AND ', + map { + $self->getfield($_) eq '' + #? "( $_ IS NULL OR $_ = \"\" )" + ? ( datasrc =~ m/Pg/ + ? "$_ IS NULL" + : "( $_ IS NULL OR $_ = \"\" )" + ) + : "$_ = ". _quote($self->getfield($_),$self->table,$_) + } ( $self->dbdef_table->primary_key ) + ? ( $self->dbdef_table->primary_key) + : $self->fields + ); + my $sth = dbh->prepare($statement) or return dbh->errstr; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $rc = $sth->execute or return $sth->errstr; + #not portable #return "Record not found, statement:\n$statement" if $rc eq "0E0"; + + undef $self; #no need to keep object! + + ''; +} + +=item del + +Depriciated (use delete instead). + +=cut + +sub del { + cluck "warning: FS::Record::del depriciated!"; + &delete(@_); #call method in this scope +} + +=item replace OLD_RECORD + +Replace the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +sub replace { + my ( $new, $old ) = ( shift, shift ); + + my @diff = grep $new->getfield($_) ne $old->getfield($_), $old->fields; + unless ( @diff ) { + carp "warning: records identical"; + return ''; + } + + return "Records not in same table!" unless $new->table eq $old->table; + + my $primary_key = $old->dbdef_table->primary_key; + return "Can't change $primary_key" + if $primary_key + && ( $old->getfield($primary_key) ne $new->getfield($primary_key) ); + + my $error = $new->check; + return $error if $error; + + my $statement = "UPDATE ". $old->table. " SET ". join(', ', + map { + "$_ = ". _quote($new->getfield($_),$old->table,$_) + } @diff + ). ' WHERE '. + join(' AND ', + map { + $old->getfield($_) eq '' + #? "( $_ IS NULL OR $_ = \"\" )" + ? ( datasrc =~ m/Pg/ + ? "$_ IS NULL" + : "( $_ IS NULL OR $_ = \"\" )" + ) + : "$_ = ". _quote($old->getfield($_),$old->table,$_) + } ( $primary_key ? ( $primary_key ) : $old->fields ) + ) + ; + my $sth = dbh->prepare($statement) or return dbh->errstr; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $rc = $sth->execute or return $sth->errstr; + #not portable #return "Record not found (or records identical)." if $rc eq "0E0"; + + ''; + +} + +=item rep + +Depriciated (use replace instead). + +=cut + +sub rep { + cluck "warning: FS::Record::rep depriciated!"; + replace @_; #call method in this scope +} + +=item check + +Not yet implemented, croaks. Derived classes should provide a check method. + +=cut + +sub check { + confess "FS::Record::check not implemented; supply one in subclass!"; +} + +=item unique COLUMN + +Replaces COLUMN in record with a unique number. Called by the B 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->getfield($field); + $self->setfield($field,$1); + ''; +} + +=item ut_number COLUMN + +Check/untaint simple numeric data (whole numbers). May not be null. If there +is an error, returns the error, otherwise returns false. + +=cut + +sub ut_number { + my($self,$field)=@_; + $self->getfield($field) =~ /^(\d+)$/ + or return "Illegal or empty (numeric) $field: ". $self->getfield($field); + $self->setfield($field,$1); + ''; +} + +=item ut_numbern COLUMN + +Check/untaint simple numeric data (whole numbers). May be null. If there is +an error, returns the error, otherwise returns false. + +=cut + +sub ut_numbern { + my($self,$field)=@_; + $self->getfield($field) =~ /^(\d*)$/ + or return "Illegal (numeric) $field: ". $self->getfield($field); + $self->setfield($field,$1); + ''; +} + +=item ut_money COLUMN + +Check/untaint monetary numbers. May be negative. Set to 0 if null. If there +is an error, returns the error, otherwise returns false. + +=cut + +sub ut_money { + my($self,$field)=@_; + $self->setfield($field, 0) if $self->getfield($field) eq ''; + $self->getfield($field) =~ /^(\-)? ?(\d*)(\.\d{2})?$/ + or return "Illegal (money) $field: ". $self->getfield($field); + #$self->setfield($field, "$1$2$3" || 0); + $self->setfield($field, ( ($1||''). ($2||''). ($3||'') ) || 0); + ''; +} + +=item ut_text COLUMN + +Check/untaint text. Alphanumerics, spaces, and the following punctuation +symbols are currently permitted: ! @ # $ % & ( ) - + ; : ' " , . ? / +May not be null. If there is an error, returns the error, otherwise returns +false. + +=cut + +sub ut_text { + my($self,$field)=@_; + $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/]+)$/ + or return "Illegal or empty (text) $field: ". $self->getfield($field); + $self->setfield($field,$1); + ''; +} + +=item ut_textn COLUMN + +Check/untaint text. Alphanumerics, spaces, and the following punctuation +symbols are currently permitted: ! @ # $ % & ( ) - + ; : ' " , . ? / +May be null. If there is an error, returns the error, otherwise returns false. + +=cut + +sub ut_textn { + my($self,$field)=@_; + $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/]*)$/ + or return "Illegal (text) $field: ". $self->getfield($field); + $self->setfield($field,$1); + ''; +} + +=item ut_alpha COLUMN + +Check/untaint alphanumeric strings (no spaces). May not be null. If there is +an error, returns the error, otherwise returns false. + +=cut + +sub ut_alpha { + my($self,$field)=@_; + $self->getfield($field) =~ /^(\w+)$/ + or return "Illegal or empty (alphanumeric) $field: ". + $self->getfield($field); + $self->setfield($field,$1); + ''; +} + +=item ut_alpha COLUMN + +Check/untaint alphanumeric strings (no spaces). May be null. If there is an +error, returns the error, otherwise returns false. + +=cut + +sub ut_alphan { + my($self,$field)=@_; + $self->getfield($field) =~ /^(\w*)$/ + or return "Illegal (alphanumeric) $field: ". $self->getfield($field); + $self->setfield($field,$1); + ''; +} + +=item ut_phonen COLUMN + +Check/untaint phone numbers. May be null. If there is an error, returns +the error, otherwise returns false. + +=cut + +sub ut_phonen { + my($self,$field)=@_; + my $phonen = $self->getfield($field); + if ( $phonen eq '' ) { + $self->setfield($field,''); + } else { + $phonen =~ s/\D//g; + $phonen =~ /^(\d{3})(\d{3})(\d{4})(\d*)$/ + or return "Illegal (phone) $field: ". $self->getfield($field); + $phonen = "$1-$2-$3"; + $phonen .= " x$4" if $4; + $self->setfield($field,$phonen); + } + ''; +} + +=item ut_anything COLUMN + +Untaints arbitrary data. Be careful. + +=cut + +sub ut_anything { + my($self,$field)=@_; + $self->getfield($field) =~ /^(.*)$/ + or return "Illegal $field: ". $self->getfield($field); + $self->setfield($field,$1); + ''; +} + +=item fields [ TABLE ] + +This can be used as both a subroutine and a method call. It returns a list +of the columns in this record's table, or an explicitly specified table. +(See L). + +=cut + +# Usage: @fields = fields($table); +# @fields = $record->fields; +sub fields { + my $something = shift; + my $table; + if ( ref($something) ) { + $table = $something->table; + } else { + $table = $something; + } + #croak "Usage: \@fields = fields(\$table)\n or: \@fields = \$record->fields" unless $table; + my($table_obj) = $dbdef->table($table); + croak "Unknown table $table" unless $table_obj; + $table_obj->columns; +} + +=head1 SUBROUTINES + +=over 4 + +=item reload_dbdef([FILENAME]) + +Load a database definition (see L), 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 "warning: hfields is depriciated"; + my($table)=@_; + my(%hash); + foreach (fields($table)) { + $hash{$_}=1; + } + \%hash; +} + +#sub _dump { +# my($self)=@_; +# join("\n", map { +# "$_: ". $self->getfield($_). "|" +# } (fields($self->table)) ); +#} + +#sub DESTROY { +# my $self = shift; +# #use Carp qw(cluck); +# #cluck "DESTROYING $self"; +# warn "DESTROYING $self"; +#} + +#sub is_tainted { +# return ! eval { join('',@_), kill 0; 1; }; +# } + +=back + +=head1 VERSION + +$Id: Record.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ + +=head1 BUGS + +This module should probably be renamed, since much of the functionality is +of general use. It is not completely unlike Adapter::DBI (see below). + +Exported qsearch and qsearchs should be depriciated in favor of method calls +(against an FS::Record object like the old search and searchs that qsearch +and qsearchs were on top of.) + +The whole fields / hfields mess should be removed. + +The various WHERE clauses should be subroutined. + +table string should be depriciated in favor of FS::dbdef_table. + +No doubt we could benefit from a Tied hash. Documenting how exists / defined +true maps to the database (and WHERE clauses) would also help. + +The ut_ methods should ask the dbdef for a default length. + +ut_sqltype (like ut_varchar) should all be defined + +A fallback check method should be provided whith uses the dbdef. + +The ut_money method assumes money has two decimal digits. + +The Pg money kludge in the new method only strips `$'. + +The ut_phonen method assumes US-style phone numbers. + +The _quote function should probably use ut_float instead of a regex. + +All the subroutines probably should be methods, here or elsewhere. + +Probably should borrow/use some dbdef methods where appropriate (like sub +fields) + +=head1 SEE ALSO + +L, L, L + +Adapter::DBI from Ch. 11 of Advanced Perl Programming by Sriram Srinivasan. + +=cut + +1; + diff --git a/FS/FS/SSH.pm b/FS/FS/SSH.pm new file mode 100644 index 000000000..84ac06b44 --- /dev/null +++ b/FS/FS/SSH.pm @@ -0,0 +1,146 @@ +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 + +=cut + +1; + diff --git a/FS/FS/UI/Base.pm b/FS/FS/UI/Base.pm new file mode 100644 index 000000000..bbeb9e171 --- /dev/null +++ b/FS/FS/UI/Base.pm @@ -0,0 +1,194 @@ +package FS::UI::Base; + +use strict; +use vars qw ( @ISA ); +use FS::Record qw( fields qsearch ); + +@ISA = ( $FS::UI::Base::_lock ); + +=head1 NAME + +FS::UI::Base - Base class for all user-interface objects + +=head1 SYNOPSIS + + use FS::UI::SomeInterface; + use FS::UI::some_table; + + $interface = new FS::UI::some_table; + + $error = $interface->browse; + $error = $interface->search; + $error = $interface->view; + $error = $interface->edit; + $error = $interface->process; + +=head1 DESCRIPTION + +An FS::UI::Base object represents a user interface object. FS::UI::Base +is intended as a base class for table-specfic classes to inherit from, i.e. +FS::UI::cust_main. The simplest case, which will provide a default UI for your +new table, is as follows: + + package FS::UI::table_name; + use vars qw ( @ISA ); + use FS::UI::Base; + @ISA = qw( FS::UI::Base ); + sub db_table { 'table_name'; } + +Currently available interfaces are: + FS::UI::Gtk, an X-Windows UI implemented using the Gtk+ toolkit + FS::UI::CGI, a web interface implemented using CGI.pm, etc. + +=head1 METHODS + +=over 4 + +=item new + +=cut + +=item browse + +=cut + +sub browse { + my $self = shift; + + my @fields = $self->list_fields; + + #begin browse-specific stuff + + $self->title( "Browse ". $self->db_names ) unless $self->title; + my @records = qsearch ( $self->db_table, {} ); + + #end browse-specific stuff + + $self->addwidget ( new FS::UI::_Text ( $self->db_description ) ); + + my @header = $self->list_header; + my @headerspan = $self->list_headerspan; + my %callback = $self->db_callback; + + my $columns; + + my $table = new FS::UI::_Tableborder ( + 'rows' => 1 + scalar(@records), + 'columns' => $columns || scalar(@fields), + ); + + my $c = 0; + foreach my $header ( @header ) { + my $headerspan = shift(@headerspan) || 1; + $table->attach( + 0, $c, new FS::UI::_Text ( $header ), 1, $headerspan + ); + $c += $headerspan; + } + + my $r = 1; + + foreach my $record ( @records ) { + $c = 0; + foreach my $field ( @fields ) { + my $value = $record->getfield($field); + my $widget; + if ( $callback{$field} ) { + $widget = &{ $callback{$field} }( $value, $record ); + } else { + $widget = new FS::UI::_Text ( $value ); + } + $table->attach( $r, $c++, $widget, 1, 1 ); + } + $r++; + } + + $self->addwidget( $table ); + + $self->activate; + +} + +=item title + +=cut + +sub title { + my $self = shift; + my $value = shift; + if ( defined($value) ) { + $self->{'title'} = $value; + } else { + $self->{'title'}; + } +} + +=item addwidget + +=cut + +sub addwidget { + my $self = shift; + my $widget = shift; + push @{ $self->{'Widgets'} }, $widget; +} + +#fallback methods + +sub db_description {} + +sub db_name {} + +sub db_names { + my $self = shift; + $self->db_name. 's'; +} + +sub list_fields { + my $self = shift; + fields( $self->db_table ); +} + +sub list_header { + my $self = shift; + $self->list_fields +} + +sub list_headerspan { + my $self = shift; + map 1, $self->list_header; +} + +sub db_callback {} + +=back + +=head1 VERSION + +$Id: Base.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ + +=head1 BUGS + +This documentation is incomplete. + +There should be some sort of per-(freeside)-user preferences and the ability +for specific FS::UI:: modules to put their own values there as well. + +=head1 SEE ALSO + +L, L + +=head1 HISTORY + +$Log: Base.pm,v $ +Revision 1.1 1999-08-04 09:03:53 ivan +initial checkin of module files for proper perl installation + +Revision 1.1 1999/01/20 09:30:36 ivan +skeletal cross-UI UI code. + + +=cut + +1; + diff --git a/FS/FS/UI/CGI.pm b/FS/FS/UI/CGI.pm new file mode 100644 index 000000000..ae87d1375 --- /dev/null +++ b/FS/FS/UI/CGI.pm @@ -0,0 +1,239 @@ +package FS::UI::CGI; + +use strict; +use CGI; +#use CGI::Switch; #when FS::UID user and preference callback stuff is fixed +use CGI::Carp qw(fatalsToBrowser); +use HTML::Table; +use FS::UID qw(adminsuidsetup); +#use FS::Record qw( qsearch fields ); + +die "Can't initialize CGI interface; $FS::UI::Base::_lock used" + if $FS::UI::Base::_lock; +$FS::UI::Base::_lock = "FS::UI::CGI"; + +=head1 NAME + +FS::UI::CGI - Base class for CGI user-interface objects + +=head1 SYNOPSIS + + use FS::UI::CGI; + use FS::UI::some_table; + + $interface = new FS::UI::some_table; + + $error = $interface->browse; + $error = $interface->search; + $error = $interface->view; + $error = $interface->edit; + $error = $interface->process; + +=head1 DESCRIPTION + +An FS::UI::CGI object represents a CGI interface object. + +=head1 METHODS + +=over 4 + +=item new + +=cut + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = { @_ }; + + $self->{'_cgi'} = new CGI; + $self->{'_user'} = $self->{'_cgi'}->remote_user; + $self->{'_dbh'} = FS::UID::adminsuidsetup $self->{'_user'}; + + bless ( $self, $class); +} + +sub activate { + my $self = shift; + print $self->_header, + join ( "
", map $_->sprint, @{ $self->{'Widgets'} } ), + $self->_footer, + ; +} + +=item _header + +=cut + +sub _header { + my $self = shift; + my $cgi = $self->{'_cgi'}; + + $cgi->header( '-expires' => 'now' ), '', + '', $self->title, '', + '', + '', $self->title, '

', + ; +} + +=item _footer + +=cut + +sub _footer { + ""; +} + +=item interface + +Returns the string `CGI'. Useful for the author of a table-specific UI class +to conditionally specify certain behaviour. + +=cut + +sub interface { 'CGI'; } + +=back + +=cut + +package FS::UI::_Widget; + +use vars qw( $AUTOLOAD ); + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = { @_ }; + bless ( $self, $class ); +} + +sub AUTOLOAD { + my $self = shift; + my $value = shift; + my($field)=$AUTOLOAD; + $field =~ s/.*://; + if ( defined($value) ) { + $self->{$field} = $value; + } else { + $self->{$field}; + } +} + +package FS::UI::_Text; + +use vars qw ( @ISA ); + +@ISA = qw ( FS::UI::_Widget); + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = {}; + $self->{'_text'} = shift; + bless ( $self, $class ); +} + +sub sprint { + my $self = shift; + $self->{'_text'}; +} + +package FS::UI::_Link; + +use vars qw ( @ISA $BASE_URL ); + +@ISA = qw ( FS::UI::_Widget); +$BASE_URL = "http://rootwood.sisd.com/freeside"; + +sub sprint { + my $self = shift; + my $table = $self->{'table'}; + my $method = $self->{'method'}; + + # i will be cleaned up when we're done moving from the old webinterface! + my @arg = @{$self->{'arg'}}; + my $yuck = join( "&", @arg); + qq(). $self->{'text'}. "<\A>"; +} + +package FS::UI::_Table; + +use vars qw ( @ISA ); + +@ISA = qw ( FS::UI::_Widget); + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = $class eq $proto ? { @_ } : $proto; + bless ( $self, $class ); + $self->{'_table'} = new HTML::Table ( $self->rows, $self->columns ); + $self; +} + +sub attach { + my $self = shift; + my ( $row, $column, $widget, $rowspan, $colspan ) = @_; + $self->{"_table"}->setCell( $row+1, $column+1, $widget->sprint ); + $self->{"_table"}->setCellRowSpan( $row+1, $column+1, $rowspan ) if $rowspan; + $self->{"_table"}->setCellColSpan( $row+1, $column+1, $colspan ) if $colspan; +} + +sub sprint { + my $self = shift; + $self->{'_table'}->getTable; +} + +package FS::UI::_Tableborder; + +use vars qw ( @ISA ); + +@ISA = qw ( FS::UI::_Table ); + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = $class eq $proto ? { @_ } : $proto; + bless ( $self, $class ); + $self->SUPER::new(@_); + $self->{'_table'}->setBorder; + $self; +} + +=head1 VERSION + +$Id: CGI.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ + +=head1 BUGS + +This documentation is incomplete. + +In _Tableborder, headers should be links that sort on their fields. + +_Link uses a constant $BASE_URL + +_Link passes the arguments as a manually-constructed GET string instead +of POSTing, for compatability while the web interface is upgraded. Once +this is done it should pass arguements properly (i.e. as a POST, 8-bit clean) + +Still some small bits of widget code same as FS::UI::Gtk. + +=head1 SEE ALSO + +L + +=head1 HISTORY + +$Log: CGI.pm,v $ +Revision 1.1 1999-08-04 09:03:53 ivan +initial checkin of module files for proper perl installation + +Revision 1.1 1999/01/20 09:30:36 ivan +skeletal cross-UI UI code. + + +=cut + +1; + diff --git a/FS/FS/UI/Gtk.pm b/FS/FS/UI/Gtk.pm new file mode 100644 index 000000000..507a29361 --- /dev/null +++ b/FS/FS/UI/Gtk.pm @@ -0,0 +1,224 @@ +package FS::UI::Gtk; + +use strict; +use Gtk; +use FS::UID qw(adminsuidsetup); + +die "Can't initialize Gtk interface; $FS::UI::Base::_lock used" + if $FS::UI::Base::_lock; +$FS::UI::Base::_lock = "FS::UI::Gtk"; + +=head1 NAME + +FS::UI::Gtk - Base class for Gtk user-interface objects + +=head1 SYNOPSIS + + use FS::UI::Gtk; + use FS::UI::some_table; + + $interface = new FS::UI::some_table; + + $error = $interface->browse; + $error = $interface->search; + $error = $interface->view; + $error = $interface->edit; + $error = $interface->process; + +=head1 DESCRIPTION + +An FS::UI::Gtk object represents a Gtk user interface object. + +=head1 METHODS + +=over 4 + +=item new + +=cut + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = { @_ }; + + bless ( $self, $class ); + + $self->{'_user'} = 'ivan'; #Pop up login window? + $self->{'_dbh'} = FS::UID::adminsuidsetup $self->{'_user'}; + + + + $self; +} + +sub activate { + my $self = shift; + + my $vbox = new Gtk::VBox ( 0, 4 ); + + foreach my $widget ( @{ $self->{'Widgets'} } ) { + $widget->_gtk->show; + $vbox->pack_start ( $widget->_gtk, 1, 1, 4 ); + } + $vbox->show; + + my $window = new Gtk::Window "toplevel"; + $self->{'_gtk'} = $window; + $window->set_title( $self->title ); + $window->add ( $vbox ); + $window->show; + main Gtk; +} + +=item interface + +Returns the string `Gtk'. Useful for the author of a table-specific UI class +to conditionally specify certain behaviour. + +=cut + +sub interface { 'Gtk'; } + +=back + +=cut + +package FS::UI::_Widget; + +use vars qw( $AUTOLOAD ); + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = { @_ }; + bless ( $self, $class ); +} + +sub _gtk { + my $self = shift; + $self->{'_gtk'}; +} + +sub AUTOLOAD { + my $self = shift; + my $value = shift; + my($field)=$AUTOLOAD; + $field =~ s/.*://; + if ( defined($value) ) { + $self->{$field} = $value; + } else { + $self->{$field}; + } +} + +package FS::UI::_Text; + +use vars qw ( @ISA ); + +@ISA = qw ( FS::UI::_Widget ); + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = {}; + $self->{'_gtk'} = new Gtk::Label ( shift ); + bless ( $self, $class ); +} + +package FS::UI::_Link; + +use vars qw ( @ISA ); + +@ISA = qw ( FS::UI::_Widget ); + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = { @_ }; + $self->{'_gtk'} = new_with_label Gtk::Button ( $self->{'text'} ); + $self->{'_gtk'}->signal_connect( 'clicked', sub { + print "STUB: (Gtk) FS::UI::_Link"; + }, "hi", "there" ); + bless ( $self, $class ); +} + + +package FS::UI::_Table; + +use vars qw ( @ISA ); + +@ISA = qw ( FS::UI::_Widget ); + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = { @_ }; + bless ( $self, $class ); + + $self->{'_gtk'} = new Gtk::Table ( + $self->rows, + $self->columns, + 0, #homogeneous + ); + + $self; +} + +sub attach { + my $self = shift; + my ( $row, $column, $widget, $rowspan, $colspan ) = @_; + $rowspan ||= 1; + $colspan ||= 1; + $self->_gtk->attach_defaults( + $widget->_gtk, + $column, + $column + $colspan, + $row, + $row + $rowspan, + ); + $widget->_gtk->show; +} + +package FS::UI::_Tableborder; + +use vars qw ( @ISA ); + +@ISA = qw ( FS::UI::_Table ); + +=head1 VERSION + +$Id: Gtk.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ + +=head1 BUGS + +This documentation is incomplete. + +_Tableborder is just a _Table now. _Tableborders should scroll (but not the +headers) and need and need more decoration. (data in white section ala gtksql +and sliding field widths) headers should be buttons that callback to sort on +their fields. + +There should be a persistant, per-(freeside)-user store for window positions +and sizes and sort fields etc (see L. + +Still some small bits of widget code same as FS::UI::CGI. + +=head1 SEE ALSO + +L + +=head1 HISTORY + +$Log: Gtk.pm,v $ +Revision 1.1 1999-08-04 09:03:53 ivan +initial checkin of module files for proper perl installation + +Revision 1.1 1999/01/20 09:30:36 ivan +skeletal cross-UI UI code. + + +=cut + +1; + diff --git a/FS/FS/UI/agent.pm b/FS/FS/UI/agent.pm new file mode 100644 index 000000000..ce9744a55 --- /dev/null +++ b/FS/FS/UI/agent.pm @@ -0,0 +1,62 @@ +package FS::UI::agent; + +use strict; +use vars qw ( @ISA ); +use FS::UI::Base; +use FS::Record qw( qsearchs ); +use FS::agent; +use FS::agent_type; + +@ISA = qw ( FS::UI::Base ); + +sub db_table { 'agent' }; + +sub db_name { 'Agent' }; + +sub db_description { < + sub { + my ( $agentnum, $record ) = @_; + my $agent = $record->agent; + new FS::UI::_Link ( + 'table' => 'agent', + 'method' => 'edit', + 'arg' => [ $agentnum ], + 'text' => "$agentnum: $agent", + ); + }, + 'typenum' => + sub { + my $typenum = shift; + my $agent_type = qsearchs( 'agent_type', { 'typenum' => $typenum } ); + my $atype = $agent_type->atype; + new FS::UI::_Link ( + 'table' => 'agent_type', + 'method' => 'edit', + 'arg' => [ $typenum ], + 'text' => "$typenum: $atype" + ); + }, +} + +1; diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm new file mode 100644 index 000000000..2315c266d --- /dev/null +++ b/FS/FS/UID.pm @@ -0,0 +1,266 @@ +package FS::UID; + +use strict; +use vars qw( + @ISA @EXPORT_OK $cgi $dbh $freeside_uid $user + $conf_dir $secrets $datasrc $db_user $db_pass %callback +); +use subs qw( + getsecrets cgisetotaker +); +use Exporter; +use Carp; +use DBI; +use FS::Conf; + +@ISA = qw(Exporter); +@EXPORT_OK = qw(checkeuid checkruid swapuid cgisuidsetup + adminsuidsetup getotaker dbh datasrc getsecrets ); + +$freeside_uid = scalar(getpwnam('freeside')); + +$conf_dir = "/usr/local/etc/freeside/"; + +=head1 NAME + +FS::UID - Subroutines for database login and assorted other stuff + +=head1 SYNOPSIS + + use FS::UID qw(adminsuidsetup cgisuidsetup dbh datasrc getotaker + checkeuid checkruid swapuid); + + adminsuidsetup $user; + + $cgi = new CGI; + $dbh = cgisuidsetup($cgi); + + $dbh = dbh; + + $datasrc = datasrc; + +=head1 DESCRIPTION + +Provides a hodgepodge of subroutines. + +=head1 SUBROUTINES + +=over 4 + +=item adminsuidsetup USER + +Sets the user to USER (see config.html from the base documentation). +Cleans the environment. +Make sure the script is running as freeside, or setuid freeside. +Opens a connection to the database. +Swaps real and effective UIDs. +Runs any defined callbacks (see below). +Returns the DBI database handle (usually you don't need this). + +=cut + +sub adminsuidsetup { + + $user = shift; + croak "fatal: adminsuidsetup called without arguements" unless $user; + + $ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin'; + $ENV{'SHELL'} = '/bin/sh'; + $ENV{'IFS'} = " \t\n"; + $ENV{'CDPATH'} = ''; + $ENV{'ENV'} = ''; + $ENV{'BASH_ENV'} = ''; + + croak "Not running uid freeside!" unless checkeuid(); + getsecrets; + $dbh = DBI->connect($datasrc,$db_user,$db_pass, { + 'AutoCommit' => 'true', + 'ChopBlanks' => 'true', + } ) or die "DBI->connect error: $DBI::errstr\n"; + + swapuid(); #go to non-privledged user if running setuid freeside + + foreach ( keys %callback ) { + &{$callback{$_}}; + } + + $dbh; +} + +=item cgisuidsetup CGI_object + +Stores the CGI (see L) object for later use. (CGI::Base is depriciated) +Runs adminsuidsetup. + +=cut + +sub cgisuidsetup { + $cgi=shift; + if ( $cgi->isa('CGI::Base') ) { + carp "Use of CGI::Base is depriciated"; + } elsif ( ! $cgi->isa('CGI') ) { + croak "Pass a CGI object to cgisuidsetup!"; + } + cgisetotaker; + adminsuidsetup($user); +} + +=item cgi + +Returns the CGI (see L) object. + +=cut + +sub cgi { + $cgi; +} + +=item dbh + +Returns the DBI database handle. + +=cut + +sub dbh { + $dbh; +} + +=item datasrc + +Returns the DBI data source. + +=cut + +sub datasrc { + $datasrc; +} + +#hack for web demo +#sub setdbh { +# $dbh=$_[0]; +#} + +sub suidsetup { + croak "suidsetup depriciated"; +} + +=item getotaker + +Returns the current Freeside user. + +=cut + +sub getotaker { + $user; +} + +=item cgisetotaker + +Sets and returns the CGI REMOTE_USER. $cgi should be defined as a CGI.pm +object. Support for CGI::Base and derived classes is depriciated. + +=cut + +sub cgisetotaker { + if ( $cgi && $cgi->isa('CGI::Base') && defined $cgi->var('REMOTE_USER')) { + carp "Use of CGI::Base is depriciated"; + $user = lc ( $cgi->var('REMOTE_USER') ); + } elsif ( $cgi && $cgi->isa('CGI') && defined $cgi->remote_user ) { + $user = lc ( $cgi->remote_user ); + } else { + die "fatal: Can't get REMOTE_USER!"; + } + $user; +} + +=item checkeuid + +Returns true if effective UID is that of the freeside user. + +=cut + +sub checkeuid { + ( $> == $freeside_uid ); +} + +=item checkruid + +Returns true if the real UID is that of the freeside user. + +=cut + +sub checkruid { + ( $< == $freeside_uid ); +} + +=item swapuid + +Swaps real and effective UIDs. + +=cut + +sub swapuid { + ($<,$>) = ($>,$<) if $< != $>; +} + +=item getsecrets [ USER ] + +Sets the user to USER, if supplied. +Sets and returns the DBI datasource, username and password for this user from +the `/usr/local/etc/freeside/mapsecrets' file. + +=cut + +sub getsecrets { + my($setuser) = shift; + $user = $setuser if $setuser; + die "No user!" unless $user; + my($conf) = new FS::Conf $conf_dir; + my($line) = grep /^\s*$user\s/, $conf->config('mapsecrets'); + die "User not found in mapsecrets!" unless $line; + $line =~ /^\s*$user\s+(.*)$/; + $secrets = $1; + die "Illegal mapsecrets line for user?!" unless $secrets; + ($datasrc, $db_user, $db_pass) = $conf->config($secrets) + or die "Can't get secrets: $!"; + $FS::Conf::default_dir = $conf_dir. "/conf.$datasrc"; + ($datasrc, $db_user, $db_pass); +} + +=back + +=head1 CALLBACKS + +Warning: this interface is likely to change in future releases. + +A package can install a callback to be run in adminsuidsetup by putting a +coderef into the hash %FS::UID::callback : + + $coderef = sub { warn "Hi, I'm returning your call!" }; + $FS::UID::callback{'Package::Name'}; + +=head1 VERSION + +$Id: UID.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ + +=head1 BUGS + +Too many package-global variables. + +Not OO. + +No capabilities yet. When mod_perl and Authen::DBI are implemented, +cgisuidsetup will go away as well. + +Goes through contortions to support non-OO syntax with multiple datasrc's. + +Callbacks are inelegant. + +=head1 SEE ALSO + +L, L, L, config.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/agent.pm b/FS/FS/agent.pm new file mode 100644 index 000000000..27e9aed71 --- /dev/null +++ b/FS/FS/agent.pm @@ -0,0 +1,160 @@ +package FS::agent; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearch qsearchs ); +use FS::cust_main; +use FS::agent_type; + +@ISA = qw( FS::Record ); + +=head1 NAME + +FS::agent - Object methods for agent records + +=head1 SYNOPSIS + + use FS::agent; + + $record = new FS::agent \%hash; + $record = new FS::agent { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + + $agent_type = $record->agent_type; + + $hashref = $record->pkgpart_hashref; + #may purchase $pkgpart if $hashref->{$pkgpart}; + +=head1 DESCRIPTION + +An FS::agent object represents an agent. Every customer has an agent. Agents +can be used to track things like resellers or salespeople. FS::agent inherits +from FS::Record. The following fields are currently supported: + +=over 4 + +=item agemtnum - primary key (assigned automatically for new agents) + +=item agent - Text name of this agent + +=item typenum - Agent type. See L + +=item prog - For future use. + +=item freq - For future use. + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new agent. To add the agent to the database, see L<"insert">. + +=cut + +sub table { 'agent'; } + +=item insert + +Adds this agent to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete + +Deletes this agent from the database. Only agents with no customers can be +deleted. If there is an error, returns the error, otherwise returns false. + +=cut + +sub delete { + my $self = shift; + + return "Can't delete an agent with customers!" + if qsearch( 'cust_main', { 'agentnum' => $self->agentnum } ); + + $self->SUPER::delete; +} + +=item replace OLD_RECORD + +Replaces OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=item check + +Checks all fields to make sure this is a valid agent. If there is an error, +returns the error, otherwise returns false. Called by the insert and replace +methods. + +=cut + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('agentnum') + || $self->ut_text('agent') + || $self->ut_number('typenum') + || $self->ut_numbern('freq') + || $self->ut_textn('prog') + ; + return $error if $error; + + return "Unknown typenum!" + unless $self->agent_type; + + ''; + +} + +=item agent_type + +Returns the FS::agent_type object (see L) for this agent. + +=cut + +sub agent_type { + my $self = shift; + qsearchs( 'agent_type', { 'typenum' => $self->typenum } ); +} + +=item pkgpart_hashref + +Returns a hash reference. The keys of the hash are pkgparts. The value is +true iff this agent may purchase the specified package definition. See +L. + +=cut + +sub pkgpart_hashref { + my $self = shift; + $self->agent_type->pkgpart_hashref; +} + +=back + +=head1 VERSION + +$Id: agent.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ + +=head1 BUGS + +=head1 SEE ALSO + +L, L, L, L, +schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/agent_type.pm b/FS/FS/agent_type.pm new file mode 100644 index 000000000..988533ae3 --- /dev/null +++ b/FS/FS/agent_type.pm @@ -0,0 +1,165 @@ +package FS::agent_type; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearch ); +use FS::agent; +use FS::type_pkgs; + +@ISA = qw( FS::Record ); + +=head1 NAME + +FS::agent_type - Object methods for agent_type records + +=head1 SYNOPSIS + + use FS::agent_type; + + $record = new FS::agent_type \%hash; + $record = new FS::agent_type { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + + $hashref = $record->pkgpart_hashref; + #may purchase $pkgpart if $hashref->{$pkgpart}; + + @type_pkgs = $record->type_pkgs; + + @pkgparts = $record->pkgpart; + +=head1 DESCRIPTION + +An FS::agent_type object represents an agent type. Every agent (see +L) 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 new HASHREF + +Creates a new agent type. To add the agent type to the database, see +L<"insert">. + +=cut + +sub table { 'agent_type'; } + +=item insert + +Adds this agent type to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete + +Deletes this agent type from the database. Only agent types with no agents +can be deleted. If there is an error, returns the error, otherwise returns +false. + +=cut + +sub delete { + my $self = shift; + + return "Can't delete an agent_type with agents!" + if qsearch( 'agent', { 'typenum' => $self->typenum } ); + + $self->SUPER::delete; +} + +=item replace OLD_RECORD + +Replaces OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=item check + +Checks all fields to make sure this is a valid agent type. If there is an +error, returns the error, otherwise returns false. Called by the insert and +replace methods. + +=cut + +sub check { + my $self = shift; + + $self->ut_numbern('typenum') + or $self->ut_text('atype'); + +} + +=item pkgpart_hashref + +Returns a hash reference. The keys of the hash are pkgparts. The value is +true iff this agent may purchase the specified package definition. See +L. + +=cut + +sub pkgpart_hashref { + my $self = shift; + my %pkgpart; + #$pkgpart{$_}++ foreach $self->pkgpart; + # not compatible w/5.004_04 (fixed in 5.004_05) + foreach ( $self->pkgpart ) { $pkgpart{$_}++; } + \%pkgpart; +} + +=item type_pkgs + +Returns all FS::type_pkgs objects (see L) for this agent type. + +=cut + +sub type_pkgs { + my $self = shift; + qsearch('type_pkgs', { 'typenum' => $self->typenum } ); +} + +=item pkgpart + +Returns the pkgpart of all package definitions (see L) for this +agent type. + +=cut + +sub pkgpart { + my $self = shift; + map $_->pkgpart, $self->type_pkgs; +} + +=back + +=head1 VERSION + +$Id: agent_type.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ + +=head1 BUGS + +=head1 SEE ALSO + +L, L, L, L, +L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm new file mode 100644 index 000000000..30db4699f --- /dev/null +++ b/FS/FS/cust_bill.pm @@ -0,0 +1,450 @@ +package FS::cust_bill; + +use strict; +use vars qw( @ISA $conf $add1 $add2 $add3 $add4 ); +use Date::Format; +use FS::Record qw( qsearch qsearchs ); +use FS::cust_main; +use FS::cust_bill_pkg; +use FS::cust_credit; +use FS::cust_pay; +use FS::cust_pkg; + +@ISA = qw( FS::Record ); + +#ask FS::UID to run this stuff for us later +$FS::UID::callback{'FS::cust_bill'} = sub { + $conf = new FS::Conf; + ( $add1, $add2, $add3, $add4 ) = ( $conf->config('address'), '', '', '', '' ); +}; + +=head1 NAME + +FS::cust_bill - Object methods for cust_bill records + +=head1 SYNOPSIS + + use FS::cust_bill; + + $record = new FS::cust_bill \%hash; + $record = new FS::cust_bill { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + + ( $total_previous_balance, @previous_cust_bill ) = $record->previous; + + @cust_bill_pkg_objects = $cust_bill->cust_bill_pkg; + + ( $total_previous_credits, @previous_cust_credit ) = $record->cust_credit; + + @cust_pay_objects = $cust_bill->cust_pay; + + @lines = $cust_bill->print_text; + @lines = $cust_bill->print_text $time; + +=head1 DESCRIPTION + +An FS::cust_bill object represents an invoice. FS::cust_bill inherits from +FS::Record. The following fields are currently supported: + +=over 4 + +=item invnum - primary key (assigned automatically for new invoices) + +=item custnum - customer (see L) + +=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 new HASHREF + +Creates a new invoice. To add the invoice to the database, see L<"insert">. +Invoices are normally created by calling the bill method of a customer object +(see L). + +=cut + +sub table { 'cust_bill'; } + +=item insert + +Adds this invoice to the database ("Posts" the invoice). If there is an error, +returns the error, otherwise returns false. + +When adding new invoices, owed must be charged (or null, in which case it is +automatically set to charged). + +=cut + +sub insert { + my $self = shift; + + $self->owed( $self->charged ) if $self->owed eq ''; + return "owed != charged!" + unless $self->owed == $self->charged; + + $self->SUPER::insert; +} + +=item delete + +Currently unimplemented. I don't remove invoices because there would then be +no record you ever posted this invoice (which is bad, no?) + +=cut + +sub delete { + return "Can't remove invoice!" +} + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +Only owed and printed may be changed. Owed is normally updated by creating and +inserting a payment (see L). Printed is normally updated by +calling the collect method of a customer object (see L). + +=cut + +sub replace { + my( $new, $old ) = ( shift, shift ); + return "Can't change custnum!" unless $old->custnum == $new->custnum; + #return "Can't change _date!" unless $old->_date eq $new->_date; + return "Can't change _date!" unless $old->_date == $new->_date; + return "Can't change charged!" unless $old->charged == $new->charged; + return "(New) owed can't be > (new) charged!" if $new->owed > $new->charged; + + $new->SUPER::replace($old); +} + +=item check + +Checks all fields to make sure this is a valid invoice. If there is an error, +returns the error, otherwise returns false. Called by the insert and replace +methods. + +=cut + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('invnum') + || $self->ut_number('custnum') + || $self->ut_numbern('_date') + || $self->ut_money('charged') + || $self->ut_money('owed') + || $self->ut_numbern('printed') + ; + return $error if $error; + + return "Unknown customer" + unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); + + $self->_date(time) unless $self->_date; + + $self->printed(0) if $self->printed eq ''; + + ''; #no error +} + +=item previous + +Returns a list consisting of the total previous balance for this customer, +followed by the previous outstanding invoices (as FS::cust_bill objects also). + +=cut + +sub previous { + my $self = shift; + my $total = 0; + my @cust_bill = sort { $a->_date <=> $b->_date } + grep { $_->owed != 0 && $_->_date < $self->_date } + qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) + ; + foreach ( @cust_bill ) { $total += $_->owed; } + $total, @cust_bill; +} + +=item cust_bill_pkg + +Returns the line items (see L) for this invoice. + +=cut + +sub cust_bill_pkg { + my $self = shift; + qsearch( 'cust_bill_pkg', { 'invnum' => $self->invnum } ); +} + +=item cust_credit + +Returns a list consisting of the total previous credited (see +L) for this customer, followed by the previous outstanding +credits (FS::cust_credit objects). + +=cut + +sub cust_credit { + my $self = shift; + my $total = 0; + my @cust_credit = sort { $a->_date <=> $b->date } + grep { $_->credited != 0 && $_->_date < $self->_date } + qsearch('cust_credit', { 'custnum' => $self->custnum } ) + ; + foreach (@cust_credit) { $total += $_->credited; } + $total, @cust_credit; +} + +=item cust_pay + +Returns all payments (see L) for this invoice. + +=cut + +sub cust_pay { + my $self = shift; + sort { $a->_date <=> $b->date } + qsearch( 'cust_pay', { 'invnum' => $self->invnum } ) + ; +} + +=item print_text [TIME]; + +Returns an ASCII invoice, as a list of lines. + +TIME an optional value used to control the printing of overdue messages. The +default is now. It isn't the date of the invoice; that's the `_date' field. +It is specified as a UNIX timestamp; see L. Also see +L and L for conversion functions. + +=cut + +sub print_text { + + my( $self, $today ) = ( shift, shift ); + $today ||= time; + my $invnum = $self->invnum; + my $cust_main = qsearchs('cust_main', { 'custnum', $self->custnum } ); + $cust_main->payname( $cust_main->first. ' '. $cust_main->getfield('last') ) + unless $cust_main->payname; + + my( $pr_total, @pr_cust_bill ) = $self->previous; #previous balance + my( $cr_total, @cr_cust_credit ) = $self->cust_credit; #credits + my $balance_due = $self->owed + $pr_total - $cr_total; + + #overdue? + my $overdue = ( + $balance_due > 0 + && $today > $self->_date + && $self->printed > 1 + ); + + #printing bits here (yuck!) + + my @collect = (); + + my($description,$amount); + my(@buf); + + #format address + my($l,@address)=(0,'','','','','','',''); + $address[$l++] = + $cust_main->payname. + ( ( $cust_main->payby eq 'BILL' ) && $cust_main->payinfo + ? " (P.O. #". $cust_main->payinfo. ")" + : '' + ) + ; + $address[$l++]=$cust_main->company if $cust_main->company; + $address[$l++]=$cust_main->address1; + $address[$l++]=$cust_main->address2 if $cust_main->address2; + $address[$l++]=$cust_main->city. ", ". $cust_main->state. " ". + $cust_main->zip; + $address[$l++]=$cust_main->country unless $cust_main->country eq 'US'; + + #previous balance + foreach ( @pr_cust_bill ) { + push @buf, ( + "Previous Balance, Invoice #". $_->invnum. + " (". time2str("%x",$_->_date). ")", + '$'. sprintf("%10.2f",$_->owed) + ); + } + if (@pr_cust_bill) { + push @buf,('','-----------'); + push @buf,('Total Previous Balance','$' . sprintf("%10.2f",$pr_total ) ); + push @buf,('',''); + } + + #new charges + foreach ( $self->cust_bill_pkg ) { + + if ( $_->pkgnum ) { + + my($cust_pkg)=qsearchs('cust_pkg', { 'pkgnum', $_->pkgnum } ); + my($part_pkg)=qsearchs('part_pkg',{'pkgpart'=>$cust_pkg->pkgpart}); + my($pkg)=$part_pkg->pkg; + + if ( $_->setup != 0 ) { + push @buf, ( "$pkg Setup",'$' . sprintf("%10.2f",$_->setup) ); + push @buf, map { " ". $_->[0]. ": ". $_->[1], '' } $cust_pkg->labels; + } + + if ( $_->recur != 0 ) { + push @buf, ( + "$pkg (" . time2str("%x",$_->sdate) . " - " . + time2str("%x",$_->edate) . ")", + '$' . sprintf("%10.2f",$_->recur) + ); + push @buf, map { " ". $_->[0]. ": ". $_->[1], '' } $cust_pkg->labels; + } + + } else { #pkgnum Tax + push @buf,("Tax",'$' . sprintf("%10.2f",$_->setup) ) + if $_->setup != 0; + } + } + + push @buf,('','-----------'); + push @buf,('Total New Charges', + '$' . sprintf("%10.2f",$self->charged) ); + push @buf,('',''); + + push @buf,('','-----------'); + push @buf,('Total Charges', + '$' . sprintf("%10.2f",$self->charged + $pr_total) ); + push @buf,('',''); + + #credits + foreach ( @cr_cust_credit ) { + push @buf,( + "Credit #". $_->crednum. " (" . time2str("%x",$_->_date) .")", + '$' . sprintf("%10.2f",$_->credited) + ); + } + + #get & print payments + foreach ( $self->cust_pay ) { + push @buf,( + "Payment received ". time2str("%x",$_->_date ), + '$' . sprintf("%10.2f",$_->paid ) + ); + } + + #balance due + push @buf,('','-----------'); + push @buf,('Balance Due','$' . + sprintf("%10.2f",$self->owed + $pr_total - $cr_total ) ); + + #now print + + my $tot_lines = 50; #should be configurable + #header is 17 lines + my $tot_pages = int( scalar(@buf) / ( 2 * ( $tot_lines - 17 ) ) ); + $tot_pages++ if scalar(@buf) % ( 2 * ( $tot_lines - 17 ) ); + + my $page = 1; + my $lines; + while (@buf) { + $lines = $tot_lines; + my @header = &header( + $page, $tot_pages, $self->_date, $self->invnum, @address + ); + push @collect, @header; + $lines -= scalar(@header); + + while ( $lines-- && @buf ) { + $description=shift(@buf); + $amount=shift(@buf); + push @collect, myswrite($description, $amount); + } + $page++; + } + while ( $lines-- ) { + push @collect, myswrite('', ''); + } + + return @collect; + + sub header { #17 lines + my ( $page, $tot_pages, $date, $invnum, @address ) = @_ ; + push @address, '', '', '', ''; + + my @return = (); + my $i = ' 'x32; + push @return, + '', + $i. 'Invoice', + $i. substr("Page $page of $tot_pages".' 'x10, 0, 20). + time2str("%x", $date ). " FS-". $invnum, + '', + '', + $add1, + $add2, + $add3, + $add4, + '', + splice @address, 0, 7; + ; + return map $_. "\n", @return; + } + + sub myswrite { + my $format = <, L, L, L, +L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/cust_bill_pkg.pm b/FS/FS/cust_bill_pkg.pm new file mode 100644 index 000000000..38d059df8 --- /dev/null +++ b/FS/FS/cust_bill_pkg.pm @@ -0,0 +1,144 @@ +package FS::cust_bill_pkg; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearchs ); +use FS::cust_pkg; +use FS::cust_bill; + +@ISA = qw(FS::Record ); + +=head1 NAME + +FS::cust_bill_pkg - Object methods for cust_bill_pkg records + +=head1 SYNOPSIS + + use FS::cust_bill_pkg; + + $record = new FS::cust_bill_pkg \%hash; + $record = new FS::cust_bill_pkg { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cust_bill_pkg object represents an invoice line item. +FS::cust_bill_pkg inherits from FS::Record. The following fields are currently +supported: + +=over 4 + +=item invnum - invoice (see L) + +=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 new HASHREF + +Creates a new line item. To add the line item to the database, see +L<"insert">. Line items are normally created by calling the bill method of a +customer object (see L). + +=cut + +sub table { 'cust_bill_pkg'; } + +=item insert + +Adds this line item to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete + +Currently unimplemented. I don't remove line items because there would then be +no record the items ever existed (which is bad, no?) + +=cut + +sub delete { + return "Can't delete cust_bill_pkg records!"; +} + +=item replace OLD_RECORD + +Currently unimplemented. This would be even more of an accounting nightmare +than deleteing the items. Just don't do it. + +=cut + +sub replace { + return "Can't modify cust_bill_pkg records!"; +} + +=item check + +Checks all fields to make sure this is a valid line item. If there is an +error, returns the error, otherwise returns false. Called by the insert +method. + +=cut + +sub check { + my $self = shift; + + my $error = + $self->ut_number('pkgnum') + || $self->ut_number('invnum') + || $self->ut_money('setup') + || $self->ut_money('recur') + || $self->ut_numbern('sdate') + || $self->ut_numbern('edate') + ; + return $error if $error; + + if ( $self->pkgnum != 0 ) { #allow unchecked pkgnum 0 for tax! (add to part_pkg?) + return "Unknown pkgnum ". $self->pkgnum + unless qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } ); + } + + return "Unknown invnum" + unless qsearchs( 'cust_bill' ,{ 'invnum' => $self->invnum } ); + + ''; #no error +} + +=back + +=head1 VERSION + +$Id: cust_bill_pkg.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ + +=head1 BUGS + +=head1 SEE ALSO + +L, L, L, L, schema.html +from the base documentation. + +=cut + +1; + diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm new file mode 100644 index 000000000..de8c39d69 --- /dev/null +++ b/FS/FS/cust_credit.pm @@ -0,0 +1,174 @@ +package FS::cust_credit; + +use strict; +use vars qw( @ISA ); +use FS::UID qw( getotaker ); +use FS::Record qw( qsearchs ); +use FS::cust_main; + +@ISA = qw( FS::Record ); + +=head1 NAME + +FS::cust_credit - Object methods for cust_credit records + +=head1 SYNOPSIS + + use FS::cust_credit; + + $record = new FS::cust_credit \%hash; + $record = new FS::cust_credit { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cust_credit object represents a credit. FS::cust_credit inherits from +FS::Record. The following fields are currently supported: + +=over 4 + +=item crednum - primary key (assigned automatically for new credits) + +=item custnum - customer (see L) + +=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 new HASHREF + +Creates a new credit. To add the credit to the database, see L<"insert">. + +=cut + +sub table { 'cust_credit'; } + +=item insert + +Adds this credit to the database ("Posts" the credit). If there is an error, +returns the error, otherwise returns false. + +When adding new invoices, credited must be amount (or null, in which case it is +automatically set to amount). + +=cut + +sub insert { + my $self = shift; + + my $error; + return $error if $error = $self->ut_money('credited') + || $self->ut_money('amount'); + + $self->credited($self->amount) if $self->credited == 0 + || $self->credited eq ''; + return "credited != amount!" + unless $self->credited == $self->amount; + + $self->SUPER::insert; +} + +=item delete + +Currently unimplemented. + +=cut + +sub delete { + return "Can't remove credit!" +} + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +Only credited may be changed. Credited is normally updated by creating and +inserting a refund (see L). + +=cut + +sub replace { + my ( $new, $old ) = ( shift, shift ); + + return "Can't change custnum!" unless $old->custnum == $new->custnum; + #return "Can't change date!" unless $old->_date eq $new->_date; + return "Can't change date!" unless $old->_date == $new->_date; + return "Can't change amount!" unless $old->amount == $new->amount; + return "(New) credited can't be > (new) amount!" + if $new->credited > $new->amount; + + $new->SUPER::replace($old); +} + +=item check + +Checks all fields to make sure this is a valid credit. If there is an error, +returns the error, otherwise returns false. Called by the insert and replace +methods. + +=cut + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('crednum') + || $self->ut_number('custnum') + || $self->ut_numbern('_date') + || $self->ut_money('amount') + || $self->ut_money('credited') + || $self->ut_textn('reason'); + ; + return $error if $error; + + return "Unknown customer" + unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); + + $self->_date(time) unless $self->_date; + + $self->otaker(getotaker); + + ''; #no error +} + +=back + +=head1 VERSION + +$Id: cust_credit.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ + +=head1 BUGS + +The delete method. + +=head1 SEE ALSO + +L, L, L, schema.html from the base +documentation. + +=cut + +1; + diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm new file mode 100644 index 000000000..25b6b9f46 --- /dev/null +++ b/FS/FS/cust_main.pm @@ -0,0 +1,965 @@ +#this is so kludgy i'd be embarassed if it wasn't cybercash's fault +package main; +use vars qw($paymentserversecret $paymentserverport $paymentserverhost); + +package FS::cust_main; + +use strict; +use vars qw( @ISA $conf $lpr $processor $xaction $E_NoErr $invoice_from + $smtpmachine ); +use Safe; +use Carp; +use Time::Local; +use Date::Format; +use Date::Manip; +use Mail::Internet; +use Mail::Header; +use Business::CreditCard; +use FS::UID qw( getotaker ); +use FS::Record qw( qsearchs qsearch ); +use FS::cust_pkg; +use FS::cust_bill; +use FS::cust_bill_pkg; +use FS::cust_pay; +use FS::cust_credit; +use FS::cust_pay_batch; +use FS::part_referral; +use FS::cust_main_county; +use FS::agent; +use FS::cust_main_invoice; + +@ISA = qw( FS::Record ); + +#ask FS::UID to run this stuff for us later +$FS::UID::callback{'FS::cust_main'} = sub { + $conf = new FS::Conf; + $lpr = $conf->config('lpr'); + $invoice_from = $conf->config('invoice_from'); + $smtpmachine = $conf->config('smtpmachine'); + + if ( $conf->exists('cybercash3.2') ) { + require CCMckLib3_2; + #qw($MCKversion %Config InitConfig CCError CCDebug CCDebug2); + require CCMckDirectLib3_2; + #qw(SendCC2_1Server); + require CCMckErrno3_2; + #qw(MCKGetErrorMessage $E_NoErr); + import CCMckErrno3_2 qw($E_NoErr); + + my $merchant_conf; + ($merchant_conf,$xaction)= $conf->config('cybercash3.2'); + my $status = &CCMckLib3_2::InitConfig($merchant_conf); + if ( $status != $E_NoErr ) { + warn "CCMckLib3_2::InitConfig error:\n"; + foreach my $key (keys %CCMckLib3_2::Config) { + warn " $key => $CCMckLib3_2::Config{$key}\n" + } + my($errmsg) = &CCMckErrno3_2::MCKGetErrorMessage($status); + die "CCMckLib3_2::InitConfig fatal error: $errmsg\n"; + } + $processor='cybercash3.2'; + } elsif ( $conf->exists('cybercash2') ) { + require CCLib; + #qw(sendmserver); + ( $main::paymentserverhost, + $main::paymentserverport, + $main::paymentserversecret, + $xaction, + ) = $conf->config('cybercash2'); + $processor='cybercash2'; + } +}; + +=head1 NAME + +FS::cust_main - Object methods for cust_main records + +=head1 SYNOPSIS + + use FS::cust_main; + + $record = new FS::cust_main \%hash; + $record = new FS::cust_main { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + + @cust_pkg = $record->all_pkgs; + + @cust_pkg = $record->ncancelled_pkgs; + + $error = $record->bill; + $error = $record->bill %options; + $error = $record->bill 'time' => $time; + + $error = $record->collect; + $error = $record->collect %options; + $error = $record->collect 'invoice_time' => $time, + 'batch_card' => 'yes', + 'report_badcard' => 'yes', + ; + +=head1 DESCRIPTION + +An FS::cust_main object represents a customer. FS::cust_main inherits from +FS::Record. The following fields are currently supported: + +=over 4 + +=item custnum - primary key (assigned automatically for new customers) + +=item agentnum - agent (see L) + +=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 fax - 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 new HASHREF + +Creates a new customer. To add the customer to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I method. + +=cut + +sub table { 'cust_main'; } + +=item insert + +Adds this customer to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete NEW_CUSTNUM + +This deletes the customer. If there is an error, returns the error, otherwise +returns false. + +This will completely remove all traces of the customer record. This is not +what you want when a customer cancels service; for that, cancel all of the +customer's packages (see L). + +If the customer has any packages, you need to pass a new (valid) customer +number for those packages to be transferred to. + +You can't delete a customer with invoices (see L), +or credits (see L). + +=cut + +sub delete { + my $self = shift; + + if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) { + return "Can't delete a customer with invoices"; + } + if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) { + return "Can't delete a customer with credits"; + } + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum } ); + if ( @cust_pkg ) { + my $new_custnum = shift; + return "Invalid new customer number: $new_custnum" + unless qsearchs( 'cust_main', { 'custnum' => $new_custnum } ); + foreach my $cust_pkg ( @cust_pkg ) { + my %hash = $cust_pkg->hash; + $hash{'custnum'} = $new_custnum; + my $new_cust_pkg = new FS::cust_pkg ( \%hash ); + my $error = $new_cust_pkg->replace($cust_pkg); + return $error if $error; + } + } + foreach my $cust_main_invoice ( + qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } ) + ) { + my $error = $cust_main_invoice->delete; + return $error if $error; + } + + $self->SUPER::delete; +} + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=item check + +Checks all fields to make sure this is a valid customer record. If there is +an error, returns the error, otherwise returns false. Called by the insert +and repalce methods. + +=cut + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('custnum') + || $self->ut_number('agentnum') + || $self->ut_number('refnum') + || $self->ut_textn('company') + || $self->ut_text('address1') + || $self->ut_textn('address2') + || $self->ut_text('city') + || $self->ut_textn('county') + || $self->ut_textn('state') + || $self->ut_phonen('daytime') + || $self->ut_phonen('night') + || $self->ut_phonen('fax') + ; + return $error if $error; + + return "Unknown agent" + unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } ); + + return "Unknown referral" + unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } ); + + $self->getfield('last') =~ /^([\w \,\.\-\']+)$/ + or return "Illegal last name: ". $self->getfield('last'); + $self->setfield('last',$1); + + $self->first =~ /^([\w \,\.\-\']+)$/ + or return "Illegal first name: ". $self->first; + $self->first($1); + + if ( $self->ss eq '' ) { + $self->ss(''); + } else { + my $ss = $self->ss; + $ss =~ s/\D//g; + $ss =~ /^(\d{3})(\d{2})(\d{4})$/ + or return "Illegal social security number: ". $self->ss; + $self->ss("$1-$2-$3"); + } + + $self->country =~ /^(\w\w)$/ or return "Illegal country: ". $self->country; + $self->country($1); + unless ( qsearchs('cust_main_county', { + 'country' => $self->country, + 'state' => '', + } ) ) { + return "Unknown state/county/country: ". + $self->state. "/". $self->county. "/". $self->country + unless qsearchs('cust_main_county',{ + 'state' => $self->state, + 'county' => $self->county, + 'country' => $self->country, + } ); + } + + $self->zip =~ /^\s*(\w[\w\-\s]{3,8}\w)\s*$/ + or return "Illegal zip: ". $self->zip; + $self->zip($1); + + $self->payby =~ /^(CARD|BILL|COMP)$/ + or return "Illegal payby: ". $self->payby; + $self->payby($1); + + if ( $self->payby eq 'CARD' ) { + + my $payinfo = $self->payinfo; + $payinfo =~ s/\D//g; + $payinfo =~ /^(\d{13,16})$/ + or return "Illegal credit card number: ". $self->payinfo; + $payinfo = $1; + $self->payinfo($payinfo); + validate($payinfo) + or return "Illegal credit card number: ". $self->payinfo; + return "Unknown card type" if cardtype($self->payinfo) eq "Unknown"; + + } elsif ( $self->payby eq 'BILL' ) { + + $error = $self->ut_textn('payinfo'); + return "Illegal P.O. number: ". $self->payinfo if $error; + + } elsif ( $self->payby eq 'COMP' ) { + + $error = $self->ut_textn('payinfo'); + return "Illegal comp account issuer: ". $self->payinfo if $error; + + } + + 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: ". $self->paydate; + if ( length($2) == 4 ) { + $self->paydate("$2-$1-01"); + } elsif ( $2 > 97 ) { #should pry change to check for "this year" + $self->paydate("19$2-$1-01"); + } else { + $self->paydate("20$2-$1-01"); + } + } + + if ( $self->payname eq '' ) { + $self->payname( $self->first. " ". $self->getfield('last') ); + } else { + $self->payname =~ /^([\w \,\.\-\']+)$/ + or return "Illegal billing name: ". $self->payname; + $self->payname($1); + } + + $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax; + $self->tax($1); + + $self->otaker(getotaker); + + ''; #no error +} + +=item all_pkgs + +Returns all packages (see L) for this customer. + +=cut + +sub all_pkgs { + my $self = shift; + qsearch( 'cust_pkg', { 'custnum' => $self->custnum }); +} + +=item ncancelled_pkgs + +Returns all non-cancelled packages (see L) for this customer. + +=cut + +sub ncancelled_pkgs { + my $self = shift; + 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'} || time; + + my $error; + + #put below somehow? + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + # find the packages which are due for billing, find out how much they are + # & generate invoice database. + + my( $total_setup, $total_recur ) = ( 0, 0 ); + my @cust_bill_pkg; + + foreach my $cust_pkg ( + qsearch('cust_pkg',{'custnum'=> $self->getfield('custnum') } ) + ) { + + next if $cust_pkg->getfield('cancel'); + + #? to avoid use of uninitialized value errors... ? + $cust_pkg->setfield('bill', '') + unless defined($cust_pkg->bill); + + my $part_pkg = qsearchs( 'part_pkg', { 'pkgpart' => $cust_pkg->pkgpart } ); + + #so we don't modify cust_pkg record unnecessarily + my $cust_pkg_mod_flag = 0; + my %hash = $cust_pkg->hash; + my $old_cust_pkg = new FS::cust_pkg \%hash; + + # bill setup + my $setup = 0; + unless ( $cust_pkg->setup ) { + my $setup_prog = $part_pkg->getfield('setup'); + my $cpt = new Safe; + #$cpt->permit(); #what is necessary? + $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods? + $setup = $cpt->reval($setup_prog); + unless ( defined($setup) ) { + warn "Error reval-ing part_pkg->setup pkgpart ", + $part_pkg->pkgpart, ": $@"; + } else { + $cust_pkg->setfield('setup',$time); + $cust_pkg_mod_flag=1; + } + } + + #bill recurring fee + my $recur = 0; + my $sdate; + if ( $part_pkg->getfield('freq') > 0 && + ! $cust_pkg->getfield('susp') && + ( $cust_pkg->getfield('bill') || 0 ) < $time + ) { + my $recur_prog = $part_pkg->getfield('recur'); + my $cpt = new Safe; + #$cpt->permit(); #what is necessary? + $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods? + $recur = $cpt->reval($recur_prog); + unless ( defined($recur) ) { + warn "Error reval-ing part_pkg->recur pkgpart ", + $part_pkg->pkgpart, ": $@"; + } else { + #change this bit to use Date::Manip? + #$sdate=$cust_pkg->bill || time; + #$sdate=$cust_pkg->bill || $time; + $sdate = $cust_pkg->bill || $cust_pkg->setup || $time; + my ($sec,$min,$hour,$mday,$mon,$year) = + (localtime($sdate) )[0,1,2,3,4,5]; + $mon += $part_pkg->getfield('freq'); + until ( $mon < 12 ) { $mon -= 12; $year++; } + $cust_pkg->setfield('bill', + timelocal($sec,$min,$hour,$mday,$mon,$year)); + $cust_pkg_mod_flag = 1; + } + } + + warn "setup is undefinded" unless defined($setup); + warn "recur is undefinded" unless defined($recur); + warn "cust_pkg bill is undefinded" unless defined($cust_pkg->bill); + + if ( $cust_pkg_mod_flag ) { + $error=$cust_pkg->replace($old_cust_pkg); + if ( $error ) { #just in case + warn "Error modifying pkgnum ", $cust_pkg->pkgnum, ": $error"; + } else { + $setup = sprintf( "%.2f", $setup ); + $recur = sprintf( "%.2f", $recur ); + my $cust_bill_pkg = new FS::cust_bill_pkg ({ + 'pkgnum' => $cust_pkg->pkgnum, + 'setup' => $setup, + 'recur' => $recur, + 'sdate' => $sdate, + 'edate' => $cust_pkg->bill, + }); + push @cust_bill_pkg, $cust_bill_pkg; + $total_setup += $setup; + $total_recur += $recur; + } + } + + } + + my $charged = sprintf( "%.2f", $total_setup + $total_recur ); + + return '' if scalar(@cust_bill_pkg) == 0; + + unless ( $self->getfield('tax') =~ /Y/i + || $self->getfield('payby') eq 'COMP' + ) { + my $cust_main_county = qsearchs('cust_main_county',{ + 'state' => $self->state, + 'county' => $self->county, + 'country' => $self->country, + } ); + my $tax = sprintf( "%.2f", + $charged * ( $cust_main_county->getfield('tax') / 100 ) + ); + $charged = sprintf( "%.2f", $charged+$tax ); + + my $cust_bill_pkg = new FS::cust_bill_pkg ({ + 'pkgnum' => 0, + 'setup' => $tax, + 'recur' => 0, + 'sdate' => '', + 'edate' => '', + }); + push @cust_bill_pkg, $cust_bill_pkg; + } + + my $cust_bill = new FS::cust_bill ( { + 'custnum' => $self->getfield('custnum'), + '_date' => $time, + 'charged' => $charged, + } ); + $error = $cust_bill->insert; + #shouldn't happen, but how else to handle this? (wrap me in eval, to catch + # fatal errors) + die "Error creating cust_bill record: $error!\n", + "Check updated but unbilled packages for customer", $self->custnum, "\n" + if $error; + + my $invnum = $cust_bill->invnum; + my $cust_bill_pkg; + foreach $cust_bill_pkg ( @cust_bill_pkg ) { + $cust_bill_pkg->setfield( 'invnum', $invnum ); + $error = $cust_bill_pkg->insert; + #shouldn't happen, but how else tohandle this? + die "Error creating cust_bill_pkg record: $error!\n", + "Check incomplete invoice ", $invnum, "\n" + if $error; + } + + ''; #no error +} + +=item collect OPTIONS + +(Attempt to) collect money for this customer's outstanding invoices (see +L). 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'} || time; + + 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'; + local $SIG{PIPE} = 'IGNORE'; + + foreach my $cust_bill ( + qsearch('cust_bill', { 'custnum' => $self->custnum, } ) + ) { + + #this has to be before next's + my $amount = sprintf( "%.2f", $total_owed < $cust_bill->owed + ? $total_owed + : $cust_bill->owed + ); + $total_owed = sprintf( "%.2f", $total_owed - $amount ); + + next unless $cust_bill->owed > 0; + + next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } ); + + #warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, total_owed $total_owed)"; + + next unless $amount > 0; + + if ( $self->payby eq 'BILL' ) { + + #30 days 2592000 + my $since = $invoice_time - ( $cust_bill->_date || 0 ); + #warn "$invoice_time ", $cust_bill->_date, " $since"; + if ( $since >= 0 #don't print future invoices + && ( $cust_bill->printed * 2592000 ) <= $since + ) { + + #my @print_text = $cust_bill->print_text; #( date ) + my @invoicing_list = $self->invoicing_list; + if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice + $ENV{SMTPHOSTS} = $smtpmachine; + $ENV{MAILADDRESS} = $invoice_from; + my $header = new Mail::Header ( [ + "From: $invoice_from", + "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ), + "Sender: $invoice_from", + "Reply-To: $invoice_from", + "Date: ". time2str("%a, %d %b %Y %X %z", time), + "Subject: Invoice", + ] ); + my $message = new Mail::Internet ( + 'Header' => $header, + 'Body' => [ $cust_bill->print_text ], #( date) + ); + $message->smtpsend or die "Can't send invoice email!"; #die? warn? + + } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) { + open(LPR, "|$lpr") or die "Can't open pipe to $lpr: $!"; + print LPR $cust_bill->print_text; #( date ) + close LPR + or die $! ? "Error closing $lpr: $!" + : "Exit status $? from $lpr"; + } + + my %hash = $cust_bill->hash; + $hash{'printed'}++; + my $new_cust_bill = new FS::cust_bill(\%hash); + my $error = $new_cust_bill->replace($cust_bill); + warn "Error updating $cust_bill->printed: $error" if $error; + + } + + } elsif ( $self->payby eq 'COMP' ) { + my $cust_pay = new FS::cust_pay ( { + 'invnum' => $cust_bill->invnum, + 'paid' => $amount, + '_date' => '', + 'payby' => 'COMP', + 'payinfo' => $self->payinfo, + 'paybatch' => '' + } ); + my $error = $cust_pay->insert; + return 'Error COMPing invnum #' . $cust_bill->invnum . + ':' . $error if $error; + + } elsif ( $self->payby eq 'CARD' ) { + + if ( $options{'batch_card'} ne 'yes' ) { + + return "Real time card processing not enabled!" unless $processor; + + if ( $processor =~ /^cybercash/ ) { + + #fix exp. date for cybercash + #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/; + $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; + my $exp = "$2/$1"; + + my $paybatch = $cust_bill->invnum. + '-' . time2str("%y%m%d%H%M%S", time); + + my $payname = $self->payname || + $self->getfield('first'). ' '. $self->getfield('last'); + + my $address = $self->address1; + $address .= ", ". $self->address2 if $self->address2; + + my $country = 'USA' if $self->country eq 'US'; + + my @full_xaction = ( $xaction, + 'Order-ID' => $paybatch, + 'Amount' => "usd $amount", + 'Card-Number' => $self->getfield('payinfo'), + 'Card-Name' => $payname, + 'Card-Address' => $address, + 'Card-City' => $self->getfield('city'), + 'Card-State' => $self->getfield('state'), + 'Card-Zip' => $self->getfield('zip'), + 'Card-Country' => $country, + 'Card-Exp' => $exp, + ); + + my %result; + if ( $processor eq 'cybercash2' ) { + $^W=0; #CCLib isn't -w safe, ugh! + %result = &CCLib::sendmserver(@full_xaction); + $^W=1; + } elsif ( $processor eq 'cybercash3.2' ) { + %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction); + } else { + return "Unkonwn real-time processor $processor\n"; + } + + #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3 + #if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1 + if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3 + my $cust_pay = new FS::cust_pay ( { + 'invnum' => $cust_bill->invnum, + 'paid' => $amount, + '_date' => '', + 'payby' => 'CARD', + 'payinfo' => $self->payinfo, + 'paybatch' => "$processor:$paybatch", + } ); + my $error = $cust_pay->insert; + return 'Error applying payment, invnum #' . + $cust_bill->invnum. ':'. $error if $error; + } elsif ( $result{'Mstatus'} ne 'failure-bad-money' + || $options{'report_badcard'} ) { + return 'Cybercash error, invnum #' . + $cust_bill->invnum. ':'. $result{'MErrMsg'}; + } else { + return ''; + } + + } else { + return "Unkonwn real-time processor $processor\n"; + } + + } else { #batch card + + my $cust_pay_batch = new FS::cust_pay_batch ( { + 'invnum' => $cust_bill->getfield('invnum'), + 'custnum' => $self->getfield('custnum'), + 'last' => $self->getfield('last'), + 'first' => $self->getfield('first'), + 'address1' => $self->getfield('address1'), + 'address2' => $self->getfield('address2'), + 'city' => $self->getfield('city'), + 'state' => $self->getfield('state'), + 'zip' => $self->getfield('zip'), + 'country' => $self->getfield('country'), + 'trancode' => 77, + 'cardnum' => $self->getfield('payinfo'), + 'exp' => $self->getfield('paydate'), + 'payname' => $self->getfield('payname'), + 'amount' => $amount, + } ); + my $error = $cust_pay_batch->insert; + return "Error adding to cust_pay_batch: $error" if $error; + + } + + } else { + return "Unknown payment type ". $self->payby; + } + + + + + + } + ''; + +} + +=item total_owed + +Returns the total owed for this customer on all invoices +(see L). + +=cut + +sub total_owed { + my $self = shift; + my $total_bill = 0; + foreach my $cust_bill ( qsearch('cust_bill', { + 'custnum' => $self->custnum, + } ) ) { + $total_bill += $cust_bill->owed; + } + sprintf( "%.2f", $total_bill ); +} + +=item total_credited + +Returns the total credits (see L) for this customer. + +=cut + +sub total_credited { + my $self = shift; + my $total_credit = 0; + foreach my $cust_credit ( qsearch('cust_credit', { + 'custnum' => $self->custnum, + } ) ) { + $total_credit += $cust_credit->credited; + } + sprintf( "%.2f", $total_credit ); +} + +=item balance + +Returns the balance for this customer (total owed minus total credited). + +=cut + +sub balance { + my $self = shift; + sprintf( "%.2f", $self->total_owed - $self->total_credited ); +} + +=item invoicing_list [ ARRAYREF ] + +If an arguement is given, sets these email addresses as invoice recipients +(see L). Errors are not fatal and are not reported +(except as warnings), so use check_invoicing_list first. + +Returns a list of email addresses (with svcnum entries expanded). + +Note: You can clear the invoicing list by passing an empty ARRAYREF. You can +check it without disturbing anything by passing nothing. + +This interface may change in the future. + +=cut + +sub invoicing_list { + my( $self, $arrayref ) = @_; + if ( $arrayref ) { + my @cust_main_invoice; + if ( $self->custnum ) { + @cust_main_invoice = + qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } ); + } else { + @cust_main_invoice = (); + } + foreach my $cust_main_invoice ( @cust_main_invoice ) { + #warn $cust_main_invoice->destnum; + unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) { + #warn $cust_main_invoice->destnum; + my $error = $cust_main_invoice->delete; + warn $error if $error; + } + } + if ( $self->custnum ) { + @cust_main_invoice = + qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } ); + } else { + @cust_main_invoice = (); + } + foreach my $address ( @{$arrayref} ) { + unless ( grep { $address eq $_->address } @cust_main_invoice ) { + my $cust_main_invoice = new FS::cust_main_invoice ( { + 'custnum' => $self->custnum, + 'dest' => $address, + } ); + my $error = $cust_main_invoice->insert; + warn $error if $error; + } + } + } + if ( $self->custnum ) { + map { $_->address } + qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } ); + } else { + (); + } +} + +=item check_invoicing_list ARRAYREF + +Checks these arguements as valid input for the invoicing_list method. If there +is an error, returns the error, otherwise returns false. + +=cut + +sub check_invoicing_list { + my( $self, $arrayref ) = @_; + foreach my $address ( @{$arrayref} ) { + my $cust_main_invoice = new FS::cust_main_invoice ( { + 'custnum' => $self->custnum, + 'dest' => $address, + } ); + my $error = $self->custnum + ? $cust_main_invoice->check + : $cust_main_invoice->checkdest + ; + return $error if $error; + } + ''; +} + +=back + +=head1 VERSION + +$Id: cust_main.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ + +=head1 BUGS + +The delete method. + +The delete method should possibly take an FS::cust_main object reference +instead of a scalar customer number. + +Bill and collect options should probably be passed as references instead of a +list. + +CyberCash v2 forces us to define some variables in package main. + +There should probably be a configuration file with a list of allowed credit +card types. + +CyberCash is the only processor. + +No multiple currency support (probably a larger project than just this module). + +=head1 SEE ALSO + +L, L, L, L +L, L, L, +L, L, +L, schema.html from the base documentation. + +=cut + +1; + + diff --git a/FS/FS/cust_main_county.pm b/FS/FS/cust_main_county.pm new file mode 100644 index 000000000..383360b7b --- /dev/null +++ b/FS/FS/cust_main_county.pm @@ -0,0 +1,111 @@ +package FS::cust_main_county; + +use strict; +use vars qw( @ISA ); +use FS::Record; + +@ISA = qw( FS::Record ); + +=head1 NAME + +FS::cust_main_county - Object methods for cust_main_county objects + +=head1 SYNOPSIS + + use FS::cust_main_county; + + $record = new FS::cust_main_county \%hash; + $record = new FS::cust_main_county { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cust_main_county object represents a tax rate, defined by locale. +FS::cust_main_county inherits from FS::Record. The following fields are +currently supported: + +=over 4 + +=item taxnum - primary key (assigned automatically for new tax rates) + +=item state + +=item county + +=item country + +=item tax - percentage + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new tax rate. To add the tax rate to the database, see L<"insert">. + +=cut + +sub table { 'cust_main_county'; } + +=item insert + +Adds this tax rate to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete + +Deletes this tax rate from the database. If there is an error, returns the +error, otherwise returns false. + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=item check + +Checks all fields to make sure this is a valid tax rate. If there is an error, +returns the error, otherwise returns false. Called by the insert and replace +methods. + +=cut + +sub check { + my $self = shift; + + $self->ut_numbern('taxnum') + || $self->ut_textn('state') + || $self->ut_textn('county') + || $self->ut_text('country') + || $self->ut_float('tax') + ; + +} + +=back + +=head1 VERSION + +$Id: cust_main_county.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ + +=head1 BUGS + +=head1 SEE ALSO + +L, L, L, schema.html from the base +documentation. + +=cut + +1; + diff --git a/FS/FS/cust_main_invoice.pm b/FS/FS/cust_main_invoice.pm new file mode 100644 index 000000000..bd7d53dd6 --- /dev/null +++ b/FS/FS/cust_main_invoice.pm @@ -0,0 +1,181 @@ +package FS::cust_main_invoice; + +use strict; +use vars qw(@ISA $conf $mydomain); +use Exporter; +use FS::Record qw( qsearchs ); +use FS::Conf; +use FS::cust_main; +use FS::svc_acct; + +@ISA = qw( FS::Record ); + +#ask FS::UID to run this stuff for us later +$FS::UID::callback{'FS::cust_main_invoice'} = sub { + $conf = new FS::Conf; + $mydomain = $conf->config('domain'); +}; + +=head1 NAME + +FS::cust_main_invoice - Object methods for cust_main_invoice records + +=head1 SYNOPSIS + + use FS::cust_main_invoice; + + $record = new FS::cust_main_invoice \%hash; + $record = new FS::cust_main_invoice { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + + $email_address = $record->address; + +=head1 DESCRIPTION + +An FS::cust_main_invoice object represents an invoice destination. FS::cust_main_invoice inherits from +FS::Record. The following fields are currently supported: + +=over 4 + +=item destnum - primary key + +=item custnum - customer (see L) + +=item 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) + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new invoice destination. To add the invoice destination to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I method. + +=cut + +sub table { 'cust_main_invoice'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete + +Delete this record from the database. + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +sub replace { + my ( $new, $old ) = ( shift, shift ); + + return "Can't change custnum!" unless $old->custnum == $new->custnum; + + $new->SUPER::replace; +} + + +=item check + +Checks all fields to make sure this is a valid invoice destination. If there is +an error, returns the error, otherwise returns false. Called by the insert +and repalce methods. + +=cut + +sub check { + my $self = shift; + + my $error = $self->ut_numbern('destnum') + || $self->ut_number('custnum') + || $self->checkdest; + ; + return $error if $error; + + return "Unknown customer" + unless qsearchs('cust_main',{ 'custnum' => $self->custnum }); + + ''; #noerror +} + +=item checkdest + +Checks the dest field only. + +=cut + +sub checkdest { + my $self = shift; + + my $error = $self->ut_text('dest'); + return $error if $error; + + if ( $self->dest eq 'POST' ) { + #contemplate our navel + } elsif ( $self->dest =~ /^(\d+)$/ ) { + return "Unknown local account (specified by svcnum)" + unless qsearchs( 'svc_acct', { 'svcnum' => $self->dest } ); + } elsif ( $self->dest =~ /^([\w\.\-]+)\@(([\w\.\-]+\.)+\w+)$/ ) { + my($user, $domain) = ($1, $2); + if ( $domain eq $mydomain ) { + my $svc_acct = qsearchs( 'svc_acct', { 'username' => $user } ); + return "Unknown local account (specified literally)" unless $svc_acct; + $svc_acct->svcnum =~ /^(\d+)$/ or die "Non-numeric svcnum?!"; + $self->dest($1); + } + } else { + return "Illegal destination!"; + } + + ''; #no error +} + +=item address + +Returns the literal email address for this record (or `POST'). + +=cut + +sub address { + my $self = shift; + if ( $self->dest =~ /(\d+)$/ ) { + my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $1 } ); + $svc_acct->username . '@' . $mydomain; + } else { + $self->dest; + } +} + +=back + +=head1 VERSION + +$Id: cust_main_invoice.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ + +=head1 BUGS + +=head1 SEE ALSO + +L, L + +=cut + +1; + diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm new file mode 100644 index 000000000..e2b92982d --- /dev/null +++ b/FS/FS/cust_pay.pm @@ -0,0 +1,188 @@ +package FS::cust_pay; + +use strict; +use vars qw( @ISA ); +use Business::CreditCard; +use FS::Record qw( qsearchs ); +use FS::cust_bill; + +@ISA = qw( FS::Record ); + +=head1 NAME + +FS::cust_pay - Object methods for cust_pay objects + +=head1 SYNOPSIS + + use FS::cust_pay; + + $record = new FS::cust_pay \%hash; + $record = new FS::cust_pay { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cust_pay object represents a payment. FS::cust_pay inherits from +FS::Record. The following fields are currently supported: + +=over 4 + +=item paynum - primary key (assigned automatically for new payments) + +=item invnum - Invoice (see L) + +=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 new HASHREF + +Creates a new payment. To add the payment to the databse, see L<"insert">. + +=cut + +sub table { 'cust_pay'; } + +=item insert + +Adds this payment to the databse, and updates the invoice (see +L). + +=cut + +sub insert { + my $self = shift; + + my $error; + + $error = $self->check; + return $error if $error; + + my $old_cust_bill = qsearchs( 'cust_bill', { 'invnum' => $self->invnum } ); + return "Unknown invnum" unless $old_cust_bill; + my %hash = $old_cust_bill->hash; + $hash{'owed'} = sprintf("%.2f", $hash{owed} - $self->paid ); + my $new_cust_bill = new FS::cust_bill ( \%hash ); + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + $error = $new_cust_bill->replace($old_cust_bill); + return "Error modifying cust_bill: $error" if $error; + + $self->SUPER::insert; +} + +=item delete + +Currently unimplemented (accounting reasons). + +=cut + +sub delete { + return "Can't (yet?) delete cust_pay records!"; +} + +=item replace OLD_RECORD + +Currently unimplemented (accounting reasons). + +=cut + +sub replace { + return "Can't (yet?) modify cust_pay records!"; +} + +=item check + +Checks all fields to make sure this is a valid payment. If there is an error, +returns the error, otherwise returns false. Called by the insert method. + +=cut + +sub check { + my $self = shift; + + my $error; + + $error = + $self->ut_numbern('paynum') + || $self->ut_number('invnum') + || $self->ut_money('paid') + || $self->ut_numbern('_date') + ; + return $error if $error; + + $self->_date(time) unless $self->_date; + + $self->payby =~ /^(CARD|BILL|COMP)$/ or return "Illegal payby"; + $self->payby($1); + + if ( $self->payby eq 'CARD' ) { + my $payinfo = $self->payinfo; + $payinfo =~ s/\D//g; + $self->payinfo($payinfo); + if ( $self->payinfo ) { + $self->payinfo =~ /^(\d{13,16})$/ + or return "Illegal (mistyped?) credit card number (payinfo)"; + $self->payinfo($1); + validate($self->payinfo) or return "Illegal credit card number"; + return "Unknown card type" if cardtype($self->payinfo) eq "Unknown"; + } else { + $self->payinfo('N/A'); + } + + } else { + $error = $self->ut_textn('payinfo'); + return $error if $error; + } + + $error = $self->ut_textn('paybatch'); + return $error if $error; + + ''; #no error + +} + +=back + +=head1 VERSION + +$Id: cust_pay.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ + +=head1 BUGS + +Delete and replace methods. + +=head1 SEE ALSO + +L, L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/cust_pay_batch.pm b/FS/FS/cust_pay_batch.pm new file mode 100644 index 000000000..7c5c6c404 --- /dev/null +++ b/FS/FS/cust_pay_batch.pm @@ -0,0 +1,205 @@ +package FS::cust_pay_batch; + +use strict; +use vars qw( @ISA ); +use FS::Record; +use Business::CreditCard; + +@ISA = qw( FS::Record ); + +=head1 NAME + +FS::cust_pay_batch - Object methods for batch cards + +=head1 SYNOPSIS + + use FS::cust_pay_batch; + + $record = new FS::cust_pay_batch \%hash; + $record = new FS::cust_pay_batch { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cust_pay_batch object represents a credit card transaction ready to be +batched (sent to a processor). FS::cust_pay_batch inherits from FS::Record. +Typically called by the collect method of an FS::cust_main object. The +following fields are currently supported: + +=over 4 + +=item trancode - 77 for charges + +=item cardnum + +=item exp - card expiration + +=item amount + +=item invnum - invoice + +=item custnum - customer + +=item payname - name on card + +=item first - name + +=item last - name + +=item address1 + +=item address2 + +=item city + +=item state + +=item zip + +=item country + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new record. To add the record to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I method. + +=cut + +sub table { 'cust_pay_batch'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete + +Delete this record from the database. If there is an error, returns the error, +otherwise returns false. + +=item replace OLD_RECORD + +#inactive +# +#Replaces the OLD_RECORD with this one in the database. If there is an error, +#returns the error, otherwise returns false. + +=cut + +sub replace { + return "Can't (yet?) replace batched transactions!"; +} + +=item check + +Checks all fields to make sure this is a valid transaction. If there is +an error, returns the error, otherwise returns false. Called by the insert +and repalce methods. + +=cut + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('trancode') + || $self->ut_number('cardnum') + || $self->ut_money('amount') + || $self->ut_number('invnum') + || $self->ut_number('custnum') + || $self->ut_text('address1') + || $self->ut_textn('address2') + || $self->ut_text('city') + || $self->ut_text('state') + ; + + return $error if $error; + + $self->getfield('last') =~ /^([\w \,\.\-\']+)$/ or return "Illegal last name"; + $self->setfield('last',$1); + + $self->first =~ /^([\w \,\.\-\']+)$/ or return "Illegal first name"; + $self->first($1); + + my $cardnum = $self->cardnum; + $cardnum =~ s/\D//g; + $cardnum =~ /^(\d{13,16})$/ + or return "Illegal credit card number"; + $cardnum = $1; + $self->cardnum($cardnum); + validate($cardnum) or return "Illegal credit card number"; + return "Unknown card type" if cardtype($cardnum) eq "Unknown"; + + if ( $self->exp eq '' ) { + return "Expriation date required"; #unless + $self->exp(''); + } else { + if ( $self->exp =~ /^(\d{4})[\/\-](\d{1,2})[\/\-](\d{1,2})$/ ) { + $self->exp("$1-$2-$3"); + } elsif ( $self->exp =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) { + if ( length($2) == 4 ) { + $self->exp("$2-$1-01"); + } elsif ( $2 > 98 ) { #should pry change to check for "this year" + $self->exp("19$2-$1-01"); + } else { + $self->exp("20$2-$1-01"); + } + } else { + return "Illegal expiration date"; + } + } + + if ( $self->payname eq '' ) { + $self->payname( $self->first. " ". $self->getfield('last') ); + } else { + $self->payname =~ /^([\w \,\.\-\']+)$/ + or return "Illegal billing name"; + $self->payname($1); + } + + $self->zip =~ /^\s*(\w[\w\-\s]{3,8}\w)\s*$/ + or return "Illegal zip: ". $self->zip; + $self->zip($1); + + $self->country =~ /^(\w\w)$/ or return "Illegal \w\wy"; + $self->country($1); + + #check invnum, custnum, ? + + ''; #no error +} + +=back + +=head1 VERSION + +$Id: cust_pay_batch.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ + +=head1 BUGS + +There should probably be a configuration file with a list of allowed credit +card types. + +=head1 SEE ALSO + +L, L + +=cut + +1; + diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm new file mode 100644 index 000000000..c31340d2f --- /dev/null +++ b/FS/FS/cust_pkg.pm @@ -0,0 +1,518 @@ +package FS::cust_pkg; + +use strict; +use vars qw(@ISA); +use FS::UID qw( getotaker ); +use FS::Record qw( qsearch qsearchs ); +use FS::cust_svc; +use FS::part_pkg; +use FS::cust_main; +use FS::type_pkgs; + +# need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend, +# setup } +# because they load configuraion by setting FS::UID::callback (see TODO) +use FS::svc_acct; +use FS::svc_acct_sm; +use FS::svc_domain; + +@ISA = qw( FS::Record ); + +=head1 NAME + +FS::cust_pkg - Object methods for cust_pkg objects + +=head1 SYNOPSIS + + use FS::cust_pkg; + + $record = new FS::cust_pkg \%hash; + $record = new FS::cust_pkg { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + + $error = $record->cancel; + + $error = $record->suspend; + + $error = $record->unsuspend; + + $part_pkg = $record->part_pkg; + + @labels = $record->labels; + + $error = FS::cust_pkg::order( $custnum, \@pkgparts ); + $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] ); + +=head1 DESCRIPTION + +An FS::cust_pkg object represents a customer billing item. FS::cust_pkg +inherits from FS::Record. The following fields are currently supported: + +=over 4 + +=item pkgnum - primary key (assigned automatically for new billing items) + +=item custnum - Customer (see L) + +=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 new HASHREF + +Create a new billing item. To add the item to the database, see L<"insert">. + +=cut + +sub table { 'cust_pkg'; } + +=item insert + +Adds this billing item to the database ("Orders" the item). If there is an +error, returns the error, otherwise returns false. + +sub insert { + my $self = shift; + + # custnum might not have have been defined in sub check (for one-shot new + # customers), so check it here instead + + my $error = $self->ut_number('custnum'); + return $error if $error + + return "Unknown customer" + unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); + + $self->SUPER::insert; + +} + +=item delete + +Currently unimplemented. You don't want to delete billing items, because there +would then be no record the customer ever purchased the item. Instead, see +the cancel method. + +=cut + +sub delete { + return "Can't delete cust_pkg records!"; +} + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +Currently, custnum, setup, bill, susp, expire, and cancel may be changed. + +Changing pkgpart may have disasterous effects. See the order subroutine. + +setup and bill are normally updated by calling the bill method of a customer +object (see L). + +suspend is normally updated by the suspend and unsuspend methods. + +cancel is normally updated by the cancel method (and also the order subroutine +in some cases). + +=cut + +sub replace { + my( $new, $old ) = ( shift, shift ); + + #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart; + return "Can't change otaker!" if $old->otaker ne $new->otaker; + return "Can't change setup once it exists!" + if $old->getfield('setup') && + $old->getfield('setup') != $new->getfield('setup'); + #some logic for bill, susp, cancel? + + $new->SUPER::replace($old); +} + +=item check + +Checks all fields to make sure this is a valid billing item. If there is an +error, returns the error, otherwise returns false. Called by the insert and +replace methods. + +=cut + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('pkgnum') + || $self->ut_numbern('custnum') + || $self->ut_number('pkgpart') + || $self->ut_numbern('setup') + || $self->ut_numbern('bill') + || $self->ut_numbern('susp') + || $self->ut_numbern('cancel') + ; + return $error if $error; + + if ( $self->custnum ) { + return "Unknown customer" + unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); + } + + return "Unknown pkgpart" + unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } ); + + $self->otaker(getotaker) unless $self->otaker; + $self->otaker =~ /^(\w{0,16})$/ or return "Illegal otaker"; + $self->otaker($1); + + ''; #no error +} + +=item cancel + +Cancels and removes all services (see L 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 = shift; + my $error; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + foreach my $cust_svc ( + qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) + ) { + my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } ); + + $part_svc->svcdb =~ /^([\w\-]+)$/ + or return "Illegal svcdb value in part_svc!"; + my $svcdb = $1; + require "FS/$svcdb.pm"; + + my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } ); + if ($svc) { + $error = $svc->cancel; + return "Error cancelling service: $error" if $error; + $error = $svc->delete; + return "Error deleting service: $error" if $error; + } + + $error = $cust_svc->delete; + return "Error deleting cust_svc: $error" if $error; + + } + + unless ( $self->getfield('cancel') ) { + my %hash = $self->hash; + $hash{'cancel'} = time; + my $new = new FS::cust_pkg ( \%hash ); + $error = $new->replace($self); + return $error if $error; + } + + ''; #no errors +} + +=item suspend + +Suspends all services (see L 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 = shift; + my $error ; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + foreach my $cust_svc ( + qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) + ) { + my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } ); + + $part_svc->svcdb =~ /^([\w\-]+)$/ + or return "Illegal svcdb value in part_svc!"; + my $svcdb = $1; + require "FS/$svcdb.pm"; + + my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } ); + if ($svc) { + $error = $svc->suspend; + return $error if $error; + } + + } + + unless ( $self->getfield('susp') ) { + my %hash = $self->hash; + $hash{'susp'} = time; + my $new = new FS::cust_pkg ( \%hash ); + $error = $new->replace($self); + return $error if $error; + } + + ''; #no errors +} + +=item unsuspend + +Unsuspends all services (see L 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 = shift; + my($error); + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + foreach my $cust_svc ( + qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } ) + ) { + my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } ); + + $part_svc->svcdb =~ /^([\w\-]+)$/ + or return "Illegal svcdb value in part_svc!"; + my $svcdb = $1; + require "FS/$svcdb.pm"; + + my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } ); + if ($svc) { + $error = $svc->unsuspend; + return $error if $error; + } + + } + + unless ( ! $self->getfield('susp') ) { + my %hash = $self->hash; + $hash{'susp'} = ''; + my $new = new FS::cust_pkg ( \%hash ); + $error = $new->replace($self); + return $error if $error; + } + + ''; #no errors +} + +=item part_pkg + +Returns the definition for this billing item, as an FS::part_pkg object (see +L $self->pkgpart } ); +} + +=item labels + +Returns a list of lists, calling the label method for all services +(see L) of this billing item. + +=cut + +sub labels { + my $self = shift; + map { [ $_->label ] } qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } ); +} + +=back + +=head1 SUBROUTINES + +=over 4 + +=item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF ] + +CUSTNUM is a customer (see L) + +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)=@_; + + # generate %part_pkg + # $part_pkg{$pkgpart} is true iff $custnum may purchase $pkgpart + # + my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum}); + my($agent)=qsearchs('agent',{'agentnum'=> $cust_main->agentnum }); + my %part_pkg = %{ $agent->pkgpart_hashref }; + + my(%svcnum); + # generate %svcnum + # for those packages being removed: + #@{ $svcnum{$svcpart} } goes from a svcpart to a list of FS::Record + # objects (table eq 'cust_svc') + my($pkgnum); + foreach $pkgnum ( @{$remove_pkgnums} ) { + my($cust_svc); + foreach $cust_svc (qsearch('cust_svc',{'pkgnum'=>$pkgnum})) { + push @{ $svcnum{$cust_svc->getfield('svcpart')} }, $cust_svc; + } + } + + my(@cust_svc); + #generate @cust_svc + # for those packages the customer is purchasing: + # @{$pkgparts} is a list of said packages, by pkgpart + # @cust_svc is a corresponding list of lists of FS::Record objects + my($pkgpart); + foreach $pkgpart ( @{$pkgparts} ) { + return "Customer not permitted to purchase pkgpart $pkgpart!" + unless $part_pkg{$pkgpart}; + push @cust_svc, [ + map { + ( $svcnum{$_} && @{ $svcnum{$_} } ) ? shift @{ $svcnum{$_} } : (); + } (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'; + local $SIG{PIPE} = 'IGNORE'; + + #first cancel old packages +# my($pkgnum); + foreach $pkgnum ( @{$remove_pkgnums} ) { + my($old) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); + die "Package $pkgnum not found to remove!" unless $old; + my(%hash) = $old->hash; + $hash{'cancel'}=time; + my($new) = new FS::cust_pkg ( \%hash ); + my($error)=$new->replace($old); + die "Couldn't update package $pkgnum: $error" if $error; + } + + #now add new packages, changing cust_svc records if necessary +# my($pkgpart); + while ($pkgpart=shift @{$pkgparts} ) { + + my($new) = new FS::cust_pkg ( { + 'custnum' => $custnum, + 'pkgpart' => $pkgpart, + } ); + my($error) = $new->insert; + die "Couldn't insert new cust_pkg record: $error" if $error; + my($pkgnum)=$new->getfield('pkgnum'); + + my($cust_svc); + foreach $cust_svc ( @{ shift @cust_svc } ) { + my(%hash) = $cust_svc->hash; + $hash{'pkgnum'}=$pkgnum; + my($new) = new FS::cust_svc ( \%hash ); + my($error)=$new->replace($cust_svc); + die "Couldn't link old service to new package: $error" if $error; + } + } + + ''; #no errors +} + +=back + +=head1 VERSION + +$Id: cust_pkg.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ + +=head1 BUGS + +sub order is not OO. Perhaps it should be moved to FS::cust_main and made so? + +In sub order, the @pkgparts array (passed by reference) is clobbered. + +Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard +method to pass dates to the recur_prog expression, it should do so. + +FS::svc_acct, FS::svc_acct_sm, and FS::svc_domain are loaded via 'use' at +compile time, rather than via 'require' in sub { setup, suspend, unsuspend, +cancel } because they use %FS::UID::callback to load configuration values. +Probably need a subroutine which decides what to do based on whether or not +we've fetched the user yet, rather than a hash. See FS::UID and the TODO. + +=head1 SEE ALSO + +L, L, L, L +, L, schema.html from the base documentation + +=cut + +1; + diff --git a/FS/FS/cust_refund.pm b/FS/FS/cust_refund.pm new file mode 100644 index 000000000..65254aef4 --- /dev/null +++ b/FS/FS/cust_refund.pm @@ -0,0 +1,187 @@ +package FS::cust_refund; + +use strict; +use vars qw( @ISA ); +use Business::CreditCard; +use FS::Record qw( qsearchs ); +use FS::UID qw(getotaker); +use FS::cust_credit; + +@ISA = qw( FS::Record ); + +=head1 NAME + +FS::cust_refund - Object method for cust_refund objects + +=head1 SYNOPSIS + + use FS::cust_refund; + + $record = new FS::cust_refund \%hash; + $record = new FS::cust_refund { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cust_refund represents a refund. FS::cust_refund inherits from +FS::Record. The following fields are currently supported: + +=over 4 + +=item refundnum - primary key (assigned automatically for new refunds) + +=item crednum - Credit (see L) + +=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 new HASHREF + +Creates a new refund. To add the refund to the database, see L<"insert">. + +=cut + +sub table { 'cust_refund'; } + +=item insert + +Adds this refund to the database, and updates the credit (see +L). + +=cut + +sub insert { + my $self = shift; + + my $error; + + $error=$self->check; + return $error if $error; + + my $old_cust_credit = + qsearchs( 'cust_credit', { 'crednum' => $self->crednum } ); + return "Unknown crednum" unless $old_cust_credit; + my %hash = $old_cust_credit->hash; + $hash{credited} = sprintf("%.2f", $hash{credited} - $self->refund ); + my($new_cust_credit) = new FS::cust_credit ( \%hash ); + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + $error = $new_cust_credit->replace($old_cust_credit); + return "Error modifying cust_credit: $error" if $error; + + $self->SUPER::insert; +} + +=item delete + +Currently unimplemented (accounting reasons). + +=cut + +sub delete { + return "Can't (yet?) delete cust_refund records!"; +} + +=item replace OLD_RECORD + +Currently unimplemented (accounting reasons). + +=cut + +sub replace { + return "Can't (yet?) modify cust_refund records!"; +} + +=item check + +Checks all fields to make sure this is a valid refund. If there is an error, +returns the error, otherwise returns false. Called by the insert method. + +=cut + +sub check { + my $self = shift; + + my $error; + + $error = + $self->ut_number('refundnum') + || $self->ut_number('crednum') + || $self->ut_money('amount') + || $self->ut_numbern('_date') + ; + return $error if $error; + + $self->_date(time) unless $self->_date; + + $self->payby =~ /^(CARD|BILL|COMP)$/ or return "Illegal payby"; + $self->payby($1); + + if ( $self->payby eq 'CARD' ) { + my $payinfo = $self->payinfo; + $self->payinfo($payinfo =~ s/\D//g); + if ( $self->payinfo ) { + $self->payinfo =~ /^(\d{13,16})$/ + or return "Illegal (mistyped?) credit card number (payinfo)"; + $self->payinfo($1); + validate($self->payinfo) or return "Illegal credit card number"; + return "Unknown card type" if cardtype($self->payinfo) eq "Unknown"; + } else { + $self->payinfo('N/A'); + } + + } else { + $error = $self->ut_textn('payinfo'); + return $error if $error; + } + + $self->otaker(getotaker); + + ''; #no error +} + +=back + +=head1 VERSION + +$Id: cust_refund.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ + +=head1 BUGS + +Delete and replace methods. + +=head1 SEE ALSO + +L, L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm new file mode 100644 index 000000000..cbc4d91fa --- /dev/null +++ b/FS/FS/cust_svc.pm @@ -0,0 +1,167 @@ +package FS::cust_svc; + +use strict; +use vars qw( @ISA ); +use Carp qw( cluck ); +use FS::Record qw( qsearchs ); +use FS::cust_pkg; +use FS::part_pkg; +use FS::part_svc; +use FS::svc_acct; +use FS::svc_acct_sm; +use FS::svc_domain; + +@ISA = qw( FS::Record ); + +=head1 NAME + +FS::cust_svc - Object method for cust_svc objects + +=head1 SYNOPSIS + + use FS::cust_svc; + + $record = new FS::cust_svc \%hash + $record = new FS::cust_svc { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + + ($label, $value) = $record->label; + +=head1 DESCRIPTION + +An FS::cust_svc represents a service. FS::cust_svc inherits from FS::Record. +The following fields are currently supported: + +=over 4 + +=item svcnum - primary key (assigned automatically for new services) + +=item pkgnum - Package (see L) + +=item svcpart - Service definition (see L) + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new service. To add the refund to the database, see L<"insert">. +Services are normally created by creating FS::svc_ objects (see +L, L, and L, among others). + +=cut + +sub table { 'cust_svc'; } + +=item insert + +Adds this service to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete + +Deletes this service from the database. If there is an error, returns the +error, otherwise returns false. + +Called by the cancel method of the package (see L). + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=item check + +Checks all fields to make sure this is a valid service. If there is an error, +returns the error, otehrwise returns false. Called by the insert and +replace methods. + +=cut + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('svcnum') + || $self->ut_numbern('pkgnum') + || $self->ut_number('svcpart') + ; + return $error if $error; + + return "Unknown pkgnum" + unless ! $self->pkgnum + || qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } ); + + return "Unknown svcpart" unless + qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); + + ''; #no error +} + +=item label + +Returns a list consisting of: +- The name of this service (from part_svc) +- A meaningful identifier (username, domain, or mail alias) +- The table name (i.e. svc_domain) for this service + +=cut + +sub label { + my $self = shift; + my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); + my $svcdb = $part_svc->svcdb; + my $svc_x = qsearchs( $svcdb, { 'svcnum' => $self->svcnum } ); + my $svc = $part_svc->svc; + my $tag; + if ( $svcdb eq 'svc_acct' ) { + $tag = $svc_x->getfield('username'); + } elsif ( $svcdb eq 'svc_acct_sm' ) { + my $domuser = $svc_x->domuser eq '*' ? '(anything)' : $svc_x->domuser; + my $svc_domain = qsearchs ( 'svc_domain', { 'svcnum' => $svc_x->domsvc } ); + my $domain = $svc_domain->domain; + $tag = "$domuser\@$domain"; + } elsif ( $svcdb eq 'svc_domain' ) { + $tag = $svc_x->getfield('domain'); + } else { + cluck "warning: asked for label of unsupported svcdb; using svcnum"; + $tag = $svc_x->getfield('svcnum'); + } + $svc, $tag, $svcdb; +} + +=back + +=head1 VERSION + +$Id: cust_svc.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ + +=head1 BUGS + +Behaviour of changing the svcpart of cust_svc records is undefined and should +possibly be prohibited, and pkg_svc records are not checked. + +pkg_svc records are not checked in general (here). + +Deleting this record doesn't check or delete the svc_* record associated +with this record. + +=head1 SEE ALSO + +L, L, L, L, +schema.html from the base documentation + +=cut + +1; + diff --git a/FS/FS/dbdef.pm b/FS/FS/dbdef.pm new file mode 100644 index 000000000..b737fd53a --- /dev/null +++ b/FS/FS/dbdef.pm @@ -0,0 +1,140 @@ +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, + +=cut + +1; + diff --git a/FS/FS/dbdef_colgroup.pm b/FS/FS/dbdef_colgroup.pm new file mode 100644 index 000000000..c25b07ada --- /dev/null +++ b/FS/FS/dbdef_colgroup.pm @@ -0,0 +1,95 @@ +package FS::dbdef_colgroup; + +use strict; +use vars qw(@ISA); +use Exporter; + +@ISA = qw(Exporter); + +=head1 NAME + +FS::dbdef_colgroup - Column group objects + +=head1 SYNOPSIS + + use FS::dbdef_colgroup; + + $colgroup = new FS::dbdef_colgroup ( $lol ); + $colgroup = new FS::dbdef_colgroup ( + [ + [ 'single_column' ], + [ 'multiple_columns', 'another_column', ], + ] + ); + + @sql_lists = $colgroup->sql_list; + + @singles = $colgroup->singles; + +=head1 DESCRIPTION + +FS::dbdef_colgroup objects represent sets of sets of columns. + +=head1 METHODS + +=over 4 + +=item new + +Creates a new FS::dbdef_colgroup object. + +=cut + +sub new { + my($proto, $lol) = @_; + + my $class = ref($proto) || $proto; + my $self = { + 'lol' => $lol, + }; + + bless ($self, $class); + +} + +=item sql_list + +Returns a flat list of comma-separated values, for SQL statements. + +=cut + +sub sql_list { #returns a flat list of comman-separates lists (for sql) + my($self)=@_; + grep $_ ne '', map join(', ', @{$_}), @{$self->{'lol'}}; +} + +=item singles + +Returns a flat list of all single item lists. + +=cut + +sub singles { #returns single-field groups as a flat list + my($self)=@_; + #map ${$_}[0], grep scalar(@{$_}) == 1, @{$self->{'lol'}}; + map { + ${$_}[0] =~ /^(\w+)$/ + #aah! + or die "Illegal column ", ${$_}[0], " in colgroup!"; + $1; + } grep scalar(@{$_}) == 1, @{$self->{'lol'}}; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, L, L, +L, L, L + +=cut + +1; + diff --git a/FS/FS/dbdef_column.pm b/FS/FS/dbdef_column.pm new file mode 100644 index 000000000..e784e8495 --- /dev/null +++ b/FS/FS/dbdef_column.pm @@ -0,0 +1,174 @@ +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 or L, will use +engine-specific syntax. + +=cut + +sub line { + my($self,$datasrc)=@_; + my($null)=$self->null; + if ( $datasrc =~ /mysql/ ) { #yucky mysql hack + $null ||= "NOT NULL" + } + if ( $datasrc =~ /Pg/ ) { #yucky Pg hack + $null ||= "NOT NULL"; + $null =~ s/^NULL$//; + } + join(' ', + $self->name, + $self->type. ( $self->length ? '('.$self->length.')' : '' ), + $null, + ); +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, L, L + +=head1 VERSION + +$Id: dbdef_column.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ + +=cut + +1; + diff --git a/FS/FS/dbdef_index.pm b/FS/FS/dbdef_index.pm new file mode 100644 index 000000000..49bf51dd9 --- /dev/null +++ b/FS/FS/dbdef_index.pm @@ -0,0 +1,35 @@ +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 + +=cut + +1; + diff --git a/FS/FS/dbdef_table.pm b/FS/FS/dbdef_table.pm new file mode 100644 index 000000000..4b6d6619a --- /dev/null +++ b/FS/FS/dbdef_table.pm @@ -0,0 +1,235 @@ +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) = $self->name. "__". $_ . "_index"; + $index =~ s/,\s*/_/g; + "CREATE UNIQUE INDEX $index ON ". $self->name. " ($_)" + } $self->unique->sql_list ), + ( map { + my($index) = $self->name. "__". $_ . "_index"; + $index =~ s/,\s*/_/g; + "CREATE INDEX $index ON ". $self->name. " ($_)" + } $self->index->sql_list ), + ; + + +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, L, L, L, +L + +=head1 VERSION + +$Id: dbdef_table.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ + +=cut + +1; + diff --git a/FS/FS/dbdef_unique.pm b/FS/FS/dbdef_unique.pm new file mode 100644 index 000000000..fa28d585d --- /dev/null +++ b/FS/FS/dbdef_unique.pm @@ -0,0 +1,36 @@ +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 + +=cut + +1; + + diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm new file mode 100644 index 000000000..863e962bb --- /dev/null +++ b/FS/FS/part_pkg.pm @@ -0,0 +1,186 @@ +package FS::part_pkg; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearch ); +use FS::pkg_svc; + +@ISA = qw( FS::Record ); + +=head1 NAME + +FS::part_pkg - Object methods for part_pkg objects + +=head1 SYNOPSIS + + use FS::part_pkg; + + $record = new FS::part_pkg \%hash + $record = new FS::part_pkg { 'column' => 'value' }; + + $custom_record = $template_record->clone; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + + @pkg_svc = $record->pkg_svc; + + $svcnum = $record->svcpart; + $svcnum = $record->svcpart( 'svc_acct' ); + +=head1 DESCRIPTION + +An FS::part_pkg object represents a billing item definition. FS::part_pkg +inherits from FS::Record. The following fields are currently supported: + +=over 4 + +=item pkgpart - primary key (assigned automatically for new billing item definitions) + +=item pkg - Text name of this billing item definition (customer-viewable) + +=item comment - Text name of this billing item definition (non-customer-viewable) + +=item setup - Setup fee + +=item freq - Frequency of recurring fee + +=item recur - Recurring fee + +=back + +setup and recur are evaluated as Safe perl expressions. You can use numbers +just as you would normally. More advanced semantics are not yet defined. + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new billing item definition. To add the billing item definition to +the database, see L<"insert">. + +=cut + +sub table { 'part_pkg'; } + +=item clone + +An alternate constructor. Creates a new billing item definition by duplicating +an existing definition. A new pkgpart is assigned and `(CUSTOM) ' is prepended +to the comment field. To add the billing item definition to the database, see +L<"insert">. + +=cut + +sub clone { + my $self = shift; + my $class = ref($self); + my %hash = $self->hash; + $hash{'pkgpart'} = ''; + $hash{'comment'} = "(CUSTOM) ". $hash{'comment'} + unless $hash{'comment'} =~ /^\(CUSTOM\) /; + #new FS::part_pkg ( \%hash ); # ? + new $class ( \%hash ); # ? +} + +=item insert + +Adds this billing item definition to the database. If there is an error, +returns the error, otherwise returns false. + +=item delete + +Currently unimplemented. + +=cut + +sub delete { + return "Can't (yet?) delete package definitions."; +# check & make sure the pkgpart isn't in cust_pkg or type_pkgs? +} + +=item replace OLD_RECORD + +Replaces OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=item check + +Checks all fields to make sure this is a valid billing item definition. If +there is an error, returns the error, otherwise returns false. Called by the +insert and replace methods. + +=cut + +sub check { + my $self = shift; + + $self->ut_numbern('pkgpart') + || $self->ut_text('pkg') + || $self->ut_text('comment') + || $self->ut_anything('setup') + || $self->ut_number('freq') + || $self->ut_anything('recur') + ; +} + +=item pkg_svc + +Returns all FS::pkg_svc objects (see L) for this package +definition. + +=cut + +sub pkg_svc { + my $self = shift; + qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } ); +} + +=item svcpart [ SVCDB ] + +Returns the svcpart of a single service definition (see L) +associated with this billing item definition (see L). Returns +false if there not exactly one service definition with quantity 1, or if +SVCDB is specified and does not match the svcdb of the service definition, + +=cut + +sub svcpart { + my $self = shift; + my $svcdb = shift; + my @pkg_svc = $self->pkg_svc; + return '' if scalar(@pkg_svc) != 1 + || $pkg_svc[0]->quantity != 1 + || ( $svcdb && $pkg_svc[0]->part_svc->svcdb ne $svcdb ); + $pkg_svc[0]->svcpart; +} + +=back + +=head1 VERSION + +$Id: part_pkg.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ + +=head1 BUGS + +The delete method is unimplemented. + +setup and recur semantics are not yet defined (and are implemented in +FS::cust_bill. hmm.). + +=head1 SEE ALSO + +L, L, L, L, L. +schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/part_referral.pm b/FS/FS/part_referral.pm new file mode 100644 index 000000000..3f0af4b8e --- /dev/null +++ b/FS/FS/part_referral.pm @@ -0,0 +1,110 @@ +package FS::part_referral; + +use strict; +use vars qw( @ISA ); +use FS::Record; + +@ISA = qw( FS::Record ); + +=head1 NAME + +FS::part_referral - Object methods for part_referral objects + +=head1 SYNOPSIS + + use FS::part_referral; + + $record = new FS::part_referral \%hash + $record = new FS::part_referral { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::part_referral represents a referral - where a customer heard of your +services. This can be used to track the effectiveness of a particular piece of +advertising, for example. FS::part_referral inherits from FS::Record. The +following fields are currently supported: + +=over 4 + +=item refnum - primary key (assigned automatically for new referrals) + +=item referral - Text name of this referral + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new referral. To add the referral to the database, see L<"insert">. + +=cut + +sub table { 'part_referral'; } + +=item insert + +Adds this referral to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete + +Currently unimplemented. + +=cut + +sub delete { + my $self = shift; + return "Can't (yet?) delete part_referral records"; + #need to make sure no customers have this referral! +} + +=item replace OLD_RECORD + +Replaces OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=item check + +Checks all fields to make sure this is a valid referral. If there is an error, +returns the error, otherwise returns false. Called by the insert and replace +methods. + +=cut + +sub check { + my $self = shift; + + $self->ut_numbern('refnum') + || $self->ut_text('referral') + ; +} + +=back + +=head1 VERSION + +$Id: part_referral.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ + +=head1 BUGS + +The delete method is unimplemented. + +=head1 SEE ALSO + +L, L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/part_svc.pm b/FS/FS/part_svc.pm new file mode 100644 index 000000000..01487b75f --- /dev/null +++ b/FS/FS/part_svc.pm @@ -0,0 +1,165 @@ +package FS::part_svc; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( fields ); + +@ISA = qw(FS::Record); + +=head1 NAME + +FS::part_svc - Object methods for part_svc objects + +=head1 SYNOPSIS + + use FS::part_svc; + + $record = new FS::part_referral \%hash + $record = new FS::part_referral { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::part_svc represents a service definition. FS::part_svc inherits from +FS::Record. The following fields are currently supported: + +=over 4 + +=item svcpart - primary key (assigned automatically for new service definitions) + +=item svc - text name of this service definition + +=item svcdb - table used for this service. See L, +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 new HASHREF + +Creates a new service definition. To add the service definition to the +database, see L<"insert">. + +=cut + +sub table { 'part_svc'; } + +=item insert + +Adds this service definition to the database. If there is an error, returns +the error, otherwise returns false. + +=item delete + +Currently unimplemented. + +=cut + +sub delete { + return "Can't (yet?) delete service definitions."; +# check & make sure the svcpart isn't in cust_svc or pkg_svc (in any packages)? +} + +=item replace OLD_RECORD + +Replaces OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +sub replace { + my ( $new, $old ) = ( shift, shift ); + + return "Can't change svcdb!" + unless $old->svcdb eq $new->svcdb; + + $new->SUPER::replace( $old ); +} + +=item check + +Checks all fields to make sure this is a valid service definition. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +sub check { + my $self = shift; + my $recref = $self->hashref; + + my $error; + $error= + $self->ut_numbern('svcpart') + || $self->ut_text('svc') + || $self->ut_alpha('svcdb') + ; + return $error if $error; + + my @fields = eval { fields( $recref->{svcdb} ) }; #might die + return "Unknown svcdb!" unless @fields; + + my $svcdb; + foreach $svcdb ( qw( + svc_acct svc_acct_sm svc_domain + ) ) { + my @rows = map { /^${svcdb}__(.*)$/; $1 } + grep ! /_flag$/, + grep /^${svcdb}__/, + fields('part_svc'); + foreach my $row (@rows) { + unless ( $svcdb eq $recref->{svcdb} ) { + $recref->{$svcdb.'__'.$row}=''; + $recref->{$svcdb.'__'.$row.'_flag'}=''; + next; + } + $recref->{$svcdb.'__'.$row.'_flag'} =~ /^([DF]?)$/ + or return "Illegal flag for $svcdb $row"; + $recref->{$svcdb.'__'.$row.'_flag'} = $1; + + my $error = $self->ut_anything($svcdb.'__'.$row); + return $error if $error; + + } + } + + ''; #no error +} + +=back + +=head1 VERSION + +$Id: part_svc.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ + +=head1 BUGS + +Delete is unimplemented. + +The list of svc_* tables is hardcoded. When svc_acct_pop is renamed, this +should be fixed. + +=head1 SEE ALSO + +L, L, L, L, +L, L, L, schema.html from the +base documentation. + +=cut + +1; + diff --git a/FS/FS/pkg_svc.pm b/FS/FS/pkg_svc.pm new file mode 100644 index 000000000..1812dbf29 --- /dev/null +++ b/FS/FS/pkg_svc.pm @@ -0,0 +1,152 @@ +package FS::pkg_svc; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearchs ); +use FS::part_pkg; +use FS::part_svc; + +@ISA = qw( FS::Record ); + +=head1 NAME + +FS::pkg_svc - Object methods for pkg_svc records + +=head1 SYNOPSIS + + use FS::pkg_svc; + + $record = new FS::pkg_svc \%hash; + $record = new FS::pkg_svc { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + + $part_pkg = $record->part_pkg; + + $part_svc = $record->part_svc; + +=head1 DESCRIPTION + +An FS::pkg_svc record links a billing item definition (see L) 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 new HASHREF + +Create a new record. To add the record to the database, see L<"insert">. + +=cut + +sub table { 'pkg_svc'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete + +Deletes this record from the database. If there is an error, returns the +error, otherwise returns false. + +=item replace OLD_RECORD + +Replaces OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +sub replace { + my ( $new, $old ) = ( shift, shift ); + + return "Can't change pkgpart!" if $old->pkgpart != $new->pkgpart; + return "Can't change svcpart!" if $old->svcpart != $new->svcpart; + + $new->SUPER::replace($old); +} + +=item check + +Checks all fields to make sure this is a valid record. If there is an error, +returns the error, otherwise returns false. Called by the insert and replace +methods. + +=cut + +sub check { + my $self = shift; + + my $error; + $error = + $self->ut_number('pkgpart') + || $self->ut_number('svcpart') + || $self->ut_number('quantity') + ; + return $error if $error; + + return "Unknown pkgpart!" unless $self->part_pkg; + return "Unknown svcpart!" unless $self->part_svc; + + ''; #no error +} + +=item part_pkg + +Returns the FS::part_pkg object (see L). + +=cut + +sub part_pkg { + my $self = shift; + qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } ); +} + +=item part_svc + +Returns the FS::part_svc object (see L). + +=cut + +sub part_svc { + my $self = shift; + qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); +} + +=back + +=head1 VERSION + +$Id: pkg_svc.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ + +=head1 BUGS + +=head1 SEE ALSO + +L, L, L, schema.html from the base +documentation. + +=cut + +1; + diff --git a/FS/FS/svc_Common.pm b/FS/FS/svc_Common.pm new file mode 100644 index 000000000..5bea5b0ce --- /dev/null +++ b/FS/FS/svc_Common.pm @@ -0,0 +1,204 @@ +package FS::svc_Common; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearchs fields ); +use FS::cust_svc; +use FS::part_svc; + +@ISA = qw( FS::Record ); + +=head1 NAME + +FS::svc_Common - Object method for all svc_ records + +=head1 SYNOPSIS + +use FS::svc_Common; + +@ISA = qw( FS::svc_Common ); + +=head1 DESCRIPTION + +FS::svc_Common is intended as a base class for table-specific classes to +inherit from, i.e. FS::svc_acct. FS::svc_Common inherits from FS::Record. + +=head1 METHODS + +=over 4 + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +The additional fields pkgnum and svcpart (see L) should be +defined. An FS::cust_svc record will be created and inserted. + +=cut + +sub insert { + my $self = shift; + my $error; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + $error = $self->check; + return $error if $error; + + my $svcnum = $self->svcnum; + my $cust_svc; + unless ( $svcnum ) { + $cust_svc = new FS::cust_svc ( { + 'svcnum' => $svcnum, + 'pkgnum' => $self->pkgnum, + 'svcpart' => $self->svcpart, + } ); + $error = $cust_svc->insert; + return $error if $error; + $svcnum = $self->svcnum($cust_svc->svcnum); + } + + $error = $self->SUPER::insert; + if ( $error ) { + $cust_svc->delete if $cust_svc; + return $error; + } + + ''; +} + +=item delete + +Deletes this account from the database. If there is an error, returns the +error, otherwise returns false. + +The corresponding FS::cust_svc record will be deleted as well. + +=cut + +sub delete { + my $self = shift; + my $error; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $svcnum = $self->svcnum; + + $error = $self->SUPER::delete; + return $error if $error; + + my $cust_svc = qsearchs( 'cust_svc' , { 'svcnum' => $svcnum } ); + $error = $cust_svc->delete; + return $error if $error; + + ''; +} + +=item setfixed + +Sets any fixed fields for this service (see L). If there is an +error, returns the error, otherwise returns the FS::part_svc object (use ref() +to test the return). Usually called by the check method. + +=cut + +sub setfixed { + my $self = shift; + $self->setx('F'); +} + +=item setdefault + +Sets all fields to their defaults (see L), overriding their +current values. If there is an error, returns the error, otherwise returns +the FS::part_svc object (use ref() to test the return). + +=cut + +sub setdefault { + my $self = shift; + $self->setx('D'); +} + +sub setx { + my $self = shift; + my $x = shift; + + my $error; + + $error = + $self->ut_numbern('svcnum') + ; + return $error if $error; + + #get part_svc + my $svcpart; + if ( $self->svcnum ) { + my $cust_svc = qsearchs( 'cust_svc', { 'svcnum' => $self->svcnum } ); + return "Unknown svcnum" unless $cust_svc; + $svcpart = $cust_svc->svcpart; + } else { + $svcpart = $self->getfield('svcpart'); + } + my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $svcpart } ); + return "Unkonwn svcpart" unless $part_svc; + + #set default/fixed/whatever fields from part_svc + foreach my $field ( fields('svc_acct') ) { + if ( $part_svc->getfield('svc_acct__'. $field. '_flag') eq $x ) { + $self->setfield( $field, $part_svc->getfield('svc_acct__'. $field) ); + } + } + + $part_svc; + +} + +=item suspend + +=item unsuspend + +=item cancel + +Stubs - return false (no error) so derived classes don't need to define these +methods. Called by the cancel method of FS::cust_pkg (see L). + +=cut + +sub suspend { ''; } +sub unsuspend { ''; } +sub cancel { ''; } + +=back + +=head1 VERSION + +$Id: svc_Common.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ + +=head1 BUGS + +The setfixed method return value. + +The new method should set defaults from part_svc (like the check method +sets fixed values)? + +=head1 SEE ALSO + +L, L, L, L, schema.html +from the base documentation. + +=cut + +1; + diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm new file mode 100644 index 000000000..b2f23c933 --- /dev/null +++ b/FS/FS/svc_acct.pm @@ -0,0 +1,468 @@ +package FS::svc_acct; + +use strict; +use vars qw(@ISA $nossh_hack $conf $dir_prefix @shells + $shellmachine @saltset @pw_set); +use FS::Conf; +use FS::Record qw( qsearchs fields ); +use FS::svc_Common; +use FS::SSH qw(ssh); +use FS::part_svc; +use FS::svc_acct_pop; + +@ISA = qw( FS::svc_Common ); + +#ask FS::UID to run this stuff for us later +$FS::UID::callback{'FS::svc_acct'} = sub { + $conf = new FS::Conf; + $dir_prefix = $conf->config('home'); + @shells = $conf->config('shells'); + $shellmachine = $conf->config('shellmachine'); +}; + +@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); +@pw_set = ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '!', '.', ',' ); + +#not needed in 5.004 #srand($$|time); + +=head1 NAME + +FS::svc_acct - Object methods for svc_acct records + +=head1 SYNOPSIS + + use FS::svc_acct; + + $record = new FS::svc_acct \%hash; + $record = new FS::svc_acct { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + + $error = $record->suspend; + + $error = $record->unsuspend; + + $error = $record->cancel; + +=head1 DESCRIPTION + +An FS::svc_acct object represents an account. FS::svc_acct inherits from +FS::svc_Common. The following fields are currently supported: + +=over 4 + +=item svcnum - primary key (assigned automatcially for new accounts) + +=item username + +=item _password - generated if blank + +=item popnum - Point of presence (see L) + +=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 new HASHREF + +Creates a new account. To add the account to the database, see L<"insert">. + +=cut + +sub table { 'svc_acct'; } + +=item insert + +Adds this account to the database. If there is an error, returns the error, +otherwise returns false. + +The additional fields pkgnum and svcpart (see L) 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 = shift; + my $error; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + $error = $self->check; + return $error if $error; + + return "Username ". $self->username. " in use" + if qsearchs( 'svc_acct', { 'username' => $self->username } ); + + my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); + return "Unkonwn svcpart" unless $part_svc; + return "uid in use" + if $part_svc->svc_acct__uid_flag ne 'F' + && qsearchs( 'svc_acct', { 'uid' => $self->uid } ) + && $self->username !~ /^(hyla)?fax$/ + ; + + $error = $self->SUPER::insert; + return $error if $error; + + my ( $username, $uid, $dir, $shell ) = ( + $self->username, + $self->uid, + $self->dir, + $self->shell, + ); + if ( $username + && $uid + && $dir + && $shellmachine + && ! $nossh_hack ) { + #one way + ssh("root\@$shellmachine", + "useradd -d $dir -m -s $shell -u $uid $username" + ); + #another way + #ssh("root\@$shellmachine","/bin/mkdir $dir; /bin/chmod 711 $dir; ". + # "/bin/cp -p /etc/skel/.* $dir 2>/dev/null; ". + # "/bin/cp -pR /etc/skel/Maildir $dir 2>/dev/null; ". + # "/bin/chown -R $uid $dir") unless $nossh_hack; + } + + ''; #no error +} + +=item delete + +Deletes this account from the database. If there is an error, returns the +error, otherwise returns false. + +The corresponding FS::cust_svc record will be deleted as well. + +If the configuration value (see L) shellmachine exists, the command: + + userdel $username + +is executed on shellmachine via ssh. This behaviour can be surpressed by +setting $FS::svc_acct::nossh_hack true. + +=cut + +sub delete { + my $self = shift; + my $error; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + $error = $self->SUPER::delete; + return $error if $error; + + my $username = $self->username; + if ( $username && $shellmachine && ! $nossh_hack ) { + ssh("root\@$shellmachine","userdel $username"); + } + + ''; +} + +=item replace OLD_RECORD + +Replaces OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +If the configuration value (see L) shellmachine exists, and the +dir field has changed, the command: + + [ -d $old_dir ] && ( + chmod u+t $old_dir; + umask 022; + mkdir $new_dir; + cd $old_dir; + find . -depth -print | cpio -pdm $new_dir; + chmod u-t $new_dir; + chown -R $uid.$gid $new_dir; + rm -rf $old_dir + ) + +is executed on shellmachine via ssh. This behaviour can be surpressed by +setting $FS::svc_acct::nossh_hack true. + +=cut + +sub replace { + my ( $new, $old ) = ( shift, shift ); + my $error; + + return "Username in use" + if $old->username ne $new->username && + qsearchs( 'svc_acct', { 'username' => $new->username } ); + + return "Can't change uid!" if $old->uid != $new->uid; + + #change homdir when we change username + $new->setfield('dir', '') if $old->username ne $new->username; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + $error = $new->SUPER::replace($old); + return $error if $error; + + my ( $old_dir, $new_dir ) = ( $old->getfield('dir'), $new->getfield('dir') ); + my ( $uid, $gid) = ( $new->getfield('uid'), $new->getfield('gid') ); + if ( $old_dir + && $new_dir + && $old_dir ne $new_dir + && ! $nossh_hack + ) { + ssh("root\@$shellmachine","[ -d $old_dir ] && ". + "( chmod u+t $old_dir; ". #turn off qmail delivery + "umask 022; mkdir $new_dir; cd $old_dir; ". + "find . -depth -print | cpio -pdm $new_dir; ". + "chmod u-t $new_dir; chown -R $uid.$gid $new_dir; ". + "rm -rf $old_dir". + ")" + ); + } + + ''; #no error +} + +=item suspend + +Suspends this account by prefixing *SUSPENDED* to the password. If there is an +error, returns the error, otherwise returns false. + +Called by the suspend method of FS::cust_pkg (see L). + +=cut + +sub suspend { + my $self = shift; + my %hash = $self->hash; + unless ( $hash{_password} =~ /^\*SUSPENDED\* / ) { + $hash{_password} = '*SUSPENDED* '.$hash{_password}; + my $new = new FS::svc_acct ( \%hash ); + $new->replace($self); + } else { + ''; #no error (already suspended) + } +} + +=item unsuspend + +Unsuspends this account by removing *SUSPENDED* from the password. If there is +an error, returns the error, otherwise returns false. + +Called by the unsuspend method of FS::cust_pkg (see L). + +=cut + +sub unsuspend { + my $self = shift; + my %hash = $self->hash; + if ( $hash{_password} =~ /^\*SUSPENDED\* (.*)$/ ) { + $hash{_password} = $1; + my $new = new FS::svc_acct ( \%hash ); + $new->replace($self); + } else { + ''; #no error (already unsuspended) + } +} + +=item cancel + +Just returns false (no error) for now. + +Called by the cancel method of FS::cust_pkg (see L). + +=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 = shift; + + my($recref) = $self->hashref; + + my $x = $self->setfixed; + return $x unless ref($x); + my $part_svc = $x; + + 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. "\'; ". + $conf->dir. "/shells contains: @shells"; + } + } else { + $recref->{shell} = '/bin/sync'; + } + + $recref->{quota} =~ /^(\d*)$/ or return "Illegal quota (unimplemented)"; + $recref->{quota} = $1; + + } else { + $recref->{gid} ne '' ? + return "Can't have gid without uid" : ( $recref->{gid}='' ); + $recref->{finger} ne '' ? + return "Can't have finger-name without uid" : ( $recref->{finger}='' ); + $recref->{dir} ne '' ? + return "Can't have directory without uid" : ( $recref->{dir}='' ); + $recref->{shell} ne '' ? + return "Can't have shell without uid" : ( $recref->{shell}='' ); + $recref->{quota} ne '' ? + return "Can't have quota without uid" : ( $recref->{quota}='' ); + } + + unless ( $part_svc->getfield('svc_acct__slipip_flag') eq 'F' ) { + unless ( $recref->{slipip} eq '0e0' ) { + $recref->{slipip} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/ + or return "Illegal slipip". $self->slipip; + $recref->{slipip} = $1; + } else { + $recref->{slipip} = '0e0'; + } + + } + + #arbitrary RADIUS stuff; allow ut_textn for now + foreach ( grep /^radius_/, fields('svc_acct') ) { + $self->ut_textn($_); + } + + #generate a password if it is blank + $recref->{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) ) + unless ( $recref->{_password} ); + + #if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,16})$/ ) { + if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{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 VERSION + +$Id: svc_acct.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ + +=head1 BUGS + +The remote commands should be configurable. + +The bits which ssh should fork before doing so. + +The $recref stuff in sub check should be cleaned up. + +=head1 SEE ALSO + +L, L, L, L, +L, L, L, L, L, +schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/svc_acct_pop.pm b/FS/FS/svc_acct_pop.pm new file mode 100644 index 000000000..a64adb25a --- /dev/null +++ b/FS/FS/svc_acct_pop.pm @@ -0,0 +1,111 @@ +package FS::svc_acct_pop; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearchs ); + +@ISA = qw( FS::Record ); + +=head1 NAME + +FS::svc_acct_pop - Object methods for svc_acct_pop records + +=head1 SYNOPSIS + + use FS::svc_acct_pop; + + $record = new FS::svc_acct_pop \%hash; + $record = new FS::svc_acct_pop { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::svc_acct object represents an point of presence. FS::svc_acct_pop +inherits from FS::Record. The following fields are currently supported: + +=over 4 + +=item popnum - primary key (assigned automatically for new accounts) + +=item city + +=item state + +=item ac - area code + +=item exch - exchange + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new point of presence (if only it were that easy!). To add the +point of presence to the database, see L<"insert">. + +=cut + +sub table { 'svc_acct_pop'; } + +=item insert + +Adds this point of presence to the database. If there is an error, returns the +error, otherwise returns false. + +=item delete + +Removes this point of presence from the database. + +=item replace OLD_RECORD + +Replaces OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=item check + +Checks all fields to make sure this is a valid point of presence. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +sub check { + my $self = shift; + + $self->ut_numbern('popnum') + or $self->ut_text('city') + or $self->ut_text('state') + or $self->ut_number('ac') + or $self->ut_number('exch') + ; + +} + +=back + +=head1 VERSION + +$Id: svc_acct_pop.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ + +=head1 BUGS + +It should be renamed to part_pop. + +=head1 SEE ALSO + +L, L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/svc_acct_sm.pm b/FS/FS/svc_acct_sm.pm new file mode 100644 index 000000000..96bc3a27b --- /dev/null +++ b/FS/FS/svc_acct_sm.pm @@ -0,0 +1,252 @@ +package FS::svc_acct_sm; + +use strict; +use vars qw( @ISA $nossh_hack $conf $shellmachine @qmailmachines ); +use FS::Record qw( fields qsearch qsearchs ); +use FS::svc_Common; +use FS::cust_svc; +use FS::SSH qw(ssh); +use FS::Conf; +use FS::svc_acct; +use FS::svc_domain; + +@ISA = qw( FS::svc_Common ); + +#ask FS::UID to run this stuff for us later +$FS::UID::callback{'FS::svc_acct_sm'} = sub { + $conf = new FS::Conf; + $shellmachine = $conf->exists('qmailmachines') + ? $conf->config('shellmachine') + : ''; +}; + +=head1 NAME + +FS::svc_acct_sm - Object methods for svc_acct_sm records + +=head1 SYNOPSIS + + use FS::svc_acct_sm; + + $record = new FS::svc_acct_sm \%hash; + $record = new FS::svc_acct_sm { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + + $error = $record->suspend; + + $error = $record->unsuspend; + + $error = $record->cancel; + +=head1 DESCRIPTION + +An FS::svc_acct object represents a virtual mail alias. FS::svc_acct inherits +from FS::Record. The following fields are currently supported: + +=over 4 + +=item svcnum - primary key (assigned automatcially for new accounts) + +=item domsvc - svcnum of the virtual domain (see L) + +=item domuid - uid of the target account (see L) + +=item domuser - virtual username + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new virtual mail alias. To add the virtual mail alias to the +database, see L<"insert">. + +=cut + +sub table { 'svc_acct_sm'; } + +=item insert + +Adds this virtual mail alias to the database. If there is an error, returns +the error, otherwise returns false. + +The additional fields pkgnum and svcpart (see L) 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 = shift; + my $error; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + $error=$self->check; + return $error if $error; + + return "Domain username (domuser) in use for this domain (domsvc)" + if qsearchs('svc_acct_sm',{ 'domuser'=> $self->domuser, + 'domsvc' => $self->domsvc, + } ); + + return "First domain username (domuser) for domain (domsvc) must be " . + qq='*' (catch-all)!= + if $self->domuser ne '*' && + ! qsearch('svc_acct_sm',{ 'domsvc' => $self->domsvc } ); + + $error = $self->SUPER::insert; + return $error if $error; + + my $svc_domain = qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } ); + my $svc_acct = qsearchs( 'svc_acct', { 'uid' => $self->domuid } ); + my ( $uid, $gid, $dir, $domain ) = ( + $svc_acct->uid, + $svc_acct->gid, + $svc_acct->dir, + $svc_domain->domain, + ); + my $qdomain = $domain; + $qdomain =~ s/\./:/g; #see manpage for 'dot-qmail': EXTENSION ADDRESSES + ssh("root\@$shellmachine","[ -e $dir/.qmail-$qdomain-default ] || { touch $dir/.qmail-$qdomain-default; chown $uid:$gid $dir/.qmail-$qdomain-default; }") + if ( ! $nossh_hack && $shellmachine && $dir && $self->domuser eq '*' ); + + ''; #no error + +} + +=item delete + +Deletes this virtual mail alias from the database. If there is an error, +returns the error, otherwise returns false. + +The corresponding FS::cust_svc record will be deleted as well. + +=item replace OLD_RECORD + +Replaces OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +sub replace { + my ( $new, $old ) = ( shift, shift ); + my $error; + + return "Domain username (domuser) in use for this domain (domsvc)" + if ( $old->domuser ne $new->domuser + || $old->domsvc != $new->domsvc + ) && qsearchs('svc_acct_sm',{ + 'domuser'=> $new->domuser, + 'domsvc' => $new->domsvc, + } ) + ; + + $new->SUPER::replace($old); + +} + +=item suspend + +Just returns false (no error) for now. + +Called by the suspend method of FS::cust_pkg (see L). + +=item unsuspend + +Just returns false (no error) for now. + +Called by the unsuspend method of FS::cust_pkg (see L). + +=item cancel + +Just returns false (no error) for now. + +Called by the cancel method of FS::cust_pkg (see L). + +=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 = shift; + my $error; + + my $x = $self->setfixed; + return $x unless ref($x); + my $part_svc = $x; + + my($recref) = $self->hashref; + + $recref->{domuser} =~ /^(\*|[a-z0-9_\-]{2,32})$/ + or return "Illegal domain username (domuser)"; + $recref->{domuser} = $1; + + $recref->{domsvc} =~ /^(\d+)$/ or return "Illegal domsvc"; + $recref->{domsvc} = $1; + my($svc_domain); + return "Unknown domsvc" unless + $svc_domain=qsearchs('svc_domain',{'svcnum'=> $recref->{domsvc} } ); + + $recref->{domuid} =~ /^(\d+)$/ or return "Illegal uid"; + $recref->{domuid} = $1; + my($svc_acct); + return "Unknown uid" unless + $svc_acct=qsearchs('svc_acct',{'uid'=> $recref->{domuid} } ); + + ''; #no error +} + +=back + +=head1 VERSION + +$Id: svc_acct_sm.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ + +=head1 BUGS + +The remote commands should be configurable. + +The $recref stuff in sub check should be cleaned up. + +=head1 SEE ALSO + +L, L, L, L, L, +L, L, L, L, L, +schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm new file mode 100644 index 000000000..c6d124833 --- /dev/null +++ b/FS/FS/svc_domain.pm @@ -0,0 +1,421 @@ +package FS::svc_domain; + +use strict; +use vars qw( @ISA $whois_hack $conf $mydomain $smtpmachine + $tech_contact $from $to @nameservers @nameserver_ips @template +); +use Carp; +use Mail::Internet; +use Mail::Header; +use Date::Format; +use Net::Whois; #0.24; +use FS::Record qw(fields qsearch qsearchs); +use FS::Conf; +use FS::svc_Common; +use FS::cust_svc; +use FS::svc_acct; +use FS::cust_pkg; +use FS::cust_main; + +@ISA = qw( FS::svc_Common ); + +#ask FS::UID to run this stuff for us later +$FS::UID::callback{'FS::domain'} = sub { + $conf = new FS::Conf; + + $mydomain = $conf->config('domain'); + $smtpmachine = $conf->config('smtpmachine'); + + my($internic)="/registries/internic"; + $tech_contact = $conf->config("$internic/tech_contact"); + $from = $conf->config("$internic/from"); + $to = $conf->config("$internic/to"); + my(@ns) = $conf->config("$internic/nameservers"); + @nameservers=map { + /^\s*\d+\.\d+\.\d+\.\d+\s+([^\s]+)\s*$/ + or die "Illegal line in $internic/nameservers"; + $1; + } @ns; + @nameserver_ips=map { + /^\s*(\d+\.\d+\.\d+\.\d+)\s+([^\s]+)\s*$/ + or die "Illegal line in $internic/nameservers!"; + $1; + } @ns; + @template = map { $_. "\n" } $conf->config("$internic/template"); + +}; + +=head1 NAME + +FS::svc_domain - Object methods for svc_domain records + +=head1 SYNOPSIS + + use FS::svc_domain; + + $record = new FS::svc_domain \%hash; + $record = new FS::svc_domain { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + + $error = $record->suspend; + + $error = $record->unsuspend; + + $error = $record->cancel; + +=head1 DESCRIPTION + +An FS::svc_domain object represents a domain. FS::svc_domain inherits from +FS::svc_Common. The following fields are currently supported: + +=over 4 + +=item svcnum - primary key (assigned automatically for new accounts) + +=item domain + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new domain. To add the domain to the database, see L<"insert">. + +=cut + +sub table { 'svc_domain'; } + +=item insert + +Adds this domain to the database. If there is an error, returns the error, +otherwise returns false. + +The additional fields I and I (see L) should be +defined. An FS::cust_svc record will be created and inserted. + +The additional field I should be set to I for new domains or I +for transfers. + +A registration or transfer email will be submitted unless +$FS::svc_domain::whois_hack is true. + +The additional field I can be used to manually set the admin contact +email address on this email. Otherwise, the svc_acct records for this package +(see L) are searched. If there is exactly one svc_acct record +in the same package, it is automatically used. Otherwise an error is returned. + +=cut + +sub insert { + my $self = shift; + my $error; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + $error = $self->check; + return $error if $error; + + return "Domain in use (here)" + if qsearchs( 'svc_domain', { 'domain' => $self->domain } ); + + my $whois = $self->whois; + return "Domain in use (see whois)" + if ( $self->action eq "N" && $whois ); + return "Domain not found (see whois)" + if ( $self->action eq "M" && ! $whois ); + + $error = $self->SUPER::insert; + return $error if $error; + + $self->submit_internic unless $whois_hack; + + ''; #no error +} + +=item delete + +Deletes this domain from the database. If there is an error, returns the +error, otherwise returns false. + +The corresponding FS::cust_svc record will be deleted as well. + +=item replace OLD_RECORD + +Replaces OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +sub replace { + my ( $new, $old ) = ( shift, shift ); + my $error; + + return "Can't change domain - reorder." + if $old->getfield('domain') ne $new->getfield('domain'); + + $new->SUPER::replace($old); + +} + +=item suspend + +Just returns false (no error) for now. + +Called by the suspend method of FS::cust_pkg (see L). + +=item unsuspend + +Just returns false (no error) for now. + +Called by the unsuspend method of FS::cust_pkg (see L). + +=item cancel + +Just returns false (no error) for now. + +Called by the cancel method of FS::cust_pkg (see L). + +=item check + +Checks all fields to make sure this is a valid domain. If there is an error, +returns the error, otherwise returns false. Called by the insert and replace +methods. + +Sets any fixed values; see L. + +=cut + +sub check { + my $self = shift; + my $error; + + my $x = $self->setfixed; + return $x unless ref($x); + my $part_svc = $x; + + #hmm + my $pkgnum; + if ( $self->svcnum ) { + my $cust_svc = qsearchs( 'cust_svc', { 'svcnum' => $self->svcnum } ); + $pkgnum = $cust_svc->pkgnum; + } else { + $pkgnum = $self->pkgnum; + } + + my($recref) = $self->hashref; + + unless ( $whois_hack ) { + unless ( $self->email ) { #find out an email address + my @svc_acct; + foreach ( qsearch( 'cust_svc', { 'pkgnum' => $pkgnum } ) ) { + my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $_->svcnum } ); + push @svc_acct, $svc_acct if $svc_acct; + } + + if ( scalar(@svc_acct) == 0 ) { + return "Must order an account in package ". $pkgnum. " first"; + } elsif ( scalar(@svc_acct) > 1 ) { + return "More than one account in package ". $pkgnum. ": specify admin contact email"; + } else { + $self->email($svc_acct[0]->username. '@'. $mydomain); + } + } + } + + #if ( $recref->{domain} =~ /^([\w\-\.]{1,22})\.(com|net|org|edu)$/ ) { + if ( $recref->{domain} =~ /^([\w\-]{1,22})\.(com|net|org|edu)$/ ) { + $recref->{domain} = "$1.$2"; + # hmmmmmmmm. + } elsif ( $whois_hack && $recref->{domain} =~ /^([\w\-\.]+)$/ ) { + $recref->{domain} = $1; + } else { + return "Illegal domain ". $recref->{domain}. + " (or unknown registry - try \$whois_hack)"; + } + + $recref->{action} =~ /^(M|N)$/ or return "Illegal action"; + $recref->{action} = $1; + + $self->ut_textn('purpose'); + +} + +=item whois + +Returns the Net::Whois object corresponding to this domain, or undef if +the domain is not found in whois. + +(If $FS::svc_domain::whois_hack is true, returns that in all cases instead.) + +=cut + +sub whois { + $whois_hack or new Net::Whois::Domain $_[0]->domain; +} + +=item _whois + +Depriciated. + +=cut + +sub _whois { + die "_whois depriciated"; +} + +=item submit_internic + +Submits a registration email for this domain. + +=cut + +sub submit_internic { + my $self = shift; + + my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } ); + return unless $cust_pkg; + my $cust_main = qsearchs( 'cust_main', { 'custnum' => $cust_pkg->custnum } ); + return unless $cust_main; + + my %subs = ( + 'action' => $self->action, + 'purpose' => $self->purpose, + 'domain' => $self->domain, + 'company' => $cust_main->company + || $cust_main->getfield('first'). ' '. + $cust_main->getfield('last') + , + 'city' => $cust_main->city, + 'state' => $cust_main->state, + 'zip' => $cust_main->zip, + 'country' => $cust_main->country, + 'last' => $cust_main->getfield('last'), + 'first' => $cust_main->getfield('first'), + 'daytime' => $cust_main->daytime, + 'fax' => $cust_main->fax, + 'email' => $self->email, + 'tech_contact' => $tech_contact, + 'primary' => shift @nameservers, + 'primary_ip' => shift @nameserver_ips, + ); + + #yuck + my @xtemplate = @template; + my @body; + my $line; + OLOOP: while ( defined( $line = shift @xtemplate ) ) { + + if ( $line =~ /^###LOOP###$/ ) { + my(@buffer); + LOADBUF: while ( defined( $line = shift @xtemplate ) ) { + last LOADBUF if ( $line =~ /^###ENDLOOP###$/ ); + push @buffer, $line; + } + my %lubs = ( + 'address' => $cust_main->address2 + ? [ $cust_main->address1, $cust_main->address2 ] + : [ $cust_main->address1 ] + , + 'secondary' => [ @nameservers ], + 'secondary_ip' => [ @nameserver_ips ], + ); + LOOP: while (1) { + my @xbuffer = @buffer; + SUBLOOP: while ( defined( $line = shift @xbuffer ) ) { + if ( $line =~ /###(\w+)###/ ) { + #last LOOP unless my($lub)=shift@{$lubs{$1}}; + next OLOOP unless my $lub = shift @{$lubs{$1}}; + $line =~ s/###(\w+)###/$lub/e; + redo SUBLOOP; + } else { + push @body, $line; + } + } #SUBLOOP + } #LOOP + + } + + if ( $line =~ /###(\w+)###/ ) { + #$line =~ s/###(\w+)###/$subs{$1}/eg; + $line =~ s/###(\w+)###/$subs{$1}/e; + redo OLOOP; + } else { + push @body, $line; + } + + } #OLOOP + + my $subject; + if ( $self->action eq "M" ) { + $subject = "MODIFY DOMAIN ". $self->domain; + } elsif ( $self->action eq "N" ) { + $subject = "NEW DOMAIN ". $self->domain; + } else { + croak "submit_internic called with action ". $self->action; + } + + $ENV{SMTPHOSTS} = $smtpmachine; + $ENV{MAILADDRESS} = $from; + my $header = Mail::Header->new( [ + "From: $from", + "To: $to", + "Sender: $from", + "Reply-To: $from", + "Date: ". time2str("%a, %d %b %Y %X %z", time), + "Subject: $subject", + ] ); + + my($msg)=Mail::Internet->new( + 'Header' => $header, + 'Body' => \@body, + ); + + $msg->smtpsend or die "Can't send registration email"; #die? warn? + +} + +=back + +=head1 VERSION + +$Id: svc_domain.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ + +=head1 BUGS + +All BIND/DNS fields should be included (and exported). + +Delete doesn't send a registration template. + +All registries should be supported. + +Should change action to a real field. + +The $recref stuff in sub check should be cleaned up. + +=head1 SEE ALSO + +L, L, L, L, +L, L, L, L, L, +L, schema.html from the base documentation, config.html from the +base documentation. + +=cut + +1; + + diff --git a/FS/FS/type_pkgs.pm b/FS/FS/type_pkgs.pm new file mode 100644 index 000000000..8e0d4ef56 --- /dev/null +++ b/FS/FS/type_pkgs.pm @@ -0,0 +1,113 @@ +package FS::type_pkgs; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearchs ); +use FS::agent_type; +use FS::part_pkg; + +@ISA = qw( FS::Record ); + +=head1 NAME + +FS::type_pkgs - Object methods for type_pkgs records + +=head1 SYNOPSIS + + use FS::type_pkgs; + + $record = new FS::type_pkgs \%hash; + $record = new FS::type_pkgs { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::type_pkgs record links an agent type (see L) to a +billing item definition (see L). FS::type_pkgs inherits from +FS::Record. The following fields are currently supported: + +=over 4 + +=item typenum - Agent type, see L + +=item pkgpart - Billing item definition, see L + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Create a new record. To add the record to the database, see L<"insert">. + +=cut + +sub table { 'type_pkgs'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete + +Deletes this record from the database. If there is an error, returns the +error, otherwise returns false. + +=item replace OLD_RECORD + +Replaces OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=item check + +Checks all fields to make sure this is a valid record. If there is an error, +returns the error, otherwise returns false. Called by the insert and replace +methods. + +=cut + +sub check { + my $self = shift; + + my $error = + $self->ut_number('typenum') + || $self->ut_number('pkgpart') + ; + return $error if $error; + + return "Unknown typenum" + unless qsearchs( 'agent_type', { 'typenum' => $self->typenum } ); + + return "Unknown pkgpart" + unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } ); + + ''; #no error +} + +=back + +=head1 VERSION + +$Id: type_pkgs.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ + +=head1 BUGS + +=head1 SEE ALSO + +L, L, L, schema.html from the base +documentation. + +=cut + +1; + diff --git a/FS/MANIFEST b/FS/MANIFEST index c036308ed..37e19e890 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -1,5 +1,47 @@ Changes FS.pm +FS/Bill.pm +FS/CGI.pm +FS/Conf.pm +FS/Invoice.pm +FS/Record.pm +FS/SSH.pm +FS/UI/Base.pm +FS/UI/CGI.pm +FS/UI/Gtk.pm +FS/UI/agent.pm +FS/UID.pm +FS/agent.pm +FS/agent_type.pm +FS/cust_bill.pm +FS/cust_bill_pkg.pm +FS/cust_credit.pm +FS/cust_main.pm +FS/cust_main_county.pm +FS/cust_main_invoice.pm +FS/cust_pay.pm +FS/cust_pay_batch.pm +FS/cust_pkg.pm +FS/cust_refund.pm +FS/cust_svc.pm +FS/dbdef.pm +FS/dbdef_colgroup.pm +FS/dbdef_column.pm +FS/dbdef_index.pm +FS/dbdef_table.pm +FS/dbdef_unique.pm +FS/part_pkg.pm +FS/part_referral.pm +FS/part_svc.pm +FS/pkg_svc.pm +FS/svc_Common.pm +FS/svc_acct.pm +FS/svc_acct_pop.pm +FS/svc_acct_sm.pm +FS/svc_domain.pm +FS/type_pkgs.pm MANIFEST +MANIFEST.SKIP Makefile.PL test.pl +README diff --git a/FS/MANIFEST.SKIP b/FS/MANIFEST.SKIP new file mode 100644 index 000000000..ae335e78a --- /dev/null +++ b/FS/MANIFEST.SKIP @@ -0,0 +1 @@ +CVS/ diff --git a/FS/README b/FS/README new file mode 100644 index 000000000..d4c35acb4 --- /dev/null +++ b/FS/README @@ -0,0 +1,6 @@ +This is the Perl module section of Freeside. + +perl Makefile.PL +make +make test +make install -- cgit v1.2.1 From 263f3ca6d5572cc855760147ec09477b759f5c1e Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 4 Aug 1999 10:41:22 +0000 Subject: some pod syntax update to generate nicer html docs --- FS/FS/Record.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index f5f928210..e486e1ce7 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -719,7 +719,7 @@ sub ut_anything { This can be used as both a subroutine and a method call. It returns a list of the columns in this record's table, or an explicitly specified table. -(See L). +(See L). =cut @@ -768,7 +768,7 @@ sub dbdef { $dbdef; } 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'. +type (see L) does not end in `char' or `binary'. =cut @@ -825,7 +825,7 @@ sub hfields { =head1 VERSION -$Id: Record.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ +$Id: Record.pm,v 1.2 1999-08-04 10:41:22 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 52ba6db7b5930e9fda318a87ee00977fd12207db Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 4 Aug 1999 11:50:41 +0000 Subject: pod syntax --- FS/FS/cust_pkg.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index c31340d2f..2de664b5c 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -351,7 +351,7 @@ sub unsuspend { =item part_pkg Returns the definition for this billing item, as an FS::part_pkg object (see -L). =cut @@ -490,7 +490,7 @@ sub order { =head1 VERSION -$Id: cust_pkg.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ +$Id: cust_pkg.pm,v 1.2 1999-08-04 11:50:41 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From e14a30891181730a042f451bb094dee1e263700c Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 4 Aug 1999 12:41:47 +0000 Subject: pod fix --- FS/FS.pm | 94 +++++++++++++++++++++++++++------------------------------------- 1 file changed, 40 insertions(+), 54 deletions(-) (limited to 'FS') diff --git a/FS/FS.pm b/FS/FS.pm index 78317392a..64461a5d1 100644 --- a/FS/FS.pm +++ b/FS/FS.pm @@ -19,112 +19,98 @@ ISP billing software. This includes: =head2 Database metadata classes -=over 4 +L - Database class -=item L - Database class +L - Database table class -=item L - Database table class +L - Database column class -=item L - Database column class +L - Database column group class -=item L - Database column group class +L - Database index class -=item L - Database index class - -=item L - Database unique index class - -=back +L - Database unique index class =head2 Utility classes -=over 4 +L - Simple wrappers around ssh and scp commands. -=item L - Simple wrappers around ssh and scp commands. +L - Freeside configuration values -=item L - Freeside configuration values +L - User class (not yet OO) -=item L - User class (not yet OO) - -=item L - Non OO-subroutines for the web interface. This is +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). -=back - =head2 Database record classes -=over 4 +L - Database record base class -=item L - Database record base class - -=item L - POP (Point of Presence, not Post +L - POP (Point of Presence, not Post Office Protocol) class -=item L - Referral class +L - Referral class -=item L - Locale (tax rate) class +L - Locale (tax rate) class -=item L - Service base class +L - Service base class -=item L - Account (shell, RADIUS, POP3) class +L - Account (shell, RADIUS, POP3) class -=item L - Domain class +L - Domain class -=item L - Vitual mail alias class +L - Vitual mail alias class -=item L - Service definition class +L - Service definition class -=item L - Package (billing item) definition class +L - Package (billing item) definition class -=item L - Class linking package (billing item) +L - Class linking package (billing item) definitions (see L) with service definitions (see L) -=item L - Agent (reseller) class +L - Agent (reseller) class -=item L - Agent type class +L - Agent type class -=item L - Class linking agent types (see +L - Class linking agent types (see L) with package (billing item) definitions (see L) -=item L - Service class +L - Service class -=item L - Package (billing item) class +L - Package (billing item) class -=item L - Customer class +L - Customer class -=item L - Invoice destination +L - Invoice destination class -=item L - Invoice class +L - Invoice class -=item L - Invoice line item class +L - Invoice line item class -=item L - Payment class +L - Payment class -=item L - Credit class +L - Credit class -=item L - Refund class +L - Refund class -=item L - Credit card transaction queue +L - Credit card transaction queue class -=back - =head2 User Interface classes (under development; not yet usable) -=over 4 - -=item L - User-interface base class +L - User-interface base class -=item L - Gtk user-interface class +L - Gtk user-interface class -=item L - CGI (HTML) user-interface class +L - CGI (HTML) user-interface class -=item L - agent table user-interface class +L - agent table user-interface class -=back +=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 @@ -141,7 +127,7 @@ The main documentation is in htdocs/docs. =head1 VERSION -$Id: FS.pm,v 1.2 1999-08-04 07:34:15 ivan Exp $ +$Id: FS.pm,v 1.3 1999-08-04 12:41:47 ivan Exp $ =head1 SUPPORT -- cgit v1.2.1 From 8ba31246d8226ff4d71d0ddabcb31d984e7a1548 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 11 Aug 1999 13:12:11 +0000 Subject: require a working Net::Whois version --- FS/FS/svc_domain.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm index c6d124833..57fa47fa8 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -8,7 +8,7 @@ use Carp; use Mail::Internet; use Mail::Header; use Date::Format; -use Net::Whois; #0.24; +use Net::Whois 1.001; use FS::Record qw(fields qsearch qsearchs); use FS::Conf; use FS::svc_Common; @@ -393,7 +393,7 @@ sub submit_internic { =head1 VERSION -$Id: svc_domain.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ +$Id: svc_domain.pm,v 1.2 1999-08-11 13:12:11 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 0b1f40cc85eee025f01dd14e155cc65837e3f9e5 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 11 Aug 1999 20:41:28 +0000 Subject: new bill script, --- FS/FS/svc_domain.pm | 4 +- FS/MANIFEST | 1 + FS/Makefile.PL | 3 +- FS/bin/freeside-bill | 122 +++++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 127 insertions(+), 3 deletions(-) create mode 100755 FS/bin/freeside-bill (limited to 'FS') diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm index 57fa47fa8..73cc3e340 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -8,7 +8,7 @@ use Carp; use Mail::Internet; use Mail::Header; use Date::Format; -use Net::Whois 1.001; +use Net::Whois 1.0; use FS::Record qw(fields qsearch qsearchs); use FS::Conf; use FS::svc_Common; @@ -393,7 +393,7 @@ sub submit_internic { =head1 VERSION -$Id: svc_domain.pm,v 1.2 1999-08-11 13:12:11 ivan Exp $ +$Id: svc_domain.pm,v 1.3 1999-08-11 20:41:27 ivan Exp $ =head1 BUGS diff --git a/FS/MANIFEST b/FS/MANIFEST index 37e19e890..e1b4413c6 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -45,3 +45,4 @@ MANIFEST.SKIP Makefile.PL test.pl README +bin/freeside-bill diff --git a/FS/Makefile.PL b/FS/Makefile.PL index 22b412d21..ab4c2281b 100644 --- a/FS/Makefile.PL +++ b/FS/Makefile.PL @@ -2,6 +2,7 @@ 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', + 'NAME' => 'FS', 'VERSION_FROM' => 'FS.pm', # finds $VERSION + 'EXE_FILES' => [ glob 'bin/*' ], ); diff --git a/FS/bin/freeside-bill b/FS/bin/freeside-bill new file mode 100755 index 000000000..8f2c32fb2 --- /dev/null +++ b/FS/bin/freeside-bill @@ -0,0 +1,122 @@ +#!/usr/bin/perl -Tw + +use strict; +use Fcntl qw(:flock); +use Date::Parse; +use Getopt::Std; +use FS::UID qw(adminsuidsetup swapuid); +use FS::Record qw(qsearch qsearchs); +use FS::cust_main; + +&untaint_argv; #what it sounds like (eww) +use vars qw($opt_a $opt_c $opt_i $opt_d); +getopts("acid:"); +my $user = shift or die &usage; + +adminsuidsetup $user; + +my %bill_only = map { $_ => 1 } ( + @ARGV ? @ARGV : ( map $_->custnum, qsearch('cust_main', {} ) ) +); + +#we're at now now (and later). +my($time)= $main::opt_d ? str2time($main::opt_d) : $^T; + +# find packages w/ bill < time && cancel != '', and create corresponding +# customer objects + +my($cust_main,%saw); +foreach $cust_main ( + map { + if ( + ( $main::opt_a || ( ( $_->getfield('bill') || 0 ) <= $time ) ) + && $bill_only{ $_->custnum } + && !$saw{ $_->custnum }++ + ) { + qsearchs('cust_main',{'custnum'=> $_->custnum } ); + } else { + (); + } + } ( qsearch('cust_pkg', { 'cancel' => '' }), + qsearch('cust_pkg', { 'cancel' => 0 }), + ) +) { + + # and bill them + + print "Billing customer #" . $cust_main->getfield('custnum') . "\n"; + next; + + my($error); + + $error=$cust_main->bill('time'=>$time); + warn "Error billing, customer #" . $cust_main->getfield('custnum') . + ":" . $error if $error; + + if ($main::opt_c) { + $error=$cust_main->collect('invoice_time'=>$time, + 'batch_card' => $main::opt_i ? 'no' : 'yes', + ); + warn "Error collecting customer #" . $cust_main->getfield('custnum') . + ":" . $error if $error; + + #sleep 1; + + } + +} + +# subroutines + +sub untaint_argv { + foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV + $ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal arguement \"$ARGV[$_]\""; + $ARGV[$_]=$1; + } +} + +sub usage { + die "Usage:\n\n bill [ -c [ i ] ] [ -d 'date' ] [ -b ] user\n"; +} + +=head1 NAME + +freeside-bill - Command line (crontab, script) interface to customer billing. + +=head1 SYNOPSIS + + freeside-bill [ -c [ -a ] [ -i ] ] [ -d 'date' ] user [ custnum custnum ... ] + +=head1 DESCRIPTION + +Bills customers. Searches for customers who are due for billing and calls +the bill and collect methods of a cust_main object. See L. + + -c: Turn on collecting (you probably want this). + + -a: Call collect even if there isn't a new invoice (probably a bad idea for + daily use) + + -i: real-time billing (as opposed to batch billing). only relevant + for credit cards. + + -d: Pretent it's 'date'. Date is in any format Date::Parse is happy with, + but be careful. + +user: From the mapsecrets file - see config.html from the base documentation + +custnum: if one or more customer numbers are specified, only bills those +customers. Otherwise, bills all customers. + +=head1 VERSION + +$Id: freeside-bill,v 1.1 1999-08-11 20:41:27 ivan Exp $ + +=head1 BUGS + +=head1 SEE ALSO + +L, config.html from the base documentation + +=cut + -- cgit v1.2.1 From 9d1c4be2e9cc349481101bbc11a9acdc1b7c235a Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 11 Aug 1999 20:51:54 +0000 Subject: *** empty log message *** --- FS/bin/freeside-bill | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-bill b/FS/bin/freeside-bill index 8f2c32fb2..a251df4d5 100755 --- a/FS/bin/freeside-bill +++ b/FS/bin/freeside-bill @@ -45,7 +45,6 @@ foreach $cust_main ( # and bill them print "Billing customer #" . $cust_main->getfield('custnum') . "\n"; - next; my($error); @@ -110,7 +109,7 @@ customers. Otherwise, bills all customers. =head1 VERSION -$Id: freeside-bill,v 1.1 1999-08-11 20:41:27 ivan Exp $ +$Id: freeside-bill,v 1.2 1999-08-11 20:51:54 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From aa39234613e8148c531ad3fd0ca46ee806563f6c Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 12 Aug 1999 00:05:03 +0000 Subject: configurable min/max username length, min password length, periods in usernames --- FS/FS/svc_acct.pm | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index b2f23c933..079508b84 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -1,8 +1,9 @@ package FS::svc_acct; use strict; -use vars qw(@ISA $nossh_hack $conf $dir_prefix @shells - $shellmachine @saltset @pw_set); +use vars qw( @ISA $nossh_hack $conf $dir_prefix @shells $usernamemin + $usernamemax $passwordmin + $shellmachine @saltset @pw_set); use FS::Conf; use FS::Record qw( qsearchs fields ); use FS::svc_Common; @@ -18,6 +19,9 @@ $FS::UID::callback{'FS::svc_acct'} = sub { $dir_prefix = $conf->config('home'); @shells = $conf->config('shells'); $shellmachine = $conf->config('shellmachine'); + $usernamemin = $conf->config('usernamemin') || 2; + $usernamemax = $conf->config('usernamemax'); + $passwordmin = $conf->config('passwordmin') || 6; }; @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); @@ -338,8 +342,8 @@ sub check { return $x unless ref($x); my $part_svc = $x; - my $ulen =$self->dbdef_table->column('username')->length; - $recref->{username} =~ /^([a-z0-9_\-]{2,$ulen})$/ + my $ulen = $usernamemax || $self->dbdef_table->column('username')->length; + $recref->{username} =~ /^([a-z0-9_\-\.]{$usernamemin,$ulen})$/ or return "Illegal username"; $recref->{username} = $1; $recref->{username} =~ /[a-z]/ or return "Illegal username"; @@ -422,7 +426,7 @@ sub check { unless ( $recref->{_password} ); #if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,16})$/ ) { - if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,8})$/ ) { + if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{$passwordmin,8})$/ ) { $recref->{_password} = $1.$3; #uncomment this to encrypt password immediately upon entry, or run #bin/crypt_pw in cron to give new users a window during which their @@ -446,7 +450,7 @@ sub check { =head1 VERSION -$Id: svc_acct.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ +$Id: svc_acct.pm,v 1.2 1999-08-12 00:05:03 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 6ce5ed47f0108896bc9d32a348b5afa44bd09c84 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 12 Aug 1999 04:16:01 +0000 Subject: hidecancelledpackages config option --- FS/FS/cust_main.pm | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 25b6b9f46..50535da55 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -6,7 +6,7 @@ package FS::cust_main; use strict; use vars qw( @ISA $conf $lpr $processor $xaction $E_NoErr $invoice_from - $smtpmachine ); + $smtpmachine $Debug ); use Safe; use Carp; use Time::Local; @@ -30,6 +30,9 @@ use FS::cust_main_invoice; @ISA = qw( FS::Record ); +$Debug = 0; +#$Debug = 1; + #ask FS::UID to run this stuff for us later $FS::UID::callback{'FS::cust_main'} = sub { $conf = new FS::Conf; @@ -392,7 +395,12 @@ sub ncancelled_pkgs { qsearch( 'cust_pkg', { 'custnum' => $self->custnum, 'cancel' => '', - }); + }), + qsearch( 'cust_pkg', { + 'custnum' => $self->custnum, + 'cancel' => 0, + }), + ; } =item bill OPTIONS @@ -602,6 +610,7 @@ sub collect { my $invoice_time = $options{'invoice_time'} || time; my $total_owed = $self->balance; + warn "collect: total owed $total_owed " if $Debug; return '' unless $total_owed > 0; #redundant????? #put below somehow? @@ -627,7 +636,7 @@ sub collect { 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)"; + warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, total_owed $total_owed)" if $Debug; next unless $amount > 0; @@ -930,7 +939,7 @@ sub check_invoicing_list { =head1 VERSION -$Id: cust_main.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ +$Id: cust_main.pm,v 1.2 1999-08-12 04:16:01 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 75f1f7889d2a653c61adb689c029e8c8a7544565 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 20 Aug 1999 08:27:06 +0000 Subject: fix for bug noticed by Martin G. Bayerle: > if you eliminate services from any package, to reduce it to only one service, > once gone, they won't reappear. --- FS/FS/part_pkg.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index 863e962bb..d262a04e0 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -134,13 +134,13 @@ sub check { =item pkg_svc Returns all FS::pkg_svc objects (see L) for this package -definition. +definition (with non-zero quantity). =cut sub pkg_svc { my $self = shift; - qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } ); + grep { $_->quantity } qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } ); } =item svcpart [ SVCDB ] @@ -166,7 +166,7 @@ sub svcpart { =head1 VERSION -$Id: part_pkg.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ +$Id: part_pkg.pm,v 1.2 1999-08-20 08:27:06 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 7c7bc66bd24874e7ccd4fd3445f1da7f88e9679d Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 4 Oct 1999 08:23:26 +0000 Subject: silly 'use of unitialized value' errors --- FS/bin/freeside-bill | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/bin/freeside-bill b/FS/bin/freeside-bill index a251df4d5..417df767b 100755 --- a/FS/bin/freeside-bill +++ b/FS/bin/freeside-bill @@ -28,6 +28,9 @@ my($time)= $main::opt_d ? str2time($main::opt_d) : $^T; my($cust_main,%saw); foreach $cust_main ( map { + unless ( exists $saw{ $_->custnum } && defined $saw{ $_->custnum} ) { + $saw{ $_->custnum } = 0; # to avoid 'use of uninitialized value' errors + } if ( ( $main::opt_a || ( ( $_->getfield('bill') || 0 ) <= $time ) ) && $bill_only{ $_->custnum } @@ -109,7 +112,7 @@ customers. Otherwise, bills all customers. =head1 VERSION -$Id: freeside-bill,v 1.2 1999-08-11 20:51:54 ivan Exp $ +$Id: freeside-bill,v 1.3 1999-10-04 08:23:26 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 8a45867abd9f8349bec410910af8ad166e1434a5 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 8 Nov 1999 21:38:38 +0000 Subject: remove services using pkg_svc table now, oops! --- FS/FS/cust_pkg.pm | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 2de664b5c..1dcdab8d5 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -8,6 +8,7 @@ use FS::cust_svc; use FS::part_pkg; use FS::cust_main; use FS::type_pkgs; +use FS::pkg_svc; # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend, # setup } @@ -428,16 +429,15 @@ sub order { push @cust_svc, [ map { ( $svcnum{$_} && @{ $svcnum{$_} } ) ? shift @{ $svcnum{$_} } : (); - } (split(/,/, - qsearchs('part_pkg',{'pkgpart'=>$pkgpart})->getfield('services') - )) + } map { $_->svcpart } qsearch('pkg_svc', { 'pkgpart' => $pkgpart }) ]; } #check for leftover services foreach (keys %svcnum) { next unless @{ $svcnum{$_} }; - return "Leftover services!"; + return "Leftover services, svcpart $_: svcnum ". + join(', ', map { $_->svcnum } @{ $svcnum{$_} } ); } #no leftover services, let's make changes. @@ -490,7 +490,7 @@ sub order { =head1 VERSION -$Id: cust_pkg.pm,v 1.2 1999-08-04 11:50:41 ivan Exp $ +$Id: cust_pkg.pm,v 1.3 1999-11-08 21:38:38 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 9a34cb208f355e2046580232eb731b00deac4b89 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 28 Jan 2000 22:56:13 +0000 Subject: track full phone number --- FS/FS/svc_acct_pop.pm | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/svc_acct_pop.pm b/FS/FS/svc_acct_pop.pm index a64adb25a..5e755ef73 100644 --- a/FS/FS/svc_acct_pop.pm +++ b/FS/FS/svc_acct_pop.pm @@ -42,6 +42,8 @@ inherits from FS::Record. The following fields are currently supported: =item exch - exchange +=item loc - rest of number + =back =head1 METHODS @@ -87,6 +89,7 @@ sub check { or $self->ut_text('state') or $self->ut_number('ac') or $self->ut_number('exch') + or $self->ut_numbern('loc') ; } @@ -95,7 +98,7 @@ sub check { =head1 VERSION -$Id: svc_acct_pop.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ +$Id: svc_acct_pop.pm,v 1.2 2000-01-28 22:55:06 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From ccbd7d4704d768d4d79c3beafbc9ef44ace49f8c Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 29 Jan 2000 21:10:13 +0000 Subject: doc update --- FS/FS/svc_domain.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm index 73cc3e340..f960de066 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -257,8 +257,8 @@ sub check { =item whois -Returns the Net::Whois object corresponding to this domain, or undef if -the domain is not found in whois. +Returns the Net::Whois::Domain object (see L) 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.) @@ -393,7 +393,7 @@ sub submit_internic { =head1 VERSION -$Id: svc_domain.pm,v 1.3 1999-08-11 20:41:27 ivan Exp $ +$Id: svc_domain.pm,v 1.4 2000-01-29 21:10:13 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 959663cd4d4885295f44de43ac005e55d054102f Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 31 Jan 2000 05:22:23 +0000 Subject: prepaid "internet cards" --- FS/FS/cust_main.pm | 72 ++++++++++++++++++++++++---- FS/FS/prepay_credit.pm | 128 +++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 191 insertions(+), 9 deletions(-) create mode 100644 FS/FS/prepay_credit.pm (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 50535da55..59ec41b81 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -27,6 +27,7 @@ use FS::part_referral; use FS::cust_main_county; use FS::agent; use FS::cust_main_invoice; +use FS::prepay_credit; @ISA = qw( FS::Record ); @@ -148,9 +149,9 @@ FS::Record. The following fields are currently supported: =item fax - phone (optional) -=item payby - `CARD' (credit cards), `BILL' (billing), or `COMP' (free) +=item payby - `CARD' (credit cards), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see L and sets billing type to BILL) -=item payinfo - card number, P.O.#, or comp issuer (4-8 lowercase alphanumerics; think username) +=item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L) =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy @@ -182,6 +183,52 @@ sub table { 'cust_main'; } Adds this customer to the database. If there is an error, returns the error, otherwise returns false. +=cut + +sub insert { + my $self = shift; + + my $flag = 0; + if ( $self->payby eq 'PREPAY' ) { + $self->payby('BILL'); + $flag = 1; + } + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $error = $self->SUPER::insert; + return $error if $error; + + if ( $flag ) { + my $prepay_credit = + qsearchs('prepay_credit', { 'identifier' => $self->payinfo } ); + warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo + unless $prepay_credit; + my $amount = $prepay_credit->amount; + my $error = $prepay_credit->delete; + if ( $error ) { + warn "WARNING: can't delete prepay_credit: ". $self->payinfo; + } else { + my $cust_credit = new FS::cust_credit { + 'custnum' => $self->custnum, + 'amount' => $amount, + }; + my $error = $cust_credit->insert; + warn "WARNING: error inserting cust_credit for prepay_credit: $error" + if $error; + } + + } + + ''; + +} + =item delete NEW_CUSTNUM This deletes the customer. If there is an error, returns the error, otherwise @@ -314,7 +361,7 @@ sub check { or return "Illegal zip: ". $self->zip; $self->zip($1); - $self->payby =~ /^(CARD|BILL|COMP)$/ + $self->payby =~ /^(CARD|BILL|COMP|PREPAY)$/ or return "Illegal payby: ". $self->payby; $self->payby($1); @@ -340,10 +387,21 @@ sub check { $error = $self->ut_textn('payinfo'); return "Illegal comp account issuer: ". $self->payinfo if $error; + } elsif ( $self->payby eq 'PREPAY' ) { + + my $payinfo = $self->payinfo; + $payinfo =~ s/\W//g; #anything else would just confuse things + $self->payinfo($payinfo); + $error = $self->ut_alpha('payinfo'); + return "Illegal prepayment identifier: ". $self->payinfo if $error; + return "Unknown prepayment identifier" + unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } ); + } if ( $self->paydate eq '' ) { - return "Expriation date required" unless $self->payby eq 'BILL'; + return "Expriation date required" + unless $self->payby eq 'BILL' || $self->payby eq 'PREPAY'; $self->paydate(''); } else { $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ @@ -799,10 +857,6 @@ sub collect { return "Unknown payment type ". $self->payby; } - - - - } ''; @@ -939,7 +993,7 @@ sub check_invoicing_list { =head1 VERSION -$Id: cust_main.pm,v 1.2 1999-08-12 04:16:01 ivan Exp $ +$Id: cust_main.pm,v 1.3 2000-01-31 05:22:23 ivan Exp $ =head1 BUGS diff --git a/FS/FS/prepay_credit.pm b/FS/FS/prepay_credit.pm new file mode 100644 index 000000000..86274aa4c --- /dev/null +++ b/FS/FS/prepay_credit.pm @@ -0,0 +1,128 @@ +package FS::prepay_credit; + +use strict; +use vars qw( @ISA ); +#use FS::Record qw( qsearch qsearchs ); +use FS::Record qw(); + +@ISA = qw(FS::Record); + +=head1 NAME + +FS::prepay_credit - Object methods for prepay_credit records + +=head1 SYNOPSIS + + use FS::prepay_credit; + + $record = new FS::prepay_credit \%hash; + $record = new FS::prepay_credit { + 'identifier' => '4198123455512121' + 'amount' => '19.95', + }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::table_name object represents an pre--paid credit, such as a pre-paid +"calling card". FS::prepay_credit inherits from FS::Record. The following +fields are currently supported: + +=over 4 + +=item field - description + +=item identifier - identifier entered by the user to receive the credit + +=item amount - amount of the credit + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new pre-paid credit. To add the example to the database, see +L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I method. + +=cut + +sub table { 'prepay_credit'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +=item delete + +Delete this record from the database. + +=cut + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +=item check + +Checks all fields to make sure this is a valid pre-paid credit. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +sub check { + my $self = shift; + + my $identifier = $self->identifier; + $identifier =~ s/\W//g; #anything else would just confuse things + $self->identifier($identifier); + + $self->ut_number('prepaynum') + || $self->ut_alpha('identifier') + || $self->ut_money('amount') + ; + +} + +=back + +=head1 VERSION + +$Id: prepay_credit.pm,v 1.1 2000-01-31 05:22:23 ivan Exp $ + +=head1 BUGS + +=head1 SEE ALSO + +L, schema.html from the base documentation. + +=head1 HISTORY + +$Log: prepay_credit.pm,v $ +Revision 1.1 2000-01-31 05:22:23 ivan +prepaid "internet cards" + + +=cut + +1; + -- cgit v1.2.1 From 3bfec7cf75a1a4eb4da1cdf8c64003bd6babcd81 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 2 Feb 2000 20:22:18 +0000 Subject: bugfix prepayment in signup server --- FS/FS/cust_main.pm | 4 ++-- FS/FS/prepay_credit.pm | 9 ++++++--- 2 files changed, 8 insertions(+), 5 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 59ec41b81..26883d554 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -399,7 +399,7 @@ sub check { } - if ( $self->paydate eq '' ) { + if ( $self->paydate eq '' || $self->paydate eq '-' ) { return "Expriation date required" unless $self->payby eq 'BILL' || $self->payby eq 'PREPAY'; $self->paydate(''); @@ -993,7 +993,7 @@ sub check_invoicing_list { =head1 VERSION -$Id: cust_main.pm,v 1.3 2000-01-31 05:22:23 ivan Exp $ +$Id: cust_main.pm,v 1.4 2000-02-02 20:22:18 ivan Exp $ =head1 BUGS diff --git a/FS/FS/prepay_credit.pm b/FS/FS/prepay_credit.pm index 86274aa4c..113cee823 100644 --- a/FS/FS/prepay_credit.pm +++ b/FS/FS/prepay_credit.pm @@ -96,7 +96,7 @@ sub check { $identifier =~ s/\W//g; #anything else would just confuse things $self->identifier($identifier); - $self->ut_number('prepaynum') + $self->ut_numbern('prepaynum') || $self->ut_alpha('identifier') || $self->ut_money('amount') ; @@ -107,7 +107,7 @@ sub check { =head1 VERSION -$Id: prepay_credit.pm,v 1.1 2000-01-31 05:22:23 ivan Exp $ +$Id: prepay_credit.pm,v 1.2 2000-02-02 20:22:18 ivan Exp $ =head1 BUGS @@ -118,7 +118,10 @@ L, schema.html from the base documentation. =head1 HISTORY $Log: prepay_credit.pm,v $ -Revision 1.1 2000-01-31 05:22:23 ivan +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" -- cgit v1.2.1 From 5bd5f206a77cf975515d955119d4dff7764a2d8c Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 3 Feb 2000 05:17:39 +0000 Subject: beginning of DNS and Apache support --- FS/FS/cust_pkg.pm | 3 +- FS/FS/domain_record.pm | 182 +++++++++++++++++++++++++++++++++++++ FS/FS/svc_domain.pm | 68 +++++++++++++- FS/FS/svc_www.pm | 242 +++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 493 insertions(+), 2 deletions(-) create mode 100644 FS/FS/domain_record.pm create mode 100644 FS/FS/svc_www.pm (limited to 'FS') diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 1dcdab8d5..08be4e4e0 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -16,6 +16,7 @@ use FS::pkg_svc; use FS::svc_acct; use FS::svc_acct_sm; use FS::svc_domain; +use FS::svc_www; @ISA = qw( FS::Record ); @@ -490,7 +491,7 @@ sub order { =head1 VERSION -$Id: cust_pkg.pm,v 1.3 1999-11-08 21:38:38 ivan Exp $ +$Id: cust_pkg.pm,v 1.4 2000-02-03 05:16:52 ivan Exp $ =head1 BUGS diff --git a/FS/FS/domain_record.pm b/FS/FS/domain_record.pm new file mode 100644 index 000000000..9b7081b2c --- /dev/null +++ b/FS/FS/domain_record.pm @@ -0,0 +1,182 @@ +package FS::domain_record; + +use strict; +use vars qw( @ISA ); +#use FS::Record qw( qsearch qsearchs ); +use FS::Record qw( qsearchs ); +use FS::svc_domain; + +@ISA = qw(FS::Record); + +=head1 NAME + +FS::domain_record - Object methods for domain_record records + +=head1 SYNOPSIS + + use FS::domain_record; + + $record = new FS::domain_record \%hash; + $record = new FS::domain_record { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::domain_record object represents an entry in a DNS zone. +FS::domain_record inherits from FS::Record. The following fields are currently +supported: + +=over 4 + +=item recnum - primary key + +=item svcnum - Domain (see L) of this entry + +=item reczone - partial (or full) zone for this entry + +=item recaf - address family for this entry, currently only `IN' is recognized. + +=item rectype - record type for this entry (A, MX, etc.) + +=item recdata - data for this entry + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new entry. To add the example to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I method. + +=cut + +sub table { 'domain_record'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +=item delete + +Delete this record from the database. + +=cut + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +=item check + +Checks all fields to make sure this is a valid example. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +# the check method should currently be supplied - FS::Record contains some +# data checking routines + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('recnum') + || $self->ut_number('svcnum') + ; + return $error if $error; + + return "Unknown svcnum (in svc_domain)" + unless qsearchs('svc_domain', { 'svcnum' => $self->svcnum } ); + + $self->reczone =~ /^(@|[a-z0-9\.\-]+)$/ + or return "Illegal reczone: ". $self->reczone; + $self->reczone($1); + + $self->recaf =~ /^(IN)$/ or return "Illegal recaf: ". $self->recaf; + $self->recaf($1); + + $self->rectype =~ /^(SOA|NS|MX|A|PTR|CNAME)$/ + or return "Illegal rectype (only SOA NS MX A PTR CNAME recognized): ". + $self->rectype; + $self->rectype($1); + + if ( $self->rectype eq 'SOA' ) { + my $recdata = $self->recdata; + $recdata =~ s/\s+/ /g; + $recdata =~ /^([a-z0-9\.\-]+ [\w\-\+]+\.[a-z0-9\.\-]+ \( (\d+ ){5}\))$/ + or return "Illegal data for SOA reocrd: $recdata"; + $self->recdata($1); + } elsif ( $self->rectype eq 'NS' ) { + $self->recdata =~ /^([a-z0-9\.\-]+)$/ + or return "Illegal data for NS record: ". $self->recdata; + $self->recdata($1); + } elsif ( $self->rectype eq 'MX' ) { + $self->recdata =~ /^(\d+)\s+([a-z0-9\.\-]+)$/ + or return "Illegal data for MX record: ". $self->recdata; + $self->recdata("$1 $2"); + } elsif ( $self->rectype eq 'A' ) { + $self->recdata =~ /^((\d{1,3}\.){3}\d{1,3})$/ + or return "Illegal data for A record: ". $self->recdata; + $self->recdata($1); + } elsif ( $self->rectype eq 'PTR' ) { + $self->recdata =~ /^([a-z0-9\.\-]+)$/ + or return "Illegal data for PTR record: ". $self->recdata; + $self->recdata($1); + } elsif ( $self->rectype eq 'CNAME' ) { + $self->recdata =~ /^([a-z0-9\.\-]+)$/ + or return "Illegal data for CNAME record: ". $self->recdata; + $self->recdata($1); + } else { + die "ack!"; + } + + ''; #no error +} + +=back + +=head1 VERSION + +$Id: domain_record.pm,v 1.1 2000-02-03 05:16:52 ivan Exp $ + +=head1 BUGS + +The data validation doesn't check everything it could. In particular, +there is no protection against bad data that passes the regex, duplicate +SOA records, forgetting the trailing `.', impossible IP addersses, etc. Of +course, it's still better than editing the zone files directly. :) + +=head1 SEE ALSO + +L, schema.html from the base documentation. + +=head1 HISTORY + +$Log: domain_record.pm,v $ +Revision 1.1 2000-02-03 05:16:52 ivan +beginning of DNS and Apache support + + +=cut + +1; + diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm index f960de066..4d4db5ad8 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -3,6 +3,8 @@ package FS::svc_domain; use strict; use vars qw( @ISA $whois_hack $conf $mydomain $smtpmachine $tech_contact $from $to @nameservers @nameserver_ips @template + @mxmachines @nsmachines $soadefaultttl $soaemail $soaexpire $soamachine + $soarefresh $soaretry ); use Carp; use Mail::Internet; @@ -16,6 +18,7 @@ use FS::cust_svc; use FS::svc_acct; use FS::cust_pkg; use FS::cust_main; +use FS::domain_record; @ISA = qw( FS::svc_Common ); @@ -43,6 +46,15 @@ $FS::UID::callback{'FS::domain'} = sub { } @ns; @template = map { $_. "\n" } $conf->config("$internic/template"); + @mxmachines = $conf->config('mxmachines'); + @nsmachines = $conf->config('nsmachines'); + $soadefaultttl = $conf->config('soadefaultttl'); + $soaemail = $conf->config('soaemail'); + $soaexpire = $conf->config('soaexpire'); + $soamachine = $conf->config('soamachine'); + $soarefresh = $conf->config('soarefresh'); + $soaretry = $conf->config('soaretry'); + }; =head1 NAME @@ -114,6 +126,19 @@ email address on this email. Otherwise, the svc_acct records for this package (see L) are searched. If there is exactly one svc_acct record in the same package, it is automatically used. Otherwise an error is returned. +If any I configuration file exists, an SOA record is added to +the domain_record table (see ). + +If any machines are defined in the I configuration file, NS +records are added to the domain_record table (see L). + +If any machines are defined in the I configuration file, MX +records are added to the domain_record table (see L). + +Any problems adding FS::domain_record records will emit warnings, but will +not return errors from this method. If your configuration files are correct +you shouln't have any problems. + =cut sub insert { @@ -144,6 +169,47 @@ sub insert { $self->submit_internic unless $whois_hack; + if ( $soamachine ) { + my $soa = new FS::domain_record { + 'svcnum' => $self->svcnum, + 'reczone' => '@', + 'recaf' => 'IN', + 'rectype' => 'SOA', + 'recdata' => "$soamachine $soaemail ( ". time2str("%Y%m%e", time). "00 ". + "$soarefresh $soarety $soaexpire $soadefaultttl )" + }; + $error = $soa->insert; + warn "WARNING: couldn't insert SOA record for new domain: $error" if $error; + + foreach $nsmachine ( @nsmachines ) { + my $ns = new FS::domain_record { + 'svcnum' => $self->svcnum, + 'reczone' => '@', + 'recaf' => 'IN', + 'rectype' => 'NS', + 'recdata' => $nsmachine, + }; + my $error = $ns->insert; + warn "WARNING: couldn't insert NS record for new domain: $error" + if $error; + } + + foreach $mxmachine ( @mxmachines ) { + my $mx = new FS::domain_record { + 'svcnum' => $self->svcnum, + 'reczone' => '@', + 'recaf' => 'IN', + 'rectype' => 'mx', + 'recdata' => $mxmachine, + }; + my $error = $mx->insert; + warn "WARNING: couldn't insert MX record for new domain: $error" + if $error; + } + + } + + ''; #no error } @@ -393,7 +459,7 @@ sub submit_internic { =head1 VERSION -$Id: svc_domain.pm,v 1.4 2000-01-29 21:10:13 ivan Exp $ +$Id: svc_domain.pm,v 1.5 2000-02-03 05:16:52 ivan Exp $ =head1 BUGS diff --git a/FS/FS/svc_www.pm b/FS/FS/svc_www.pm new file mode 100644 index 000000000..fc1419c7d --- /dev/null +++ b/FS/FS/svc_www.pm @@ -0,0 +1,242 @@ +package FS::svc_www; + +use strict; +use vars qw(@ISA $conf $apacheroot $apachemachine $nossh_hack ); +#use FS::Record qw( qsearch qsearchs ); +use FS::Record qw( qsearchs ); +use FS::svc_Common; +use FS::cust_svc; +use FS::domain_record; +use FS::svc_acct; +use FS::SSH qw(ssh); + +@ISA = qw(svc_Common); + +#ask FS::UID to run this stuff for us later +$FS::UID::callback{'FS::svc_www'} = sub { + $conf = new FS::Conf; + $apacheroot = $conf->config('apacheroot'); + $apachemachine = $conf->config('apachemachine'); +}; + +=head1 NAME + +FS::svc_www - Object methods for svc_www records + +=head1 SYNOPSIS + + use FS::svc_www; + + $record = new FS::svc_www \%hash; + $record = new FS::svc_www { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + + $error = $record->suspend; + + $error = $record->unsuspend; + + $error = $record->cancel; + +=head1 DESCRIPTION + +An FS::svc_www object represents an web virtual host. FS::svc_www inherits +from FS::svc_Common. The following fields are currently supported: + +=over 4 + +=item svcnum - primary key + +=item recnum - DNS `A' record corresponding to this web virtual host. (see L) corresponding to this web virtual host. + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new web virtual host. To add the record to the database, see +L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I method. + +=cut + +sub table { 'svc_www'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +The additional fields pkgnum and svcpart (see L) should be +defined. An FS::cust_svc record will be created and inserted. + +If the configuration values (see L) I, and +I exist, the command: + + mkdir $apacheroot/$zone; + chown $username $apacheroot/$zone; + ln -s $apacheroot/$zone $homedir/$zone + +I<$zone> is the DNS A record pointed to by I +I<$username> is the username pointed to by I +I<$homedir> is that user's home directory + +is executed on I via ssh. This behaviour can be surpressed by +setting $FS::svc_www::nossh_hack true. + +=cut + +sub insert { + my $self = shift; + my $error; + + $error = $self->SUPER::insert; + return $error if $error; + + my $domain_record = qsearchs('domain_record', { 'recnum' => $self->recnum } ); # or die ? + my $zone = $domain_record->reczone; + # or die ? + unless ( $zone =~ /\.$/ ) { + my $dom_svcnum = $domain_record->svcnum; + my $svc_domain = qsearchs('svc_domain', { 'svcnum' => $dom_svcnum } ); + # or die ? + $zone .= $svc_domain->domain; + } + + my $svc_acct = qsearchs('svc_acct', { 'svcnum' => $self->usersvc } ); + # or die ? + my $username = $svc_acct->username; + # or die ? + my $homedir = $svc_acct->dir; + # or die ? + + if ( $apachemachine + && $apacheroot + && $zone + && $username + && $homedir + && ! $nossh_hack + ) { + ssh("root\@$apachemachine", + "mkdir $apacheroot/$zone; ". + "chown $username $apacheroot/$zone; ". + "ln -s $apacheroot/$zone $homedir/$zone" + ); + } + + ''; +} + +=item delete + +Delete this record from the database. + +=cut + +sub delete { + my $self = shift; + my $error; + + $error = $self->SUPER::delete; + return $error if $error; + + ''; +} + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +sub replace { + my ( $new, $old ) = ( shift, shift ); + my $error; + + $error = $new->SUPER::replace($old); + return $error if $error; + + ''; +} + +=item suspend + +Called by the suspend method of FS::cust_pkg (see L). + +=item unsuspend + +Called by the unsuspend method of FS::cust_pkg (see L). + +=item cancel + +Called by the cancel method of FS::cust_pkg (see L). + +=item check + +Checks all fields to make sure this is a valid example. If there is +an error, returns the error, otherwise returns false. Called by the insert +and repalce methods. + +=cut + +sub check { + my $self = shift; + + my $x = $self->setfixed; + return $x unless ref($x); + my $part_svc = $x; + + my $error = + $self->ut_numbern('svcnum') + || $self->ut_number('recnum') + || $self->ut_number('usersvc') + ; + return $error if $error; + + return "Unknown recnum: ". $self->recnum + unless qsearchs('domain_record', { 'recnum' => $self->recnum } ); + + return "Unknown usersvc (svc_acct.svcnum): ". $self->usersvc + unless qsearchs('svc_acct', { 'svcnum' => $self->usersvc } ); + + ''; #no error +} + +=back + +=head1 VERSION + +$Id: svc_www.pm,v 1.1 2000-02-03 05:16:52 ivan Exp $ + +=head1 BUGS + +=head1 SEE ALSO + +L, L, L, L, +L, L, schema.html from the base documentation. + +=head1 HISTORY + +$Log: svc_www.pm,v $ +Revision 1.1 2000-02-03 05:16:52 ivan +beginning of DNS and Apache support + + +=cut + +1; + -- cgit v1.2.1 From 051f66ab072bfbb2a074f656b9886ccbc47287ed Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 1 Mar 2000 08:13:59 +0000 Subject: compilation bugfixes --- FS/FS/svc_domain.pm | 8 ++++---- FS/FS/svc_www.pm | 9 ++++++--- FS/MANIFEST | 3 +++ 3 files changed, 13 insertions(+), 7 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm index 4d4db5ad8..e1e4eb8b5 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -176,12 +176,12 @@ sub insert { 'recaf' => 'IN', 'rectype' => 'SOA', 'recdata' => "$soamachine $soaemail ( ". time2str("%Y%m%e", time). "00 ". - "$soarefresh $soarety $soaexpire $soadefaultttl )" + "$soarefresh $soaretry $soaexpire $soadefaultttl )" }; $error = $soa->insert; warn "WARNING: couldn't insert SOA record for new domain: $error" if $error; - foreach $nsmachine ( @nsmachines ) { + foreach my $nsmachine ( @nsmachines ) { my $ns = new FS::domain_record { 'svcnum' => $self->svcnum, 'reczone' => '@', @@ -194,7 +194,7 @@ sub insert { if $error; } - foreach $mxmachine ( @mxmachines ) { + foreach my $mxmachine ( @mxmachines ) { my $mx = new FS::domain_record { 'svcnum' => $self->svcnum, 'reczone' => '@', @@ -459,7 +459,7 @@ sub submit_internic { =head1 VERSION -$Id: svc_domain.pm,v 1.5 2000-02-03 05:16:52 ivan Exp $ +$Id: svc_domain.pm,v 1.6 2000-03-01 08:13:59 ivan Exp $ =head1 BUGS diff --git a/FS/FS/svc_www.pm b/FS/FS/svc_www.pm index fc1419c7d..bb765b193 100644 --- a/FS/FS/svc_www.pm +++ b/FS/FS/svc_www.pm @@ -10,7 +10,7 @@ use FS::domain_record; use FS::svc_acct; use FS::SSH qw(ssh); -@ISA = qw(svc_Common); +@ISA = qw( FS::svc_Common ); #ask FS::UID to run this stuff for us later $FS::UID::callback{'FS::svc_www'} = sub { @@ -220,7 +220,7 @@ sub check { =head1 VERSION -$Id: svc_www.pm,v 1.1 2000-02-03 05:16:52 ivan Exp $ +$Id: svc_www.pm,v 1.2 2000-03-01 08:13:59 ivan Exp $ =head1 BUGS @@ -232,7 +232,10 @@ L, L, schema.html from the base documentation. =head1 HISTORY $Log: svc_www.pm,v $ -Revision 1.1 2000-02-03 05:16:52 ivan +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/FS/MANIFEST b/FS/MANIFEST index e1b4413c6..e0b5b51e5 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -46,3 +46,6 @@ Makefile.PL test.pl README bin/freeside-bill +FS/domain_record.pm +FS/prepay_credit.pm +FS/svc_www.pm -- cgit v1.2.1 From 12debb17cbd12e68261dc7f98e39bfbc3915e6f6 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 3 Mar 2000 18:21:38 +0000 Subject: changes backported from 1.2.3 release, bugfix from web demo --- FS/FS/Record.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index e486e1ce7..dae9f3707 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -204,7 +204,7 @@ sub qsearchs { # $result_record = &FS::Record:qsearchs('table',\%hash); my(@result) = qsearch(@_); carp "warning: Multiple records in scalar search!" if scalar(@result) > 1; #should warn more vehemently if the search was on a primary key? - $result[0]; + scalar(@result) ? ($result[0]) : (); } =back @@ -825,7 +825,7 @@ sub hfields { =head1 VERSION -$Id: Record.pm,v 1.2 1999-08-04 10:41:22 ivan Exp $ +$Id: Record.pm,v 1.3 2000-03-03 18:21:38 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From cb457f9c0242ea9e7acc80b9aaadd0d1c9bf66a9 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 3 Mar 2000 18:45:21 +0000 Subject: use Apache::exit instead of exit in &eidiot - Registry wasn't overriding exit in modules --- FS/FS/CGI.pm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/CGI.pm b/FS/FS/CGI.pm index 3577c14b8..47c034e13 100644 --- a/FS/FS/CGI.pm +++ b/FS/FS/CGI.pm @@ -123,7 +123,9 @@ Sends headers and an HTML error message, then exits. sub eidiot { #warn "eidiot depriciated"; idiot(@_); - exit; + #exit; + use Apache; + Apache::exit; } =item popurl LEVEL -- cgit v1.2.1 From 089181476b72019013be25c540d71f862e805012 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 6 Mar 2000 15:04:59 +0000 Subject: bug in IPC::Open3 documentation? --- FS/FS/SSH.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/SSH.pm b/FS/FS/SSH.pm index 84ac06b44..0caae879e 100644 --- a/FS/FS/SSH.pm +++ b/FS/FS/SSH.pm @@ -121,7 +121,8 @@ Connects the supplied filehandles to the ssh process (in batch mode). sub sshopen3 { my($host,$writer,$reader,$error,$command)=@_; - open3($writer,$reader,$error,$ssh,'-o','Batchmode yes',$host,$command); + #open3($writer,$reader,$error,$ssh,'-o','Batchmode yes',$host,$command); + open3($reader,$writer,$error,$ssh,'-o','Batchmode yes',$host,$command); } sub _yesno { -- cgit v1.2.1 From 0eadaa520cb08c57df5ffb196b7e98956bc2849c Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 6 Mar 2000 15:15:26 +0000 Subject: backout silly change --- FS/FS/SSH.pm | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/SSH.pm b/FS/FS/SSH.pm index 0caae879e..84ac06b44 100644 --- a/FS/FS/SSH.pm +++ b/FS/FS/SSH.pm @@ -121,8 +121,7 @@ Connects the supplied filehandles to the ssh process (in batch mode). sub sshopen3 { my($host,$writer,$reader,$error,$command)=@_; - #open3($writer,$reader,$error,$ssh,'-o','Batchmode yes',$host,$command); - open3($reader,$writer,$error,$ssh,'-o','Batchmode yes',$host,$command); + open3($writer,$reader,$error,$ssh,'-o','Batchmode yes',$host,$command); } sub _yesno { -- cgit v1.2.1 From e3aaca5c08b8b39627978eb30d10dfb241946b93 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 6 Mar 2000 16:38:42 +0000 Subject: better error message. bah. --- FS/FS/svc_acct.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 079508b84..fcd8030df 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -348,7 +348,7 @@ sub check { $recref->{username} = $1; $recref->{username} =~ /[a-z]/ or return "Illegal username"; - $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum"; + $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum}; $recref->{popnum} = $1; return "Unkonwn popnum" unless ! $recref->{popnum} || @@ -450,7 +450,7 @@ sub check { =head1 VERSION -$Id: svc_acct.pm,v 1.2 1999-08-12 00:05:03 ivan Exp $ +$Id: svc_acct.pm,v 1.3 2000-03-06 16:38:42 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 44261274cf5d0bf453005c50d43050143cd18774 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 3 Apr 2000 02:32:57 +0000 Subject: accept anything in ARGV for -d Date::Parse --- FS/bin/freeside-bill | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-bill b/FS/bin/freeside-bill index 417df767b..208f92071 100755 --- a/FS/bin/freeside-bill +++ b/FS/bin/freeside-bill @@ -72,7 +72,9 @@ foreach $cust_main ( sub untaint_argv { foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV - $ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal arguement \"$ARGV[$_]\""; + #$ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal arguement \"$ARGV[$_]\""; + # Date::Parse + $ARGV[$_] =~ /^(.*)$/ || die "Illegal arguement \"$ARGV[$_]\""; $ARGV[$_]=$1; } } @@ -112,7 +114,7 @@ customers. Otherwise, bills all customers. =head1 VERSION -$Id: freeside-bill,v 1.3 1999-10-04 08:23:26 ivan Exp $ +$Id: freeside-bill,v 1.4 2000-04-03 02:32:57 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From e7004fed34b31db9e27020cc69f9723d1059cfd3 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 11 Apr 2000 00:06:27 +0000 Subject: CGI.pm detects mod_perl and calls appropriate exit (Registry's override doesn't work here) --- FS/FS/CGI.pm | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/CGI.pm b/FS/FS/CGI.pm index 47c034e13..1e8fca644 100644 --- a/FS/FS/CGI.pm +++ b/FS/FS/CGI.pm @@ -123,9 +123,14 @@ Sends headers and an HTML error message, then exits. sub eidiot { #warn "eidiot depriciated"; idiot(@_); - #exit; - use Apache; - Apache::exit; + if (exists $ENV{MOD_PERL}) { + eval { + use Apache; + Apache::exit(); + }; + } else { + exit; + } } =item popurl LEVEL -- cgit v1.2.1 From f38f7128e7058d102ac7898e0f06deaf4d1fd538 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 13 May 2000 21:50:12 +0000 Subject: cgisuidsetup takes an Apache object as well as a CGI object now. --- FS/FS/CGI.pm | 4 ++-- FS/FS/UID.pm | 11 ++++++++--- 2 files changed, 10 insertions(+), 5 deletions(-) (limited to 'FS') diff --git a/FS/FS/CGI.pm b/FS/FS/CGI.pm index 1e8fca644..198477ce6 100644 --- a/FS/FS/CGI.pm +++ b/FS/FS/CGI.pm @@ -141,8 +141,8 @@ Returns current URL with LEVEL levels of path removed from the end (default 0). sub popurl { my($up)=@_; - my($cgi)=&FS::UID::cgi; - my($url)=new URI::URL $cgi->url; + 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); diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm index 2315c266d..2cee65d11 100644 --- a/FS/FS/UID.pm +++ b/FS/FS/UID.pm @@ -98,8 +98,10 @@ sub cgisuidsetup { $cgi=shift; if ( $cgi->isa('CGI::Base') ) { carp "Use of CGI::Base is depriciated"; + } elsif ( $cgi->isa('Apache') ) { + } elsif ( ! $cgi->isa('CGI') ) { - croak "Pass a CGI object to cgisuidsetup!"; + croak "fatal: unrecognized object $cgi"; } cgisetotaker; adminsuidsetup($user); @@ -112,6 +114,7 @@ Returns the CGI (see L) object. =cut sub cgi { + carp "warning: \$FS::UID::cgi isa Apache" if $cgi->isa('Apache'); $cgi; } @@ -167,8 +170,10 @@ sub cgisetotaker { $user = lc ( $cgi->var('REMOTE_USER') ); } elsif ( $cgi && $cgi->isa('CGI') && defined $cgi->remote_user ) { $user = lc ( $cgi->remote_user ); + } elsif ( $cgi && $cgi->isa('Apache') ) { + $user = lc ( $cgi->connection->user ); } else { - die "fatal: Can't get REMOTE_USER!"; + die "fatal: Can't get REMOTE_USER! for cgi $cgi"; } $user; } @@ -241,7 +246,7 @@ coderef into the hash %FS::UID::callback : =head1 VERSION -$Id: UID.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ +$Id: UID.pm,v 1.2 2000-05-13 21:50:12 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 62a808f08c065aa5a29fb9cbf6b7108fe4cb8d15 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 13 May 2000 21:57:56 +0000 Subject: add print_batch script from Joel Griffiths --- FS/bin/freeside-print-batch | 266 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 266 insertions(+) create mode 100755 FS/bin/freeside-print-batch (limited to 'FS') diff --git a/FS/bin/freeside-print-batch b/FS/bin/freeside-print-batch new file mode 100755 index 000000000..c1a25edb2 --- /dev/null +++ b/FS/bin/freeside-print-batch @@ -0,0 +1,266 @@ +#!/usr/bin/perl -Tw + +use strict; +#use Date::Format; +use Time::Local; +use Getopt::Std; +use FS::Conf; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch); +use FS::cust_pay; +use FS::cust_pay_batch; + +# Get the currennt time and date +my $time = time; +my ($sec,$min,$hour,$mday,$mon,$year) = + (localtime($time) )[0,1,2,3,4,5]; +my $_date = + timelocal($sec,$min,$hour,$mday,$mon,$year); + +# Set the mail program +my $mail_program = "/usr/sbin/sendmail -t -n"; + +&untaint_argv; #what it sounds like (eww) +use vars qw($opt_v $opt_p $opt_e $opt_a $opt_d); +getopts("vpead"); #switches + +# Login to the database +my $user = shift or die &usage; +adminsuidsetup $user; + +# Get the needed configuration files +my $conf = new FS::Conf; +my $lpr = $conf->config('lpr'); +my $email = $conf->config('email'); + +my(@batch)=qsearch('cust_pay_batch',{}); +if (scalar(@batch) == 0) +{ + exit 1; +} + +# Open print and email pipes +# $lpr and opt_p for printing +# $email and opt_e for email +# +if ($lpr && $main::opt_p) +{ + open(LPR, "|$lpr"); + print LPR qq~C R E D I T C A R D P A Y M E N T S D U E $mon/$mday/$year\n\n~; +} + +if ($email && $main::opt_e) +{ + open (MAIL, "|$mail_program"); + print MAIL <getfield('state'); + my $zip = $cust_pay_batch->getfield('zip'); + my $amount = $cust_pay_batch->getfield('amount'); + my $last = $cust_pay_batch->getfield('last'); + my $address1 = $cust_pay_batch->getfield('address1'); + my $address2 = $cust_pay_batch->getfield('address2'); + my $first = $cust_pay_batch->getfield('first'); + my $city = $cust_pay_batch->getfield('city'); + my $cardnum = $cust_pay_batch->getfield('cardnum'); + my $payname = $cust_pay_batch->getfield('payname'); + my $exp = $cust_pay_batch->getfield('exp'); + my $invnum = $cust_pay_batch->getfield('invnum'); + my $custnum = $cust_pay_batch->getfield('custnum'); + + # Need a carriage return in address before address2 + # if it exists. Otherwise address will just be address1 + my $address = $address1; + $address .= "\n$address2" if ($address2); + + # Only print to the screen in verbose mode + if ($main::opt_v) + { + printf("Invoice %d for %s %s\tCustomer Number: %d\n", + $invnum, + $first, + $last, + $custnum); + + printf("\t%s\n", $address); + printf("\t%s, %s, %s\n\n", + $city, + $state, + $zip); + + printf("\tCard Number: %s\tExp:%s\n", + $cardnum, + $exp); + printf("\t\tName: %s\n", $payname); + printf("\t\tAmount: %.2f\n\n\n", $amount); + } + + if ($lpr && $main::opt_p) + { + printf(LPR "Invoice %d for %s %s\tCustomer Number: %d\n", + $invnum, + $first, + $last, + $custnum); + + printf(LPR "\t%s\n", $address); + printf(LPR "\t%s, %s, %s\n\n", + $city, + $state, + $zip); + + printf(LPR "\tCard Number: %s\tExp:%s\n", + $cardnum, + $exp); + printf(LPR "\t\tName: %s\n", $payname); + printf(LPR "\t\tAmount: %.2f\n\n\n", $amount); + } + + if ($email && $main::opt_e) + { + printf(MAIL "Invoice %d for %s %s\tCustomer Number: %d\n", + $invnum, + $first, + $last, + $custnum); + + printf(MAIL "\t%s\n", $address); + printf(MAIL "\t%s, %s, %s\n\n", + $city, + $state, + $zip); + + printf(MAIL "\tCard Number: %s\tExp:%s\n", + $cardnum, + $exp); + printf(MAIL "\t\tName: %s\n", $payname); + printf(MAIL "\t\tAmount: %.2f\n\n\n", $amount); + } + + # Now I want to delete the records from cust_pay_batch + # and mark the records in cust_pay as paid today if + # the delete (-d) command line option is set. + if($main::opt_a) + { + my $payment=new FS::cust_pay { + 'invnum' => $invnum, + 'paid' => $amount, + '_date' => $_date, + 'payby' => "CARD", + 'payinfo' => $cardnum, + 'paybatch' => "AUTO", + }; + + my $pay_error=$payment->insert; + if ($pay_error) + { + # warn might be better if you get root's mail + # NEED TO TEST THIS BEFORE DELETE IF WARN IS USED + die "Could not update cust_pay for invnum $invnum. $pay_error\n"; + } + } + + # This just deletes the records + # Must be last in the foreach loop + if($main::opt_d) + { + my $del_error = $cust_pay_batch->delete; + if ($del_error) + { + die "Could not delete cust_pay_batch for invnum $invnum. $del_error\n"; + } + } + +} + +# Now I need to close LPR and EMAIL if they were open +if($lpr && $main::opt_p) +{ + close LPR || die "Could not close printer: $lpr\n"; +} + +if($email && $main::opt_e) +{ + close MAIL || die "Could not close printer: $lpr\n"; +} + + +# subroutines +sub untaint_argv { + foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV + $ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal argument \"$ARGV[$_]\""; + $ARGV[$_]=$1; + } +} + +sub usage { + die "Usage:\n\n freeside-print-batch [-v] [-p] [-e] [-a] [-d] user\n"; +} + +=head1 NAME + +freeside-print-batch - Prints or emails cust_pay_batch. Also deletes + old records and adds payment to cust_pay. + Usually run after the bill command. + +=head1 SYNOPSIS + + freeside-print-batch [-v] [-p] [-e] [-a] [-d] user + +=head1 DESCRIPTION + +Prints or emails cust_pay_batch. Can enter payment and delete +printed records. Usually run as a cron job. + +-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. + +user: From the mapsecrets file - see config.html from the base documentation + +=head1 VERSION + +$Id: freeside-print-batch,v 1.1 2000-05-13 21:57:56 ivan Exp $ + +=head1 BUGS + +Yes..... Use at your own risk. No guarantees or warrantees of any +kind apply to this program. Parts of this program are hacked from +other GNU licensed software created mainly by Ivan Kohler. + +This is released under the GNU Public License. See www.gnu.org +for more information regarding this license. + +=head1 SEE ALSO + +L, config.html from the base documentation + +=head1 HISTORY + +griff@aver-computer.com July 99 + +$Log: freeside-print-batch,v $ +Revision 1.1 2000-05-13 21:57:56 ivan +add print_batch script from Joel Griffiths + + +=cut + + -- cgit v1.2.1 From ffe6f2fa392b5b8b190304e699c2a8fdc82476ed Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 15 Jun 2000 12:38:09 +0000 Subject: fix for ncancelled_pkgs - when called in scalar context, was only returning second item --- FS/FS/cust_main.pm | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 26883d554..34d601d67 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -450,15 +450,16 @@ Returns all non-cancelled packages (see L) for this customer. sub ncancelled_pkgs { my $self = shift; - qsearch( 'cust_pkg', { - 'custnum' => $self->custnum, - 'cancel' => '', - }), - qsearch( 'cust_pkg', { - 'custnum' => $self->custnum, - 'cancel' => 0, - }), - ; + @{ [ # force list context + qsearch( 'cust_pkg', { + 'custnum' => $self->custnum, + 'cancel' => '', + }), + qsearch( 'cust_pkg', { + 'custnum' => $self->custnum, + 'cancel' => 0, + }), + ] }; } =item bill OPTIONS @@ -993,7 +994,7 @@ sub check_invoicing_list { =head1 VERSION -$Id: cust_main.pm,v 1.4 2000-02-02 20:22:18 ivan Exp $ +$Id: cust_main.pm,v 1.5 2000-06-15 12:38:09 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 85d18115231d9c0a98e79eec997444d9f0d30866 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 15 Jun 2000 13:35:47 +0000 Subject: add radius method --- FS/FS/svc_acct.pm | 25 ++++++++++++++++++++++++- 1 file changed, 24 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index fcd8030df..339081a37 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -54,6 +54,8 @@ FS::svc_acct - Object methods for svc_acct records $error = $record->cancel; + %hash = $record->radius; + =head1 DESCRIPTION An FS::svc_acct object represents an account. FS::svc_acct inherits from @@ -446,11 +448,32 @@ sub check { ''; #no error } +=item radius + +Returns key/value pairs, suitable for assigning to a hash, for any RADIUS +attributes of this record. + +Note that this is now the preferred method for reading RADIUS attributes - +accessing the columns directly is discouraged, as the column names are +expected to change in the future. + +=cut + +sub radius { + my $self = shift; + map { + /^(radius_(.*))$/; + my($column, $attrib) = ($1, $2); + $attrib =~ s/_/\-/g; + ( $attrib, $self->getfield($column) ); + } grep { /^radius_/ && $self->getfield($_) } fields( $self->table ); +} + =back =head1 VERSION -$Id: svc_acct.pm,v 1.3 2000-03-06 16:38:42 ivan Exp $ +$Id: svc_acct.pm,v 1.4 2000-06-15 13:35:47 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From b6449417b8af1065a6e58f5cab11d63b33cbd2f9 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 17 Jun 2000 21:48:05 +0000 Subject: fix typo in error message --- FS/FS/cust_pay_batch.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_pay_batch.pm b/FS/FS/cust_pay_batch.pm index 7c5c6c404..0576cbefc 100644 --- a/FS/FS/cust_pay_batch.pm +++ b/FS/FS/cust_pay_batch.pm @@ -176,7 +176,7 @@ sub check { or return "Illegal zip: ". $self->zip; $self->zip($1); - $self->country =~ /^(\w\w)$/ or return "Illegal \w\wy"; + $self->country =~ /^(\w\w)$/ or return "Illegal country: ". $self->country; $self->country($1); #check invnum, custnum, ? @@ -188,7 +188,7 @@ sub check { =head1 VERSION -$Id: cust_pay_batch.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ +$Id: cust_pay_batch.pm,v 1.2 2000-06-17 21:48:05 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From e946a03513a43926a4da1ef82d486c64700b2623 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 20 Jun 2000 07:13:03 +0000 Subject: documentation update --- FS/FS/cust_main_invoice.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main_invoice.pm b/FS/FS/cust_main_invoice.pm index bd7d53dd6..309691a43 100644 --- a/FS/FS/cust_main_invoice.pm +++ b/FS/FS/cust_main_invoice.pm @@ -48,7 +48,7 @@ FS::Record. The following fields are currently supported: =item custnum - customer (see L) -=item 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) +=item dest - Invoice destination: If numeric, a svcnum (see L), if string, a literal email address, or `POST' to enable mailing (the default if no cust_main_invoice records exist) =back @@ -167,7 +167,7 @@ sub address { =head1 VERSION -$Id: cust_main_invoice.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ +$Id: cust_main_invoice.pm,v 1.2 2000-06-20 07:13:03 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 27649e60bc8cf16ba2f76731a4ebab471df3801c Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 22 Jun 2000 10:52:37 +0000 Subject: tyop --- FS/bin/freeside-bill | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-bill b/FS/bin/freeside-bill index 208f92071..680d29da5 100755 --- a/FS/bin/freeside-bill +++ b/FS/bin/freeside-bill @@ -104,7 +104,7 @@ the bill and collect methods of a cust_main object. See L. -i: real-time billing (as opposed to batch billing). only relevant for credit cards. - -d: Pretent it's 'date'. Date is in any format Date::Parse is happy with, + -d: Pretend it's 'date'. Date is in any format Date::Parse is happy with, but be careful. user: From the mapsecrets file - see config.html from the base documentation @@ -114,7 +114,7 @@ customers. Otherwise, bills all customers. =head1 VERSION -$Id: freeside-bill,v 1.4 2000-04-03 02:32:57 ivan Exp $ +$Id: freeside-bill,v 1.5 2000-06-22 10:52:37 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From b4a403644cb80a612dd028882f971bdd20839275 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 23 Jun 2000 12:25:59 +0000 Subject: FS::Record::qsearch - more portable, doesn't depend on $sth->execute returning a number of rows, uses placeholders and prepare_cached --- FS/FS/Record.pm | 86 +++++++++++++++++++++++++++++++++++---------------------- FS/FS/UID.pm | 32 +++++++++++++-------- 2 files changed, 74 insertions(+), 44 deletions(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index dae9f3707..0d989e300 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -1,17 +1,20 @@ package FS::Record; use strict; -use vars qw($dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK); +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 FS::UID qw(dbh checkruid swapuid getotaker datasrc); +use FS::UID qw(dbh checkruid swapuid getotaker datasrc driver_name); use FS::dbdef; +use diagnostics; @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; @@ -124,7 +127,7 @@ sub new { $hashref->{$field}='' unless defined $hashref->{$field}; #trim the '$' and ',' from money fields for Pg (belong HERE?) #(what about Pg i18n?) - if ( datasrc =~ m/Pg/ + if ( driver_name eq 'Pg' && $self->dbdef_table->column($field)->type eq 'money' ) { ${$hashref}{$field} =~ s/^\$//; ${$hashref}{$field} =~ s/\,//; @@ -157,37 +160,50 @@ objects. =cut sub qsearch { - my($table,$record) = @_; - my($dbh) = dbh; + my($table, $record) = @_; + my $dbh = dbh; + + my @fields = grep exists($record->{$_}), fields($table); + + my $statement = "SELECT * FROM $table"; + if ( @fields ) { + $statement .= " WHERE ". join(' AND ', map { + if ( $record->{$_} eq '' || $record->{$_} eq undef ) { + if ( driver_name eq 'Pg' ) { + "$_ IS NULL"; + } else { + qq-( $_ IS NULL OR $_ = "" )-; + } + } else { + "$_ = ?"; + } + } @fields ); + } - my(@fields)=grep exists($record->{$_}), fields($table); + warn $statement if $DEBUG; + my $sth = $dbh->prepare_cached($statement) or croak $dbh->errstr; - my($sth); - my($statement) = "SELECT * FROM $table". ( @fields - ? " WHERE ". join(' AND ', - map { - $record->{$_} eq '' - ? ( datasrc =~ m/Pg/ - ? "$_ IS NULL" - : "( $_ IS NULL OR $_ = \"\" )" - ) - : "$_ = ". _quote($record->{$_},$table,$_) - } @fields - ) : '' - ); - $sth=$dbh->prepare($statement) - or croak $dbh->errstr; #is that a little too harsh? hmm. - #warn $statement #if $debug # or some such; + $sth->execute( map $record->{$_}, + grep $record->{$_} ne '' && $record->{$_} ne undef, @fields + ) or croak $dbh->errstr; - if ( eval ' scalar(@FS::'. $table. '::ISA);' ) { - map { - eval 'new FS::'. $table. ' ( $sth->fetchrow_hashref );'; - } ( 1 .. $sth->execute ); + if ( eval 'scalar(@FS::'. $table. '::ISA);' ) { + if ( eval 'FS::'. $table. '->can(\'new\')' eq \&new ) { + #derivied class didn't override new method, so this optimization is safe + map { + new( "FS::$table", { %{$_} } ) + } @{$sth->fetchall_arrayref( {} )}; + } else { + warn "untested code (class FS::$table uses custom new method)"; + map { + eval 'FS::'. $table. '->new( { %{$_} } )'; + } @{$sth->fetchall_arrayref( {} )}; + } } else { - cluck "qsearch: warning: FS::$table not loaded; returning generic FS::Record objects"; + cluck "warning: FS::$table not loaded; returning FS::Record objects"; map { - new FS::Record ($table,$sth->fetchrow_hashref); - } ( 1 .. $sth->execute ); + FS::Record->new( $table, { %{$_} } ); + } @{$sth->fetchall_arrayref( {} )}; } } @@ -390,7 +406,7 @@ sub delete { map { $self->getfield($_) eq '' #? "( $_ IS NULL OR $_ = \"\" )" - ? ( datasrc =~ m/Pg/ + ? ( driver_name eq 'Pg' ? "$_ IS NULL" : "( $_ IS NULL OR $_ = \"\" )" ) @@ -462,7 +478,7 @@ sub replace { map { $old->getfield($_) eq '' #? "( $_ IS NULL OR $_ = \"\" )" - ? ( datasrc =~ m/Pg/ + ? ( driver_name eq 'Pg' ? "$_ IS NULL" : "( $_ IS NULL OR $_ = \"\" )" ) @@ -825,7 +841,7 @@ sub hfields { =head1 VERSION -$Id: Record.pm,v 1.3 2000-03-03 18:21:38 ivan Exp $ +$Id: Record.pm,v 1.4 2000-06-23 12:25:59 ivan Exp $ =head1 BUGS @@ -849,7 +865,7 @@ The ut_ methods should ask the dbdef for a default length. ut_sqltype (like ut_varchar) should all be defined -A fallback check method should be provided whith uses the dbdef. +A fallback check method should be provided which uses the dbdef. The ut_money method assumes money has two decimal digits. @@ -864,6 +880,10 @@ All the subroutines probably should be methods, here or elsewhere. Probably should borrow/use some dbdef methods where appropriate (like sub fields) +As of 1.14, DBI fetchall_hashref( {} ) doesn't set fetchrow_hashref NAME_lc, +or allow it to be set. Working around it is ugly any way around - DBI should +be fixed. (only affects RDBMS which return uppercase column names) + =head1 SEE ALSO L, L, L diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm index 2cee65d11..88d733829 100644 --- a/FS/FS/UID.pm +++ b/FS/FS/UID.pm @@ -3,19 +3,19 @@ package FS::UID; use strict; use vars qw( @ISA @EXPORT_OK $cgi $dbh $freeside_uid $user - $conf_dir $secrets $datasrc $db_user $db_pass %callback + $conf_dir $secrets $datasrc $db_user $db_pass %callback $driver_name ); use subs qw( getsecrets cgisetotaker ); use Exporter; -use Carp; +use Carp qw(carp croak cluck); use DBI; use FS::Conf; @ISA = qw(Exporter); @EXPORT_OK = qw(checkeuid checkruid swapuid cgisuidsetup - adminsuidsetup getotaker dbh datasrc getsecrets ); + adminsuidsetup getotaker dbh datasrc getsecrets driver_name ); $freeside_uid = scalar(getpwnam('freeside')); @@ -39,6 +39,8 @@ FS::UID - Subroutines for database login and assorted other stuff $datasrc = datasrc; + $driver_name = driver_name; + =head1 DESCRIPTION Provides a hodgepodge of subroutines. @@ -89,8 +91,8 @@ sub adminsuidsetup { =item cgisuidsetup CGI_object -Stores the CGI (see L) object for later use. (CGI::Base is depriciated) -Runs adminsuidsetup. +Takes a single argument, which is a CGI (see L) or Apache (see L) +object (CGI::Base is depriciated). Runs cgisetotaker and then adminsuidsetup. =cut @@ -138,10 +140,16 @@ sub datasrc { $datasrc; } -#hack for web demo -#sub setdbh { -# $dbh=$_[0]; -#} +=item driver_name + +Returns just the driver name portion of the DBI data source. + +=cut + +sub driver_name { + return $driver_name if defined $driver_name; + $driver_name = ( split(':', $datasrc) )[1]; +} sub suidsetup { croak "suidsetup depriciated"; @@ -160,7 +168,8 @@ sub getotaker { =item cgisetotaker Sets and returns the CGI REMOTE_USER. $cgi should be defined as a CGI.pm -object. Support for CGI::Base and derived classes is depriciated. +object (see L) or an Apache object (see L). Support for CGI::Base +and derived classes is depriciated. =cut @@ -229,6 +238,7 @@ sub getsecrets { ($datasrc, $db_user, $db_pass) = $conf->config($secrets) or die "Can't get secrets: $!"; $FS::Conf::default_dir = $conf_dir. "/conf.$datasrc"; + undef $driver_name; ($datasrc, $db_user, $db_pass); } @@ -246,7 +256,7 @@ coderef into the hash %FS::UID::callback : =head1 VERSION -$Id: UID.pm,v 1.2 2000-05-13 21:50:12 ivan Exp $ +$Id: UID.pm,v 1.3 2000-06-23 12:25:59 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From d2c5fa2eb293628ae281120322eb0e70d6a92a7d Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 24 Jun 2000 00:28:30 +0000 Subject: don't use Date::Manip; report correct program name in freeside-bill usage msg --- FS/FS/cust_main.pm | 7 ++++--- FS/bin/freeside-bill | 4 ++-- 2 files changed, 6 insertions(+), 5 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 34d601d67..2a8a8b7ee 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -11,7 +11,7 @@ use Safe; use Carp; use Time::Local; use Date::Format; -use Date::Manip; +#use Date::Manip; use Mail::Internet; use Mail::Header; use Business::CreditCard; @@ -546,7 +546,8 @@ sub bill { warn "Error reval-ing part_pkg->recur pkgpart ", $part_pkg->pkgpart, ": $@"; } else { - #change this bit to use Date::Manip? + #change this bit to use Date::Manip? CAREFUL with timezones (see + # mailing list archive) #$sdate=$cust_pkg->bill || time; #$sdate=$cust_pkg->bill || $time; $sdate = $cust_pkg->bill || $cust_pkg->setup || $time; @@ -994,7 +995,7 @@ sub check_invoicing_list { =head1 VERSION -$Id: cust_main.pm,v 1.5 2000-06-15 12:38:09 ivan Exp $ +$Id: cust_main.pm,v 1.6 2000-06-24 00:28:30 ivan Exp $ =head1 BUGS diff --git a/FS/bin/freeside-bill b/FS/bin/freeside-bill index 680d29da5..42991c4f8 100755 --- a/FS/bin/freeside-bill +++ b/FS/bin/freeside-bill @@ -80,7 +80,7 @@ sub untaint_argv { } sub usage { - die "Usage:\n\n bill [ -c [ i ] ] [ -d 'date' ] [ -b ] user\n"; + die "Usage:\n\n freeside-bill [ -c [ i ] ] [ -d 'date' ] [ -b ] user\n"; } =head1 NAME @@ -114,7 +114,7 @@ customers. Otherwise, bills all customers. =head1 VERSION -$Id: freeside-bill,v 1.5 2000-06-22 10:52:37 ivan Exp $ +$Id: freeside-bill,v 1.6 2000-06-24 00:28:30 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 952a38a1f13f58d8be92a501fc40b9bd66291867 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 27 Jun 2000 11:27:55 +0000 Subject: logically identical, but -w safe --- FS/FS/Record.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 0d989e300..c23ce941e 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -168,7 +168,7 @@ sub qsearch { my $statement = "SELECT * FROM $table"; if ( @fields ) { $statement .= " WHERE ". join(' AND ', map { - if ( $record->{$_} eq '' || $record->{$_} eq undef ) { + if ( ! defined($record->{$_} || $record->{$_} eq '' ) { if ( driver_name eq 'Pg' ) { "$_ IS NULL"; } else { @@ -841,7 +841,7 @@ sub hfields { =head1 VERSION -$Id: Record.pm,v 1.4 2000-06-23 12:25:59 ivan Exp $ +$Id: Record.pm,v 1.5 2000-06-27 11:27:55 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 064b854f445b96607bb1193bb277f44a5b84b00a Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 27 Jun 2000 11:29:52 +0000 Subject: fix typo in last patch, and another gratuitous -w pleaser --- FS/FS/Record.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index c23ce941e..69913c18d 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -168,7 +168,7 @@ sub qsearch { my $statement = "SELECT * FROM $table"; if ( @fields ) { $statement .= " WHERE ". join(' AND ', map { - if ( ! defined($record->{$_} || $record->{$_} eq '' ) { + if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) { if ( driver_name eq 'Pg' ) { "$_ IS NULL"; } else { @@ -184,7 +184,7 @@ sub qsearch { my $sth = $dbh->prepare_cached($statement) or croak $dbh->errstr; $sth->execute( map $record->{$_}, - grep $record->{$_} ne '' && $record->{$_} ne undef, @fields + grep defined( $record->{$_} ) && $record->{$_} ne '', @fields ) or croak $dbh->errstr; if ( eval 'scalar(@FS::'. $table. '::ISA);' ) { @@ -841,7 +841,7 @@ sub hfields { =head1 VERSION -$Id: Record.pm,v 1.5 2000-06-27 11:27:55 ivan Exp $ +$Id: Record.pm,v 1.6 2000-06-27 11:29:52 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From b84f789033eba9a0fc74bca5a071cfefd87f3c69 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 27 Jun 2000 12:15:37 +0000 Subject: i18 --- FS/FS/Record.pm | 16 +++++++++++----- FS/FS/cust_main.pm | 14 +++++++++----- 2 files changed, 20 insertions(+), 10 deletions(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 69913c18d..12cc77ebf 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -8,7 +8,6 @@ use Carp qw(carp cluck croak confess); use File::CounterFile; use FS::UID qw(dbh checkruid swapuid getotaker datasrc driver_name); use FS::dbdef; -use diagnostics; @ISA = qw(Exporter); @EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef); @@ -694,25 +693,32 @@ sub ut_alphan { ''; } -=item ut_phonen COLUMN +=item ut_phonen COLUMN [ COUNTRY ] Check/untaint phone numbers. May be null. If there is an error, returns the error, otherwise returns false. +Takes an optional two-letter ISO country code; without it or with unsupported +countries, ut_phonen simply calls ut_alphan. + =cut sub ut_phonen { - my($self,$field)=@_; + my( $self, $field, $country ) = @_; + return $self->ut_alphan($field) unless defined $country; my $phonen = $self->getfield($field); if ( $phonen eq '' ) { $self->setfield($field,''); - } else { + } elsif ( $country eq 'US' ) { $phonen =~ s/\D//g; $phonen =~ /^(\d{3})(\d{3})(\d{4})(\d*)$/ or return "Illegal (phone) $field: ". $self->getfield($field); $phonen = "$1-$2-$3"; $phonen .= " x$4" if $4; $self->setfield($field,$phonen); + } else { + warn "don't know how to check phone numbers for country $country"; + return $self->ut_alphan($field); } ''; } @@ -841,7 +847,7 @@ sub hfields { =head1 VERSION -$Id: Record.pm,v 1.6 2000-06-27 11:29:52 ivan Exp $ +$Id: Record.pm,v 1.7 2000-06-27 12:15:37 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 2a8a8b7ee..b863748a0 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -312,9 +312,6 @@ sub check { || $self->ut_text('city') || $self->ut_textn('county') || $self->ut_textn('state') - || $self->ut_phonen('daytime') - || $self->ut_phonen('night') - || $self->ut_phonen('fax') ; return $error if $error; @@ -357,7 +354,14 @@ sub check { } ); } - $self->zip =~ /^\s*(\w[\w\-\s]{3,8}\w)\s*$/ + $error = + $self->ut_phonen('daytime', $self->country) + || $self->ut_phonen('night', $self->country) + || $self->ut_phonen('fax', $self->country) + ; + return $error if $error; + + $self->zip =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/ or return "Illegal zip: ". $self->zip; $self->zip($1); @@ -995,7 +999,7 @@ sub check_invoicing_list { =head1 VERSION -$Id: cust_main.pm,v 1.6 2000-06-24 00:28:30 ivan Exp $ +$Id: cust_main.pm,v 1.7 2000-06-27 12:15:37 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From be4e54da250b7b94ddfd67c9f8eeb02288e10020 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 28 Jun 2000 12:52:22 +0000 Subject: bugfix to accept shells that evaluate to false in perl, like the empty string. --- FS/FS/svc_acct.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 339081a37..14979ed09 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -381,8 +381,8 @@ sub check { unless ( $recref->{username} eq 'sync' ) { my($shell); - if ( $shell = (grep $_ eq $recref->{shell}, @shells)[0] ) { - $recref->{shell} = $shell; + if ( grep $_ eq $recref->{shell}, @shells ) { + $recref->{shell} = (grep $_ eq $recref->{shell}, @shells)[0]; } else { return "Illegal shell \`". $self->shell. "\'; ". $conf->dir. "/shells contains: @shells"; @@ -473,7 +473,7 @@ sub radius { =head1 VERSION -$Id: svc_acct.pm,v 1.4 2000-06-15 13:35:47 ivan Exp $ +$Id: svc_acct.pm,v 1.5 2000-06-28 12:52:22 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 9d6e81f15df01d7146def82c6e62d7c65fd2bc82 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 28 Jun 2000 12:54:33 +0000 Subject: superfluous my() --- FS/FS/svc_acct.pm | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 14979ed09..93354296b 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -380,7 +380,6 @@ sub check { ; unless ( $recref->{username} eq 'sync' ) { - my($shell); if ( grep $_ eq $recref->{shell}, @shells ) { $recref->{shell} = (grep $_ eq $recref->{shell}, @shells)[0]; } else { @@ -473,7 +472,7 @@ sub radius { =head1 VERSION -$Id: svc_acct.pm,v 1.5 2000-06-28 12:52:22 ivan Exp $ +$Id: svc_acct.pm,v 1.6 2000-06-28 12:54:33 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From a875d5b4fd2d12937c7a53bed773490e2f3ba50f Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 29 Jun 2000 11:12:20 +0000 Subject: don't block on $whois_hack trueness when adding new domains. --- FS/FS/svc_domain.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm index e1e4eb8b5..5cfe69081 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -160,7 +160,7 @@ sub insert { my $whois = $self->whois; return "Domain in use (see whois)" - if ( $self->action eq "N" && $whois ); + if ( $self->action eq "N" && ! $whois_hack && $whois ); return "Domain not found (see whois)" if ( $self->action eq "M" && ! $whois ); @@ -459,7 +459,7 @@ sub submit_internic { =head1 VERSION -$Id: svc_domain.pm,v 1.6 2000-03-01 08:13:59 ivan Exp $ +$Id: svc_domain.pm,v 1.7 2000-06-29 11:12:20 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 5072965ec7e8d55ef82769fc322240abc7fb7e00 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 29 Jun 2000 11:56:52 +0000 Subject: md5 passwords can are 34 characters long and have $ in them. --- FS/FS/svc_acct.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 93354296b..26c634be3 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -436,7 +436,7 @@ sub check { #$recref->{password} = $1. # crypt($3,$saltset[int(rand(64))].$saltset[int(rand(64))] #; - } elsif ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([\w\.\/]{13,24})$/ ) { + } elsif ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([\w\.\/\$]{13,34})$/ ) { $recref->{_password} = $1.$3; } elsif ( $recref->{_password} eq '*' ) { $recref->{_password} = '*'; @@ -472,7 +472,7 @@ sub radius { =head1 VERSION -$Id: svc_acct.pm,v 1.6 2000-06-28 12:54:33 ivan Exp $ +$Id: svc_acct.pm,v 1.7 2000-06-29 11:56:52 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 5a698d284b646e4077144193ead58cf0f0f91893 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 30 Jun 2000 10:37:18 +0000 Subject: maildisablecatchall configuration file --- FS/FS/svc_acct_sm.pm | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct_sm.pm b/FS/FS/svc_acct_sm.pm index 96bc3a27b..15cf86d9b 100644 --- a/FS/FS/svc_acct_sm.pm +++ b/FS/FS/svc_acct_sm.pm @@ -117,8 +117,9 @@ sub insert { return "First domain username (domuser) for domain (domsvc) must be " . qq='*' (catch-all)!= - if $self->domuser ne '*' && - ! qsearch('svc_acct_sm',{ 'domsvc' => $self->domsvc } ); + if $self->domuser ne '*' + && ! qsearch('svc_acct_sm',{ 'domsvc' => $self->domsvc } ) + && ! $conf->exists('maildisablecatchall'); $error = $self->SUPER::insert; return $error if $error; @@ -232,7 +233,7 @@ sub check { =head1 VERSION -$Id: svc_acct_sm.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ +$Id: svc_acct_sm.pm,v 1.2 2000-06-30 10:37:18 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 24a036da06d8418666d966895aa94cf0675318fd Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 4 Jul 2000 13:42:37 +0000 Subject: noted a API inconsistancy --- FS/FS/svc_acct.pm | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 26c634be3..a59d86331 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -472,7 +472,7 @@ sub radius { =head1 VERSION -$Id: svc_acct.pm,v 1.7 2000-06-29 11:56:52 ivan Exp $ +$Id: svc_acct.pm,v 1.8 2000-07-04 13:42:37 ivan Exp $ =head1 BUGS @@ -482,6 +482,10 @@ The bits which ssh should fork before doing so. The $recref stuff in sub check should be cleaned up. +The suspend, unsuspend and cancel methods update the database, but not the +current object. This is probably a bug as it's unexpected and +counterintuitive. + =head1 SEE ALSO L, L, L, L, -- cgit v1.2.1 From 61fc4e61c6644d2e0abdffe8cbdfafd4b092e84b Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 6 Jul 2000 08:57:28 +0000 Subject: support for radius check attributes (except importing). poorly documented. --- FS/FS/svc_acct.pm | 36 +++++++++++++++++++++++++++++++++--- 1 file changed, 33 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index a59d86331..558e3838b 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -4,6 +4,7 @@ use strict; use vars qw( @ISA $nossh_hack $conf $dir_prefix @shells $usernamemin $usernamemax $passwordmin $shellmachine @saltset @pw_set); +use Carp; use FS::Conf; use FS::Record qw( qsearchs fields ); use FS::svc_Common; @@ -449,8 +450,19 @@ sub check { =item radius +Depriciated, use radius_reply instead. + +=cut + +sub radius { + carp "FS::svc_acct::radius depriciated, use radius_reply"; + $_[0]->radius_reply; +} + +=item radius_reply + Returns key/value pairs, suitable for assigning to a hash, for any RADIUS -attributes of this record. +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 @@ -458,7 +470,7 @@ expected to change in the future. =cut -sub radius { +sub radius_reply { my $self = shift; map { /^(radius_(.*))$/; @@ -468,11 +480,29 @@ sub radius { } grep { /^radius_/ && $self->getfield($_) } fields( $self->table ); } +=item radius_check + +Returns key/value pairs, suitable for assigning to a hash, for any RADIUS +check attributes of this record. + +Accessing RADIUS attributes directly is not supported and will break in the +future. + =back +sub radius_check { + my $self = shift; + map { + /^(rc_(.*))$/; + my($column, $attrib) = ($1, $2); + $attrib =~ s/_/\-/g; + ( $attrib, $self->getfield($column) ); + } grep { /^rc_/ && $self->getfield($_) } fields( $self->table ); +} + =head1 VERSION -$Id: svc_acct.pm,v 1.8 2000-07-04 13:42:37 ivan Exp $ +$Id: svc_acct.pm,v 1.9 2000-07-06 08:57:27 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From aa0ba10d4319ee7cd473776df10abf7a3eec18fc Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 6 Jul 2000 13:56:42 +0000 Subject: mis-PODed =back should have been a =cut in conjunction with AUTOLOAD this was sure a pain to find --- FS/FS/svc_acct.pm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 558e3838b..56ad5d7fa 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -488,7 +488,7 @@ check attributes of this record. Accessing RADIUS attributes directly is not supported and will break in the future. -=back +=cut sub radius_check { my $self = shift; @@ -500,9 +500,11 @@ sub radius_check { } grep { /^rc_/ && $self->getfield($_) } fields( $self->table ); } +=cut + =head1 VERSION -$Id: svc_acct.pm,v 1.9 2000-07-06 08:57:27 ivan Exp $ +$Id: svc_acct.pm,v 1.10 2000-07-06 13:56:42 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From ec0441faaefa3fa2bd41e88ddc4bd3049198612a Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 17 Jul 2000 10:37:27 +0000 Subject: make remote commands configurable --- FS/FS/svc_acct.pm | 119 +++++++++++++++++++++++++++++++++--------------------- 1 file changed, 73 insertions(+), 46 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 56ad5d7fa..5986bff87 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -3,7 +3,8 @@ package FS::svc_acct; use strict; use vars qw( @ISA $nossh_hack $conf $dir_prefix @shells $usernamemin $usernamemax $passwordmin - $shellmachine @saltset @pw_set); + $shellmachine $useradd $usermod $userdel + @saltset @pw_set); use Carp; use FS::Conf; use FS::Record qw( qsearchs fields ); @@ -23,6 +24,27 @@ $FS::UID::callback{'FS::svc_acct'} = sub { $usernamemin = $conf->config('usernamemin') || 2; $usernamemax = $conf->config('usernamemax'); $passwordmin = $conf->config('passwordmin') || 6; + if ( $shellmachine ) { + if ( $conf->exists('shellmachine-useradd') ) { + $useradd = join("\n", $conf->config('shellmachine-useradd') ) + || 'cp -pr /etc/skel $dir; chown -R $uid.$gid $dir'; + } else { + $useradd = 'useradd -d $dir -m -s $shell -u $uid $username'; + } + if ( $conf->exists('shellmachine-userdel') ) { + $userdel = join("\n", $conf->config('shellmachine-userdel') ) + || 'rm -rf $dir'; + } else { + $userdel = 'userdel $username'; + } + $usermod = join("\n", $conf->config('shellmachine-usermod') ) + || '[ -d $old_dir ] && mv $old_dir $new_dir || ( '. + 'chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; '. + 'find . -depth -print | cpio -pdm $new_dir; '. + 'chmod u-t $new_dir; chown -R $uid.$gid $new_dir; '. + 'rm -rf $old_dir'. + ')'; + } }; @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); @@ -111,12 +133,21 @@ 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 +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 executed on shellmachine via ssh. This behaviour can be surpressed by -setting $FS::svc_acct::nossh_hack true. +is the default. If the shellmachine-useradd configuration file exists but +it empty, + + cp -pr /etc/skel $dir; chown -R $uid.$gid $dir + +is the default instead. Otherwise the contents of the file are treated as +a double-quoted perl string, with the following variables available: +$username, $uid, $gid, $dir, and $shell. =cut @@ -148,26 +179,15 @@ sub insert { $error = $self->SUPER::insert; return $error if $error; - my ( $username, $uid, $dir, $shell ) = ( + my( $username, $uid, $gid, $dir, $shell ) = ( $self->username, $self->uid, + $self->gid, $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; + if ( $username && $uid && $dir && $shellmachine && ! $nossh_hack ) { + ssh("root\@$shellmachine", eval "$useradd"); } ''; #no error @@ -180,12 +200,22 @@ 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: +If the configuration value (see L) 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 executed on shellmachine via ssh. This behaviour can be surpressed by -setting $FS::svc_acct::nossh_hack true. +is the default. If the shellmachine-userdel configuration file exists but +is empty, + + rm -rf $dir + +is the default instead. Otherwise the contents of the file are treated as a +double-quoted perl string, with the following variables available: +$username and $dir. =cut @@ -203,9 +233,12 @@ sub delete { $error = $self->SUPER::delete; return $error if $error; - my $username = $self->username; + my( $username, $dir ) = ( + $self->username, + $self->dir, + ); if ( $username && $shellmachine && ! $nossh_hack ) { - ssh("root\@$shellmachine","userdel $username"); + ssh("root\@$shellmachine", eval "$userdel"); } ''; @@ -217,11 +250,13 @@ 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: +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 ] && ( + [ -d $old_dir ] && mv $old_dir $new_dir || ( chmod u+t $old_dir; - umask 022; mkdir $new_dir; cd $old_dir; find . -depth -print | cpio -pdm $new_dir; @@ -258,21 +293,14 @@ sub replace { $error = $new->SUPER::replace($old); return $error if $error; - my ( $old_dir, $new_dir ) = ( $old->getfield('dir'), $new->getfield('dir') ); - my ( $uid, $gid) = ( $new->getfield('uid'), $new->getfield('gid') ); - if ( $old_dir - && $new_dir - && $old_dir ne $new_dir - && ! $nossh_hack - ) { - ssh("root\@$shellmachine","[ -d $old_dir ] && ". - "( chmod u+t $old_dir; ". #turn off qmail delivery - "umask 022; mkdir $new_dir; cd $old_dir; ". - "find . -depth -print | cpio -pdm $new_dir; ". - "chmod u-t $new_dir; chown -R $uid.$gid $new_dir; ". - "rm -rf $old_dir". - ")" - ); + my ( $old_dir, $new_dir, $uid, $gid ) = ( + $old->getfield('dir'), + $new->getfield('dir'), + $new->getfield('uid'), + $new->getfield('gid'), + ); + if ( $old_dir && $new_dir && $old_dir ne $new_dir && ! $nossh_hack ) { + ssh("root\@$shellmachine", eval "$usermod" ); } ''; #no error @@ -504,13 +532,12 @@ sub radius_check { =head1 VERSION -$Id: svc_acct.pm,v 1.10 2000-07-06 13:56:42 ivan Exp $ +$Id: svc_acct.pm,v 1.11 2000-07-17 10:37:27 ivan Exp $ =head1 BUGS -The remote commands should be configurable. - -The bits which ssh should fork before doing so. +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. -- cgit v1.2.1 From 41e9b7ac95959d4392a7aee9b8aef1cc301a1eb6 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 17 Jul 2000 10:53:42 +0000 Subject: prevent accounts which are the target of mail aliases from being deleted --- FS/FS/svc_acct.pm | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 5986bff87..93b657f2d 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -12,6 +12,7 @@ use FS::svc_Common; use FS::SSH qw(ssh); use FS::part_svc; use FS::svc_acct_pop; +use FS::svc_acct_sm; @ISA = qw( FS::svc_Common ); @@ -223,6 +224,9 @@ sub delete { my $self = shift; my $error; + return "Can't delete an account which has mail aliases pointed to it!" + if $self->uid && qsearch( 'svc_acct_sm', { 'domuid' => $self->uid } ); + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -532,7 +536,7 @@ sub radius_check { =head1 VERSION -$Id: svc_acct.pm,v 1.11 2000-07-17 10:37:27 ivan Exp $ +$Id: svc_acct.pm,v 1.12 2000-07-17 10:53:42 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 48b905cd57f4b9e0f33e84bcee15b28d812c3d9f Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 17 Jul 2000 13:51:07 +0000 Subject: silly mistake --- FS/FS/svc_acct.pm | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 93b657f2d..d2e3918da 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -188,7 +188,7 @@ sub insert { $self->shell, ); if ( $username && $uid && $dir && $shellmachine && ! $nossh_hack ) { - ssh("root\@$shellmachine", eval "$useradd"); + ssh("root\@$shellmachine", eval qq("$useradd") ); } ''; #no error @@ -242,7 +242,7 @@ sub delete { $self->dir, ); if ( $username && $shellmachine && ! $nossh_hack ) { - ssh("root\@$shellmachine", eval "$userdel"); + ssh("root\@$shellmachine", eval qq("$userdel") ); } ''; @@ -304,7 +304,7 @@ sub replace { $new->getfield('gid'), ); if ( $old_dir && $new_dir && $old_dir ne $new_dir && ! $nossh_hack ) { - ssh("root\@$shellmachine", eval "$usermod" ); + ssh("root\@$shellmachine", eval qq("$usermod") ); } ''; #no error @@ -536,7 +536,7 @@ sub radius_check { =head1 VERSION -$Id: svc_acct.pm,v 1.12 2000-07-17 10:53:42 ivan Exp $ +$Id: svc_acct.pm,v 1.13 2000-07-17 13:51:07 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From ec9e52e13c2fa488e190db6ce2cacfcf3f978676 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 9 Aug 2000 11:30:41 +0000 Subject: templatable invoices --- FS/FS/cust_bill.pm | 224 ++++++++++++++++++++++++++--------------------------- 1 file changed, 110 insertions(+), 114 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 30db4699f..1d0790ef1 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -1,8 +1,10 @@ package FS::cust_bill; use strict; -use vars qw( @ISA $conf $add1 $add2 $add3 $add4 ); +use vars qw( @ISA $conf $invoice_template ); +use vars qw( $invoice_lines @buf ); #yuck use Date::Format; +use Text::Template; use FS::Record qw( qsearch qsearchs ); use FS::cust_main; use FS::cust_bill_pkg; @@ -15,7 +17,20 @@ use FS::cust_pkg; #ask FS::UID to run this stuff for us later $FS::UID::callback{'FS::cust_bill'} = sub { $conf = new FS::Conf; - ( $add1, $add2, $add3, $add4 ) = ( $conf->config('address'), '', '', '', '' ); + my @invoice_template = $conf->config('invoice_template') + or die "cannot load config file invoice_template"; + $invoice_lines = 0; + foreach ( grep /invoice_lines\(\d+\)/, @invoice_template ) { #kludgy + /invoice_lines\((\d+)\)/; + $invoice_lines += $1; + } + die "no invoice_lines() functions in template?" unless $invoice_lines; + $invoice_template = new Text::Template ( + TYPE => 'ARRAY', + SOURCE => [ map "$_\n", @invoice_template ], + ) or die "can't create new Text::Template object: $Text::Template::ERROR"; + $invoice_template->compile() + or die "can't compile template: $Text::Template::ERROR"; }; =head1 NAME @@ -233,7 +248,7 @@ sub cust_pay { =item print_text [TIME]; -Returns an ASCII invoice, as a list of lines. +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. @@ -246,7 +261,7 @@ sub print_text { my( $self, $today ) = ( shift, shift ); $today ||= time; - my $invnum = $self->invnum; +# my $invnum = $self->invnum; my $cust_main = qsearchs('cust_main', { 'custnum', $self->custnum } ); $cust_main->payname( $cust_main->first. ' '. $cust_main->getfield('last') ) unless $cust_main->payname; @@ -255,48 +270,24 @@ sub print_text { my( $cr_total, @cr_cust_credit ) = $self->cust_credit; #credits my $balance_due = $self->owed + $pr_total - $cr_total; - #overdue? - my $overdue = ( - $balance_due > 0 - && $today > $self->_date - && $self->printed > 1 - ); + # - #printing bits here (yuck!) - - my @collect = (); - - my($description,$amount); - my(@buf); - - #format address - my($l,@address)=(0,'','','','','','',''); - $address[$l++] = - $cust_main->payname. - ( ( $cust_main->payby eq 'BILL' ) && $cust_main->payinfo - ? " (P.O. #". $cust_main->payinfo. ")" - : '' - ) - ; - $address[$l++]=$cust_main->company if $cust_main->company; - $address[$l++]=$cust_main->address1; - $address[$l++]=$cust_main->address2 if $cust_main->address2; - $address[$l++]=$cust_main->city. ", ". $cust_main->state. " ". - $cust_main->zip; - $address[$l++]=$cust_main->country unless $cust_main->country eq 'US'; + #my @collect = (); + #my($description,$amount); + @buf = (); #previous balance foreach ( @pr_cust_bill ) { - push @buf, ( + 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,('',''); + push @buf,['','-----------']; + push @buf,['Total Previous Balance','$' . sprintf("%10.2f",$pr_total ) ]; + push @buf,['','']; } #new charges @@ -309,117 +300,122 @@ sub print_text { my($pkg)=$part_pkg->pkg; if ( $_->setup != 0 ) { - push @buf, ( "$pkg Setup",'$' . sprintf("%10.2f",$_->setup) ); - push @buf, map { " ". $_->[0]. ": ". $_->[1], '' } $cust_pkg->labels; + push @buf, [ "$pkg Setup",'$' . sprintf("%10.2f",$_->setup) ]; + push @buf, + map { [ " ". $_->[0]. ": ". $_->[1], '' ] } $cust_pkg->labels; } if ( $_->recur != 0 ) { - push @buf, ( + push @buf, [ "$pkg (" . time2str("%x",$_->sdate) . " - " . time2str("%x",$_->edate) . ")", '$' . sprintf("%10.2f",$_->recur) - ); - push @buf, map { " ". $_->[0]. ": ". $_->[1], '' } $cust_pkg->labels; + ]; + push @buf, + map { [ " ". $_->[0]. ": ". $_->[1], '' ] } $cust_pkg->labels; } } else { #pkgnum Tax - push @buf,("Tax",'$' . sprintf("%10.2f",$_->setup) ) + 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 New Charges', + '$' . sprintf("%10.2f",$self->charged) ]; + push @buf,['','']; - push @buf,('','-----------'); - push @buf,('Total Charges', - '$' . sprintf("%10.2f",$self->charged + $pr_total) ); - push @buf,('',''); + push @buf,['','-----------']; + push @buf,['Total Charges', + '$' . sprintf("%10.2f",$self->charged + $pr_total) ]; + push @buf,['','']; #credits foreach ( @cr_cust_credit ) { - push @buf,( + push @buf,[ "Credit #". $_->crednum. " (" . time2str("%x",$_->_date) .")", '$' . sprintf("%10.2f",$_->credited) - ); + ]; } #get & print payments foreach ( $self->cust_pay ) { - push @buf,( + 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 + push @buf,['','-----------']; + push @buf,['Balance Due','$' . + sprintf("%10.2f",$self->owed + $pr_total - $cr_total ) ]; + + #setup template variables + + package FS::cust_bill::_template; #! + use vars qw( $invnum $date $page $total_pages @address $overdue @buf ); + + $invnum = $self->invnum; + $date = $self->_date; + $page = 1; + + $total_pages = + int( scalar(@FS::cust_bill::buf) / $FS::cust_bill::invoice_lines ); + $total_pages++ + if scalar(@FS::cust_bill::buf) % $FS::cust_bill::invoice_lines; + + + #format address (variable for the template) + my $l = 0; + @address = ( '', '', '', '', '', '' ); + package FS::cust_bill; #! + $FS::cust_bill::_template::address[$l++] = + $cust_main->payname. + ( ( $cust_main->payby eq 'BILL' ) && $cust_main->payinfo + ? " (P.O. #". $cust_main->payinfo. ")" + : '' + ) + ; + $FS::cust_bill::_template::address[$l++] = $cust_main->company + if $cust_main->company; + $FS::cust_bill::_template::address[$l++] = $cust_main->address1; + $FS::cust_bill::_template::address[$l++] = $cust_main->address2 + if $cust_main->address2; + $FS::cust_bill::_template::address[$l++] = + $cust_main->city. ", ". $cust_main->state. " ". $cust_main->zip; + $FS::cust_bill::_template::address[$l++] = $cust_main->country + unless $cust_main->country eq 'US'; + + #overdue? (variable for the template) + $FS::cust_bill::_template::overdue = ( + $balance_due > 0 + && $today > $self->_date + && $self->printed > 1 + ); - my $tot_lines = 50; #should be configurable - #header is 17 lines - my $tot_pages = int( scalar(@buf) / ( 2 * ( $tot_lines - 17 ) ) ); - $tot_pages++ if scalar(@buf) % ( 2 * ( $tot_lines - 17 ) ); + #and subroutine for the template - my $page = 1; + sub FS::cust_bill::_template::invoice_lines { + my $lines = shift; + map { + scalar(@buf) ? shift @buf : [ '', '' ]; + } + ( 1 .. $lines ); + } + + $FS::cust_bill::_template::page = 1; my $lines; + my @collect; while (@buf) { - $lines = $tot_lines; - my @header = &header( - $page, $tot_pages, $self->_date, $self->invnum, @address + push @collect, split("\n", + $invoice_template->fill_in( PACKAGE => 'FS::cust_bill::_template' ) ); - push @collect, @header; - $lines -= scalar(@header); - - while ( $lines-- && @buf ) { - $description=shift(@buf); - $amount=shift(@buf); - push @collect, myswrite($description, $amount); - } - $page++; - } - while ( $lines-- ) { - push @collect, myswrite('', ''); - } - - return @collect; - - sub header { #17 lines - my ( $page, $tot_pages, $date, $invnum, @address ) = @_ ; - push @address, '', '', '', ''; - - my @return = (); - my $i = ' 'x32; - push @return, - '', - $i. 'Invoice', - $i. substr("Page $page of $tot_pages".' 'x10, 0, 20). - time2str("%x", $date ). " FS-". $invnum, - '', - '', - $add1, - $add2, - $add3, - $add4, - '', - splice @address, 0, 7; - ; - return map $_. "\n", @return; + $FS::cust_bill::_template::page++; } - sub myswrite { - my $format = < Date: Wed, 20 Sep 2000 10:35:21 +0000 Subject: since printed field isn't updated 'till after print_text method is called, want to print overdue invoices if printed > 0, not > 1 --- FS/FS/cust_bill.pm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 1d0790ef1..2df92f75f 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -392,7 +392,8 @@ sub print_text { $FS::cust_bill::_template::overdue = ( $balance_due > 0 && $today > $self->_date - && $self->printed > 1 +# && $self->printed > 1 + && $self->printed > 0 ); #and subroutine for the template @@ -423,7 +424,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.2 2000-08-09 11:30:41 ivan Exp $ +$Id: cust_bill.pm,v 1.3 2000-09-20 10:35:21 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 52b07e8abd3946578a6c2701ec9e5195ec6b17e6 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 27 Oct 2000 20:15:50 +0000 Subject: session monitor --- FS/FS/Record.pm | 50 +++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 49 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 12cc77ebf..b0bfb0b3c 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -723,6 +723,54 @@ sub ut_phonen { ''; } +=item ut_ip COLUMN + +Check/untaint ip addresses. IPv4 only for now. + +=cut + +sub ut_ip { + my( $self, $field ) = @_; + $self->getfield($field) =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/; + or return "Illegal (IP address) $field: ". $self->getfield($field); + for ( $1 $2 $3 $4 ) { return "Illegal (IP address) $field" if $_ > 255; }; + $self->$setfield($field, "$1.$2.$3.$3"); + ''; +} + +=item ut_ipn COLUMN + +Check/untaint ip addresses. IPv4 only for now. May be null. + +=cut + +sub ut_ipn { + my( $self, $field ) = @_; + if ( $self->getfield($field) =~ /^()$/ ) { + $self->setfield($field,''); + ''; + } else { + $self->ut_ip($field); + } +} + +=item ut_domain COLUMN + +Check/untaint host and domain names. + +=cut + +sub ut_domain { + my( $self, $field ) = @_; + #$self->getfield($field) =~/^(\w+\.)*\w+$/ + $self->getfield($field) =~/^(\w+\.)*\w+$/ + or return "Illegal (domain) $field: ". $self->getfield($field); + $self->setfield($field,$1); + ''; +} + +=cut + =item ut_anything COLUMN Untaints arbitrary data. Be careful. @@ -847,7 +895,7 @@ sub hfields { =head1 VERSION -$Id: Record.pm,v 1.7 2000-06-27 12:15:37 ivan Exp $ +$Id: Record.pm,v 1.8 2000-10-27 20:15:50 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From eea322178c024e57730831556d28a78524df7450 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 27 Oct 2000 20:18:32 +0000 Subject: oops, also necessary for session monitor --- FS/FS/nas.pm | 137 ++++++++++++++++++++++++++++++++++++++++ FS/FS/port.pm | 157 ++++++++++++++++++++++++++++++++++++++++++++++ FS/FS/session.pm | 187 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 481 insertions(+) create mode 100644 FS/FS/nas.pm create mode 100644 FS/FS/port.pm create mode 100644 FS/FS/session.pm (limited to 'FS') diff --git a/FS/FS/nas.pm b/FS/FS/nas.pm new file mode 100644 index 000000000..5ed95f92e --- /dev/null +++ b/FS/FS/nas.pm @@ -0,0 +1,137 @@ +package FS::nas; + +use strict; +use vars qw( @ISA ); +use FS::Record qw(); +#use FS::Record qw( qsearch qsearchs ); + +@ISA = qw(FS::Record); + +=head1 NAME + +FS::nas - Object methods for nas records + +=head1 SYNOPSIS + + use FS::nas; + + $record = new FS::nas \%hash; + $record = new FS::nas { + 'nasnum' => 1, + 'nasip' => '10.4.20.23', + 'nasfqdn' => 'box1.brc.nv.us.example.net', + }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + + $error = $record->heartbeat($timestamp); + +=head1 DESCRIPTION + +An FS::nas object represents an Network Access Server on your network, such as +a terminal server or equivalent. FS::nas inherits from FS::Record. The +following fields are currently supported: + +=over 4 + +=item nasnum - primary key + +=item nas - NAS name + +=item nasip - NAS ip address + +=item nasfqdn - NAS fully-qualified domain name + +=item last - timestamp indicating the last instant the NAS was in a known + state (used by the session monitoring). + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new NAS. To add the NAS to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'nas'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +# the insert method can be inherited from FS::Record + +=item delete + +Delete this record from the database. + +=cut + +# the delete method can be inherited from FS::Record + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +# the replace method can be inherited from FS::Record + +=item check + +Checks all fields to make sure this is a valid example. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +# the check method should currently be supplied - FS::Record contains some +# data checking routines + +sub check { + my $self = shift; + + $self->ut_numbern('nasnum') + || $self->ut_text('nas') + || $self->ut_ip('nasip') + || $self->ut_domain('nasfqdn') + || $self->ut_numbern('last'); +} + +=back + +=head1 VERSION + +$Id: nas.pm,v 1.1 2000-10-27 20:18:32 ivan Exp $ + +=head1 BUGS + +The author forgot to customize this manpage. + +=head1 SEE ALSO + +L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/port.pm b/FS/FS/port.pm new file mode 100644 index 000000000..c1bdee975 --- /dev/null +++ b/FS/FS/port.pm @@ -0,0 +1,157 @@ +package FS::port; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearchs ); +use FS::nas; + +@ISA = qw(FS::Record); + +=head1 NAME + +FS::port - Object methods for port records + +=head1 SYNOPSIS + + use FS::port; + + $record = new FS::port \%hash; + $record = new FS::port { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::port object represents an individual port on a NAS. FS::port inherits +from FS::Record. The following fields are currently supported: + +=over 4 + +=item portnum - primary key + +=item ip - IP address of this port + +=item nasport - port number on the NAS + +=item nasnum - NAS this port is on - see L + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new port. To add the example to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'port'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +# the insert method can be inherited from FS::Record + +=item delete + +Delete this record from the database. + +=cut + +# the delete method can be inherited from FS::Record + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +# the replace method can be inherited from FS::Record + +=item check + +Checks all fields to make sure this is a valid example. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +# the check method should currently be supplied - FS::Record contains some +# data checking routines + +sub check { + my $self = shift; + my $error = + $self->ut_numbern('portnum') + || $self->ut_ipn('ipn') + || $self->ut_numbern('nasport') + || $self->ut_number('nasnum'); + ; + return $error if $error; + return "Either ip or nasport must be specified" + unless $self->ip || $self->nasport; + return "Unknown nasnum" + unless qsearchs('nas', { 'nasnum' => $self->nasnum } ); + ''; #no error +} + +=back + +=head1 VERSION + +$Id: port.pm,v 1.1 2000-10-27 20:18:32 ivan Exp $ + +=head1 BUGS + +The author forgot to customize this manpage. + +=head1 SEE ALSO + +L, schema.html from the base documentation. + +=head1 HISTORY + +ivan@voicenet.com 97-jul-1 + +added hfields +ivan@sisd.com 97-nov-13 + +$Log: port.pm,v $ +Revision 1.1 2000-10-27 20:18:32 ivan +oops, also necessary for session monitor + +Revision 1.1 1999/08/04 08:03:03 ivan +move table subclass examples out of production directory + +Revision 1.4 1998/12/29 11:59:57 ivan +mostly properly OO, some work still to be done with svc_ stuff + +Revision 1.3 1998/11/15 04:33:00 ivan +updates for newest versoin + +Revision 1.2 1998/11/15 03:48:49 ivan +update for current version + + +=cut + +1; + diff --git a/FS/FS/session.pm b/FS/FS/session.pm new file mode 100644 index 000000000..0d766bd22 --- /dev/null +++ b/FS/FS/session.pm @@ -0,0 +1,187 @@ +package FS::session; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearchs ); +use FS::svc_acct; + +@ISA = qw(FS::Record); + +=head1 NAME + +FS::session - Object methods for session records + +=head1 SYNOPSIS + + use FS::session; + + $record = new FS::session \%hash; + $record = new FS::session { + 'portnum' => 1, + 'svcnum' => 2, + 'login' => $timestamp, + 'logout' => $timestamp, + }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::session object represents an user login session. FS::session inherits +from FS::Record. The following fields are currently supported: + +=over 4 + +=item sessionnum - primary key + +=item portnum - NAS port for this session - see L + +=item svcnum - User for this session - see L + +=item login - timestamp indicating the beginning of this user session. + +=item logout - timestamp indicating the end of this user session. May be null, + which indicates a currently open session. + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new example. To add the example to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'session'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. If the `login' field is empty, it is replaced with +the current time. + +=cut + +sub insert { + my $self = shift; + my $error; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + $error = $self->check; + return $error if $error; + + $self->setfield('login', time()) unless $self->getfield('login'); + + $error = $self->SUPER::insert; + return $error if $error; + + #session-starting callback! + + ''; + +} + +=item delete + +Delete this record from the database. + +=cut + +# the delete method can be inherited from FS::Record + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. If the `logout' field is empty, +it is replaced with the current time. + +=cut + +sub replace { + my $self = shift; + my $error; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + $error = $self->check; + return $error if $error; + + $self->setfield('logout', time()) unless $self->getfield('logout'); + + $error = $self->SUPER::replace; + return $error if $error; + + #session-ending callback! + + ''; +} + +=item check + +Checks all fields to make sure this is a valid example. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +# the check method should currently be supplied - FS::Record contains some +# data checking routines + +sub check { + my $self = shift; + my $error = + $self->ut_numbern('sessionnum') + || $self->ut_number('portnum') + || $self->ut_number('svcnum') + || $self->ut_numbern('login') + || $self->ut_numbern('logout') + ; + return $error if $error; + return "Unknown svcnum" + unless qsearchs('svc_acct', { 'svcnum' => $self->svcnum } ); + ''; +} + +=back + +=head1 VERSION + +$Id: session.pm,v 1.1 2000-10-27 20:18:32 ivan Exp $ + +=head1 BUGS + +The author forgot to customize this manpage. + +=head1 SEE ALSO + +L, schema.html from the base documentation. + +=cut + +1; + -- cgit v1.2.1 From 7f07089722bfcabe3bf42619bb2bdb81fd8d44e1 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 7 Nov 2000 15:00:37 +0000 Subject: session monitor --- FS/FS/Record.pm | 8 ++++---- FS/FS/nas.pm | 12 +++++++++++- FS/FS/session.pm | 27 ++++++++++++++++++++++++--- FS/MANIFEST | 4 ++++ 4 files changed, 43 insertions(+), 8 deletions(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index b0bfb0b3c..59472c898 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -731,10 +731,10 @@ Check/untaint ip addresses. IPv4 only for now. sub ut_ip { my( $self, $field ) = @_; - $self->getfield($field) =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/; + $self->getfield($field) =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/ or return "Illegal (IP address) $field: ". $self->getfield($field); - for ( $1 $2 $3 $4 ) { return "Illegal (IP address) $field" if $_ > 255; }; - $self->$setfield($field, "$1.$2.$3.$3"); + for ( $1, $2, $3, $4 ) { return "Illegal (IP address) $field" if $_ > 255; } + $self->setfield($field, "$1.$2.$3.$3"); ''; } @@ -895,7 +895,7 @@ sub hfields { =head1 VERSION -$Id: Record.pm,v 1.8 2000-10-27 20:15:50 ivan Exp $ +$Id: Record.pm,v 1.9 2000-11-07 15:00:37 ivan Exp $ =head1 BUGS diff --git a/FS/FS/nas.pm b/FS/FS/nas.pm index 5ed95f92e..873c9bce6 100644 --- a/FS/FS/nas.pm +++ b/FS/FS/nas.pm @@ -117,11 +117,21 @@ sub check { || $self->ut_numbern('last'); } +=sub heartbeat TIMESTAMP + +Updates the timestamp for this nas + +=cut + +sub heartbeat { + warn "warning: heartbeat unimplemented!" +} + =back =head1 VERSION -$Id: nas.pm,v 1.1 2000-10-27 20:18:32 ivan Exp $ +$Id: nas.pm,v 1.2 2000-11-07 15:00:37 ivan Exp $ =head1 BUGS diff --git a/FS/FS/session.pm b/FS/FS/session.pm index 0d766bd22..b85a5822f 100644 --- a/FS/FS/session.pm +++ b/FS/FS/session.pm @@ -4,6 +4,8 @@ use strict; use vars qw( @ISA ); use FS::Record qw( qsearchs ); use FS::svc_acct; +use FS::port; +use FS::nas; @ISA = qw(FS::Record); @@ -31,6 +33,8 @@ FS::session - Object methods for session records $error = $record->check; + $error = $record->nas_heartbeat($timestamp); + =head1 DESCRIPTION An FS::session object represents an user login session. FS::session inherits @@ -57,7 +61,7 @@ from FS::Record. The following fields are currently supported: =item new HASHREF -Creates a new example. To add the example to the database, see L<"insert">. +Creates a new session. To add the session to the database, see L<"insert">. Note that this stores the hash reference, not a distinct copy of the hash it points to. You can ask the object for a copy with the I method. @@ -95,6 +99,8 @@ sub insert { $error = $self->SUPER::insert; return $error if $error; + $self->nas_heartbeat($self->getfield('login')); + #session-starting callback! ''; @@ -136,6 +142,8 @@ sub replace { $error = $self->SUPER::replace; return $error if $error; + $self->nas_heartbeat($self->getfield('logout')); + #session-ending callback! ''; @@ -143,7 +151,7 @@ sub replace { =item check -Checks all fields to make sure this is a valid example. If there is +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. @@ -167,11 +175,24 @@ sub check { ''; } +=item nas_heartbeat + +Heartbeats the nas associated with this session (see L). + +=cut + +sub nas_heartbeat { + my $self = shift; + my $port = qsearchs('port',{'portnum'=>$self->portnum}); + my $nas = qsearchs('nas',{'nasnum'=>$port->nasnum}); + $nas->heartbeat(shift); +} + =back =head1 VERSION -$Id: session.pm,v 1.1 2000-10-27 20:18:32 ivan Exp $ +$Id: session.pm,v 1.2 2000-11-07 15:00:37 ivan Exp $ =head1 BUGS diff --git a/FS/MANIFEST b/FS/MANIFEST index e0b5b51e5..91d2e2fc0 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -40,12 +40,16 @@ FS/svc_acct_pop.pm FS/svc_acct_sm.pm FS/svc_domain.pm FS/type_pkgs.pm +FS/nas.pm +FS/port.pm +FS/session.pm MANIFEST MANIFEST.SKIP Makefile.PL test.pl README bin/freeside-bill +bin/freeside-print-batch FS/domain_record.pm FS/prepay_credit.pm FS/svc_www.pm -- cgit v1.2.1 From e085e7fdbffc73d27eb43e5999b85c39499ccb14 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 22 Nov 2000 23:30:51 +0000 Subject: tyop --- FS/FS/svc_www.pm | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_www.pm b/FS/FS/svc_www.pm index bb765b193..6e741950f 100644 --- a/FS/FS/svc_www.pm +++ b/FS/FS/svc_www.pm @@ -53,7 +53,7 @@ from FS::svc_Common. The following fields are currently supported: =item svcnum - primary key -=item recnum - DNS `A' record corresponding to this web virtual host. (see L) =item usersvc - account (see L) corresponding to this web virtual host. @@ -220,7 +220,7 @@ sub check { =head1 VERSION -$Id: svc_www.pm,v 1.2 2000-03-01 08:13:59 ivan Exp $ +$Id: svc_www.pm,v 1.3 2000-11-22 23:30:51 ivan Exp $ =head1 BUGS @@ -232,7 +232,10 @@ L, L, schema.html from the base documentation. =head1 HISTORY $Log: svc_www.pm,v $ -Revision 1.2 2000-03-01 08:13:59 ivan +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 -- cgit v1.2.1 From e966cec8367fbc5f21b366f9c497fc0260292407 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 3 Dec 2000 10:09:35 +0000 Subject: bad caches! --- FS/FS/CGIwrapper.pm | 17 +++++++++++++++++ FS/MANIFEST | 1 + 2 files changed, 18 insertions(+) create mode 100644 FS/FS/CGIwrapper.pm (limited to 'FS') 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/MANIFEST b/FS/MANIFEST index 91d2e2fc0..a66c5ced7 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -53,3 +53,4 @@ bin/freeside-print-batch FS/domain_record.pm FS/prepay_credit.pm FS/svc_www.pm +FS/CGIwrapper.pm -- cgit v1.2.1 From c7effea426d7cefcebc4b32f162fd1719095fc12 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 3 Dec 2000 13:44:05 +0000 Subject: beginnings of web status for session monitor --- FS/FS/port.pm | 19 +++++++++++++++++-- 1 file changed, 17 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/port.pm b/FS/FS/port.pm index c1bdee975..ee4611d21 100644 --- a/FS/FS/port.pm +++ b/FS/FS/port.pm @@ -4,6 +4,7 @@ use strict; use vars qw( @ISA ); use FS::Record qw( qsearchs ); use FS::nas; +use FS::session; @ISA = qw(FS::Record); @@ -26,6 +27,8 @@ FS::port - Object methods for port records $error = $record->check; + $session = $port->session; + =head1 DESCRIPTION An FS::port object represents an individual port on a NAS. FS::port inherits @@ -113,11 +116,20 @@ sub check { ''; #no error } +=item session + +Returns the currently open session, or if no session is currently open, the +most recent session. See L. + +=cut + + + =back =head1 VERSION -$Id: port.pm,v 1.1 2000-10-27 20:18:32 ivan Exp $ +$Id: port.pm,v 1.2 2000-12-03 13:44:05 ivan Exp $ =head1 BUGS @@ -135,7 +147,10 @@ added hfields ivan@sisd.com 97-nov-13 $Log: port.pm,v $ -Revision 1.1 2000-10-27 20:18:32 ivan +Revision 1.2 2000-12-03 13:44:05 ivan +beginnings of web status for session monitor + +Revision 1.1 2000/10/27 20:18:32 ivan oops, also necessary for session monitor Revision 1.1 1999/08/04 08:03:03 ivan -- cgit v1.2.1 From 9951dac925264910d664b50d2fc33cf3dc1c734e Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 3 Dec 2000 13:45:15 +0000 Subject: patch from Jason Spence : admin.html doc, autocapgen --- FS/FS/agent.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/agent.pm b/FS/FS/agent.pm index 27e9aed71..1afe70641 100644 --- a/FS/FS/agent.pm +++ b/FS/FS/agent.pm @@ -131,7 +131,7 @@ sub agent_type { =item pkgpart_hashref Returns a hash reference. The keys of the hash are pkgparts. The value is -true iff this agent may purchase the specified package definition. See +true if this agent may purchase the specified package definition. See L. =cut @@ -145,7 +145,7 @@ sub pkgpart_hashref { =head1 VERSION -$Id: agent.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ +$Id: agent.pm,v 1.2 2000-12-03 13:45:15 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 3a95cc316da367ffd248ba29ac594f3efbc9db61 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 3 Dec 2000 15:14:00 +0000 Subject: bugfixes from Jeff Finucane , thanks! --- FS/FS/cust_bill.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 2df92f75f..568f272aa 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -225,7 +225,7 @@ credits (FS::cust_credit objects). sub cust_credit { my $self = shift; my $total = 0; - my @cust_credit = sort { $a->_date <=> $b->date } + my @cust_credit = sort { $a->_date <=> $b->_date } grep { $_->credited != 0 && $_->_date < $self->_date } qsearch('cust_credit', { 'custnum' => $self->custnum } ) ; @@ -241,7 +241,7 @@ Returns all payments (see L) for this invoice. sub cust_pay { my $self = shift; - sort { $a->_date <=> $b->date } + sort { $a->_date <=> $b->_date } qsearch( 'cust_pay', { 'invnum' => $self->invnum } ) ; } @@ -424,7 +424,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.3 2000-09-20 10:35:21 ivan Exp $ +$Id: cust_bill.pm,v 1.4 2000-12-03 15:14:00 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From b90f8cdac9371c219a72dda16f8deecc7c44fc28 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 3 Dec 2000 20:25:20 +0000 Subject: session monitor updates --- FS/FS/Record.pm | 19 +++++++++++++++---- FS/FS/nas.pm | 24 +++++++++++++++++++----- FS/FS/port.pm | 27 +++++++++++++++++++++------ FS/FS/session.pm | 28 ++++++++++++++++++++++++---- 4 files changed, 79 insertions(+), 19 deletions(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 59472c898..18541d2db 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -149,22 +149,32 @@ sub create { } } -=item qsearch TABLE, HASHREF +=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!. + qq!
'; + + $text .= qq!'; + +} + =back =head1 VERSION -$Id: svc_acct_pop.pm,v 1.3 2001-09-26 09:17:06 ivan Exp $ +$Id: svc_acct_pop.pm,v 1.4 2001-09-27 20:41:37 ivan Exp $ =head1 BUGS It should be renamed to part_pop. +popselector? putting web ui components in here? they should probably live +somewhere else... + =head1 SEE ALSO L, L, L, schema.html from the -- cgit v1.2.1 From 2f33777f569ff435e4cc00769288b65f53fcfc0e Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 27 Sep 2001 21:49:31 +0000 Subject: not used --- FS/FS/svc_acct_pop.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct_pop.pm b/FS/FS/svc_acct_pop.pm index 3b8e9785a..243c18a8b 100644 --- a/FS/FS/svc_acct_pop.pm +++ b/FS/FS/svc_acct_pop.pm @@ -129,7 +129,6 @@ sub popselector { push @{$svc_acct_pop{$_->state}}, $_ foreach @svc_acct_pop; } - my $size = 0; my $text = < function opt(what,href,text) { @@ -151,7 +150,6 @@ END foreach my $pop ( @{$svc_acct_pop{$popstate}}) { my $o_popnum = $pop->popnum; my $poptext = $pop->text; - $size = length($poptext) if length($poptext) > $size; $text .= "opt(what.form.popnum, \"$o_popnum\", \"$poptext\");\n" } $text .= "}\n"; @@ -173,13 +171,15 @@ END } $text .= ''; + $text; + } =back =head1 VERSION -$Id: svc_acct_pop.pm,v 1.4 2001-09-27 20:41:37 ivan Exp $ +$Id: svc_acct_pop.pm,v 1.5 2001-09-27 21:49:31 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From d390ca47b755c896af0644ae83ec583973c319b6 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 30 Sep 2001 20:30:09 +0000 Subject: username-uppercase config file --- FS/FS/svc_acct.pm | 23 +++++++++++++++++------ 1 file changed, 17 insertions(+), 6 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 46208aa22..3530001fd 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -3,7 +3,7 @@ package FS::svc_acct; use strict; use vars qw( @ISA $nossh_hack $conf $dir_prefix @shells $usernamemin $usernamemax $passwordmin $username_letter $username_letterfirst - $username_noperiod + $username_noperiod $username_uppercase $shellmachine $useradd $usermod $userdel $mydomain $cyrus_server $cyrus_admin_user $cyrus_admin_pass $dirhash @@ -57,6 +57,7 @@ $FS::UID::callback{'FS::svc_acct'} = sub { $username_letter = $conf->exists('username-letter'); $username_letterfirst = $conf->exists('username-letterfirst'); $username_noperiod = $conf->exists('username-noperiod'); + $username_uppercase = $conf->exists('username-uppercase'); $mydomain = $conf->config('domain'); if ( $conf->exists('cyrus') ) { ($cyrus_server, $cyrus_admin_user, $cyrus_admin_pass) = @@ -674,9 +675,15 @@ sub check { return $error if $error; my $ulen = $usernamemax || $self->dbdef_table->column('username')->length; - $recref->{username} =~ /^([a-z0-9_\-\.]{$usernamemin,$ulen})$/ - or return "Illegal username"; + if ( $username_uppercase ) { + $recref->{username} =~ /^([a-z0-9_\-\.]{$usernamemin,$ulen})$/i + or return "Illegal username"; + } else { + $recref->{username} =~ /^([a-z0-9_\-\.]{$usernamemin,$ulen})$/ + or return "Illegal username"; + } $recref->{username} = $1; + if ( $username_letterfirst ) { $recref->{username} =~ /^[a-z]/ or return "Illegal username"; } elsif ( $username_letter ) { @@ -705,8 +712,12 @@ sub check { return "Only root can have uid 0" if $recref->{uid} == 0 && $recref->{username} ne 'root'; - $error = $self->ut_textn('finger'); - return $error if $error; +# $error = $self->ut_textn('finger'); +# return $error if $error; + $self->getfield('finger') =~ + /^([\w \t\!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\*]*)$/ + or return "Illegal finger: ". $self->getfield('finger'); + $self->setfield('finger', $1); $recref->{dir} =~ /^([\/\w\-]*)$/ or return "Illegal directory"; @@ -908,7 +919,7 @@ sub ssh { =head1 VERSION -$Id: svc_acct.pm,v 1.46 2001-09-19 21:06:17 ivan Exp $ +$Id: svc_acct.pm,v 1.47 2001-09-30 20:30:09 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 4ff1dd39976ab5c7550081743ca89a741100cfa3 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 30 Sep 2001 22:19:34 +0000 Subject: $1 doesn't seem to last very long... --- FS/FS/svc_acct.pm | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 3530001fd..e46b4e5f3 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -676,13 +676,14 @@ sub check { my $ulen = $usernamemax || $self->dbdef_table->column('username')->length; if ( $username_uppercase ) { - $recref->{username} =~ /^([a-z0-9_\-\.]{$usernamemin,$ulen})$/i - or return "Illegal username"; + $recref->{username} =~ /^([a-z0-9_\-\.]{$usernamemin,$ulen})$/ + or return "Illegal username: ". $recref->{username}; + $recref->{username} = $1; } else { $recref->{username} =~ /^([a-z0-9_\-\.]{$usernamemin,$ulen})$/ - or return "Illegal username"; + or return "Illegal username: ". $recref->{username}; + $recref->{username} = $1; } - $recref->{username} = $1; if ( $username_letterfirst ) { $recref->{username} =~ /^[a-z]/ or return "Illegal username"; @@ -919,7 +920,7 @@ sub ssh { =head1 VERSION -$Id: svc_acct.pm,v 1.47 2001-09-30 20:30:09 ivan Exp $ +$Id: svc_acct.pm,v 1.48 2001-09-30 22:19:34 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From f832b7bf60eed131141facd8207a1c44a134d3ca Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 30 Sep 2001 22:35:34 +0000 Subject: arg --- FS/FS/svc_acct.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index e46b4e5f3..2390de02e 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -676,7 +676,7 @@ sub check { my $ulen = $usernamemax || $self->dbdef_table->column('username')->length; if ( $username_uppercase ) { - $recref->{username} =~ /^([a-z0-9_\-\.]{$usernamemin,$ulen})$/ + $recref->{username} =~ /^([a-z0-9_\-\.]{$usernamemin,$ulen})$/i or return "Illegal username: ". $recref->{username}; $recref->{username} = $1; } else { @@ -920,7 +920,7 @@ sub ssh { =head1 VERSION -$Id: svc_acct.pm,v 1.48 2001-09-30 22:19:34 ivan Exp $ +$Id: svc_acct.pm,v 1.49 2001-09-30 22:35:34 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 1fd215138eeed664b07d4347ce18a7a1a616419b Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 1 Oct 2001 10:31:08 +0000 Subject: oops --- FS/FS/cust_pkg.pm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 147a760d9..dff241393 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -100,6 +100,8 @@ sub table { 'cust_pkg'; } Adds this billing item to the database ("Orders" the item). If there is an error, returns the error, otherwise returns false. +=cut + sub insert { my $self = shift; @@ -565,7 +567,7 @@ sub order { =head1 VERSION -$Id: cust_pkg.pm,v 1.6 2001-09-04 14:44:06 ivan Exp $ +$Id: cust_pkg.pm,v 1.7 2001-10-01 10:31:08 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From fce8244a87d152312852eef77411c644f992314d Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 2 Oct 2001 11:10:19 +0000 Subject: allow some more characters in GECOS... showing up in fix.net's password files --- FS/FS/svc_acct.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 2390de02e..71c47d6cd 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -716,7 +716,7 @@ sub check { # $error = $self->ut_textn('finger'); # return $error if $error; $self->getfield('finger') =~ - /^([\w \t\!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\*]*)$/ + /^([\w \t\!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\*\<\>]*)$/ or return "Illegal finger: ". $self->getfield('finger'); $self->setfield('finger', $1); @@ -920,7 +920,7 @@ sub ssh { =head1 VERSION -$Id: svc_acct.pm,v 1.49 2001-09-30 22:35:34 ivan Exp $ +$Id: svc_acct.pm,v 1.50 2001-10-02 11:10:19 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 44e51a5c50be350fa698bcdcf86ad5c01a7631a2 Mon Sep 17 00:00:00 2001 From: jeff Date: Tue, 2 Oct 2001 16:00:31 +0000 Subject: add pkey to batch payments and fix a doc typo --- FS/FS/cust_pay_batch.pm | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_pay_batch.pm b/FS/FS/cust_pay_batch.pm index 0576cbefc..671cd710a 100644 --- a/FS/FS/cust_pay_batch.pm +++ b/FS/FS/cust_pay_batch.pm @@ -35,6 +35,8 @@ following fields are currently supported: =over 4 +=item paybatchnum - primary key (automatically assigned) + =item trancode - 77 for charges =item cardnum @@ -117,7 +119,8 @@ sub check { my $self = shift; my $error = - $self->ut_numbern('trancode') + $self->ut_numbern('paybatchnum') + || $self->ut_numbern('trancode') || $self->ut_number('cardnum') || $self->ut_money('amount') || $self->ut_number('invnum') @@ -188,7 +191,7 @@ sub check { =head1 VERSION -$Id: cust_pay_batch.pm,v 1.2 2000-06-17 21:48:05 ivan Exp $ +$Id: cust_pay_batch.pm,v 1.3 2001-10-02 16:00:30 jeff Exp $ =head1 BUGS -- cgit v1.2.1 From 058ad19b1b6e139df3a3cfbdbd02263099883907 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 9 Oct 2001 03:11:50 +0000 Subject: fix syntax error in newly-enabled insert sub, sheesh --- FS/FS/cust_pkg.pm | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index dff241393..d2d74190d 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -107,11 +107,12 @@ sub insert { # custnum might not have have been defined in sub check (for one-shot new # customers), so check it here instead + # (is this still necessary with transactions?) my $error = $self->ut_number('custnum'); - return $error if $error + return $error if $error; - return "Unknown customer" + return "Unknown customer ". $self->custnum unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); $self->SUPER::insert; @@ -567,7 +568,7 @@ sub order { =head1 VERSION -$Id: cust_pkg.pm,v 1.7 2001-10-01 10:31:08 ivan Exp $ +$Id: cust_pkg.pm,v 1.8 2001-10-09 03:11:50 ivan Exp $ =head1 BUGS @@ -584,6 +585,9 @@ cancel } because they use %FS::UID::callback to load configuration values. Probably need a subroutine which decides what to do based on whether or not we've fetched the user yet, rather than a hash. See FS::UID and the TODO. +Now that things are transactional should the check in the insert method be +moved to check ? + =head1 SEE ALSO L, L, L, L -- cgit v1.2.1 From 4bbf90e800406ff75a5fed09ba5cd71293cda542 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 9 Oct 2001 23:10:17 +0000 Subject: add `unsuspendauto' config file: enable the automatic unsuspension of suspended packages when a customer's balance due changes from positive to zero or negative as the result of a payment or credit add cust_pkg.manual_flag to disable this behaviour per customer package (no UI to set this yet) --- FS/FS/cust_credit.pm | 56 +++++++++++++++++++++++++++++++++++++++++--- FS/FS/cust_main.pm | 66 +++++++++++++++++++++++++++++++++++++++++++++++++++- FS/FS/cust_pay.pm | 29 ++++++++++++++++++++--- FS/FS/cust_pkg.pm | 10 +++++++- 4 files changed, 153 insertions(+), 8 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm index 1f792daa6..54c201ad4 100644 --- a/FS/FS/cust_credit.pm +++ b/FS/FS/cust_credit.pm @@ -1,8 +1,8 @@ package FS::cust_credit; use strict; -use vars qw( @ISA ); -use FS::UID qw( getotaker ); +use vars qw( @ISA $conf $unsuspendauto ); +use FS::UID qw( dbh getotaker ); use FS::Record qw( qsearch qsearchs ); use FS::cust_main; use FS::cust_refund; @@ -10,6 +10,14 @@ use FS::cust_credit_bill; @ISA = qw( FS::Record ); +#ask FS::UID to run this stuff for us later +$FS::UID::callback{'FS::cust_credit'} = sub { + + $conf = new FS::Conf; + $unsuspendauto = $conf->exists('unsuspendauto'); + +}; + =head1 NAME FS::cust_credit - Object methods for cust_credit records @@ -69,6 +77,48 @@ sub table { 'cust_credit'; } Adds this credit to the database ("Posts" the credit). If there is an error, returns the error, otherwise returns false. +=cut + +sub insert { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $cust_main = qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); + my $old_balance = $cust_main->balance; + + my $error = $self->SUPER::insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error inserting $self: $error"; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + #false laziness w/ cust_credit::insert + if ( $unsuspendauto && $old_balance && $cust_main->balance <= 0 ) { + my @errors = $cust_main->unsuspend; + #return + # side-fx with nested transactions? upstack rolls back? + warn "WARNING:Errors unsuspending customer ". $cust_main->custnum. ": ". + join(' / ', @errors) + if @errors; + } + #eslaf + + ''; + +} + =item delete Currently unimplemented. @@ -185,7 +235,7 @@ sub credited { =head1 VERSION -$Id: cust_credit.pm,v 1.11 2001-09-02 07:49:52 ivan Exp $ +$Id: cust_credit.pm,v 1.12 2001-10-09 23:10:16 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 0a7f1f7cb..d5beca92a 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -98,6 +98,8 @@ FS::cust_main - Object methods for cust_main records @cust_pkg = $record->ncancelled_pkgs; + @cust_pkg = $record->suspended_pkgs; + $error = $record->bill; $error = $record->bill %options; $error = $record->bill 'time' => $time; @@ -708,6 +710,68 @@ sub ncancelled_pkgs { ] }; } +=item suspended_pkgs + +Returns all suspended packages (see L) for this customer. + +=cut + +sub suspended_pkgs { + my $self = shift; + grep { $_->susp } $self->ncancelled_pkgs; +} + +=item unflagged_suspended_pkgs + +Returns all unflagged suspended packages (see L) for this +customer (thouse packages without the `manual_flag' set). + +=cut + +sub unflagged_suspended_pkgs { + my $self = shift; + return $self->suspended_pkgs + unless dbdef->table('cust_pkg')->column('manual_flag'); + grep { ! $_->manual_flag } $self->suspended_pkgs; +} + +=item unsuspended_pkgs + +Returns all unsuspended (and uncancelled) packages (see L) for +this customer. + +=cut + +sub unsuspended_pkgs { + my $self = shift; + grep { ! $_->susp } $self->ncancelled_pkgs; +} + +=item unsuspend + +Unsuspends all unflagged suspended packages (see L +and L) for this customer. Always returns a list: an empty list +on success or a list of errors. + +=cut + +sub unsuspend { + my $self = shift; + grep { $_->unsuspend } $self->suspended_pkgs; +} + +=item suspend + +Suspends all unsuspended packages (see L) for this customer. +Always returns a list: an empty list on success or a list of errors. + +=cut + +sub suspend { + my $self = shift; + grep { $_->suspend } $self->unsuspended_pkgs; +} + =item bill OPTIONS Generates invoices (see L) for this customer. Usually used in @@ -1724,7 +1788,7 @@ sub append_fuzzyfiles { =head1 VERSION -$Id: cust_main.pm,v 1.38 2001-09-26 09:17:06 ivan Exp $ +$Id: cust_main.pm,v 1.39 2001-10-09 23:10:16 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index 42ca0b0a5..daf5b5263 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -1,15 +1,24 @@ package FS::cust_pay; use strict; -use vars qw( @ISA ); +use vars qw( @ISA $conf $unsuspendauto ); use Business::CreditCard; -use FS::Record qw( dbh qsearch qsearchs ); +use FS::UID qw( dbh ); +use FS::Record qw( dbh qsearch qsearchs dbh ); use FS::cust_bill; use FS::cust_bill_pay; use FS::cust_main; @ISA = qw( FS::Record ); +#ask FS::UID to run this stuff for us later +$FS::UID::callback{'FS::cust_pay'} = sub { + + $conf = new FS::Conf; + $unsuspendauto = $conf->exists('unsuspendauto'); + +}; + =head1 NAME FS::cust_pay - Object methods for cust_pay objects @@ -90,6 +99,9 @@ sub insert { local $FS::UID::AutoCommit = 0; my $dbh = dbh; + my $cust_main = qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); + my $old_balance = $cust_main->balance; + my $error = $self->check; return $error if $error; @@ -124,6 +136,17 @@ sub insert { $dbh->commit or die $dbh->errstr if $oldAutoCommit; + #false laziness w/ cust_credit::insert + if ( $unsuspendauto && $old_balance && $cust_main->balance <= 0 ) { + my @errors = $cust_main->unsuspend; + #return + # side-fx with nested transactions? upstack rolls back? + warn "WARNING:Errors unsuspending customer ". $cust_main->custnum. ": ". + join(' / ', @errors) + if @errors; + } + #eslaf + ''; } @@ -281,7 +304,7 @@ sub unapplied { =head1 VERSION -$Id: cust_pay.pm,v 1.7 2001-09-03 22:07:38 ivan Exp $ +$Id: cust_pay.pm,v 1.8 2001-10-09 23:10:16 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index d2d74190d..1bcf74f78 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -77,6 +77,9 @@ inherits from FS::Record. The following fields are currently supported: =item otaker - order taker (assigned automatically if null, see L) +=item manual_flag - If this field is set to 1, disables the automatic +unsuspensiond of this package when using the B config file. + =back Note: setup, bill, susp, expire and cancel are specified as UNIX timestamps; @@ -197,6 +200,11 @@ sub check { $self->otaker =~ /^(\w{0,16})$/ or return "Illegal otaker"; $self->otaker($1); + if ( $self->dbdef_table->column('manual_flag') ) { + $self->manual_flag =~ /^([01]?)$/ or return "Illegal manual_flag"; + $self->manual_flag($1); + } + ''; #no error } @@ -568,7 +576,7 @@ sub order { =head1 VERSION -$Id: cust_pkg.pm,v 1.8 2001-10-09 03:11:50 ivan Exp $ +$Id: cust_pkg.pm,v 1.9 2001-10-09 23:10:16 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 672aab6658cf490d740b49336d16994072a0e506 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 10 Oct 2001 05:24:25 +0000 Subject: embarassing doc fix, thanks jason --- FS/FS/Record.pm | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 333602c07..a15aaba36 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -65,17 +65,17 @@ FS::Record - Database record objects $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_anything('column'); - $value = $record->ut_name('column'); + $error = $record->ut_float('column'); + $error = $record->ut_number('column'); + $error = $record->ut_numbern('column'); + $error = $record->ut_money('column'); + $error = $record->ut_text('column'); + $error = $record->ut_textn('column'); + $error = $record->ut_alpha('column'); + $error = $record->ut_alphan('column'); + $error = $record->ut_phonen('column'); + $error = $record->ut_anything('column'); + $error = $record->ut_name('column'); $dbdef = reload_dbdef; $dbdef = reload_dbdef "/non/standard/filename"; @@ -994,7 +994,7 @@ sub DESTROY { return; } =head1 VERSION -$Id: Record.pm,v 1.29 2001-09-16 12:45:35 ivan Exp $ +$Id: Record.pm,v 1.30 2001-10-10 05:24:25 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From a6d3e4dc73803cffad96fd4b6270b2fb5f4b0568 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 15 Oct 2001 10:42:29 +0000 Subject: price plans web gui 1st pass, oh my --- FS/FS/cust_main.pm | 73 ++++++++++++++++++++++++++++++++++++++++-------------- FS/FS/part_pkg.pm | 12 ++++++--- 2 files changed, 64 insertions(+), 21 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index d5beca92a..f99a15e69 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -216,10 +216,9 @@ otherwise returns false. CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert method containing FS::cust_pkg and FS::svc_I objects, all records -are inserted atomicly, or the transaction is rolled back (this requries a -transactional database). Passing an empty hash reference is equivalent to -not supplying this parameter. There should be a better explanation of this, -but until then, here's an example: +are inserted atomicly, or the transaction is rolled back. Passing an empty +hash reference is equivalent to not supplying this parameter. There should be +a better explanation of this, but until then, here's an example: use Tie::RefHash; tie %hash, 'Tie::RefHash'; #this part is important @@ -233,7 +232,7 @@ INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will be set as the invoicing list (see L<"invoicing_list">). Errors return as expected and rollback the entire transaction; it is not necessary to call check_invoicing_list first. The invoicing_list is set after the records in the -CUST_PKG_HASHREF above are inserted, so it is now possible set set an +CUST_PKG_HASHREF above are inserted, so it is now possible to set an invoicing_list destination to the newly-created svc_acct. Here's an example: $cust_main->insert( {}, [ $email, 'POST' ] ); @@ -1216,9 +1215,9 @@ sub collect { } my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list; - if ( $conf->exists('emailinvoiceonly') ) { - @invoicing_list = $self->default_invoicing_list - unless @invoicing_list; + if ( $conf->exists('emailinvoiceauto') + || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) { + push @invoicing_list, $self->default_invoicing_list; } my $email = $invoicing_list[0]; @@ -1467,7 +1466,7 @@ sub apply_payments { } - # return 0; + return $self->total_unapplied_payments; } =item total_credited @@ -1559,15 +1558,17 @@ sub invoicing_list { } else { @cust_main_invoice = (); } + my %seen = map { $_->address => 1 } @cust_main_invoice; foreach my $address ( @{$arrayref} ) { - unless ( grep { $address eq $_->address } @cust_main_invoice ) { - my $cust_main_invoice = new FS::cust_main_invoice ( { - 'custnum' => $self->custnum, - 'dest' => $address, - } ); - my $error = $cust_main_invoice->insert; - warn $error if $error; - } + #unless ( grep { $address eq $_->address } @cust_main_invoice ) { + next if exists $seen{$address} && $seen{$address}; + $seen{$address} = 1; + my $cust_main_invoice = new FS::cust_main_invoice ( { + 'custnum' => $self->custnum, + 'dest' => $address, + } ); + my $error = $cust_main_invoice->insert; + warn $error if $error; } } if ( $self->custnum ) { @@ -1603,6 +1604,8 @@ sub check_invoicing_list { =item default_invoicing_list +Returns the email addresses of any + =cut sub default_invoicing_list { @@ -1647,6 +1650,40 @@ sub referral_cust_main { @cust_main; } +=item referral_cust_pkg [ DEPTH ] + +Like referral_cust_main, except returns a flat list of all unsuspended packages +for each customer. The number of items in this list may be useful for +comission calculations (perhaps after a grep). + +=cut + +sub referral_cust_pkg { + my $self = shift; + my $depth = @_ ? shift : 1; + + map { $_->unsuspended_pkgs } + grep { $_->unsuspended_pkgs } + $self->referral_cust_main($depth); +} + +=item credit AMOUNT, REASON + +Applies a credit to this customer. If there is an error, returns the error, +otherwise returns false. + +=cut + +sub credit { + my( $self, $amount, $reason ) = @_; + my $cust_credit = new FS::cust_credit { + 'custnum' => $self->custnum, + 'amount' => $amount, + 'reason' => $reason, + }; + $cust_credit->insert; +} + =back =head1 SUBROUTINES @@ -1788,7 +1825,7 @@ sub append_fuzzyfiles { =head1 VERSION -$Id: cust_main.pm,v 1.39 2001-10-09 23:10:16 ivan Exp $ +$Id: cust_main.pm,v 1.40 2001-10-15 10:42:28 ivan Exp $ =head1 BUGS diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index d262a04e0..d84b9c5b7 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -46,11 +46,15 @@ inherits from FS::Record. The following fields are currently supported: =item comment - Text name of this billing item definition (non-customer-viewable) -=item setup - Setup fee +=item setup - Setup fee expression =item freq - Frequency of recurring fee -=item recur - Recurring fee +=item recur - Recurring fee expression + +=item plan - Price plan + +=item plandata - Price plan data =back @@ -128,6 +132,8 @@ sub check { || $self->ut_anything('setup') || $self->ut_number('freq') || $self->ut_anything('recur') + || $self->ut_alphan('plan') + || $self->ut_anything('plandata') ; } @@ -166,7 +172,7 @@ sub svcpart { =head1 VERSION -$Id: part_pkg.pm,v 1.2 1999-08-20 08:27:06 ivan Exp $ +$Id: part_pkg.pm,v 1.3 2001-10-15 10:42:28 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From a984fa561b6493ae41215c3d26013767f9ce79cb Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 15 Oct 2001 12:16:42 +0000 Subject: print reasons with credits on invoices use straight eval, not Safe::reval in cust_main::bill for now, as i have no idea how to call methods on a share()'ed scalar. hmm. add cust_pkg::cust_main method s/eidiot/idiot/ in httemplate/misc/bill.cgi --- FS/FS/cust_bill.pm | 8 ++++++-- FS/FS/cust_main.pm | 20 +++++++++++--------- FS/FS/cust_pkg.pm | 23 ++++++++++++++++------- 3 files changed, 33 insertions(+), 18 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index f61137f54..b65df89c4 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -389,8 +389,12 @@ sub print_text { #something more elaborate if $_->amount ne $_->cust_credit->credited ? + my $reason = substr($_->cust_credit->reason,0,32); + $reason .= '...' if length($reason) < length($_->cust_credit->reason); + $reason = " ($reason) " if $reason; push @buf,[ - "Credit #". $_->crednum. " (". time2str("%x",$_->cust_credit->_date) .")", + "Credit #". $_->crednum. " (". time2str("%x",$_->cust_credit->_date) .")". + $reason, $money_char. sprintf("%10.2f",$_->amount) ]; } @@ -489,7 +493,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.11 2001-09-03 22:07:38 ivan Exp $ +$Id: cust_bill.pm,v 1.12 2001-10-15 12:16:41 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index f99a15e69..dce73c0ba 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -843,10 +843,11 @@ sub bill { }; $setup_prog = $1; - my $cpt = new Safe; - #$cpt->permit(); #what is necessary? - $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods? - $setup = $cpt->reval($setup_prog); + #my $cpt = new Safe; + ##$cpt->permit(); #what is necessary? + #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods? + #$setup = $cpt->reval($setup_prog); + $setup = eval $setup_prog; unless ( defined($setup) ) { $dbh->rollback if $oldAutoCommit; return "Error reval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart. @@ -871,10 +872,11 @@ sub bill { }; $recur_prog = $1; - my $cpt = new Safe; - #$cpt->permit(); #what is necessary? - $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods? - $recur = $cpt->reval($recur_prog); + #my $cpt = new Safe; + ##$cpt->permit(); #what is necessary? + #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods? + #$recur = $cpt->reval($recur_prog); + $recur = eval $recur_prog; unless ( defined($recur) ) { $dbh->rollback if $oldAutoCommit; return "Error reval-ing part_pkg->recur pkgpart ". @@ -1825,7 +1827,7 @@ sub append_fuzzyfiles { =head1 VERSION -$Id: cust_main.pm,v 1.40 2001-10-15 10:42:28 ivan Exp $ +$Id: cust_main.pm,v 1.41 2001-10-15 12:16:42 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 1bcf74f78..cbf4ae50d 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -115,8 +115,7 @@ sub insert { my $error = $self->ut_number('custnum'); return $error if $error; - return "Unknown customer ". $self->custnum - unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); + return "Unknown customer ". $self->custnum unless $self->cust_main; $self->SUPER::insert; @@ -189,8 +188,7 @@ sub check { return $error if $error; if ( $self->custnum ) { - return "Unknown customer" - unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); + return "Unknown customer ". $self->custnum unless $self->cust_main; } return "Unknown pkgpart" @@ -433,6 +431,17 @@ sub labels { map { [ $_->label ] } qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } ); } +=item cust_main + +Returns the parent customer object (see L). + +=cut + +sub cust_main { + my $self = shift; + qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); +} + =back =head1 SUBROUTINES @@ -576,7 +585,7 @@ sub order { =head1 VERSION -$Id: cust_pkg.pm,v 1.9 2001-10-09 23:10:16 ivan Exp $ +$Id: cust_pkg.pm,v 1.10 2001-10-15 12:16:42 ivan Exp $ =head1 BUGS @@ -598,8 +607,8 @@ moved to check ? =head1 SEE ALSO -L, L, L, L -, L, schema.html from the base documentation +L, L, L, L, +L, schema.html from the base documentation =cut -- cgit v1.2.1 From 9410e9f656b950a9d4b383a3992fa50bb7a270db Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 15 Oct 2001 14:58:03 +0000 Subject: date editing --- FS/FS/cust_pkg.pm | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index cbf4ae50d..069ac8cf7 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -157,9 +157,12 @@ sub replace { #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart; return "Can't change otaker!" if $old->otaker ne $new->otaker; - return "Can't change setup once it exists!" - if $old->getfield('setup') && - $old->getfield('setup') != $new->getfield('setup'); + + #allow this *sigh* + #return "Can't change setup once it exists!" + # if $old->getfield('setup') && + # $old->getfield('setup') != $new->getfield('setup'); + #some logic for bill, susp, cancel? $new->SUPER::replace($old); @@ -585,7 +588,7 @@ sub order { =head1 VERSION -$Id: cust_pkg.pm,v 1.10 2001-10-15 12:16:42 ivan Exp $ +$Id: cust_pkg.pm,v 1.11 2001-10-15 14:58:03 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 60c837e0aaf454dfa0b0c0283dc36928782d1b6c Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 20 Oct 2001 12:18:00 +0000 Subject: setup and recurring fee tax exempt flags, UI to edit rework part_pkg editing UI some more --- FS/FS/cust_main.pm | 39 ++++++++++++++++++++++++++------------- FS/FS/part_pkg.pm | 17 +++++++++++++++-- 2 files changed, 41 insertions(+), 15 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index dce73c0ba..3895514d4 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -813,6 +813,7 @@ sub bill { # & generate invoice database. my( $total_setup, $total_recur ) = ( 0, 0 ); + my( $taxable_setup, $taxable_recur ) = ( 0, 0 ); my @cust_bill_pkg = (); foreach my $cust_pkg ( @@ -927,37 +928,49 @@ sub bill { push @cust_bill_pkg, $cust_bill_pkg; $total_setup += $setup; $total_recur += $recur; + $taxable_setup += $setup + unless $part_pkg->dbdef_table->column('setuptax') + || $part_pkg->setuptax =~ /^Y$/i; + $taxable_recur += $recur + unless $part_pkg->dbdef_table->column('recurtax') + || $part_pkg->recurtax =~ /^Y$/i; } } } my $charged = sprintf( "%.2f", $total_setup + $total_recur ); + my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur ); unless ( @cust_bill_pkg ) { $dbh->commit or die $dbh->errstr if $oldAutoCommit; return ''; } - unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) { + unless ( $self->tax =~ /Y/i + || $self->payby eq 'COMP' + || $taxable_charged == 0 ) { my $cust_main_county = qsearchs('cust_main_county',{ 'state' => $self->state, 'county' => $self->county, 'country' => $self->country, } ); my $tax = sprintf( "%.2f", - $charged * ( $cust_main_county->getfield('tax') / 100 ) + $taxable_charged * ( $cust_main_county->getfield('tax') / 100 ) ); - $charged = sprintf( "%.2f", $charged+$tax ); - - my $cust_bill_pkg = new FS::cust_bill_pkg ({ - 'pkgnum' => 0, - 'setup' => $tax, - 'recur' => 0, - 'sdate' => '', - 'edate' => '', - }); - push @cust_bill_pkg, $cust_bill_pkg; + + if ( $tax > 0 ) { + $charged = sprintf( "%.2f", $charged+$tax ); + + my $cust_bill_pkg = new FS::cust_bill_pkg ({ + 'pkgnum' => 0, + 'setup' => $tax, + 'recur' => 0, + 'sdate' => '', + 'edate' => '', + }); + push @cust_bill_pkg, $cust_bill_pkg; + } } my $cust_bill = new FS::cust_bill ( { @@ -1827,7 +1840,7 @@ sub append_fuzzyfiles { =head1 VERSION -$Id: cust_main.pm,v 1.41 2001-10-15 12:16:42 ivan Exp $ +$Id: cust_main.pm,v 1.42 2001-10-20 12:17:59 ivan Exp $ =head1 BUGS diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index d84b9c5b7..ceb2a0128 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -52,6 +52,10 @@ inherits from FS::Record. The following fields are currently supported: =item recur - Recurring fee expression +=item setuptax - Setup fee tax exempt flag, empty or `Y' + +=item recurtax - Recurring fee tax exempt flag, empty or `Y' + =item plan - Price plan =item plandata - Price plan data @@ -126,7 +130,7 @@ insert and replace methods. sub check { my $self = shift; - $self->ut_numbern('pkgpart') + my $error = $self->ut_numbern('pkgpart') || $self->ut_text('pkg') || $self->ut_text('comment') || $self->ut_anything('setup') @@ -135,6 +139,15 @@ sub check { || $self->ut_alphan('plan') || $self->ut_anything('plandata') ; + return $error if $error; + + $self->setuptax =~ /^(Y?)$/ or return "Illegal setuptax: ". $self->setuptax; + $self->setuptax($1); + + $self->recurtax =~ /^(Y?)$/ or return "Illegal recrutax: ". $self->recurtax; + $self->recurtax($1); + + ''; } =item pkg_svc @@ -172,7 +185,7 @@ sub svcpart { =head1 VERSION -$Id: part_pkg.pm,v 1.3 2001-10-15 10:42:28 ivan Exp $ +$Id: part_pkg.pm,v 1.4 2001-10-20 12:17:59 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From fcf83b9d956af1049af0d13812cc6756c78308b5 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 22 Oct 2001 08:29:42 +0000 Subject: better delete customer code & warnings, delete package ability (& warning) --- FS/FS/cust_main.pm | 25 ++++++++++++++++++++----- FS/FS/cust_pkg.pm | 15 ++++++++------- 2 files changed, 28 insertions(+), 12 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 3895514d4..12be7aba9 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -362,11 +362,13 @@ This will completely remove all traces of the customer record. This is not what you want when a customer cancels service; for that, cancel all of the customer's packages (see L). -If the customer has any packages, you need to pass a new (valid) customer -number for those packages to be transferred to. +If the customer has any uncancelled packages, you need to pass a new (valid) +customer number for those packages to be transferred to. Cancelled packages +will be deleted. Did I mention that this is NOT what you want when a customer +cancels service and that you really should be looking see L? You can't delete a customer with invoices (see L), -or credits (see L). +or credits (see L) or payments (see L). =cut @@ -392,8 +394,12 @@ sub delete { $dbh->rollback if $oldAutoCommit; return "Can't delete a customer with credits"; } + if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) { + $dbh->rollback if $oldAutoCommit; + return "Can't delete a customer with payments"; + } - my @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum } ); + my @cust_pkg = $self->ncancelled_pkgs; if ( @cust_pkg ) { my $new_custnum = shift; unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) { @@ -411,6 +417,15 @@ sub delete { } } } + my @cancelled_pkgs = $self->all_pkgs; + foreach my $cust_pkg ( @cancelled_cust_pkg ) { + my $error = $cust_pkg->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + foreach my $cust_main_invoice ( qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } ) ) { @@ -1840,7 +1855,7 @@ sub append_fuzzyfiles { =head1 VERSION -$Id: cust_main.pm,v 1.42 2001-10-20 12:17:59 ivan Exp $ +$Id: cust_main.pm,v 1.43 2001-10-22 08:29:42 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 069ac8cf7..7aee8d027 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -123,15 +123,16 @@ sub insert { =item delete -Currently unimplemented. You don't want to delete billing items, because there -would then be no record the customer ever purchased the item. Instead, see -the cancel method. +This method now works but you probably shouldn't use it. + +You don't want to delete billing items, because there would then be no record +the customer ever purchased the item. Instead, see the cancel method. =cut -sub delete { - return "Can't delete cust_pkg records!"; -} +#sub delete { +# return "Can't delete cust_pkg records!"; +#} =item replace OLD_RECORD @@ -588,7 +589,7 @@ sub order { =head1 VERSION -$Id: cust_pkg.pm,v 1.11 2001-10-15 14:58:03 ivan Exp $ +$Id: cust_pkg.pm,v 1.12 2001-10-22 08:29:42 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 813696972eaf418cb94abca6aa2d4bfc4c67829a Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 22 Oct 2001 08:31:25 +0000 Subject: tyop --- FS/FS/cust_main.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 12be7aba9..dfb712502 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -417,7 +417,7 @@ sub delete { } } } - my @cancelled_pkgs = $self->all_pkgs; + my @cancelled_cust_pkg = $self->all_pkgs; foreach my $cust_pkg ( @cancelled_cust_pkg ) { my $error = $cust_pkg->delete; if ( $error ) { @@ -1855,7 +1855,7 @@ sub append_fuzzyfiles { =head1 VERSION -$Id: cust_main.pm,v 1.43 2001-10-22 08:29:42 ivan Exp $ +$Id: cust_main.pm,v 1.44 2001-10-22 08:31:25 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From f94ef1d2324d55293ba9efeb3a6156a488bbd39f Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 22 Oct 2001 12:22:03 +0000 Subject: fix delete method for new databases --- FS/FS/svc_domain.pm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm index 58c6423c3..8b8c35957 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -279,7 +279,8 @@ sub delete { if qsearch( 'svc_acct', { 'domsvc' => $self->svcnum } ); return "Can't delete a domain with (svc_acct_sm) mail aliases!" - if qsearch('svc_acct_sm', { 'domsvc' => $self->svcnum } ); + if defined( $FS::Record::dbdef->table('svc_acct_sm') ) + && qsearch('svc_acct_sm', { 'domsvc' => $self->svcnum } ); return "Can't delete a domain with (domain_record) zone entries!" if qsearch('domain_record', { 'svcnum' => $self->svcnum } ); @@ -533,7 +534,7 @@ sub submit_internic { =head1 VERSION -$Id: svc_domain.pm,v 1.20 2001-09-06 20:41:59 ivan Exp $ +$Id: svc_domain.pm,v 1.21 2001-10-22 12:22:03 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From b7cdcea59f34c12f7d181c41014e0d2559bf983c Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 22 Oct 2001 14:48:28 +0000 Subject: fix dir check --- FS/FS/svc_acct.pm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 71c47d6cd..8e29cb739 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -720,9 +720,10 @@ sub check { or return "Illegal finger: ". $self->getfield('finger'); $self->setfield('finger', $1); - $recref->{dir} =~ /^([\/\w\-]*)$/ + $recref->{dir} =~ /^([\/\w\-\.]*)$/ or return "Illegal directory"; $recref->{dir} = $1; + return "Illegal directory" if $recref->{dir} =~ /\.\./; #no .. unless ( $recref->{dir} ) { $recref->{dir} = $dir_prefix . '/'; if ( $dirhash > 0 ) { @@ -920,7 +921,7 @@ sub ssh { =head1 VERSION -$Id: svc_acct.pm,v 1.50 2001-10-02 11:10:19 ivan Exp $ +$Id: svc_acct.pm,v 1.51 2001-10-22 14:48:28 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 6f325cd8d38905b98c6f11a64701653bdd9f9fcf Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 23 Oct 2001 20:53:06 +0000 Subject: Pg: FOR UPDATE LIMIT 1 mysql: LIMIT 1 FOR UPDATE greeeat. --- FS/bin/freeside-queued | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-queued b/FS/bin/freeside-queued index 35728db53..4e3724e6e 100644 --- a/FS/bin/freeside-queued +++ b/FS/bin/freeside-queued @@ -7,7 +7,7 @@ use Fcntl qw(:flock); use POSIX qw(setsid); use Date::Format; use IO::File; -use FS::UID qw(adminsuidsetup forksuidsetup); +use FS::UID qw(adminsuidsetup forksuidsetup driver_name); use FS::Record qw(qsearchs); use FS::queue; @@ -48,7 +48,9 @@ while (1) { 'queue', { 'status' => 'new' }, '', - 'ORDER BY jobnum FOR UPDATE LIMIT 1' + driver_name =~ /^mysql$/i + ? 'ORDER BY jobnum LIMIT 1 FOR UPDATE' + : 'ORDER BY jobnum FOR UPDATE LIMIT 1' ) or do { sleep 5; next; @@ -76,7 +78,7 @@ while (1) { #get new db handles $FS::UID::dbh->{InactiveDestroy} = 1; - $FS::svc_acct::icradius_dbh->{InactiveDestroy} + $FS::svc_acct::icradius_dbh->{InactiveDestroy} = 1 if $FS::svc_acct::icradius_dbh; forksuidsetup($user); -- cgit v1.2.1 From e6b57805f6b3e76448ab9b6d280f2c53bc1410f3 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 24 Oct 2001 15:29:31 +0000 Subject: preliminary web config editor new config files: username-ampersand, passwordmax fs-setup updates get rid of old and crufty and unused registries/ config foo documentation updates --- FS/FS.pm | 4 +- FS/FS/Conf.pm | 587 +++++++++++++++++++++++++++++++++++++++++++++++++++- FS/FS/ConfItem.pm | 63 ++++++ FS/FS/svc_acct.pm | 26 ++- FS/FS/svc_domain.pm | 124 +---------- FS/MANIFEST | 2 + FS/t/ConfItem.t | 5 + 7 files changed, 677 insertions(+), 134 deletions(-) create mode 100644 FS/FS/ConfItem.pm create mode 100644 FS/t/ConfItem.t (limited to 'FS') diff --git a/FS/FS.pm b/FS/FS.pm index d2c07e47c..ca3330066 100644 --- a/FS/FS.pm +++ b/FS/FS.pm @@ -21,6 +21,8 @@ Freeside ISP billing software. This includes: L - Freeside configuration values +L - Freeside configuration option meta-data. + L - User class (not yet OO) L - Non OO-subroutines for the web interface. This is @@ -141,7 +143,7 @@ The main documentation is in htdocs/docs. =head1 VERSION -$Id: FS.pm,v 1.9 2001-09-26 09:17:06 ivan Exp $ +$Id: FS.pm,v 1.10 2001-10-24 15:29:30 ivan Exp $ =head1 SUPPORT diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 7c6105bdc..615fdcb72 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -1,7 +1,10 @@ package FS::Conf; -use vars qw($default_dir); +use vars qw($default_dir @config_items $DEBUG ); use IO::File; +use FS::ConfItem; + +$DEBUG = 0; =head1 NAME @@ -22,6 +25,8 @@ FS::Conf - Read access to Freeside configuration values @list = $conf->config('key'); $bool = $conf->exists('key'); + @config_items = $conf->config_items; + =head1 DESCRIPTION Read access to Freeside configuration values. Keys currently map to filenames, @@ -58,7 +63,8 @@ sub dir { -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; + $dir =~ /^(.*)$/; + $1; } =item config @@ -97,16 +103,589 @@ sub exists { -e "$dir/$file"; } +=item touch + +=cut + +sub touch { + my($self, $file) = @_; + my $dir = $self->dir; + unless ( $self->exists($file) ) { + warn "[FS::Conf] TOUCH $file\n" if $DEBUG; + system('touch', "$dir/$file"); + } +} + +=item set + +=cut + +sub set { + my($self, $file, $value) = @_; + my $dir = $self->dir; + $value =~ /^(.*)$/s; + $value = $1; + unless ( $self->config($file) eq $value ) { + warn "[FS::Conf] SET $file\n" if $DEBUG; + warn "$dir" if is_tainted($dir); + warn "$dir" if is_tainted($file); + my $fh = new IO::File ">$dir/$file" or return; + print $fh "$value\n"; + } +} +sub is_tainted { + return ! eval { join('',@_), kill 0; 1; }; + } + +=item delete + +=cut + +sub delete { + my($self, $file) = @_; + my $dir = $self->dir; + if ( $self->exists($file) ) { + warn "[FS::Conf] DELETE $file\n"; + unlink "$dir/$file"; + } +} + +=item config_items + +Returns all of the possible configuration items as FS::ConfItem objects. See +L. + +=cut + +sub config_items { +# my $self = shift; + @config_items; +} + =back =head1 BUGS -Write access (with locking) should be implemented. +Write access (touch, set, delete) should be documented. + +If this was more than just crud that will never be useful outside Freeside I'd +worry that config_items is freeside-specific and icky. =head1 SEE ALSO -config.html from the base documentation contains a list of configuration files. +"Configuration" in the web interface (config/config.cgi). + +httemplate/docs/config.html =cut +@config_items = map { new FS::ConfItem $_ } ( + + { + 'key' => 'address', + 'section' => 'depreciated', + 'description' => 'This configuration file is no longer used. See invoice_template instead.', + 'type' => 'text', + }, + + { + 'key' => 'apacheroot', + 'section' => 'apache', + 'description' => 'The directory containing Apache virtual hosts', + 'type' => 'text', + }, + + { + 'key' => 'apachemachine', + 'section' => 'apache', + 'description' => 'A machine with the apacheroot directory and user home directories. The existance of this file enables setup of virtual host directories, and, in conjunction with the `home\' configuration file, symlinks into user home directories.', + 'type' => 'text', + }, + + { + 'key' => 'apachemachines', + 'section' => 'apache', + 'description' => 'Your Apache machines, one per line. This enables export of `/etc/apache/vhosts.conf\', which can be included in your Apache configuration via the Include directive.', + 'type' => 'textarea', + }, + + { + 'key' => 'bindprimary', + 'section' => 'BIND', + 'description' => 'Your BIND primary nameserver. This enables export of /var/named/named.conf and zone files into /var/named', + 'type' => 'text', + }, + + { + 'key' => 'bindsecondaries', + 'section' => 'BIND', + 'description' => 'Your BIND secondary nameservers, one per line. This enables export of /var/named/named.conf', + 'type' => 'textarea', + }, + + { + 'key' => 'business-onlinepayment', + 'section' => 'billing', + 'description' => 'Business::OnlinePayment support, at least three lines: processor, login, and password. An optional fourth line specifies the action or actions (multiple actions are separated with `,\': for example: `Authorization Only, Post Authorization\'). Optional additional lines are passed to Business::OnlinePayment as %processor_options.', + 'type' => 'textarea', + }, + + { + 'key' => 'bsdshellmachines', + 'section' => '', + 'description' => 'Your BSD flavored shell (and mail) machines, one per line. This enables export of `/etc/passwd\' and `/etc/master.passwd\'.', + 'type' => 'textarea', + }, + + { + 'key' => 'countrydefault', + 'section' => 'UI', + 'description' => 'Default two-letter country code (if not supplied, the default is `US\')', + 'type' => 'text', + }, + + { + 'key' => 'cybercash3.2', + 'section' => 'billing', + 'description' => 'CyberCash Cashregister v3.2 support. Two lines: the full path and name of your merchant_conf file, and the transaction type (`mauthonly\' or `mauthcapture\').', + 'type' => 'textarea', + }, + + { + 'key' => 'cyrus', + 'section' => '', + 'description' => 'Integration with Cyrus IMAP Server, three lines: IMAP server, admin username, and admin password. Cyrus::IMAP::Admin should be installed locally and the connection to the server secured.', + 'type' => 'textarea', + }, + + { + 'key' => 'deletecustomers', + 'section' => 'UI', + 'description' => '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.', + 'type' => 'checkbox', + }, + + { + 'key' => 'dirhash', + 'section' => 'shell', + 'description' => 'Optional numeric value to control directory hashing. If positive, hashes directories for the specified number of levels from the front of the username. If negative, hashes directories for the specified number of levels from the end of the username. Some examples:
  • 1: user -> /home/u/user
  • 2: user -> /home/u/s/user
  • -1: user -> /home/r/user
  • -2: user -> home/r/e/user
', + 'type' => 'text', + }, + + { + 'key' => 'disable_customer_referrals', + 'section' => 'UI', + 'description' => 'The existance of this file will disable new customer-to-customer referrals in the web interface.', + 'type' => 'checkbox', + }, + + { + 'key' => 'domain', + 'section' => 'depreciated', + 'description' => 'Your domain name.', + 'type' => 'text', + }, + + { + 'key' => 'editreferrals', + 'section' => 'UI', + 'description' => 'The existance of this file will allow you to change the referral of existing customers.', + 'type' => 'checkbox', + }, + + { + 'key' => 'emailinvoiceonly', + 'section' => 'billing', + 'description' => 'Disables postal mail invoices.', + 'type' => 'checkbox', + }, + + { + 'key' => 'emailinvoiceauto', + 'section' => 'billing', + 'description' => 'Automatically adds new accounts to the email invoice list upon customer creation.', + 'type' => 'checkbox', + }, + + { + 'key' => 'erpcdmachines', + 'section' => '', + 'description' => 'Your ERPCD authenticaion machines, one per line. This enables export of `/usr/annex/acp_passwd\' and `/usr/annex/acp_dialup\'.', + 'type' => 'textarea', + }, + + { + 'key' => 'hidecancelledpackages', + 'section' => 'UI', + 'description' => 'The existance of this file will prevent cancelled packages from showing up in listings (though they will still be in the database)', + 'type' => 'checkbox', + }, + + { + 'key' => 'hidecancelledcustomers', + 'section' => 'UI', + 'description' => '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)', + 'type' => 'checkbox', + }, + + { + 'key' => 'home', + 'section' => 'required', + 'description' => 'For new users, prefixed to username to create a directory name. Should have a leading but not a trailing slash.', + 'type' => 'text', + }, + + { + 'key' => 'icradiusmachines', + 'section' => '', + 'description' => '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". You do not need to use MySQL for your Freeside database to export to an ICRADIUS mysql database with this option.', + 'type' => [qw( checkbox textarea )], + }, + + { + 'key' => 'icradius_mysqldest', + 'section' => '', + 'description' => 'Destination directory for the MySQL databases, on the ICRADIUS machines. Defaults to "/usr/local/var/".', + 'type' => 'text', + }, + + { + 'key' => 'icradius_mysqlsource', + 'section' => '', + 'description' => 'Source directory for for the MySQL radcheck table files, on the Freeside machine. Defaults to "/usr/local/var/freeside".', + 'type' => 'text', + }, + + { + 'key' => 'icradius_secrets', + 'section' => '', + 'description' => '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.', + 'type' => 'textarea', + }, + + { + 'key' => 'invoice_from', + 'section' => 'required', + 'description' => 'Return address on email invoices.', + 'type' => 'text', + }, + + { + 'key' => 'invoice_template', + 'section' => 'required', + 'description' => 'Required template file for invoices. See the billing documentation for details.', + 'type' => 'textarea', + }, + + { + 'key' => 'lpr', + 'section' => 'required', + 'description' => 'Print command for paper invoices, for example `lpr -h\'.', + 'type' => 'text', + }, + + { + 'key' => 'maildisablecatchall', + 'section' => 'depreciated', + 'description' => 'DEPRECIATED, now the default. The existance of this file used to disable the requirement that each virtual domain have a catch-all mailbox.', + 'type' => 'checkbox', + }, + + { + 'key' => 'money_char', + 'section' => '', + 'description' => 'Currency symbol - defaults to `$\'.', + 'type' => 'text', + }, + + { + 'key' => 'mxmachines', + 'section' => 'BIND', + 'description' => 'MX entries for new domains, weight and machine, one per line, with trailing `.\'', + 'type' => 'textarea', + }, + + { + 'key' => 'nsmachines', + 'section' => 'BIND', + 'description' => 'NS nameservers for new domains, one per line, with trailing `.\'', + 'type' => 'textarea', + }, + + { + 'key' => 'nismachines', + 'section' => '', + 'description' => 'Your NIS master (not slave master) machines, one per line. This enables export of `/etc/global/passwd\' and `/etc/global/shadow\'.', + 'type' => 'textarea', + }, + + { + 'key' => 'passwordmin', + 'section' => 'password', + 'description' => 'Minimum password length (default 6)', + 'type' => 'text', + }, + + { + 'key' => 'passwordmax', + 'section' => 'password', + 'description' => 'Maximum password length (default 8) (don\'t set this over 12 if you need to import or export crypt() passwords)', + 'type' => 'text', + }, + + { + 'key' => 'qmailmachines', + 'section' => '', + 'description' => '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\'.', + 'type' => [qw( checkbox textarea )], + }, + + { + 'key' => 'radiusmachines', + 'section' => '', + 'description' => 'Your RADIUS authentication machines, one per line. This enables export of `/etc/raddb/users\'.', + 'type' => 'textarea', + }, + + { + 'key' => 'referraldefault', + 'section' => 'UI', + 'description' => 'Default referral, specified by refnum.', + 'type' => 'text', + }, + +# { +# 'key' => 'registries', +# 'section' => 'required', +# 'description' => 'Directory which contains domain registry information. Each registry is a directory.', +# }, + + { + 'key' => 'sendmailconfigpath', + 'section' => '', + 'description' => 'Sendmail configuration file path - defaults to `/etc\'. Many newer distributions use `/etc/mail\'.', + 'type' => 'text', + }, + + { + 'key' => 'sendmailmachines', + 'section' => '', + 'description' => 'Your sendmail machines, one per line. This enables export of `/etc/virtusertable\' and `/etc/sendmail.cw\'.', + 'type' => 'textarea', + }, + + { + 'key' => 'sendmailrestart', + 'section' => '', + 'description' => 'If defined, the command which is run on sendmail machines after files are copied.', + 'type' => 'text', + }, + + { + 'key' => 'session-start', + 'section' => 'session', + 'description' => 'If defined, the command which is executed on the Freeside machine when a session begins. The contents of the file are treated as a double-quoted perl string, with the following variables available: $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.', + 'type' => 'text', + }, + + { + 'key' => 'session-stop', + 'section' => 'session', + 'description' => 'If defined, the command which is executed on the Freeside machine when a session ends. The contents of the file are treated as a double-quoted perl string, with the following variables available: $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.', + 'type' => 'text', + }, + + { + 'key' => 'shellmachine', + 'section' => 'shell', + 'description' => 'A single machine with user home directories mounted. This enables home directory creation, renaming and archiving/deletion. In conjunction with `qmailmachines\', it also enables `.qmail-extension\' file maintenance.', + 'type' => 'text', + }, + + { + 'key' => 'shellmachine-useradd', + 'section' => 'shell', + 'description' => '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.', + 'type' => [qw( checkbox text )], + }, + + { + 'key' => 'shellmachine-userdel', + 'section' => 'shell', + 'description' => '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.', + 'type' => [qw( checkbox text )], + }, + + { + 'key' => 'shellmachine-usermod', + 'section' => 'shell', + 'description' => '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.', + 'type' => [qw( checkbox text )], + }, + + { + 'key' => 'shellmachines', + 'section' => 'shell', + 'description' => 'Your Linux and System V flavored shell (and mail) machines, one per line. This enables export of `/etc/passwd\' and `/etc/shadow\' files.', + 'type' => 'textarea', + }, + + { + 'key' => 'shells', + 'section' => 'required', + 'description' => 'Legal shells (think /etc/shells). You probably want to `cut -d: -f7 /etc/passwd | sort | uniq\' initially so that importing doesn\'t fail with `Illegal shell\' errors, then remove any special entries afterwords. A blank line specifies that an empty shell is permitted.', + 'type' => 'textarea', + }, + + { + 'key' => 'showpasswords', + 'section' => 'UI', + 'description' => 'The existance of this file will allow unencrypted user passwords to be displayed.', + 'type' => 'checkbox', + }, + + { + 'key' => 'signupurl', + 'section' => 'UI', + 'description' => 'if you are using customer-to-customer referrals, and you enter the URL of your signup server CGI, the customer view screen will display a customized link to the signup server with the appropriate customer as referral.', + 'type' => 'text', + }, + + { + 'key' => 'smtpmachine', + 'section' => 'required', + 'description' => 'SMTP relay for Freeside\'s outgoing mail.', + 'type' => 'text', + }, + + { + 'key' => 'soadefaultttl', + 'section' => 'BIND', + 'description' => 'SOA default TTL for new domains.', + 'type' => 'text', + }, + + { + 'key' => 'soaemail', + 'section' => 'BIND', + 'description' => 'SOA email for new domains, in BIND form (`.\' instead of `@\'), with trailing `.\'', + 'type' => 'text', + }, + + { + 'key' => 'soaexpire', + 'section' => 'BIND', + 'description' => 'SOA expire for new domains', + 'type' => 'text', + }, + + { + 'key' => 'soamachine', + 'section' => 'BIND', + 'description' => 'SOA machine for new domains, with trailing `.\'', + 'type' => 'text', + }, + + { + 'key' => 'soarefresh', + 'section' => 'BIND', + 'description' => 'SOA refresh for new domains', + 'type' => 'text', + }, + + { + 'key' => 'soaretry', + 'section' => 'BIND', + 'description' => 'SOA retry for new domains', + 'type' => 'text', + }, + + { + 'key' => 'statedefault', + 'section' => 'UI', + 'description' => 'Default state or province (if not supplied, the default is `CA\')', + 'type' => 'text', + }, + + { + 'key' => 'textradiusprepend', + 'section' => 'depreciated', + 'description' => 'DEPRECIATED, use RADIUS check attributes instead. This option will be removed soon. The contents of this file will be prepended to the first line of a user\'s RADIUS entry in text exports.', + 'type' => 'text', + }, + + { + 'key' => 'unsuspendauto', + 'section' => 'billing', + 'description' => 'The existance of this file will enable the automatic unsuspension of suspended packages when a customer\'s balance due changes from positive to zero or negative as the result of a payment or credit.', + 'type' => 'checkbox', + }, + + { + 'key' => 'usernamemin', + 'section' => 'username', + 'description' => 'Minimum username length (default 2);', + 'type' => 'text', + }, + + { + 'key' => 'usernamemax', + 'section' => 'username', + 'description' => 'Maximum username length (default is the size of the SQL column, probably specified when fs-setup was run)', + 'type' => 'text', + }, + + { + 'key' => 'username-ampersand', + 'section' => 'username', + 'description' => 'The existance of this file will allow the ampersand character (&) in usernames. Be careful when using this option in conjunction with shellmachine-useradd and other configuration options which execute shell commands, as the ampersand will be interpreted by the shell if not quoted.', + 'type' => 'checkbox', + }, + + { + 'key' => 'username-letter', + 'section' => 'username', + 'description' => 'The existance of this file will turn on the requirement that usernames contain at least one letter.', + 'type' => 'checkbox', + }, + + { + 'key' => 'username-letterfirst', + 'section' => 'username', + 'description' => 'The existance of this file will turn on the requirement that usernames start with a letter.', + 'type' => 'checkbox', + }, + + { + 'key' => 'username-noperiod', + 'section' => 'username', + 'description' => 'The existance of this file will disallow periods in usernames.', + 'type' => 'checkbox', + }, + + { + 'key' => 'username-uppercase', + 'section' => 'username', + 'description' => 'The existance of this file will allow uppercase characters in username.', + 'type' => 'checkbox', + }, + + { + 'key' => 'username_policy', + 'section' => '', + 'description' => 'This file controls the mechanism for preventing duplicate usernames in passwd/radius files exported from svc_accts. This should be one of \'prepend domsvc\' \'append domsvc\' or \'append domain\'', +# 'type' => 'select', + 'type' => '', + }, + + { + 'key' => 'vpopmailmachines', + 'section' => '', + 'description' => 'Your vpopmail pop toasters, one per line. Each line is of the form "machinename vpopdir vpopuid vpopgid". For example: poptoaster.domain.tld /home/vpopmail 508 508 Note: vpopuid and vpopgid are values taken from the vpopmail machine\'s /etc/passwd', + 'type' => 'textarea', + }, + +); + 1; + diff --git a/FS/FS/ConfItem.pm b/FS/FS/ConfItem.pm new file mode 100644 index 000000000..83295b4fa --- /dev/null +++ b/FS/FS/ConfItem.pm @@ -0,0 +1,63 @@ +package FS::ConfItem; + +=head1 NAME + +FS::ConfItem - Configutaion option meta-data. + +=head1 SYNOPSIS + + use FS::Conf; + @config_items = $conf->config_items; + + foreach $item ( @config_items ) { + $key = $item->key; + $section = $item->section; + $description = $item->description; + } + +=head1 DESCRIPTION + +=head1 METHODS + +=over 4 + +=item new + +=cut + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = @_ ? shift : {}; + bless ($self, $class); +} + +=item key + +=item section + +=item description + +=cut + +sub AUTOLOAD { + my $self = shift; + my $field = $AUTOLOAD; + $field =~ s/.*://; + $self->{$field}; +} + +=back + +=head1 BUGS + +Terse docs. + +=head1 SEE ALSO + +L + +=cut + +1; + diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 8e29cb739..3e7230f49 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -2,7 +2,8 @@ package FS::svc_acct; use strict; use vars qw( @ISA $nossh_hack $conf $dir_prefix @shells $usernamemin - $usernamemax $passwordmin $username_letter $username_letterfirst + $usernamemax $passwordmin $passwordmax + $username_ampersand $username_letter $username_letterfirst $username_noperiod $username_uppercase $shellmachine $useradd $usermod $userdel $mydomain $cyrus_server $cyrus_admin_user $cyrus_admin_pass @@ -33,6 +34,7 @@ $FS::UID::callback{'FS::svc_acct'} = sub { $usernamemin = $conf->config('usernamemin') || 2; $usernamemax = $conf->config('usernamemax'); $passwordmin = $conf->config('passwordmin') || 6; + $passwordmax = $conf->config('passwordmax') || 8; if ( $shellmachine ) { if ( $conf->exists('shellmachine-useradd') ) { $useradd = join("\n", $conf->config('shellmachine-useradd') ) @@ -58,6 +60,7 @@ $FS::UID::callback{'FS::svc_acct'} = sub { $username_letterfirst = $conf->exists('username-letterfirst'); $username_noperiod = $conf->exists('username-noperiod'); $username_uppercase = $conf->exists('username-uppercase'); + $username_ampersand = $conf->exists('username-ampersand'); $mydomain = $conf->config('domain'); if ( $conf->exists('cyrus') ) { ($cyrus_server, $cyrus_admin_user, $cyrus_admin_pass) = @@ -676,11 +679,11 @@ sub check { my $ulen = $usernamemax || $self->dbdef_table->column('username')->length; if ( $username_uppercase ) { - $recref->{username} =~ /^([a-z0-9_\-\.]{$usernamemin,$ulen})$/i + $recref->{username} =~ /^([a-z0-9_\-\.\&]{$usernamemin,$ulen})$/i or return "Illegal username: ". $recref->{username}; $recref->{username} = $1; } else { - $recref->{username} =~ /^([a-z0-9_\-\.]{$usernamemin,$ulen})$/ + $recref->{username} =~ /^([a-z0-9_\-\.\&]{$usernamemin,$ulen})$/ or return "Illegal username: ". $recref->{username}; $recref->{username} = $1; } @@ -693,6 +696,9 @@ sub check { if ( $username_noperiod ) { $recref->{username} =~ /\./ and return "Illegal username"; } + unless ( $username_ampersand ) { + $recref->{username} =~ /\&/ and return "Illegal username"; + } $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum}; $recref->{popnum} = $1; @@ -720,10 +726,13 @@ sub check { or return "Illegal finger: ". $self->getfield('finger'); $self->setfield('finger', $1); - $recref->{dir} =~ /^([\/\w\-\.]*)$/ + $recref->{dir} =~ /^([\/\w\-\.\&]*)$/ or return "Illegal directory"; $recref->{dir} = $1; - return "Illegal directory" if $recref->{dir} =~ /\.\./; #no .. + return "Illegal directory" + if $recref->{dir} =~ /(^|\/)\.+(\/|$)/; #no .. component + return "Illegal directory" + if $recref->{dir} =~ /\&/ && ! $username_ampersand; unless ( $recref->{dir} ) { $recref->{dir} = $dir_prefix . '/'; if ( $dirhash > 0 ) { @@ -787,7 +796,7 @@ sub check { unless ( $recref->{_password} ); #if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,16})$/ ) { - if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{$passwordmin,8})$/ ) { + if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{$passwordmin,$passwordmax})$/ ) { $recref->{_password} = $1.$3; #uncomment this to encrypt password immediately upon entry, or run #bin/crypt_pw in cron to give new users a window during which their @@ -803,7 +812,8 @@ sub check { } elsif ( $recref->{_password} eq '!!' ) { $recref->{_password} = '!!'; } else { - return "Illegal password"; + #return "Illegal password"; + return "Illegal password: ". $recref->{_password}; } ''; #no error @@ -921,7 +931,7 @@ sub ssh { =head1 VERSION -$Id: svc_acct.pm,v 1.51 2001-10-22 14:48:28 ivan Exp $ +$Id: svc_acct.pm,v 1.52 2001-10-24 15:29:30 ivan Exp $ =head1 BUGS diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm index 8b8c35957..bc62ea7bc 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -2,7 +2,6 @@ package FS::svc_domain; use strict; use vars qw( @ISA $whois_hack $conf $smtpmachine - $tech_contact $from $to @nameservers @nameserver_ips @template @mxmachines @nsmachines $soadefaultttl $soaemail $soaexpire $soamachine $soarefresh $soaretry $qshellmachine $nossh_hack ); @@ -29,23 +28,6 @@ $FS::UID::callback{'FS::domain'} = sub { $smtpmachine = $conf->config('smtpmachine'); - my($internic)="/registries/internic"; - $tech_contact = $conf->config("$internic/tech_contact"); - $from = $conf->config("$internic/from"); - $to = $conf->config("$internic/to"); - my(@ns) = $conf->config("$internic/nameservers"); - @nameservers=map { - /^\s*\d+\.\d+\.\d+\.\d+\s+([^\s]+)\s*$/ - or die "Illegal line in $internic/nameservers"; - $1; - } @ns; - @nameserver_ips=map { - /^\s*(\d+\.\d+\.\d+\.\d+)\s+([^\s]+)\s*$/ - or die "Illegal line in $internic/nameservers!"; - $1; - } @ns; - @template = map { $_. "\n" } $conf->config("$internic/template"); - @mxmachines = $conf->config('mxmachines'); @nsmachines = $conf->config('nsmachines'); $soadefaultttl = $conf->config('soadefaultttl'); @@ -426,115 +408,15 @@ Submits a registration email for this domain. =cut sub submit_internic { - my $self = shift; - - my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } ); - return unless $cust_pkg; - my $cust_main = qsearchs( 'cust_main', { 'custnum' => $cust_pkg->custnum } ); - return unless $cust_main; - - my %subs = ( - 'action' => $self->action, - 'purpose' => $self->purpose, - 'domain' => $self->domain, - 'company' => $cust_main->company - || $cust_main->getfield('first'). ' '. - $cust_main->getfield('last') - , - 'city' => $cust_main->city, - 'state' => $cust_main->state, - 'zip' => $cust_main->zip, - 'country' => $cust_main->country, - 'last' => $cust_main->getfield('last'), - 'first' => $cust_main->getfield('first'), - 'daytime' => $cust_main->daytime, - 'fax' => $cust_main->fax, - 'email' => $self->email, - 'tech_contact' => $tech_contact, - 'primary' => shift @nameservers, - 'primary_ip' => shift @nameserver_ips, - ); - - #yuck - my @xtemplate = @template; - my @body; - my $line; - OLOOP: while ( defined( $line = shift @xtemplate ) ) { - - if ( $line =~ /^###LOOP###$/ ) { - my(@buffer); - LOADBUF: while ( defined( $line = shift @xtemplate ) ) { - last LOADBUF if ( $line =~ /^###ENDLOOP###$/ ); - push @buffer, $line; - } - my %lubs = ( - 'address' => $cust_main->address2 - ? [ $cust_main->address1, $cust_main->address2 ] - : [ $cust_main->address1 ] - , - 'secondary' => [ @nameservers ], - 'secondary_ip' => [ @nameserver_ips ], - ); - LOOP: while (1) { - my @xbuffer = @buffer; - SUBLOOP: while ( defined( $line = shift @xbuffer ) ) { - if ( $line =~ /###(\w+)###/ ) { - #last LOOP unless my($lub)=shift@{$lubs{$1}}; - next OLOOP unless my $lub = shift @{$lubs{$1}}; - $line =~ s/###(\w+)###/$lub/e; - redo SUBLOOP; - } else { - push @body, $line; - } - } #SUBLOOP - } #LOOP - - } - - if ( $line =~ /###(\w+)###/ ) { - #$line =~ s/###(\w+)###/$subs{$1}/eg; - $line =~ s/###(\w+)###/$subs{$1}/e; - redo OLOOP; - } else { - push @body, $line; - } - - } #OLOOP - - my $subject; - if ( $self->action eq "M" ) { - $subject = "MODIFY DOMAIN ". $self->domain; - } elsif ( $self->action eq "N" ) { - $subject = "NEW DOMAIN ". $self->domain; - } else { - croak "submit_internic called with action ". $self->action; - } - - $ENV{SMTPHOSTS} = $smtpmachine; - $ENV{MAILADDRESS} = $from; - my $header = Mail::Header->new( [ - "From: $from", - "To: $to", - "Sender: $from", - "Reply-To: $from", - "Date: ". time2str("%a, %d %b %Y %X %z", time), - "Subject: $subject", - ] ); - - my($msg)=Mail::Internet->new( - 'Header' => $header, - 'Body' => \@body, - ); - - $msg->smtpsend or die "Can't send registration email"; #die? warn? - + #my $self = shift; + carp "submit_internic depreciated"; } =back =head1 VERSION -$Id: svc_domain.pm,v 1.21 2001-10-22 12:22:03 ivan Exp $ +$Id: svc_domain.pm,v 1.22 2001-10-24 15:29:30 ivan Exp $ =head1 BUGS diff --git a/FS/MANIFEST b/FS/MANIFEST index 5af893a4d..5de6977a1 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -11,6 +11,7 @@ fin/freeside-apply-credits FS.pm FS/CGI.pm FS/Conf.pm +FS/ConfItem.pm FS/Record.pm FS/UI/Base.pm FS/UI/CGI.pm @@ -61,6 +62,7 @@ t/agent_type.t t/CGI.t t/CGIwrapper.t t/Conf.t +t/ConfItem.t t/cust_bill.t t/cust_bill_pay.t t/cust_bill_pkg.t diff --git a/FS/t/ConfItem.t b/FS/t/ConfItem.t new file mode 100644 index 000000000..c7932d7e3 --- /dev/null +++ b/FS/t/ConfItem.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::ConfItem; +$loaded=1; +print "ok 1\n"; -- cgit v1.2.1 From 03fbdb67704c8b1afa696b1d7ff98fc005c05af4 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 25 Oct 2001 08:41:43 +0000 Subject: remove debugging cruft --- FS/FS/Conf.pm | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 615fdcb72..fb8d13bae 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -127,15 +127,15 @@ sub set { $value = $1; unless ( $self->config($file) eq $value ) { warn "[FS::Conf] SET $file\n" if $DEBUG; - warn "$dir" if is_tainted($dir); - warn "$dir" if is_tainted($file); +# warn "$dir" if is_tainted($dir); +# warn "$dir" if is_tainted($file); my $fh = new IO::File ">$dir/$file" or return; print $fh "$value\n"; } } -sub is_tainted { - return ! eval { join('',@_), kill 0; 1; }; - } +#sub is_tainted { +# return ! eval { join('',@_), kill 0; 1; }; +# } =item delete -- cgit v1.2.1 From 76191674732cd788622f864d385187504a45f4ed Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 25 Oct 2001 16:13:10 +0000 Subject: & in email addresses --- FS/FS/cust_main_invoice.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main_invoice.pm b/FS/FS/cust_main_invoice.pm index d6b4cd933..3077d645a 100644 --- a/FS/FS/cust_main_invoice.pm +++ b/FS/FS/cust_main_invoice.pm @@ -135,7 +135,7 @@ sub checkdest { } elsif ( $self->dest =~ /^(\d+)$/ ) { return "Unknown local account (specified by svcnum: ". $self->dest. ")" unless qsearchs( 'svc_acct', { 'svcnum' => $self->dest } ); - } elsif ( $self->dest =~ /^([\w\.\-]+)\@(([\w\.\-]+\.)+\w+)$/ ) { + } elsif ( $self->dest =~ /^([\w\.\-\&]+)\@(([\w\.\-]+\.)+\w+)$/ ) { my($user, $domain) = ($1, $2); if ( $domain eq $mydomain ) { my $svc_acct = qsearchs( 'svc_acct', { 'username' => $user } ); @@ -172,7 +172,7 @@ sub address { =head1 VERSION -$Id: cust_main_invoice.pm,v 1.7 2001-09-16 12:45:35 ivan Exp $ +$Id: cust_main_invoice.pm,v 1.8 2001-10-25 16:13:10 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 91387f8f489e561deaf1de052d80ef800a4970a3 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 26 Oct 2001 10:24:56 +0000 Subject: cache foo *sigh* --- FS/FS/CGI.pm | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) (limited to 'FS') diff --git a/FS/FS/CGI.pm b/FS/FS/CGI.pm index 85b91eab2..f0fec434d 100644 --- a/FS/FS/CGI.pm +++ b/FS/FS/CGI.pm @@ -1,7 +1,7 @@ package FS::CGI; use strict; -use vars qw(@EXPORT_OK @ISA); +use vars qw(@EXPORT_OK @ISA @header); use Exporter; use CGI; use URI::URL; @@ -11,6 +11,10 @@ use FS::UID; @ISA = qw(Exporter); @EXPORT_OK = qw(header menubar idiot eidiot popurl table itable ntable); +@header = ( '-Expires' => '-1', + '-Pragma' => 'no-cache', + '-Cache-Control' => 'no-cache' ); + =head1 NAME FS::CGI - Subroutines for the web interface @@ -91,12 +95,12 @@ 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' ); - } +# if ( $cgi->isa('CGI::Base') ) { +# no strict 'subs'; +# &CGI::Base::SendHeaders; +# } else { + print $cgi->header( @FS::CGI::header ); +# } print < -- cgit v1.2.1 From f242d4d58ce0980887df84be50112e47094d5e59 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 29 Oct 2001 20:53:38 +0000 Subject: methods for getting the associated svc_acct records --- FS/FS/svc_forward.pm | 30 ++++++++++++++++++++++++------ 1 file changed, 24 insertions(+), 6 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_forward.pm b/FS/FS/svc_forward.pm index 6ee1d5b85..1476dbf78 100644 --- a/FS/FS/svc_forward.pm +++ b/FS/FS/svc_forward.pm @@ -271,8 +271,7 @@ sub check { ; return $error if $error; - return "Unknown srcsvc" - unless qsearchs('svc_acct', { 'svcnum' => $self->srcsvc } ); + return "Unknown srcsvc" unless $self->srcsvc_acct; return "Both dstsvc and dst were defined; one one can be specified" if $self->dstsvc && $self->dst; @@ -280,9 +279,7 @@ sub check { return "one of dstsvc or dst is required" unless $self->dstsvc || $self->dst; - return "Unknown dstsvc" - unless qsearchs('svc_acct', { 'svcnum' => $self->dstsvc } ) - || ! $self->dstsvc; + return "Unknown dstsvc" unless $self->dstsvc_acct || ! $self->dstsvc; if ( $self->dst ) { $self->dst =~ /^([\w\.\-]+)\@(([\w\-]+\.)+\w+)$/ @@ -295,11 +292,32 @@ sub check { ''; #no error } +=item srcsvc_acct + +Returns the FS::svc_acct object referenced by the srcsvc column. + +=cut + +sub srcsvc_acct { + my $self = shift; + qsearchs('svc_acct', { 'svcnum' => $self->srcsvc } ); +} + +=item dstsvc_acct + +Returns the FS::svc_acct object referenced by the srcsvc column, or false for +forwards not local to freeside. + =back +sub dstsvc_acct { + my $self = shift; + qsearchs('svc_acct', { 'svcnum' => $self->dstsvc } ); +} + =head1 VERSION -$Id: svc_forward.pm,v 1.7 2001-09-06 20:41:59 ivan Exp $ +$Id: svc_forward.pm,v 1.8 2001-10-29 20:53:38 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 399377be683d60fd80690504103b809885b27903 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 30 Oct 2001 10:20:32 +0000 Subject: setup/config updates. getting easier... --- FS/FS/Conf.pm | 4 ++-- FS/MANIFEST | 3 ++- FS/bin/freeside-adduser | 52 +++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 56 insertions(+), 3 deletions(-) create mode 100644 FS/bin/freeside-adduser (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index fb8d13bae..1c75954aa 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -8,7 +8,7 @@ $DEBUG = 0; =head1 NAME -FS::Conf - Read access to Freeside configuration values +FS::Conf - Freeside configuration values =head1 SYNOPSIS @@ -29,7 +29,7 @@ FS::Conf - Read access to Freeside configuration values =head1 DESCRIPTION -Read access to Freeside configuration values. Keys currently map to filenames, +Read and write Freeside configuration values. Keys currently map to filenames, but this may change in the future. =head1 METHODS diff --git a/FS/MANIFEST b/FS/MANIFEST index 5de6977a1..4254514a2 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -7,7 +7,8 @@ bin/freeside-bill bin/freeside-email bin/freeside-print-batch bin/freeside-queued -fin/freeside-apply-credits +bin/freeside-apply-credits +bin/freeside-adduser FS.pm FS/CGI.pm FS/Conf.pm diff --git a/FS/bin/freeside-adduser b/FS/bin/freeside-adduser new file mode 100644 index 000000000..4517a83fa --- /dev/null +++ b/FS/bin/freeside-adduser @@ -0,0 +1,52 @@ +#!/usr/bin/perl -w +# +# $Id: freeside-adduser,v 1.1 2001-10-30 10:20:32 ivan Exp $ + +use strict; +use vars qw($opt_h $opt_c); +use Getopt::Std; + +my $FREESIDE_CONF = "/usr/local/etc/freeside"; + +getopts("ch:"); +die &usage if $opt_c && ! $opt_h; +my $secretfile = shift or die &usage; +my $user = shift or die &usage; + +my @args = ( 'htpasswd' ); +push @args, '-c' if $opt_c; +push @args, $opt_h, $user; +system(@args) == 0 or die "htpasswd failed: $?"; + +open(MAPSECRETS,">>$FREESIDE_CONF/mapsecrets") + or die "can't open $FREESIDE_CONF/mapsecrets: $!"; +print MAPSECRETS "$user $secretfile\n"; +close MAPSECRETS or die "can't close $FREESIDE_CONF/mapsecrets: $!"; + +sub usage { + die "Usage:\n\n freeside-adduser [ -h htpasswd_file [ -c ] ] secretfile username" +} + +=head1 NAME + +freeside-adduser - Command line interface to add (freeside) users. + +=head1 SYNOPSIS + + freeside-adduser [ -h htpasswd_file [ -c ] ] username + +=head DESCRIPTION + +Adds a user to the Freeside billing system. This is for adding users (internal +sales/tech folks) to the web interface, not for adding customer accounts. + + -h: Also call htpasswd for this user with the given filename + + -c: Passed to htpasswd + +=head1 SEE ALSO + +L, base Freeside documentation + +=cut + -- cgit v1.2.1 From edda09a317f5dfef05fb8906f28531ec6f4b0927 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 30 Oct 2001 11:47:54 +0000 Subject: whew more install docs and automation --- FS/bin/freeside-adduser | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-adduser b/FS/bin/freeside-adduser index 4517a83fa..e66b0d012 100644 --- a/FS/bin/freeside-adduser +++ b/FS/bin/freeside-adduser @@ -1,6 +1,6 @@ #!/usr/bin/perl -w # -# $Id: freeside-adduser,v 1.1 2001-10-30 10:20:32 ivan Exp $ +# $Id: freeside-adduser,v 1.2 2001-10-30 11:47:54 ivan Exp $ use strict; use vars qw($opt_h $opt_c); @@ -33,9 +33,9 @@ freeside-adduser - Command line interface to add (freeside) users. =head1 SYNOPSIS - freeside-adduser [ -h htpasswd_file [ -c ] ] username + freeside-adduser [ -h htpasswd_file [ -c ] ] secretfile username -=head DESCRIPTION +=head1 DESCRIPTION Adds a user to the Freeside billing system. This is for adding users (internal sales/tech folks) to the web interface, not for adding customer accounts. -- cgit v1.2.1 From a8989c556a7a1951a0b34942c6289f26395859d7 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 30 Oct 2001 13:47:07 +0000 Subject: `make create-config' installs default config (conf dir update) freeside-adduser uses default secrets file --- FS/bin/freeside-adduser | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-adduser b/FS/bin/freeside-adduser index e66b0d012..7fc5830db 100644 --- a/FS/bin/freeside-adduser +++ b/FS/bin/freeside-adduser @@ -1,16 +1,15 @@ #!/usr/bin/perl -w # -# $Id: freeside-adduser,v 1.2 2001-10-30 11:47:54 ivan Exp $ +# $Id: freeside-adduser,v 1.3 2001-10-30 13:47:07 ivan Exp $ use strict; -use vars qw($opt_h $opt_c); +use vars qw($opt_h $opt_c $opt_s); use Getopt::Std; my $FREESIDE_CONF = "/usr/local/etc/freeside"; -getopts("ch:"); +getopts("ch:s:"); die &usage if $opt_c && ! $opt_h; -my $secretfile = shift or die &usage; my $user = shift or die &usage; my @args = ( 'htpasswd' ); @@ -18,13 +17,15 @@ push @args, '-c' if $opt_c; push @args, $opt_h, $user; system(@args) == 0 or die "htpasswd failed: $?"; +my $secretfile = $opt_s || 'secrets'; + open(MAPSECRETS,">>$FREESIDE_CONF/mapsecrets") or die "can't open $FREESIDE_CONF/mapsecrets: $!"; print MAPSECRETS "$user $secretfile\n"; close MAPSECRETS or die "can't close $FREESIDE_CONF/mapsecrets: $!"; sub usage { - die "Usage:\n\n freeside-adduser [ -h htpasswd_file [ -c ] ] secretfile username" + die "Usage:\n\n freeside-adduser [ -h htpasswd_file [ -c ] ] [ -s secretfile ] username" } =head1 NAME @@ -33,7 +34,7 @@ freeside-adduser - Command line interface to add (freeside) users. =head1 SYNOPSIS - freeside-adduser [ -h htpasswd_file [ -c ] ] secretfile username + freeside-adduser [ -h htpasswd_file [ -c ] ] [ -s secretfile ] username =head1 DESCRIPTION @@ -44,6 +45,8 @@ sales/tech folks) to the web interface, not for adding customer accounts. -c: Passed to htpasswd + -s: Specify an alternate secret file + =head1 SEE ALSO L, base Freeside documentation -- cgit v1.2.1 From 20c1183d2673b62bd0e29eb65f0a9a2c974b8027 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 30 Oct 2001 19:05:27 +0000 Subject: depriciate cust_pay_batch.trancode web interface to view pending batch --- FS/FS/cust_pay_batch.pm | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_pay_batch.pm b/FS/FS/cust_pay_batch.pm index 671cd710a..6acb4fefb 100644 --- a/FS/FS/cust_pay_batch.pm +++ b/FS/FS/cust_pay_batch.pm @@ -37,8 +37,6 @@ following fields are currently supported: =item paybatchnum - primary key (automatically assigned) -=item trancode - 77 for charges - =item cardnum =item exp - card expiration @@ -120,7 +118,7 @@ sub check { my $error = $self->ut_numbern('paybatchnum') - || $self->ut_numbern('trancode') + || $self->ut_numbern('trancode') #depriciated || $self->ut_number('cardnum') || $self->ut_money('amount') || $self->ut_number('invnum') @@ -191,7 +189,7 @@ sub check { =head1 VERSION -$Id: cust_pay_batch.pm,v 1.3 2001-10-02 16:00:30 jeff Exp $ +$Id: cust_pay_batch.pm,v 1.4 2001-10-30 19:05:27 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From da6df9f67f3db20a41ad9244db3f829600f678fd Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 2 Nov 2001 04:55:49 +0000 Subject: config web GUI updates. almost usable now. --- FS/FS/Conf.pm | 99 ++++++++++++++++++++++++++++++----------------------------- 1 file changed, 50 insertions(+), 49 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 1c75954aa..569eaabb5 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -184,7 +184,7 @@ httemplate/docs/config.html { 'key' => 'address', 'section' => 'depreciated', - 'description' => 'This configuration file is no longer used. See invoice_template instead.', + 'description' => 'This configuration option is no longer used. See invoice_template instead.', 'type' => 'text', }, @@ -232,7 +232,7 @@ httemplate/docs/config.html { 'key' => 'bsdshellmachines', - 'section' => '', + 'section' => 'shell', 'description' => 'Your BSD flavored shell (and mail) machines, one per line. This enables export of `/etc/passwd\' and `/etc/master.passwd\'.', 'type' => 'textarea', }, @@ -253,7 +253,7 @@ httemplate/docs/config.html { 'key' => 'cyrus', - 'section' => '', + 'section' => 'mail', 'description' => 'Integration with Cyrus IMAP Server, three lines: IMAP server, admin username, and admin password. Cyrus::IMAP::Admin should be installed locally and the connection to the server secured.', 'type' => 'textarea', }, @@ -261,7 +261,7 @@ httemplate/docs/config.html { 'key' => 'deletecustomers', 'section' => 'UI', - 'description' => '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.', + 'description' => 'Enable customer deletions. Be very careful! Deleting a customer will remove all traces that this customer ever existed! It should probably only be used when auditing a legacy database. Normally, you cancel all of a customers\' packages if they cancel service.', 'type' => 'checkbox', }, @@ -275,7 +275,7 @@ httemplate/docs/config.html { 'key' => 'disable_customer_referrals', 'section' => 'UI', - 'description' => 'The existance of this file will disable new customer-to-customer referrals in the web interface.', + 'description' => 'Disable new customer-to-customer referrals in the web interface', 'type' => 'checkbox', }, @@ -289,42 +289,42 @@ httemplate/docs/config.html { 'key' => 'editreferrals', 'section' => 'UI', - 'description' => 'The existance of this file will allow you to change the referral of existing customers.', + 'description' => 'Enable referral modification for existing customers', 'type' => 'checkbox', }, { 'key' => 'emailinvoiceonly', 'section' => 'billing', - 'description' => 'Disables postal mail invoices.', + 'description' => 'Disables postal mail invoices', 'type' => 'checkbox', }, { 'key' => 'emailinvoiceauto', 'section' => 'billing', - 'description' => 'Automatically adds new accounts to the email invoice list upon customer creation.', + 'description' => 'Automatically adds new accounts to the email invoice list upon customer creation', 'type' => 'checkbox', }, { 'key' => 'erpcdmachines', 'section' => '', - 'description' => 'Your ERPCD authenticaion machines, one per line. This enables export of `/usr/annex/acp_passwd\' and `/usr/annex/acp_dialup\'.', + 'description' => 'Your ERPCD authenticaion machines, one per line. This enables export of `/usr/annex/acp_passwd\' and `/usr/annex/acp_dialup\'', 'type' => 'textarea', }, { 'key' => 'hidecancelledpackages', 'section' => 'UI', - 'description' => 'The existance of this file will prevent cancelled packages from showing up in listings (though they will still be in the database)', + 'description' => 'Prevent cancelled packages from showing up in listings (though they will still be in the database)', 'type' => 'checkbox', }, { 'key' => 'hidecancelledcustomers', 'section' => 'UI', - 'description' => '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)', + 'description' => 'Prevent customers with only cancelled packages from showing up in listings (though they will still be in the database)', 'type' => 'checkbox', }, @@ -337,36 +337,36 @@ httemplate/docs/config.html { 'key' => 'icradiusmachines', - 'section' => '', - 'description' => '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". You do not need to use MySQL for your Freeside database to export to an ICRADIUS mysql database with this option.', + 'section' => 'radius', + 'description' => 'Your ICRADIUS machines or FreeRADIUS (with MySQL authentication) machines, one per line. Turning this option on (even if empty) turns on radcheck table population (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 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". You do not need to use MySQL for your Freeside database to export to an ICRADIUS/FreeRADIUS mysql database with this option.', 'type' => [qw( checkbox textarea )], }, { 'key' => 'icradius_mysqldest', - 'section' => '', - 'description' => 'Destination directory for the MySQL databases, on the ICRADIUS machines. Defaults to "/usr/local/var/".', + 'section' => 'radius', + 'description' => 'Destination directory for the MySQL databases, on the ICRADIUS/FreeRADIUS machines. Defaults to "/usr/local/var/".', 'type' => 'text', }, { 'key' => 'icradius_mysqlsource', - 'section' => '', + 'section' => 'radius', 'description' => 'Source directory for for the MySQL radcheck table files, on the Freeside machine. Defaults to "/usr/local/var/freeside".', 'type' => 'text', }, { 'key' => 'icradius_secrets', - 'section' => '', - 'description' => '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.', + 'section' => 'radius', + 'description' => 'Optionally specifies a MySQL database for ICRADIUS/FreeRADIUS 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.', 'type' => 'textarea', }, { 'key' => 'invoice_from', 'section' => 'required', - 'description' => 'Return address on email invoices.', + 'description' => 'Return address on email invoices', 'type' => 'text', }, @@ -380,21 +380,21 @@ httemplate/docs/config.html { 'key' => 'lpr', 'section' => 'required', - 'description' => 'Print command for paper invoices, for example `lpr -h\'.', + 'description' => 'Print command for paper invoices, for example `lpr -h\'', 'type' => 'text', }, { 'key' => 'maildisablecatchall', 'section' => 'depreciated', - 'description' => 'DEPRECIATED, now the default. The existance of this file used to disable the requirement that each virtual domain have a catch-all mailbox.', + 'description' => 'DEPRECIATED, now the default. Turning this option on used to disable the requirement that each virtual domain have a catch-all mailbox.', 'type' => 'checkbox', }, { 'key' => 'money_char', 'section' => '', - 'description' => 'Currency symbol - defaults to `$\'.', + 'description' => 'Currency symbol - defaults to `$\'', 'type' => 'text', }, @@ -414,7 +414,7 @@ httemplate/docs/config.html { 'key' => 'nismachines', - 'section' => '', + 'section' => 'shell', 'description' => 'Your NIS master (not slave master) machines, one per line. This enables export of `/etc/global/passwd\' and `/etc/global/shadow\'.', 'type' => 'textarea', }, @@ -435,14 +435,14 @@ httemplate/docs/config.html { 'key' => 'qmailmachines', - 'section' => '', - 'description' => '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\'.', + 'section' => 'mail', + 'description' => 'Your qmail machines, one per line. This enables export of `/var/qmail/control/virtualdomains\', `/var/qmail/control/recipientmap\', and `/var/qmail/control/rcpthosts\'. Setting this option (even if empty) also turns on user `.qmail-extension\' file maintenance in conjunction with the shellmachine option.', 'type' => [qw( checkbox textarea )], }, { 'key' => 'radiusmachines', - 'section' => '', + 'section' => 'radius', 'description' => 'Your RADIUS authentication machines, one per line. This enables export of `/etc/raddb/users\'.', 'type' => 'textarea', }, @@ -450,7 +450,7 @@ httemplate/docs/config.html { 'key' => 'referraldefault', 'section' => 'UI', - 'description' => 'Default referral, specified by refnum.', + 'description' => 'Default referral, specified by refnum', 'type' => 'text', }, @@ -462,21 +462,21 @@ httemplate/docs/config.html { 'key' => 'sendmailconfigpath', - 'section' => '', - 'description' => 'Sendmail configuration file path - defaults to `/etc\'. Many newer distributions use `/etc/mail\'.', + 'section' => 'mail', + 'description' => 'Sendmail configuration file path. Defaults to `/etc\'. Many newer distributions use `/etc/mail\'.', 'type' => 'text', }, { 'key' => 'sendmailmachines', - 'section' => '', + 'section' => 'mail', 'description' => 'Your sendmail machines, one per line. This enables export of `/etc/virtusertable\' and `/etc/sendmail.cw\'.', 'type' => 'textarea', }, { 'key' => 'sendmailrestart', - 'section' => '', + 'section' => 'mail', 'description' => 'If defined, the command which is run on sendmail machines after files are copied.', 'type' => 'text', }, @@ -505,22 +505,23 @@ httemplate/docs/config.html { 'key' => 'shellmachine-useradd', 'section' => 'shell', - 'description' => '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.', + 'description' => 'The command(s) to run on shellmachine when an account is created. If the shellmachine option is set but this option is not, useradd -d $dir -m -s $shell -u $uid $username is the default. If this option is set but empty, cp -pr /etc/skel $dir; chown -R $uid.$gid $dir is the default instead. Otherwise the value is evaluated as a double-quoted perl string, with the following variables available: $username, $uid, $gid, $dir, and $shell.', 'type' => [qw( checkbox text )], }, { 'key' => 'shellmachine-userdel', 'section' => 'shell', - 'description' => '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.', + 'description' => 'The command(s) to run on shellmachine when an account is deleted. If the shellmachine option is set but this option is not, userdel $username is the default. If this option is set but empty, rm -rf $dir is the default instead. Otherwise the value is evaluated as a double-quoted perl string, with the following variables available: $username and $dir.', 'type' => [qw( checkbox text )], }, { 'key' => 'shellmachine-usermod', 'section' => 'shell', - 'description' => '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.', - 'type' => [qw( checkbox text )], + 'description' => 'The command(s) to run on shellmachine when an account is modified. If the shellmachine option is set but this option 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.', + #'type' => [qw( checkbox text )], + 'type' => 'text', }, { @@ -540,21 +541,21 @@ httemplate/docs/config.html { 'key' => 'showpasswords', 'section' => 'UI', - 'description' => 'The existance of this file will allow unencrypted user passwords to be displayed.', + 'description' => 'Display unencrypted user passwords in the web interface', 'type' => 'checkbox', }, { 'key' => 'signupurl', 'section' => 'UI', - 'description' => 'if you are using customer-to-customer referrals, and you enter the URL of your signup server CGI, the customer view screen will display a customized link to the signup server with the appropriate customer as referral.', + 'description' => 'if you are using customer-to-customer referrals, and you enter the URL of your signup server CGI, the customer view screen will display a customized link to the signup server with the appropriate customer as referral', 'type' => 'text', }, { 'key' => 'smtpmachine', 'section' => 'required', - 'description' => 'SMTP relay for Freeside\'s outgoing mail.', + 'description' => 'SMTP relay for Freeside\'s outgoing mail', 'type' => 'text', }, @@ -610,63 +611,63 @@ httemplate/docs/config.html { 'key' => 'textradiusprepend', 'section' => 'depreciated', - 'description' => 'DEPRECIATED, use RADIUS check attributes instead. This option will be removed soon. The contents of this file will be prepended to the first line of a user\'s RADIUS entry in text exports.', + 'description' => 'DEPRECIATED, use RADIUS check attributes instead. This option will be removed soon. The contents will be prepended to the first line of a user\'s RADIUS entry in text exports.', 'type' => 'text', }, { 'key' => 'unsuspendauto', 'section' => 'billing', - 'description' => 'The existance of this file will enable the automatic unsuspension of suspended packages when a customer\'s balance due changes from positive to zero or negative as the result of a payment or credit.', + 'description' => 'Enables the automatic unsuspension of suspended packages when a customer\'s balance due changes from positive to zero or negative as the result of a payment or credit', 'type' => 'checkbox', }, { 'key' => 'usernamemin', 'section' => 'username', - 'description' => 'Minimum username length (default 2);', + 'description' => 'Minimum username length (default 2)', 'type' => 'text', }, { 'key' => 'usernamemax', 'section' => 'username', - 'description' => 'Maximum username length (default is the size of the SQL column, probably specified when fs-setup was run)', + 'description' => 'Maximum username length', 'type' => 'text', }, { 'key' => 'username-ampersand', 'section' => 'username', - 'description' => 'The existance of this file will allow the ampersand character (&) in usernames. Be careful when using this option in conjunction with shellmachine-useradd and other configuration options which execute shell commands, as the ampersand will be interpreted by the shell if not quoted.', + 'description' => 'Allow the ampersand character (&) in usernames. Be careful when using this option in conjunction with shellmachine-useradd and other configuration options which execute shell commands, as the ampersand will be interpreted by the shell if not quoted.', 'type' => 'checkbox', }, { 'key' => 'username-letter', 'section' => 'username', - 'description' => 'The existance of this file will turn on the requirement that usernames contain at least one letter.', + 'description' => 'Usernames must contain at least one letter', 'type' => 'checkbox', }, { 'key' => 'username-letterfirst', 'section' => 'username', - 'description' => 'The existance of this file will turn on the requirement that usernames start with a letter.', + 'description' => 'Usernames must start with a letter', 'type' => 'checkbox', }, { 'key' => 'username-noperiod', 'section' => 'username', - 'description' => 'The existance of this file will disallow periods in usernames.', + 'description' => 'Disallow periods in usernames', 'type' => 'checkbox', }, { 'key' => 'username-uppercase', 'section' => 'username', - 'description' => 'The existance of this file will allow uppercase characters in username.', + 'description' => 'Allow uppercase characters in usernames', 'type' => 'checkbox', }, @@ -675,12 +676,12 @@ httemplate/docs/config.html 'section' => '', 'description' => 'This file controls the mechanism for preventing duplicate usernames in passwd/radius files exported from svc_accts. This should be one of \'prepend domsvc\' \'append domsvc\' or \'append domain\'', # 'type' => 'select', - 'type' => '', + 'type' => 'text', }, { 'key' => 'vpopmailmachines', - 'section' => '', + 'section' => 'mail', 'description' => 'Your vpopmail pop toasters, one per line. Each line is of the form "machinename vpopdir vpopuid vpopgid". For example: poptoaster.domain.tld /home/vpopmail 508 508 Note: vpopuid and vpopgid are values taken from the vpopmail machine\'s /etc/passwd', 'type' => 'textarea', }, -- cgit v1.2.1 From 7b91bff5d59610bd53a8708fddc88ae279f6e662 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 2 Nov 2001 05:11:52 +0000 Subject: depend on DBIx::DBSchema 0.19 --- FS/FS/Record.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index a15aaba36..ec326458d 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -7,7 +7,7 @@ use Exporter; use Carp qw(carp cluck croak confess); use File::CounterFile; use Locale::Country; -use DBIx::DBSchema; +use DBIx::DBSchema 0.19; use FS::UID qw(dbh checkruid getotaker datasrc driver_name); @ISA = qw(Exporter); @@ -994,7 +994,7 @@ sub DESTROY { return; } =head1 VERSION -$Id: Record.pm,v 1.30 2001-10-10 05:24:25 ivan Exp $ +$Id: Record.pm,v 1.31 2001-11-02 05:11:52 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 3802a0ac7cbbae87a45014b0968f0a4186876d52 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 2 Nov 2001 08:14:14 +0000 Subject: silence pod complaints --- FS/bin/freeside-print-batch | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-print-batch b/FS/bin/freeside-print-batch index baef43787..da4ecf464 100755 --- a/FS/bin/freeside-print-batch +++ b/FS/bin/freeside-print-batch @@ -229,7 +229,7 @@ B<-p>: Print to printer lpr as found in the conf directory. B<-e>: Email output to user found in the Conf email file. -B<-a>: Automatically pays all records in cust_pay_batch. Use -d with this option usually. +B<-a>: Automatically pays all records in cust_pay_batch. Usually used with the B<-d> option. B<-d>: Delete - Pays account and deletes record from cust_pay_batch. @@ -237,7 +237,7 @@ user: From the mapsecrets file - see config.html from the base documentation =head1 VERSION -$Id: freeside-print-batch,v 1.3 2001-08-21 02:44:47 ivan Exp $ +$Id: freeside-print-batch,v 1.4 2001-11-02 08:14:14 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From fd72d2af8120195f96826eb044e217dbfcaee1c7 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 3 Nov 2001 17:49:52 +0000 Subject: new 'jsearch' call for big joined searches & caching support preliminary customer browse optimizations, much faster! --- FS/FS/Record.pm | 100 +++++++++++++++++++++++++++++++++++++++++---------- FS/FS/SearchCache.pm | 96 +++++++++++++++++++++++++++++++++++++++++++++++++ FS/FS/cust_main.pm | 44 ++++++++++++++++------- FS/FS/cust_pkg.pm | 46 ++++++++++++++++++++++-- FS/FS/cust_svc.pm | 42 ++++++++++++++++++---- FS/FS/svc_acct.pm | 31 ++++++++++++++-- FS/MANIFEST | 1 + FS/t/SearchCache.t | 5 +++ 8 files changed, 322 insertions(+), 43 deletions(-) create mode 100644 FS/FS/SearchCache.pm create mode 100644 FS/t/SearchCache.t (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index ec326458d..3c8e9bac6 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -9,9 +9,10 @@ use File::CounterFile; use Locale::Country; use DBIx::DBSchema 0.19; use FS::UID qw(dbh checkruid getotaker datasrc driver_name); +use FS::SearchCache; @ISA = qw(Exporter); -@EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef); +@EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef jsearch); $DEBUG = 0; @@ -135,9 +136,31 @@ sub new { } } + $self->_cache($hashref, shift) if $self->can('_cache') && @_; + $self; } +sub new_or_cached { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = {}; + bless ($self, $class); + + $self->{'Table'} = shift unless defined ( $self->table ); + + my $hashref = $self->{'Hash'} = shift; + my $cache = shift; + if ( defined( $cache->cache->{$hashref->{$cache->key}} ) ) { + my $obj = $cache->cache->{$hashref->{$cache->key}}; + $obj->_cache($hashref, $cache) if $obj->can('_cache'); + $obj; + } else { + $cache->cache->{$hashref->{$cache->key}} = $self->new($hashref, $cache); + } + +} + sub create { my $proto = shift; my $class = ref($proto) || $proto; @@ -170,15 +193,19 @@ objects. =cut sub qsearch { - my($table, $record, $select, $extra_sql ) = @_; - $table =~ /^([\w\_]+)$/ or die "Illegal table: $table"; - $table = $1; + my($stable, $record, $select, $extra_sql, $cache ) = @_; + #$stable =~ /^([\w\_]+)$/ or die "Illegal table: $table"; + #for jsearch + $stable =~ /^([\w\s\(\)\.\,\=]+)$/ or die "Illegal table: $stable"; + $stable = $1; $select ||= '*'; my $dbh = dbh; + my $table = $cache ? $cache->table : $stable; + my @fields = grep exists($record->{$_}), fields($table); - my $statement = "SELECT $select FROM $table"; + my $statement = "SELECT $select FROM $stable"; if ( @fields ) { $statement .= ' WHERE '. join(' AND ', map { if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) { @@ -206,9 +233,15 @@ sub qsearch { if ( eval 'scalar(@FS::'. $table. '::ISA);' ) { if ( eval 'FS::'. $table. '->can(\'new\')' eq \&new ) { #derivied class didn't override new method, so this optimization is safe - map { - new( "FS::$table", { %{$_} } ) - } @{$sth->fetchall_arrayref( {} )}; + if ( $cache ) { + map { + new_or_cached( "FS::$table", { %{$_} }, $cache ) + } @{$sth->fetchall_arrayref( {} )}; + } else { + map { + new( "FS::$table", { %{$_} } ) + } @{$sth->fetchall_arrayref( {} )}; + } } else { warn "untested code (class FS::$table uses custom new method)"; map { @@ -224,6 +257,25 @@ sub qsearch { } +=item jsearch + +Experimental JOINed search method. Using this method, you can execute a +single SELECT spanning multiple tables, and cache the results for subsequent +method calls. Interface will almost definately change in an incompatible +fashion. + +=cut + +sub jsearch { + my($table, $record, $select, $extra_sql, $ptable, $pkey ) = @_; + my $cache = FS::SearchCache->new( $ptable, $pkey ); + my %saw; + ( $cache, + grep { !$saw{$_->getfield($pkey)}++ } + qsearch($table, $record, $select, $extra_sql, $cache ) + ); +} + =item qsearchs TABLE, HASHREF Same as qsearch, except that if more than one record matches, it Bs but @@ -312,16 +364,30 @@ $record->column('value') is a synonym for $record->set('column','value'); =cut +# readable/safe +#sub AUTOLOAD { +# my($self,$value)=@_; +# my($field)=$AUTOLOAD; +# $field =~ s/.*://; +# if ( defined($value) ) { +# confess "errant AUTOLOAD $field for $self (arg $value)" +# unless $self->can('setfield'); +# $self->setfield($field,$value); +# } else { +# confess "errant AUTOLOAD $field for $self (no args)" +# unless $self->can('getfield'); +# $self->getfield($field); +# } +#} + +# efficient sub AUTOLOAD { - my($self,$value)=@_; - my($field)=$AUTOLOAD; + my $field = $AUTOLOAD; $field =~ s/.*://; - if ( defined($value) ) { - confess "errant AUTOLOAD $field for $self (arg $value)" - unless $self->can('setfield'); - $self->setfield($field,$value); + if ( scalar(@_) == 2 ) { + $_[0]->setfield($field, $_[1]); } else { - $self->getfield($field); + $_[0]->getfield($field); } } @@ -992,10 +1058,6 @@ sub DESTROY { return; } =back -=head1 VERSION - -$Id: Record.pm,v 1.31 2001-11-02 05:11:52 ivan Exp $ - =head1 BUGS This module should probably be renamed, since much of the functionality is diff --git a/FS/FS/SearchCache.pm b/FS/FS/SearchCache.pm new file mode 100644 index 000000000..4218acfb6 --- /dev/null +++ b/FS/FS/SearchCache.pm @@ -0,0 +1,96 @@ +package FS::SearchCache; + +use strict; +use vars qw($DEBUG); +#use Carp qw(carp cluck croak confess); + +$DEBUG = 0; + +=head1 NAME + +FS::SearchCache - cache + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head1 METHODS + +=over 4 + +=item new + +=cut + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my( $table, $key ) = @_; + warn "table $table\n" if $DEBUG > 1; + warn "key $key\n" if $DEBUG > 1; + my $self = { 'table' => $table, + 'key' => $key, + 'cache' => {}, + 'subcache' => {}, + }; + bless ($self, $class); + + $self; +} + +=item table + +=cut + +sub table { my $self = shift; $self->{table}; } + +=item key + +=cut + +sub key { my $self = shift; $self->{key}; } + +=item cache + +=cut + +sub cache { my $self = shift; $self->{cache}; } + +=item subcache + +=cut + +sub subcache { + my $self = shift; + my $col = shift; + my $table = shift; + my $keyval = shift; + if ( exists $self->{subcache}->{$col}->{$keyval} ) { + warn "returning existing subcache for $keyval ($col)". + "$self->{subcache}->{$col}->{$keyval}\n" if $DEBUG; + return $self->{subcache}->{$col}->{$keyval}; + } else { + #my $tablekey = @_ ? shift : $col; + my $tablekey = $col; + my $subcache = ref($self)->new( $table, $tablekey ); + $self->{subcache}->{$col}->{$keyval} = $subcache; + warn "creating new subcache $table $tablekey: $subcache\n" if $DEBUG; + $subcache; + } +} + +=back + +=head1 BUGS + +Dismal documentation. + +=head1 SEE ALSO + +L, L + +=cut + +1; + + diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index dfb712502..4c4fe8702 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -75,6 +75,18 @@ $FS::UID::callback{'FS::cust_main'} = sub { } }; +sub _cache { + my $self = shift; + my ( $hashref, $cache ) = @_; + if ( exists $hashref->{'pkgnum'} ) { +# #@{ $self->{'_pkgnum'} } = (); + my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum}); + $self->{'_pkgnum'} = $subcache; + #push @{ $self->{'_pkgnum'} }, + FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum}; + } +} + =head1 NAME FS::cust_main - Object methods for cust_main records @@ -701,7 +713,11 @@ Returns all packages (see L) for this customer. sub all_pkgs { my $self = shift; - qsearch( 'cust_pkg', { 'custnum' => $self->custnum }); + if ( $self->{'_pkgnum'} ) { + values %{ $self->{'_pkgnum'}->cache }; + } else { + qsearch( 'cust_pkg', { 'custnum' => $self->custnum }); + } } =item ncancelled_pkgs @@ -712,16 +728,20 @@ Returns all non-cancelled packages (see L) for this customer. sub ncancelled_pkgs { my $self = shift; - @{ [ # force list context - qsearch( 'cust_pkg', { - 'custnum' => $self->custnum, - 'cancel' => '', - }), - qsearch( 'cust_pkg', { - 'custnum' => $self->custnum, - 'cancel' => 0, - }), - ] }; + if ( $self->{'_pkgnum'} ) { + grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache }; + } else { + @{ [ # force list context + qsearch( 'cust_pkg', { + 'custnum' => $self->custnum, + 'cancel' => '', + }), + qsearch( 'cust_pkg', { + 'custnum' => $self->custnum, + 'cancel' => 0, + }), + ] }; + } } =item suspended_pkgs @@ -1855,7 +1875,7 @@ sub append_fuzzyfiles { =head1 VERSION -$Id: cust_main.pm,v 1.44 2001-10-22 08:31:25 ivan Exp $ +$Id: cust_main.pm,v 1.45 2001-11-03 17:49:52 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 7aee8d027..19e1da356 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -20,6 +20,27 @@ use FS::svc_www; @ISA = qw( FS::Record ); +sub _cache { + my $self = shift; + my ( $hashref, $cache ) = @_; + #if ( $hashref->{'pkgpart'} ) { + if ( $hashref->{'pkg'} ) { + # #@{ $self->{'_pkgnum'} } = (); + # my $subcache = $cache->subcache('pkgpart', 'part_pkg'); + # $self->{'_pkgpart'} = $subcache; + # #push @{ $self->{'_pkgnum'} }, + # FS::part_pkg->new_or_cached($hashref, $subcache); + $self->{'_pkgpart'} = FS::part_pkg->new($hashref); + } + if ( exists $hashref->{'svcnum'} ) { + #@{ $self->{'_pkgnum'} } = (); + my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum}); + $self->{'_svcnum'} = $subcache; + #push @{ $self->{'_pkgnum'} }, + FS::cust_svc->new_or_cached($hashref, $subcache) if $hashref->{svcnum}; + } +} + =head1 NAME FS::cust_pkg - Object methods for cust_pkg objects @@ -420,7 +441,26 @@ L). sub part_pkg { my $self = shift; - qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } ); + #exists( $self->{'_pkgpart'} ) + $self->{'_pkgpart'} + ? $self->{'_pkgpart'} + : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } ); +} + +=item cust_svc + +Returns the services for this package, as FS::cust_svc objects (see +L) + +=cut + +sub cust_svc { + my $self = shift; + if ( $self->{'_svcnum'} ) { + values %{ $self->{'_svcnum'}->cache }; + } else { + qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } ); + } } =item labels @@ -432,7 +472,7 @@ Returns a list of lists, calling the label method for all services sub labels { my $self = shift; - map { [ $_->label ] } qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } ); + map { [ $_->label ] } $self->cust_svc; } =item cust_main @@ -589,7 +629,7 @@ sub order { =head1 VERSION -$Id: cust_pkg.pm,v 1.12 2001-10-22 08:29:42 ivan Exp $ +$Id: cust_pkg.pm,v 1.13 2001-11-03 17:49:52 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index daec79fe8..c398e5ecd 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -14,6 +14,17 @@ use FS::svc_forward; @ISA = qw( FS::Record ); +sub _cache { + my $self = shift; + my ( $hashref, $cache ) = @_; + if ( $hashref->{'username'} ) { + $self->{'_svc_acct'} = FS::svc_acct->new($hashref, ''); + } + if ( $hashref->{'svc'} ) { + $self->{'_svcpart'} = FS::part_svc->new($hashref); + } +} + =head1 NAME FS::cust_svc - Object method for cust_svc objects @@ -109,6 +120,20 @@ sub check { ''; #no error } +=item part_svc + +Returns the definition for this service, as a FS::part_svc object (see +L). + +=cut + +sub part_svc { + my $self = shift; + $self->{'_svcpart'} + ? $self->{'_svcpart'} + : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); +} + =item label Returns a list consisting of: @@ -120,11 +145,14 @@ Returns a list consisting of: sub label { my $self = shift; - my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); - my $svcdb = $part_svc->svcdb; - my $svc_x = qsearchs( $svcdb, { 'svcnum' => $self->svcnum } ) - or die "can't find $svcdb.svcnum ". $self->svcnum; - my $svc = $part_svc->svc; + my $svcdb = $self->part_svc->svcdb; + my $svc_x; + if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) { + $svc_x = $self->{'_svc_acct'}; + } else { + $svc_x = qsearchs( $svcdb, { 'svcnum' => $self->svcnum } ) + or die "can't find $svcdb.svcnum ". $self->svcnum; + } my $tag; if ( $svcdb eq 'svc_acct' ) { $tag = $svc_x->email; @@ -148,14 +176,14 @@ sub label { cluck "warning: asked for label of unsupported svcdb; using svcnum"; $tag = $svc_x->getfield('svcnum'); } - $svc, $tag, $svcdb; + $self->part_svc->svc, $tag, $svcdb; } =back =head1 VERSION -$Id: cust_svc.pm,v 1.5 2001-09-03 22:07:38 ivan Exp $ +$Id: cust_svc.pm,v 1.6 2001-11-03 17:49:52 ivan Exp $ =head1 BUGS diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 3e7230f49..219d8d404 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -85,6 +85,18 @@ $FS::UID::callback{'FS::svc_acct'} = sub { #not needed in 5.004 #srand($$|time); +sub _cache { + my $self = shift; + my ( $hashref, $cache ) = @_; + if ( $hashref->{'svc_acct_svcnum'} ) { + $self->{'_domsvc'} = FS::svc_domain->new( { + 'svcnum' => $hashref->{'domsvc'}, + 'domain' => $hashref->{'svc_acct_domain'}, + 'catchall' => $hashref->{'svc_acct_catchall'}, + } ); + } +} + =head1 NAME FS::svc_acct - Object methods for svc_acct records @@ -880,7 +892,8 @@ Returns the domain associated with this account. sub domain { my $self = shift; if ( $self->domsvc ) { - my $svc_domain = qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } ) + #$self->svc_domain->domain; + my $svc_domain = $self->svc_domain or die "no svc_domain.svcnum for svc_acct.domsvc ". $self->domsvc; $svc_domain->domain; } else { @@ -888,6 +901,20 @@ sub domain { } } +=item svc_domain + +Returns the FS::svc_domain record for this account's domain (see +L{'_domsvc'} + ? $self->{'_domsvc'} + : qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } ); +} + =item email Returns an email address associated with the account. @@ -931,7 +958,7 @@ sub ssh { =head1 VERSION -$Id: svc_acct.pm,v 1.52 2001-10-24 15:29:30 ivan Exp $ +$Id: svc_acct.pm,v 1.53 2001-11-03 17:49:52 ivan Exp $ =head1 BUGS diff --git a/FS/MANIFEST b/FS/MANIFEST index 4254514a2..c83fad5c9 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -14,6 +14,7 @@ FS/CGI.pm FS/Conf.pm FS/ConfItem.pm FS/Record.pm +FS/SearchCache.pm FS/UI/Base.pm FS/UI/CGI.pm FS/UI/Gtk.pm diff --git a/FS/t/SearchCache.t b/FS/t/SearchCache.t new file mode 100644 index 000000000..3c26f3528 --- /dev/null +++ b/FS/t/SearchCache.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::SearchCache; +$loaded=1; +print "ok 1\n"; -- cgit v1.2.1 From 170cab94330f9a6c5daaee7072010b589f3ab64d Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 5 Nov 2001 11:55:04 +0000 Subject: better error messages for eval'ed setup/recur expressions remove debugging warn output --- FS/FS/cust_main.pm | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 4c4fe8702..8911023cc 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -886,8 +886,8 @@ sub bill { $setup = eval $setup_prog; unless ( defined($setup) ) { $dbh->rollback if $oldAutoCommit; - return "Error reval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart. - ": $@"; + return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart. + "(expression $setup_prog): $@"; } $cust_pkg->setfield('setup',$time); $cust_pkg_mod_flag=1; @@ -915,8 +915,8 @@ sub bill { $recur = eval $recur_prog; unless ( defined($recur) ) { $dbh->rollback if $oldAutoCommit; - return "Error reval-ing part_pkg->recur pkgpart ". - $part_pkg->pkgpart. ": $@"; + return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart. + "(expression $recur_prog): $@"; } #change this bit to use Date::Manip? CAREFUL with timezones (see # mailing list archive) @@ -1022,7 +1022,7 @@ sub bill { my $invnum = $cust_bill->invnum; my $cust_bill_pkg; foreach $cust_bill_pkg ( @cust_bill_pkg ) { - warn $cust_bill_pkg->invnum($invnum); + #warn $cust_bill_pkg->invnum($invnum); $error = $cust_bill_pkg->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -1875,7 +1875,7 @@ sub append_fuzzyfiles { =head1 VERSION -$Id: cust_main.pm,v 1.45 2001-11-03 17:49:52 ivan Exp $ +$Id: cust_main.pm,v 1.46 2001-11-05 11:55:04 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From b8e6793aff1a70bb437361af00a0b69026e56543 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 5 Nov 2001 13:57:31 +0000 Subject: doc tyop --- FS/FS/svc_acct.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 219d8d404..e049af038 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -904,7 +904,7 @@ sub domain { =item svc_domain Returns the FS::svc_domain record for this account's domain (see -L. =cut @@ -958,7 +958,7 @@ sub ssh { =head1 VERSION -$Id: svc_acct.pm,v 1.53 2001-11-03 17:49:52 ivan Exp $ +$Id: svc_acct.pm,v 1.54 2001-11-05 13:57:31 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From e4c4a600a9f167f84c1a0663f73797ed18934e92 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 5 Nov 2001 14:04:56 +0000 Subject: fixup getopt --- FS/bin/freeside-bill | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-bill b/FS/bin/freeside-bill index 82b3321e1..7898936c5 100755 --- a/FS/bin/freeside-bill +++ b/FS/bin/freeside-bill @@ -11,8 +11,8 @@ use FS::Record qw(qsearch qsearchs); use FS::cust_main; &untaint_argv; #what it sounds like (eww) -use vars qw($opt_a $opt_c $opt_i $opt_d); -getopts("acid:"); +use vars qw($opt_a $opt_c $opt_i $opt_d $opt_p); +getopts("acid:p"); my $user = shift or die &usage; adminsuidsetup $user; @@ -22,7 +22,7 @@ my %bill_only = map { $_ => 1 } ( ); #we're at now now (and later). -my($time)= $main::opt_d ? str2time($main::opt_d) : $^T; +my($time)= $opt_d ? str2time($opt_d) : $^T; # find packages w/ bill < time && cancel != '', and create corresponding # customer objects @@ -34,7 +34,7 @@ foreach $cust_main ( $saw{ $_->custnum } = 0; # to avoid 'use of uninitialized value' errors } if ( - ( $main::opt_a || ( ( $_->getfield('bill') || 0 ) <= $time ) ) + ( $opt_a || ( ( $_->getfield('bill') || 0 ) <= $time ) ) && $bill_only{ $_->custnum } && !$saw{ $_->custnum }++ ) { @@ -57,14 +57,14 @@ foreach $cust_main ( warn "Error billing, customer #" . $cust_main->getfield('custnum') . ":" . $error if $error; - if ($main::opt_p) { + if ($opt_p) { $cust_main->apply_payments; $error=$cust_main->apply_credits; } - if ($main::opt_c) { + if ($opt_c) { $error=$cust_main->collect('invoice_time'=>$time, - 'batch_card' => $main::opt_i ? 'no' : 'yes', + 'batch_card' => $opt_i ? 'no' : 'yes', ); warn "Error collecting from customer #" . $cust_main->gcustnum. ":$error" if $error; @@ -123,7 +123,7 @@ customers. Otherwise, bills all customers. =head1 VERSION -$Id: freeside-bill,v 1.9 2001-09-11 00:08:18 ivan Exp $ +$Id: freeside-bill,v 1.10 2001-11-05 14:04:56 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From dcdc515874c5db8e450550f41da21e9490709d5b Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 5 Nov 2001 16:42:19 +0000 Subject: AUTOLOAD optimizations broke things rather badly, oops --- FS/FS/Record.pm | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 3c8e9bac6..9f3549468 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -384,7 +384,7 @@ $record->column('value') is a synonym for $record->set('column','value'); sub AUTOLOAD { my $field = $AUTOLOAD; $field =~ s/.*://; - if ( scalar(@_) == 2 ) { + if ( defined($_[1]) ) { $_[0]->setfield($field, $_[1]); } else { $_[0]->getfield($field); @@ -1036,12 +1036,12 @@ sub hfields { \%hash; } -#sub _dump { -# my($self)=@_; -# join("\n", map { -# "$_: ". $self->getfield($_). "|" -# } (fields($self->table)) ); -#} +sub _dump { + my($self)=@_; + join("\n", map { + "$_: ". $self->getfield($_). "|" + } (fields($self->table)) ); +} sub DESTROY { return; } -- cgit v1.2.1 From 92eaaea542d3dfdcc1e258b50785f79d8e6aad8c Mon Sep 17 00:00:00 2001 From: jeff Date: Mon, 5 Nov 2001 17:00:41 +0000 Subject: improved svc_acct replacement --- FS/FS/svc_acct.pm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index e049af038..8f9216fb7 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -548,7 +548,9 @@ sub replace { return "Username in use" if $old->username ne $new->username && - qsearchs( 'svc_acct', { 'username' => $new->username } ); + qsearchs( 'svc_acct', { 'username' => $new->username, + 'domsvc' => $new->domsvc, + } ); return "Can't change uid!" if $old->uid != $new->uid; @@ -958,7 +960,7 @@ sub ssh { =head1 VERSION -$Id: svc_acct.pm,v 1.54 2001-11-05 13:57:31 ivan Exp $ +$Id: svc_acct.pm,v 1.55 2001-11-05 17:00:41 jeff Exp $ =head1 BUGS -- cgit v1.2.1 From 45b4365687be864c68b1daa0ee7787a6a0933589 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 5 Nov 2001 20:12:07 +0000 Subject: makefile fixups --- FS/FS/Record.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 9f3549468..6c7a321e6 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -804,7 +804,7 @@ sub ut_phonen { $phonen .= " x$4" if $4; $self->setfield($field,$phonen); } else { - warn "don't know how to check phone numbers for country $country"; + warn "warning: don't know how to check phone numbers for country $country"; return $self->ut_textn($field); } ''; -- cgit v1.2.1 From bcb172a6ea2b9f3e645eed81896f960151267bf5 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 6 Nov 2001 17:58:08 +0000 Subject: fix error message for s/htdocs/httemplate/ --- FS/FS/UID.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm index f81d8dcdd..890e2988a 100644 --- a/FS/FS/UID.pm +++ b/FS/FS/UID.pm @@ -188,7 +188,7 @@ sub cgisetotaker { $user = lc ( $cgi->connection->user ); } else { die "fatal: Can't get REMOTE_USER! for cgi $cgi - you need to setup ". - "Apache user authentication as documented in htdocs/docs/config.html"; + "Apache user authentication as documented in httemplate/docs/config.html"; } $user; } @@ -252,7 +252,7 @@ coderef into the hash %FS::UID::callback : =head1 VERSION -$Id: UID.pm,v 1.10 2001-09-24 03:23:34 ivan Exp $ +$Id: UID.pm,v 1.11 2001-11-06 17:58:08 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 9fa3f18ba6b2e910601891a15fe30448d51d43f9 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 8 Nov 2001 15:26:44 +0000 Subject: harmless typo noticed by "Edward Shabotinsky" , thanks --- FS/bin/freeside-queued | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/bin/freeside-queued b/FS/bin/freeside-queued index 4e3724e6e..87e3cb422 100644 --- a/FS/bin/freeside-queued +++ b/FS/bin/freeside-queued @@ -40,7 +40,7 @@ $log_file = "/usr/local/etc/freeside/queuelog.". $FS::UID::datasrc; $SIG{__DIE__} = \&_die; $SIG{__WARN__} = \&_logmsg; -warn "freesied-queued starting\n"; +warn "freeside-queued starting\n"; while (1) { -- cgit v1.2.1 From 3d801efe52697501ffbe673e58773f24eb56c6c8 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 12 Nov 2001 13:19:52 +0000 Subject: import hack to be less strict --- FS/FS/cust_main.pm | 30 +++++++++++++++++------------- 1 file changed, 17 insertions(+), 13 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 8911023cc..054175670 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -3,7 +3,7 @@ package FS::cust_main; use strict; use vars qw( @ISA $conf $lpr $processor $xaction $E_NoErr $invoice_from $smtpmachine $Debug $bop_processor $bop_login $bop_password - $bop_action @bop_options); + $bop_action @bop_options $import ); use Safe; use Carp; use Time::Local; @@ -34,6 +34,8 @@ use FS::queue; $Debug = 0; #$Debug = 1; +$import = 0; + #ask FS::UID to run this stuff for us later $FS::UID::callback{'FS::cust_main'} = sub { $conf = new FS::Conf; @@ -563,17 +565,19 @@ sub check { $self->ss("$1-$2-$3"); } - unless ( qsearchs('cust_main_county', { - 'country' => $self->country, - 'state' => '', - } ) ) { - return "Unknown state/county/country: ". - $self->state. "/". $self->county. "/". $self->country - unless qsearchs('cust_main_county',{ - 'state' => $self->state, - 'county' => $self->county, - 'country' => $self->country, - } ); + unless ( $import ) { + unless ( qsearchs('cust_main_county', { + 'country' => $self->country, + 'state' => '', + } ) ) { + return "Unknown state/county/country: ". + $self->state. "/". $self->county. "/". $self->country + unless qsearchs('cust_main_county',{ + 'state' => $self->state, + 'county' => $self->county, + 'country' => $self->country, + } ); + } } $error = @@ -1875,7 +1879,7 @@ sub append_fuzzyfiles { =head1 VERSION -$Id: cust_main.pm,v 1.46 2001-11-05 11:55:04 ivan Exp $ +$Id: cust_main.pm,v 1.47 2001-11-12 13:19:52 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 82a77e8496deec74c06a941e6115d0f79c706241 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 13 Nov 2001 21:27:42 +0000 Subject: remove freeside-print-batch --- FS/MANIFEST | 1 - FS/bin/freeside-print-batch | 260 -------------------------------------------- 2 files changed, 261 deletions(-) delete mode 100755 FS/bin/freeside-print-batch (limited to 'FS') diff --git a/FS/MANIFEST b/FS/MANIFEST index c83fad5c9..d4bac3d73 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -5,7 +5,6 @@ Makefile.PL README bin/freeside-bill bin/freeside-email -bin/freeside-print-batch bin/freeside-queued bin/freeside-apply-credits bin/freeside-adduser diff --git a/FS/bin/freeside-print-batch b/FS/bin/freeside-print-batch deleted file mode 100755 index da4ecf464..000000000 --- a/FS/bin/freeside-print-batch +++ /dev/null @@ -1,260 +0,0 @@ -#!/usr/bin/perl -Tw - -use strict; -#use Date::Format; -use Time::Local; -use Getopt::Std; -use FS::Conf; -use FS::UID qw(adminsuidsetup); -use FS::Record qw(qsearch); -use FS::cust_pay; -use FS::cust_pay_batch; - -# Get the currennt time and date -my $time = time; -my ($sec,$min,$hour,$mday,$mon,$year) = - (localtime($time) )[0,1,2,3,4,5]; -my $_date = - timelocal($sec,$min,$hour,$mday,$mon,$year); - -# Set the mail program -my $mail_program = "/usr/sbin/sendmail -t -n"; - -&untaint_argv; #what it sounds like (eww) -use vars qw($opt_v $opt_p $opt_e $opt_a $opt_d); -getopts("vpead"); #switches - -# Login to the database -my $user = shift or die &usage; -adminsuidsetup $user; - -# Get the needed configuration files -my $conf = new FS::Conf; -my $lpr = $conf->config('lpr'); -my $email = $conf->config('email'); - -my(@batch)=qsearch('cust_pay_batch',{}); -if (scalar(@batch) == 0) -{ - exit 1; -} - -# Open print and email pipes -# $lpr and opt_p for printing -# $email and opt_e for email -# -if ($lpr && $main::opt_p) -{ - open(LPR, "|$lpr"); - print LPR qq~C R E D I T C A R D P A Y M E N T S D U E $mon/$mday/$year\n\n~; -} - -if ($email && $main::opt_e) -{ - open (MAIL, "|$mail_program"); - print MAIL <getfield('state'); - my $zip = $cust_pay_batch->getfield('zip'); - my $amount = $cust_pay_batch->getfield('amount'); - my $last = $cust_pay_batch->getfield('last'); - my $address1 = $cust_pay_batch->getfield('address1'); - my $address2 = $cust_pay_batch->getfield('address2'); - my $first = $cust_pay_batch->getfield('first'); - my $city = $cust_pay_batch->getfield('city'); - my $cardnum = $cust_pay_batch->getfield('cardnum'); - my $payname = $cust_pay_batch->getfield('payname'); - my $exp = $cust_pay_batch->getfield('exp'); - my $invnum = $cust_pay_batch->getfield('invnum'); - my $custnum = $cust_pay_batch->getfield('custnum'); - - # Need a carriage return in address before address2 - # if it exists. Otherwise address will just be address1 - my $address = $address1; - $address .= "\n$address2" if ($address2); - - # Only print to the screen in verbose mode - if ($main::opt_v) - { - printf("Invoice %d for %s %s\tCustomer Number: %d\n", - $invnum, - $first, - $last, - $custnum); - - printf("\t%s\n", $address); - printf("\t%s, %s, %s\n\n", - $city, - $state, - $zip); - - printf("\tCard Number: %s\tExp:%s\n", - $cardnum, - $exp); - printf("\t\tName: %s\n", $payname); - printf("\t\tAmount: %.2f\n\n\n", $amount); - } - - if ($lpr && $main::opt_p) - { - printf(LPR "Invoice %d for %s %s\tCustomer Number: %d\n", - $invnum, - $first, - $last, - $custnum); - - printf(LPR "\t%s\n", $address); - printf(LPR "\t%s, %s, %s\n\n", - $city, - $state, - $zip); - - printf(LPR "\tCard Number: %s\tExp:%s\n", - $cardnum, - $exp); - printf(LPR "\t\tName: %s\n", $payname); - printf(LPR "\t\tAmount: %.2f\n\n\n", $amount); - } - - if ($email && $main::opt_e) - { - printf(MAIL "Invoice %d for %s %s\tCustomer Number: %d\n", - $invnum, - $first, - $last, - $custnum); - - printf(MAIL "\t%s\n", $address); - printf(MAIL "\t%s, %s, %s\n\n", - $city, - $state, - $zip); - - printf(MAIL "\tCard Number: %s\tExp:%s\n", - $cardnum, - $exp); - printf(MAIL "\t\tName: %s\n", $payname); - printf(MAIL "\t\tAmount: %.2f\n\n\n", $amount); - } - - # Now I want to delete the records from cust_pay_batch - # and mark the records in cust_pay as paid today if - # the delete (-d) command line option is set. - if($main::opt_a) - { - my $payment=new FS::cust_pay { - 'invnum' => $invnum, - 'paid' => $amount, - '_date' => $_date, - 'payby' => "CARD", - 'payinfo' => $cardnum, - 'paybatch' => "AUTO", - }; - - my $pay_error=$payment->insert; - if ($pay_error) - { - # warn might be better if you get root's mail - # NEED TO TEST THIS BEFORE DELETE IF WARN IS USED - die "Could not update cust_pay for invnum $invnum. $pay_error\n"; - } - } - - # This just deletes the records - # Must be last in the foreach loop - if($main::opt_d) - { - my $del_error = $cust_pay_batch->delete; - if ($del_error) - { - die "Could not delete cust_pay_batch for invnum $invnum. $del_error\n"; - } - } - -} - -# Now I need to close LPR and EMAIL if they were open -if($lpr && $main::opt_p) -{ - close LPR || die "Could not close printer: $lpr\n"; -} - -if($email && $main::opt_e) -{ - close MAIL || die "Could not close printer: $lpr\n"; -} - - -# subroutines -sub untaint_argv { - foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV - $ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal argument \"$ARGV[$_]\""; - $ARGV[$_]=$1; - } -} - -sub usage { - die "Usage:\n\n freeside-print-batch [-v] [-p] [-e] [-a] [-d] user\n"; -} - -=head1 NAME - -freeside-print-batch - Prints or emails cust_pay_batch. Also deletes - old records and adds payment to cust_pay. - Usually run after the bill command. - -=head1 SYNOPSIS - - freeside-print-batch [-v] [-p] [-e] [-a] [-d] user - -=head1 DESCRIPTION - -Prints or emails cust_pay_batch. Can enter payment and delete -printed records. Usually run as a cron job. - -B<-v>: Verbose - Prints records to STDOUT. - -B<-p>: Print to printer lpr as found in the conf directory. - -B<-e>: Email output to user found in the Conf email file. - -B<-a>: Automatically pays all records in cust_pay_batch. Usually used with the B<-d> option. - -B<-d>: Delete - Pays account and deletes record from cust_pay_batch. - -user: From the mapsecrets file - see config.html from the base documentation - -=head1 VERSION - -$Id: freeside-print-batch,v 1.4 2001-11-02 08:14:14 ivan Exp $ - -=head1 BUGS - -Yes..... Use at your own risk. No guarantees or warrantees of any -kind apply to this program. Parts of this program are hacked from -other GNU licensed software created mainly by Ivan Kohler. - -This is released under the GNU Public License. See www.gnu.org -for more information regarding this license. - -=head1 SEE ALSO - -L, config.html from the base documentation - -=head1 AUTHOR - -Joel Griffiths July 99 - -=cut - -- cgit v1.2.1 From 685e4c619cadadba55590b04c44f563a925b6baa Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 21 Nov 2001 03:40:03 +0000 Subject: postalinvoicedefault config file --- FS/FS/Conf.pm | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 569eaabb5..bf27bf348 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -300,6 +300,13 @@ httemplate/docs/config.html 'type' => 'checkbox', }, + { + 'key' => 'postalinvoicedefault', + 'section' => 'billing', + 'description' => 'Disables postal mail invoices as the default option in the UI. Be careful not to setup customers which are not sent invoices. See emailinvoiceauto.', + 'type' => 'checkbox', + }, + { 'key' => 'emailinvoiceauto', 'section' => 'billing', -- cgit v1.2.1 From 09655ec6f1761d464a928f6aab88bb936999df25 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 21 Nov 2001 03:42:13 +0000 Subject: a more reasonalbe name (!) --- FS/FS/Conf.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index bf27bf348..0d04cc129 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -301,7 +301,7 @@ httemplate/docs/config.html }, { - 'key' => 'postalinvoicedefault', + 'key' => 'disablepostalinvoicedefault', 'section' => 'billing', 'description' => 'Disables postal mail invoices as the default option in the UI. Be careful not to setup customers which are not sent invoices. See emailinvoiceauto.', 'type' => 'checkbox', -- cgit v1.2.1 From 5c0eff524454c3e66a0fbe90250884d0a7578284 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 30 Nov 2001 00:04:38 +0000 Subject: more link methods --- FS/FS/cust_pkg.pm | 4 ++-- FS/FS/cust_svc.pm | 14 +++++++++++++- FS/FS/svc_Common.pm | 18 +++++++++++++++--- 3 files changed, 30 insertions(+), 6 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 19e1da356..c6fabe5cb 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -99,7 +99,7 @@ inherits from FS::Record. The following fields are currently supported: =item otaker - order taker (assigned automatically if null, see L) =item manual_flag - If this field is set to 1, disables the automatic -unsuspensiond of this package when using the B config file. +unsuspension of this package when using the B config file. =back @@ -629,7 +629,7 @@ sub order { =head1 VERSION -$Id: cust_pkg.pm,v 1.13 2001-11-03 17:49:52 ivan Exp $ +$Id: cust_pkg.pm,v 1.14 2001-11-30 00:04:38 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index c398e5ecd..9bc563f40 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -134,6 +134,18 @@ sub part_svc { : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); } +=item cust_pkg + +Returns the definition for this service, as a FS::part_svc object (see +L). + +=cut + +sub cust_pkg { + my $self = shift; + qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } ); +} + =item label Returns a list consisting of: @@ -183,7 +195,7 @@ sub label { =head1 VERSION -$Id: cust_svc.pm,v 1.6 2001-11-03 17:49:52 ivan Exp $ +$Id: cust_svc.pm,v 1.7 2001-11-30 00:04:38 ivan Exp $ =head1 BUGS diff --git a/FS/FS/svc_Common.pm b/FS/FS/svc_Common.pm index 7e216461f..042c243fd 100644 --- a/FS/FS/svc_Common.pm +++ b/FS/FS/svc_Common.pm @@ -107,7 +107,7 @@ sub delete { $error = $self->SUPER::delete; return $error if $error; - my $cust_svc = qsearchs( 'cust_svc' , { 'svcnum' => $svcnum } ); + my $cust_svc = $self->cust_svc; $error = $cust_svc->delete; return $error if $error; @@ -154,7 +154,7 @@ sub setx { #get part_svc my $svcpart; if ( $self->svcnum ) { - my $cust_svc = qsearchs( 'cust_svc', { 'svcnum' => $self->svcnum } ); + my $cust_svc = $self->cust_svc; return "Unknown svcnum" unless $cust_svc; $svcpart = $cust_svc->svcpart; } else { @@ -176,6 +176,18 @@ sub setx { } +=item cust_svc + +Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc +object (see L). + +=cut + +sub cust_svc { + my $self = shift; + qsearchs('cust_svc', { 'svcnum' => $self->svcnum } ); +} + =item suspend =item unsuspend @@ -195,7 +207,7 @@ sub cancel { ''; } =head1 VERSION -$Id: svc_Common.pm,v 1.6 2001-09-11 22:20:28 ivan Exp $ +$Id: svc_Common.pm,v 1.7 2001-11-30 00:04:38 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 4e5a0655072be725acf00394186b93c96bba17ee Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 3 Dec 2001 08:41:43 +0000 Subject: maxsearchrecordsperpage config option paged implementation of customer browse! --- FS/FS/Conf.pm | 7 +++++++ FS/FS/Record.pm | 6 ++++-- 2 files changed, 11 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 0d04cc129..8195fc55e 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -467,6 +467,13 @@ httemplate/docs/config.html # 'description' => 'Directory which contains domain registry information. Each registry is a directory.', # }, + { + 'key' => 'maxsearchrecordsperpage', + 'section' => 'UI', + 'description' => 'If set, number of search records to return per page.', + 'type' => 'text', + }, + { 'key' => 'sendmailconfigpath', 'section' => 'mail', diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 6c7a321e6..a04ddb982 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -227,7 +227,7 @@ sub qsearch { $sth->execute( map $record->{$_}, grep defined( $record->{$_} ) && $record->{$_} ne '', @fields - ) or croak "Error executing \"$statement\": ". $dbh->errstr; + ) or croak "Error executing \"$statement\": ". $sth->errstr; $dbh->commit or croak $dbh->errstr if $FS::UID::AutoCommit; if ( eval 'scalar(@FS::'. $table. '::ISA);' ) { @@ -257,13 +257,15 @@ sub qsearch { } -=item jsearch +=item jsearch TABLE, HASHREF, SELECT, EXTRA_SQL, PRIMARY_TABLE, PRIMARY_KEY Experimental JOINed search method. Using this method, you can execute a single SELECT spanning multiple tables, and cache the results for subsequent method calls. Interface will almost definately change in an incompatible fashion. +Arguments: + =cut sub jsearch { -- cgit v1.2.1 From 05feb08987abb48996f97a4938a3ef507584ae23 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 8 Dec 2001 10:01:42 +0000 Subject: radiusprepend config file for DEFAULT entries etc. --- FS/FS/Conf.pm | 9 +++++++++ 1 file changed, 9 insertions(+) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 8195fc55e..4ce9da1de 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -129,7 +129,9 @@ sub set { warn "[FS::Conf] SET $file\n" if $DEBUG; # warn "$dir" if is_tainted($dir); # warn "$dir" if is_tainted($file); + chmod 0644, "$dir/$file"; my $fh = new IO::File ">$dir/$file" or return; + chmod 0644, "$dir/$file"; print $fh "$value\n"; } } @@ -622,6 +624,13 @@ httemplate/docs/config.html 'type' => 'text', }, + { + 'key' => 'radiusprepend', + 'section' => 'radius', + 'description' => 'The contents will be prepended to the top of the RADIUS users file (text exports only).', + 'type' => 'textarea', + }, + { 'key' => 'textradiusprepend', 'section' => 'depreciated', -- cgit v1.2.1 From 9368defd2eb92a3be0a2d6ddda712440c2d015ae Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 8 Dec 2001 10:03:11 +0000 Subject: fix logic error creating invoice line items --- FS/FS/cust_main.pm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 054175670..8a7d0ca30 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1026,7 +1026,8 @@ sub bill { my $invnum = $cust_bill->invnum; my $cust_bill_pkg; foreach $cust_bill_pkg ( @cust_bill_pkg ) { - #warn $cust_bill_pkg->invnum($invnum); + #warn $invnum; + $cust_bill_pkg->invnum($invnum); $error = $cust_bill_pkg->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -1879,7 +1880,7 @@ sub append_fuzzyfiles { =head1 VERSION -$Id: cust_main.pm,v 1.47 2001-11-12 13:19:52 ivan Exp $ +$Id: cust_main.pm,v 1.48 2001-12-08 10:03:11 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 357faffb9564be9d77815cde87645efd955adb4d Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 8 Dec 2001 10:07:27 +0000 Subject: get custnum from invnum before trying to use custnum! --- FS/FS/cust_pay.pm | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index daf5b5263..21365c1eb 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -99,12 +99,6 @@ sub insert { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $cust_main = qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); - my $old_balance = $cust_main->balance; - - my $error = $self->check; - return $error if $error; - if ( $self->invnum ) { my $cust_bill = qsearchs('cust_bill', { 'invnum' => $self->invnum } ) or do { @@ -114,6 +108,12 @@ sub insert { $self->custnum($cust_bill->custnum ); } + my $cust_main = qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); + my $old_balance = $cust_main->balance; + + my $error = $self->check; + return $error if $error; + $error = $self->SUPER::insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -304,7 +304,7 @@ sub unapplied { =head1 VERSION -$Id: cust_pay.pm,v 1.8 2001-10-09 23:10:16 ivan Exp $ +$Id: cust_pay.pm,v 1.9 2001-12-08 10:07:27 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From c88ce379ab3075629aed1c674124c8ca13ad7dbe Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 10 Dec 2001 12:18:53 +0000 Subject: Pg datatype pain --- FS/FS/Record.pm | 22 ++++++++++++++++++++-- 1 file changed, 20 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index a04ddb982..995e4bdc2 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -7,6 +7,7 @@ use Exporter; use Carp qw(carp cluck croak confess); use File::CounterFile; use Locale::Country; +use DBI qw(:sql_types); use DBIx::DBSchema 0.19; use FS::UID qw(dbh checkruid getotaker datasrc driver_name); use FS::SearchCache; @@ -225,9 +226,26 @@ sub qsearch { my $sth = $dbh->prepare($statement) or croak "$dbh->errstr doing $statement"; - $sth->execute( map $record->{$_}, + my $bind = 1; + + foreach my $field ( grep defined( $record->{$_} ) && $record->{$_} ne '', @fields - ) or croak "Error executing \"$statement\": ". $sth->errstr; + ) { + if ( $record->{$field} =~ /^\d+(\.\d+)?$/ + && $dbdef->table($table)->column($field)->type =~ /(int)/i + ) { + $sth->bind_param($bind++, $record->{$field}, SQL_INTEGER ); + } else { + $sth->bind_param($bind++, $record->{$field}, SQL_VARCHAR ); + } + } + +# $sth->execute( map $record->{$_}, +# grep defined( $record->{$_} ) && $record->{$_} ne '', @fields +# ) or croak "Error executing \"$statement\": ". $sth->errstr; + + $sth->execute or croak "Error executing \"$statement\": ". $sth->errstr; + $dbh->commit or croak $dbh->errstr if $FS::UID::AutoCommit; if ( eval 'scalar(@FS::'. $table. '::ISA);' ) { -- cgit v1.2.1 From 29acbc574cb1e29032c634e1f6ac63e92d14df3b Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 13 Dec 2001 09:17:52 +0000 Subject: added util to set invoice destinations --- FS/bin/freeside-setinvoice | 42 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 42 insertions(+) create mode 100644 FS/bin/freeside-setinvoice (limited to 'FS') diff --git a/FS/bin/freeside-setinvoice b/FS/bin/freeside-setinvoice new file mode 100644 index 000000000..aeaa0bb1b --- /dev/null +++ b/FS/bin/freeside-setinvoice @@ -0,0 +1,42 @@ +#!/usr/bin/perl + +use strict; +use FS::UID qw(adminsuidsetup); +use FS::Conf; +use FS::Record qw(qsearch); +use FS::cust_main; +use FS::svc_acct; + +&untaint_argv; #what it sounds like (eww) +my $user = shift or die &usage; + +adminsuidsetup $user; + +foreach my $cust_main ( + grep { ! scalar($_->invoicing_list) } + qsearch( 'cust_main', {} ) +) { + my @dest; + my @cust_pkg = $cust_main->ncancelled_pkgs; + foreach my $cust_pkg ( @cust_pkg ) { + foreach my $cust_svc ( $cust_pkg->cust_svc ) { + my $svc_acct = qsearchs( 'svc_acct', {} ); + push @dest, $svc_acct->svcnum if $svc_acct; + } + } + push @dest, 'POST' unless @dest; + $cust_main->invoicing_list(@dest); +} + +sub untaint_argv { + foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV + $ARGV[$_] =~ /^(.*)$/ || die "Illegal arguement \"$ARGV[$_]\""; + $ARGV[$_]=$1; + } +} + +sub usage { + die "Usage:\n\n freeside-setinvoice user\n"; +} + + -- cgit v1.2.1 From 156535a911a8ad4315dcdee397cf8aff2071b520 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 13 Dec 2001 17:52:37 +0000 Subject: fix setinvoice script --- FS/bin/freeside-setinvoice | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-setinvoice b/FS/bin/freeside-setinvoice index aeaa0bb1b..3eb75f8b7 100644 --- a/FS/bin/freeside-setinvoice +++ b/FS/bin/freeside-setinvoice @@ -3,7 +3,7 @@ use strict; use FS::UID qw(adminsuidsetup); use FS::Conf; -use FS::Record qw(qsearch); +use FS::Record qw(qsearch qsearchs); use FS::cust_main; use FS::svc_acct; @@ -20,7 +20,7 @@ foreach my $cust_main ( my @cust_pkg = $cust_main->ncancelled_pkgs; foreach my $cust_pkg ( @cust_pkg ) { foreach my $cust_svc ( $cust_pkg->cust_svc ) { - my $svc_acct = qsearchs( 'svc_acct', {} ); + my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $cust_svc->svcnum } ); push @dest, $svc_acct->svcnum if $svc_acct; } } -- cgit v1.2.1 From f78c8ea9034ef02671aa68512dc5458a0c693cc0 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 13 Dec 2001 18:37:25 +0000 Subject: okay, it should really work now --- FS/bin/freeside-setinvoice | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/bin/freeside-setinvoice b/FS/bin/freeside-setinvoice index 3eb75f8b7..708e2fa30 100644 --- a/FS/bin/freeside-setinvoice +++ b/FS/bin/freeside-setinvoice @@ -25,7 +25,7 @@ foreach my $cust_main ( } } push @dest, 'POST' unless @dest; - $cust_main->invoicing_list(@dest); + $cust_main->invoicing_list(\@dest); } sub untaint_argv { -- cgit v1.2.1 From bca375bc3e1192968727473f4f59ba30ef034c3c Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 15 Dec 2001 00:17:38 +0000 Subject: style changes --- FS/FS/cust_main.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 8a7d0ca30..ad6d46e96 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -856,10 +856,10 @@ sub bill { my @cust_bill_pkg = (); foreach my $cust_pkg ( - qsearch('cust_pkg',{'custnum'=> $self->getfield('custnum') } ) + qsearch('cust_pkg', { 'custnum' => $self->custnum } ) ) { - next if $cust_pkg->getfield('cancel'); + next if $cust_pkg->cancel; #? to avoid use of uninitialized value errors... ? $cust_pkg->setfield('bill', '') @@ -1880,7 +1880,7 @@ sub append_fuzzyfiles { =head1 VERSION -$Id: cust_main.pm,v 1.48 2001-12-08 10:03:11 ivan Exp $ +$Id: cust_main.pm,v 1.49 2001-12-15 00:17:38 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 968bee2fe4a8f00cc52525881032cf1575c640f4 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 15 Dec 2001 22:58:33 +0000 Subject: meaningful FS::cust_svc::label for svc_www records --- FS/FS/cust_svc.pm | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index 9bc563f40..5fca892cd 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -11,6 +11,7 @@ use FS::svc_acct; use FS::svc_acct_sm; use FS::svc_domain; use FS::svc_forward; +use FS::domain_record; @ISA = qw( FS::Record ); @@ -184,6 +185,9 @@ sub label { } } elsif ( $svcdb eq 'svc_domain' ) { $tag = $svc_x->getfield('domain'); + } elsif ( $svcdb eq 'svc_www' ) { + my $domain = qsearchs( 'domain_record', { 'recnum' => $svc_x->recnum } ); + $tag = $domain->reczone; } else { cluck "warning: asked for label of unsupported svcdb; using svcnum"; $tag = $svc_x->getfield('svcnum'); @@ -195,7 +199,7 @@ sub label { =head1 VERSION -$Id: cust_svc.pm,v 1.7 2001-11-30 00:04:38 ivan Exp $ +$Id: cust_svc.pm,v 1.8 2001-12-15 22:58:33 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From f1042452ad03c578088c7b43a5e8263770c365c5 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 16 Dec 2001 00:55:53 +0000 Subject: fix weird rounding error: total cust_bill_pay.amount 39.9 for paynum 240 greater than cust_pay.paid 39.90 --- FS/FS/cust_bill_pay.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill_pay.pm b/FS/FS/cust_bill_pay.pm index 5ef82d658..3b95f45ab 100644 --- a/FS/FS/cust_bill_pay.pm +++ b/FS/FS/cust_bill_pay.pm @@ -95,7 +95,7 @@ sub insert { $pay_total += $_ foreach map { $_->amount } qsearch('cust_bill_pay', { 'paynum' => $self->paynum } ); - if ( $pay_total > $cust_pay->paid ) { + if ( sprintf("%.2f", $pay_total) > sprintf("%.2f", $cust_pay->paid) ) { $dbh->rollback if $oldAutoCommit; return "total cust_bill_pay.amount $pay_total for paynum ". $self->paynum. " greater than cust_pay.paid ". $cust_pay->paid; @@ -195,7 +195,7 @@ sub cust_bill { =head1 VERSION -$Id: cust_bill_pay.pm,v 1.8 2001-09-03 22:07:38 ivan Exp $ +$Id: cust_bill_pay.pm,v 1.9 2001-12-16 00:55:53 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From d90a6a6e37b227e9265be011197ab20b56bfa7ca Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 16 Dec 2001 23:50:10 +0000 Subject: eek nasty bug --- FS/FS/cust_main.pm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index ad6d46e96..a36d125be 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -859,7 +859,8 @@ sub bill { qsearch('cust_pkg', { 'custnum' => $self->custnum } ) ) { - next if $cust_pkg->cancel; + #NO!! next if $cust_pkg->cancel; + next if $cust_pkg->getfield('cancel'); #? to avoid use of uninitialized value errors... ? $cust_pkg->setfield('bill', '') @@ -1880,7 +1881,7 @@ sub append_fuzzyfiles { =head1 VERSION -$Id: cust_main.pm,v 1.49 2001-12-15 00:17:38 ivan Exp $ +$Id: cust_main.pm,v 1.50 2001-12-16 23:50:10 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From ff600bea7c4f34854be39bc4a6b56f20c1605c4d Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 17 Dec 2001 23:59:56 +0000 Subject: fixes Argument "" isn't numeric in ncmp at /usr/local/lib/perl5/site_perl/5.005/FS/cust_bill.pm line 254. --- FS/FS/cust_bill.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index b65df89c4..1a2ecaf1d 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -251,7 +251,7 @@ Returns all payment applications (see L) for this invoice. sub cust_bill_pay { my $self = shift; - sort { $a->_date <=> $b->date } + sort { $a->_date <=> $b->_date } qsearch( 'cust_bill_pay', { 'invnum' => $self->invnum } ); } @@ -493,7 +493,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.12 2001-10-15 12:16:41 ivan Exp $ +$Id: cust_bill.pm,v 1.13 2001-12-17 23:59:56 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From c52f29f23bed4af764c0a3deda0f43e2d40c8e51 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 18 Dec 2001 01:49:35 +0000 Subject: add freeside-setinvoice to MANIFEST fix warning: FS::cust_main_invoice=HASH(0x90c86c4) at /usr/local/lib/perl5/site_perl/5.005/FS/svc_acct.pm line 419. --- FS/FS/svc_acct.pm | 9 +++++---- FS/MANIFEST | 1 + 2 files changed, 6 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 8f9216fb7..382987e1b 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -415,9 +415,10 @@ sub delete { foreach my $cust_main_invoice ( qsearch( 'cust_main_invoice', { 'dest' => $self->svcnum } ) ) { - #next unless defined; #wtf is up with qsearch? - warn $cust_main_invoice; - next unless defined $cust_main_invoice; + unless ( defined($cust_main_invoice) ) { + warn "WARNING: something's wrong with qsearch"; + next; + } my %hash = $cust_main_invoice->hash; $hash{'dest'} = $self->email; my $new = new FS::cust_main_invoice \%hash; @@ -960,7 +961,7 @@ sub ssh { =head1 VERSION -$Id: svc_acct.pm,v 1.55 2001-11-05 17:00:41 jeff Exp $ +$Id: svc_acct.pm,v 1.56 2001-12-18 01:49:35 ivan Exp $ =head1 BUGS diff --git a/FS/MANIFEST b/FS/MANIFEST index d4bac3d73..b7804ccc3 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -8,6 +8,7 @@ bin/freeside-email bin/freeside-queued bin/freeside-apply-credits bin/freeside-adduser +bin/freeside-setinvoice FS.pm FS/CGI.pm FS/Conf.pm -- cgit v1.2.1 From 78a46db8485d62447891a73016bc0031f92adf63 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 18 Dec 2001 06:29:30 +0000 Subject: full number in POP pulldown --- FS/FS/svc_acct_pop.pm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct_pop.pm b/FS/FS/svc_acct_pop.pm index 243c18a8b..fa4f5c670 100644 --- a/FS/FS/svc_acct_pop.pm +++ b/FS/FS/svc_acct_pop.pm @@ -107,7 +107,8 @@ Returns: sub text { my $self = shift; - $self->city. ', '. $self->state. ' ('. $self->ac. ')/'. $self->exch; + $self->city. ', '. $self->state. + ' ('. $self->ac. ')/'. $self->exch. '-'. $self->loc; } =back @@ -179,7 +180,7 @@ END =head1 VERSION -$Id: svc_acct_pop.pm,v 1.5 2001-09-27 21:49:31 ivan Exp $ +$Id: svc_acct_pop.pm,v 1.6 2001-12-18 06:29:30 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 4a7a96cd297d390d7d58aafed554672ab949143e Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 19 Dec 2001 14:30:12 +0000 Subject: surpress warnings --- FS/FS/svc_acct.pm | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 382987e1b..11f09a116 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -552,8 +552,10 @@ sub replace { qsearchs( 'svc_acct', { 'username' => $new->username, 'domsvc' => $new->domsvc, } ); - - return "Can't change uid!" if $old->uid != $new->uid; + { + no warnings 'numeric'; + return "Can't change uid!" if $old->uid != $new->uid; + } return "can't change username using Cyrus" if $cyrus_server && $old->username ne $new->username; @@ -961,7 +963,7 @@ sub ssh { =head1 VERSION -$Id: svc_acct.pm,v 1.56 2001-12-18 01:49:35 ivan Exp $ +$Id: svc_acct.pm,v 1.57 2001-12-19 14:30:12 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From b1c7bf3ab64205054c5b677fa55d21049e7a4d26 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 19 Dec 2001 14:33:48 +0000 Subject: alas, a 5.6-ism --- FS/FS/svc_acct.pm | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 11f09a116..139303b3c 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -552,10 +552,10 @@ sub replace { qsearchs( 'svc_acct', { 'username' => $new->username, 'domsvc' => $new->domsvc, } ); - { - no warnings 'numeric'; +# { +# no warnings 'numeric'; #alas, a 5.006-ism return "Can't change uid!" if $old->uid != $new->uid; - } +# } return "can't change username using Cyrus" if $cyrus_server && $old->username ne $new->username; @@ -963,7 +963,7 @@ sub ssh { =head1 VERSION -$Id: svc_acct.pm,v 1.57 2001-12-19 14:30:12 ivan Exp $ +$Id: svc_acct.pm,v 1.58 2001-12-19 14:33:48 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 80fad8cc255a422c562e0b4f040bfce91f074adc Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 20 Dec 2001 02:07:04 +0000 Subject: quiet warnings --- FS/FS/svc_acct.pm | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 139303b3c..ba8f32fdd 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -552,10 +552,11 @@ sub replace { qsearchs( 'svc_acct', { 'username' => $new->username, 'domsvc' => $new->domsvc, } ); -# { -# no warnings 'numeric'; #alas, a 5.006-ism + { + #no warnings 'numeric'; #alas, a 5.006-ism + local($^W) = 0; return "Can't change uid!" if $old->uid != $new->uid; -# } + } return "can't change username using Cyrus" if $cyrus_server && $old->username ne $new->username; @@ -963,7 +964,7 @@ sub ssh { =head1 VERSION -$Id: svc_acct.pm,v 1.58 2001-12-19 14:33:48 ivan Exp $ +$Id: svc_acct.pm,v 1.59 2001-12-20 02:07:04 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 363349b93ce19e66749126bd14eed75710e57479 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 20 Dec 2001 02:09:52 +0000 Subject: don't error trying to suspend accounts with '*' password --- FS/FS/svc_acct.pm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index ba8f32fdd..49a55e9cf 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -635,7 +635,9 @@ Called by the suspend method of FS::cust_pkg (see L). sub suspend { my $self = shift; my %hash = $self->hash; - unless ( $hash{_password} =~ /^\*SUSPENDED\* / ) { + unless ( $hash{_password} =~ /^\*SUSPENDED\* / + || $hash{_password} eq '*' + ) { $hash{_password} = '*SUSPENDED* '.$hash{_password}; my $new = new FS::svc_acct ( \%hash ); $new->replace($self); @@ -964,7 +966,7 @@ sub ssh { =head1 VERSION -$Id: svc_acct.pm,v 1.59 2001-12-20 02:07:04 ivan Exp $ +$Id: svc_acct.pm,v 1.60 2001-12-20 02:09:52 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 1d1703a3c1217c744d2393cbef19364fd595bcb0 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 20 Dec 2001 05:34:07 +0000 Subject: work better with DBIx::Profile --- FS/FS/Record.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 995e4bdc2..38f4390db 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -234,9 +234,9 @@ sub qsearch { if ( $record->{$field} =~ /^\d+(\.\d+)?$/ && $dbdef->table($table)->column($field)->type =~ /(int)/i ) { - $sth->bind_param($bind++, $record->{$field}, SQL_INTEGER ); + $sth->bind_param($bind++, $record->{$field}, { TYPE => SQL_INTEGER } ); } else { - $sth->bind_param($bind++, $record->{$field}, SQL_VARCHAR ); + $sth->bind_param($bind++, $record->{$field}, { TYPE => SQL_VARCHAR } ); } } -- cgit v1.2.1 From 29a315f2dc4187e5558315f76c3d27d11e287620 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 21 Dec 2001 20:55:35 +0000 Subject: fixes total cust_bill_pay.amount and cust_credit_bill.amount 19.95 for invnum 1659 greater than cust_bill.charged 19.95 at /usr/local/lib/perl5/site_perl/5.005/FS/cust_main.pm line 1519. --- FS/FS/cust_bill_pay.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill_pay.pm b/FS/FS/cust_bill_pay.pm index 3b95f45ab..2b0105139 100644 --- a/FS/FS/cust_bill_pay.pm +++ b/FS/FS/cust_bill_pay.pm @@ -111,7 +111,7 @@ sub insert { qsearch('cust_bill_pay', { 'invnum' => $self->invnum } ); $bill_total += $_ foreach map { $_->amount } qsearch('cust_credit_bill', { 'invnum' => $self->invnum } ); - if ( $bill_total > $cust_bill->charged ) { + if ( sprintf("%.2f", $bill_total) > sprintf("%.2f", $cust_bill->charged) ) { $dbh->rollback if $oldAutoCommit; return "total cust_bill_pay.amount and cust_credit_bill.amount $bill_total". " for invnum ". $self->invnum. @@ -195,7 +195,7 @@ sub cust_bill { =head1 VERSION -$Id: cust_bill_pay.pm,v 1.9 2001-12-16 00:55:53 ivan Exp $ +$Id: cust_bill_pay.pm,v 1.10 2001-12-21 20:55:35 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From c00273147a2d400779fcdaf34f171b2180faa453 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 21 Dec 2001 21:40:24 +0000 Subject: add name/address to post payment screen get rid of some $-0.00 yay for ieee fp --- FS/FS/cust_bill.pm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 1a2ecaf1d..fbccff1ff 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -297,6 +297,8 @@ sub owed { $balance -= $_->amount foreach ( $self->cust_bill_pay ); $balance -= $_->amount foreach ( $self->cust_credited ); $balance = sprintf( "%.2f", $balance); + $balance =~ s/^\-0\.00$/0.00/; #yay ieee fp + $balance; } =item print_text [TIME]; @@ -493,7 +495,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.13 2001-12-17 23:59:56 ivan Exp $ +$Id: cust_bill.pm,v 1.14 2001-12-21 21:40:24 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From d0f483f47168e01eb6c28e8fc99a62050b245132 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 26 Dec 2001 04:25:04 +0000 Subject: auto-apply payments and credits, post credit UI overhaul --- FS/FS/CGI.pm | 64 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 63 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/CGI.pm b/FS/FS/CGI.pm index f0fec434d..c66bfe3c2 100644 --- a/FS/FS/CGI.pm +++ b/FS/FS/CGI.pm @@ -9,7 +9,8 @@ use CGI::Carp qw(fatalsToBrowser); use FS::UID; @ISA = qw(Exporter); -@EXPORT_OK = qw(header menubar idiot eidiot popurl table itable ntable); +@EXPORT_OK = qw(header menubar idiot eidiot popurl table itable ntable + small_custview); @header = ( '-Expires' => '-1', '-Pragma' => 'no-cache', @@ -206,6 +207,65 @@ sub ntable { } +=item small_custview CUSTNUM || CUST_MAIN_OBJECT, COUNTRYDEFAULT + +Sheesh. I should just switch to Mason. + +=cut + +sub small_custview { + use FS::Record qw(qsearchs); + use FS::cust_main; + + my $arg = shift; + my $countrydefault = shift || 'US'; + + my $cust_main = ref($arg) ? $arg + : qsearchs('cust_main', { 'custnum' => $arg } ) + or die "unknown custnum $arg"; + + my $html = 'Customer #'. $cust_main->custnum. ''. + ntable('#e8e8e8'). '
'. ntable("#cccccc",2). + '
Billing'. + $cust_main->getfield('last'). ', '. $cust_main->first. '
'; + + $html .= $cust_main->company. '
' if $cust_main->company; + $html .= $cust_main->address1. '
'; + $html .= $cust_main->address2. '
' if $cust_main->address2; + $html .= $cust_main->city. ', '. $cust_main->state. ' '. $cust_main->zip. '
'; + $html .= $cust_main->country. '
' + if $cust_main->country && $cust_main->country ne $countrydefault; + + $html .= '
'; + + if ( defined $cust_main->dbdef_table->column('ship_last') ) { + + my $pre = $cust_main->ship_last ? 'ship_' : ''; + + $html .= ''. ntable("#cccccc",2). + 'Service'. + $cust_main->get("${pre}last"). ', '. + $cust_main->get("${pre}first"). '
'; + $html .= $cust_main->get("${pre}company"). '
' + if $cust_main->get("${pre}company"); + $html .= $cust_main->get("${pre}address1"). '
'; + $html .= $cust_main->get("${pre}address2"). '
' + if $cust_main->get("${pre}address2"); + $html .= $cust_main->get("${pre}city"). ', '. + $cust_main->get("${pre}state"). ' '. + $cust_main->get("${pre}ship_zip"). '
'; + $html .= $cust_main->get("${pre}country"). '
' + if $cust_main->get("${pre}country") + && $cust_main->get("${pre}country") ne $countrydefault; + + $html .= ''; + } + + $html .= ''; + + $html; +} + =back =head1 BUGS @@ -214,6 +274,8 @@ Not OO. Not complete. +small_custview sooooo doesn't belong here. i should just switch to Mason. + =head1 SEE ALSO L, L -- cgit v1.2.1 From 9958a1c7391840abd8085e6f781de988533942f2 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 26 Dec 2001 07:53:21 +0000 Subject: doc --- FS/FS/cust_pay.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index 21365c1eb..ecd6ab24f 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -57,7 +57,7 @@ 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 payinfo - card number, check #, or comp issuer (4-8 lowercase alphanumerics; think username), respectively =item paybatch - text field for tracking card processing @@ -304,7 +304,7 @@ sub unapplied { =head1 VERSION -$Id: cust_pay.pm,v 1.9 2001-12-08 10:07:27 ivan Exp $ +$Id: cust_pay.pm,v 1.10 2001-12-26 07:53:21 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From b6b291e9894efecc061aaef6d4af3c510bb32fad Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 26 Dec 2001 11:17:49 +0000 Subject: (untested eek) freeside-overdue script & cust_main balance_date & total_owed_date methods --- FS/FS/cust_main.pm | 43 +++++++++++++-- FS/bin/freeside-overdue | 139 ++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 178 insertions(+), 4 deletions(-) create mode 100755 FS/bin/freeside-overdue (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index a36d125be..3995e6561 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1416,10 +1416,25 @@ Returns the total owed for this customer on all invoices sub total_owed { my $self = shift; + $self->total_owed_date(2145859200); #12/31/2037 +} + +=item total_owed_date TIME + +Returns the total owed for this customer on all invoices with date earlier than +TIME. TIME is specified as a UNIX timestamp; see L). Also +see L and L for conversion functions. + +=cut + +sub total_owed_date { + my $self = shift; + my $time = shift; my $total_bill = 0; - foreach my $cust_bill ( qsearch('cust_bill', { - 'custnum' => $self->custnum, - } ) ) { + foreach my $cust_bill ( + grep { $_->_date <= $time } + qsearch('cust_bill', { 'custnum' => $self->custnum, } ) + ) { $total_bill += $cust_bill->owed; } sprintf( "%.2f", $total_bill ); @@ -1575,6 +1590,26 @@ sub balance { ); } +=item balance_date TIME + +Returns the balance for this customer, only considering invoices with date +earlier than TIME (total_owed_date minus total_credited minus +total_unapplied_payments). TIME is specified as a UNIX timestamp; see +L). Also see L and L for conversion +functions. + +=cut + +sub balance_date { + my $self = shift; + my $time = shift; + sprintf( "%.2f", + $self->total_owed_date($time) + - $self->total_credited + - $self->total_unapplied_payments + ); +} + =item invoicing_list [ ARRAYREF ] If an arguement is given, sets these email addresses as invoice recipients @@ -1881,7 +1916,7 @@ sub append_fuzzyfiles { =head1 VERSION -$Id: cust_main.pm,v 1.50 2001-12-16 23:50:10 ivan Exp $ +$Id: cust_main.pm,v 1.51 2001-12-26 11:17:49 ivan Exp $ =head1 BUGS diff --git a/FS/bin/freeside-overdue b/FS/bin/freeside-overdue new file mode 100755 index 000000000..541b8be03 --- /dev/null +++ b/FS/bin/freeside-overdue @@ -0,0 +1,139 @@ +#!/usr/bin/perl + +use strict; +use vars qw( $days_to_pay $cust_main $cust_pkg + $cust_svc $svc_acct ); +use Getopt::Std; +use FS::cust_main; +use FS::cust_pkg; +use FS::cust_svc; +use FS::svc_acct; +use FS::Record qw(qsearch qsearchs); +use FS::UID qw(adminsuidsetup); + +&untaint_argv; +my %opt; +getopts('ed:qpsc', \%opt); +my $user = shift or die &usage; + +adminsuidsetup $user; + +my $now = time; +my ($sec,$min,$hour,$mday,$mon,$year) = + (localtime($now) )[0,1,2,3,4,5]; +$mon++; +$year += 1900; + +foreach $cust_main ( qsearch('cust_main',{} ) ) { + + my ( $eyear, $emon, $eday ) = ( 2037, 12, 31 ); + if ( $cust_main->paydate =~ /^(\d{4})\-(\d{1,2})\-(\d{1,2})$/ + && $cust_main->payby eq 'BILL') { + ( $eyear, $emon, $eday ) = ( $1, $2, $3 ); + } + + if ( ( $opt{d} + && $cust_main->balance_date(time - $opt{d} * 86400) > 0 + && qsearchs( 'cust_pkg', { 'custnum' => $cust_main->custnum, + 'susp' => "" } ) ) + || ( $opt{e} + && $cust_main->payby eq 'BILL' + && ( $eyear < $year + || ( $eyear == $year && $emon < $mon ) ) ) + ) { + + unless ( $opt{q} ) { + print $cust_main->custnum, "\t", + $cust_main->last, "\t", $cust_main->first, "\t", + $cust_main->balance_date(time-$opt{d} * 86400); + } + + foreach $cust_pkg ( qsearch( 'cust_pkg', + { 'custnum' => $cust_main->custnum } ) ) { + + if ($opt{p} && ! grep { $_ eq 'POST' } $cust_main->invoicing_list ) { + print "\n\tAdding postal invoicing" unless $opt{q}; + my @invoicing_list = $cust_main->invoicing_list; + push @invoicing_list, 'POST'; + $cust_main->invoicing_list(\@invoicing_list); + } + + if ($opt{s}) { + print "\n\tSuspending pkgnum " . $cust_pkg->pkgnum unless $opt{q}; + $cust_pkg->suspend; + } + + if ($opt{c}) { + print "\n\tCancelling pkgnum " . $cust_pkg->pkgnum unless $opt{q}; + $cust_pkg->cancel; + } + + } + + print "\n" unless $opt{q}; + + } + +} + +sub untaint_argv { + foreach $_ ( $[ .. $#ARGV ) { + $ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal arguement \"$ARGV[$_]\""; + $ARGV[$_]=$1; + } +} + +sub usage { + die "Usage:\n\n freeside-overdue [ -e ] [ -d days ] [ -q ] [ -p ] [ -s ] [ -c ] user\n"; +} + + +=head1 NAME + +freeside-overdue - Perform actions on overdue and/or expired accounts. + +=head1 SYNOPSIS + + freeside-overdue [ -e ] [ -d days ] [ -q ] [ -p ] [ -s ] [ -c ] user + +=head1 DESCRIPTION + +Performs actions on overdue and/or expired accounts. + +Selection options (at least one selection option is required): + + -d: Customers with a balance due on invoices older than the supplied number + of days. Requires an integer argument. + + -e: Customers with a billing expiration date in the past. + +Action options: + + -q: Be quiet (by default, suspended accounts are printed). + + -p: Add postal invoicing to the relevant customers. + + -s: Suspend accounts. + + -c: Cancel accounts. + + user: From the mapsecrets file - see config.html from the base documentation + +=head1 CRONTAB + +Example crontab entries: + +20 4,16 * * * freeside-overdue -e -s user +20 4,16 * * * freeside-overdue -d 30 -p -q user +20 4,16 * * * freeside-overdue -d 60 user +20 4,16 * * * freeside-overdue -d 90 -s user +20 4,16 * * * freeside-overdue -d 120 -c user + +=head1 ORIGINAL AUTHORS + +Original disable-overdue version by mw/kwh: Mark W.? and Kristian Hoffmann ? + +=cut + +1; + -- cgit v1.2.1 From d2f2a080fa2a94c0dd1535b87b3d8f6a59fb2bbb Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 26 Dec 2001 11:47:52 +0000 Subject: don't provide example crontabs that run at 4:20 _PM_ --- FS/bin/freeside-overdue | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-overdue b/FS/bin/freeside-overdue index 541b8be03..45d534461 100755 --- a/FS/bin/freeside-overdue +++ b/FS/bin/freeside-overdue @@ -123,11 +123,11 @@ Action options: Example crontab entries: -20 4,16 * * * freeside-overdue -e -s user -20 4,16 * * * freeside-overdue -d 30 -p -q user -20 4,16 * * * freeside-overdue -d 60 user -20 4,16 * * * freeside-overdue -d 90 -s user -20 4,16 * * * freeside-overdue -d 120 -c user +20 4 * * * freeside-overdue -e -s user +20 4 * * * freeside-overdue -d 30 -p -q user +20 4 * * * freeside-overdue -d 60 user +20 4 * * * freeside-overdue -d 90 -s user +20 4 * * * freeside-overdue -d 120 -c user =head1 ORIGINAL AUTHORS -- cgit v1.2.1 From 854f8d1e160d394d5019292d7e7a9019f06cc1b9 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 26 Dec 2001 15:08:49 +0000 Subject: add freeside-overdue --- FS/MANIFEST | 1 + FS/bin/freeside-overdue | 29 +++++++++++++++++++++-------- 2 files changed, 22 insertions(+), 8 deletions(-) (limited to 'FS') diff --git a/FS/MANIFEST b/FS/MANIFEST index b7804ccc3..23a27d1d3 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -9,6 +9,7 @@ bin/freeside-queued bin/freeside-apply-credits bin/freeside-adduser bin/freeside-setinvoice +bin/freeside-overdue FS.pm FS/CGI.pm FS/Conf.pm diff --git a/FS/bin/freeside-overdue b/FS/bin/freeside-overdue index 45d534461..65941ce95 100755 --- a/FS/bin/freeside-overdue +++ b/FS/bin/freeside-overdue @@ -13,7 +13,7 @@ use FS::UID qw(adminsuidsetup); &untaint_argv; my %opt; -getopts('ed:qpsc', \%opt); +getopts('ed:qplsc', \%opt); my $user = shift or die &usage; adminsuidsetup $user; @@ -48,10 +48,15 @@ foreach $cust_main ( qsearch('cust_main',{} ) ) { $cust_main->balance_date(time-$opt{d} * 86400); } + if ( $opt{l} ) { + print "\n\tCharging late fee of \$$opt{l}" unless $opt{q}; + + } + foreach $cust_pkg ( qsearch( 'cust_pkg', { 'custnum' => $cust_main->custnum } ) ) { - if ($opt{p} && ! grep { $_ eq 'POST' } $cust_main->invoicing_list ) { + if ( $opt{p} && ! grep { $_ eq 'POST' } $cust_main->invoicing_list ) { print "\n\tAdding postal invoicing" unless $opt{q}; my @invoicing_list = $cust_main->invoicing_list; push @invoicing_list, 'POST'; @@ -84,7 +89,7 @@ sub untaint_argv { } sub usage { - die "Usage:\n\n freeside-overdue [ -e ] [ -d days ] [ -q ] [ -p ] [ -s ] [ -c ] user\n"; + die "Usage:\n\n freeside-overdue [ -e ] [ -d days ] [ -q ] [ -p ] [ -l amount ] [ -s ] [ -c ] user\n"; } @@ -94,7 +99,7 @@ freeside-overdue - Perform actions on overdue and/or expired accounts. =head1 SYNOPSIS - freeside-overdue [ -e ] [ -d days ] [ -q ] [ -p ] [ -s ] [ -c ] user + freeside-overdue [ -e ] [ -d days ] [ -q ] [ -p ] [ -l amount ] [ -s ] [ -c ] user =head1 DESCRIPTION @@ -109,10 +114,12 @@ Selection options (at least one selection option is required): Action options: - -q: Be quiet (by default, suspended accounts are printed). + -q: Be quiet (by default, selected accounts are printed). -p: Add postal invoicing to the relevant customers. + -l: Add a charge of the given amount to the relevant customers. + -s: Suspend accounts. -c: Cancel accounts. @@ -123,11 +130,17 @@ Action options: Example crontab entries: +# suspend expired accounts 20 4 * * * freeside-overdue -e -s user + +# quietly add postal invoicing to customers over 30 days past due 20 4 * * * freeside-overdue -d 30 -p -q user -20 4 * * * freeside-overdue -d 60 user -20 4 * * * freeside-overdue -d 90 -s user -20 4 * * * freeside-overdue -d 120 -c user + +# suspend accounts and charge a $10.23 fee for customers over 60 days past due +20 4 * * * freeside-overdue -d 60 -s -l 10.23 user + +# cancel accounts over 90 days past due +20 4 * * * freeside-overdue -d 90 -c user =head1 ORIGINAL AUTHORS -- cgit v1.2.1 From cf16b23820da69e3c8d0156ae27e21c635bf1ec5 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 27 Dec 2001 09:26:14 +0000 Subject: service and package disable! --- FS/FS/Record.pm | 2 +- FS/FS/part_pkg.pm | 7 ++++++- FS/FS/part_svc.pm | 14 ++++++++++---- FS/bin/freeside-overdue | 10 +++++----- 4 files changed, 22 insertions(+), 11 deletions(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 38f4390db..6c0f5f819 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -211,7 +211,7 @@ sub qsearch { $statement .= ' WHERE '. join(' AND ', map { if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) { if ( driver_name =~ /^Pg$/i ) { - "$_ IS NULL"; + qq-( $_ IS NULL OR $_ = '' )-; } else { qq-( $_ IS NULL OR $_ = "" )-; } diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index ceb2a0128..be2ad935f 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -60,6 +60,8 @@ inherits from FS::Record. The following fields are currently supported: =item plandata - Price plan data +=item disabled - Disabled flag, empty or `Y' + =back setup and recur are evaluated as Safe perl expressions. You can use numbers @@ -147,6 +149,9 @@ sub check { $self->recurtax =~ /^(Y?)$/ or return "Illegal recrutax: ". $self->recurtax; $self->recurtax($1); + $self->disabled =~ /^(Y?)$/ or return "Illegal disabled: ". $self->disabled; + $self->disabled($1); + ''; } @@ -185,7 +190,7 @@ sub svcpart { =head1 VERSION -$Id: part_pkg.pm,v 1.4 2001-10-20 12:17:59 ivan Exp $ +$Id: part_pkg.pm,v 1.5 2001-12-27 09:26:13 ivan Exp $ =head1 BUGS diff --git a/FS/FS/part_svc.pm b/FS/FS/part_svc.pm index 2b3f3f309..18760c39a 100644 --- a/FS/FS/part_svc.pm +++ b/FS/FS/part_svc.pm @@ -40,6 +40,8 @@ FS::Record. The following fields are currently supported: =item svcdb - table used for this service. See L, L, and L, among others. +=item disabled - Disabled flag, empty or `Y' + =back =head1 METHODS @@ -235,6 +237,7 @@ sub check { my @fields = eval { fields( $recref->{svcdb} ) }; #might die return "Unknown svcdb!" unless @fields; +##REPLACED BY part_svc_column # my $svcdb; # foreach $svcdb ( qw( # svc_acct svc_acct_sm svc_domain @@ -259,6 +262,9 @@ sub check { # } # } + $self->disabled =~ /^(Y?)$/ or return "Illegal disabled: ". $self->disabled; + $self->disabled($1); + ''; #no error } @@ -295,7 +301,7 @@ sub all_part_svc_column { =head1 VERSION -$Id: part_svc.pm,v 1.6 2001-09-12 15:45:01 ivan Exp $ +$Id: part_svc.pm,v 1.7 2001-12-27 09:26:13 ivan Exp $ =head1 BUGS @@ -306,9 +312,9 @@ should be fixed. =head1 SEE ALSO -L, L, L, L, -L, L, L, schema.html from the -base documentation. +L, L, L, +L, L, L, L, +schema.html from the base documentation. =cut diff --git a/FS/bin/freeside-overdue b/FS/bin/freeside-overdue index 65941ce95..0c62b99c1 100755 --- a/FS/bin/freeside-overdue +++ b/FS/bin/freeside-overdue @@ -48,10 +48,10 @@ foreach $cust_main ( qsearch('cust_main',{} ) ) { $cust_main->balance_date(time-$opt{d} * 86400); } - if ( $opt{l} ) { - print "\n\tCharging late fee of \$$opt{l}" unless $opt{q}; - - } +# if ( $opt{l} ) { +# print "\n\tCharging late fee of \$$opt{l}" unless $opt{q}; +# +# } foreach $cust_pkg ( qsearch( 'cust_pkg', { 'custnum' => $cust_main->custnum } ) ) { @@ -83,7 +83,7 @@ foreach $cust_main ( qsearch('cust_main',{} ) ) { sub untaint_argv { foreach $_ ( $[ .. $#ARGV ) { - $ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal arguement \"$ARGV[$_]\""; + $ARGV[$_] =~ /^([\w\-\/\.]*)$/ || die "Illegal arguement \"$ARGV[$_]\""; $ARGV[$_]=$1; } } -- cgit v1.2.1 From 5e25b996982d42eb2587ec54db0d5b39508aa730 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 28 Dec 2001 14:40:35 +0000 Subject: add more options to freeside-overdue add charge method to FS::cust_main one-off packages default to disabled billing payname defaults to first and last, not "Accounts Payable" --- FS/FS/cust_main.pm | 26 ++++++++++++++- FS/bin/freeside-bill | 6 ++-- FS/bin/freeside-overdue | 85 ++++++++++++++++++++++++++++++++++++------------- 3 files changed, 90 insertions(+), 27 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 3995e6561..6c18f93a1 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -28,6 +28,7 @@ use FS::cust_credit_bill; use FS::cust_bill_pay; use FS::prepay_credit; use FS::queue; +use FS::part_pkg; @ISA = qw( FS::Record ); @@ -1775,6 +1776,29 @@ sub credit { $cust_credit->insert; } +=item charge AMOUNT PKG COMMENT + +Creates a one-time charge for this customer. If there is an error, returns +the error, otherwise returns false. + +=cut + +sub charge { + my ( $self, $amount, $pkg, $comment ) = @_; + + my $part_pkg = new FS::part_pkg ( { + 'pkg' => $pkg || 'One-time charge', + 'comment' => $comment, + 'setup' => $amount, + 'freq' => 0, + 'recur' => '0', + 'disabled' => 'Y', + } ); + + $part_pkg->insert; + +} + =back =head1 SUBROUTINES @@ -1916,7 +1940,7 @@ sub append_fuzzyfiles { =head1 VERSION -$Id: cust_main.pm,v 1.51 2001-12-26 11:17:49 ivan Exp $ +$Id: cust_main.pm,v 1.52 2001-12-28 14:40:35 ivan Exp $ =head1 BUGS diff --git a/FS/bin/freeside-bill b/FS/bin/freeside-bill index 7898936c5..49ec43c82 100755 --- a/FS/bin/freeside-bill +++ b/FS/bin/freeside-bill @@ -59,14 +59,14 @@ foreach $cust_main ( if ($opt_p) { $cust_main->apply_payments; - $error=$cust_main->apply_credits; + $cust_main->apply_credits; } if ($opt_c) { $error=$cust_main->collect('invoice_time'=>$time, 'batch_card' => $opt_i ? 'no' : 'yes', ); - warn "Error collecting from customer #" . $cust_main->gcustnum. ":$error" + warn "Error collecting from customer #" . $cust_main->custnum. ":$error" if $error; #sleep 1; @@ -123,7 +123,7 @@ customers. Otherwise, bills all customers. =head1 VERSION -$Id: freeside-bill,v 1.10 2001-11-05 14:04:56 ivan Exp $ +$Id: freeside-bill,v 1.11 2001-12-28 14:40:35 ivan Exp $ =head1 BUGS diff --git a/FS/bin/freeside-overdue b/FS/bin/freeside-overdue index 0c62b99c1..8f7f872c8 100755 --- a/FS/bin/freeside-overdue +++ b/FS/bin/freeside-overdue @@ -1,4 +1,4 @@ -#!/usr/bin/perl +#!/usr/bin/perl -w use strict; use vars qw( $days_to_pay $cust_main $cust_pkg @@ -13,12 +13,12 @@ use FS::UID qw(adminsuidsetup); &untaint_argv; my %opt; -getopts('ed:qplsc', \%opt); +getopts('ed:qplscbyoi', \%opt); my $user = shift or die &usage; adminsuidsetup $user; -my $now = time; +my $now = time; #eventually take a time option like freeside-bill my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($now) )[0,1,2,3,4,5]; $mon++; @@ -48,21 +48,23 @@ foreach $cust_main ( qsearch('cust_main',{} ) ) { $cust_main->balance_date(time-$opt{d} * 86400); } -# if ( $opt{l} ) { -# print "\n\tCharging late fee of \$$opt{l}" unless $opt{q}; -# -# } + if ( $opt{p} && ! grep { $_ eq 'POST' } $cust_main->invoicing_list ) { + print "\n\tAdding postal invoicing" unless $opt{q}; + my @invoicing_list = $cust_main->invoicing_list; + push @invoicing_list, 'POST'; + $cust_main->invoicing_list(\@invoicing_list); + } + + if ( $opt{l} ) { + print "\n\tCharging late fee of \$$opt{l}" unless $opt{q}; + my $error = $cust_main->charge($opt{l}, 'Late fee'); + # comment or plandata with info so we don't redo the same late fee every + # day + } foreach $cust_pkg ( qsearch( 'cust_pkg', { 'custnum' => $cust_main->custnum } ) ) { - if ( $opt{p} && ! grep { $_ eq 'POST' } $cust_main->invoicing_list ) { - print "\n\tAdding postal invoicing" unless $opt{q}; - my @invoicing_list = $cust_main->invoicing_list; - push @invoicing_list, 'POST'; - $cust_main->invoicing_list(\@invoicing_list); - } - if ($opt{s}) { print "\n\tSuspending pkgnum " . $cust_pkg->pkgnum unless $opt{q}; $cust_pkg->suspend; @@ -72,7 +74,29 @@ foreach $cust_main ( qsearch('cust_main',{} ) ) { print "\n\tCancelling pkgnum " . $cust_pkg->pkgnum unless $opt{q}; $cust_pkg->cancel; } + + } + + if ( $opt{b} ) { + print "\n\tBilling" unless $opt{q}; + my $error = $cust_main->bill('time'=>$now); + warn "Error billing, customer #" . $cust_main->custnum . + ":" . $error if $error; + } + if ( $opt{y} ) { + print "\n\tApplying outstanding payments and credits" unless $opt{q}; + $cust_main->apply_payments; + $cust_main->apply_credits; + } + + if ( $opt{o} ) { + print "\n\tCollecting" unless $opt{q}; + my $error = $cust_main->collect( 'invoice_time'=>$now, + 'batch_card' => $opt{i} ? 'no' : 'yes', + ); + warn "Error collecting from customer #" . $cust_main->custnum. ":$error" + if $error; } print "\n" unless $opt{q}; @@ -99,7 +123,7 @@ freeside-overdue - Perform actions on overdue and/or expired accounts. =head1 SYNOPSIS - freeside-overdue [ -e ] [ -d days ] [ -q ] [ -p ] [ -l amount ] [ -s ] [ -c ] user + freeside-overdue [ -e ] [ -d days ] [ -q ] [ -p ] [ -l amount ] [ -s ] [ -c ] [ -b ] [ -y ] [ -o [ -i ] ] user =head1 DESCRIPTION @@ -107,22 +131,31 @@ Performs actions on overdue and/or expired accounts. Selection options (at least one selection option is required): - -d: Customers with a balance due on invoices older than the supplied number - of days. Requires an integer argument. + -d: Customers with a balance due on invoices older than the supplied number + of days. Requires an integer argument. - -e: Customers with a billing expiration date in the past. + -e: Customers with a billing expiration date in the past. Action options: - -q: Be quiet (by default, selected accounts are printed). + -q: Be quiet (by default, selected accounts are printed). + + -p: Add postal invoicing to the relevant customers. + + -l: Add a charge of the given amount to the relevant customers. + + -s: Suspend accounts. - -p: Add postal invoicing to the relevant customers. + -c: Cancel accounts. - -l: Add a charge of the given amount to the relevant customers. + -b: Bill customers (create invoices) - -s: Suspend accounts. + -y: Apply unapplied payments and credits - -c: Cancel accounts. + -o: Collect from customers (charge cards, print invoices) + + -i: real-time billing (as opposed to batch billing). only relevant + for credit cards. user: From the mapsecrets file - see config.html from the base documentation @@ -146,6 +179,12 @@ Example crontab entries: Original disable-overdue version by mw/kwh: Mark W.? and Kristian Hoffmann ? +Ivan seems to be turning it into the "do-everything" CLI. + +=head1 BUGS + +Hell now that this is the do-everything CLI it should have --longoptions + =cut 1; -- cgit v1.2.1 From 368fe197549dab5edf86cd37b64b9fdddbd07a65 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 28 Dec 2001 15:14:01 +0000 Subject: force printing in freeside-overdue --- FS/FS/cust_main.pm | 20 +++++++++++++------- FS/bin/freeside-overdue | 8 +++++--- 2 files changed, 18 insertions(+), 10 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 6c18f93a1..3e92417c4 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1067,6 +1067,9 @@ CyberCash is not installed. report_badcard - Set this true if you want bad card transactions to return an error. By default, they don't. +force_print - force printing even if invoice has been printed more than once +every 30 days, and don't increment the `printed' field. + =cut sub collect { @@ -1118,7 +1121,8 @@ sub collect { 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 + && ( ( $cust_bill->printed * 2592000 ) <= $since + || $options{'force_print'} ) ) { #my @print_text = $cust_bill->print_text; #( date ) @@ -1148,11 +1152,13 @@ sub collect { : "Exit status $? from $lpr"; } - my %hash = $cust_bill->hash; - $hash{'printed'}++; - my $new_cust_bill = new FS::cust_bill(\%hash); - my $error = $new_cust_bill->replace($cust_bill); - warn "Error updating $cust_bill->printed: $error" if $error; + unless ( $options{'force_print'} ) { + my %hash = $cust_bill->hash; + $hash{'printed'}++; + my $new_cust_bill = new FS::cust_bill(\%hash); + my $error = $new_cust_bill->replace($cust_bill); + warn "Error updating $cust_bill->printed: $error" if $error; + } } @@ -1940,7 +1946,7 @@ sub append_fuzzyfiles { =head1 VERSION -$Id: cust_main.pm,v 1.52 2001-12-28 14:40:35 ivan Exp $ +$Id: cust_main.pm,v 1.53 2001-12-28 15:14:01 ivan Exp $ =head1 BUGS diff --git a/FS/bin/freeside-overdue b/FS/bin/freeside-overdue index 8f7f872c8..076330228 100755 --- a/FS/bin/freeside-overdue +++ b/FS/bin/freeside-overdue @@ -92,9 +92,11 @@ foreach $cust_main ( qsearch('cust_main',{} ) ) { if ( $opt{o} ) { print "\n\tCollecting" unless $opt{q}; - my $error = $cust_main->collect( 'invoice_time'=>$now, - 'batch_card' => $opt{i} ? 'no' : 'yes', - ); + my $error = $cust_main->collect( + 'invoice_time' => $now, + 'batch_card' => $opt{i} ? 'no' : 'yes', + 'force_print' => 'yes', + ); warn "Error collecting from customer #" . $cust_main->custnum. ":$error" if $error; } -- cgit v1.2.1 From e3f87d761538a0a21d26fc86b5bce7c9d737d590 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 28 Dec 2001 15:17:40 +0000 Subject: update usage message --- FS/bin/freeside-overdue | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/bin/freeside-overdue b/FS/bin/freeside-overdue index 076330228..964321884 100755 --- a/FS/bin/freeside-overdue +++ b/FS/bin/freeside-overdue @@ -115,7 +115,7 @@ sub untaint_argv { } sub usage { - die "Usage:\n\n freeside-overdue [ -e ] [ -d days ] [ -q ] [ -p ] [ -l amount ] [ -s ] [ -c ] user\n"; + die "Usage:\n\n freeside-overdue [ -e ] [ -d days ] [ -q ] [ -p ] [ -l amount ] [ -s ] [ -c ] [ -b ] [ -y ] [ -o [ -i ] ] user\n"; } -- cgit v1.2.1 From 69a0a7504f84aa9bb1f204d1f3522e1520e0885e Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 3 Jan 2002 17:40:26 +0000 Subject: more schema changes: part_bill_event and cust_bill_event tables remove old 1.4.0pre READMEs --- FS/FS/cust_bill_event.pm | 134 +++++++++++++++++++++++++++++++++++++++++++++++ FS/FS/part_bill_event.pm | 132 ++++++++++++++++++++++++++++++++++++++++++++++ FS/MANIFEST | 4 ++ FS/t/cust_bill_event.t | 5 ++ FS/t/part_bill_event.t | 5 ++ 5 files changed, 280 insertions(+) create mode 100644 FS/FS/cust_bill_event.pm create mode 100644 FS/FS/part_bill_event.pm create mode 100644 FS/t/cust_bill_event.t create mode 100644 FS/t/part_bill_event.t (limited to 'FS') diff --git a/FS/FS/cust_bill_event.pm b/FS/FS/cust_bill_event.pm new file mode 100644 index 000000000..910b4dead --- /dev/null +++ b/FS/FS/cust_bill_event.pm @@ -0,0 +1,134 @@ +package FS::cust_bill_event; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearch qsearchs ); + +@ISA = qw(FS::Record); + +=head1 NAME + +FS::cust_bill_event - Object methods for cust_bill_event records + +=head1 SYNOPSIS + + use FS::cust_bill_event; + + $record = new FS::cust_bill_event \%hash; + $record = new FS::cust_bill_event { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cust_bill_event object represents an complete invoice event. +FS::cust_bill_event inherits from FS::Record. The following fields are +currently supported: + +=over 4 + +=item eventnum - primary key + +=item invnum - invoice (see L) + +=item eventpart - event definition (see L) + +=item _date - specified as a UNIX timestamp; see L. Also see +L and L for conversion functions. + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new completed invoice event. To add the compelted invoice event to +the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'cust_bill_event'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +# the insert method can be inherited from FS::Record + +=item delete + +Delete this record from the database. + +=cut + +# the delete method can be inherited from FS::Record + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +# the replace method can be inherited from FS::Record + +=item check + +Checks all fields to make sure this is a valid completed invoice event. If +there is an error, returns the error, otherwise returns false. Called by the +insert and replace methods. + +=cut + +# the check method should currently be supplied - FS::Record contains some +# data checking routines + +sub check { + my $self = shift; + + my $error = $self->ut_numbern('eventnum') + || $self->ut_number('invnum') + || $self->ut_number('eventpart') + || $self->ut_number('_date') + ; + + return "Unknown invnum" + unless qsearchs( 'cust_bill' ,{ 'invnum' => $self->invnum } ); + + return "Unknown eventpart" + unless qsearchs( 'part_bill_event' ,{ 'eventpart' => $self->eventpart } ); + + ''; #no error +} + +=back + +=head1 BUGS + +Far too early in the morning. + +=head1 SEE ALSO + +L, L, L, schema.html from the +base documentation. + +=cut + +1; + diff --git a/FS/FS/part_bill_event.pm b/FS/FS/part_bill_event.pm new file mode 100644 index 000000000..fb2c06ad4 --- /dev/null +++ b/FS/FS/part_bill_event.pm @@ -0,0 +1,132 @@ +package FS::part_bill_event; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearch qsearchs ); + +@ISA = qw(FS::Record); + +=head1 NAME + +FS::part_bill_event - Object methods for part_bill_event records + +=head1 SYNOPSIS + + use FS::part_bill_event; + + $record = new FS::part_bill_event \%hash; + $record = new FS::part_bill_event { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::part_bill_event object represents an invoice event definition - +a callback which is triggered when an invoice is a certain amount of time +overdue. FS::part_bill_event inherits from +FS::Record. The following fields are currently supported: + +=over 4 + +=item eventpart - primary key + +=item payby - CARD, BILL, or COMP + +=item event - event name + +=item eventcode - event action + +=item seconds - how long after the invoice date events of this type are triggered + +=item disabled - Disabled flag, empty or `Y' + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new invoice event definition. To add the example to the database, +see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'part_bill_event'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +# the insert method can be inherited from FS::Record + +=item delete + +Delete this record from the database. + +=cut + +# the delete method can be inherited from FS::Record + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +# the replace method can be inherited from FS::Record + +=item check + +Checks all fields to make sure this is a valid invoice event definition. If +there is an error, returns the error, otherwise returns false. Called by the +insert and replace methods. + +=cut + +# the check method should currently be supplied - FS::Record contains some +# data checking routines + +sub check { + my $self = shift; + + $self->ut_numbern('eventpart') + || $self->ut_enum('payby', [qw( CARD BILL COMP )] ) + || $self->ut_text('event') + || $self->ut_anything('eventcode') + || $self->ut_number('seconds') + || $self->ut_enum('disabled', [ '', 'Y' ] ) + ; +} + +=back + +=head1 BUGS + +Alas. + +=head1 SEE ALSO + +L, L, L, schema.html from the +base documentation. + +=cut + +1; + diff --git a/FS/MANIFEST b/FS/MANIFEST index 23a27d1d3..0a9205c7f 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -31,12 +31,14 @@ FS/cust_main.pm FS/cust_main_county.pm FS/cust_main_invoice.pm FS/cust_pay.pm +FS/cust_bill_event.pm FS/cust_bill_pay.pm FS/cust_pay_batch.pm FS/cust_pkg.pm FS/cust_refund.pm FS/cust_credit_refund.pm FS/cust_svc.pm +FS/part_bill_event.pm FS/part_pkg.pm FS/part_pop_local.pm FS/part_referral.pm @@ -67,6 +69,7 @@ t/CGIwrapper.t t/Conf.t t/ConfItem.t t/cust_bill.t +t/cust_bill_event.t t/cust_bill_pay.t t/cust_bill_pkg.t t/cust_credit.t @@ -82,6 +85,7 @@ t/cust_refund.t t/cust_svc.t t/domain_record.t t/nas.t +t/part_bill_event.t t/part_pkg.t t/part_pop_local.t t/part_referral.t diff --git a/FS/t/cust_bill_event.t b/FS/t/cust_bill_event.t new file mode 100644 index 000000000..0e2ca3e24 --- /dev/null +++ b/FS/t/cust_bill_event.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_bill_event; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_bill_event.t b/FS/t/part_bill_event.t new file mode 100644 index 000000000..5626a9f97 --- /dev/null +++ b/FS/t/part_bill_event.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_bill_event; +$loaded=1; +print "ok 1\n"; -- cgit v1.2.1 From d73c1796de9df0ed14469f745d985cd706137d6d Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 9 Jan 2002 13:29:34 +0000 Subject: update fuzzy cache files on customer replace. do an exact search along with the fuzzy search (webui) --- FS/FS/cust_main.pm | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 3e92417c4..1a9d43e94 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -347,6 +347,7 @@ sub insert { } } + #false laziness with sub replace my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; $error = $queue->insert($self->getfield('last'), $self->company); if ( $error ) { @@ -362,6 +363,7 @@ sub insert { return "queueing job (transaction rolled back): $error"; } } + #eslaf $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -509,6 +511,24 @@ sub replace { $self->invoicing_list( $invoicing_list ); } + #false laziness with sub insert + my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; + $error = $queue->insert($self->getfield('last'), $self->company); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } + + if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) { + $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; + $error = $queue->insert($self->getfield('last'), $self->company); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } + } + #eslaf + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -1946,7 +1966,7 @@ sub append_fuzzyfiles { =head1 VERSION -$Id: cust_main.pm,v 1.53 2001-12-28 15:14:01 ivan Exp $ +$Id: cust_main.pm,v 1.54 2002-01-09 13:29:33 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 947a8fac5088418d76d92494f810d6a3b3313595 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 14 Jan 2002 14:29:00 +0000 Subject: fix -l option --- FS/bin/freeside-overdue | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/bin/freeside-overdue b/FS/bin/freeside-overdue index 964321884..db99e62b4 100755 --- a/FS/bin/freeside-overdue +++ b/FS/bin/freeside-overdue @@ -13,7 +13,7 @@ use FS::UID qw(adminsuidsetup); &untaint_argv; my %opt; -getopts('ed:qplscbyoi', \%opt); +getopts('ed:qpl:scbyoi', \%opt); my $user = shift or die &usage; adminsuidsetup $user; -- cgit v1.2.1 From be58a1538ce963c4d3b6319c163960513703108d Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 14 Jan 2002 20:28:17 +0000 Subject: pay some attention to 1.4 RADIUS SQL export --- FS/FS/Conf.pm | 8 ++--- FS/FS/svc_acct.pm | 95 ++++++++++++++++++++++++++++++++++++++++++++++--------- 2 files changed, 84 insertions(+), 19 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 4ce9da1de..cc91e8292 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -347,28 +347,28 @@ httemplate/docs/config.html { 'key' => 'icradiusmachines', 'section' => 'radius', - 'description' => 'Your ICRADIUS machines or FreeRADIUS (with MySQL authentication) machines, one per line. Turning this option on (even if empty) turns on radcheck table population (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 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". You do not need to use MySQL for your Freeside database to export to an ICRADIUS/FreeRADIUS mysql database with this option.', + 'description' => 'Turn this option on to enable radcheck and radreply table population - by default in the Freeside database, or in the database specified by the icradius_secrets config option (the radcheck and radreply tables needs to be created manually). You do not need to use MySQL for your Freeside database to export to an ICRADIUS/FreeRADIUS MySQL database with this option.

ADDITIONAL DEPRECATED FUNCTIONALITY (instead use MySQL replication or point icradius_secrets to the external database) - your ICRADIUS machines or FreeRADIUS (with MySQL authentication) machines, one per line. Machines listed in this file will have the radcheck table exported to them. Each line should contain four items, separted by whitespace: machine name, MySQL database name, MySQL username, and MySQL password. For example: "radius.isp.tld radius_db radius_user passw0rd"
', 'type' => [qw( checkbox textarea )], }, { 'key' => 'icradius_mysqldest', 'section' => 'radius', - 'description' => 'Destination directory for the MySQL databases, on the ICRADIUS/FreeRADIUS machines. Defaults to "/usr/local/var/".', + 'description' => 'DEPRECATED (instead use MySQL replication or point icradius_secrets to the external database) - Destination directory for the MySQL databases, on the ICRADIUS/FreeRADIUS machines. Defaults to "/usr/local/var/".', 'type' => 'text', }, { 'key' => 'icradius_mysqlsource', 'section' => 'radius', - 'description' => 'Source directory for for the MySQL radcheck table files, on the Freeside machine. Defaults to "/usr/local/var/freeside".', + 'description' => 'DEPRECATED (instead use MySQL replication or point icradius_secrets to the external database) - Source directory for for the MySQL radcheck table files, on the Freeside machine. Defaults to "/usr/local/var/freeside".', 'type' => 'text', }, { 'key' => 'icradius_secrets', 'section' => 'radius', - 'description' => 'Optionally specifies a MySQL database for ICRADIUS/FreeRADIUS 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.', + 'description' => 'Optionally specifies a database for ICRADIUS/FreeRADIUS export. Three lines: DBI data source, username and password.', 'type' => 'textarea', }, diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 49a55e9cf..28c0f57a4 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -71,9 +71,15 @@ $FS::UID::callback{'FS::svc_acct'} = sub { $cyrus_admin_user = ''; $cyrus_admin_pass = ''; } - if ( $conf->exists('icradius_secrets') ) { - $icradius_dbh = DBI->connect($conf->config('icradius_secrets')) - or die $DBI::errstr; + if ( $conf->exists('icradiusmachines') ) { + if ( $conf->exists('icradius_secrets') ) { + #need some sort of late binding so it's only connected to when + # actually used, hmm + $icradius_dbh = DBI->connect($conf->config('icradius_secrets')) + or die $DBI::errstr; + } else { + $icradius_dbh = dbh; + } } else { $icradius_dbh = ''; } @@ -273,15 +279,29 @@ sub insert { } } if ( $icradius_dbh ) { - my $queue = new FS::queue { 'job' => 'FS::svc_acct::icradius_rc_insert' }; - $error = $queue->insert( $self->username, - $self->_password, - $self->radius_check - ); + + my $radcheck_queue = + new FS::queue { 'job' => 'FS::svc_acct::icradius_rc_insert' }; + $error = $radcheck_queue->insert( $self->username, + $self->_password, + $self->radius_check + ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } + + my $radreply_queue = + new FS::queue { 'job' => 'FS::svc_acct::icradius_rr_insert' }; + $error = $radreply_queue->insert( $self->username, + $self->_password, + $self->radius_reply + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "queueing job (transaction rolled back): $error"; } + } $dbh->commit or die $dbh->errstr if $oldAutoCommit; @@ -353,6 +373,25 @@ sub icradius_rc_insert { 1; } +sub icradius_rr_insert { + my( $username, $password, %radreply ) = @_; + + foreach my $attribute ( keys %radreply ) { + my $sth = $icradius_dbh->prepare( + "INSERT INTO radreply ( id, UserName, Attribute, Value ) VALUES ( ". + join(", ", map { $icradius_dbh->quote($_) } ( + '', + $username, + $attribute, + $radreply{$attribute}, + ) ). " )" + ); + $sth->execute or die "can't insert into radreply table: ". $sth->errstr; + } + + 1; +} + =item delete Deletes this account from the database. If there is an error, returns the @@ -471,12 +510,21 @@ sub delete { } } if ( $icradius_dbh ) { + my $queue = new FS::queue { 'job' => 'FS::svc_acct::icradius_rc_delete' }; $error = $queue->insert( $self->username ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "queueing job (transaction rolled back): $error"; } + + my $queue = new FS::queue { 'job' => 'FS::svc_acct::icradius_rr_delete' }; + $error = $queue->insert( $self->username ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } + } $dbh->commit or die $dbh->errstr if $oldAutoCommit; @@ -516,6 +564,18 @@ sub icradius_rc_delete { 1; } +sub icradius_rr_delete { + my $username = shift; + + my $sth = $icradius_dbh->prepare( + 'DELETE FROM radreply WHERE UserName = ?' + ); + $sth->execute($username) + or die "can't delete from radreply table: ". $sth->errstr; + + 1; +} + =item replace OLD_RECORD Replaces OLD_RECORD with this one in the database. If there is an error, @@ -863,12 +923,17 @@ expected to change in the future. sub radius_reply { my $self = shift; - map { - /^(radius_(.*))$/; - my($column, $attrib) = ($1, $2); - #$attrib =~ s/_/\-/g; - ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) ); - } grep { /^radius_/ && $self->getfield($_) } fields( $self->table ); + my %reply = + map { + /^(radius_(.*))$/; + my($column, $attrib) = ($1, $2); + #$attrib =~ s/_/\-/g; + ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) ); + } grep { /^radius_/ && $self->getfield($_) } fields( $self->table ); + if ( $self->ip && $self->ip ne '0e0' ) { + $reply{Framed-IP-Address} = $self->ip; + } + %reply; } =item radius_check @@ -966,7 +1031,7 @@ sub ssh { =head1 VERSION -$Id: svc_acct.pm,v 1.60 2001-12-20 02:09:52 ivan Exp $ +$Id: svc_acct.pm,v 1.61 2002-01-14 20:28:17 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 52c1b2edef2c53822d8e67952710ba45dae1d293 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 16 Jan 2002 15:37:42 +0000 Subject: doc --- FS/FS/svc_acct.pm | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 28c0f57a4..3f97189e7 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -1031,7 +1031,7 @@ sub ssh { =head1 VERSION -$Id: svc_acct.pm,v 1.61 2002-01-14 20:28:17 ivan Exp $ +$Id: svc_acct.pm,v 1.62 2002-01-16 15:37:42 ivan Exp $ =head1 BUGS @@ -1046,9 +1046,10 @@ counterintuitive. =head1 SEE ALSO -L, L, L, L, -L, L, L, L), -L, L, L, +L, edit/part_svc.cgi from an installed web interface, +export.html from the base documentation, L, L, +L, L, L, L, +L), L, L, L, schema.html from the base documentation. =cut -- cgit v1.2.1 From fb697ebf8016ab1fa33de81a2a6b46f2bc7f1c1d Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 19 Jan 2002 15:16:22 +0000 Subject: error message update --- FS/FS/UID.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm index 890e2988a..78fe156c3 100644 --- a/FS/FS/UID.pm +++ b/FS/FS/UID.pm @@ -188,7 +188,7 @@ sub cgisetotaker { $user = lc ( $cgi->connection->user ); } else { die "fatal: Can't get REMOTE_USER! for cgi $cgi - you need to setup ". - "Apache user authentication as documented in httemplate/docs/config.html"; + "Apache user authentication as documented in httemplate/docs/install.html"; } $user; } @@ -252,7 +252,7 @@ coderef into the hash %FS::UID::callback : =head1 VERSION -$Id: UID.pm,v 1.11 2001-11-06 17:58:08 ivan Exp $ +$Id: UID.pm,v 1.12 2002-01-19 15:16:22 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 002d821bb367e07902c987721737f62f280e03b9 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 21 Jan 2002 11:30:17 +0000 Subject: include FS::svc_forward in kludgy preload --- FS/FS/cust_pkg.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index c6fabe5cb..633b3224f 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -17,6 +17,7 @@ use FS::svc_acct; use FS::svc_acct_sm; use FS::svc_domain; use FS::svc_www; +use FS::svc_forward; @ISA = qw( FS::Record ); @@ -629,7 +630,7 @@ sub order { =head1 VERSION -$Id: cust_pkg.pm,v 1.14 2001-11-30 00:04:38 ivan Exp $ +$Id: cust_pkg.pm,v 1.15 2002-01-21 11:30:17 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 3a625afa978c85a769c2a40b1bfaeb4aa9d1bc45 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 22 Jan 2002 14:53:26 +0000 Subject: silly compilation problem --- FS/FS/svc_acct.pm | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 3f97189e7..0340e7cc5 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -511,15 +511,17 @@ sub delete { } if ( $icradius_dbh ) { - my $queue = new FS::queue { 'job' => 'FS::svc_acct::icradius_rc_delete' }; - $error = $queue->insert( $self->username ); + my $radcheck_queue = + new FS::queue { 'job' => 'FS::svc_acct::icradius_rc_delete' }; + $error = $radcheck_queue->insert( $self->username ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "queueing job (transaction rolled back): $error"; } - my $queue = new FS::queue { 'job' => 'FS::svc_acct::icradius_rr_delete' }; - $error = $queue->insert( $self->username ); + my $radreply_queue = + new FS::queue { 'job' => 'FS::svc_acct::icradius_rr_delete' }; + $error = $radreply_queue->insert( $self->username ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "queueing job (transaction rolled back): $error"; @@ -931,7 +933,7 @@ sub radius_reply { ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) ); } grep { /^radius_/ && $self->getfield($_) } fields( $self->table ); if ( $self->ip && $self->ip ne '0e0' ) { - $reply{Framed-IP-Address} = $self->ip; + $reply{'Framed-IP-Address'} = $self->ip; } %reply; } @@ -1031,7 +1033,7 @@ sub ssh { =head1 VERSION -$Id: svc_acct.pm,v 1.62 2002-01-16 15:37:42 ivan Exp $ +$Id: svc_acct.pm,v 1.63 2002-01-22 14:53:26 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 4f391f615b2ea762783edc0fa796013c57e457e2 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 22 Jan 2002 14:55:25 +0000 Subject: docu --- FS/FS/part_svc.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_svc.pm b/FS/FS/part_svc.pm index 18760c39a..446d88c7e 100644 --- a/FS/FS/part_svc.pm +++ b/FS/FS/part_svc.pm @@ -301,7 +301,7 @@ sub all_part_svc_column { =head1 VERSION -$Id: part_svc.pm,v 1.7 2001-12-27 09:26:13 ivan Exp $ +$Id: part_svc.pm,v 1.8 2002-01-22 14:55:25 ivan Exp $ =head1 BUGS @@ -312,7 +312,7 @@ should be fixed. =head1 SEE ALSO -L, L, L, +L, L, L, L, L, L, L, L, schema.html from the base documentation. -- cgit v1.2.1 From d89908c40c18df348f580852f906853184fabd3c Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 22 Jan 2002 15:57:33 +0000 Subject: don't allow $0.00 in credits/payments/refunds --- FS/FS/cust_credit.pm | 4 +++- FS/FS/cust_pay.pm | 4 +++- FS/FS/cust_refund.pm | 4 +++- 3 files changed, 9 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm index 54c201ad4..278e6dedd 100644 --- a/FS/FS/cust_credit.pm +++ b/FS/FS/cust_credit.pm @@ -160,6 +160,8 @@ sub check { ; return $error if $error; + return "amount must be > 0 " if $self->amount == 0; + return "Unknown customer" unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); @@ -235,7 +237,7 @@ sub credited { =head1 VERSION -$Id: cust_credit.pm,v 1.12 2001-10-09 23:10:16 ivan Exp $ +$Id: cust_credit.pm,v 1.13 2002-01-22 15:57:33 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index ecd6ab24f..b96e29fbd 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -240,6 +240,8 @@ sub check { ; return $error if $error; + return "paid must be > 0 " if $self->paid == 0; + return "unknown cust_main.custnum: ". $self->custnum unless $self->invnum || qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); @@ -304,7 +306,7 @@ sub unapplied { =head1 VERSION -$Id: cust_pay.pm,v 1.10 2001-12-26 07:53:21 ivan Exp $ +$Id: cust_pay.pm,v 1.11 2002-01-22 15:57:33 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_refund.pm b/FS/FS/cust_refund.pm index 77bacdffb..7b8b29f5e 100644 --- a/FS/FS/cust_refund.pm +++ b/FS/FS/cust_refund.pm @@ -213,6 +213,8 @@ sub check { ; return $error if $error; + return "amount must be > 0 " if $self->amount == 0; + $self->_date(time) unless $self->_date; return "unknown cust_main.custnum: ". $self->custnum @@ -249,7 +251,7 @@ sub check { =head1 VERSION -$Id: cust_refund.pm,v 1.8 2001-09-02 05:38:13 ivan Exp $ +$Id: cust_refund.pm,v 1.9 2002-01-22 15:57:33 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 579b08e47d45dec6ea0729164a6e24613c02be26 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 24 Jan 2002 02:26:49 +0000 Subject: fix cust_refund::insert --- FS/FS/cust_refund.pm | 30 +++++++++++++++++++----------- 1 file changed, 19 insertions(+), 11 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_refund.pm b/FS/FS/cust_refund.pm index 7b8b29f5e..6bf2da595 100644 --- a/FS/FS/cust_refund.pm +++ b/FS/FS/cust_refund.pm @@ -93,10 +93,23 @@ sub insert { local $FS::UID::AutoCommit = 0; my $dbh = dbh; + if ( $self->crednum ) { + my $cust_credit = qsearchs('cust_bill', { 'invnum' => $self->invnum } ) + or do { + $dbh->rollback if $oldAutoCommit; + return "Unknown cust_credit.crednum: ". $self->crednum; + }; + $self->custnum($cust_credit->custnum); + } + my $error = $self->check; return $error if $error; - die; + $error = $self->SUPER::insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } if ( $self->crednum ) { my $cust_credit_refund = new FS::cust_credit_refund { @@ -110,14 +123,9 @@ sub insert { $dbh->rollback if $oldAutoCommit; return $error; } - $self->custnum($cust_credit_refund->cust_credit->custnum); + #$self->custnum($cust_credit_refund->cust_credit->custnum); } - $error = $self->SUPER::insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } $dbh->commit or die $dbh->errstr if $oldAutoCommit; @@ -206,7 +214,7 @@ sub check { my $error = $self->ut_number('refundnum') - || $self->ut_number('custnum') + || $self->ut_numbern('custnum') || $self->ut_money('amount') || $self->ut_numbern('_date') || $self->ut_textn('paybatch') @@ -218,8 +226,8 @@ sub check { $self->_date(time) unless $self->_date; return "unknown cust_main.custnum: ". $self->custnum - unless $self->invnum - || qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); + unless $self->crednum + || qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); $self->payby =~ /^(CARD|BILL|COMP)$/ or return "Illegal payby"; $self->payby($1); @@ -251,7 +259,7 @@ sub check { =head1 VERSION -$Id: cust_refund.pm,v 1.9 2002-01-22 15:57:33 ivan Exp $ +$Id: cust_refund.pm,v 1.10 2002-01-24 02:26:49 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From f3d5a1bc3bf8ffe4b2fe6a0da3b201ba988b21a8 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 24 Jan 2002 06:46:29 +0000 Subject: more updates to cust_refund::update_replace --- FS/FS/cust_refund.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_refund.pm b/FS/FS/cust_refund.pm index 6bf2da595..0f87679a0 100644 --- a/FS/FS/cust_refund.pm +++ b/FS/FS/cust_refund.pm @@ -133,7 +133,7 @@ sub insert { } -sub upgrade_replace { +sub upgrade_replace { #1.3.x->1.4.x my $self = shift; local $SIG{HUP} = 'IGNORE'; @@ -170,7 +170,7 @@ sub upgrade_replace { die; } - $error = $new->SUPER::insert($self); + $error = $new->SUPER::replace($self); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -259,7 +259,7 @@ sub check { =head1 VERSION -$Id: cust_refund.pm,v 1.10 2002-01-24 02:26:49 ivan Exp $ +$Id: cust_refund.pm,v 1.11 2002-01-24 06:46:29 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 254ccae67eb65fe7d9320c121e76c447b937abd9 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 24 Jan 2002 06:52:44 +0000 Subject: from jeff@fix in FS::cust_refund::check 'amount' should probably be replaced with +'refund' in two places --- FS/FS/cust_refund.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_refund.pm b/FS/FS/cust_refund.pm index 0f87679a0..c7d8a6d62 100644 --- a/FS/FS/cust_refund.pm +++ b/FS/FS/cust_refund.pm @@ -215,13 +215,13 @@ sub check { my $error = $self->ut_number('refundnum') || $self->ut_numbern('custnum') - || $self->ut_money('amount') + || $self->ut_money('refund') || $self->ut_numbern('_date') || $self->ut_textn('paybatch') ; return $error if $error; - return "amount must be > 0 " if $self->amount == 0; + return "refund must be > 0 " if $self->refund == 0; $self->_date(time) unless $self->_date; @@ -259,7 +259,7 @@ sub check { =head1 VERSION -$Id: cust_refund.pm,v 1.11 2002-01-24 06:46:29 ivan Exp $ +$Id: cust_refund.pm,v 1.12 2002-01-24 06:52:44 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 9bf94801a1dd34dadf2862b52886e1257995ef08 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 24 Jan 2002 11:43:39 +0000 Subject: and it seems that cust_credit_refund::cust_credit should exist.. --- FS/FS/cust_credit_refund.pm | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_credit_refund.pm b/FS/FS/cust_credit_refund.pm index fb09a42d8..cf16284bc 100644 --- a/FS/FS/cust_credit_refund.pm +++ b/FS/FS/cust_credit_refund.pm @@ -168,11 +168,23 @@ sub cust_refund { qsearchs( 'cust_refund', { 'refundnum' => $self->refundnum } ); } +=item cust_credit + +Returns the credit (see L) + +=cut + +sub cust_refund { + my $self = shift; + qsearchs( 'cust_credit', { 'crednum' => $self->crednum } ); +} + + =back =head1 VERSION -$Id: cust_credit_refund.pm,v 1.4 2001-09-02 07:49:52 ivan Exp $ +$Id: cust_credit_refund.pm,v 1.5 2002-01-24 11:43:39 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From ef5490483c6b97512c4a1fe0ec841c2044e346af Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 24 Jan 2002 11:52:02 +0000 Subject: jeff's on a bugfinding roll here, thanks! --- FS/FS/cust_credit_refund.pm | 3 +-- FS/FS/cust_pay.pm | 3 ++- FS/FS/cust_refund.pm | 6 ++++-- 3 files changed, 7 insertions(+), 5 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_credit_refund.pm b/FS/FS/cust_credit_refund.pm index cf16284bc..8b7d6dac3 100644 --- a/FS/FS/cust_credit_refund.pm +++ b/FS/FS/cust_credit_refund.pm @@ -179,12 +179,11 @@ sub cust_refund { qsearchs( 'cust_credit', { 'crednum' => $self->crednum } ); } - =back =head1 VERSION -$Id: cust_credit_refund.pm,v 1.5 2002-01-24 11:43:39 ivan Exp $ +$Id: cust_credit_refund.pm,v 1.6 2002-01-24 11:52:02 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index b96e29fbd..00c6e1cfe 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -251,6 +251,7 @@ sub check { $self->payby =~ /^(CARD|BILL|COMP)$/ or return "Illegal payby"; $self->payby($1); + #false laziness with cust_refund::check if ( $self->payby eq 'CARD' ) { my $payinfo = $self->payinfo; $payinfo =~ s/\D//g; @@ -306,7 +307,7 @@ sub unapplied { =head1 VERSION -$Id: cust_pay.pm,v 1.11 2002-01-22 15:57:33 ivan Exp $ +$Id: cust_pay.pm,v 1.12 2002-01-24 11:52:02 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_refund.pm b/FS/FS/cust_refund.pm index c7d8a6d62..a1d1e594c 100644 --- a/FS/FS/cust_refund.pm +++ b/FS/FS/cust_refund.pm @@ -232,9 +232,11 @@ sub check { $self->payby =~ /^(CARD|BILL|COMP)$/ or return "Illegal payby"; $self->payby($1); + #false laziness with cust_pay::check if ( $self->payby eq 'CARD' ) { my $payinfo = $self->payinfo; - $self->payinfo($payinfo =~ s/\D//g); + $payinfo =~ s/\D//g; + $self->payinfo($payinfo); if ( $self->payinfo ) { $self->payinfo =~ /^(\d{13,16})$/ or return "Illegal (mistyped?) credit card number (payinfo)"; @@ -259,7 +261,7 @@ sub check { =head1 VERSION -$Id: cust_refund.pm,v 1.12 2002-01-24 06:52:44 ivan Exp $ +$Id: cust_refund.pm,v 1.13 2002-01-24 11:52:02 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 0d2d5a1fdc65bc8511dcf9727e534e7e5da271f7 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 24 Jan 2002 16:54:53 +0000 Subject: stack traces help alot --- FS/FS/cust_credit_refund.pm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_credit_refund.pm b/FS/FS/cust_credit_refund.pm index 8b7d6dac3..83f6e2f75 100644 --- a/FS/FS/cust_credit_refund.pm +++ b/FS/FS/cust_credit_refund.pm @@ -57,6 +57,8 @@ L and L for conversion functions. Creates a new record. To add the record to the database, see L<"insert">. +=cut + sub table { 'cust_credit_refund'; } =item insert @@ -183,7 +185,7 @@ sub cust_refund { =head1 VERSION -$Id: cust_credit_refund.pm,v 1.6 2002-01-24 11:52:02 ivan Exp $ +$Id: cust_credit_refund.pm,v 1.7 2002-01-24 16:54:53 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 243ec8f6a0ef59759f1398967faa561a43b1dff5 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 24 Jan 2002 16:58:47 +0000 Subject: rather than == 0 in the ::check's .... you might consider <= 0 --- FS/FS/cust_bill_pay.pm | 4 ++-- FS/FS/cust_credit.pm | 4 ++-- FS/FS/cust_credit_bill.pm | 4 ++-- FS/FS/cust_credit_refund.pm | 4 ++-- FS/FS/cust_pay.pm | 4 ++-- FS/FS/cust_refund.pm | 4 ++-- 6 files changed, 12 insertions(+), 12 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill_pay.pm b/FS/FS/cust_bill_pay.pm index 2b0105139..1c838b932 100644 --- a/FS/FS/cust_bill_pay.pm +++ b/FS/FS/cust_bill_pay.pm @@ -162,7 +162,7 @@ sub check { ; return $error if $error; - return "amount must be > 0" if $self->amount == 0; + return "amount must be > 0" if $self->amount <= 0; $self->_date(time) unless $self->_date; @@ -195,7 +195,7 @@ sub cust_bill { =head1 VERSION -$Id: cust_bill_pay.pm,v 1.10 2001-12-21 20:55:35 ivan Exp $ +$Id: cust_bill_pay.pm,v 1.11 2002-01-24 16:58:47 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm index 278e6dedd..3044af7ea 100644 --- a/FS/FS/cust_credit.pm +++ b/FS/FS/cust_credit.pm @@ -160,7 +160,7 @@ sub check { ; return $error if $error; - return "amount must be > 0 " if $self->amount == 0; + return "amount must be > 0 " if $self->amount <= 0; return "Unknown customer" unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); @@ -237,7 +237,7 @@ sub credited { =head1 VERSION -$Id: cust_credit.pm,v 1.13 2002-01-22 15:57:33 ivan Exp $ +$Id: cust_credit.pm,v 1.14 2002-01-24 16:58:47 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_credit_bill.pm b/FS/FS/cust_credit_bill.pm index 8f992b580..62215419c 100644 --- a/FS/FS/cust_credit_bill.pm +++ b/FS/FS/cust_credit_bill.pm @@ -109,7 +109,7 @@ sub check { ; return $error if $error; - return "amount must be > 0" if $self->amount == 0; + return "amount must be > 0" if $self->amount <= 0; return "Unknown credit" unless my $cust_credit = @@ -145,7 +145,7 @@ sub cust_credit { =head1 VERSION -$Id: cust_credit_bill.pm,v 1.6 2001-09-26 09:17:06 ivan Exp $ +$Id: cust_credit_bill.pm,v 1.7 2002-01-24 16:58:47 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_credit_refund.pm b/FS/FS/cust_credit_refund.pm index 83f6e2f75..7079d28e9 100644 --- a/FS/FS/cust_credit_refund.pm +++ b/FS/FS/cust_credit_refund.pm @@ -149,7 +149,7 @@ sub check { ; return $error if $error; - return "amount must be > 0" if $self->amount == 0; + return "amount must be > 0" if $self->amount <= 0; $self->_date(time) unless $self->_date; @@ -185,7 +185,7 @@ sub cust_refund { =head1 VERSION -$Id: cust_credit_refund.pm,v 1.7 2002-01-24 16:54:53 ivan Exp $ +$Id: cust_credit_refund.pm,v 1.8 2002-01-24 16:58:47 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index 00c6e1cfe..8f790a61a 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -240,7 +240,7 @@ sub check { ; return $error if $error; - return "paid must be > 0 " if $self->paid == 0; + return "paid must be > 0 " if $self->paid <= 0; return "unknown cust_main.custnum: ". $self->custnum unless $self->invnum @@ -307,7 +307,7 @@ sub unapplied { =head1 VERSION -$Id: cust_pay.pm,v 1.12 2002-01-24 11:52:02 ivan Exp $ +$Id: cust_pay.pm,v 1.13 2002-01-24 16:58:47 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_refund.pm b/FS/FS/cust_refund.pm index a1d1e594c..2f7b3af4f 100644 --- a/FS/FS/cust_refund.pm +++ b/FS/FS/cust_refund.pm @@ -221,7 +221,7 @@ sub check { ; return $error if $error; - return "refund must be > 0 " if $self->refund == 0; + return "refund must be > 0 " if $self->refund <= 0; $self->_date(time) unless $self->_date; @@ -261,7 +261,7 @@ sub check { =head1 VERSION -$Id: cust_refund.pm,v 1.13 2002-01-24 11:52:02 ivan Exp $ +$Id: cust_refund.pm,v 1.14 2002-01-24 16:58:47 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 99e136cfed6e793e7f85b0916239416bf96acaf7 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 24 Jan 2002 17:02:53 +0000 Subject: emit a warning in this unlikely case again --- FS/FS/Record.pm | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 6c0f5f819..5c828b7c6 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -122,7 +122,10 @@ sub new { my $self = {}; bless ($self, $class); - $self->{'Table'} = shift unless defined ( $self->table ); + unless defined ( $self->table ) { + $self->{'Table'} = shift; + carp "warning: FS::Record::new called with table name ". $self->{'Table'}; + } my $hashref = $self->{'Hash'} = shift; -- cgit v1.2.1 From a820cfffc9f5413be79409c915565689563dede3 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 26 Jan 2002 01:52:31 +0000 Subject: another bug spotted by jeff --- FS/FS/cust_credit_refund.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_credit_refund.pm b/FS/FS/cust_credit_refund.pm index 7079d28e9..cc3b32cdb 100644 --- a/FS/FS/cust_credit_refund.pm +++ b/FS/FS/cust_credit_refund.pm @@ -176,7 +176,7 @@ Returns the credit (see L) =cut -sub cust_refund { +sub cust_credit { my $self = shift; qsearchs( 'cust_credit', { 'crednum' => $self->crednum } ); } @@ -185,7 +185,7 @@ sub cust_refund { =head1 VERSION -$Id: cust_credit_refund.pm,v 1.8 2002-01-24 16:58:47 ivan Exp $ +$Id: cust_credit_refund.pm,v 1.9 2002-01-26 01:52:31 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From b03df92e48df653460cb8b6034a06dd1de6f4095 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 28 Jan 2002 05:15:29 +0000 Subject: part_export schema changes --- FS/FS/part_export.pm | 138 ++++++++++++++++++++++++++++++++++++++++++++ FS/FS/part_export_option.pm | 134 ++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 272 insertions(+) create mode 100644 FS/FS/part_export.pm create mode 100644 FS/FS/part_export_option.pm (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm new file mode 100644 index 000000000..67371bc3b --- /dev/null +++ b/FS/FS/part_export.pm @@ -0,0 +1,138 @@ +package FS::part_export; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearch qsearchs ); +use FS::part_svc; + +@ISA = qw(FS::Record); + +=head1 NAME + +FS::part_export - Object methods for part_export records + +=head1 SYNOPSIS + + use FS::part_export; + + $record = new FS::part_export \%hash; + $record = new FS::part_export { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::part_export object represents an export of Freeside data to an external +provisioning system. FS::part_export inherits from FS::Record. The following +fields are currently supported: + +=over 4 + +=item eventpart - primary key + +=item svcpart - Service definition (see L) to which this export applies + +=item machine - Machine name + +=item exporttype - Export type + +=item nodomain - blank or "Y" : usernames are exported to this service with no domain + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new export. To add the export to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'part_export'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +# the insert method can be inherited from FS::Record + +=item delete + +Delete this record from the database. + +=cut + +# the delete method can be inherited from FS::Record + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +# the replace method can be inherited from FS::Record + +=item check + +Checks all fields to make sure this is a valid export. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +sub check { + my $self = shift; + my $error = + $self->ut_numbern('exportnum') + || $self->ut_number('svcpart') + || $self->ut_alpha('exporttype') + ; + return $error if $error; + + return "Unknown svcpart: ". $self->svcpart + unless qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); + + $self->machine =~ /^([\w\-\.]*)$/ + or return "Illegal machine: ". $self->machine; + $self->machine($1); + + $self->nodomain =~ /^(Y?)$/ or return "Illegal nodomain: ". $self->nodomain; + $self->nodomain($1); + + #check exporttype? + + ''; #no error +} + +=back + +=head1 BUGS + +Probably. + +=head1 SEE ALSO + +L, L, L, L, +L, L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/part_export_option.pm b/FS/FS/part_export_option.pm new file mode 100644 index 000000000..4ce70b4cd --- /dev/null +++ b/FS/FS/part_export_option.pm @@ -0,0 +1,134 @@ +package FS::part_export_option; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearch qsearchs ); +use FS::part_export; + +@ISA = qw(FS::Record); + +=head1 NAME + +FS::part_export_option - Object methods for part_export_option records + +=head1 SYNOPSIS + + use FS::part_export_option; + + $record = new FS::part_export_option \%hash; + $record = new FS::part_export_option { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::part_export_option object represents an export option. +FS::part_export_option inherits from FS::Record. The following fields are +currently supported: + +=over 4 + +=item optionnum - primary key + +=item exportnum - export (see L) + +=item option - option name + +=item opeionvalue - option value + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new export option. To add the export option to the database, see +L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'part_export_option'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +# the insert method can be inherited from FS::Record + +=item delete + +Delete this record from the database. + +=cut + +# the delete method can be inherited from FS::Record + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +# the replace method can be inherited from FS::Record + +=item check + +Checks all fields to make sure this is a valid export option. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +# the check method should currently be supplied - FS::Record contains some +# data checking routines + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('optionnum') + || $self->ut_number('exportnum') + || $self->ut_alpha('option') + || $self->ut_textn('optionvalue') + ; + return $error if $error; + + return "Unknown exportnum: ". $self->exportnum + unless qsearchs('part_export', { 'exportnum' => $self->exportnum } ); + + #check options & values? + + ''; #no error +} + +=back + +=head1 BUGS + +Possibly. + +=head1 SEE ALSO + +L, L, schema.html from the base documentation. + +=cut + +1; + -- cgit v1.2.1 From 1aa750eba2b9b73b4f09f28b9acd748ee3669bd4 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 28 Jan 2002 06:57:23 +0000 Subject: book closing schema changes --- FS/FS/cust_bill.pm | 9 +++++++-- FS/FS/cust_credit.pm | 11 ++++++++--- FS/FS/cust_pay.pm | 9 +++++++-- FS/FS/cust_refund.pm | 9 +++++++-- FS/FS/part_pkg.pm | 18 +++++------------- FS/FS/part_svc.pm | 6 ++---- 6 files changed, 36 insertions(+), 26 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index fbccff1ff..8b326a56f 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -91,6 +91,8 @@ L and L for conversion functions. =item printed - how many times this invoice has been printed automatically (see L). +=item closed - books closed flag, empty or `Y' + =back =head1 METHODS @@ -120,7 +122,9 @@ no record you ever posted this invoice (which is bad, no?) =cut sub delete { - return "Can't remove invoice!" + my $self = shift; + return "Can't delete closed invoice" if $self->closed =~ /^Y/i; + $self->SUPER::delete(@_); } =item replace OLD_RECORD @@ -160,6 +164,7 @@ sub check { || $self->ut_numbern('_date') || $self->ut_money('charged') || $self->ut_numbern('printed') + || $self->ut_enum('closed', [ '', 'Y' ]) ; return $error if $error; @@ -495,7 +500,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.14 2001-12-21 21:40:24 ivan Exp $ +$Id: cust_bill.pm,v 1.15 2002-01-28 06:57:23 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm index 3044af7ea..0ce5ac614 100644 --- a/FS/FS/cust_credit.pm +++ b/FS/FS/cust_credit.pm @@ -58,6 +58,8 @@ L and L for conversion functions. =item reason - text +=item closed - books closed flag, empty or `Y' + =back =head1 METHODS @@ -126,7 +128,9 @@ Currently unimplemented. =cut sub delete { - return "Can't remove credit!" + my $self = shift; + return "Can't delete closed credit" if $self->closed =~ /^Y/i; + $self->SUPER::delete(@_); } =item replace OLD_RECORD @@ -156,7 +160,8 @@ sub check { || $self->ut_number('custnum') || $self->ut_numbern('_date') || $self->ut_money('amount') - || $self->ut_textn('reason'); + || $self->ut_textn('reason') + || $self->ut_enum('closed', [ '', 'Y' ]) ; return $error if $error; @@ -237,7 +242,7 @@ sub credited { =head1 VERSION -$Id: cust_credit.pm,v 1.14 2002-01-24 16:58:47 ivan Exp $ +$Id: cust_credit.pm,v 1.15 2002-01-28 06:57:23 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index 8f790a61a..3f811357a 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -61,6 +61,8 @@ L and L for conversion functions. =item paybatch - text field for tracking card processing +=item closed - books closed flag, empty or `Y' + =back =head1 METHODS @@ -208,7 +210,9 @@ Currently unimplemented (accounting reasons). =cut sub delete { - return "Can't (yet?) delete cust_pay records!"; + my $self = shift; + return "Can't delete closed payment" if $self->closed =~ /^Y/i; + $self->SUPER::delete(@_); } =item replace OLD_RECORD @@ -237,6 +241,7 @@ sub check { || $self->ut_money('paid') || $self->ut_numbern('_date') || $self->ut_textn('paybatch') + || $self->ut_enum('closed', [ '', 'Y' ]) ; return $error if $error; @@ -307,7 +312,7 @@ sub unapplied { =head1 VERSION -$Id: cust_pay.pm,v 1.13 2002-01-24 16:58:47 ivan Exp $ +$Id: cust_pay.pm,v 1.14 2002-01-28 06:57:23 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_refund.pm b/FS/FS/cust_refund.pm index 2f7b3af4f..3dbd4ef39 100644 --- a/FS/FS/cust_refund.pm +++ b/FS/FS/cust_refund.pm @@ -55,6 +55,8 @@ L and L for conversion functions. =item otaker - order taker (assigned automatically, see L) +=item closed - books closed flag, empty or `Y' + =back =head1 METHODS @@ -189,7 +191,9 @@ Currently unimplemented (accounting reasons). =cut sub delete { - return "Can't (yet?) delete cust_refund records!"; + my $self = shift; + return "Can't delete closed refund" if $self->closed =~ /^Y/i; + $self->SUPER::delete(@_); } =item replace OLD_RECORD @@ -218,6 +222,7 @@ sub check { || $self->ut_money('refund') || $self->ut_numbern('_date') || $self->ut_textn('paybatch') + || $self->ut_enum('closed', [ '', 'Y' ]) ; return $error if $error; @@ -261,7 +266,7 @@ sub check { =head1 VERSION -$Id: cust_refund.pm,v 1.14 2002-01-24 16:58:47 ivan Exp $ +$Id: cust_refund.pm,v 1.15 2002-01-28 06:57:23 ivan Exp $ =head1 BUGS diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index be2ad935f..29257c0cb 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -132,7 +132,7 @@ insert and replace methods. sub check { my $self = shift; - my $error = $self->ut_numbern('pkgpart') + $self->ut_numbern('pkgpart') || $self->ut_text('pkg') || $self->ut_text('comment') || $self->ut_anything('setup') @@ -140,19 +140,11 @@ sub check { || $self->ut_anything('recur') || $self->ut_alphan('plan') || $self->ut_anything('plandata') + || $self->ut_enum('setuptax', [ '', 'Y' ] ) + || $self->ut_enum('recurtax', [ '', 'Y' ] ) + || $self->ut_enum('disabled', [ '', 'Y' ] ) ; - return $error if $error; - $self->setuptax =~ /^(Y?)$/ or return "Illegal setuptax: ". $self->setuptax; - $self->setuptax($1); - - $self->recurtax =~ /^(Y?)$/ or return "Illegal recrutax: ". $self->recurtax; - $self->recurtax($1); - - $self->disabled =~ /^(Y?)$/ or return "Illegal disabled: ". $self->disabled; - $self->disabled($1); - - ''; } =item pkg_svc @@ -190,7 +182,7 @@ sub svcpart { =head1 VERSION -$Id: part_pkg.pm,v 1.5 2001-12-27 09:26:13 ivan Exp $ +$Id: part_pkg.pm,v 1.6 2002-01-28 06:57:23 ivan Exp $ =head1 BUGS diff --git a/FS/FS/part_svc.pm b/FS/FS/part_svc.pm index 446d88c7e..41ee21d31 100644 --- a/FS/FS/part_svc.pm +++ b/FS/FS/part_svc.pm @@ -231,6 +231,7 @@ sub check { $self->ut_numbern('svcpart') || $self->ut_text('svc') || $self->ut_alpha('svcdb') + || $self->ut_enum('disabled', [ '', 'Y' ] ) ; return $error if $error; @@ -262,9 +263,6 @@ sub check { # } # } - $self->disabled =~ /^(Y?)$/ or return "Illegal disabled: ". $self->disabled; - $self->disabled($1); - ''; #no error } @@ -301,7 +299,7 @@ sub all_part_svc_column { =head1 VERSION -$Id: part_svc.pm,v 1.8 2002-01-22 14:55:25 ivan Exp $ +$Id: part_svc.pm,v 1.9 2002-01-28 06:57:23 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From f31f46f6f60c2a4d6b4f69694e020c2ec48ab807 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 28 Jan 2002 11:24:50 +0000 Subject: oops, syntax error in new() check for missing subclass table sub (eek) --- FS/FS/Record.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 5c828b7c6..6b7997f21 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -122,7 +122,7 @@ sub new { my $self = {}; bless ($self, $class); - unless defined ( $self->table ) { + unless ( defined ( $self->table ) ) { $self->{'Table'} = shift; carp "warning: FS::Record::new called with table name ". $self->{'Table'}; } -- cgit v1.2.1 From 6991d4986df7fb3a6c7c49b5ae1b3713e87a16c4 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 29 Jan 2002 16:33:16 +0000 Subject: - web interface for hourly account charges! (FS::cust_pkg, FS::cust_svc and FS::svc_acct seconds_since methods) - Makefile target to regenerate HTML manpages on install - FS.pm doc update - $FS::Record::Debug now dumps all SQL - new FS::cust_main methods: ->cancel, ->invoicing_list_addpost - start of a billing event web interface - cust_pay::upgrade_replace doesn't error out if history includes overapplied payments --- FS/FS.pm | 53 +++++++++++++++++++++++++++++++++++++---------------- FS/FS/Record.pm | 13 +++++++++---- FS/FS/cust_main.pm | 31 +++++++++++++++++++++++++++++-- FS/FS/cust_pay.pm | 12 +++++++++--- FS/FS/cust_pkg.pm | 28 +++++++++++++++++++++++++++- FS/FS/cust_svc.pm | 51 ++++++++++++++++++++++++++++++++++++++++++--------- FS/FS/svc_acct.pm | 35 ++++++++++++++++++++++++++++++++++- 7 files changed, 187 insertions(+), 36 deletions(-) (limited to 'FS') diff --git a/FS/FS.pm b/FS/FS.pm index ca3330066..60831ecd5 100644 --- a/FS/FS.pm +++ b/FS/FS.pm @@ -14,8 +14,7 @@ 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: +Freeside perl modules and CLI utilities. =head2 Utility classes @@ -25,9 +24,7 @@ L - Freeside configuration option meta-data. 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). +L - Non OO-subroutines for the web interface. =head2 Database record classes @@ -60,6 +57,10 @@ L - Service definition class L - Column constraint class +L - External provisioning export class + +L - Export option class + L - Package (billing item) definition class L - Class linking package (billing item) @@ -87,6 +88,10 @@ L - Invoice class L - Invoice line item class +L - Invoice event definition class + +L - Completed invoice event class + L - Payment class L - Payment application class @@ -113,7 +118,27 @@ L - Job queue L - Job arguments -=head2 User Interface classes (under development; not yet usable) +=head1 Remote API modules + +L + +L + +L + +=head2 Command-line utilities + +L + +L + +L + +L + +L + +=head2 User Interface classes (under (stalled) development; not yet usable) L - User-interface base class @@ -139,17 +164,17 @@ Providers. The Freeside home page is at . -The main documentation is in htdocs/docs. - -=head1 VERSION - -$Id: FS.pm,v 1.10 2001-10-24 15:29:30 ivan Exp $ +The main documentation is in httemplate/docs. =head1 SUPPORT -A mailing list for users and developers is available. Send a blank message to +A mailing list for users is available. Send a blank message to to subscribe. +A mailing list for developers is available. It is intended to be lower volume +and higher SNR than the users list. Send a blank message to + to subscribe. + Commercial support is available; see . @@ -166,10 +191,6 @@ 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... diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 6b7997f21..4286606f0 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -1,7 +1,8 @@ package FS::Record; use strict; -use vars qw($dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK $DEBUG); +use vars qw( $dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK $DEBUG + $me ); use subs qw(reload_dbdef); use Exporter; use Carp qw(carp cluck croak confess); @@ -16,6 +17,7 @@ use FS::SearchCache; @EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef jsearch); $DEBUG = 0; +$me = '[FS::Record]'; #ask FS::UID to run this stuff for us later $FS::UID::callback{'FS::Record'} = sub { @@ -225,7 +227,7 @@ sub qsearch { } $statement .= " $extra_sql" if defined($extra_sql); - warn $statement if $DEBUG; + warn "[debug]$me $statement\n" if $DEBUG; my $sth = $dbh->prepare($statement) or croak "$dbh->errstr doing $statement"; @@ -474,6 +476,7 @@ sub insert { join(', ',map(_quote($self->getfield($_),$self->table,$_), @fields)). ")" ; + warn "[debug]$me $statement\n" if $DEBUG; my $sth = dbh->prepare($statement) or return dbh->errstr; local $SIG{HUP} = 'IGNORE'; @@ -523,6 +526,7 @@ sub delete { ? ( $self->dbdef_table->primary_key) : $self->fields ); + warn "[debug]$me $statement\n" if $DEBUG; my $sth = dbh->prepare($statement) or return dbh->errstr; local $SIG{HUP} = 'IGNORE'; @@ -561,11 +565,11 @@ returns the error, otherwise returns false. sub replace { my ( $new, $old ) = ( shift, shift ); - warn "[debug][FS::Record] $new ->replace $old\n" if $DEBUG; + warn "[debug]$me $new ->replace $old\n" if $DEBUG; my @diff = grep $new->getfield($_) ne $old->getfield($_), $old->fields; unless ( @diff ) { - carp "[warning][FS::Record] $new -> replace $old: records identical"; + carp "[warning]$me $new -> replace $old: records identical"; return ''; } @@ -596,6 +600,7 @@ sub replace { } ( $primary_key ? ( $primary_key ) : $old->fields ) ) ; + warn "[debug]$me $statement\n" if $DEBUG; my $sth = dbh->prepare($statement) or return dbh->errstr; local $SIG{HUP} = 'IGNORE'; diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 1a9d43e94..8a7a6f806 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -831,6 +831,18 @@ sub suspend { grep { $_->suspend } $self->unsuspended_pkgs; } +=item cancel + +Cancels all uncancelled packages (see L) for this customer. +Always returns a list: an empty list on success or a list of errors. + +=cut + +sub cancel { + my $self = shift; + grep { $_->cancel } $self->ncancelled_pkgs; +} + =item bill OPTIONS Generates invoices (see L) for this customer. Usually used in @@ -1722,7 +1734,7 @@ sub check_invoicing_list { =item default_invoicing_list -Returns the email addresses of any +Sets the invoicing list to all accounts associated with this customer. =cut @@ -1740,6 +1752,21 @@ sub default_invoicing_list { $self->invoicing_list(\@list); } +=item invoicing_list_addpost + +Adds postal invoicing to this customer. If this customer is already configured +to receive postal invoices, does nothing. + +=cut + +sub invoicing_list_addpost { + my $self = shift; + return if grep { $_ eq 'POST' } $self->invoicing_list; + my @invoicing_list = $self->invoicing_list; + push @invoicing_list, 'POST'; + $self->invoicing_list(\@invoicing_list); +} + =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ] Returns an array of customers referred by this customer (referral_custnum set @@ -1966,7 +1993,7 @@ sub append_fuzzyfiles { =head1 VERSION -$Id: cust_main.pm,v 1.54 2002-01-09 13:29:33 ivan Exp $ +$Id: cust_main.pm,v 1.55 2002-01-29 16:33:15 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index 3f811357a..51c7b29e1 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -181,11 +181,17 @@ sub upgrade_replace { #1.3.x->1.4.x '_date' => $self->_date, }; $error = $cust_bill_pay->insert; - if ( $error ) { + if ( $error =~ + /total cust_bill_pay.amount and cust_credit_bill.amount .* for invnum .* greater than cust_bill.charged/ ) { + #warn $error; + my $cust_bill = qsearchs( 'cust_bill', { 'invnum' => $self->invnum } ); + $new->custnum($cust_bill->custnum); + } elsif ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; + } else { + $new->custnum($cust_bill_pay->cust_bill->custnum); } - $new->custnum($cust_bill_pay->cust_bill->custnum); } else { die; } @@ -312,7 +318,7 @@ sub unapplied { =head1 VERSION -$Id: cust_pay.pm,v 1.14 2002-01-28 06:57:23 ivan Exp $ +$Id: cust_pay.pm,v 1.15 2002-01-29 16:33:15 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 633b3224f..b241ecac2 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -71,6 +71,8 @@ FS::cust_pkg - Object methods for cust_pkg objects @labels = $record->labels; + $seconds = $record->seconds_since($timestamp); + $error = FS::cust_pkg::order( $custnum, \@pkgparts ); $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] ); @@ -487,6 +489,30 @@ sub cust_main { qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); } +=item seconds_since TIMESTAMP + +Returns the number of seconds all accounts (see L) in this +package have been online since TIMESTAMP. + +TIMESTAMP is specified as a UNIX timestamp; see L. Also see +L and L for conversion functions. + +=cut + +sub seconds_since { + my($self, $since) = @_; + my $seconds = 0; + + foreach my $cust_svc ( + grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc + ) { + $seconds += $cust_svc->seconds_since($since); + } + + $seconds; + +} + =back =head1 SUBROUTINES @@ -630,7 +656,7 @@ sub order { =head1 VERSION -$Id: cust_pkg.pm,v 1.15 2002-01-21 11:30:17 ivan Exp $ +$Id: cust_pkg.pm,v 1.16 2002-01-29 16:33:15 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index 5fca892cd..541f0c801 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -3,7 +3,7 @@ package FS::cust_svc; use strict; use vars qw( @ISA ); use Carp qw( cluck ); -use FS::Record qw( qsearchs ); +use FS::Record qw( qsearchs dbh ); use FS::cust_pkg; use FS::part_pkg; use FS::part_svc; @@ -159,13 +159,8 @@ Returns a list consisting of: sub label { my $self = shift; my $svcdb = $self->part_svc->svcdb; - my $svc_x; - if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) { - $svc_x = $self->{'_svc_acct'}; - } else { - $svc_x = qsearchs( $svcdb, { 'svcnum' => $self->svcnum } ) - or die "can't find $svcdb.svcnum ". $self->svcnum; - } + my $svc_x = $self->svc_x + or die "can't find $svcdb.svcnum ". $self->svcnum; my $tag; if ( $svcdb eq 'svc_acct' ) { $tag = $svc_x->email; @@ -195,11 +190,49 @@ sub label { $self->part_svc->svc, $tag, $svcdb; } +=item svc_x + +Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or +FS::svc_domain object, etc.) + +=cut + +sub svc_x { + my $self = shift; + my $svcdb = $self->part_svc->svcdb; + if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) { + $self->{'_svc_acct'}; + } else { + qsearchs( $svcdb, { 'svcnum' => $self->svcnum } ); + } +} + +=item seconds_since TIMESTAMP + +See L. Equivalent to +$cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records +where B is not "svc_acct". + +=cut + +#note: implementation here, POD in FS::svc_acct +sub seconds_since { + my($self, $since) = @_; + my $dbh = dbh; + my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session + WHERE svcnum = ? + AND login >= ? + AND logout IS NOT NULL' + ) or die $dbh->errstr; + $sth->execute($self->svcnum, $since) or die $sth->errstr; + $sth->fetchrow_arrayref->[0]; +} + =back =head1 VERSION -$Id: cust_svc.pm,v 1.8 2001-12-15 22:58:33 ivan Exp $ +$Id: cust_svc.pm,v 1.9 2002-01-29 16:33:15 ivan Exp $ =head1 BUGS diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 0340e7cc5..16270f9cc 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -134,6 +134,14 @@ FS::svc_acct - Object methods for svc_acct records %hash = $record->radius_check; + $domain = $record->domain; + + $svc_domain = $record->svc_domain; + + $email = $record->email; + + $seconds_since = $record->seconds_since($timestamp); + =head1 DESCRIPTION An FS::svc_acct object represents an account. FS::svc_acct inherits from @@ -990,6 +998,15 @@ sub svc_domain { : qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } ); } +=item cust_svc + +Returns the FS::cust_svc record for this account (see L). + +sub cust_svc { + my $self = shift; + qsearchs( 'cust_svc', { 'svcnum' => $self->svcnum } ); +} + =item email Returns an email address associated with the account. @@ -1001,6 +1018,22 @@ sub email { $self->username. '@'. $self->domain; } +=item seconds_since TIMESTAMP + +Returns the number of seconds this account has been online since TIMESTAMP. +See L + +TIMESTAMP is specified as a UNIX timestamp; see L. Also see +L and L for conversion functions. + +=cut + +#note: POD here, implementation in FS::cust_svc +sub seconds_since { + my $self = shift; + $self->cust_svc->seconds_since(@_); +} + =item ssh =cut @@ -1033,7 +1066,7 @@ sub ssh { =head1 VERSION -$Id: svc_acct.pm,v 1.63 2002-01-22 14:53:26 ivan Exp $ +$Id: svc_acct.pm,v 1.64 2002-01-29 16:33:15 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From c5c0ba135749164ec8ba75d18f76c29625e1bc7e Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 29 Jan 2002 17:42:46 +0000 Subject: weight, plan and plandata fields in part_bill_event --- FS/FS/part_bill_event.pm | 11 +++++++++++ 1 file changed, 11 insertions(+) (limited to 'FS') diff --git a/FS/FS/part_bill_event.pm b/FS/FS/part_bill_event.pm index fb2c06ad4..4a23315dd 100644 --- a/FS/FS/part_bill_event.pm +++ b/FS/FS/part_bill_event.pm @@ -44,6 +44,12 @@ FS::Record. The following fields are currently supported: =item seconds - how long after the invoice date events of this type are triggered +=item weight - ordering for events with identical seconds + +=item plan - eventcode plan + +=item plandata - additional plan data + =item disabled - Disabled flag, empty or `Y' =back @@ -106,12 +112,17 @@ insert and replace methods. sub check { my $self = shift; + $self->weight(0) unless $self->weight; + $self->ut_numbern('eventpart') || $self->ut_enum('payby', [qw( CARD BILL COMP )] ) || $self->ut_text('event') || $self->ut_anything('eventcode') || $self->ut_number('seconds') || $self->ut_enum('disabled', [ '', 'Y' ] ) + || $self->ut_number('weight') + || $self->ut_alphan('plan') + || $self->ut_anything('plandata') ; } -- cgit v1.2.1 From 1fd6d8cf5d7854860ef4fd10ed89828e0c04ec39 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 30 Jan 2002 14:18:09 +0000 Subject: remove use Module; and $cgi = new CGI; &cgisuidsetup(); from all templates. should work better under Mason. --- FS/FS/CGI.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/CGI.pm b/FS/FS/CGI.pm index c66bfe3c2..40932147e 100644 --- a/FS/FS/CGI.pm +++ b/FS/FS/CGI.pm @@ -168,9 +168,9 @@ Returns HTML tag for beginning a table. sub table { my $col = shift; if ( $col ) { - qq!!; + qq!
!; } else { - "
"; + '
'; } } @@ -202,7 +202,7 @@ sub ntable { if ( $col ) { qq!
!; } else { - "
"; + '
'; } } -- cgit v1.2.1 From 8cbba53b09bb5b09355316b7ff8948500c3b4b76 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 4 Feb 2002 16:44:48 +0000 Subject: billing events! --- FS/FS/cust_bill.pm | 370 +++++++++++++++++++++++++++++++++++++++++++++++- FS/FS/cust_main.pm | 402 ++++++++--------------------------------------------- 2 files changed, 426 insertions(+), 346 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 8b326a56f..00135afa1 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -2,8 +2,14 @@ package FS::cust_bill; use strict; use vars qw( @ISA $conf $invoice_template $money_char ); +use vars qw( $lpr $invoice_from $smtpmachine ); +use vars qw( $processor ); +use vars qw( $xaction $E_NoErr ); +use vars qw( $bop_processor $bop_login $bop_password $bop_action @bop_options ); use vars qw( $invoice_lines @buf ); #yuck use Date::Format; +use Mail::Internet; +use Mail::Header; use Text::Template; use FS::Record qw( qsearch qsearchs ); use FS::cust_main; @@ -12,6 +18,7 @@ use FS::cust_credit; use FS::cust_pay; use FS::cust_pkg; use FS::cust_credit_bill; +use FS::cust_pay_batch; @ISA = qw( FS::Record ); @@ -36,6 +43,44 @@ $FS::UID::callback{'FS::cust_bill'} = sub { ) or die "can't create new Text::Template object: $Text::Template::ERROR"; $invoice_template->compile() or die "can't compile template: $Text::Template::ERROR"; + + $lpr = $conf->config('lpr'); + $invoice_from = $conf->config('invoice_from'); + $smtpmachine = $conf->config('smtpmachine'); + + if ( $conf->exists('cybercash3.2') ) { + require CCMckLib3_2; + #qw($MCKversion %Config InitConfig CCError CCDebug CCDebug2); + require CCMckDirectLib3_2; + #qw(SendCC2_1Server); + require CCMckErrno3_2; + #qw(MCKGetErrorMessage $E_NoErr); + import CCMckErrno3_2 qw($E_NoErr); + + my $merchant_conf; + ($merchant_conf,$xaction)= $conf->config('cybercash3.2'); + my $status = &CCMckLib3_2::InitConfig($merchant_conf); + if ( $status != $E_NoErr ) { + warn "CCMckLib3_2::InitConfig error:\n"; + foreach my $key (keys %CCMckLib3_2::Config) { + warn " $key => $CCMckLib3_2::Config{$key}\n" + } + my($errmsg) = &CCMckErrno3_2::MCKGetErrorMessage($status); + die "CCMckLib3_2::InitConfig fatal error: $errmsg\n"; + } + $processor='cybercash3.2'; + } elsif ( $conf->exists('business-onlinepayment') ) { + ( $bop_processor, + $bop_login, + $bop_password, + $bop_action, + @bop_options + ) = $conf->config('business-onlinepayment'); + $bop_action ||= 'normal authorization'; + eval "use Business::OnlinePayment"; + $processor="Business::OnlinePayment::$bop_processor"; + } + }; =head1 NAME @@ -88,8 +133,7 @@ L and L for conversion functions. =item charged - amount of this invoice -=item printed - how many times this invoice has been printed automatically -(see L). +=item printed - deprecated =item closed - books closed flag, empty or `Y' @@ -207,6 +251,17 @@ sub cust_bill_pkg { qsearch( 'cust_bill_pkg', { 'invnum' => $self->invnum } ); } +=item cust_main + +Returns the customer (see L) for this invoice. + +=cut + +sub cust_main { + my $self = shift; + qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); +} + =item cust_credit Depreciated. See the cust_credited method. @@ -306,6 +361,315 @@ sub owed { $balance; } +=item send + +Sends this invoice to the destinations configured for this customer: send +emails or print. See L. + +=cut + +sub send { + my $self = shift; + + #my @print_text = $cust_bill->print_text; #( date ) + my @invoicing_list = $self->cust_main->invoicing_list; + if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice + $ENV{SMTPHOSTS} = $smtpmachine; + $ENV{MAILADDRESS} = $invoice_from; + my $header = new Mail::Header ( [ + "From: $invoice_from", + "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ), + "Sender: $invoice_from", + "Reply-To: $invoice_from", + "Date: ". time2str("%a, %d %b %Y %X %z", time), + "Subject: Invoice", + ] ); + my $message = new Mail::Internet ( + 'Header' => $header, + 'Body' => [ $self->print_text ], #( date) + ); + $message->smtpsend + or return "Can't send invoice email to server $smtpmachine!"; + + #} elsif ( grep { $_ eq 'POST' } @invoicing_list ) { + } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) { + open(LPR, "|$lpr") + or return "Can't open pipe to $lpr: $!"; + print LPR $self->print_text; #( date ) + close LPR + or return $! ? "Error closing $lpr: $!" + : "Exit status $? from $lpr"; + } + + ''; + +} + +=item comp + +Pays this invoice with a compliemntary payment. If there is an error, +returns the error, otherwise returns false. + +=cut + +sub comp { + my $self = shift; + my $cust_pay = new FS::cust_pay ( { + 'invnum' => $self->invnum, + 'paid' => $self->owed, + '_date' => '', + 'payby' => 'COMP', + 'payinfo' => $self->cust_main->payinfo, + 'paybatch' => '', + } ); + $cust_pay->insert; +} + +=item realtime_card + +Attempts to pay this invoice with a Business::OnlinePayment realtime gateway. +See http://search.cpan.org/search?mode=module&query=Business%3A%3AOnlinePayment +for supproted processors. + +=cut + +sub realtime_card { + my $self = shift; + my $cust_main = $self->cust_main; + my $amount = $self->owed; + + unless ( $processor =~ /^Business::OnlinePayment::(.*)$/ ) { + return "Real-time card processing not enabled (processor $processor)"; + } + my $bop_processor = $1; #hmm? + + my $address = $cust_main->address1; + $address .= ", ". $cust_main->address2 if $cust_main->address2; + + #fix exp. date + #$cust_main->paydate =~ /^(\d+)\/\d*(\d{2})$/; + $cust_main->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; + my $exp = "$2/$1"; + + my($payname, $payfirst, $paylast); + if ( $cust_main->payname ) { + $payname = $cust_main->payname; + $payname =~ /^\s*([\w \,\.\-\']*\w)?\s+([\w\,\.\-\']+)$/ + or do { + #$dbh->rollback if $oldAutoCommit; + return "Illegal payname $payname"; + }; + ($payfirst, $paylast) = ($1, $2); + } else { + $payfirst = $cust_main->getfield('first'); + $paylast = $cust_main->getfield('first'); + $payname = "$payfirst $paylast"; + } + + my @invoicing_list = grep { $_ ne 'POST' } $cust_main->invoicing_list; + if ( $conf->exists('emailinvoiceauto') + || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) { + push @invoicing_list, $cust_main->default_invoicing_list; + } + my $email = $invoicing_list[0]; + + my( $action1, $action2 ) = split(/\s*\,\s*/, $bop_action ); + + my $transaction = + new Business::OnlinePayment( $bop_processor, @bop_options ); + $transaction->content( + 'type' => 'CC', + 'login' => $bop_login, + 'password' => $bop_password, + 'action' => $action1, + 'description' => 'Internet Services', + 'amount' => $amount, + 'invoice_number' => $self->invnum, + 'customer_id' => $self->custnum, + 'last_name' => $paylast, + 'first_name' => $payfirst, + 'name' => $payname, + 'address' => $address, + 'city' => $cust_main->city, + 'state' => $cust_main->state, + 'zip' => $cust_main->zip, + 'country' => $cust_main->country, + 'card_number' => $cust_main->payinfo, + 'expiration' => $exp, + 'referer' => 'http://cleanwhisker.420.am/', + 'email' => $email, + ); + $transaction->submit(); + + if ( $transaction->is_success() && $action2 ) { + my $auth = $transaction->authorization; + my $ordernum = $transaction->order_number; + #warn "********* $auth ***********\n"; + #warn "********* $ordernum ***********\n"; + my $capture = + new Business::OnlinePayment( $bop_processor, @bop_options ); + + $capture->content( + action => $action2, + login => $bop_login, + password => $bop_password, + order_number => $ordernum, + amount => $amount, + authorization => $auth, + description => 'Internet Services', + ); + + $capture->submit(); + + unless ( $capture->is_success ) { + my $e = "Authorization sucessful but capture failed, invnum #". + $self->invnum. ': '. $capture->result_code. + ": ". $capture->error_message; + warn $e; + return $e; + } + + } + + if ( $transaction->is_success() ) { + + my $cust_pay = new FS::cust_pay ( { + 'invnum' => $self->invnum, + 'paid' => $amount, + '_date' => '', + 'payby' => 'CARD', + 'payinfo' => $cust_main->payinfo, + 'paybatch' => "$processor:". $transaction->authorization, + } ); + my $error = $cust_pay->insert; + if ( $error ) { + # gah, even with transactions. + my $e = 'WARNING: Card debited but database not updated - '. + 'error applying payment, invnum #' . $self->invnum. + " ($processor): $error"; + warn $e; + return $e; + } else { + return ''; + } + #} elsif ( $options{'report_badcard'} ) { + } else { + return "$processor error, invnum #". $self->invnum. ': '. + $transaction->result_code. ": ". $transaction->error_message; + } + +} + +=item realtime_card_cybercash + +Attempts to pay this invoice with the CyberCash CashRegister realtime gateway. + +=cut + +sub realtime_card_cybercash { + my $self = shift; + my $cust_main = $self->cust_main; + my $amount = $self->owed; + + return "CyberCash CashRegister real-time card processing not enabled!" + unless $processor eq 'cybercash3.2'; + + my $address = $cust_main->address1; + $address .= ", ". $cust_main->address2 if $cust_main->address2; + + #fix exp. date + #$cust_main->paydate =~ /^(\d+)\/\d*(\d{2})$/; + $cust_main->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; + my $exp = "$2/$1"; + + # + + my $paybatch = $self->invnum. + '-' . time2str("%y%m%d%H%M%S", time); + + my $payname = $cust_main->payname || + $cust_main->getfield('first').' '.$cust_main->getfield('last'); + + my $country = $cust_main->country eq 'US' ? 'USA' : $cust_main->country; + + my @full_xaction = ( $xaction, + 'Order-ID' => $paybatch, + 'Amount' => "usd $amount", + 'Card-Number' => $cust_main->getfield('payinfo'), + 'Card-Name' => $payname, + 'Card-Address' => $address, + 'Card-City' => $cust_main->getfield('city'), + 'Card-State' => $cust_main->getfield('state'), + 'Card-Zip' => $cust_main->getfield('zip'), + 'Card-Country' => $country, + 'Card-Exp' => $exp, + ); + + my %result; + %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction); + + if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3 + my $cust_pay = new FS::cust_pay ( { + 'invnum' => $self->invnum, + 'paid' => $amount, + '_date' => '', + 'payby' => 'CARD', + 'payinfo' => $cust_main->payinfo, + 'paybatch' => "$processor:$paybatch", + } ); + my $error = $cust_pay->insert; + if ( $error ) { + # gah, even with transactions. + my $e = 'WARNING: Card debited but database not updated - '. + 'error applying payment, invnum #' . $self->invnum. + " (CyberCash Order-ID $paybatch): $error"; + warn $e; + return $e; + } else { + return ''; + } +# } elsif ( $result{'Mstatus'} ne 'failure-bad-money' +# || $options{'report_badcard'} +# ) { + } else { + return 'Cybercash error, invnum #' . + $self->invnum. ':'. $result{'MErrMsg'}; + } + +} + +=item batch_card + +Adds a payment for this invoice to the pending credit card batch (see +L). + +=cut + +sub batch_card { + my $self = shift; + my $cust_main = $self->cust_main; + + my $cust_pay_batch = new FS::cust_pay_batch ( { + 'invnum' => $self->getfield('invnum'), + 'custnum' => $cust_main->getfield('custnum'), + 'last' => $cust_main->getfield('last'), + 'first' => $cust_main->getfield('first'), + 'address1' => $cust_main->getfield('address1'), + 'address2' => $cust_main->getfield('address2'), + 'city' => $cust_main->getfield('city'), + 'state' => $cust_main->getfield('state'), + 'zip' => $cust_main->getfield('zip'), + 'country' => $cust_main->getfield('country'), + 'trancode' => 77, + 'cardnum' => $cust_main->getfield('payinfo'), + 'exp' => $cust_main->getfield('paydate'), + 'payname' => $cust_main->getfield('payname'), + 'amount' => $self->owed, + } ); + $cust_pay_batch->insert; + +} + =item print_text [TIME]; Returns an text invoice, as a list of lines. @@ -500,7 +864,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.15 2002-01-28 06:57:23 ivan Exp $ +$Id: cust_bill.pm,v 1.16 2002-02-04 16:44:48 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 8a7a6f806..62f61a689 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1,16 +1,12 @@ package FS::cust_main; use strict; -use vars qw( @ISA $conf $lpr $processor $xaction $E_NoErr $invoice_from - $smtpmachine $Debug $bop_processor $bop_login $bop_password - $bop_action @bop_options $import ); +use vars qw( @ISA $conf $Debug $import ); use Safe; use Carp; use Time::Local; use Date::Format; #use Date::Manip; -use Mail::Internet; -use Mail::Header; use Business::CreditCard; use FS::UID qw( getotaker dbh ); use FS::Record qw( qsearchs qsearch dbdef ); @@ -19,7 +15,6 @@ use FS::cust_bill; use FS::cust_bill_pkg; use FS::cust_pay; use FS::cust_credit; -use FS::cust_pay_batch; use FS::part_referral; use FS::cust_main_county; use FS::agent; @@ -29,6 +24,8 @@ use FS::cust_bill_pay; use FS::prepay_credit; use FS::queue; use FS::part_pkg; +use FS::part_bill_event; +use FS::cust_bill_event; @ISA = qw( FS::Record ); @@ -40,42 +37,7 @@ $import = 0; #ask FS::UID to run this stuff for us later $FS::UID::callback{'FS::cust_main'} = sub { $conf = new FS::Conf; - $lpr = $conf->config('lpr'); - $invoice_from = $conf->config('invoice_from'); - $smtpmachine = $conf->config('smtpmachine'); - - if ( $conf->exists('cybercash3.2') ) { - require CCMckLib3_2; - #qw($MCKversion %Config InitConfig CCError CCDebug CCDebug2); - require CCMckDirectLib3_2; - #qw(SendCC2_1Server); - require CCMckErrno3_2; - #qw(MCKGetErrorMessage $E_NoErr); - import CCMckErrno3_2 qw($E_NoErr); - - my $merchant_conf; - ($merchant_conf,$xaction)= $conf->config('cybercash3.2'); - my $status = &CCMckLib3_2::InitConfig($merchant_conf); - if ( $status != $E_NoErr ) { - warn "CCMckLib3_2::InitConfig error:\n"; - foreach my $key (keys %CCMckLib3_2::Config) { - warn " $key => $CCMckLib3_2::Config{$key}\n" - } - my($errmsg) = &CCMckErrno3_2::MCKGetErrorMessage($status); - die "CCMckLib3_2::InitConfig fatal error: $errmsg\n"; - } - $processor='cybercash3.2'; - } elsif ( $conf->exists('business-onlinepayment') ) { - ( $bop_processor, - $bop_login, - $bop_password, - $bop_action, - @bop_options - ) = $conf->config('business-onlinepayment'); - $bop_action ||= 'normal authorization'; - eval "use Business::OnlinePayment"; - $processor="Business::OnlinePayment::$bop_processor"; - } + #yes, need it for stuff below (prolly should be cached) }; sub _cache { @@ -385,7 +347,8 @@ will be deleted. Did I mention that this is NOT what you want when a customer cancels service and that you really should be looking see L? You can't delete a customer with invoices (see L), -or credits (see L) or payments (see L). +or credits (see L), payments (see L) or +refunds (see L). =cut @@ -415,6 +378,10 @@ sub delete { $dbh->rollback if $oldAutoCommit; return "Can't delete a customer with payments"; } + if ( qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) ) { + $dbh->rollback if $oldAutoCommit; + return "Can't delete a customer with refunds"; + } my @cust_pkg = $self->ncancelled_pkgs; if ( @cust_pkg ) { @@ -443,7 +410,7 @@ sub delete { } } - foreach my $cust_main_invoice ( + foreach my $cust_main_invoice ( #(email invoice destinations, not invoices) qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } ) ) { my $error = $cust_main_invoice->delete; @@ -1082,6 +1049,9 @@ 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'). +Most actions are now triggered by invoice events; see L +and the invoice events web interface. + If there is an error, returns the error, otherwise returns false. Options are passed as name-value pairs. @@ -1092,15 +1062,12 @@ 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. +batch_card - This option is deprecated. See the invoice events web interface +to control whether cards are batched or run against a realtime gateway. -report_badcard - Set this true if you want bad card transactions to -return an error. By default, they don't. +report_badcard - This option is deprecated. -force_print - force printing even if invoice has been printed more than once -every 30 days, and don't increment the `printed' field. +force_print - This option is deprecated; see the invoice events web interface. =cut @@ -1141,306 +1108,62 @@ sub collect { next unless $cust_bill->owed > 0; # don't try to charge for the same invoice if it's already in a batch - next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } ); + #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } ); warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug; next unless $amount > 0; - if ( $self->payby eq 'BILL' ) { - - #30 days 2592000 - my $since = $invoice_time - ( $cust_bill->_date || 0 ); - #warn "$invoice_time ", $cust_bill->_date, " $since"; - if ( $since >= 0 #don't print future invoices - && ( ( $cust_bill->printed * 2592000 ) <= $since - || $options{'force_print'} ) - ) { - - #my @print_text = $cust_bill->print_text; #( date ) - my @invoicing_list = $self->invoicing_list; - if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice - $ENV{SMTPHOSTS} = $smtpmachine; - $ENV{MAILADDRESS} = $invoice_from; - my $header = new Mail::Header ( [ - "From: $invoice_from", - "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ), - "Sender: $invoice_from", - "Reply-To: $invoice_from", - "Date: ". time2str("%a, %d %b %Y %X %z", time), - "Subject: Invoice", - ] ); - my $message = new Mail::Internet ( - 'Header' => $header, - 'Body' => [ $cust_bill->print_text ], #( date) - ); - $message->smtpsend or die "Can't send invoice email!"; #die? warn? - - } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) { - open(LPR, "|$lpr") or die "Can't open pipe to $lpr: $!"; - print LPR $cust_bill->print_text; #( date ) - close LPR - or die $! ? "Error closing $lpr: $!" - : "Exit status $? from $lpr"; - } - - unless ( $options{'force_print'} ) { - my %hash = $cust_bill->hash; - $hash{'printed'}++; - my $new_cust_bill = new FS::cust_bill(\%hash); - my $error = $new_cust_bill->replace($cust_bill); - warn "Error updating $cust_bill->printed: $error" if $error; - } - - } + foreach my $part_bill_event ( + sort { $a->seconds <=> $b->seconds + || $a->weight <=> $b->weight + || $a->eventpart <=> $b->eventpart } + grep { $_->seconds > ( $invoice_time - ( $cust_bill->_date || 0 ) ) + && ! qsearchs( 'cust_bill_event', { + 'invnum' => $cust_bill->invnum, + 'eventpart' => $_->eventpart } ) + } + qsearch('part_bill_event', { 'payby' => $self->payby, + 'disabled' => '', } ) + ) { + #run callback + my $cust_main = $self; #for callback + my $error = eval $part_bill_event->eventcode; - } elsif ( $self->payby eq 'COMP' ) { - my $cust_pay = new FS::cust_pay ( { - 'invnum' => $cust_bill->invnum, - 'paid' => $amount, - '_date' => '', - 'payby' => 'COMP', - 'payinfo' => $self->payinfo, - 'paybatch' => '' - } ); - my $error = $cust_pay->insert; if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return 'Error COMPing invnum #'. $cust_bill->invnum. ": $error"; - } - - } elsif ( $self->payby eq 'CARD' ) { + warn "Error running invoice event (". $part_bill_event->eventcode. + "): $error"; - if ( $options{'batch_card'} ne 'yes' ) { + } else { - unless ( $processor ) { - $dbh->rollback if $oldAutoCommit; - return "Real time card processing not enabled!"; - } - - my $address = $self->address1; - $address .= ", ". $self->address2 if $self->address2; - - #fix exp. date - #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/; - $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; - my $exp = "$2/$1"; - - if ( $processor eq 'cybercash3.2' ) { - - #fix exp. date for cybercash - #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/; - $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; - my $exp = "$2/$1"; - - my $paybatch = $cust_bill->invnum. - '-' . time2str("%y%m%d%H%M%S", time); - - my $payname = $self->payname || - $self->getfield('first'). ' '. $self->getfield('last'); - - - my $country = $self->country eq 'US' ? 'USA' : $self->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; - %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction); - - #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3 - #if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1 - if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3 - my $cust_pay = new FS::cust_pay ( { - 'invnum' => $cust_bill->invnum, - 'paid' => $amount, - '_date' => '', - 'payby' => 'CARD', - 'payinfo' => $self->payinfo, - 'paybatch' => "$processor:$paybatch", - } ); - my $error = $cust_pay->insert; - if ( $error ) { - # gah, even with transactions. - $dbh->commit if $oldAutoCommit; #well. - my $e = 'WARNING: Card debited but database not updated - '. - 'error applying payment, invnum #' . $cust_bill->invnum. - " (CyberCash Order-ID $paybatch): $error"; - warn $e; - return $e; - } - } elsif ( $result{'Mstatus'} ne 'failure-bad-money' - || $options{'report_badcard'} ) { - $dbh->commit if $oldAutoCommit; - return 'Cybercash error, invnum #' . - $cust_bill->invnum. ':'. $result{'MErrMsg'}; - } else { - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - return ''; - } - - } elsif ( $processor =~ /^Business::OnlinePayment::(.*)$/ ) { - - my $bop_processor = $1; - - my($payname, $payfirst, $paylast); - if ( $self->payname ) { - $payname = $self->payname; - $payname =~ /^\s*([\w \,\.\-\']*\w)?\s+([\w\,\.\-\']+)$/ - or do { - $dbh->rollback if $oldAutoCommit; - return "Illegal payname $payname"; - }; - ($payfirst, $paylast) = ($1, $2); - } else { - $payfirst = $self->getfield('first'); - $paylast = $self->getfield('first'); - $payname = "$payfirst $paylast"; - } - - my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list; - if ( $conf->exists('emailinvoiceauto') - || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) { - push @invoicing_list, $self->default_invoicing_list; - } - my $email = $invoicing_list[0]; - - my( $action1, $action2 ) = split(/\s*\,\s*/, $bop_action ); - - my $transaction = - new Business::OnlinePayment( $bop_processor, @bop_options ); - $transaction->content( - 'type' => 'CC', - 'login' => $bop_login, - 'password' => $bop_password, - 'action' => $action1, - 'description' => 'Internet Services', - 'amount' => $amount, - 'invoice_number' => $cust_bill->invnum, - 'customer_id' => $self->custnum, - 'last_name' => $paylast, - 'first_name' => $payfirst, - 'name' => $payname, - 'address' => $address, - 'city' => $self->city, - 'state' => $self->state, - 'zip' => $self->zip, - 'country' => $self->country, - 'card_number' => $self->payinfo, - 'expiration' => $exp, - 'referer' => 'http://cleanwhisker.420.am/', - 'email' => $email, - ); - $transaction->submit(); - - if ( $transaction->is_success() && $action2 ) { - my $auth = $transaction->authorization; - my $ordernum = $transaction->order_number; - #warn "********* $auth ***********\n"; - #warn "********* $ordernum ***********\n"; - my $capture = - new Business::OnlinePayment( $bop_processor, @bop_options ); - - $capture->content( - action => $action2, - login => $bop_login, - password => $bop_password, - order_number => $ordernum, - amount => $amount, - authorization => $auth, - description => 'Internet Services', - ); - - $capture->submit(); - - unless ( $capture->is_success ) { - my $e = "Authorization sucessful but capture failed, invnum #". - $cust_bill->invnum. ': '. $capture->result_code. - ": ". $capture->error_message; - warn $e; - return $e; - } - - } - - if ( $transaction->is_success() ) { - - my $cust_pay = new FS::cust_pay ( { - 'invnum' => $cust_bill->invnum, - 'paid' => $amount, - '_date' => '', - 'payby' => 'CARD', - 'payinfo' => $self->payinfo, - 'paybatch' => "$processor:". $transaction->authorization, - } ); - my $error = $cust_pay->insert; - if ( $error ) { - # gah, even with transactions. - $dbh->commit if $oldAutoCommit; #well. - my $e = 'WARNING: Card debited but database not updated - '. - 'error applying payment, invnum #' . $cust_bill->invnum. - " ($processor): $error"; - warn $e; - return $e; - } - } elsif ( $options{'report_badcard'} ) { - $dbh->commit if $oldAutoCommit; - return "$processor error, invnum #". $cust_bill->invnum. ': '. - $transaction->result_code. ": ". $transaction->error_message; - } else { - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - #return ''; - } - - } else { - $dbh->rollback if $oldAutoCommit; - return "Unknown real-time processor $processor\n"; + #add cust_bill_event + my $cust_bill_event = new FS::cust_bill_event { + 'invnum' => $cust_bill->invnum, + 'eventpart' => $part_bill_event->eventpart, + '_date' => $invoice_time, + }; + $cust_bill_event->insert; + if ( $error ) { + #$dbh->rollback if $oldAutoCommit; + #return "error: $error"; + + # gah, even with transactions. + $dbh->commit if $oldAutoCommit; #well. + my $e = 'WARNING: Event run but database not updated - '. + 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum. + ', eventpart '. $part_bill_event->eventpart. + ": $error"; + warn $e; + return $e; } - } else { #batch card - - my $cust_pay_batch = new FS::cust_pay_batch ( { - 'invnum' => $cust_bill->getfield('invnum'), - 'custnum' => $self->getfield('custnum'), - 'last' => $self->getfield('last'), - 'first' => $self->getfield('first'), - 'address1' => $self->getfield('address1'), - 'address2' => $self->getfield('address2'), - 'city' => $self->getfield('city'), - 'state' => $self->getfield('state'), - 'zip' => $self->getfield('zip'), - 'country' => $self->getfield('country'), - 'trancode' => 77, - 'cardnum' => $self->getfield('payinfo'), - 'exp' => $self->getfield('paydate'), - 'payname' => $self->getfield('payname'), - 'amount' => $amount, - } ); - my $error = $cust_pay_batch->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Error adding to cust_pay_batch: $error"; - } - } - } else { - $dbh->rollback if $oldAutoCommit; - return "Unknown payment type ". $self->payby; } } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -1991,10 +1714,6 @@ sub append_fuzzyfiles { 1; } -=head1 VERSION - -$Id: cust_main.pm,v 1.55 2002-01-29 16:33:15 ivan Exp $ - =head1 BUGS The delete method. @@ -2005,8 +1724,6 @@ 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. @@ -2015,9 +1732,8 @@ No multiple currency support (probably a larger project than just this module). =head1 SEE ALSO L, L, L, L -L, L, L, -L, L, -L, schema.html from the base documentation. +L, L, L, +L, L, schema.html from the base documentation. =cut -- cgit v1.2.1 From b6c28c086832416944440cab39f3bffc9d3dd1f1 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 5 Feb 2002 20:25:32 +0000 Subject: better error messages if you haven't run fs-setup ? --- FS/FS/Record.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 4286606f0..755cef830 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -1014,7 +1014,8 @@ I<$FS::Record::setup_hack> is true. Returns a DBIx::DBSchema object. sub reload_dbdef { my $file = shift || $dbdef_file; - $dbdef = load DBIx::DBSchema $file; + $dbdef = load DBIx::DBSchema $file + or die "can't load database schema from $file"; } =item dbdef -- cgit v1.2.1 From 0144506246df56f2f705d4edc3cf29cd7dd0ed24 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 6 Feb 2002 14:58:05 +0000 Subject: fix for non-file auth --- FS/bin/freeside-adduser | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-adduser b/FS/bin/freeside-adduser index 7fc5830db..9d424634b 100644 --- a/FS/bin/freeside-adduser +++ b/FS/bin/freeside-adduser @@ -1,6 +1,6 @@ #!/usr/bin/perl -w # -# $Id: freeside-adduser,v 1.3 2001-10-30 13:47:07 ivan Exp $ +# $Id: freeside-adduser,v 1.4 2002-02-06 14:58:05 ivan Exp $ use strict; use vars qw($opt_h $opt_c $opt_s); @@ -12,10 +12,12 @@ getopts("ch:s:"); die &usage if $opt_c && ! $opt_h; my $user = shift or die &usage; -my @args = ( 'htpasswd' ); -push @args, '-c' if $opt_c; -push @args, $opt_h, $user; -system(@args) == 0 or die "htpasswd failed: $?"; +if ( $opt_h ) { + my @args = ( 'htpasswd' ); + push @args, '-c' if $opt_c; + push @args, $opt_h, $user; + system(@args) == 0 or die "htpasswd failed: $?"; +} my $secretfile = $opt_s || 'secrets'; -- cgit v1.2.1 From e647329a15ecae064a3242f05f948658aeab9256 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 6 Feb 2002 15:36:40 +0000 Subject: part_bill_event.plan can contain punctuation --- FS/FS/part_bill_event.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_bill_event.pm b/FS/FS/part_bill_event.pm index 4a23315dd..fb1daa20b 100644 --- a/FS/FS/part_bill_event.pm +++ b/FS/FS/part_bill_event.pm @@ -121,7 +121,7 @@ sub check { || $self->ut_number('seconds') || $self->ut_enum('disabled', [ '', 'Y' ] ) || $self->ut_number('weight') - || $self->ut_alphan('plan') + || $self->ut_textn('plan') || $self->ut_anything('plandata') ; } -- cgit v1.2.1 From b9940d4c9565a0e399b156d527f7426fe1cd098b Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 6 Feb 2002 15:50:54 +0000 Subject: pod typo --- FS/FS/cust_bill.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 00135afa1..ad2ae82d1 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -864,7 +864,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.16 2002-02-04 16:44:48 ivan Exp $ +$Id: cust_bill.pm,v 1.17 2002-02-06 15:50:54 ivan Exp $ =head1 BUGS @@ -878,7 +878,7 @@ or something similar so the look can be completely customized?) =head1 SEE ALSO -L, L, L, L, +L, L, L, L, L, L, schema.html from the base documentation. -- cgit v1.2.1 From 88d4198ff452581be05e3018b3e23db564545525 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 6 Feb 2002 15:55:47 +0000 Subject: doc updates and pod2x fix to skip blib/ files --- FS/FS/cust_main.pm | 2 ++ 1 file changed, 2 insertions(+) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 62f61a689..94fd97f39 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1714,6 +1714,8 @@ sub append_fuzzyfiles { 1; } +=back + =head1 BUGS The delete method. -- cgit v1.2.1 From 69c6e80a7253f927af1780a3e0dd3fcf50110599 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 7 Feb 2002 22:29:35 +0000 Subject: delete payments --- FS/FS/Conf.pm | 7 +++++++ FS/FS/cust_bill_pay.pm | 10 +++++++--- FS/FS/cust_pay.pm | 36 +++++++++++++++++++++++++++++++++--- 3 files changed, 47 insertions(+), 6 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index cc91e8292..873ee75a9 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -267,6 +267,13 @@ httemplate/docs/config.html 'type' => 'checkbox', }, + { + 'key' => 'deletepayments', + 'section' => 'UI', + 'description' => 'Enable deletion of unclosed payments. Be very careful! Only delete payments that were data-entry errors, not adjustments.', + 'type' => 'checkbox', + }, + { 'key' => 'dirhash', 'section' => 'shell', diff --git a/FS/FS/cust_bill_pay.pm b/FS/FS/cust_bill_pay.pm index 1c838b932..913704bef 100644 --- a/FS/FS/cust_bill_pay.pm +++ b/FS/FS/cust_bill_pay.pm @@ -125,12 +125,16 @@ sub insert { =item delete -Currently unimplemented (accounting reasons). +Deletes this payment application, unless the closed flag for the parent payment +(see L) is set. =cut sub delete { - return "Can't (yet?) delete cust_bill_pay records!"; + my $self = shift; + return "Can't delete application for closed payment" + if $self->cust_pay->closed =~ /^Y/i; + $self->SUPER::delete(@_); } =item replace OLD_RECORD @@ -195,7 +199,7 @@ sub cust_bill { =head1 VERSION -$Id: cust_bill_pay.pm,v 1.11 2002-01-24 16:58:47 ivan Exp $ +$Id: cust_bill_pay.pm,v 1.12 2002-02-07 22:29:34 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index 51c7b29e1..839571a95 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -211,14 +211,44 @@ sub upgrade_replace { #1.3.x->1.4.x =item delete -Currently unimplemented (accounting reasons). +Deletes this payment and all associated applications (see L), +unless the closed flag is set. =cut sub delete { my $self = shift; return "Can't delete closed payment" if $self->closed =~ /^Y/i; - $self->SUPER::delete(@_); + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + foreach my $cust_bill_pay ( $self->cust_bill_pay ) { + my $error = $cust_bill_pay->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + my $error = $self->SUPER::delete(@_); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; + } =item replace OLD_RECORD @@ -318,7 +348,7 @@ sub unapplied { =head1 VERSION -$Id: cust_pay.pm,v 1.15 2002-01-29 16:33:15 ivan Exp $ +$Id: cust_pay.pm,v 1.16 2002-02-07 22:29:34 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 5bb9eff0716710611f50071bec6167b4514edb48 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 9 Feb 2002 17:03:55 +0000 Subject: okay, both Apache::ASP and Mason should set no-cache headers now (closes: Bug#23) --- FS/FS/CGI.pm | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) (limited to 'FS') diff --git a/FS/FS/CGI.pm b/FS/FS/CGI.pm index 40932147e..d1c56a254 100644 --- a/FS/FS/CGI.pm +++ b/FS/FS/CGI.pm @@ -12,10 +12,6 @@ use FS::UID; @EXPORT_OK = qw(header menubar idiot eidiot popurl table itable ntable small_custview); -@header = ( '-Expires' => '-1', - '-Pragma' => 'no-cache', - '-Cache-Control' => 'no-cache' ); - =head1 NAME FS::CGI - Subroutines for the web interface @@ -58,6 +54,9 @@ sub header { $title + + + @@ -88,24 +87,27 @@ sub menubar { #$menubar=menubar('Main Menu', '../', 'Item', 'url', ... ); This is depriciated. Don't use it. -Sends headers and an HTML error message. +Sends an HTML error message. =cut sub idiot { #warn "idiot depriciated"; my($error)=@_; - my $cgi = &FS::UID::cgi(); +# my $cgi = &FS::UID::cgi(); # if ( $cgi->isa('CGI::Base') ) { # no strict 'subs'; # &CGI::Base::SendHeaders; # } else { - print $cgi->header( @FS::CGI::header ); +# print $cgi->header( @FS::CGI::header ); # } print < Error processing your request + + +
@@ -123,7 +125,7 @@ END This is depriciated. Don't use it. -Sends headers and an HTML error message, then exits. +Sends an HTML error message, then exits. =cut -- cgit v1.2.1 From 4c18a45810f000bb013d23d4738cfca012794c4b Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 9 Feb 2002 17:45:26 +0000 Subject: have FS::cust_svc::check look up & check pkg_svc.quantity like httemplate/view/cust_pkg.cgi (closes: Bug#43) --- FS/FS/cust_svc.pm | 27 ++++++++++++++++++++------- 1 file changed, 20 insertions(+), 7 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index 541f0c801..a81e3bb32 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -7,6 +7,7 @@ use FS::Record qw( qsearchs dbh ); use FS::cust_pkg; use FS::part_pkg; use FS::part_svc; +use FS::pkg_svc; use FS::svc_acct; use FS::svc_acct_sm; use FS::svc_domain; @@ -111,12 +112,24 @@ sub check { ; return $error if $error; - return "Unknown pkgnum" - unless ! $self->pkgnum - || qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } ); - - return "Unknown svcpart" unless - qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); + my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); + return "Unknown svcpart" unless $part_svc; + + if ( $self->pkgnum ) { + my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } ); + return "Unknown pkgnum" unless $cust_pkg; + my $pkg_svc = qsearchs( 'pkg_svc', { + 'pkgpart' => $cust_pkg->pkgpart, + 'svcpart' => $self->svcpart, + }); + my @cust_svc = qsearch('cust_svc', { + 'pkgnum' => $self->pkgnum, + 'svcpart' => $self->svcpart, + }); + return "Already ". scalar(@cust_svc). " ". $part_svc->svc. + " services for pkgnum ". $self->pkgnum + if $pkg_svc->quantity >= scalar(@cust_svc); + } ''; #no error } @@ -232,7 +245,7 @@ sub seconds_since { =head1 VERSION -$Id: cust_svc.pm,v 1.9 2002-01-29 16:33:15 ivan Exp $ +$Id: cust_svc.pm,v 1.10 2002-02-09 17:45:26 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 4609bb519b7fdf0eace6523fee49752cdb82a1ef Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 9 Feb 2002 18:09:30 +0000 Subject: okay all external export from .pm files is queued! (closes: Bug#249) --- FS/FS/svc_domain.pm | 41 ++++++++++++++++++++++++++++++++++++++--- 1 file changed, 38 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm index bc62ea7bc..d0f0e11a8 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -10,7 +10,7 @@ use Mail::Internet; use Mail::Header; use Date::Format; use Net::Whois 1.0; -use Net::SSH qw(ssh); +use Net::SSH; use FS::Record qw(fields qsearch qsearchs dbh); use FS::Conf; use FS::svc_Common; @@ -19,6 +19,7 @@ use FS::svc_acct; use FS::cust_pkg; use FS::cust_main; use FS::domain_record; +use FS::queue; @ISA = qw( FS::svc_Common ); @@ -228,6 +229,7 @@ sub insert { $dbh->commit or die $dbh->errstr if $oldAutoCommit; if ( $qshellmachine && $self->catchall && ! $nossh_hack ) { + my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $self->catchall } ) or warn "WARNING: inserted unknown catchall: ". $self->catchall; if ( $svc_acct && $svc_acct->dir ) { @@ -238,13 +240,46 @@ sub insert { $svc_acct->gid, $svc_acct->dir, ); - ssh("root\@$qshellmachine", "[ -e $dir/.qmail-$qdomain-default ] || { touch $dir/.qmail-$qdomain-default; chown $uid:$gid $dir/.qmail-$qdomain-default; }"); + + my $queue = new FS::queue { 'job' => 'FS::svc_domain::ssh' }; + $error = $queue->insert("root\@$qshellmachine", "[ -e $dir/.qmail-$qdomain-default ] || { touch $dir/.qmail-$qdomain-default; chown $uid:$gid $dir/.qmail-$qdomain-default; }" ); + } } ''; #no error } +=item ssh + +=cut + +#false laziness with FS::svc_acct::ssh +sub ssh { + my ( $host, @cmd_and_args ) = @_; + + use IO::File; + my $reader = IO::File->new(); + my $writer = IO::File->new(); + my $error = IO::File->new(); + + &Net::SSH::sshopen3( $host, $reader, $writer, $error, @cmd_and_args) or die $!; + + local $/ = undef; + my $output_stream = <$writer>; + my $error_stream = <$error>; + if ( length $error_stream ) { + #warn "[FS::svc_acct::ssh] STDERR $error_stream"; + die "[FS::svc_domain::ssh] STDERR $error_stream"; + } + if ( length $output_stream ) { + warn "[FS::svc_domain::ssh] STDOUT $output_stream"; + } + +# &Net::SSH::ssh(@args,">>/usr/local/etc/freeside/sshoutput 2>&1"); +} + + =item delete Deletes this domain from the database. If there is an error, returns the @@ -416,7 +451,7 @@ sub submit_internic { =head1 VERSION -$Id: svc_domain.pm,v 1.22 2001-10-24 15:29:30 ivan Exp $ +$Id: svc_domain.pm,v 1.23 2002-02-09 18:09:30 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 0bdec843e4a9bb7f947c9ba980a40f7bf37020fb Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 9 Feb 2002 18:24:02 +0000 Subject: no more exit() in templates --- FS/FS/CGI.pm | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/CGI.pm b/FS/FS/CGI.pm index d1c56a254..35d2e2839 100644 --- a/FS/FS/CGI.pm +++ b/FS/FS/CGI.pm @@ -10,7 +10,7 @@ use FS::UID; @ISA = qw(Exporter); @EXPORT_OK = qw(header menubar idiot eidiot popurl table itable ntable - small_custview); + small_custview myexit); =head1 NAME @@ -132,6 +132,18 @@ Sends an HTML error message, then exits. sub eidiot { warn "eidiot depriciated"; idiot(@_); + &myexit(); +} + +=item myexit + +You probably shouldn't use this; but if you must: + +If running under mod_perl, calles Apache::exit, otherwise, calls exit. + +=cut + +sub myexit { if (exists $ENV{MOD_PERL}) { $main::Response->End() if defined $main::Response -- cgit v1.2.1 From 298b8d9a262265fe7106da1ff552ce6778237034 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 10 Feb 2002 01:48:00 +0000 Subject: remove -i option from freeside-bill (obsoleted by invoice events) --- FS/bin/freeside-bill | 17 ++++++----------- 1 file changed, 6 insertions(+), 11 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-bill b/FS/bin/freeside-bill index 49ec43c82..6ef344a50 100755 --- a/FS/bin/freeside-bill +++ b/FS/bin/freeside-bill @@ -11,8 +11,8 @@ use FS::Record qw(qsearch qsearchs); use FS::cust_main; &untaint_argv; #what it sounds like (eww) -use vars qw($opt_a $opt_c $opt_i $opt_d $opt_p); -getopts("acid:p"); +use vars qw($opt_a $opt_c $opt_d $opt_p); +getopts("acd:p"); my $user = shift or die &usage; adminsuidsetup $user; @@ -63,9 +63,7 @@ foreach $cust_main ( } if ($opt_c) { - $error=$cust_main->collect('invoice_time'=>$time, - 'batch_card' => $opt_i ? 'no' : 'yes', - ); + $error=$cust_main->collect( 'invoice_time' => $time); warn "Error collecting from customer #" . $cust_main->custnum. ":$error" if $error; @@ -86,7 +84,7 @@ sub untaint_argv { } sub usage { - die "Usage:\n\n freeside-bill [ -c [ i ] ] [ -d 'date' ] [ -b ] user\n"; + die "Usage:\n\n freeside-bill [ -c [ -p ] ] [ -d 'date' ] user [ custnum custnum ... ]\n"; } =head1 NAME @@ -95,7 +93,7 @@ freeside-bill - Command line (crontab, script) interface to customer billing. =head1 SYNOPSIS - freeside-bill [ -c [ -p ] [ -a ] [ -i ] ] [ -d 'date' ] user [ custnum custnum ... ] + freeside-bill [ -c [ -p ] [ -a ] ] [ -d 'date' ] user [ custnum custnum ... ] =head1 DESCRIPTION @@ -110,9 +108,6 @@ the bill and collect methods of a cust_main object. See L. -a: Call collect even if there isn't a new invoice (probably a bad idea for daily use) - -i: real-time billing (as opposed to batch billing). only relevant - for credit cards. - -d: Pretend it's 'date'. Date is in any format Date::Parse is happy with, but be careful. @@ -123,7 +118,7 @@ customers. Otherwise, bills all customers. =head1 VERSION -$Id: freeside-bill,v 1.11 2001-12-28 14:40:35 ivan Exp $ +$Id: freeside-bill,v 1.12 2002-02-10 01:48:00 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From c828daa905491e65deb30a2ed34af609cdb96b99 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 10 Feb 2002 02:16:47 +0000 Subject: pro-rating w/ web interface, tested (closes: Bug#313). view/cust_bill.cgi invoice view shows invoice events! fix bug where adding events with no name silently failed instead of giving an error add new comission plans --- FS/FS/Conf.pm | 7 +++++++ FS/FS/cust_bill.pm | 16 +++++++++++++++- FS/FS/cust_bill_event.pm | 13 +++++++++++++ FS/FS/cust_main.pm | 32 +++++++++++++++++++++++++------- 4 files changed, 60 insertions(+), 8 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 873ee75a9..da6bf72ce 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -716,6 +716,13 @@ httemplate/docs/config.html 'type' => 'textarea', }, + { + 'key' => 'safe-part_pkg', + 'section' => 'UI', + 'description' => 'Validates package definition setup and recur expressions against a preset list. Useful for webdemos, annoying to powerusers.', + 'type' => 'checkbox', + }, + ); 1; diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index ad2ae82d1..4306ea477 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -19,6 +19,7 @@ use FS::cust_pay; use FS::cust_pkg; use FS::cust_credit_bill; use FS::cust_pay_batch; +use FS::cust_bill_event; @ISA = qw( FS::Record ); @@ -251,6 +252,19 @@ sub cust_bill_pkg { qsearch( 'cust_bill_pkg', { 'invnum' => $self->invnum } ); } +=item cust_bill_event + +Returns the completed invoice events (see L) for this +invoice. + +=cut + +sub cust_bill_event { + my $self = shift; + qsearch( 'cust_bill_event', { 'invnum' => $self->invnum } ); +} + + =item cust_main Returns the customer (see L) for this invoice. @@ -864,7 +878,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.17 2002-02-06 15:50:54 ivan Exp $ +$Id: cust_bill.pm,v 1.18 2002-02-10 02:16:46 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_bill_event.pm b/FS/FS/cust_bill_event.pm index 910b4dead..cc9ce7cb8 100644 --- a/FS/FS/cust_bill_event.pm +++ b/FS/FS/cust_bill_event.pm @@ -3,6 +3,7 @@ package FS::cust_bill_event; use strict; use vars qw( @ISA ); use FS::Record qw( qsearch qsearchs ); +use FS::part_bill_event; @ISA = qw(FS::Record); @@ -117,6 +118,18 @@ sub check { ''; #no error } +=item part_bill_event + +Returns the invoice event definition (see L) for this +completed invoice event. + +=cut + +sub part_bill_event { + my $self = shift; + qsearchs( 'part_bill_event', { 'eventpart' => $self->eventpart } ); +} + =back =head1 BUGS diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 94fd97f39..5cc6cfdfd 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -913,6 +913,9 @@ sub bill { }; $recur_prog = $1; + # shared with $recur_prog + $sdate = $cust_pkg->bill || $cust_pkg->setup || $time; + #my $cpt = new Safe; ##$cpt->permit(); #what is necessary? #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods? @@ -925,11 +928,14 @@ sub bill { } #change this bit to use Date::Manip? CAREFUL with timezones (see # mailing list archive) - #$sdate=$cust_pkg->bill || time; - #$sdate=$cust_pkg->bill || $time; - $sdate = $cust_pkg->bill || $cust_pkg->setup || $time; my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($sdate) )[0,1,2,3,4,5]; + + #pro-rating magic - if $recur_prog fiddles $sdate, want to use that + # only for figuring next bill date, nothing else, so, reset $sdate again + # here + $sdate = $cust_pkg->bill || $cust_pkg->setup || $time; + $mon += $part_pkg->getfield('freq'); until ( $mon < 12 ) { $mon -= 12; $year++; } $cust_pkg->setfield('bill', @@ -1118,7 +1124,7 @@ sub collect { sort { $a->seconds <=> $b->seconds || $a->weight <=> $b->weight || $a->eventpart <=> $b->eventpart } - grep { $_->seconds > ( $invoice_time - ( $cust_bill->_date || 0 ) ) + grep { $_->seconds <= ( $invoice_time - $cust_bill->_date ) && ! qsearchs( 'cust_bill_event', { 'invnum' => $cust_bill->invnum, 'eventpart' => $_->eventpart } ) @@ -1518,11 +1524,23 @@ sub referral_cust_main { @cust_main; } +=item referral_cust_main_ncancelled + +Same as referral_cust_main, except only returns customers with uncancelled +packages. + +=cut + +sub referral_cust_main_ncancelled { + my $self = shift; + grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main; +} + =item referral_cust_pkg [ DEPTH ] -Like referral_cust_main, except returns a flat list of all unsuspended packages -for each customer. The number of items in this list may be useful for -comission calculations (perhaps after a grep). +Like referral_cust_main, except returns a flat list of all unsuspended (and +uncancelled) packages for each customer. The number of items in this list may +be useful for comission calculations (perhaps after a Cpkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ). =cut -- cgit v1.2.1 From b4bce0bf487b4ee3620e13f1fdf56ecc1d001a42 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 10 Feb 2002 02:28:28 +0000 Subject: hide SS# unless you turn it on via config file --- FS/FS/Conf.pm | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index da6bf72ce..20ec1380e 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -723,6 +723,13 @@ httemplate/docs/config.html 'type' => 'checkbox', }, + { + 'key' => 'show_ss', + 'section' => 'UI', + 'description' => 'Turns on display/collection of SS# in the web interface.', + 'type' => 'checkbox', + }, + ); 1; -- cgit v1.2.1 From 775d9fe6df79f88479998937d58ae2237a2525aa Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 10 Feb 2002 16:49:50 +0000 Subject: okay, for now, don't try to transform email addresses into svcnum-linked destinations --- FS/FS/cust_main_invoice.pm | 27 +++++++++++---------------- 1 file changed, 11 insertions(+), 16 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main_invoice.pm b/FS/FS/cust_main_invoice.pm index 3077d645a..7d8a0725a 100644 --- a/FS/FS/cust_main_invoice.pm +++ b/FS/FS/cust_main_invoice.pm @@ -1,7 +1,7 @@ package FS::cust_main_invoice; use strict; -use vars qw(@ISA $conf $mydomain); +use vars qw(@ISA $conf); use Exporter; use FS::Record qw( qsearchs ); use FS::Conf; @@ -10,12 +10,6 @@ use FS::svc_acct; @ISA = qw( FS::Record ); -#ask FS::UID to run this stuff for us later -$FS::UID::callback{'FS::cust_main_invoice'} = sub { - $conf = new FS::Conf; - $mydomain = $conf->config('domain'); -}; - =head1 NAME FS::cust_main_invoice - Object methods for cust_main_invoice records @@ -137,13 +131,14 @@ sub checkdest { unless qsearchs( 'svc_acct', { 'svcnum' => $self->dest } ); } elsif ( $self->dest =~ /^([\w\.\-\&]+)\@(([\w\.\-]+\.)+\w+)$/ ) { my($user, $domain) = ($1, $2); - if ( $domain eq $mydomain ) { - my $svc_acct = qsearchs( 'svc_acct', { 'username' => $user } ); - return "Unknown local account: $user\@$domain (specified literally)" - unless $svc_acct; - $svc_acct->svcnum =~ /^(\d+)$/ or die "Non-numeric svcnum?!"; - $self->dest($1); - } +# if ( $domain eq $mydomain ) { +# my $svc_acct = qsearchs( 'svc_acct', { 'username' => $user } ); +# return "Unknown local account: $user\@$domain (specified literally)" +# unless $svc_acct; +# $svc_acct->svcnum =~ /^(\d+)$/ or die "Non-numeric svcnum?!"; +# $self->dest($1); +# } + $self->dest("$1\@$2"); } else { return "Illegal destination!"; } @@ -162,7 +157,7 @@ sub address { if ( $self->dest =~ /^(\d+)$/ ) { my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $1 } ) or return undef; - $svc_acct->username . '@' . $mydomain; + $svc_acct->email; } else { $self->dest; } @@ -172,7 +167,7 @@ sub address { =head1 VERSION -$Id: cust_main_invoice.pm,v 1.8 2001-10-25 16:13:10 ivan Exp $ +$Id: cust_main_invoice.pm,v 1.9 2002-02-10 16:49:50 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From f726710e136944a42cf3ac405eb5d29637eb67a6 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 10 Feb 2002 17:02:37 +0000 Subject: allow + in email addresses --- FS/FS/cust_main_invoice.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main_invoice.pm b/FS/FS/cust_main_invoice.pm index 7d8a0725a..ebbadc6d9 100644 --- a/FS/FS/cust_main_invoice.pm +++ b/FS/FS/cust_main_invoice.pm @@ -129,7 +129,7 @@ sub checkdest { } elsif ( $self->dest =~ /^(\d+)$/ ) { return "Unknown local account (specified by svcnum: ". $self->dest. ")" unless qsearchs( 'svc_acct', { 'svcnum' => $self->dest } ); - } elsif ( $self->dest =~ /^([\w\.\-\&]+)\@(([\w\.\-]+\.)+\w+)$/ ) { + } elsif ( $self->dest =~ /^([\w\.\-\&\+]+)\@(([\w\.\-]+\.)+\w+)$/ ) { my($user, $domain) = ($1, $2); # if ( $domain eq $mydomain ) { # my $svc_acct = qsearchs( 'svc_acct', { 'username' => $user } ); @@ -167,7 +167,7 @@ sub address { =head1 VERSION -$Id: cust_main_invoice.pm,v 1.9 2002-02-10 16:49:50 ivan Exp $ +$Id: cust_main_invoice.pm,v 1.10 2002-02-10 17:02:37 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From ddb53fcc9fc80561354b97e4e7803004990138d0 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 10 Feb 2002 18:56:49 +0000 Subject: use unique tokens to prevent double-submission of payments in the web UI (closes: Bug#320) --- FS/FS/cust_pay.pm | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index 839571a95..6156eadeb 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -136,6 +136,17 @@ sub insert { } } + if ( $self->paybatch =~ /^webui-/ ) { + my @cust_pay = qsearch('cust_pay', { + 'custnum' => $self->custnum, + 'paybatch' => $self->paybatch, + } ); + if ( scalar(@cust_pay) > 1 ) { + $dbh->rollback if $oldAutoCommit; + return "a payment with webui token ". $self->paybatch. " already exists"; + } + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; #false laziness w/ cust_credit::insert @@ -348,7 +359,7 @@ sub unapplied { =head1 VERSION -$Id: cust_pay.pm,v 1.16 2002-02-07 22:29:34 ivan Exp $ +$Id: cust_pay.pm,v 1.17 2002-02-10 18:56:49 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 7e3eb82f87c371785544b706b7347c7edde2b593 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 10 Feb 2002 19:58:43 +0000 Subject: update billing documentation for the new world of invoice events added freeside-daily replacing freeside-bill for the new world of invoice events --- FS/MANIFEST | 1 + FS/bin/freeside-bill | 8 ++--- FS/bin/freeside-daily | 90 +++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 94 insertions(+), 5 deletions(-) create mode 100755 FS/bin/freeside-daily (limited to 'FS') diff --git a/FS/MANIFEST b/FS/MANIFEST index 0a9205c7f..85c09b465 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -4,6 +4,7 @@ MANIFEST.SKIP Makefile.PL README bin/freeside-bill +bin/freeside-daily bin/freeside-email bin/freeside-queued bin/freeside-apply-credits diff --git a/FS/bin/freeside-bill b/FS/bin/freeside-bill index 6ef344a50..49ad4a768 100755 --- a/FS/bin/freeside-bill +++ b/FS/bin/freeside-bill @@ -97,6 +97,8 @@ freeside-bill - Command line (crontab, script) interface to customer billing. =head1 DESCRIPTION +This script is deprecated in 1.4.0. You should use freeside-daily instead. + Bills customers. Searches for customers who are due for billing and calls the bill and collect methods of a cust_main object. See L. @@ -116,15 +118,11 @@ user: From the mapsecrets file - see config.html from the base documentation custnum: if one or more customer numbers are specified, only bills those customers. Otherwise, bills all customers. -=head1 VERSION - -$Id: freeside-bill,v 1.12 2002-02-10 01:48:00 ivan Exp $ - =head1 BUGS =head1 SEE ALSO -L, config.html from the base documentation +L, L, config.html from the base documentation =cut diff --git a/FS/bin/freeside-daily b/FS/bin/freeside-daily new file mode 100755 index 000000000..8d839cb21 --- /dev/null +++ b/FS/bin/freeside-daily @@ -0,0 +1,90 @@ +#!/usr/bin/perl -w + +use strict; +use Fcntl qw(:flock); +use Date::Parse; +use Getopt::Std; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch qsearchs); +use FS::cust_main; + +&untaint_argv; #what it sounds like (eww) +use vars qw($opt_d); +getopts("d:"); +my $user = shift or die &usage; + +adminsuidsetup $user; + +my @cust_main = @ARGV + ? map { qsearchs('cust_main', { custnum => $_ } ) } @ARGV + : qsearch('cust_main', {} ) +; + +#we're at now now (and later). +my($time)= $opt_d ? str2time($opt_d) : $^T; + +my($cust_main,%saw); +foreach $cust_main ( @cust_main ) { + + my $error; + + $error = $cust_main->bill( 'time' => $time ); + warn "Error billing, custnum ". $cust_main->custnum. ": $error" if $error; + + $cust_main->apply_payments; + $cust_main->apply_credits; + + $error=$cust_main->collect( 'invoice_time' => $time ); + warn "Error collecting, custnum". $cust_main->custnum. ": $error" if $error; + +} + +# subroutines + +sub untaint_argv { + foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV + #$ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal arguement \"$ARGV[$_]\""; + # Date::Parse + $ARGV[$_] =~ /^(.*)$/ || die "Illegal arguement \"$ARGV[$_]\""; + $ARGV[$_]=$1; + } +} + +sub usage { + die "Usage:\n\n freeside-daily [ -d 'date' ] user [ custnum custnum ... ]\n"; +} + +=head1 NAME + +freeside-daily - Run daily billing and invoice collection events. + +=head1 SYNOPSIS + + freeside-daily [ -d 'date' ] user [ custnum custnum ... ] + +=head1 DESCRIPTION + +Bills customers and runs invoice collection events. Should be run from +crontab daily. + +This script replaces freeside-bill from 1.3.1. + +Bills customers. Searches for customers who are due for billing and calls +the bill and collect methods of a cust_main object. See L. + + -d: Pretend it's 'date'. Date is in any format Date::Parse is happy with, + but be careful. + +user: From the mapsecrets file - see config.html from the base documentation + +custnum: if one or more customer numbers are specified, only bills those +customers. Otherwise, bills all customers. + +=head1 BUGS + +=head1 SEE ALSO + +L, config.html from the base documentation + +=cut + -- cgit v1.2.1 From 686c4dd420f19c596e7c4b1a3980e5121c007c32 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 10 Feb 2002 21:30:05 +0000 Subject: add new package definitions to all agent types by default config option to restore current behaviour (must explicitly add new package definitions to each agent type) closes: Bug#324 --- FS/FS/Conf.pm | 7 +++++++ FS/FS/part_pkg.pm | 50 ++++++++++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 55 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 20ec1380e..f68d84e8b 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -730,6 +730,13 @@ httemplate/docs/config.html 'type' => 'checkbox', }, + { + 'key' => 'agent_defaultpkg', + 'section' => 'UI', + 'description' => 'Setting this option will cause new packages to be available to all agent types by default.', + 'type' => 'checkbox', + }, + ); 1; diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index 29257c0cb..86af95432 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -2,8 +2,11 @@ package FS::part_pkg; use strict; use vars qw( @ISA ); -use FS::Record qw( qsearch ); +use FS::Record qw( qsearch dbh ); use FS::pkg_svc; +use FS::agent_type; +use FS::type_pkgs; +use FS::Conf; @ISA = qw( FS::Record ); @@ -105,6 +108,49 @@ sub clone { Adds this billing item definition to the database. If there is an error, returns the error, otherwise returns false. +=cut + +sub insert { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $self->SUPER::insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + my $conf = new FS::Conf; + + if ( $conf->exists('agent_defaultpkg') ) { + foreach my $agent_type ( qsearch('agent_type', {} ) ) { + my $type_pkgs = new FS::type_pkgs({ + 'typenum' => $agent_type->typenum, + 'pkgpart' => $self->pkgpart, + }); + my $error = $type_pkgs->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; +} + =item delete Currently unimplemented. @@ -182,7 +228,7 @@ sub svcpart { =head1 VERSION -$Id: part_pkg.pm,v 1.6 2002-01-28 06:57:23 ivan Exp $ +$Id: part_pkg.pm,v 1.7 2002-02-10 21:30:05 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From bb88a75467993505e2e3d37e8ce313f254ca5325 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 10 Feb 2002 21:37:24 +0000 Subject: import qsearch() so the quantity checking works --- FS/FS/cust_svc.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index a81e3bb32..8a8dbe7c9 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -3,7 +3,7 @@ package FS::cust_svc; use strict; use vars qw( @ISA ); use Carp qw( cluck ); -use FS::Record qw( qsearchs dbh ); +use FS::Record qw( qsearch qsearchs dbh ); use FS::cust_pkg; use FS::part_pkg; use FS::part_svc; @@ -245,7 +245,7 @@ sub seconds_since { =head1 VERSION -$Id: cust_svc.pm,v 1.10 2002-02-09 17:45:26 ivan Exp $ +$Id: cust_svc.pm,v 1.11 2002-02-10 21:37:24 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 06a4d261c7b7c1d8692fd2dfd33b06e090c17d53 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 10 Feb 2002 22:06:28 +0000 Subject: another bug in quantity checking --- FS/FS/cust_svc.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index 8a8dbe7c9..3e38be39e 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -128,7 +128,7 @@ sub check { }); return "Already ". scalar(@cust_svc). " ". $part_svc->svc. " services for pkgnum ". $self->pkgnum - if $pkg_svc->quantity >= scalar(@cust_svc); + if scalar(@cust_svc) >= $pkg_svc->quantity; } ''; #no error @@ -245,7 +245,7 @@ sub seconds_since { =head1 VERSION -$Id: cust_svc.pm,v 1.11 2002-02-10 21:37:24 ivan Exp $ +$Id: cust_svc.pm,v 1.12 2002-02-10 22:06:28 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From f255042296a645e7d90c19ee6740796250cfb9f3 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 11 Feb 2002 19:38:58 +0000 Subject: svc_www is working! also auto-create and add A records if necessary using apacheip config file. and show all domain_records on view/svc_domain.cgi page --- FS/FS/Conf.pm | 7 +++++ FS/FS/svc_www.pm | 89 ++++++++++++++++++++++++++++++++++++++++++++++++-------- 2 files changed, 84 insertions(+), 12 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index f68d84e8b..3a4f5b9de 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -197,6 +197,13 @@ httemplate/docs/config.html 'type' => 'text', }, + { + 'key' => 'apacheip', + 'section' => 'apache', + 'description' => 'The current IP address to assign to new virtual hosts', + 'type' => 'text', + }, + { 'key' => 'apachemachine', 'section' => 'apache', diff --git a/FS/FS/svc_www.pm b/FS/FS/svc_www.pm index d4e398810..f09a3f89d 100644 --- a/FS/FS/svc_www.pm +++ b/FS/FS/svc_www.pm @@ -1,13 +1,14 @@ package FS::svc_www; use strict; -use vars qw(@ISA $conf $apacheroot $apachemachine $nossh_hack ); +use vars qw(@ISA $conf $apacheroot $apachemachine $apacheip $nossh_hack ); #use FS::Record qw( qsearch qsearchs ); -use FS::Record qw( qsearchs ); +use FS::Record qw( qsearchs dbh ); use FS::svc_Common; use FS::cust_svc; use FS::domain_record; use FS::svc_acct; +use FS::svc_domain; use Net::SSH qw(ssh); @ISA = qw( FS::svc_Common ); @@ -17,6 +18,7 @@ $FS::UID::callback{'FS::svc_www'} = sub { $conf = new FS::Conf; $apacheroot = $conf->config('apacheroot'); $apachemachine = $conf->config('apachemachine'); + $apacheip = $conf->config('apacheip'); }; =head1 NAME @@ -101,11 +103,50 @@ setting $FS::svc_www::nossh_hack true. sub insert { my $self = shift; - my $error; - $error = $self->SUPER::insert; + my $error = $self->check; return $error if $error; + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + #if ( $self->recnum =~ /^([\w\-]+|\@)\.(([\w\.\-]+\.)+\w+)$/ ) { + if ( $self->recnum =~ /^([\w\-]+|\@)\.(\d+)$/ ) { + my( $reczone, $domain_svcnum ) = ( $1, $2 ); + unless ( $apacheip ) { + $dbh->rollback if $oldAutoCommit; + return "Configuration option apacheip not set; can't autocreate A record"; + #"for $reczone". $svc_domain->domain; + } + my $domain_record = new FS::domain_record { + 'svcnum' => $domain_svcnum, + 'reczone' => $reczone, + 'recaf' => 'IN', + 'rectype' => 'A', + 'recdata' => $apacheip, + }; + $error = $domain_record->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + $self->recnum($domain_record->recnum); + } + + $error = $self->SUPER::insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + my $domain_record = qsearchs('domain_record', { 'recnum' => $self->recnum } ); # or die ? my $zone = $domain_record->reczone; # or die ? @@ -137,6 +178,7 @@ sub insert { ); } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } @@ -187,7 +229,7 @@ Called by the cancel method of FS::cust_pkg (see L). =item check -Checks all fields to make sure this is a valid example. If there is +Checks all fields to make sure this is a valid web virtual host. If there is an error, returns the error, otherwise returns false. Called by the insert and repalce methods. @@ -202,13 +244,40 @@ sub check { my $error = $self->ut_numbern('svcnum') - || $self->ut_number('recnum') +# || $self->ut_number('recnum') || $self->ut_number('usersvc') ; return $error if $error; - return "Unknown recnum: ". $self->recnum - unless qsearchs('domain_record', { 'recnum' => $self->recnum } ); + if ( $self->recnum =~ /^(\d+)$/ ) { + + $self->recnum($1); + return "Unknown recnum: ". $self->recnum + unless qsearchs('domain_record', { 'recnum' => $self->recnum } ); + + } elsif ( $self->recnum =~ /^([\w\-]+|\@)\.(([\w\.\-]+\.)+\w+)$/ ) { + + my( $reczone, $domain ) = ( $1, $2 ); + + my $svc_domain = qsearchs( 'svc_domain', { 'domain' => $domain } ) + or return "unknown domain $domain (recnum $1.$2)"; + + my $domain_record = qsearchs( 'domain_record', { + 'reczone' => $reczone, + 'svcnum' => $svc_domain->svcnum, + }); + + if ( $domain_record ) { + $self->recnum($domain_record->recnum); + } else { + #insert will create it + #$self->recnum("$reczone.$domain"); + $self->recnum("$reczone.". $svc_domain->svcnum); + } + + } else { + return "Illegal recnum: ". $self->recnum; + } return "Unknown usersvc (svc_acct.svcnum): ". $self->usersvc unless qsearchs('svc_acct', { 'svcnum' => $self->usersvc } ); @@ -218,10 +287,6 @@ sub check { =back -=head1 VERSION - -$Id: svc_www.pm,v 1.6 2001-09-06 20:41:59 ivan Exp $ - =head1 BUGS =head1 SEE ALSO -- cgit v1.2.1 From ae01ce5a885b51179d78e200338ec87e945b98ae Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 11 Feb 2002 23:01:01 +0000 Subject: oops, code hidden by pod --- FS/FS/svc_forward.pm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_forward.pm b/FS/FS/svc_forward.pm index 1476dbf78..7fde3eeab 100644 --- a/FS/FS/svc_forward.pm +++ b/FS/FS/svc_forward.pm @@ -308,16 +308,18 @@ sub srcsvc_acct { Returns the FS::svc_acct object referenced by the srcsvc column, or false for forwards not local to freeside. -=back +=cut sub dstsvc_acct { my $self = shift; qsearchs('svc_acct', { 'svcnum' => $self->dstsvc } ); } +=back + =head1 VERSION -$Id: svc_forward.pm,v 1.8 2001-10-29 20:53:38 ivan Exp $ +$Id: svc_forward.pm,v 1.9 2002-02-11 23:01:01 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From a2c24812441a8f8ae3045a8c0c93c7f009d4f494 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 12 Feb 2002 02:06:39 +0000 Subject: that's not a bug anymore, don't list it in the BUGS section --- FS/FS/svc_acct.pm | 7 ------- 1 file changed, 7 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 16270f9cc..f3c2d76d3 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -1064,15 +1064,8 @@ sub ssh { =back -=head1 VERSION - -$Id: svc_acct.pm,v 1.64 2002-01-29 16:33:15 ivan Exp $ - =head1 BUGS -The bits which ssh should fork before doing so (or maybe queue jobs for a -daemon). - The $recref stuff in sub check should be cleaned up. The suspend, unsuspend and cancel methods update the database, but not the -- cgit v1.2.1 From ae23f6fe1ca915c995cfbf29bb39e7ed5e1cce2c Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 12 Feb 2002 02:11:07 +0000 Subject: add username_policy "@append domain" add "select" config type, mmm --- FS/FS/Conf.pm | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 3a4f5b9de..5de25510c 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -711,9 +711,10 @@ httemplate/docs/config.html { 'key' => 'username_policy', 'section' => '', - 'description' => 'This file controls the mechanism for preventing duplicate usernames in passwd/radius files exported from svc_accts. This should be one of \'prepend domsvc\' \'append domsvc\' or \'append domain\'', -# 'type' => 'select', - 'type' => 'text', + 'description' => 'This file controls the mechanism for preventing duplicate usernames in passwd/radius files exported from svc_accts. This should be one of \'prepend domsvc\' \'append domsvc\' \'append domain\' or \'append @domain\'', + 'type' => 'select', + 'select_enum' => [ 'prepend domsvc', 'append domsvc', 'append domain', 'append @domain' ], + #'type' => 'text', }, { -- cgit v1.2.1 From c493d99b65cf3b1cc05ea5d7a61214dba563569f Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 12 Feb 2002 18:47:21 +0000 Subject: fixes: Error running invoice event ($cust_main->charge( 10.00, 'Overdue Bill' );): Illegal or empty (text) comment: at /usr/local/lib/perl5/site_perl/5.005/FS/cust_main.pm line 1141. --- FS/FS/cust_main.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 5cc6cfdfd..b732218e7 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1582,7 +1582,7 @@ sub charge { my $part_pkg = new FS::part_pkg ( { 'pkg' => $pkg || 'One-time charge', - 'comment' => $comment, + 'comment' => $comment || '$'. sprintf("%.2f".$amount), 'setup' => $amount, 'freq' => 0, 'recur' => '0', -- cgit v1.2.1 From 98c7a62610134dee28e0f3e7a3ab6cb3ac8de5ca Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 12 Feb 2002 18:56:16 +0000 Subject: more information in "cant send invoice email" error message --- FS/FS/cust_bill.pm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 4306ea477..943c7b3ec 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -403,7 +403,9 @@ sub send { 'Body' => [ $self->print_text ], #( date) ); $message->smtpsend - or return "Can't send invoice email to server $smtpmachine!"; + or return "(customer # ". $self->custnum. ") can't send invoice email". + " for ". join(', ', grep { $_ ne 'POST' } @invoicing_list ). + " to server $smtpmachine!"; #} elsif ( grep { $_ eq 'POST' } @invoicing_list ) { } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) { @@ -878,7 +880,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.18 2002-02-10 02:16:46 ivan Exp $ +$Id: cust_bill.pm,v 1.19 2002-02-12 18:56:16 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From dd948355ef906c1f2e65e636b972f8028289c7e6 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 14 Feb 2002 01:12:19 +0000 Subject: don't require state (i18n) --- FS/FS/cust_pay_batch.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_pay_batch.pm b/FS/FS/cust_pay_batch.pm index 6acb4fefb..dfafb0a13 100644 --- a/FS/FS/cust_pay_batch.pm +++ b/FS/FS/cust_pay_batch.pm @@ -126,7 +126,7 @@ sub check { || $self->ut_text('address1') || $self->ut_textn('address2') || $self->ut_text('city') - || $self->ut_text('state') + || $self->ut_textn('state') ; return $error if $error; @@ -189,7 +189,7 @@ sub check { =head1 VERSION -$Id: cust_pay_batch.pm,v 1.4 2001-10-30 19:05:27 ivan Exp $ +$Id: cust_pay_batch.pm,v 1.5 2002-02-14 01:12:19 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 0dc8c09556f5e74b5a58931e40c2da06619a6be7 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 15 Feb 2002 19:33:41 +0000 Subject: CP provisioning!! --- FS/FS/Conf.pm | 7 +++ FS/FS/svc_acct.pm | 130 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 137 insertions(+) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 5de25510c..d5c00467d 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -267,6 +267,13 @@ httemplate/docs/config.html 'type' => 'textarea', }, + { + 'key' => 'cp_app', + 'section' => 'mail', + 'description' => 'Integration with Critial Path Account Provisioning Protocol, four lines: "host:port", username, password, and workgroup (for new users).', + 'type' => 'textarea', + }, + { 'key' => 'deletecustomers', 'section' => 'UI', diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index f3c2d76d3..65a58fc98 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -7,6 +7,7 @@ use vars qw( @ISA $nossh_hack $conf $dir_prefix @shells $usernamemin $username_noperiod $username_uppercase $shellmachine $useradd $usermod $userdel $mydomain $cyrus_server $cyrus_admin_user $cyrus_admin_pass + $cp_server $cp_user $cp_pass $cp_workgroup $dirhash $icradius_dbh @saltset @pw_set); @@ -71,6 +72,16 @@ $FS::UID::callback{'FS::svc_acct'} = sub { $cyrus_admin_user = ''; $cyrus_admin_pass = ''; } + if ( $conf->exists('cp_app') ) { + ($cp_server, $cp_user, $cp_pass, $cp_workgroup) = + $conf->config('cp_app'); + eval "use Net::APP;" + } else { + $cp_server = ''; + $cp_user = ''; + $cp_pass = ''; + $cp_workgroup = ''; + } if ( $conf->exists('icradiusmachines') ) { if ( $conf->exists('icradius_secrets') ) { #need some sort of late binding so it's only connected to when @@ -286,6 +297,16 @@ sub insert { return "queueing job (transaction rolled back): $error"; } } + + if ( $cp_server ) { + my $queue = new FS::queue { 'job' => 'FS::svc_acct::cp_insert' }; + $error = $queue->insert($self->username, $self->_password); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } + } + if ( $icradius_dbh ) { my $radcheck_queue = @@ -351,6 +372,27 @@ sub cyrus_insert { 1; } +sub cp_insert { + my( $username, $password ) = @_; + + my $app = new Net::APP ( $cp_server, + User => $cp_user, + Password => $cp_pass, + Domain => $mydomain, + Timeout => 60, + #Debug => 1, + ) or die $@; + + $app->create_mailbox( + Mailbox => $username, + Password => $password, + Workgroup => $cp_workgroup, + Domain => $mydomain, + ); + + die $app->message unless $app->ok; +} + sub icradius_rc_insert { my( $username, $password, %radcheck ) = @_; @@ -517,6 +559,16 @@ sub delete { return "queueing job (transaction rolled back): $error"; } } + + if ( $cp_server ) { + my $queue = new FS::queue { 'job' => 'FS::svc_acct::cp_delete' }; + $error = $queue->insert($self->username); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } + } + if ( $icradius_dbh ) { my $radcheck_queue = @@ -562,6 +614,24 @@ sub cyrus_delete { 1; } +sub cp_delete { + my( $username ) = @_; + my $app = new Net::APP ( $cp_server, + User => $cp_user, + Password => $cp_pass, + Domain => $mydomain, + Timeout => 60, + #Debug => 1, + ) or die $@; + + $app->delete_mailbox( + Mailbox => $username, + Domain => $mydomain, + ); + + die $app->message unless $app->ok; +} + sub icradius_rc_delete { my $username = shift; @@ -666,6 +736,24 @@ sub replace { } } + if ( $cp_server && $old->username ne $new->username ) { + my $queue = new FS::queue { 'job' => 'FS::svc_acct::cp_rename' }; + $error = $queue->insert( $old->username, $new->username ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } + } + + if ( $cp_server && $old->_password ne $new->_password ) { + my $queue = new FS::queue { 'job' => 'FS::svc_acct::cp_change' }; + $error = $queue->insert( $new->username, $new->_password ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } + } + if ( $icradius_dbh ) { my $queue = new FS::queue { 'job' => 'FS::svc_acct::icradius_rc_replace' }; $error = $queue->insert( $new->username, @@ -693,6 +781,48 @@ sub icradius_rc_replace { 1; } +sub cp_rename { + my ( $old_username, $new_username ); + + my $app = new Net::APP ( $cp_server, + User => $cp_user, + Password => $cp_pass, + Domain => $mydomain, + Timeout => 60, + #Debug => 1, + ) or die $@; + + $app->rename_mailbox( + Domain => $mydomain, + Old_Mailbox => $old_username, + New_Mailbox => $new_username, + ); + + die $app->message unless $app->ok; + +} + +sub cp_change { + my ( $username, $password ); + + my $app = new Net::APP ( $cp_server, + User => $cp_user, + Password => $cp_pass, + Domain => $mydomain, + Timeout => 60, + #Debug => 1, + ) or die $@; + + $app->change_mailbox( + Domain => $mydomain, + Mailbox => $username, + Password => $password, + ); + + die $app->message unless $app->ok; + +} + =item suspend Suspends this account by prefixing *SUSPENDED* to the password. If there is an -- cgit v1.2.1 From 5e9885a92ecff7ba0475d206752ccfd261788508 Mon Sep 17 00:00:00 2001 From: jeff Date: Sun, 17 Feb 2002 19:07:32 +0000 Subject: queue svc_forward remote commands; better commands too --- FS/FS/svc_forward.pm | 184 ++++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 152 insertions(+), 32 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_forward.pm b/FS/FS/svc_forward.pm index 7fde3eeab..7e0a4fd99 100644 --- a/FS/FS/svc_forward.pm +++ b/FS/FS/svc_forward.pm @@ -5,7 +5,7 @@ use vars qw( @ISA $nossh_hack $conf $shellmachine @qmailmachines @vpopmailmachines ); use Net::SSH qw(ssh); use FS::Conf; -use FS::Record qw( fields qsearch qsearchs ); +use FS::Record qw( fields qsearch qsearchs dbh ); use FS::svc_Common; use FS::cust_svc; use FS::svc_acct; @@ -94,9 +94,9 @@ defined. An FS::cust_svc record will be created and inserted. If the configuration value (see L) vpopmailmachines exists, then the command: - [ -d $vpopdir/$domain/$source ] || { - echo "$destination" >> $vpopdir/$domain/$username/.$qmail - chown $vpopuid:$vpopgid $vpopdir/$domain/$username/.$qmail + [ -d $vpopdir/domains/$domain/$source ] && { + echo "$destination" >> $vpopdir/domains/$domain/$username/.$qmail + chown $vpopuid:$vpopgid $vpopdir/domains/$domain/$username/.$qmail } is executed on each vpopmailmachine via ssh (see the vpopmail documentation). @@ -115,29 +115,42 @@ sub insert { local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + $error = $self->check; return $error if $error; $error = $self->SUPER::insert; - return $error if $error; + if ($error) { + $dbh->rollback if $oldAutoCommit; + return $error; + } my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $self->srcsvc } ); my $username = $svc_acct->username; my $domain = $svc_acct->domain; my $destination; if ($self->dstsvc) { - my $dst_svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $self->dstsvc } ); - $destination = $dst_svc_acct->email; + $destination = $self->dstsvc_acct->email; } else { $destination = $self->dst; } foreach my $vpopmailmachine ( @vpopmailmachines ) { my($machine, $vpopdir, $vpopuid, $vpopgid) = split(/\s+/, $vpopmailmachine); - ssh("root\@$machine","[ -d $vpopdir/$domain/$username ] || { echo \"$destination\" >> $vpopdir/$domain/$username/.qmail; chown $vpopuid:$vpopgid $vpopdir/$domain/$username/.qmail; }") + my $queue = new FS::queue { 'job' => 'Net::SSH::ssh_cmd' }; # should be neater + my $error = $queue->insert("root\@$machine","[ -d $vpopdir/domains/$domain/$username ] && { echo \"$destination\" >> $vpopdir/domains/$domain/$username/.qmail; chown $vpopuid:$vpopgid $vpopdir/domains/$domain/$username/.qmail; }") unless $nossh_hack; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error } @@ -149,25 +162,99 @@ returns the error, otherwise returns false. The corresponding FS::cust_svc record will be deleted as well. +If the configuration value vpopmailmachines exists, then the command: + + { sed -e '/^$destination/d' < + $vpopdir/domains/$srcdomain/$srcusername/.qmail > + $vpopdir/domains/$srcdomain/$srcusername/.qmail.temp; + mv $vpopdir/domains/$srcdomain/$srcusername/.qmail.temp + $vpopdir/domains/$srcdomain/$srcusername/.qmail; + chown $vpopuid.$vpopgid $vpopdir/domains/$srcdomain/$srcusername/.qmail; } + + +is executed on each vpopmailmachine via ssh. This behaviour can be supressed +by setting $FS::svc_forward_nossh_hack true. + +=cut + +sub delete { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::Autocommit = 0; + my $dbh = dbh; + + my $error = $self->SUPER::delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + my $svc_acct = $self->srcsvc_acct; + my $username = $svc_acct->username; + my $domain = $svc_acct->domain; + my $destination; + if ($self->dstsvc) { + $destination = $self->dstsvc_acct->email; + } else { + $destination = $self->dst; + } + foreach my $vpopmailmachine ( @vpopmailmachines ) { + my($machine, $vpopdir, $vpopuid, $vpopgid) = + split(/\s+/, $vpopmailmachine); + my $queue = new FS::queue { 'job' => 'Net::SSH::ssh_cmd' }; # should be neater + my $error = $queue->insert("root\@$machine", + "sed -e '/^$destination/d' " . + "< $vpopdir/domains/$domain/$username/.qmail" . + "> $vpopdir/domains/$domain/$username/.qmail.temp; " . + "mv $vpopdir/domains/$domain/$username/.qmail.temp " . + "$vpopdir/domains/$domain/$username/.qmail; " . + "chown $vpopuid.$vpopgid $vpopdir/domains/$domain/$username/.qmail;" + ) + unless $nossh_hack; + + if ($error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } + + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; +} + + =item replace OLD_RECORD Replaces OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. -If srcsvc changes, and the configuration value vpopmailmachines exists, then -the command: +If the configuration value vpopmailmachines exists, then the command: - rm $vpopdir/$domain/$username/.qmail + { sed -e '/^$destination/d' < + $vpopdir/domains/$srcdomain/$srcusername/.qmail > + $vpopdir/domains/$srcdomain/$srcusername/.qmail.temp; + mv $vpopdir/domains/$srcdomain/$srcusername/.qmail.temp + $vpopdir/domains/$srcdomain/$srcusername/.qmail; + chown $vpopuid.$vpopgid $vpopdir/domains/$srcdomain/$srcusername/.qmail; } + is executed on each vpopmailmachine via ssh. This behaviour can be supressed by setting $FS::svc_forward_nossh_hack true. -If dstsvc changes (or dstsvc is 0 and dst changes), and the configuration value -vpopmailmachines exists, then the command: +Also, if the configuration value vpopmailmachines exists, then the command: - [ -d $vpopdir/$domain/$source ] || { - echo "$destination" >> $vpopdir/$domain/$username/.$qmail - chown $vpopuid:$vpopgid $vpopdir/$domain/$username/.$qmail + [ -d $vpopdir/domains/$domain/$source ] && { + echo "$destination" >> $vpopdir/domains/$domain/$username/.$qmail + chown $vpopuid:$vpopgid $vpopdir/domains/$domain/$username/.$qmail } is executed on each vpopmailmachine via ssh. This behaviour can be supressed @@ -193,18 +280,43 @@ sub replace { local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + my $error = $new->SUPER::replace($old); - return $error if $error; + if ($error) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + my $old_svc_acct = $old->srcsvc_acct; + my $old_username = $old_svc_acct->username; + my $old_domain = $old_svc_acct->domain; + my $destination; + if ($old->dstsvc) { + $destination = $old->dstsvc_acct->email; + } else { + $destination = $old->dst; + } + foreach my $vpopmailmachine ( @vpopmailmachines ) { + my($machine, $vpopdir, $vpopuid, $vpopgid) = + split(/\s+/, $vpopmailmachine); + my $queue = new FS::queue { 'job' => 'Net::SSH::ssh_cmd' }; # should be neater + my $error = $queue->insert("root\@$machine", + "sed -e '/^$destination/d' " . + "< $vpopdir/domains/$old_domain/$old_username/.qmail" . + "> $vpopdir/domains/$old_domain/$old_username/.qmail.temp; " . + "mv $vpopdir/domains/$old_domain/$old_username/.qmail.temp " . + "$vpopdir/domains/$old_domain/$old_username/.qmail; " . + "chown $vpopuid.$vpopgid " . + "$vpopdir/domains/$old_domain/$old_username/.qmail;" + ) + unless $nossh_hack; - if ( $new->srcsvc != $old->srcsvc ) { - my $old_svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $old->srcsvc } ); - my $old_username = $old_svc_acct->username; - my $old_domain = $old_svc_acct->domain; - foreach my $vpopmailmachine ( @vpopmailmachines ) { - my($machine, $vpopdir, $vpopuid, $vpopgid) = - split(/\s+/, $vpopmailmachine); - ssh("root\@$machine","rm $vpopdir/$old_domain/$old_username/.qmail") - unless $nossh_hack; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; } } @@ -212,21 +324,25 @@ sub replace { my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $new->srcsvc } ); my $username = $svc_acct->username; my $domain = $svc_acct->domain; - my $destination; if ($new->dstsvc) { - my $dst_svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $new->dstsvc } ); - $destination = $dst_svc_acct->email; + $destination = $new->dstsvc_acct->email; } else { $destination = $new->dst; } foreach my $vpopmailmachine ( @vpopmailmachines ) { my($machine, $vpopdir, $vpopuid, $vpopgid) = split(/\s+/, $vpopmailmachine); - ssh("root\@$machine","[ -d $vpopdir/$domain/$username ] || { echo \"$destination\" >> $vpopdir/$domain/$username/.qmail; chown $vpopuid:$vpopgid $vpopdir/$domain/$username/.qmail; }") + my $queue = new FS::queue { 'job' => 'Net::SSH::ssh_cmd' }; # should be neater + my $error = $queue->insert("root\@$machine","[ -d $vpopdir/domains/$domain/$username ] && { echo \"$destination\" >> $vpopdir/domains/$domain/$username/.qmail; chown $vpopuid:$vpopgid $vpopdir/domains/$domain/$username/.qmail; }") unless $nossh_hack; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } } #end subroutinable bits + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } @@ -279,7 +395,11 @@ sub check { return "one of dstsvc or dst is required" unless $self->dstsvc || $self->dst; - return "Unknown dstsvc" unless $self->dstsvc_acct || ! $self->dstsvc; + #return "Unknown dstsvc: $dstsvc" unless $self->dstsvc_acct || ! $self->dstsvc; + return "Unknown dstsvc" + unless qsearchs('svc_acct', { 'svcnum' => $self->dstsvc } ) + || ! $self->dstsvc; + if ( $self->dst ) { $self->dst =~ /^([\w\.\-]+)\@(([\w\-]+\.)+\w+)$/ @@ -319,7 +439,7 @@ sub dstsvc_acct { =head1 VERSION -$Id: svc_forward.pm,v 1.9 2002-02-11 23:01:01 ivan Exp $ +$Id: svc_forward.pm,v 1.10 2002-02-17 19:07:32 jeff Exp $ =head1 BUGS -- cgit v1.2.1 From 1d4951dbd6af315840a8a633bae5a5739ec5d82c Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 17 Feb 2002 19:12:12 +0000 Subject: get ride of CGIwrapper.pm --- FS/FS/CGIwrapper.pm | 17 ----------------- FS/MANIFEST | 1 - FS/t/CGIwrapper.t | 5 ----- 3 files changed, 23 deletions(-) delete mode 100644 FS/FS/CGIwrapper.pm delete mode 100644 FS/t/CGIwrapper.t (limited to 'FS') diff --git a/FS/FS/CGIwrapper.pm b/FS/FS/CGIwrapper.pm deleted file mode 100644 index 863193e94..000000000 --- a/FS/FS/CGIwrapper.pm +++ /dev/null @@ -1,17 +0,0 @@ -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/MANIFEST b/FS/MANIFEST index 85c09b465..c6638c84b 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -58,7 +58,6 @@ FS/session.pm FS/domain_record.pm FS/prepay_credit.pm FS/svc_www.pm -FS/CGIwrapper.pm FS/svc_forward.pm FS/raddb.pm FS/queue.pm diff --git a/FS/t/CGIwrapper.t b/FS/t/CGIwrapper.t deleted file mode 100644 index 06c741c3a..000000000 --- a/FS/t/CGIwrapper.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::CGIwrapper; -$loaded=1; -print "ok 1\n"; -- cgit v1.2.1 From 7158f85d129bdca437955fad1c4ca1df4718d7a2 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 17 Feb 2002 21:01:50 +0000 Subject: removing CGIwrapper.pm --- FS/MANIFEST | 1 - 1 file changed, 1 deletion(-) (limited to 'FS') diff --git a/FS/MANIFEST b/FS/MANIFEST index c6638c84b..f7a5c1248 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -65,7 +65,6 @@ FS/queue_arg.pm t/agent.t t/agent_type.t t/CGI.t -t/CGIwrapper.t t/Conf.t t/ConfItem.t t/cust_bill.t -- cgit v1.2.1 From b35b650a6078d645d6f97620f3c79ae941915dd9 Mon Sep 17 00:00:00 2001 From: jeff Date: Mon, 18 Feb 2002 00:13:58 +0000 Subject: trading in tar for rsync for improved vpopmail support --- FS/FS/Conf.pm | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index d5c00467d..7a4a71966 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -731,6 +731,13 @@ httemplate/docs/config.html 'type' => 'textarea', }, + { + 'key' => 'vpopmailrestart', + 'section' => 'mail', + 'description' => 'If defined, the command which is run on vpopmail machines after files are copied. An example can be found in eg/vpopmailrestart of the source distribution.', + 'type' => 'text', + }, + { 'key' => 'safe-part_pkg', 'section' => 'UI', -- cgit v1.2.1 From 32e8c2a2a58428acd539d880357c76720334c011 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 18 Feb 2002 08:39:21 +0000 Subject: safe web demo operation! closes: Bug#217 fix bug in edit/part_pkg: s/bkg/pkg/ edit/part_pkg.cgi - plan
+ + + + + +END + + my $p = FS::CGI::popurl(2); + foreach my $queue ( sort { + $a->getfield('jobnum') <=> $b->getfield('jobnum') + } qsearch( 'queue', $hashref ) ) { + my $hashref = $queue->hashref; + my $jobnum = $queue->jobnum; + my $args = join(' ', $queue->args); + my $date = time2str( "%a %b %e %T %Y", $queue->_date ); + my $status = $queue->status; + $status .= ': '. $queue->statustext if $queue->statustext; + if ( ! $noactions && $status =~ /^failed/ || $status =~ /^locked/ ) { + $status .= + qq! ( retry |!. + qq! remove )!; + } + my $cust_svc = $queue->cust_svc; + my $account; + if ( $cust_svc ) { + my $table = $cust_svc->part_svc->svcdb; + my $label = ( $cust_svc->label )[1]; + $account = qq!$label!; + } else { + $account = ''; + } + $html .= < + + + + + + + +END + +} + + $html .= '
JobArgsDateStatusAccount
$jobnum$hashref->{job}$args$date$status$account
'; + + $html; + +} + =back =head1 VERSION -$Id: queue.pm,v 1.3 2001-09-11 12:25:55 ivan Exp $ +$Id: queue.pm,v 1.4 2002-02-20 01:03:09 ivan Exp $ =head1 BUGS diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 65a58fc98..2f327a3d3 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -281,7 +281,10 @@ sub insert { $self->shell, ); if ( $username && $uid && $dir && $shellmachine && ! $nossh_hack ) { - my $queue = new FS::queue { 'job' => 'FS::svc_acct::ssh' }; + my $queue = new FS::queue { + 'svcnum' => $self->svcnum, + 'job' => 'Net::SSH::ssh_cmd', + }; $error = $queue->insert("root\@$shellmachine", eval qq("$useradd") ); if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -290,7 +293,10 @@ sub insert { } if ( $cyrus_server ) { - my $queue = new FS::queue { 'job' => 'FS::svc_acct::cyrus_insert' }; + my $queue = new FS::queue { + 'svcnum' => $self->svcnum, + 'job' => 'FS::svc_acct::cyrus_insert', + }; $error = $queue->insert($self->username, $self->quota); if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -299,7 +305,10 @@ sub insert { } if ( $cp_server ) { - my $queue = new FS::queue { 'job' => 'FS::svc_acct::cp_insert' }; + my $queue = new FS::queue { + 'svcnum' => $self->svcnum, + 'job' => 'FS::svc_acct::cp_insert' + }; $error = $queue->insert($self->username, $self->_password); if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -310,7 +319,10 @@ sub insert { if ( $icradius_dbh ) { my $radcheck_queue = - new FS::queue { 'job' => 'FS::svc_acct::icradius_rc_insert' }; + new FS::queue { + 'svcnum' => $self->svcnum, + 'job' => 'FS::svc_acct::icradius_rc_insert' + }; $error = $radcheck_queue->insert( $self->username, $self->_password, $self->radius_check @@ -321,7 +333,10 @@ sub insert { } my $radreply_queue = - new FS::queue { 'job' => 'FS::svc_acct::icradius_rr_insert' }; + new FS::queue { + 'svcnum' => $self->svcnum, + 'job' => 'FS::svc_acct::icradius_rr_insert' + }; $error = $radreply_queue->insert( $self->username, $self->_password, $self->radius_reply @@ -542,7 +557,7 @@ sub delete { $self->dir, ); if ( $username && $shellmachine && ! $nossh_hack ) { - my $queue = new FS::queue { 'job' => 'FS::svc_acct::ssh' }; + my $queue = new FS::queue { 'job' => 'Net::SSH::ssh_cmd' }; $error = $queue->insert("root\@$shellmachine", eval qq("$userdel") ); if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -728,7 +743,10 @@ sub replace { $new->getfield('gid'), ); if ( $old_dir && $new_dir && $old_dir ne $new_dir && ! $nossh_hack ) { - my $queue = new FS::queue { 'job' => 'FS::svc_acct::ssh' }; + my $queue = new FS::queue { + 'svcnum' => $new->svcnum, + 'job' => 'Net::SSH::ssh_cmd' + }; $error = $queue->insert("root\@$shellmachine", eval qq("$usermod") ); if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -737,7 +755,10 @@ sub replace { } if ( $cp_server && $old->username ne $new->username ) { - my $queue = new FS::queue { 'job' => 'FS::svc_acct::cp_rename' }; + my $queue = new FS::queue { + 'svcnum' => $new->svcnum, + 'job' => 'FS::svc_acct::cp_rename' + }; $error = $queue->insert( $old->username, $new->username ); if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -746,7 +767,10 @@ sub replace { } if ( $cp_server && $old->_password ne $new->_password ) { - my $queue = new FS::queue { 'job' => 'FS::svc_acct::cp_change' }; + my $queue = new FS::queue { + 'svcnum' => $new->svcnum, + 'job' => 'FS::svc_acct::cp_change' + }; $error = $queue->insert( $new->username, $new->_password ); if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -755,7 +779,10 @@ sub replace { } if ( $icradius_dbh ) { - my $queue = new FS::queue { 'job' => 'FS::svc_acct::icradius_rc_replace' }; + my $queue = new FS::queue { + 'svcnum' => $new->svcnum, + 'job' => 'FS::svc_acct::icradius_rc_replace' + }; $error = $queue->insert( $new->username, $new->_password, ); @@ -1164,34 +1191,6 @@ sub seconds_since { $self->cust_svc->seconds_since(@_); } -=item ssh - -=cut - -sub ssh { - my ( $host, @cmd_and_args ) = @_; - - use IO::File; - my $reader = IO::File->new(); - my $writer = IO::File->new(); - my $error = IO::File->new(); - - &Net::SSH::sshopen3( $host, $reader, $writer, $error, @cmd_and_args) or die $!; - - local $/ = undef; - my $output_stream = <$writer>; - my $error_stream = <$error>; - if ( length $error_stream ) { - #warn "[FS::svc_acct::ssh] STDERR $error_stream"; - die "[FS::svc_acct::ssh] STDERR $error_stream"; - } - if ( length $output_stream ) { - warn "[FS::svc_acct::ssh] STDOUT $output_stream"; - } - -# &Net::SSH::ssh(@args,">>/usr/local/etc/freeside/sshoutput 2>&1"); -} - =back =head1 BUGS diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm index d0f0e11a8..84a102911 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -241,7 +241,10 @@ sub insert { $svc_acct->dir, ); - my $queue = new FS::queue { 'job' => 'FS::svc_domain::ssh' }; + my $queue = new FS::queue { + 'svcnum' => $self->svcnum, + 'job' => 'Net::SSH::ssh_cmd', + }; $error = $queue->insert("root\@$qshellmachine", "[ -e $dir/.qmail-$qdomain-default ] || { touch $dir/.qmail-$qdomain-default; chown $uid:$gid $dir/.qmail-$qdomain-default; }" ); } @@ -250,36 +253,6 @@ sub insert { ''; #no error } -=item ssh - -=cut - -#false laziness with FS::svc_acct::ssh -sub ssh { - my ( $host, @cmd_and_args ) = @_; - - use IO::File; - my $reader = IO::File->new(); - my $writer = IO::File->new(); - my $error = IO::File->new(); - - &Net::SSH::sshopen3( $host, $reader, $writer, $error, @cmd_and_args) or die $!; - - local $/ = undef; - my $output_stream = <$writer>; - my $error_stream = <$error>; - if ( length $error_stream ) { - #warn "[FS::svc_acct::ssh] STDERR $error_stream"; - die "[FS::svc_domain::ssh] STDERR $error_stream"; - } - if ( length $output_stream ) { - warn "[FS::svc_domain::ssh] STDOUT $output_stream"; - } - -# &Net::SSH::ssh(@args,">>/usr/local/etc/freeside/sshoutput 2>&1"); -} - - =item delete Deletes this domain from the database. If there is an error, returns the @@ -451,7 +424,7 @@ sub submit_internic { =head1 VERSION -$Id: svc_domain.pm,v 1.23 2002-02-09 18:09:30 ivan Exp $ +$Id: svc_domain.pm,v 1.24 2002-02-20 01:03:09 ivan Exp $ =head1 BUGS diff --git a/FS/FS/svc_forward.pm b/FS/FS/svc_forward.pm index 7e0a4fd99..12f8b9236 100644 --- a/FS/FS/svc_forward.pm +++ b/FS/FS/svc_forward.pm @@ -140,7 +140,11 @@ sub insert { foreach my $vpopmailmachine ( @vpopmailmachines ) { my($machine, $vpopdir, $vpopuid, $vpopgid) = split(/\s+/, $vpopmailmachine); - my $queue = new FS::queue { 'job' => 'Net::SSH::ssh_cmd' }; # should be neater + my $queue = new FS::queue { + 'svcnum' => $self->svcnum, + 'job' => 'Net::SSH::ssh_cmd', + }; + # should be neater my $error = $queue->insert("root\@$machine","[ -d $vpopdir/domains/$domain/$username ] && { echo \"$destination\" >> $vpopdir/domains/$domain/$username/.qmail; chown $vpopuid:$vpopgid $vpopdir/domains/$domain/$username/.qmail; }") unless $nossh_hack; if ( $error ) { @@ -209,7 +213,8 @@ sub delete { foreach my $vpopmailmachine ( @vpopmailmachines ) { my($machine, $vpopdir, $vpopuid, $vpopgid) = split(/\s+/, $vpopmailmachine); - my $queue = new FS::queue { 'job' => 'Net::SSH::ssh_cmd' }; # should be neater + my $queue = new FS::queue { 'job' => 'Net::SSH::ssh_cmd' }; + # should be neater my $error = $queue->insert("root\@$machine", "sed -e '/^$destination/d' " . "< $vpopdir/domains/$domain/$username/.qmail" . @@ -302,7 +307,11 @@ sub replace { foreach my $vpopmailmachine ( @vpopmailmachines ) { my($machine, $vpopdir, $vpopuid, $vpopgid) = split(/\s+/, $vpopmailmachine); - my $queue = new FS::queue { 'job' => 'Net::SSH::ssh_cmd' }; # should be neater + my $queue = new FS::queue { + 'svcnum' => $new->svcnum, + 'job' => 'Net::SSH::ssh_cmd', + }; + # should be neater my $error = $queue->insert("root\@$machine", "sed -e '/^$destination/d' " . "< $vpopdir/domains/$old_domain/$old_username/.qmail" . @@ -332,7 +341,11 @@ sub replace { foreach my $vpopmailmachine ( @vpopmailmachines ) { my($machine, $vpopdir, $vpopuid, $vpopgid) = split(/\s+/, $vpopmailmachine); - my $queue = new FS::queue { 'job' => 'Net::SSH::ssh_cmd' }; # should be neater + my $queue = new FS::queue { + 'svcnum' => $new->svcnum, + 'job' => 'Net::SSH::ssh_cmd', + }; + # should be neater my $error = $queue->insert("root\@$machine","[ -d $vpopdir/domains/$domain/$username ] && { echo \"$destination\" >> $vpopdir/domains/$domain/$username/.qmail; chown $vpopuid:$vpopgid $vpopdir/domains/$domain/$username/.qmail; }") unless $nossh_hack; if ( $error ) { @@ -439,7 +452,7 @@ sub dstsvc_acct { =head1 VERSION -$Id: svc_forward.pm,v 1.10 2002-02-17 19:07:32 jeff Exp $ +$Id: svc_forward.pm,v 1.11 2002-02-20 01:03:09 ivan Exp $ =head1 BUGS diff --git a/FS/bin/freeside-queued b/FS/bin/freeside-queued index 87e3cb422..56475d059 100644 --- a/FS/bin/freeside-queued +++ b/FS/bin/freeside-queued @@ -14,7 +14,7 @@ use FS::queue; # no autoloading just yet use FS::cust_main; use FS::svc_acct; -use Net::SSH; +use Net::SSH 0.05; my $pid_file = '/var/run/freeside-queued.pid'; @@ -69,6 +69,7 @@ while (1) { warn "WARNING: can't fork: $!\n"; my %hash = $job->hash; $hash{'status'} = 'failed'; + $hash{'statustext'} = "[freeside-queued] can't fork: $!"; my $ljob = new FS::queue ( \%hash ); my $error = $ljob->replace($job); die $error if $error; @@ -89,6 +90,7 @@ while (1) { warn "job $eval failed"; my %hash = $ljob->hash; $hash{'status'} = 'failed'; + $hash{'statustext'} = $@; my $fjob = new FS::queue( \%hash ); my $error = $fjob->replace($ljob); die $error if $error; -- cgit v1.2.1 From 09b365e315a7ba825c9e1e262c50b372cf2595a2 Mon Sep 17 00:00:00 2001 From: jeff Date: Wed, 20 Feb 2002 03:17:13 +0000 Subject: correct sense of tax generation --- FS/FS/cust_main.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index b732218e7..67b426b85 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -976,10 +976,10 @@ sub bill { $total_recur += $recur; $taxable_setup += $setup unless $part_pkg->dbdef_table->column('setuptax') - || $part_pkg->setuptax =~ /^Y$/i; + && $part_pkg->setuptax =~ /^Y$/i; $taxable_recur += $recur unless $part_pkg->dbdef_table->column('recurtax') - || $part_pkg->recurtax =~ /^Y$/i; + && $part_pkg->recurtax =~ /^Y$/i; } } -- cgit v1.2.1 From b4d4e05b95414fc334bf80474a0c10f639ac4ba1 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 20 Feb 2002 10:39:53 +0000 Subject: fixes eidiot under Mason, closes: Bug#344 --- FS/FS/CGI.pm | 23 ++++++++++++++++++----- 1 file changed, 18 insertions(+), 5 deletions(-) (limited to 'FS') diff --git a/FS/FS/CGI.pm b/FS/FS/CGI.pm index ee59b259f..190c0aa37 100644 --- a/FS/FS/CGI.pm +++ b/FS/FS/CGI.pm @@ -131,6 +131,8 @@ Sends an HTML error message, then exits. sub eidiot { warn "eidiot depriciated"; + $HTML::Mason::Commands::r->send_http_header + if defined $HTML::Mason::Commands::r; idiot(@_); &myexit(); } @@ -145,11 +147,22 @@ If running under mod_perl, calles Apache::exit, otherwise, calls exit. sub myexit { if (exists $ENV{MOD_PERL}) { - $main::Response->End() - if defined $main::Response - && $main::Response->isa('Apache::ASP::Response'); - require Apache; - Apache::exit(); + + if ( defined $main::Response + && $main::Response->isa('Apache::ASP::Response') ) { #Apache::ASP + $main::Response->End(); + require Apache; + Apache::exit(); + } elsif ( defined $HTML::Mason::Commands::m ) { #Mason + #$HTML::Mason::Commands::m->flush_buffer(); + $HTML::Mason::Commands::m->abort(); + die "shouldn't fall through to here (mason \$m->abort didn't)"; + } else { + #??? well, it is $ENV{MOD_PERL} + warn "running under unknown mod_perl environment; trying Apache::exit()"; + require Apache; + Apache::exit(); + } } else { exit; } -- cgit v1.2.1 From 4dbbbee37e78a035022974d19b3b80aeaead6049 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 22 Feb 2002 01:07:23 +0000 Subject: UI work: make all functions of view/cust_pkg.cgi available on view/cust_main.cgi - having them one link down in "Edit" is confusing. closes: Bug#325 --- FS/FS/Conf.pm | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index f8d646254..226702e5c 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -766,6 +766,13 @@ httemplate/docs/config.html 'type' => 'checkbox', }, + { + 'key' => 'legacy_link', + 'section' => 'UI', + 'description' => 'Display options in the web interface to link legacy pre-Freeside services.', + 'type' => 'checkbox', + }, + ); 1; -- cgit v1.2.1 From ce4d2cc94fed25fc3b4aa85531022ae1e6eed778 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 22 Feb 2002 05:56:48 +0000 Subject: fix bugs in CP mailbox changes: cp_change and cp_rename --- FS/FS/svc_acct.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 2f327a3d3..20db38b71 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -809,7 +809,7 @@ sub icradius_rc_replace { } sub cp_rename { - my ( $old_username, $new_username ); + my ( $old_username, $new_username ) = @_; my $app = new Net::APP ( $cp_server, User => $cp_user, @@ -830,7 +830,7 @@ sub cp_rename { } sub cp_change { - my ( $username, $password ); + my ( $username, $password ) = @_; my $app = new Net::APP ( $cp_server, User => $cp_user, -- cgit v1.2.1 From da4c9633b45d04091fc1b8d420e5d75e294ebf86 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 22 Feb 2002 06:23:44 +0000 Subject: don't leak perl line numbers on cp provisioning errors --- FS/FS/svc_acct.pm | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 20db38b71..2a0c90445 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -396,7 +396,7 @@ sub cp_insert { Domain => $mydomain, Timeout => 60, #Debug => 1, - ) or die $@; + ) or die "$@\n"; $app->create_mailbox( Mailbox => $username, @@ -405,7 +405,7 @@ sub cp_insert { Domain => $mydomain, ); - die $app->message unless $app->ok; + die $app->message."\n" unless $app->ok; } sub icradius_rc_insert { @@ -637,14 +637,14 @@ sub cp_delete { Domain => $mydomain, Timeout => 60, #Debug => 1, - ) or die $@; + ) or die "$@\n"; $app->delete_mailbox( Mailbox => $username, Domain => $mydomain, ); - die $app->message unless $app->ok; + die $app->message."\n" unless $app->ok; } sub icradius_rc_delete { @@ -817,7 +817,7 @@ sub cp_rename { Domain => $mydomain, Timeout => 60, #Debug => 1, - ) or die $@; + ) or die "$@\n"; $app->rename_mailbox( Domain => $mydomain, @@ -825,7 +825,7 @@ sub cp_rename { New_Mailbox => $new_username, ); - die $app->message unless $app->ok; + die $app->message."\n" unless $app->ok; } @@ -838,7 +838,7 @@ sub cp_change { Domain => $mydomain, Timeout => 60, #Debug => 1, - ) or die $@; + ) or die "$@\n"; $app->change_mailbox( Domain => $mydomain, @@ -846,7 +846,7 @@ sub cp_change { Password => $password, ); - die $app->message unless $app->ok; + die $app->message."\n" unless $app->ok; } -- cgit v1.2.1 From dbb26e8eeae5866a4bb48f170229d019e32affef Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 22 Feb 2002 06:39:23 +0000 Subject: don't error out on bad svcnum's, just silently remove them --- FS/FS/queue.pm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/queue.pm b/FS/FS/queue.pm index 83ae17189..69dc71a0b 100644 --- a/FS/FS/queue.pm +++ b/FS/FS/queue.pm @@ -185,10 +185,12 @@ sub check { || $self->ut_enum('status',['', qw( new locked failed )]) || $self->ut_textn('statustext') || $self->ut_numbern('svcnum') - || $self->ut_foreign_keyn('svcnum', 'cust_svc', 'svcnum') ; return $error if $error; + $error = $self->ut_foreign_keyn('svcnum', 'cust_svc', 'svcnum'); + $self->svcnum('') if $error; + $self->status('new') unless $self->status; $self->_date(time) unless $self->_date; @@ -287,7 +289,7 @@ END =head1 VERSION -$Id: queue.pm,v 1.4 2002-02-20 01:03:09 ivan Exp $ +$Id: queue.pm,v 1.5 2002-02-22 06:39:23 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 8f7906377ca3165cc2a398dfdff30531787d6368 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 22 Feb 2002 06:42:28 +0000 Subject: UI in joblisting: don't split ( retry | remove ) links --- FS/FS/queue.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/queue.pm b/FS/FS/queue.pm index 69dc71a0b..3260de20d 100644 --- a/FS/FS/queue.pm +++ b/FS/FS/queue.pm @@ -253,8 +253,8 @@ END $status .= ': '. $queue->statustext if $queue->statustext; if ( ! $noactions && $status =~ /^failed/ || $status =~ /^locked/ ) { $status .= - qq! ( retry |!. - qq! remove )!; + qq! ( retry |!. + qq! remove )!; } my $cust_svc = $queue->cust_svc; my $account; @@ -289,7 +289,7 @@ END =head1 VERSION -$Id: queue.pm,v 1.5 2002-02-22 06:39:23 ivan Exp $ +$Id: queue.pm,v 1.6 2002-02-22 06:42:28 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 1cd0fc70e60e5ecccb10e2bd4dae112a53dde330 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 22 Feb 2002 08:58:11 +0000 Subject: freeside *SUSPENDED* -> CP set_mailbox_status OTHER/OTHER_BOUNCE --- FS/FS/svc_acct.pm | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 2a0c90445..314a7527b 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -840,12 +840,25 @@ sub cp_change { #Debug => 1, ) or die "$@\n"; + if ( $password =~ /^\*SUSPENDED\* (.*)$/ ) { + $password = $1; + $app->set_mailbox_status( + Other => 'T', + Other_Bounce => 'T', + ); + } else { + $app->set_mailbox_status( + Other => 'F', + Other_Bounce => 'F', + ); + } + die $app->message."\n" unless $app->ok; + $app->change_mailbox( Domain => $mydomain, Mailbox => $username, Password => $password, ); - die $app->message."\n" unless $app->ok; } -- cgit v1.2.1 From f430dd9ec58e429c2ddc7c3c83aeaf8d8c74c4fd Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 22 Feb 2002 09:01:08 +0000 Subject: correctly disable/enable accounts @ CP --- FS/FS/svc_acct.pm | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 314a7527b..b90cbe8d3 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -843,12 +843,16 @@ sub cp_change { if ( $password =~ /^\*SUSPENDED\* (.*)$/ ) { $password = $1; $app->set_mailbox_status( - Other => 'T', + Domain => $mydomain, + Mailbox => $username, + Other => 'T', Other_Bounce => 'T', ); } else { $app->set_mailbox_status( - Other => 'F', + Domain => $mydomain, + Mailbox => $username, + Other => 'F', Other_Bounce => 'F', ); } -- cgit v1.2.1 From f96fd39dcc9c2563f8ba2976f7b9d23c0b3fcc29 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 22 Feb 2002 23:08:11 +0000 Subject: fix i18n zip --- FS/FS/cust_pay_batch.pm | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_pay_batch.pm b/FS/FS/cust_pay_batch.pm index dfafb0a13..c4427c387 100644 --- a/FS/FS/cust_pay_batch.pm +++ b/FS/FS/cust_pay_batch.pm @@ -173,13 +173,16 @@ sub check { $self->payname($1); } - $self->zip =~ /^\s*(\w[\w\-\s]{3,8}\w)\s*$/ - or return "Illegal zip: ". $self->zip; - $self->zip($1); + #$self->zip =~ /^\s*(\w[\w\-\s]{3,8}\w)\s*$/ + # or return "Illegal zip: ". $self->zip; + #$self->zip($1); $self->country =~ /^(\w\w)$/ or return "Illegal country: ". $self->country; $self->country($1); + $error = $self->ut_zip('zip', $self->country); + return $error if $error; + #check invnum, custnum, ? ''; #no error @@ -189,7 +192,7 @@ sub check { =head1 VERSION -$Id: cust_pay_batch.pm,v 1.5 2002-02-14 01:12:19 ivan Exp $ +$Id: cust_pay_batch.pm,v 1.6 2002-02-22 23:08:11 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From b50b2e5f94774268c271484f9c07bfe316f95527 Mon Sep 17 00:00:00 2001 From: jeff Date: Fri, 22 Feb 2002 23:18:34 +0000 Subject: add some reporting features --- FS/MANIFEST | 4 + FS/bin/freeside-cc-receipts-report | 231 +++++++++++++++++++++++++++++++ FS/bin/freeside-credit-report | 184 +++++++++++++++++++++++++ FS/bin/freeside-receivables-report | 218 ++++++++++++++++++++++++++++++ FS/bin/freeside-tax-report | 270 +++++++++++++++++++++++++++++++++++++ 5 files changed, 907 insertions(+) create mode 100755 FS/bin/freeside-cc-receipts-report create mode 100755 FS/bin/freeside-credit-report create mode 100755 FS/bin/freeside-receivables-report create mode 100755 FS/bin/freeside-tax-report (limited to 'FS') diff --git a/FS/MANIFEST b/FS/MANIFEST index f7a5c1248..28edf59c3 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -11,6 +11,10 @@ bin/freeside-apply-credits bin/freeside-adduser bin/freeside-setinvoice bin/freeside-overdue +bin/freeside-receivables-report +bin/freeside-tax-report +bin/freeside-cc-receipts-report +bin/freeside-credit-report FS.pm FS/CGI.pm FS/Conf.pm diff --git a/FS/bin/freeside-cc-receipts-report b/FS/bin/freeside-cc-receipts-report new file mode 100755 index 000000000..2713af397 --- /dev/null +++ b/FS/bin/freeside-cc-receipts-report @@ -0,0 +1,231 @@ +#!/usr/bin/perl -Tw + +use strict; +use Date::Parse; +use Time::Local; +use Getopt::Std; +use FS::Conf; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch qsearchs); +use FS::cust_pay; +use FS::cust_pay_batch; + +# Set the mail program +my $mail_program = "/usr/sbin/sendmail -t -n"; + +&untaint_argv; #what it sounds like (eww) +use vars qw($opt_v $opt_p $opt_e $opt_d $opt_s); +getopts("vped:s:"); #switches + +#we're at now now (and later). +my($_enddate)= $main::opt_d ? str2time($main::opt_d) : $^T; +my($_startdate)= $main::opt_d ? str2time($main::opt_s) : $^T; + +# Get the current month +my ($ssec,$smin,$shour,$smday,$smon,$syear) = + (localtime($_startdate) )[0,1,2,3,4,5]; +$syear+=1900; +$smon++; + +# Get the current month +my ($esec,$emin,$ehour,$emday,$emon,$eyear) = + (localtime($_enddate) )[0,1,2,3,4,5]; +$eyear+=1900; +$emon++; + +# Login to the database +my $user = shift or die &usage; +adminsuidsetup $user; + +# Get the needed configuration files +my $conf = new FS::Conf; +my $lpr = $conf->config('lpr'); +my $email = $conf->config('email'); + +my(@cust_pays)=qsearch('cust_pay',{}); +if (scalar(@cust_pays) == 0) +{ + exit 1; +} + +# Open print and email pipes +# $lpr and opt_p for printing +# $email and opt_e for email + +if ($lpr && $main::opt_p) +{ + open(LPR, "|$lpr"); + print LPR qq~ C R E D I T C A R D R E C E I P T S for period beginning: $smon/$smday/$syear and ending $emon/$emday/$eyear\n\n~; +} + +if ($email && $main::opt_e) +{ + open (MAIL, "|$mail_program"); + print MAIL <getfield('_date'); + my $invnum = $cust_pay->getfield('invnum'); + my $paid = $cust_pay->getfield('paid'); + my $payby = $cust_pay->getfield('payby'); + + + if ($_date >= $_startdate && $_date <= $_enddate && $payby =~ 'CARD') { + $total += $paid; + + $uninvoiced += $cust_pay->unapplied; + my @cust_bill_pays = $cust_pay->cust_bill_pay; + foreach my $cust_bill_pay (@cust_bill_pays) { + my $invoice_amt =0; + my $invoice_tax =0; + my(@cust_bill_pkgs)= $cust_bill_pay->cust_bill->cust_bill_pkg; + foreach my $cust_bill_pkg (@cust_bill_pkgs) { + + my $recur = $cust_bill_pkg->getfield('recur'); + my $setup = $cust_bill_pkg->getfield('setup'); + my $pkgnum = $cust_bill_pkg->getfield('pkgnum'); + + if ($pkgnum == 0) { + $invoice_tax += $recur; + $invoice_tax += $setup; + } else { + $invoice_amt += $recur; + $invoice_amt += $setup; + } + + } + + if ($invoice_tax > 0) { + if ($invoice_amt != $paid) { + # attempt to prorate partially paid invoices + $total_tax += $paid / ($invoice_amt + $invoice_tax) * $invoice_tax; + $taxed += $paid / ($invoice_amt + $invoice_tax) * $invoice_amt; + } else { + $total_tax += $invoice_tax; + $taxed += $invoice_amt; + } + } else { + $untaxed += $paid; + } + + } + + } + +} + +if ($main::opt_v) { + printf(qq{\n%25s%14.2f\n}, "Uninvoiced", $uninvoiced); + printf(qq{%25s%14.2f\n}, "Untaxed", $untaxed); + printf(qq{%25s%14.2f\n}, "Taxed", $taxed); + printf(qq{%25s%14.2f\n}, "Tax", $total_tax); + printf(qq{\n%39s\n%39.2f\n}, "=========", $total); +} + +# Now I need to close LPR and EMAIL if they were open +if($lpr && $main::opt_p) +{ + printf(LPR qq{\n%25s%14.2f\n}, "Uninvoiced", $uninvoiced); + printf(LPR qq{%25s%14.2f\n}, "Untaxed", $untaxed); + printf(LPR qq{%25s%14.2f\n}, "Taxed", $taxed); + printf(LPR qq{%25s%14.2f\n}, "Tax", $total_tax); + printf(LPR qq{\n%39s\n%39.2f\n}, "=========", $total); + close LPR || die "Could not close printer: $lpr\n"; +} +if($email && $main::opt_e) +{ + printf(MAIL qq{\n%25s%14.2f\n}, "Untaxed", $untaxed); + printf(MAIL qq{%25s%14.2f\n}, "Taxed", $taxed); + printf(MAIL qq{%25s%14.2f\n}, "Tax", $total_tax); + printf(MAIL qq{\n%39s\n%39.2f\n}, "=========", $total); + close MAIL || die "Could not close printer: $email\n"; +} + + +# subroutines +sub untaint_argv { + foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV + $ARGV[$_] =~ /^([\w\-\/ :]*)$/ || die "Illegal argument \"$ARGV[$_]\""; + $ARGV[$_]=$1; + } +} + +sub usage { + die "Usage:\n\n freeside-tax-report [-v] [-p] [-e] user\n"; +} + +=head1 NAME + +freeside-tax-report - Prints or emails sales taxes invoiced in a given period. + +=head1 SYNOPSIS + + freeside-tax-report [-v] [-p] [-e] user + +=head1 DESCRIPTION + +Prints or emails sales taxes invoiced in a given period. + +-v: Verbose - Prints records to STDOUT. + +-p: Print to printer lpr as found in the conf directory. + +-e: Email output to user found in the Conf email file. + +user: From the mapsecrets file - see config.html from the base documentation + +=head1 VERSION + +$Id: freeside-cc-receipts-report,v 1.1 2002-02-22 23:18:32 jeff Exp $ + +=head1 BUGS + +Yes..... Use at your own risk. No guarantees or warrantees of any +kind apply to this program. Parts of this program are hacked from +other GNU licensed software created mainly by Ivan Kohler. + +This is released under the GNU Public License. See www.gnu.org +for more information regarding this license. + +=head1 SEE ALSO + +L, config.html from the base documentation + +=head1 HISTORY + +griff@aver-computer.com July 99 + +$Log: freeside-cc-receipts-report,v $ +Revision 1.1 2002-02-22 23:18:32 jeff +add some reporting features + +Revision 1.2 2002/02/19 14:24:53 jeff +might be functional now + +Revision 1.1 2000/09/20 19:25:19 jeff +local modifications + +Revision 1.1 2000/05/13 21:57:56 ivan +add print_batch script from Joel Griffiths + + +=cut + + diff --git a/FS/bin/freeside-credit-report b/FS/bin/freeside-credit-report new file mode 100755 index 000000000..4307a21b0 --- /dev/null +++ b/FS/bin/freeside-credit-report @@ -0,0 +1,184 @@ +#!/usr/bin/perl -Tw + +use strict; +use Date::Parse; +use Time::Local; +use Getopt::Std; +use FS::Conf; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch); +use FS::cust_credit; + +# Set the mail program +my $mail_program = "/usr/sbin/sendmail -t -n"; + +&untaint_argv; #what it sounds like (eww) +use vars qw($opt_v $opt_p $opt_e $opt_d $opt_s); +getopts("vped:s:"); #switches + +#we're at now now (and later). +my($_enddate)= $main::opt_d ? str2time($main::opt_d) : $^T; +my($_startdate)= $main::opt_s ? str2time($main::opt_s) : $^T; + +# Get the current month +my ($ssec,$smin,$shour,$smday,$smon,$syear) = + (localtime($_startdate) )[0,1,2,3,4,5]; +$syear+=1900; +$smon++; + +# Get the current month +my ($esec,$emin,$ehour,$emday,$emon,$eyear) = + (localtime($_enddate) )[0,1,2,3,4,5]; +$eyear+=1900; +$emon++; + +# Login to the database +my $user = shift or die &usage; +adminsuidsetup $user; + +# Get the needed configuration files +my $conf = new FS::Conf; +my $lpr = $conf->config('lpr'); +my $email = $conf->config('email'); + +my(@cust_credits)=qsearch('cust_credit',{}); +if (scalar(@cust_credits) == 0) +{ + exit 1; +} + +# Open print and email pipes +# $lpr and opt_p for printing +# $email and opt_e for email + +if ($lpr && $main::opt_p) +{ + open(LPR, "|$lpr"); + print LPR qq~ I N H O U S E C R E D I T S for period beginning: $smon/$smday/$syear and ending $emon/$emday/$eyear\n\n~; +} + +if ($email && $main::opt_e) +{ + open (MAIL, "|$mail_program"); + print MAIL <getfield('_date'); + my $amount = $cust_credit->getfield('amount'); + my $credited = $cust_credit->getfield('credited'); + + + if ($_date >= $_startdate && $_date <= $_enddate) { + $total += $amount; + + my ($sec,$min,$hour,$mday,$mon,$year) = + (localtime($_date) )[0,1,2,3,4,5]; + $mon++; + + } + +} + +if ($main::opt_v) { + printf(qq{\n\n%25s%14.2f\n}, "Credits Offered", $total); + printf(qq{\n%39s\n%39.2f\n}, "=========", $total); +} + +# Now I need to close LPR and EMAIL if they were open +if($lpr && $main::opt_p) +{ + printf(LPR qq{\n\n%25s%14.2f\n}, "Credits Offered", $total); + printf(LPR qq{\n%39s\n%39.2f\n}, "=========", $total); + close LPR || die "Could not close printer: $lpr\n"; +} +if($email && $main::opt_e) +{ + printf(MAIL qq{\n\n%25s%14.2f\n}, "Credits Offered", $total); + printf(MAIL qq{\n%39s\n%39.2f\n}, "=========", $total); + close MAIL || die "Could not close printer: $email\n"; +} + + +# subroutines +sub untaint_argv { + foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV + $ARGV[$_] =~ /^([\w\-\/ :]*)$/ || die "Illegal argument \"$ARGV[$_]\""; + $ARGV[$_]=$1; + } +} + +sub usage { + die "Usage:\n\n freeside-credit-report [-v] [-p] [-e] user\n"; +} + +=head1 NAME + +freeside-credit-report - Prints or emails in house credits offered in a given period. + +=head1 SYNOPSIS + + freeside-credit-report [-v] [-p] [-e] user + +=head1 DESCRIPTION + +Prints or emails in house credits offered in a given period. + +-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. + +user: From the mapsecrets file - see config.html from the base documentation + +=head1 VERSION + +$Id: freeside-credit-report,v 1.1 2002-02-22 23:18:32 jeff Exp $ + +=head1 BUGS + +Yes..... Use at your own risk. No guarantees or warrantees of any +kind apply to this program. Parts of this program are hacked from +other GNU licensed software created mainly by Ivan Kohler. + +This is released under the GNU Public License. See www.gnu.org +for more information regarding this license. + +=head1 SEE ALSO + +L, config.html from the base documentation + +=head1 HISTORY + +griff@aver-computer.com July 99 + +$Log: freeside-credit-report,v $ +Revision 1.1 2002-02-22 23:18:32 jeff +add some reporting features + +Revision 1.1 2002/02/19 14:24:53 jeff +might be functional now + +Revision 1.1 2000/09/20 19:25:19 jeff +local modifications + +Revision 1.1 2000/05/13 21:57:56 ivan +add print_batch script from Joel Griffiths + + +=cut + + diff --git a/FS/bin/freeside-receivables-report b/FS/bin/freeside-receivables-report new file mode 100755 index 000000000..cef652bfe --- /dev/null +++ b/FS/bin/freeside-receivables-report @@ -0,0 +1,218 @@ +#!/usr/bin/perl -Tw + +use strict; +use Date::Parse; +use Time::Local; +use Getopt::Std; +use Text::Template; +use FS::Conf; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch); +use FS::cust_main; + +# Set the mail program +my $mail_program = "/usr/sbin/sendmail -t -n"; + +&untaint_argv; #what it sounds like (eww) +use vars qw($opt_v $opt_p $opt_m $opt_e $opt_t $report_lines $report_template @buf); +getopts("vpmet:"); #switches + +#we're at now now (and later). +my($_date)= $^T; + +# Get the current month +my ($sec,$min,$hour,$mday,$mon,$year) = + (localtime($_date) )[0,1,2,3,4,5]; +$mon++; +$year += 1900; + +# Login to the database +my $user = shift or die &usage; +adminsuidsetup $user; + +# Get the needed configuration files +my $conf = new FS::Conf; +my $lpr = $conf->config('lpr'); +my $email = $conf->config('email'); +my @report_template = $conf->config('report_template') + or die "cannot load config file report_template"; +$report_lines = 0; + foreach ( grep /report_lines\(\d+\)/, @report_template ) { #kludgy :/ + /report_lines\((\d+)\)/; + $report_lines += $1; +} +die "no report_lines() functions in template?" unless $report_lines; +$report_template = new Text::Template ( + TYPE => 'ARRAY', + SOURCE => [ map "$_\n", @report_template ], +) or die "can't create new Text::Template object: $Text::Template::ERROR"; + + +my(@customers)=qsearch('cust_main',{}); +if (scalar(@customers) == 0) +{ + exit 1; +} + +# Open print and email pipes +# $lpr and opt_p for printing +# $email and opt_m for email + +if ($lpr && $opt_p) +{ + open(LPR, "|$lpr"); +} + +if ($email && $opt_m) +{ + open (MAIL, "|$mail_program"); + print MAIL <getfield('custnum'); + my $first = $customer->getfield('first'); + my $last = $customer->getfield('last'); + my $company = $customer->getfield('company'); + my $daytime = $customer->getfield('daytime'); + my $balance = $customer->balance; + + + if ($balance != 0) { + $total += $balance; + push @buf, sprintf(qq{%5d %-32.32s %12s %9.2f}, + $custnum, + $first . " " . $last . " " . $company, + $daytime, + $balance); + + } + +} + +push @buf, ('', sprintf(qq{%61s}, "========="), sprintf(qq{%61.2f}, $total)); + +sub FS::receivables_report::_template::report_lines { + my $lines = shift; + map { + scalar(@buf) ? shift @buf : '' ; + } + ( 1 .. $lines ); +} + +$FS::receivables_report::_template::title = " R E C E I V A B L E S "; +$FS::receivables_report::_template::title = $opt_t if $opt_t; +$FS::receivables_report::_template::page = 1; +$FS::receivables_report::_template::date = $_date; +$FS::receivables_report::_template::date = $_date; +$FS::receivables_report::_template::total_pages = + int( scalar(@buf) / $report_lines); +$FS::receivables_report::_template::total_pages++ if scalar(@buf) % $report_lines; + +my @report; +while (@buf) { + push @report, split("\n", + $report_template->fill_in( PACKAGE => 'FS::receivables_report::_template' ) + ); + $FS::receivables_report::_template::page++; +} + +if ($opt_v) { + print map "$_\n", @report; +} +if($lpr && $opt_p) +{ + print LPR map "$_\n", @report; + print LPR "\f" if $opt_e; + close LPR || die "Could not close printer: $lpr\n"; +} +if($email && $opt_m) +{ + print MAIL map "$_\n", @report; + close MAIL || die "Could not close printer: $email\n"; +} + + +# subroutines + +sub untaint_argv { + foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV + $ARGV[$_] =~ /^([\w\-\/ ]*)$/ || die "Illegal argument \"$ARGV[$_]\""; + $ARGV[$_]=$1; + } +} + +sub usage { + die "Usage:\n\n freeside-receivables-report [-v] [-p] [-e] user\n"; +} + +=head1 NAME + +freeside-receivables-report - Prints or emails outstanding receivables. + +=head1 SYNOPSIS + + freeside-receivables-report [-v] [-p] [-m] [-e] [-t "title"] user + +=head1 DESCRIPTION + +Prints or emails outstanding receivables + +-v: Verbose - Prints records to STDOUT. + +-p: Print to printer lpr as found in the conf directory. + +-m: Mail output to user found in the Conf email file. + +-e: Print a final form feed to the printer. + +-t: supply a title for the top of each page. + +user: From the mapsecrets file - see config.html from the base documentation + +=head1 VERSION + +$Id: freeside-receivables-report,v 1.1 2002-02-22 23:18:32 jeff Exp $ + +=head1 BUGS + +Yes..... Use at your own risk. No guarantees or warrantees of any +kind apply to this program. Parts of this program are hacked from +other GNU licensed software created mainly by Ivan Kohler. + +This is released under the GNU Public License. See www.gnu.org +for more information regarding this license. + +=head1 SEE ALSO + +L, config.html from the base documentation + +=head1 HISTORY + +griff@aver-computer.com July 99 + +$Log: freeside-receivables-report,v $ +Revision 1.1 2002-02-22 23:18:32 jeff +add some reporting features + +Revision 1.1 2000/09/20 19:25:19 jeff +local modifications + +Revision 1.1 2000/05/13 21:57:56 ivan +add print_batch script from Joel Griffiths + + +=cut + + diff --git a/FS/bin/freeside-tax-report b/FS/bin/freeside-tax-report new file mode 100755 index 000000000..334c4107b --- /dev/null +++ b/FS/bin/freeside-tax-report @@ -0,0 +1,270 @@ +#!/usr/bin/perl -Tw + +use strict; +use Date::Parse; +use Time::Local; +use Getopt::Std; +use FS::Conf; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch); +use FS::cust_pay; +use FS::cust_pay_batch; + +# Set the mail program +my $mail_program = "/usr/sbin/sendmail -t -n"; + +&untaint_argv; #what it sounds like (eww) +use vars qw($opt_v $opt_p $opt_e $opt_d $opt_s); +getopts("vped:s:"); #switches + +#we're at now now (and later). +my($_enddate)= $main::opt_d ? str2time($main::opt_d) : $^T; +my($_startdate)= $main::opt_s ? str2time($main::opt_s) : $^T; + +# Get the current month +my ($ssec,$smin,$shour,$smday,$smon,$syear) = + (localtime($_startdate) )[0,1,2,3,4,5]; +$smon++; +$syear -= 100 if $syear >= 100; +$syear = "0" . $syear if $syear < 10; + +# Get the current month +my ($esec,$emin,$ehour,$emday,$emon,$eyear) = + (localtime($_enddate) )[0,1,2,3,4,5]; +$emon++; +$eyear -= 100 if $eyear >= 100; +$eyear = "0" . $eyear if $eyear < 10; + +# Login to the database +my $user = shift or die &usage; +adminsuidsetup $user; + +# Get the needed configuration files +my $conf = new FS::Conf; +my $lpr = $conf->config('lpr'); +my $email = $conf->config('email'); + +my(@cust_bills)=qsearch('cust_bill',{}); +if (scalar(@cust_bills) == 0) +{ + exit 1; +} + +if ($main::opt_v) +{ + print qq~ S A L E S T A X E S I N V O I C E D for period beginning: $smon/$smday/$syear and ending $emon/$emday/$eyear\n\n~; +} + +# Open print and email pipes +# $lpr and opt_p for printing +# $email and opt_e for email + +if ($lpr && $main::opt_p) +{ + open(LPR, "|$lpr"); + print LPR qq~ S A L E S T A X E S I N V O I C E D for period beginning: $smon/$smday/$syear and ending $emon/$emday/$eyear\n\n~; +} + +if ($email && $main::opt_e) +{ + open (MAIL, "|$mail_program"); + print MAIL <getfield('_date'); + my $invnum = $cust_bill->getfield('invnum'); + my $charged = $cust_bill->getfield('charged'); + + + if ($_date >= $_startdate && $_date <= $_enddate) { + $total += $charged; + + # The following lines were used to produce rather verbose reports + #my ($sec,$min,$hour,$mday,$mon,$year) = + # (localtime($_date) )[0,1,2,3,4,5]; + #$mon++; + #$year -= 100 if $year >= 100; + #$year = "0" . $year if $year < 10; + + my $invoice_amt =0; + my $invoice_tax =0; + my $invoice_compped =0; + my(@cust_bill_pkgs)= $cust_bill->cust_bill_pkg; + foreach my $cust_bill_pkg (@cust_bill_pkgs) { + + my $recur = $cust_bill_pkg->getfield('recur'); + my $setup = $cust_bill_pkg->getfield('setup'); + my $pkgnum = $cust_bill_pkg->getfield('pkgnum'); + + if ($pkgnum == 0) { + # The following line was used to produce rather verbose reports + # printf(MAIL qq{\n%10s%15s%14.2f}, "$mon/$mday/$year", "Tax $invnum", $recur+$setup); + $invoice_tax += $recur; + $invoice_tax += $setup; + } else { + # The following line was used to produce rather verbose reports + # printf(MAIL qq{\n%10s%15s%14.2f}, "$mon/$mday/$year", "Inv $invnum", $recur+$setup); + $invoice_amt += $recur; + $invoice_amt += $setup; + } + + } + + my(@cust_bill_pays)= $cust_bill->cust_bill_pay; + foreach my $cust_bill_pay (@cust_bill_pays) { + my $payby = $cust_bill_pay->cust_pay->payby; + my $paid = $cust_bill_pay->getfield('amount'); + if ($payby =~ 'COMP') { + $invoice_compped += $paid; + } + } + + if (abs($invoice_compped - ($invoice_amt + $invoice_tax)) < 0.0001){ + $compped += $invoice_amt; + $compped_tax += $invoice_tax; + } elsif ($invoice_compped > 0) { + printf(qq{\nInvoice %10d has inexpliciable complimentary payments of %14.9f\n}, $invnum, $invoice_compped); + $other += $invoice_amt; + $other_tax += $invoice_tax; + } elsif ($invoice_tax > 0) { + $total_tax += $invoice_tax; + $taxed += $invoice_amt; + } else { + $untaxed += $invoice_amt; + } + + } + +} + +if ($main::opt_v) { + printf(qq{\n\n%25s%14.2f\n}, "Complimentary", $compped); + printf(qq{%25s%14.2f\n}, "Complimentary Tax", $compped_tax); + printf(qq{%25s%14.2f\n}, "Other", $other); + printf(qq{%25s%14.2f\n}, "Other Tax", $other_tax); + printf(qq{%25s%14.2f\n}, "Untaxed", $untaxed); + printf(qq{%25s%14.2f\n}, "Taxed", $taxed); + printf(qq{%25s%14.2f\n}, "Tax", $total_tax); + printf(qq{\n%39s\n%39.2f\n}, "=========", $total); +} + +# Now I need to close LPR and EMAIL if they were open +if($lpr && $main::opt_p) +{ + printf(LPR qq{\n\n%25s%14.2f\n}, "Complimentary", $compped); + printf(LPR qq{%25s%14.2f\n}, "Complimentary Tax", $compped_tax); + printf(LPR qq{%25s%14.2f\n}, "Other", $other); + printf(LPR qq{%25s%14.2f\n}, "Other Tax", $other_tax); + printf(LPR qq{%25s%14.2f\n}, "Untaxed", $untaxed); + printf(LPR qq{%25s%14.2f\n}, "Taxed", $taxed); + printf(LPR qq{%25s%14.2f\n}, "Tax", $total_tax); + printf(LPR qq{\n%39s\n%39.2f\n}, "=========", $total); + close LPR || die "Could not close printer: $lpr\n"; +} +if($email && $main::opt_e) +{ + printf(MAIL qq{\n\n%25s%14.2f\n}, "Complimentary", $compped); + printf(MAIL qq{%25s%14.2f\n}, "Complimentary Tax", $compped_tax); + printf(MAIL qq{%25s%14.2f\n}, "Other", $other); + printf(MAIL qq{%25s%14.2f\n}, "Other Tax", $other_tax); + printf(MAIL qq{%25s%14.2f\n}, "Untaxed", $untaxed); + printf(MAIL qq{%25s%14.2f\n}, "Taxed", $taxed); + printf(MAIL qq{%25s%14.2f\n}, "Tax", $total_tax); + printf(MAIL qq{\n%39s\n%39.2f\n}, "=========", $total); + close MAIL || die "Could not close printer: $email\n"; +} + + +# subroutines +sub untaint_argv { + foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV + $ARGV[$_] =~ /^([\w\-\/ :]*)$/ || die "Illegal argument \"$ARGV[$_]\""; + $ARGV[$_]=$1; + } +} + +sub usage { + die "Usage:\n\n freeside-tax-report [-v] [-p] [-e] user\n"; +} + +=head1 NAME + +freeside-tax-report - Prints or emails sales taxes invoiced in a given period. + +=head1 SYNOPSIS + + freeside-tax-report [-v] [-p] [-e] user + +=head1 DESCRIPTION + +Prints or emails sales taxes invoiced in a given period. + +-v: Verbose - Prints records to STDOUT. + +-p: Print to printer lpr as found in the conf directory. + +-e: Email output to user found in the Conf email file. + +user: From the mapsecrets file - see config.html from the base documentation + +=head1 VERSION + +$Id: freeside-tax-report,v 1.1 2002-02-22 23:18:32 jeff Exp $ + +=head1 BUGS + +Yes..... Use at your own risk. No guarantees or warrantees of any +kind apply to this program. Parts of this program are hacked from +other GNU licensed software created mainly by Ivan Kohler. + +This is released under the GNU Public License. See www.gnu.org +for more information regarding this license. + +=head1 SEE ALSO + +L, config.html from the base documentation + +=head1 HISTORY + +griff@aver-computer.com July 99 + +$Log: freeside-tax-report,v $ +Revision 1.1 2002-02-22 23:18:32 jeff +add some reporting features + +Revision 1.3 2002/02/19 14:24:53 jeff +might be functional now + +Revision 1.2 2001/08/20 18:31:49 jeff +before-merge-to-freeside_1_4_0-pre1 + +Revision 1.1 2000/09/20 19:25:19 jeff +local modifications + +Revision 1.1 2000/05/13 21:57:56 ivan +add print_batch script from Joel Griffiths + + +=cut + + -- cgit v1.2.1 From cefb9727ed4cdfacf3b967485d58b25fbea98c6b Mon Sep 17 00:00:00 2001 From: jeff Date: Sat, 23 Feb 2002 02:14:26 +0000 Subject: report fixes and cruft removal --- FS/FS/UID.pm | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm index 78fe156c3..78910195a 100644 --- a/FS/FS/UID.pm +++ b/FS/FS/UID.pm @@ -73,6 +73,9 @@ sub forksuidsetup { $user = shift; croak "fatal: adminsuidsetup called without arguements" unless $user; + $user =~ /^([\w\-\.]+)/ or croak "fatal: illegal user $user"; + $user = $1; + $ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin'; $ENV{'SHELL'} = '/bin/sh'; $ENV{'IFS'} = " \t\n"; @@ -252,7 +255,7 @@ coderef into the hash %FS::UID::callback : =head1 VERSION -$Id: UID.pm,v 1.12 2002-01-19 15:16:22 ivan Exp $ +$Id: UID.pm,v 1.13 2002-02-23 02:14:25 jeff Exp $ =head1 BUGS -- cgit v1.2.1 From e7156eeb279a7f1318fa4c7a4cce937ae75719e6 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 23 Feb 2002 07:00:21 +0000 Subject: nit --- FS/FS/UID.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm index 78910195a..d34d28e06 100644 --- a/FS/FS/UID.pm +++ b/FS/FS/UID.pm @@ -73,7 +73,7 @@ sub forksuidsetup { $user = shift; croak "fatal: adminsuidsetup called without arguements" unless $user; - $user =~ /^([\w\-\.]+)/ or croak "fatal: illegal user $user"; + $user =~ /^([\w\-\.]+)$/ or croak "fatal: illegal user $user"; $user = $1; $ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin'; @@ -230,7 +230,7 @@ sub getsecrets { die "No user!" unless $user; my($conf) = new FS::Conf $conf_dir; my($line) = grep /^\s*$user\s/, $conf->config('mapsecrets'); - die "User not found in mapsecrets!" unless $line; + die "User $user not found in mapsecrets!" unless $line; $line =~ /^\s*$user\s+(.*)$/; $secrets = $1; die "Illegal mapsecrets line for user?!" unless $secrets; @@ -255,7 +255,7 @@ coderef into the hash %FS::UID::callback : =head1 VERSION -$Id: UID.pm,v 1.13 2002-02-23 02:14:25 jeff Exp $ +$Id: UID.pm,v 1.14 2002-02-23 07:00:21 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 903b22b3da3e3ee493bb322854c6bc0b0085e0dd Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 23 Feb 2002 11:56:55 +0000 Subject: case-insensitive and substring searching --- FS/FS/Record.pm | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 020d14d8f..f30223351 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -180,7 +180,7 @@ sub create { } } -=item qsearch TABLE, HASHREF, SELECT, EXTRA_SQL +=item qsearch TABLE, HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ Searches the database for all records matching (at least) the key/value pairs in HASHREF. Returns all the records found as `FS::TABLE' objects if that @@ -214,6 +214,14 @@ sub qsearch { my $statement = "SELECT $select FROM $stable"; if ( @fields ) { $statement .= ' WHERE '. join(' AND ', map { + + my $op = '='; + if ( ref($record->{$_}) ) { + $op = $record->{$_}{'op'} if $record->{$_}{'op'}; + $op = 'LIKE' if $op =~ /^ILIKE$/i && driver_name !~ /^Pg$/i; + $record->{$_} = $record->{$_}{'value'} + } + if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) { if ( driver_name =~ /^Pg$/i ) { qq-( $_ IS NULL OR $_ = '' )-; @@ -221,7 +229,7 @@ sub qsearch { qq-( $_ IS NULL OR $_ = "" )-; } } else { - "$_ = ?"; + "$_ $op ?"; } } @fields ); } -- cgit v1.2.1 From f856cb7523ad477d63040ff6294a99d7bbd1f2bb Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 26 Feb 2002 08:34:53 +0000 Subject: die with a better error message on bad locales --- FS/FS/cust_main.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 67b426b85..e0796f4f1 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1000,7 +1000,8 @@ sub bill { 'state' => $self->state, 'county' => $self->county, 'country' => $self->country, - } ); + } ) or die "fatal: can't find tax rate for state/county/country ". + $self->state. "/". $self->county. "/". $self->country. "\n"; my $tax = sprintf( "%.2f", $taxable_charged * ( $cust_main_county->getfield('tax') / 100 ) ); -- cgit v1.2.1 From 1da4dc7b91575649612e8f3f55283b5a8b2b8811 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 26 Feb 2002 09:06:51 +0000 Subject: ugh, payname needs first/last i guess --- FS/FS/cust_bill.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 943c7b3ec..1ec9298f0 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -470,7 +470,7 @@ sub realtime_card { my($payname, $payfirst, $paylast); if ( $cust_main->payname ) { $payname = $cust_main->payname; - $payname =~ /^\s*([\w \,\.\-\']*\w)?\s+([\w\,\.\-\']+)$/ + $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)$/ or do { #$dbh->rollback if $oldAutoCommit; return "Illegal payname $payname"; @@ -880,7 +880,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.19 2002-02-12 18:56:16 ivan Exp $ +$Id: cust_bill.pm,v 1.20 2002-02-26 09:06:51 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 1fdd857c556d4e6ee7e2b577085ede891dd41506 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 26 Feb 2002 11:30:25 +0000 Subject: fix nasty logic error triggered by changing a ship_ field from something TO identical to the corresponding non-ship_ field. ouch. --- FS/FS/cust_main.pm | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index e0796f4f1..125332c9d 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -512,6 +512,8 @@ and repalce methods. sub check { my $self = shift; + warn "BEFORE: \n". $self->_dump; + my $error = $self->ut_numbern('custnum') || $self->ut_number('agentnum') @@ -553,7 +555,9 @@ sub check { $self->ss("$1-$2-$3"); } - unless ( $import ) { + +# bad idea to disable, causes billing to fail because of no tax rates later +# unless ( $import ) { unless ( qsearchs('cust_main_county', { 'country' => $self->country, 'state' => '', @@ -566,7 +570,7 @@ sub check { 'country' => $self->country, } ); } - } +# } $error = $self->ut_phonen('daytime', $self->country) @@ -583,7 +587,7 @@ sub check { if ( defined $self->dbdef_table->column('ship_last') ) { if ( grep { $self->getfield($_) ne $self->getfield("ship_$_") } @addfields - && grep $self->getfield("ship_$_"), grep $_ ne 'state', @addfields + && grep { $self->getfield("ship_$_") ne '' } @addfields ) { my $error = @@ -694,6 +698,8 @@ sub check { $self->otaker(getotaker); + warn "AFTER: \n". $self->_dump; + ''; #no error } -- cgit v1.2.1 From fc0715ded1a4c1ace11f1ad1df7600f726206afc Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 26 Feb 2002 11:42:37 +0000 Subject: in Record.pm - call ->check **BEFORE** generating @diff for SQL. causing weird effects with cust_main::check that modifies record (ship_ field weirdness) fix nasty logic error triggered by changing a ship_ field from something TO identical to the corresponding non-ship_ field. ouch --- FS/FS/Record.pm | 12 ++++++------ FS/FS/cust_main.pm | 4 ++-- 2 files changed, 8 insertions(+), 8 deletions(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index f30223351..0aa010bbc 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -575,12 +575,6 @@ sub replace { my ( $new, $old ) = ( shift, shift ); warn "[debug]$me $new ->replace $old\n" if $DEBUG; - my @diff = grep $new->getfield($_) ne $old->getfield($_), $old->fields; - unless ( @diff ) { - carp "[warning]$me $new -> replace $old: records identical"; - return ''; - } - return "Records not in same table!" unless $new->table eq $old->table; my $primary_key = $old->dbdef_table->primary_key; @@ -591,6 +585,12 @@ sub replace { my $error = $new->check; return $error if $error; + my @diff = grep $new->getfield($_) ne $old->getfield($_), $old->fields; + unless ( @diff ) { + carp "[warning]$me $new -> replace $old: records identical"; + return ''; + } + my $statement = "UPDATE ". $old->table. " SET ". join(', ', map { "$_ = ". _quote($new->getfield($_),$old->table,$_) diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 125332c9d..cf5bd3314 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -512,7 +512,7 @@ and repalce methods. sub check { my $self = shift; - warn "BEFORE: \n". $self->_dump; + #warn "BEFORE: \n". $self->_dump; my $error = $self->ut_numbern('custnum') @@ -698,7 +698,7 @@ sub check { $self->otaker(getotaker); - warn "AFTER: \n". $self->_dump; + #warn "AFTER: \n". $self->_dump; ''; #no error } -- cgit v1.2.1 From ffc6bb4416bc6e0c29d0e38a389a948d38c5534c Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 26 Feb 2002 11:53:25 +0000 Subject: okay, finally fix all the weirdness with shipping adresses. whew. --- FS/FS/cust_main.pm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index cf5bd3314..b6d3075e8 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -586,8 +586,9 @@ sub check { ); if ( defined $self->dbdef_table->column('ship_last') ) { - if ( grep { $self->getfield($_) ne $self->getfield("ship_$_") } @addfields - && grep { $self->getfield("ship_$_") ne '' } @addfields + if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") } + @addfields ) + && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields ) ) { my $error = -- cgit v1.2.1 From 49bc2dac92d2bb60e000088449b27aa380cc3490 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 27 Feb 2002 21:57:24 +0000 Subject: better debugging --- FS/FS/cust_main.pm | 10 ++++++++-- FS/bin/freeside-daily | 6 ++++-- 2 files changed, 12 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index b6d3075e8..7445e35bb 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1102,7 +1102,7 @@ sub collect { my $dbh = dbh; my $balance = $self->balance; - warn "collect: balance $balance" if $Debug; + warn "collect customer". $self->custnum. ": balance $balance" if $Debug; unless ( $balance > 0 ) { #redundant????? $dbh->rollback if $oldAutoCommit; #hmm return ''; @@ -1140,10 +1140,16 @@ sub collect { qsearch('part_bill_event', { 'payby' => $self->payby, 'disabled' => '', } ) ) { - #run callback + warn "calling invoice event (". $part_bill_event->eventcode. ")\n" + if $Debug; my $cust_main = $self; #for callback my $error = eval $part_bill_event->eventcode; + if ( $@ ) { + warn "fatal error running invoice event (". part_bill_event->eventcode. + "): $@"; + } + if ( $error ) { warn "Error running invoice event (". $part_bill_event->eventcode. diff --git a/FS/bin/freeside-daily b/FS/bin/freeside-daily index 8d839cb21..e6f02df33 100755 --- a/FS/bin/freeside-daily +++ b/FS/bin/freeside-daily @@ -9,12 +9,14 @@ use FS::Record qw(qsearch qsearchs); use FS::cust_main; &untaint_argv; #what it sounds like (eww) -use vars qw($opt_d); -getopts("d:"); +use vars qw($opt_d $opt_v); +getopts("d:v"); my $user = shift or die &usage; adminsuidsetup $user; +$FS::cust_main::Debug = 1 if $opt_v; + my @cust_main = @ARGV ? map { qsearchs('cust_main', { custnum => $_ } ) } @ARGV : qsearch('cust_main', {} ) -- cgit v1.2.1 From 9dacc694c1401117d7e34376aa4916f5a4810cab Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 27 Feb 2002 22:00:58 +0000 Subject: well, don't make things worse when debugging... --- FS/FS/cust_main.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 7445e35bb..ae6155a57 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1146,7 +1146,7 @@ sub collect { my $error = eval $part_bill_event->eventcode; if ( $@ ) { - warn "fatal error running invoice event (". part_bill_event->eventcode. + warn "fatal error running invoice event (". $part_bill_event->eventcode. "): $@"; } -- cgit v1.2.1 From 6a37289c12238d48ea864b8177216ca276b33a40 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 27 Feb 2002 22:39:14 +0000 Subject: add status and statustext fields to cust_bill_event --- FS/FS/cust_bill_event.pm | 2 ++ 1 file changed, 2 insertions(+) (limited to 'FS') diff --git a/FS/FS/cust_bill_event.pm b/FS/FS/cust_bill_event.pm index cc9ce7cb8..242b39e26 100644 --- a/FS/FS/cust_bill_event.pm +++ b/FS/FS/cust_bill_event.pm @@ -107,6 +107,8 @@ sub check { || $self->ut_number('invnum') || $self->ut_number('eventpart') || $self->ut_number('_date') + || $self->ut_enum('status', [qw( done failed )] + || $self->ut_textn('statustext'); ; return "Unknown invnum" -- cgit v1.2.1 From ddd6429bd05b2854c88b734d859c659de5faf4c6 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 27 Feb 2002 22:40:08 +0000 Subject: errant ; --- FS/FS/cust_bill_event.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_bill_event.pm b/FS/FS/cust_bill_event.pm index 242b39e26..987e53e4b 100644 --- a/FS/FS/cust_bill_event.pm +++ b/FS/FS/cust_bill_event.pm @@ -108,7 +108,7 @@ sub check { || $self->ut_number('eventpart') || $self->ut_number('_date') || $self->ut_enum('status', [qw( done failed )] - || $self->ut_textn('statustext'); + || $self->ut_textn('statustext') ; return "Unknown invnum" -- cgit v1.2.1 From e78d63847de9fbcb78d22188a25b77b7678f1cee Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 27 Feb 2002 22:40:47 +0000 Subject: and missing ) *sigh* --- FS/FS/cust_bill_event.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_bill_event.pm b/FS/FS/cust_bill_event.pm index 987e53e4b..146a30e02 100644 --- a/FS/FS/cust_bill_event.pm +++ b/FS/FS/cust_bill_event.pm @@ -107,7 +107,7 @@ sub check { || $self->ut_number('invnum') || $self->ut_number('eventpart') || $self->ut_number('_date') - || $self->ut_enum('status', [qw( done failed )] + || $self->ut_enum('status', [qw( done failed )]) || $self->ut_textn('statustext') ; -- cgit v1.2.1 From caff66abc3e2ccd9a9c26d4770fe4f4136a2e610 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 27 Feb 2002 23:03:10 +0000 Subject: bubble up billing event errors --- FS/FS/cust_main.pm | 63 ++++++++++++++++++++++++++++-------------------------- 1 file changed, 33 insertions(+), 30 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index ae6155a57..7c9bae3c3 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1135,7 +1135,9 @@ sub collect { grep { $_->seconds <= ( $invoice_time - $cust_bill->_date ) && ! qsearchs( 'cust_bill_event', { 'invnum' => $cust_bill->invnum, - 'eventpart' => $_->eventpart } ) + 'eventpart' => $_->eventpart, + 'status' => 'done', + } ) } qsearch('part_bill_event', { 'payby' => $self->payby, 'disabled' => '', } ) @@ -1145,41 +1147,42 @@ sub collect { my $cust_main = $self; #for callback my $error = eval $part_bill_event->eventcode; + my $status = ''; + my $statustext = ''; if ( $@ ) { - warn "fatal error running invoice event (". $part_bill_event->eventcode. - "): $@"; + $status = 'failed'; + $statustext = $@; + } elsif ( $error ) { + $status = 'done'; + $statustext = $error; + } else { + $status = 'done' } + #add cust_bill_event + my $cust_bill_event = new FS::cust_bill_event { + 'invnum' => $cust_bill->invnum, + 'eventpart' => $part_bill_event->eventpart, + '_date' => $invoice_time, + 'status' => $status, + 'statustext' => $statustext, + }; + $cust_bill_event->insert; if ( $error ) { - - warn "Error running invoice event (". $part_bill_event->eventcode. - "): $error"; - - } else { - - #add cust_bill_event - my $cust_bill_event = new FS::cust_bill_event { - 'invnum' => $cust_bill->invnum, - 'eventpart' => $part_bill_event->eventpart, - '_date' => $invoice_time, - }; - $cust_bill_event->insert; - if ( $error ) { - #$dbh->rollback if $oldAutoCommit; - #return "error: $error"; - - # gah, even with transactions. - $dbh->commit if $oldAutoCommit; #well. - my $e = 'WARNING: Event run but database not updated - '. - 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum. - ', eventpart '. $part_bill_event->eventpart. - ": $error"; - warn $e; - return $e; - } - + #$dbh->rollback if $oldAutoCommit; + #return "error: $error"; + + # gah, even with transactions. + $dbh->commit if $oldAutoCommit; #well. + my $e = 'WARNING: Event run but database not updated - '. + 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum. + ', eventpart '. $part_bill_event->eventpart. + ": $error"; + warn $e; + return $e; } + } } -- cgit v1.2.1 From 2ffcf3ea48312f5b5fb5661e46f5f0b2339f5c4c Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 27 Feb 2002 23:20:58 +0000 Subject: oops, spurious error messages --- FS/FS/cust_main.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 7c9bae3c3..9eb569f96 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1167,7 +1167,7 @@ sub collect { 'status' => $status, 'statustext' => $statustext, }; - $cust_bill_event->insert; + $error = $cust_bill_event->insert; if ( $error ) { #$dbh->rollback if $oldAutoCommit; #return "error: $error"; -- cgit v1.2.1 From 5a30e3a89e4e313a526a7f03afbe94282c715bdd Mon Sep 17 00:00:00 2001 From: jeff Date: Thu, 28 Feb 2002 00:28:02 +0000 Subject: improved vpopmail support for svc_acct records --- FS/FS/svc_acct.pm | 168 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 168 insertions(+) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index b90cbe8d3..6ac2b9d75 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -11,7 +11,11 @@ use vars qw( @ISA $nossh_hack $conf $dir_prefix @shells $usernamemin $dirhash $icradius_dbh @saltset @pw_set); + $rsync $ssh); use Carp; +use File::Path; +use Fcntl qw(:flock); +use FS::UID qw( datasrc ); use FS::Conf; use FS::Record qw( qsearch qsearchs fields dbh ); use FS::svc_Common; @@ -28,6 +32,8 @@ use FS::queue; #ask FS::UID to run this stuff for us later $FS::UID::callback{'FS::svc_acct'} = sub { + $rsync = "rsync"; + $ssh = "ssh"; $conf = new FS::Conf; $dir_prefix = $conf->config('home'); @shells = $conf->config('shells'); @@ -95,6 +101,14 @@ $FS::UID::callback{'FS::svc_acct'} = sub { $icradius_dbh = ''; } $dirhash = $conf->config('dirhash') || 0; + $exportdir = "/usr/local/etc/freeside/export." . datasrc; + if ( $conf->exists('vpopmailmachines') ) { + my (@vpopmailmachines) = $conf->config('vpopmailmachines'); + my ($machine, $dir, $uid, $gid) = split (/\s+/, $vpopmailmachines[0]); + $vpopdir = $dir; + } else { + $vpopdir = ''; + } }; @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); @@ -345,9 +359,28 @@ sub insert { $dbh->rollback if $oldAutoCommit; return "queueing job (transaction rolled back): $error"; } + } + + if ( $vpopdir ) { + + my $vpopmail_queue = + new FS::queue { + 'svcnum' => $self->svcnum, + 'job' => 'FS::svc_acct::vpopmail_insert' + }; + $error = $vpopmail_queue->insert( $self->username, + crypt($self->_password,$saltset[int(rand(64))].$saltset[int(rand(64))]), + $self->domain, + $vpopdir, + ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error } @@ -457,6 +490,49 @@ sub icradius_rr_insert { 1; } + +sub vpopmail_insert { + my( $username, $password, $domain, $vpopdir ) = @_; + + (open(VPASSWD, ">>$exportdir/domains/$domain/vpasswd") + and flock(VPASSWD,LOCK_EX|LOCK_NB) + ) or die "can't open vpasswd file for $username\@$domain: $exportdir/domains/$domain/vpasswd"; + print VPASSWD join(":", + $username, + $password, + '1', + '0', + $username, + "$vpopdir/domains/$domain/$username", + 'NOQUOTA', + ), "\n"; + + flock(VPASSWD,LOCK_UN); + close(VPASSWD); + + mkdir "$exportdir/domains/$domain/$username", 0700 or die "can't create Maildir"; + mkdir "$exportdir/domains/$domain/$username/Maildir", 0700 or die "can't create Maildir"; + mkdir "$exportdir/domains/$domain/$username/Maildir/cur", 0700 or die "can't create Maildir"; + mkdir "$exportdir/domains/$domain/$username/Maildir/new", 0700 or die "can't create Maildir"; + mkdir "$exportdir/domains/$domain/$username/Maildir/tmp", 0700 or die "can't create Maildir"; + + my $queue = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_sync' }; + $error = $queue->insert; + + 1; +} + +sub vpopmail_sync { + + my (@vpopmailmachines) = $conf->config('vpopmailmachines'); + my ($machine, $dir, $uid, $gid) = split (/\s+/, $vpopmailmachines[0]); + + chdir $exportdir; + my @args = ("$rsync", "-rlpt", "-e", "$ssh", "domains/", "vpopmail\@$machine:$pdir/domains/") + system {$args[0]} @args; + +} + =item delete Deletes this account from the database. If there is an error, returns the @@ -601,6 +677,14 @@ sub delete { $dbh->rollback if $oldAutoCommit; return "queueing job (transaction rolled back): $error"; } + } + if ( $vpopdir ) { + my $queue = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_delete' }; + $error = $queue->insert( $self->username, $self->domain ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } } @@ -671,6 +755,33 @@ sub icradius_rr_delete { 1; } +sub vpopmail_delete { + my( $username, $domain ) = @_; + + (open(VPASSWD, "$exportdir/domains/$domain/vpasswd") + and flock(VPASSWD,LOCK_EX|LOCK_NB) + ) or die "can't open $exportdir/domains/$domain/vpasswd: $!"; + + open(VPASSWDTMP, ">$exportdir/domains/$domain/vpasswd.tmp") + or die "Can't open $exportdir/domains/$domain/vpasswd.tmp: $!"; + + while () { + my ($mailbox, $rest) = split(':', $_); + print VPASSWDTMP $_ unless $username eq $mailbox; + } + + close(VPASSWDTMP); + + rename "$exportdir/domains/$domain/vpasswd.tmp", "$exportdir/domains/$domain/vpasswd" + or die "Can't rename $exportdir/domains/$domain/vpasswd.tmp: $!"; + + flock(VPASSWD,LOCK_UN); + close(VPASSWD); + + rmtree "$exportdir/domains/$domain/$username" or die "can't destroy Maildir";+ + 1; +} + =item replace OLD_RECORD Replaces OLD_RECORD with this one in the database. If there is an error, @@ -791,6 +902,31 @@ sub replace { return "queueing job (transaction rolled back): $error"; } } + if ( $vpopdir ) { + my $cpassword = crypt( + $new->_password,$saltset[int(rand(64))].$saltset[int(rand(64))] + ); + + if ($old->username ne $new->username || $old->domain ne $new->domain ) { + my $queue = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_delete' }; + $error = $queue->insert( $old->username, $old->domain ); + my $queue2 = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_insert' }; + $error = $queue2->insert( $new->username, + $cpassword, + $new->domain, + $vpopdir, + ) + unless $error; + } elsif ($old->_password ne $new->_password) { + my $queue = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_replace_password' }; + $error = $queue->insert( $new->username, $cpassword, $new->domain ); + } + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error @@ -867,6 +1003,38 @@ sub cp_change { } +sub vpopmail_replace_password { + my( $username, $password, $domain ) = @_; + + (open(VPASSWD, "$exportdir/domains/$domain/vpasswd") + and flock(VPASSWD,LOCK_EX|LOCK_NB) + ) or die "can't open $exportdir/domains/$domain/vpasswd: $!"; + + open(VPASSWDTMP, ">$exportdir/domains/$domain/vpasswd.tmp") + or die "Can't open $exportdir/domains/$domain/vpasswd.tmp: $!"; + + while () { + my ($mailbox, $pw, @rest) = split(':', $_); + print VPASSWDTMP $_ unless $username eq $mailbox; + print VPASSWDTMP join (':', ($mailbox, $password, @rest)) + if $username eq $mailbox; + } + + close(VPASSWDTMP); + + rename "$exportdir/domains/$domain/vpasswd.tmp", "$exportdir/domains/$domain/vpasswd" + or die "Can't rename $exportdir/domains/$domain/vpasswd.tmp: $!"; + + flock(VPASSWD,LOCK_UN); + close(VPASSWD); + + my $queue = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_sync' }; + $error = $queue->insert; + + 1; +} + + =item suspend Suspends this account by prefixing *SUSPENDED* to the password. If there is an -- cgit v1.2.1 From e8dc13cd1af07846cd3015986f3a3fd34cdcdaea Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 28 Feb 2002 22:05:31 +0000 Subject: s/depreciated/deprecated/ --- FS/FS/Conf.pm | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 226702e5c..6fbd48732 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -185,7 +185,7 @@ httemplate/docs/config.html { 'key' => 'address', - 'section' => 'depreciated', + 'section' => 'deprecated', 'description' => 'This configuration option is no longer used. See invoice_template instead.', 'type' => 'text', }, @@ -304,7 +304,7 @@ httemplate/docs/config.html { 'key' => 'domain', - 'section' => 'depreciated', + 'section' => 'deprecated', 'description' => 'Your domain name.', 'type' => 'text', }, @@ -416,8 +416,8 @@ httemplate/docs/config.html { 'key' => 'maildisablecatchall', - 'section' => 'depreciated', - 'description' => 'DEPRECIATED, now the default. Turning this option on used to disable the requirement that each virtual domain have a catch-all mailbox.', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, now the default. Turning this option on used to disable the requirement that each virtual domain have a catch-all mailbox.', 'type' => 'checkbox', }, @@ -654,8 +654,8 @@ httemplate/docs/config.html { 'key' => 'textradiusprepend', - 'section' => 'depreciated', - 'description' => 'DEPRECIATED, use RADIUS check attributes instead. This option will be removed soon. The contents will be prepended to the first line of a user\'s RADIUS entry in text exports.', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, use RADIUS check attributes instead. This option will be removed soon. The contents will be prepended to the first line of a user\'s RADIUS entry in text exports.', 'type' => 'text', }, -- cgit v1.2.1 From 251540415dbf35a7c91e8338986ece244d77a987 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 28 Feb 2002 23:13:23 +0000 Subject: eek --- FS/FS/svc_acct.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 6ac2b9d75..89fb76c36 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -10,7 +10,7 @@ use vars qw( @ISA $nossh_hack $conf $dir_prefix @shells $usernamemin $cp_server $cp_user $cp_pass $cp_workgroup $dirhash $icradius_dbh - @saltset @pw_set); + @saltset @pw_set $rsync $ssh); use Carp; use File::Path; -- cgit v1.2.1 From e296e99c38ed8fedae98bfd2b8ad063ae513583c Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 28 Feb 2002 23:17:31 +0000 Subject: clean up mess --- FS/FS/svc_acct.pm | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 89fb76c36..86132ffeb 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -11,7 +11,7 @@ use vars qw( @ISA $nossh_hack $conf $dir_prefix @shells $usernamemin $dirhash $icradius_dbh @saltset @pw_set - $rsync $ssh); + $rsync $ssh $exportdir $vpopdir); use Carp; use File::Path; use Fcntl qw(:flock); @@ -495,7 +495,7 @@ sub vpopmail_insert { my( $username, $password, $domain, $vpopdir ) = @_; (open(VPASSWD, ">>$exportdir/domains/$domain/vpasswd") - and flock(VPASSWD,LOCK_EX|LOCK_NB) + and flock(VPASSWD,LOCK_EX) ) or die "can't open vpasswd file for $username\@$domain: $exportdir/domains/$domain/vpasswd"; print VPASSWD join(":", $username, @@ -517,7 +517,8 @@ sub vpopmail_insert { mkdir "$exportdir/domains/$domain/$username/Maildir/tmp", 0700 or die "can't create Maildir"; my $queue = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_sync' }; - $error = $queue->insert; + my $error = $queue->insert; + die $error if $error; 1; } @@ -528,7 +529,7 @@ sub vpopmail_sync { my ($machine, $dir, $uid, $gid) = split (/\s+/, $vpopmailmachines[0]); chdir $exportdir; - my @args = ("$rsync", "-rlpt", "-e", "$ssh", "domains/", "vpopmail\@$machine:$pdir/domains/") + my @args = ("$rsync", "-rlpt", "-e", "$ssh", "domains/", "vpopmail\@$machine:$vpoppdir/domains/"); system {$args[0]} @args; } @@ -759,7 +760,7 @@ sub vpopmail_delete { my( $username, $domain ) = @_; (open(VPASSWD, "$exportdir/domains/$domain/vpasswd") - and flock(VPASSWD,LOCK_EX|LOCK_NB) + and flock(VPASSWD,LOCK_EX) ) or die "can't open $exportdir/domains/$domain/vpasswd: $!"; open(VPASSWDTMP, ">$exportdir/domains/$domain/vpasswd.tmp") @@ -1007,7 +1008,7 @@ sub vpopmail_replace_password { my( $username, $password, $domain ) = @_; (open(VPASSWD, "$exportdir/domains/$domain/vpasswd") - and flock(VPASSWD,LOCK_EX|LOCK_NB) + and flock(VPASSWD,LOCK_EX) ) or die "can't open $exportdir/domains/$domain/vpasswd: $!"; open(VPASSWDTMP, ">$exportdir/domains/$domain/vpasswd.tmp") -- cgit v1.2.1 From e5b4bae07ce072ba1cc6997eadbe3f0c09ff7308 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 28 Feb 2002 23:18:46 +0000 Subject: clean up mess. *sigh* --- FS/FS/svc_acct.pm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 86132ffeb..3c564ec9d 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -529,7 +529,7 @@ sub vpopmail_sync { my ($machine, $dir, $uid, $gid) = split (/\s+/, $vpopmailmachines[0]); chdir $exportdir; - my @args = ("$rsync", "-rlpt", "-e", "$ssh", "domains/", "vpopmail\@$machine:$vpoppdir/domains/"); + my @args = ("$rsync", "-rlpt", "-e", "$ssh", "domains/", "vpopmail\@$machine:$vpopdir/domains/"); system {$args[0]} @args; } @@ -1030,7 +1030,8 @@ sub vpopmail_replace_password { close(VPASSWD); my $queue = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_sync' }; - $error = $queue->insert; + my $error = $queue->insert; + die $error if $error; 1; } -- cgit v1.2.1 From 239484572a9191100993bb1e85ffe8834689feb0 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 4 Mar 2002 12:48:49 +0000 Subject: *** empty log message *** --- FS/FS/Record.pm | 54 +++++++++++++++++++++++++++++++++++++++++++++++------- FS/FS/nas.pm | 4 +++- 2 files changed, 50 insertions(+), 8 deletions(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 0aa010bbc..7dc19ccac 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -344,7 +344,7 @@ sub table { =item dbdef_table -Returns the FS::dbdef_table object for the table. +Returns the DBIx::DBSchema::Table object for the table. =cut @@ -473,20 +473,27 @@ sub insert { $self->unique($primary_key) if $primary_key && ! $self->getfield($primary_key); + #false laziness w/delete my @fields = grep defined($self->getfield($_)) && $self->getfield($_) ne "", $self->fields ; + my @values = map { _quote( $self->getfield($_), $self->table, $_) } @fields; + #eslaf my $statement = "INSERT INTO ". $self->table. " ( ". - join(', ',@fields ). + join( ', ', @fields ). ") VALUES (". - join(', ',map(_quote($self->getfield($_),$self->table,$_), @fields)). + join( ', ', @values ). ")" ; warn "[debug]$me $statement\n" if $DEBUG; my $sth = dbh->prepare($statement) or return dbh->errstr; + my $h_statement = $self->_h_statement('insert'); + warn "[debug]$me $h_statement\n" if $DEBUG; + my $h_sth = dbh->prepare($h_statement) or return dbh->errstr; + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -495,6 +502,7 @@ sub insert { local $SIG{PIPE} = 'IGNORE'; $sth->execute or return $sth->errstr; + $h_sth->execute or return $h_sth->errstr; dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit; ''; @@ -521,7 +529,7 @@ otherwise returns false. sub delete { my $self = shift; - my($statement)="DELETE FROM ". $self->table. " WHERE ". join(' AND ', + my $statement = "DELETE FROM ". $self->table. " WHERE ". join(' AND ', map { $self->getfield($_) eq '' #? "( $_ IS NULL OR $_ = \"\" )" @@ -537,6 +545,10 @@ sub delete { warn "[debug]$me $statement\n" if $DEBUG; my $sth = dbh->prepare($statement) or return dbh->errstr; + my $h_statement = $self->_h_statement('delete'); + warn "[debug]$me $h_statement\n" if $DEBUG; + my $h_sth = dbh->prepare($h_statement) or return dbh->errstr; + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -546,6 +558,7 @@ sub delete { my $rc = $sth->execute or return $sth->errstr; #not portable #return "Record not found, statement:\n$statement" if $rc eq "0E0"; + $h_sth->execute or return $h_sth->errstr; dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit; undef $self; #no need to keep object! @@ -611,6 +624,14 @@ sub replace { warn "[debug]$me $statement\n" if $DEBUG; my $sth = dbh->prepare($statement) or return dbh->errstr; + my $h_old_statement = $old->_h_statement('replace_old'); + warn "[debug]$me $h_old_statement\n" if $DEBUG; + my $h_old_sth = dbh->prepare($h_old_statement) or return dbh->errstr; + + my $h_new_statement = $new->_h_statement('replace_new'); + warn "[debug]$me $h_new_statement\n" if $DEBUG; + my $h_new_sth = dbh->prepare($h_new_statement) or return dbh->errstr; + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -620,6 +641,8 @@ sub replace { my $rc = $sth->execute or return $sth->errstr; #not portable #return "Record not found (or records identical)." if $rc eq "0E0"; + $h_old_sth->execute or return $h_old_sth->errstr; + $h_new_sth->execute or return $h_new_sth->errstr; dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit; ''; @@ -647,6 +670,23 @@ sub check { confess "FS::Record::check not implemented; supply one in subclass!"; } +sub _h_statement { + my( $self, $action ) = @_; + + my @fields = + grep defined($self->getfield($_)) && $self->getfield($_) ne "", + $self->fields + ; + my @values = map { _quote( $self->getfield($_), $self->table, $_) } @fields; + + "INSERT INTO h_". $self->table. " ( ". + join(', ', qw(history_date history_user history_action), @fields ). + ") VALUES (". + join(', ', time, dbh->quote(getotaker()), dbh->quote($action), @values). + ")" + ; +} + =item unique COLUMN Replaces COLUMN in record with a unique number. Called by the B method @@ -1056,7 +1096,7 @@ sub reload_dbdef { =item dbdef -Returns the current database definition. See L. +Returns the current database definition. See L. =cut @@ -1066,7 +1106,7 @@ sub dbdef { $dbdef; } 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'. +type (see L) does not end in `char' or `binary'. =cut @@ -1136,7 +1176,7 @@ 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. +table string should be depriciated in favor of DBIx::DBSchema::Table. No doubt we could benefit from a Tied hash. Documenting how exists / defined true maps to the database (and WHERE clauses) would also help. diff --git a/FS/FS/nas.pm b/FS/FS/nas.pm index cb0c1b901..58c6827ea 100644 --- a/FS/FS/nas.pm +++ b/FS/FS/nas.pm @@ -136,10 +136,12 @@ sub heartbeat { =head1 VERSION -$Id: nas.pm,v 1.5 2001-04-15 13:35:12 ivan Exp $ +$Id: nas.pm,v 1.6 2002-03-04 12:48:49 ivan Exp $ =head1 BUGS +heartbeat method uses SQL directly and doesn't update history tables. + =head1 SEE ALSO L, schema.html from the base documentation. -- cgit v1.2.1 From 0bb8360049c3ec543889d98a8d4ca27051139d68 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 4 Mar 2002 22:10:02 +0000 Subject: make history tables conditional --- FS/FS/Record.pm | 52 ++++++++++++++++++++++++++++++++++++---------------- 1 file changed, 36 insertions(+), 16 deletions(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 7dc19ccac..ea660d48a 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -490,9 +490,14 @@ sub insert { warn "[debug]$me $statement\n" if $DEBUG; my $sth = dbh->prepare($statement) or return dbh->errstr; - my $h_statement = $self->_h_statement('insert'); - warn "[debug]$me $h_statement\n" if $DEBUG; - my $h_sth = dbh->prepare($h_statement) or return dbh->errstr; + my $h_sth; + if ( defined $dbdef->table('h_'. $self->table) ) { + my $h_statement = $self->_h_statement('insert'); + warn "[debug]$me $h_statement\n" if $DEBUG; + $h_sth = dbh->prepare($h_statement) or return dbh->errstr; + } else { + $h_sth = ''; + } local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -502,7 +507,7 @@ sub insert { local $SIG{PIPE} = 'IGNORE'; $sth->execute or return $sth->errstr; - $h_sth->execute or return $h_sth->errstr; + $h_sth->execute or return $h_sth->errstr if $h_sth; dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit; ''; @@ -545,9 +550,14 @@ sub delete { warn "[debug]$me $statement\n" if $DEBUG; my $sth = dbh->prepare($statement) or return dbh->errstr; - my $h_statement = $self->_h_statement('delete'); - warn "[debug]$me $h_statement\n" if $DEBUG; - my $h_sth = dbh->prepare($h_statement) or return dbh->errstr; + my $h_sth; + if ( defined $dbdef->table('h_'. $self->table) ) { + my $h_statement = $self->_h_statement('delete'); + warn "[debug]$me $h_statement\n" if $DEBUG; + $h_sth = dbh->prepare($h_statement) or return dbh->errstr; + } else { + $h_sth = ''; + } local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -558,7 +568,7 @@ sub delete { my $rc = $sth->execute or return $sth->errstr; #not portable #return "Record not found, statement:\n$statement" if $rc eq "0E0"; - $h_sth->execute or return $h_sth->errstr; + $h_sth->execute or return $h_sth->errstr if $h_sth; dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit; undef $self; #no need to keep object! @@ -624,13 +634,23 @@ sub replace { warn "[debug]$me $statement\n" if $DEBUG; my $sth = dbh->prepare($statement) or return dbh->errstr; - my $h_old_statement = $old->_h_statement('replace_old'); - warn "[debug]$me $h_old_statement\n" if $DEBUG; - my $h_old_sth = dbh->prepare($h_old_statement) or return dbh->errstr; + my $h_old_sth; + if ( defined $dbdef->table('h_'. $old->table) ) { + my $h_old_statement = $old->_h_statement('replace_old'); + warn "[debug]$me $h_old_statement\n" if $DEBUG; + $h_old_sth = dbh->prepare($h_old_statement) or return dbh->errstr; + } else { + $h_old_sth = ''; + } - my $h_new_statement = $new->_h_statement('replace_new'); - warn "[debug]$me $h_new_statement\n" if $DEBUG; - my $h_new_sth = dbh->prepare($h_new_statement) or return dbh->errstr; + my $h_new_sth; + if ( defined $dbdef->table('h_'. $new->table) ) { + my $h_new_statement = $new->_h_statement('replace_new'); + warn "[debug]$me $h_new_statement\n" if $DEBUG; + $h_new_sth = dbh->prepare($h_new_statement) or return dbh->errstr; + } else { + $h_new_sth = ''; + } local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -641,8 +661,8 @@ sub replace { my $rc = $sth->execute or return $sth->errstr; #not portable #return "Record not found (or records identical)." if $rc eq "0E0"; - $h_old_sth->execute or return $h_old_sth->errstr; - $h_new_sth->execute or return $h_new_sth->errstr; + $h_old_sth->execute or return $h_old_sth->errstr if $h_old_sth; + $h_new_sth->execute or return $h_new_sth->errstr if $h_new_sth; dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit; ''; -- cgit v1.2.1 From f9734784e69f0a24e25fdeb6554d6563577e9296 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 5 Mar 2002 09:44:09 +0000 Subject: yes i have crazy customers with 8-digit customer numbers --- FS/bin/freeside-receivables-report | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-receivables-report b/FS/bin/freeside-receivables-report index cef652bfe..c4d188c4e 100755 --- a/FS/bin/freeside-receivables-report +++ b/FS/bin/freeside-receivables-report @@ -91,7 +91,7 @@ foreach my $customer (@customers) if ($balance != 0) { $total += $balance; - push @buf, sprintf(qq{%5d %-32.32s %12s %9.2f}, + push @buf, sprintf(qq{%8d %-32.32s %12s %9.2f}, $custnum, $first . " " . $last . " " . $company, $daytime, @@ -183,7 +183,7 @@ user: From the mapsecrets file - see config.html from the base documentation =head1 VERSION -$Id: freeside-receivables-report,v 1.1 2002-02-22 23:18:32 jeff Exp $ +$Id: freeside-receivables-report,v 1.2 2002-03-05 09:44:09 ivan Exp $ =head1 BUGS @@ -203,7 +203,10 @@ L, config.html from the base documentation griff@aver-computer.com July 99 $Log: freeside-receivables-report,v $ -Revision 1.1 2002-02-22 23:18:32 jeff +Revision 1.2 2002-03-05 09:44:09 ivan +yes i have crazy customers with 8-digit customer numbers + +Revision 1.1 2002/02/22 23:18:32 jeff add some reporting features Revision 1.1 2000/09/20 19:25:19 jeff -- cgit v1.2.1 From 6c2f4c44fc083bde9dd055bd4db51e65fa377379 Mon Sep 17 00:00:00 2001 From: jeff Date: Tue, 5 Mar 2002 23:13:24 +0000 Subject: consistency is nice --- FS/bin/freeside-cc-receipts-report | 127 +++++++++++------ FS/bin/freeside-credit-report | 135 +++++++++++------- FS/bin/freeside-receivables-report | 15 +- FS/bin/freeside-tax-report | 273 ++++++++++++++++++++----------------- 4 files changed, 318 insertions(+), 232 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-cc-receipts-report b/FS/bin/freeside-cc-receipts-report index 2713af397..5ea8cc5cb 100755 --- a/FS/bin/freeside-cc-receipts-report +++ b/FS/bin/freeside-cc-receipts-report @@ -1,9 +1,11 @@ #!/usr/bin/perl -Tw + use strict; use Date::Parse; use Time::Local; use Getopt::Std; +use Text::Template; use FS::Conf; use FS::UID qw(adminsuidsetup); use FS::Record qw(qsearch qsearchs); @@ -14,24 +16,24 @@ use FS::cust_pay_batch; my $mail_program = "/usr/sbin/sendmail -t -n"; &untaint_argv; #what it sounds like (eww) -use vars qw($opt_v $opt_p $opt_e $opt_d $opt_s); -getopts("vped:s:"); #switches +use vars qw($opt_v $opt_p $opt_m $opt_e $opt_t $opt_s $opt_f $report_lines $report_template @buf); +getopts("vpmef:s:"); #switches #we're at now now (and later). -my($_enddate)= $main::opt_d ? str2time($main::opt_d) : $^T; -my($_startdate)= $main::opt_d ? str2time($main::opt_s) : $^T; +my($_finishdate)= $opt_f ? str2time($main::opt_f) : $^T; +my($_startdate)= $opt_s ? str2time($main::opt_s) : $^T; # Get the current month my ($ssec,$smin,$shour,$smday,$smon,$syear) = (localtime($_startdate) )[0,1,2,3,4,5]; -$syear+=1900; $smon++; +$syear += 1900; # Get the current month -my ($esec,$emin,$ehour,$emday,$emon,$eyear) = - (localtime($_enddate) )[0,1,2,3,4,5]; -$eyear+=1900; -$emon++; +my ($fsec,$fmin,$fhour,$fmday,$fmon,$fyear) = + (localtime($_finishdate) )[0,1,2,3,4,5]; +$fmon++; +$fyear += 1900; # Login to the database my $user = shift or die &usage; @@ -41,6 +43,19 @@ adminsuidsetup $user; my $conf = new FS::Conf; my $lpr = $conf->config('lpr'); my $email = $conf->config('email'); +my @report_template = $conf->config('report_template') + or die "cannot load config file report_template"; +$report_lines = 0; +foreach ( grep /report_lines\(\d+\)/, @report_template ) { #kludgy :/ + /report_lines\((\d+)\)/; + $report_lines += $1; +} +die "no report_lines() functions in template?" unless $report_lines; +$report_template = new Text::Template ( + TYPE => 'ARRAY', + SOURCE => [ map "$_\n", @report_template ], +) or die "can't create new Text::Template object: $Text::Template::ERROR"; + my(@cust_pays)=qsearch('cust_pay',{}); if (scalar(@cust_pays) == 0) @@ -50,15 +65,14 @@ if (scalar(@cust_pays) == 0) # Open print and email pipes # $lpr and opt_p for printing -# $email and opt_e for email +# $email and opt_m for email if ($lpr && $main::opt_p) { open(LPR, "|$lpr"); - print LPR qq~ C R E D I T C A R D R E C E I P T S for period beginning: $smon/$smday/$syear and ending $emon/$emday/$eyear\n\n~; } -if ($email && $main::opt_e) +if ($email && $main::opt_m) { open (MAIL, "|$mail_program"); print MAIL <getfield('payby'); - if ($_date >= $_startdate && $_date <= $_enddate && $payby =~ 'CARD') { + if ($_date >= $_startdate && $_date <= $_finishdate && $payby =~ 'CARD') { $total += $paid; $uninvoiced += $cust_pay->unapplied; @@ -131,31 +143,54 @@ foreach my $cust_pay (@cust_pays) } -if ($main::opt_v) { - printf(qq{\n%25s%14.2f\n}, "Uninvoiced", $uninvoiced); - printf(qq{%25s%14.2f\n}, "Untaxed", $untaxed); - printf(qq{%25s%14.2f\n}, "Taxed", $taxed); - printf(qq{%25s%14.2f\n}, "Tax", $total_tax); - printf(qq{\n%39s\n%39.2f\n}, "=========", $total); +push @buf, sprintf(qq{\n%25s%14.2f\n}, "Uninvoiced", $uninvoiced); +push @buf, sprintf(qq{%25s%14.2f\n}, "Untaxed", $untaxed); +push @buf, sprintf(qq{%25s%14.2f\n}, "Taxed", $taxed); +push @buf, sprintf(qq{%25s%14.2f\n}, "Tax", $total_tax); +push @buf, sprintf(qq{\n%39s\n%39.2f\n}, "=========", $total); + +sub FS::cc_receipts_report::_template::report_lines { + my $lines = shift; + map { + scalar(@buf) ? shift @buf : '' ; + } + ( 1 .. $lines ); } -# Now I need to close LPR and EMAIL if they were open -if($lpr && $main::opt_p) +$FS::cc_receipts_report::_template::title = qq~CREDIT CARD RECEIPTS for period $smon/$smday/$syear through $fmon/$fmday/$fyear~; +$FS::cc_receipts_report::_template::title = $opt_t if $opt_t; +$FS::cc_receipts_report::_template::page = 1; +$FS::cc_receipts_report::_template::date = $^T; +$FS::cc_receipts_report::_template::date = $^T; +$FS::cc_receipts_report::_template::fdate = $_finishdate; +$FS::cc_receipts_report::_template::fdate = $_finishdate; +$FS::cc_receipts_report::_template::sdate = $_startdate; +$FS::cc_receipts_report::_template::sdate = $_startdate; +$FS::cc_receipts_report::_template::total_pages = + int( scalar(@buf) / $report_lines); +$FS::cc_receipts_report::_template::total_pages++ if scalar(@buf) % $report_lines; + +my @report; +while (@buf) { + push @report, split("\n", + $report_template->fill_in( PACKAGE => 'FS::cc_receipts_report::_template' ) + ); + $FS::cc_receipts_report::_template::page++; +} + +if ($opt_v) { + print map "$_\n", @report; +} +if($lpr && $opt_p) { - printf(LPR qq{\n%25s%14.2f\n}, "Uninvoiced", $uninvoiced); - printf(LPR qq{%25s%14.2f\n}, "Untaxed", $untaxed); - printf(LPR qq{%25s%14.2f\n}, "Taxed", $taxed); - printf(LPR qq{%25s%14.2f\n}, "Tax", $total_tax); - printf(LPR qq{\n%39s\n%39.2f\n}, "=========", $total); - close LPR || die "Could not close printer: $lpr\n"; + print LPR map "$_\n", @report; + print LPR "\f" if $opt_e; + close LPR || die "Could not close printer: $lpr\n"; } -if($email && $main::opt_e) +if($email && $opt_m) { - printf(MAIL qq{\n%25s%14.2f\n}, "Untaxed", $untaxed); - printf(MAIL qq{%25s%14.2f\n}, "Taxed", $taxed); - printf(MAIL qq{%25s%14.2f\n}, "Tax", $total_tax); - printf(MAIL qq{\n%39s\n%39.2f\n}, "=========", $total); - close MAIL || die "Could not close printer: $email\n"; + print MAIL map "$_\n", @report; + close MAIL || die "Could not close printer: $email\n"; } @@ -168,16 +203,16 @@ sub untaint_argv { } sub usage { - die "Usage:\n\n freeside-tax-report [-v] [-p] [-e] user\n"; + die "Usage:\n\n freeside-cc-receipts-report [-v] [-p] [-e] user\n"; } =head1 NAME -freeside-tax-report - Prints or emails sales taxes invoiced in a given period. +freeside-cc-receipts-report - Prints or emails total credit card receipts in a given period. =head1 SYNOPSIS - freeside-tax-report [-v] [-p] [-e] user + freeside-cc-receipts-report [-v] [-p] [-m] [-e] [-t "title"] [-s date] [-f date] user =head1 DESCRIPTION @@ -187,13 +222,21 @@ Prints or emails sales taxes invoiced in a given period. -p: Print to printer lpr as found in the conf directory. --e: Email output to user found in the Conf email file. +-m: Email output to user found in the Conf email file. + +-e: Print a final form feed to the printer. + +-t: supply a title for the top of each page. + +-s: starting date for inclusion + +-f: final date for inclusion user: From the mapsecrets file - see config.html from the base documentation =head1 VERSION -$Id: freeside-cc-receipts-report,v 1.1 2002-02-22 23:18:32 jeff Exp $ +$Id: freeside-cc-receipts-report,v 1.2 2002-03-05 23:13:23 jeff Exp $ =head1 BUGS @@ -213,8 +256,8 @@ L, config.html from the base documentation griff@aver-computer.com July 99 $Log: freeside-cc-receipts-report,v $ -Revision 1.1 2002-02-22 23:18:32 jeff -add some reporting features +Revision 1.2 2002-03-05 23:13:23 jeff +consistency is nice Revision 1.2 2002/02/19 14:24:53 jeff might be functional now diff --git a/FS/bin/freeside-credit-report b/FS/bin/freeside-credit-report index 4307a21b0..92931bcee 100755 --- a/FS/bin/freeside-credit-report +++ b/FS/bin/freeside-credit-report @@ -1,9 +1,11 @@ #!/usr/bin/perl -Tw + use strict; use Date::Parse; use Time::Local; use Getopt::Std; +use Text::Template; use FS::Conf; use FS::UID qw(adminsuidsetup); use FS::Record qw(qsearch); @@ -13,24 +15,24 @@ use FS::cust_credit; my $mail_program = "/usr/sbin/sendmail -t -n"; &untaint_argv; #what it sounds like (eww) -use vars qw($opt_v $opt_p $opt_e $opt_d $opt_s); -getopts("vped:s:"); #switches +use vars qw($opt_v $opt_p $opt_m $opt_e $opt_t $opt_s $opt_f $report_lines $report_template @buf); +getopts("vpmef:s:"); #switches #we're at now now (and later). -my($_enddate)= $main::opt_d ? str2time($main::opt_d) : $^T; -my($_startdate)= $main::opt_s ? str2time($main::opt_s) : $^T; +my($_finishdate)= $opt_f ? str2time($main::opt_f) : $^T; +my($_startdate)= $opt_s ? str2time($main::opt_s) : $^T; # Get the current month my ($ssec,$smin,$shour,$smday,$smon,$syear) = (localtime($_startdate) )[0,1,2,3,4,5]; -$syear+=1900; $smon++; +$syear += 1900; # Get the current month -my ($esec,$emin,$ehour,$emday,$emon,$eyear) = - (localtime($_enddate) )[0,1,2,3,4,5]; -$eyear+=1900; -$emon++; +my ($fsec,$fmin,$fhour,$fmday,$fmon,$fyear) = + (localtime($_finishdate) )[0,1,2,3,4,5]; +$fmon++; +$fyear += 1900; # Login to the database my $user = shift or die &usage; @@ -40,6 +42,19 @@ adminsuidsetup $user; my $conf = new FS::Conf; my $lpr = $conf->config('lpr'); my $email = $conf->config('email'); +my @report_template = $conf->config('report_template') + or die "cannot load config file report_template"; +$report_lines = 0; +foreach ( grep /report_lines\(\d+\)/, @report_template ) { #kludgy :/ + /report_lines\((\d+)\)/; + $report_lines += $1; +} +die "no report_lines() functions in template?" unless $report_lines; +$report_template = new Text::Template ( + TYPE => 'ARRAY', + SOURCE => [ map "$_\n", @report_template ], +) or die "can't create new Text::Template object: $Text::Template::ERROR"; + my(@cust_credits)=qsearch('cust_credit',{}); if (scalar(@cust_credits) == 0) @@ -49,15 +64,14 @@ if (scalar(@cust_credits) == 0) # Open print and email pipes # $lpr and opt_p for printing -# $email and opt_e for email +# $email and opt_m for email if ($lpr && $main::opt_p) { open(LPR, "|$lpr"); - print LPR qq~ I N H O U S E C R E D I T S for period beginning: $smon/$smday/$syear and ending $emon/$emday/$eyear\n\n~; } -if ($email && $main::opt_e) +if ($email && $main::opt_m) { open (MAIL, "|$mail_program"); print MAIL <getfield('_date'); my $amount = $cust_credit->getfield('amount'); - my $credited = $cust_credit->getfield('credited'); - - if ($_date >= $_startdate && $_date <= $_enddate) { + if ($_date >= $_startdate && $_date <= $_finishdate) { $total += $amount; - - my ($sec,$min,$hour,$mday,$mon,$year) = - (localtime($_date) )[0,1,2,3,4,5]; - $mon++; - } +} +push @buf, sprintf(qq{\n%25s%14.2f\n}, "Credits Offered", $total); +push @buf, sprintf(qq{\n%39s\n%39.2f\n}, "=========", $total); + +sub FS::credit_report::_template::report_lines { + my $lines = shift; + map { + scalar(@buf) ? shift @buf : '' ; + } + ( 1 .. $lines ); } -if ($main::opt_v) { - printf(qq{\n\n%25s%14.2f\n}, "Credits Offered", $total); - printf(qq{\n%39s\n%39.2f\n}, "=========", $total); +$FS::credit_report::_template::title = qq~IN HOUSE CREDITS for $smon/$smday/$syear through $fmon/$fmday/$fyear~; +$FS::credit_report::_template::title = $opt_t if $opt_t; +$FS::credit_report::_template::page = 1; +$FS::credit_report::_template::date = $^T; +$FS::credit_report::_template::date = $^T; +$FS::credit_report::_template::fdate = $_finishdate; +$FS::credit_report::_template::fdate = $_finishdate; +$FS::credit_report::_template::sdate = $_startdate; +$FS::credit_report::_template::sdate = $_startdate; +$FS::credit_report::_template::total_pages = + int( scalar(@buf) / $report_lines); +$FS::credit_report::_template::total_pages++ if scalar(@buf) % $report_lines; + +my @report; +while (@buf) { + push @report, split("\n", + $report_template->fill_in( PACKAGE => 'FS::credit_report::_template' ) + ); + $FS::credit_report::_template::page++; } -# Now I need to close LPR and EMAIL if they were open -if($lpr && $main::opt_p) +if ($opt_v) { + print map "$_\n", @report; +} +if($lpr && $opt_p) { - printf(LPR qq{\n\n%25s%14.2f\n}, "Credits Offered", $total); - printf(LPR qq{\n%39s\n%39.2f\n}, "=========", $total); - close LPR || die "Could not close printer: $lpr\n"; + print LPR map "$_\n", @report; + print LPR "\f" if $opt_e; + close LPR || die "Could not close printer: $lpr\n"; } -if($email && $main::opt_e) +if($email && $opt_m) { - printf(MAIL qq{\n\n%25s%14.2f\n}, "Credits Offered", $total); - printf(MAIL qq{\n%39s\n%39.2f\n}, "=========", $total); - close MAIL || die "Could not close printer: $email\n"; + print MAIL map "$_\n", @report; + close MAIL || die "Could not close printer: $email\n"; } @@ -126,27 +162,35 @@ sub usage { =head1 NAME -freeside-credit-report - Prints or emails in house credits offered in a given period. +freeside-credit-report - Prints or emails total credit memos in a given period. =head1 SYNOPSIS - freeside-credit-report [-v] [-p] [-e] user + freeside-credit-report [-v] [-p] [-m] [-e] [-t "title"] [-s date] [-f date] user =head1 DESCRIPTION -Prints or emails in house credits offered in a given period. +Prints or emails total credit memos in a given period. -v: Verbose - Prints records to STDOUT. -p: Print to printer lpr as found in the conf directory. --e: Email output to user found in the Conf email file. +-m: Email output to user found in the Conf email file. + +-e: Print a final form feed to the printer. + +-t: supply a title for the top of each page. + +-s: starting date for inclusion + +-f: final date for inclusion user: From the mapsecrets file - see config.html from the base documentation =head1 VERSION -$Id: freeside-credit-report,v 1.1 2002-02-22 23:18:32 jeff Exp $ +$Id: freeside-credit-report,v 1.2 2002-03-05 23:13:23 jeff Exp $ =head1 BUGS @@ -166,17 +210,8 @@ L, config.html from the base documentation griff@aver-computer.com July 99 $Log: freeside-credit-report,v $ -Revision 1.1 2002-02-22 23:18:32 jeff -add some reporting features - -Revision 1.1 2002/02/19 14:24:53 jeff -might be functional now - -Revision 1.1 2000/09/20 19:25:19 jeff -local modifications - -Revision 1.1 2000/05/13 21:57:56 ivan -add print_batch script from Joel Griffiths +Revision 1.2 2002-03-05 23:13:23 jeff +consistency is nice =cut diff --git a/FS/bin/freeside-receivables-report b/FS/bin/freeside-receivables-report index c4d188c4e..6d04ba94c 100755 --- a/FS/bin/freeside-receivables-report +++ b/FS/bin/freeside-receivables-report @@ -183,7 +183,7 @@ user: From the mapsecrets file - see config.html from the base documentation =head1 VERSION -$Id: freeside-receivables-report,v 1.2 2002-03-05 09:44:09 ivan Exp $ +$Id: freeside-receivables-report,v 1.3 2002-03-05 23:13:23 jeff Exp $ =head1 BUGS @@ -203,17 +203,8 @@ L, config.html from the base documentation griff@aver-computer.com July 99 $Log: freeside-receivables-report,v $ -Revision 1.2 2002-03-05 09:44:09 ivan -yes i have crazy customers with 8-digit customer numbers - -Revision 1.1 2002/02/22 23:18:32 jeff -add some reporting features - -Revision 1.1 2000/09/20 19:25:19 jeff -local modifications - -Revision 1.1 2000/05/13 21:57:56 ivan -add print_batch script from Joel Griffiths +Revision 1.3 2002-03-05 23:13:23 jeff +consistency is nice =cut diff --git a/FS/bin/freeside-tax-report b/FS/bin/freeside-tax-report index 334c4107b..080b4dfa7 100755 --- a/FS/bin/freeside-tax-report +++ b/FS/bin/freeside-tax-report @@ -1,39 +1,40 @@ #!/usr/bin/perl -Tw + use strict; use Date::Parse; use Time::Local; use Getopt::Std; +use Text::Template; use FS::Conf; use FS::UID qw(adminsuidsetup); use FS::Record qw(qsearch); +use FS::cust_bill; +use FS::cust_bill_pay; use FS::cust_pay; -use FS::cust_pay_batch; # Set the mail program my $mail_program = "/usr/sbin/sendmail -t -n"; &untaint_argv; #what it sounds like (eww) -use vars qw($opt_v $opt_p $opt_e $opt_d $opt_s); -getopts("vped:s:"); #switches +use vars qw($opt_v $opt_p $opt_m $opt_e $opt_t $opt_s $opt_f $report_lines $report_template @buf); +getopts("vpmef:s:"); #switches #we're at now now (and later). -my($_enddate)= $main::opt_d ? str2time($main::opt_d) : $^T; -my($_startdate)= $main::opt_s ? str2time($main::opt_s) : $^T; +my($_finishdate)= $opt_f ? str2time($main::opt_f) : $^T; +my($_startdate)= $opt_s ? str2time($main::opt_s) : $^T; # Get the current month my ($ssec,$smin,$shour,$smday,$smon,$syear) = (localtime($_startdate) )[0,1,2,3,4,5]; $smon++; -$syear -= 100 if $syear >= 100; -$syear = "0" . $syear if $syear < 10; +$syear += 1900; # Get the current month -my ($esec,$emin,$ehour,$emday,$emon,$eyear) = - (localtime($_enddate) )[0,1,2,3,4,5]; -$emon++; -$eyear -= 100 if $eyear >= 100; -$eyear = "0" . $eyear if $eyear < 10; +my ($fsec,$fmin,$fhour,$fmday,$fmon,$fyear) = + (localtime($_finishdate) )[0,1,2,3,4,5]; +$fmon++; +$fyear += 1900; # Login to the database my $user = shift or die &usage; @@ -43,6 +44,19 @@ adminsuidsetup $user; my $conf = new FS::Conf; my $lpr = $conf->config('lpr'); my $email = $conf->config('email'); +my @report_template = $conf->config('report_template') + or die "cannot load config file report_template"; +$report_lines = 0; +foreach ( grep /report_lines\(\d+\)/, @report_template ) { #kludgy :/ + /report_lines\((\d+)\)/; + $report_lines += $1; +} +die "no report_lines() functions in template?" unless $report_lines; +$report_template = new Text::Template ( + TYPE => 'ARRAY', + SOURCE => [ map "$_\n", @report_template ], +) or die "can't create new Text::Template object: $Text::Template::ERROR"; + my(@cust_bills)=qsearch('cust_bill',{}); if (scalar(@cust_bills) == 0) @@ -50,22 +64,16 @@ if (scalar(@cust_bills) == 0) exit 1; } -if ($main::opt_v) -{ - print qq~ S A L E S T A X E S I N V O I C E D for period beginning: $smon/$smday/$syear and ending $emon/$emday/$eyear\n\n~; -} - # Open print and email pipes # $lpr and opt_p for printing -# $email and opt_e for email +# $email and opt_m for email if ($lpr && $main::opt_p) { open(LPR, "|$lpr"); - print LPR qq~ S A L E S T A X E S I N V O I C E D for period beginning: $smon/$smday/$syear and ending $emon/$emday/$eyear\n\n~; } -if ($email && $main::opt_e) +if ($email && $main::opt_m) { open (MAIL, "|$mail_program"); print MAIL <getfield('_date'); my $invnum = $cust_bill->getfield('invnum'); my $charged = $cust_bill->getfield('charged'); - - if ($_date >= $_startdate && $_date <= $_enddate) { + if ($_date >= $_startdate && $_date <= $_finishdate) { $total += $charged; - # The following lines were used to produce rather verbose reports - #my ($sec,$min,$hour,$mday,$mon,$year) = - # (localtime($_date) )[0,1,2,3,4,5]; - #$mon++; - #$year -= 100 if $year >= 100; - #$year = "0" . $year if $year < 10; - - my $invoice_amt =0; - my $invoice_tax =0; - my $invoice_compped =0; - my(@cust_bill_pkgs)= $cust_bill->cust_bill_pkg; - foreach my $cust_bill_pkg (@cust_bill_pkgs) { - - my $recur = $cust_bill_pkg->getfield('recur'); - my $setup = $cust_bill_pkg->getfield('setup'); - my $pkgnum = $cust_bill_pkg->getfield('pkgnum'); - - if ($pkgnum == 0) { - # The following line was used to produce rather verbose reports - # printf(MAIL qq{\n%10s%15s%14.2f}, "$mon/$mday/$year", "Tax $invnum", $recur+$setup); - $invoice_tax += $recur; - $invoice_tax += $setup; - } else { - # The following line was used to produce rather verbose reports - # printf(MAIL qq{\n%10s%15s%14.2f}, "$mon/$mday/$year", "Inv $invnum", $recur+$setup); - $invoice_amt += $recur; - $invoice_amt += $setup; - } - - } - - my(@cust_bill_pays)= $cust_bill->cust_bill_pay; - foreach my $cust_bill_pay (@cust_bill_pays) { - my $payby = $cust_bill_pay->cust_pay->payby; - my $paid = $cust_bill_pay->getfield('amount'); - if ($payby =~ 'COMP') { - $invoice_compped += $paid; - } - } - - if (abs($invoice_compped - ($invoice_amt + $invoice_tax)) < 0.0001){ - $compped += $invoice_amt; - $compped_tax += $invoice_tax; - } elsif ($invoice_compped > 0) { - printf(qq{\nInvoice %10d has inexpliciable complimentary payments of %14.9f\n}, $invnum, $invoice_compped); - $other += $invoice_amt; - $other_tax += $invoice_tax; - } elsif ($invoice_tax > 0) { - $total_tax += $invoice_tax; - $taxed += $invoice_amt; - } else { - $untaxed += $invoice_amt; - } - - } + # The following lines were used to produce rather verbose reports + #my ($sec,$min,$hour,$mday,$mon,$year) = + # (localtime($_date) )[0,1,2,3,4,5]; + #$mon++; + #$year -= 100 if $year >= 100; + #$year = "0" . $year if $year < 10; + + my $invoice_amt =0; + my $invoice_tax =0; + my $invoice_comped =0; + my(@cust_bill_pkgs)= $cust_bill->cust_bill_pkg; + foreach my $cust_bill_pkg (@cust_bill_pkgs) { + + my $recur = $cust_bill_pkg->getfield('recur'); + my $setup = $cust_bill_pkg->getfield('setup'); + my $pkgnum = $cust_bill_pkg->getfield('pkgnum'); + + if ($pkgnum == 0) { + # The following line was used to produce rather verbose reports + # push @buf, ('', sprintf(qq{%10s%15s%14.2f}, "$mon/$mday/$year", "Tax $invnum", $recur+$setup)); + $invoice_tax += $recur; + $invoice_tax += $setup; + } else { + # The following line was used to produce rather verbose reports + # push @buf, ('', sprintf(qq{%10s%15s%14.2f}, "$mon/$mday/$year", "Inv $invnum", $recur+$setup)); + $invoice_amt += $recur; + $invoice_amt += $setup; + } + + } + + my(@cust_bill_pays)= $cust_bill->cust_bill_pay; + foreach my $cust_bill_pay (@cust_bill_pays) { + my $payby = $cust_bill_pay->cust_pay->payby; + my $paid = $cust_bill_pay->getfield('amount'); + if ($payby =~ 'COMP') { + $invoice_comped += $paid; + } + } + + if (abs($invoice_comped - ($invoice_amt + $invoice_tax)) < 0.0001){ + $comped += $invoice_amt; + $comped_tax += $invoice_tax; + } elsif ($invoice_comped > 0) { + push @buf, sprintf(qq{\nInvoice %10d has inexpliciable complimentary payments of %14.9f\n}, $invnum, $invoice_comped); + $other += $invoice_amt; + $other_tax += $invoice_tax; + } elsif ($invoice_tax > 0) { + $total_tax += $invoice_tax; + $taxed += $invoice_amt; + } else { + $untaxed += $invoice_amt; + } + + } } -if ($main::opt_v) { - printf(qq{\n\n%25s%14.2f\n}, "Complimentary", $compped); - printf(qq{%25s%14.2f\n}, "Complimentary Tax", $compped_tax); - printf(qq{%25s%14.2f\n}, "Other", $other); - printf(qq{%25s%14.2f\n}, "Other Tax", $other_tax); - printf(qq{%25s%14.2f\n}, "Untaxed", $untaxed); - printf(qq{%25s%14.2f\n}, "Taxed", $taxed); - printf(qq{%25s%14.2f\n}, "Tax", $total_tax); - printf(qq{\n%39s\n%39.2f\n}, "=========", $total); +push @buf, ('', sprintf(qq{%25s%14.2f}, "Complimentary", $comped)); +push @buf, sprintf(qq{%25s%14.2f}, "Complimentary Tax", $comped_tax); +push @buf, sprintf(qq{%25s%14.2f}, "Other", $other); +push @buf, sprintf(qq{%25s%14.2f}, "Other Tax", $other_tax); +push @buf, sprintf(qq{%25s%14.2f}, "Untaxed", $untaxed); +push @buf, sprintf(qq{%25s%14.2f}, "Taxed", $taxed); +push @buf, sprintf(qq{%25s%14.2f}, "Tax", $total_tax); +push @buf, ('', sprintf(qq{%39s}, "========="), sprintf(qq{%39.2f}, $total)); + +sub FS::tax_report::_template::report_lines { + my $lines = shift; + map { + scalar(@buf) ? shift @buf : '' ; + } + ( 1 .. $lines ); +} + +$FS::tax_report::_template::title = qq~SALES TAXES INVOICED for $smon/$smday/$syear through $fmon/$fmday/$fyear~; +$FS::tax_report::_template::title = $opt_t if $opt_t; +$FS::tax_report::_template::page = 1; +$FS::tax_report::_template::date = $^T; +$FS::tax_report::_template::date = $^T; +$FS::tax_report::_template::fdate = $_finishdate; +$FS::tax_report::_template::fdate = $_finishdate; +$FS::tax_report::_template::sdate = $_startdate; +$FS::tax_report::_template::sdate = $_startdate; +$FS::tax_report::_template::total_pages = + int( scalar(@buf) / $report_lines); +$FS::tax_report::_template::total_pages++ if scalar(@buf) % $report_lines; + +my @report; +while (@buf) { + push @report, split("\n", + $report_template->fill_in( PACKAGE => 'FS::tax_report::_template' ) + ); + $FS::tax_report::_template::page++; } -# Now I need to close LPR and EMAIL if they were open -if($lpr && $main::opt_p) +if ($opt_v) { + print map "$_\n", @report; +} +if($lpr && $opt_p) { - printf(LPR qq{\n\n%25s%14.2f\n}, "Complimentary", $compped); - printf(LPR qq{%25s%14.2f\n}, "Complimentary Tax", $compped_tax); - printf(LPR qq{%25s%14.2f\n}, "Other", $other); - printf(LPR qq{%25s%14.2f\n}, "Other Tax", $other_tax); - printf(LPR qq{%25s%14.2f\n}, "Untaxed", $untaxed); - printf(LPR qq{%25s%14.2f\n}, "Taxed", $taxed); - printf(LPR qq{%25s%14.2f\n}, "Tax", $total_tax); - printf(LPR qq{\n%39s\n%39.2f\n}, "=========", $total); - close LPR || die "Could not close printer: $lpr\n"; + print LPR map "$_\n", @report; + print LPR "\f" if $opt_e; + close LPR || die "Could not close printer: $lpr\n"; } -if($email && $main::opt_e) +if($email && $opt_m) { - printf(MAIL qq{\n\n%25s%14.2f\n}, "Complimentary", $compped); - printf(MAIL qq{%25s%14.2f\n}, "Complimentary Tax", $compped_tax); - printf(MAIL qq{%25s%14.2f\n}, "Other", $other); - printf(MAIL qq{%25s%14.2f\n}, "Other Tax", $other_tax); - printf(MAIL qq{%25s%14.2f\n}, "Untaxed", $untaxed); - printf(MAIL qq{%25s%14.2f\n}, "Taxed", $taxed); - printf(MAIL qq{%25s%14.2f\n}, "Tax", $total_tax); - printf(MAIL qq{\n%39s\n%39.2f\n}, "=========", $total); - close MAIL || die "Could not close printer: $email\n"; + print MAIL map "$_\n", @report; + close MAIL || die "Could not close printer: $email\n"; } @@ -213,7 +234,7 @@ freeside-tax-report - Prints or emails sales taxes invoiced in a given period. =head1 SYNOPSIS - freeside-tax-report [-v] [-p] [-e] user + freeside-tax-report [-v] [-p] [-m] [-e] [-t "title"] [-s date] [-f date] user =head1 DESCRIPTION @@ -223,13 +244,21 @@ Prints or emails sales taxes invoiced in a given period. -p: Print to printer lpr as found in the conf directory. --e: Email output to user found in the Conf email file. +-m: Email output to user found in the Conf email file. + +-e: Print a final form feed to the printer. + +-t: supply a title for the top of each page. + +-s: starting date for inclusion + +-f: final date for inclusion user: From the mapsecrets file - see config.html from the base documentation =head1 VERSION -$Id: freeside-tax-report,v 1.1 2002-02-22 23:18:32 jeff Exp $ +$Id: freeside-tax-report,v 1.2 2002-03-05 23:13:23 jeff Exp $ =head1 BUGS @@ -249,20 +278,8 @@ L, config.html from the base documentation griff@aver-computer.com July 99 $Log: freeside-tax-report,v $ -Revision 1.1 2002-02-22 23:18:32 jeff -add some reporting features - -Revision 1.3 2002/02/19 14:24:53 jeff -might be functional now - -Revision 1.2 2001/08/20 18:31:49 jeff -before-merge-to-freeside_1_4_0-pre1 - -Revision 1.1 2000/09/20 19:25:19 jeff -local modifications - -Revision 1.1 2000/05/13 21:57:56 ivan -add print_batch script from Joel Griffiths +Revision 1.2 2002-03-05 23:13:23 jeff +consistency is nice =cut -- cgit v1.2.1 From 8fd504d36e02fd1ac3d0d5c9d6dc723fdb419aa1 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 6 Mar 2002 00:17:32 +0000 Subject: remove CVS Log tag --- FS/bin/freeside-cc-receipts-report | 21 ++++----------------- FS/bin/freeside-credit-report | 12 ++++-------- FS/bin/freeside-receivables-report | 22 +++++++++------------- FS/bin/freeside-tax-report | 12 ++++-------- 4 files changed, 21 insertions(+), 46 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-cc-receipts-report b/FS/bin/freeside-cc-receipts-report index 5ea8cc5cb..48075a888 100755 --- a/FS/bin/freeside-cc-receipts-report +++ b/FS/bin/freeside-cc-receipts-report @@ -236,7 +236,7 @@ user: From the mapsecrets file - see config.html from the base documentation =head1 VERSION -$Id: freeside-cc-receipts-report,v 1.2 2002-03-05 23:13:23 jeff Exp $ +$Id: freeside-cc-receipts-report,v 1.3 2002-03-06 00:17:32 ivan Exp $ =head1 BUGS @@ -251,24 +251,11 @@ for more information regarding this license. L, config.html from the base documentation -=head1 HISTORY +=head1 AUTHOR -griff@aver-computer.com July 99 - -$Log: freeside-cc-receipts-report,v $ -Revision 1.2 2002-03-05 23:13:23 jeff -consistency is nice - -Revision 1.2 2002/02/19 14:24:53 jeff -might be functional now - -Revision 1.1 2000/09/20 19:25:19 jeff -local modifications - -Revision 1.1 2000/05/13 21:57:56 ivan -add print_batch script from Joel Griffiths +Jeff Finucane +based on print-batch by Joel Griffiths =cut - diff --git a/FS/bin/freeside-credit-report b/FS/bin/freeside-credit-report index 92931bcee..c73988321 100755 --- a/FS/bin/freeside-credit-report +++ b/FS/bin/freeside-credit-report @@ -190,7 +190,7 @@ user: From the mapsecrets file - see config.html from the base documentation =head1 VERSION -$Id: freeside-credit-report,v 1.2 2002-03-05 23:13:23 jeff Exp $ +$Id: freeside-credit-report,v 1.3 2002-03-06 00:17:32 ivan Exp $ =head1 BUGS @@ -205,15 +205,11 @@ for more information regarding this license. L, config.html from the base documentation -=head1 HISTORY +=head1 AUTHOR -griff@aver-computer.com July 99 - -$Log: freeside-credit-report,v $ -Revision 1.2 2002-03-05 23:13:23 jeff -consistency is nice +Jeff Finucane +based on print-batch by Joel Griffiths =cut - diff --git a/FS/bin/freeside-receivables-report b/FS/bin/freeside-receivables-report index 6d04ba94c..781e23b18 100755 --- a/FS/bin/freeside-receivables-report +++ b/FS/bin/freeside-receivables-report @@ -169,21 +169,21 @@ freeside-receivables-report - Prints or emails outstanding receivables. Prints or emails outstanding receivables --v: Verbose - Prints records to STDOUT. +B<-v>: Verbose - Prints records to STDOUT. --p: Print to printer lpr as found in the conf directory. +B<-p>: Print to printer lpr as found in the conf directory. --m: Mail output to user found in the Conf email file. +B<-m>: Mail output to user found in the Conf email file. --e: Print a final form feed to the printer. +B<-e>: Print a final form feed to the printer. --t: supply a title for the top of each page. +B<-t>: supply a title for the top of each page. user: From the mapsecrets file - see config.html from the base documentation =head1 VERSION -$Id: freeside-receivables-report,v 1.3 2002-03-05 23:13:23 jeff Exp $ +$Id: freeside-receivables-report,v 1.4 2002-03-06 00:17:32 ivan Exp $ =head1 BUGS @@ -198,15 +198,11 @@ for more information regarding this license. L, config.html from the base documentation -=head1 HISTORY +=head1 AUTHOR -griff@aver-computer.com July 99 - -$Log: freeside-receivables-report,v $ -Revision 1.3 2002-03-05 23:13:23 jeff -consistency is nice +Jeff Finucane +based on print-batch by Joel Griffiths =cut - diff --git a/FS/bin/freeside-tax-report b/FS/bin/freeside-tax-report index 080b4dfa7..ec4b99f81 100755 --- a/FS/bin/freeside-tax-report +++ b/FS/bin/freeside-tax-report @@ -258,7 +258,7 @@ user: From the mapsecrets file - see config.html from the base documentation =head1 VERSION -$Id: freeside-tax-report,v 1.2 2002-03-05 23:13:23 jeff Exp $ +$Id: freeside-tax-report,v 1.3 2002-03-06 00:17:32 ivan Exp $ =head1 BUGS @@ -273,15 +273,11 @@ for more information regarding this license. L, config.html from the base documentation -=head1 HISTORY +=head1 AUTHOR -griff@aver-computer.com July 99 - -$Log: freeside-tax-report,v $ -Revision 1.2 2002-03-05 23:13:23 jeff -consistency is nice +Jeff Finucane +based on print-batch by Joel Griffiths =cut - -- cgit v1.2.1 From a6aa711eb82626bfab39902a6c4d785f3f533ef4 Mon Sep 17 00:00:00 2001 From: jeff Date: Wed, 6 Mar 2002 22:44:14 +0000 Subject: billing expiration alerts --- FS/FS/Conf.pm | 15 +++ FS/MANIFEST | 1 + FS/bin/freeside-expiration-alerter | 209 +++++++++++++++++++++++++++++++++++++ 3 files changed, 225 insertions(+) create mode 100755 FS/bin/freeside-expiration-alerter (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 6fbd48732..e8686b575 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -190,6 +190,13 @@ httemplate/docs/config.html 'type' => 'text', }, + { + 'key' => 'alerter_template', + 'section' => 'billing', + 'description' => 'Template file for billing method expiration alerts. See the billing documentation for details.', + 'type' => 'textarea', + }, + { 'key' => 'apacheroot', 'section' => 'apache', @@ -490,6 +497,14 @@ httemplate/docs/config.html # 'description' => 'Directory which contains domain registry information. Each registry is a directory.', # }, + { + 'key' => 'report_template', + 'section' => 'required', + 'description' => 'Required template file for reports. See the billing documentation for details.', + 'type' => 'textarea', + }, + + { 'key' => 'maxsearchrecordsperpage', 'section' => 'UI', diff --git a/FS/MANIFEST b/FS/MANIFEST index 28edf59c3..c1aa5ef1a 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -15,6 +15,7 @@ bin/freeside-receivables-report bin/freeside-tax-report bin/freeside-cc-receipts-report bin/freeside-credit-report +bin/freeside-expiration-alerter FS.pm FS/CGI.pm FS/Conf.pm diff --git a/FS/bin/freeside-expiration-alerter b/FS/bin/freeside-expiration-alerter new file mode 100755 index 000000000..c3dc37b31 --- /dev/null +++ b/FS/bin/freeside-expiration-alerter @@ -0,0 +1,209 @@ +#!/usr/bin/perl -Tw + +use strict; +use Date::Format; +use Time::Local; +use Text::Template; +use Getopt::Std; +use FS::Conf; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch); +use FS::cust_main; + +use vars qw($smtpmachine); + +#hush, perl! +$FS::alerter::_template::first = ""; +$FS::alerter::_template::last = ""; +$FS::alerter::_template::company = ""; +$FS::alerter::_template::payby = ""; +$FS::alerter::_template::expdate = ""; + +# Set the mail program and other variables +my $mail_program = "/usr/sbin/sendmail -t -n"; +my $mail_sender = "billing\@mydomain.tld"; +my $default_mail_recipient = "postmaster"; +my $warning_time = 30 * 24 * 60 * 60; +my $urgent_time = 15 * 24 * 60 * 60; +my $panic_time = 5 * 24 * 60 * 60; +my $window_time = 24 * 60 * 60; + +&untaint_argv; #what it sounds like (eww) + +#we're at now now (and later). +my($_date)= $^T; + +# Get the current month +my ($sec,$min,$hour,$mday,$mon,$year) = + (localtime($_date) )[0,1,2,3,4,5]; +$mon++; + +# Login to the database +my $user = shift or die &usage; +adminsuidsetup $user; + +# Get the needed configuration files +my $conf = new FS::Conf; +$smtpmachine = $conf->config('smtpmachine'); + +my(@customers)=qsearch('cust_main',{}); +if (scalar(@customers) == 0) +{ + exit 1; +} + +# Open email pipe + +open (MAIL, "|$mail_program"); +print MAIL <config('alerter_template') + or die "cannot load config file alerter_template"; + +my $alerter = new Text::Template (TYPE => 'ARRAY', SOURCE => [ map "$_\n", @alerter_template ]) + or die "can't create new Text::Template object: Text::Template::ERROR"; +$alerter->compile() or die "can't compile template: Text::Template::ERROR"; + +# Now I can start looping +foreach my $customer (@customers) +{ + my $custnum = $customer->getfield('custnum'); + my $first = $customer->getfield('first'); + my $last = $customer->getfield('last'); + my $company = $customer->getfield('company'); + my $payby = $customer->getfield('payby'); + my $payinfo = $customer->getfield('payinfo'); + my $paydate = $customer->getfield('paydate'); + my $daytime = $customer->getfield('daytime'); + my $night = $customer->getfield('night'); + + my ($payyear,$paymonth,$payday) = split (/-/,$paydate); + + my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear); + + #credit cards expire at the end of the month/year of their exp date + if ($payby eq 'CARD') { + ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++); + $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear); + $expire_time--; + } + + if (($expire_time < $_date + $warning_time && + $expire_time > $_date + $warning_time - $window_time) || + ($expire_time < $_date + $urgent_time && + $expire_time > $_date + $urgent_time - $window_time) || + ($expire_time < $_date + $panic_time && + $expire_time > $_date + $panic_time - $window_time)) { + + + + my @packages = $customer->ncancelled_pkgs; + if (scalar(@packages) != 0) { + my @invoicing_list = $customer->invoicing_list; + if ( grep { $_ ne 'POST' } @invoicing_list ) { + $ENV{SMTPHOSTS} = $smtpmachine; + $ENV{MAILADDRESS} = $mail_sender; + my $header = new Mail::Header ( [ + "From: $mail_sender", + "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ), + "Sender: $mail_sender", + "Reply-To: $mail_sender", + "Date: ". time2str("%a, %d %b %Y %X %z", time), + "Subject: Billing Arrangement Expiration", + ] ); + $FS::alerter::_template::first = $first; + $FS::alerter::_template::last = $last; + $FS::alerter::_template::company = $company; + if ($payby eq 'CARD') { + $FS::alerter::_template::payby = "credit card (" . + substr($payinfo, 0, 2) . "xxxxxxxxxx" . + substr($payinfo, -4) . ")"; + }elsif ($payby eq 'COMP') { + $FS::alerter::_template::payby = "complimentary account"; + }else{ + $FS::alerter::_template::payby = "current method"; + } + $FS::alerter::_template::expdate = $expire_time; + + my $message = new Mail::Internet ( + 'Header' => $header, + 'Body' => [ $alerter->fill_in( PACKAGE => 'FS::alerter::_template' ) ], + ); + $message->smtpsend or die "Can't send invoice email!: $!"; #die? warn? + + } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) { + printf(MAIL qq{%5d %-32.32s %4s %10s %12s %12s\n}, + $custnum, + $first . " " . $last . " " . $company, + $payby, + $paydate, + $daytime, + $night); + } + } + } +} + +# Now I need to close EMAIL +close MAIL || die "Could not close printer: $default_mail_recipient\n"; + + +# subroutines +sub untaint_argv { + foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV + $ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal argument \"$ARGV[$_]\""; + $ARGV[$_]=$1; + } +} + +sub usage { + die "Usage:\n\n freeside-expiration-alerter user\n"; +} + +=head1 NAME + +freeside-expiration-alerter - Emails notifications of credit card expirations. + +=head1 SYNOPSIS + + freeside-expiration-alerter user + +=head1 DESCRIPTION + +Emails customers notice that their credit card or other billing arrangement +is about to expire. Usually run as a cron job. + +user: From the mapsecrets file - see config.html from the base documentation + +=head1 VERSION + +$Id: freeside-expiration-alerter,v 1.1 2002-03-06 22:44:13 jeff Exp $ + +=head1 BUGS + +Yes..... Use at your own risk. No guarantees or warrantees of any +kind apply to this program. Parts of this program are hacked from +other GNU licensed software created mainly by Ivan Kohler. + +This is released under the GNU Public License. See www.gnu.org +for more information regarding this license. + +=head1 SEE ALSO + +L, config.html from the base documentation + +=head1 AUTHOR + +Jeff Finucane + +=cut + + -- cgit v1.2.1 From 9208e850bf047eb4a4438ad3958b7891370d2cb1 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 7 Mar 2002 14:10:10 +0000 Subject: *** empty log message *** --- FS/FS/cust_bill.pm | 15 ++++---- FS/FS/part_export.pm | 87 ++++++++++++++++++++++++++++++++++++++++++--- FS/FS/part_export_option.pm | 4 +-- FS/FS/queue.pm | 3 +- 4 files changed, 95 insertions(+), 14 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 1ec9298f0..6de88cc38 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -388,7 +388,7 @@ sub send { #my @print_text = $cust_bill->print_text; #( date ) my @invoicing_list = $self->cust_main->invoicing_list; if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice - $ENV{SMTPHOSTS} = $smtpmachine; + #$ENV{SMTPHOSTS} = $smtpmachine; $ENV{MAILADDRESS} = $invoice_from; my $header = new Mail::Header ( [ "From: $invoice_from", @@ -401,11 +401,14 @@ sub send { my $message = new Mail::Internet ( 'Header' => $header, 'Body' => [ $self->print_text ], #( date) + #'Debug' => 1, ); - $message->smtpsend - or return "(customer # ". $self->custnum. ") can't send invoice email". - " for ". join(', ', grep { $_ ne 'POST' } @invoicing_list ). - " to server $smtpmachine!"; + $!=0; + $message->smtpsend( Host => $smtpmachine ) + or $message->smtpsend( Host => $smtpmachine, Debug => 1 ) + or return "(customer # ". $self->custnum. ") can't send invoice email". + " to ". join(', ', grep { $_ ne 'POST' } @invoicing_list ). + " via server $smtpmachine with SMTP: $!"; #} elsif ( grep { $_ eq 'POST' } @invoicing_list ) { } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) { @@ -880,7 +883,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.20 2002-02-26 09:06:51 ivan Exp $ +$Id: cust_bill.pm,v 1.21 2002-03-07 14:10:10 ivan Exp $ =head1 BUGS diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 67371bc3b..a0de03b63 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -2,8 +2,9 @@ package FS::part_export; use strict; use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); +use FS::Record qw( qsearch qsearchs dbh ); use FS::part_svc; +use FS::part_export_option; @ISA = qw(FS::Record); @@ -18,7 +19,10 @@ FS::part_export - Object methods for part_export records $record = new FS::part_export \%hash; $record = new FS::part_export { 'column' => 'value' }; - $error = $record->insert; + ($new_record, $options) = $template_recored->clone( $svcpart ); + + $error = $record->insert( { 'option' => 'value' } ); + $error = $record->insert( \$options ); $error = $new_record->replace($old_record); @@ -34,7 +38,7 @@ fields are currently supported: =over 4 -=item eventpart - primary key +=item exportnum - primary key =item svcpart - Service definition (see L) to which this export applies @@ -63,14 +67,76 @@ points to. You can ask the object for a copy with the I method. sub table { 'part_export'; } -=item insert +=item clone SVCPART + +An alternate constructor. Creates a new export by duplicating an existing +export. The given svcpart is assigned to the new export. + +Returns a list consisting of the new export object and a hashref of options. + +=cut + +sub clone { + my $self = shift; + my $class = ref($self); + my %hash = $self->hash; + $hash{'exportnum'} = ''; + $hash{'svcpart'} = shift; + ( $class->new( \%hash ), + { map { $_->optionname => $_->optionvalue } + qsearch('part_export_option', { 'exportnum' => $self->exportnum } ) + } + ); +} + +=item insert HASHREF Adds this record to the database. If there is an error, returns the error, otherwise returns false. +If a hash reference of options is supplied, part_export_option records are +created (see L). + =cut -# the insert method can be inherited from FS::Record +#false laziness w/queue.pm +sub insert { + my $self = shift; + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $self->SUPER::insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + my $options = shift; + foreach my $optionname ( keys %{$options} ) { + my $part_export_option = new FS::part_export_option ( { + 'optionname' => $optionname, + 'optionvalue' => $options->{$optionname}, + } ); + $error = $part_export_option->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; + +}; =item delete @@ -121,6 +187,17 @@ sub check { ''; #no error } +=item part_svc + +Returns the service definition (see L) for this export. + +=cut + +sub part_svc { + my $self = shift; + qsearchs('part_svc', { svcpart => $self->svcpart } ); +} + =back =head1 BUGS diff --git a/FS/FS/part_export_option.pm b/FS/FS/part_export_option.pm index 4ce70b4cd..1ce0de65f 100644 --- a/FS/FS/part_export_option.pm +++ b/FS/FS/part_export_option.pm @@ -38,7 +38,7 @@ currently supported: =item exportnum - export (see L) -=item option - option name +=item optionname - option name =item opeionvalue - option value @@ -105,7 +105,7 @@ sub check { my $error = $self->ut_numbern('optionnum') || $self->ut_number('exportnum') - || $self->ut_alpha('option') + || $self->ut_alpha('optionname') || $self->ut_textn('optionvalue') ; return $error if $error; diff --git a/FS/FS/queue.pm b/FS/FS/queue.pm index 3260de20d..a6d78e143 100644 --- a/FS/FS/queue.pm +++ b/FS/FS/queue.pm @@ -78,6 +78,7 @@ created (see L). =cut +#false laziness w/part_export.pm sub insert { my $self = shift; @@ -289,7 +290,7 @@ END =head1 VERSION -$Id: queue.pm,v 1.6 2002-02-22 06:42:28 ivan Exp $ +$Id: queue.pm,v 1.7 2002-03-07 14:10:10 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 64ed7b8c527bcf3e689a3f61fcdb8b4185460936 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 7 Mar 2002 14:13:21 +0000 Subject: better error msgs for mail errors --- FS/FS/cust_bill.pm | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 6de88cc38..c3524b984 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -401,7 +401,6 @@ sub send { my $message = new Mail::Internet ( 'Header' => $header, 'Body' => [ $self->print_text ], #( date) - #'Debug' => 1, ); $!=0; $message->smtpsend( Host => $smtpmachine ) @@ -883,7 +882,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.21 2002-03-07 14:10:10 ivan Exp $ +$Id: cust_bill.pm,v 1.22 2002-03-07 14:13:21 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 3e2e5fecb9ef3cf39a6ac098aacb76763edd3938 Mon Sep 17 00:00:00 2001 From: jeff Date: Thu, 7 Mar 2002 19:50:24 +0000 Subject: less shelling, more perly - abolish some pipes to sendmail --- FS/bin/freeside-cc-receipts-report | 37 ++++++++++++++--------- FS/bin/freeside-credit-report | 37 ++++++++++++++--------- FS/bin/freeside-expiration-alerter | 60 +++++++++++++++++++++++--------------- FS/bin/freeside-receivables-report | 37 ++++++++++++++--------- FS/bin/freeside-tax-report | 37 ++++++++++++++--------- 5 files changed, 129 insertions(+), 79 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-cc-receipts-report b/FS/bin/freeside-cc-receipts-report index 48075a888..06e3aba81 100755 --- a/FS/bin/freeside-cc-receipts-report +++ b/FS/bin/freeside-cc-receipts-report @@ -6,17 +6,18 @@ use Date::Parse; use Time::Local; use Getopt::Std; use Text::Template; +use Net::SMTP; +use Mail::Header; +use Mail::Internet; use FS::Conf; use FS::UID qw(adminsuidsetup); use FS::Record qw(qsearch qsearchs); use FS::cust_pay; use FS::cust_pay_batch; -# Set the mail program -my $mail_program = "/usr/sbin/sendmail -t -n"; &untaint_argv; #what it sounds like (eww) -use vars qw($opt_v $opt_p $opt_m $opt_e $opt_t $opt_s $opt_f $report_lines $report_template @buf); +use vars qw($opt_v $opt_p $opt_m $opt_e $opt_t $opt_s $opt_f $report_lines $report_template @buf $header); getopts("vpmef:s:"); #switches #we're at now now (and later). @@ -43,6 +44,9 @@ adminsuidsetup $user; my $conf = new FS::Conf; my $lpr = $conf->config('lpr'); my $email = $conf->config('email'); +my $smtpmachine = $conf->config('smtpmachine'); +my $mail_sender = $conf->exists('invoice_from') ? $conf->config('invoice_from') : + 'postmaster'; my @report_template = $conf->config('report_template') or die "cannot load config file report_template"; $report_lines = 0; @@ -74,14 +78,14 @@ if ($lpr && $main::opt_p) if ($email && $main::opt_m) { - open (MAIL, "|$mail_program"); - print MAIL < $header, + 'Body' => [ (@report) ], + ); + $!=0; + $message->smtpsend( Host => "$smtpmachine" ) + or die "can't send report to $email via $smtpmachine: $!"; } @@ -236,7 +245,7 @@ user: From the mapsecrets file - see config.html from the base documentation =head1 VERSION -$Id: freeside-cc-receipts-report,v 1.3 2002-03-06 00:17:32 ivan Exp $ +$Id: freeside-cc-receipts-report,v 1.4 2002-03-07 19:50:23 jeff Exp $ =head1 BUGS diff --git a/FS/bin/freeside-credit-report b/FS/bin/freeside-credit-report index c73988321..7699daf4d 100755 --- a/FS/bin/freeside-credit-report +++ b/FS/bin/freeside-credit-report @@ -6,16 +6,17 @@ use Date::Parse; use Time::Local; use Getopt::Std; use Text::Template; +use Net::SMTP; +use Mail::Header; +use Mail::Internet; use FS::Conf; use FS::UID qw(adminsuidsetup); use FS::Record qw(qsearch); use FS::cust_credit; -# Set the mail program -my $mail_program = "/usr/sbin/sendmail -t -n"; &untaint_argv; #what it sounds like (eww) -use vars qw($opt_v $opt_p $opt_m $opt_e $opt_t $opt_s $opt_f $report_lines $report_template @buf); +use vars qw($opt_v $opt_p $opt_m $opt_e $opt_t $opt_s $opt_f $report_lines $report_template @buf $header); getopts("vpmef:s:"); #switches #we're at now now (and later). @@ -42,6 +43,9 @@ adminsuidsetup $user; my $conf = new FS::Conf; my $lpr = $conf->config('lpr'); my $email = $conf->config('email'); +my $smtpmachine = $conf->config('smtpmachine'); +my $mail_sender = $conf->exists('invoice_from') ? $conf->config('invoice_from') : + 'postmaster'; my @report_template = $conf->config('report_template') or die "cannot load config file report_template"; $report_lines = 0; @@ -73,14 +77,14 @@ if ($lpr && $main::opt_p) if ($email && $main::opt_m) { - open (MAIL, "|$mail_program"); - print MAIL < $header, + 'Body' => [ (@report) ], + ); + $!=0; + $message->smtpsend( Host => "$smtpmachine" ) + or die "can't send report to $email via $smtpmachine: $!"; } @@ -190,7 +199,7 @@ user: From the mapsecrets file - see config.html from the base documentation =head1 VERSION -$Id: freeside-credit-report,v 1.3 2002-03-06 00:17:32 ivan Exp $ +$Id: freeside-credit-report,v 1.4 2002-03-07 19:50:24 jeff Exp $ =head1 BUGS diff --git a/FS/bin/freeside-expiration-alerter b/FS/bin/freeside-expiration-alerter index c3dc37b31..365b96467 100755 --- a/FS/bin/freeside-expiration-alerter +++ b/FS/bin/freeside-expiration-alerter @@ -5,12 +5,15 @@ use Date::Format; use Time::Local; use Text::Template; use Getopt::Std; +use Net::SMTP; +use Mail::Header; +use Mail::Internet; use FS::Conf; use FS::UID qw(adminsuidsetup); use FS::Record qw(qsearch); use FS::cust_main; -use vars qw($smtpmachine); +use vars qw($smtpmachine @body); #hush, perl! $FS::alerter::_template::first = ""; @@ -20,9 +23,8 @@ $FS::alerter::_template::payby = ""; $FS::alerter::_template::expdate = ""; # Set the mail program and other variables -my $mail_program = "/usr/sbin/sendmail -t -n"; -my $mail_sender = "billing\@mydomain.tld"; -my $default_mail_recipient = "postmaster"; +my $mail_sender = "billing\@mydomain.tld"; # or invoice_from if available +my $failure_recipient = "postmaster"; # or invoice_from if available my $warning_time = 30 * 24 * 60 * 60; my $urgent_time = 15 * 24 * 60 * 60; my $panic_time = 5 * 24 * 60 * 60; @@ -45,6 +47,11 @@ adminsuidsetup $user; # Get the needed configuration files my $conf = new FS::Conf; $smtpmachine = $conf->config('smtpmachine'); +$mail_sender = $conf->config('invoice_from') + if $conf->exists('invoice_from'); +$failure_recipient = $conf->config('invoice_from') + if $conf->exists('invoice_from'); + my(@customers)=qsearch('cust_main',{}); if (scalar(@customers) == 0) @@ -52,18 +59,16 @@ if (scalar(@customers) == 0) exit 1; } -# Open email pipe - -open (MAIL, "|$mail_program"); -print MAIL <config('alerter_template') or die "cannot load config file alerter_template"; @@ -109,8 +114,6 @@ foreach my $customer (@customers) if (scalar(@packages) != 0) { my @invoicing_list = $customer->invoicing_list; if ( grep { $_ ne 'POST' } @invoicing_list ) { - $ENV{SMTPHOSTS} = $smtpmachine; - $ENV{MAILADDRESS} = $mail_sender; my $header = new Mail::Header ( [ "From: $mail_sender", "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ), @@ -137,10 +140,12 @@ foreach my $customer (@customers) 'Header' => $header, 'Body' => [ $alerter->fill_in( PACKAGE => 'FS::alerter::_template' ) ], ); - $message->smtpsend or die "Can't send invoice email!: $!"; #die? warn? + $!=0; + $message->smtpsend( Host => $smtpmachine ) + or die "Can't send expiration email!: $!"; #die? warn? } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) { - printf(MAIL qq{%5d %-32.32s %4s %10s %12s %12s\n}, + push @body, sprintf(qq{%5d %-32.32s %4s %10s %12s %12s}, $custnum, $first . " " . $last . " " . $company, $payby, @@ -152,9 +157,18 @@ foreach my $customer (@customers) } } -# Now I need to close EMAIL -close MAIL || die "Could not close printer: $default_mail_recipient\n"; - +# Now I need to send EMAIL +if (scalar(@body)) { + my $message = new Mail::Internet ( + 'Header' => $header, + 'Body' => [ (@body) ], + ); + $!=0; + $message->smtpsend( Host => $smtpmachine ) + or $message->smtpsend( Host => $smtpmachine, Debug => 1 ) + or return "can't send alerter failure email to $failure_recipient". + " via server $smtpmachine with SMTP: $!"; +} # subroutines sub untaint_argv { @@ -185,7 +199,7 @@ user: From the mapsecrets file - see config.html from the base documentation =head1 VERSION -$Id: freeside-expiration-alerter,v 1.1 2002-03-06 22:44:13 jeff Exp $ +$Id: freeside-expiration-alerter,v 1.2 2002-03-07 19:50:24 jeff Exp $ =head1 BUGS diff --git a/FS/bin/freeside-receivables-report b/FS/bin/freeside-receivables-report index 781e23b18..b5a49031e 100755 --- a/FS/bin/freeside-receivables-report +++ b/FS/bin/freeside-receivables-report @@ -5,16 +5,17 @@ use Date::Parse; use Time::Local; use Getopt::Std; use Text::Template; +use Net::SMTP; +use Mail::Header; +use Mail::Internet; use FS::Conf; use FS::UID qw(adminsuidsetup); use FS::Record qw(qsearch); use FS::cust_main; -# Set the mail program -my $mail_program = "/usr/sbin/sendmail -t -n"; &untaint_argv; #what it sounds like (eww) -use vars qw($opt_v $opt_p $opt_m $opt_e $opt_t $report_lines $report_template @buf); +use vars qw($opt_v $opt_p $opt_m $opt_e $opt_t $report_lines $report_template @buf $header); getopts("vpmet:"); #switches #we're at now now (and later). @@ -34,6 +35,9 @@ adminsuidsetup $user; my $conf = new FS::Conf; my $lpr = $conf->config('lpr'); my $email = $conf->config('email'); +my $smtpmachine = $conf->config('smtpmachine'); +my $mail_sender = $conf->exists('invoice_from') ? $conf->config('invoice_from') : + 'postmaster'; my @report_template = $conf->config('report_template') or die "cannot load config file report_template"; $report_lines = 0; @@ -65,14 +69,14 @@ if ($lpr && $opt_p) if ($email && $opt_m) { - open (MAIL, "|$mail_program"); - print MAIL < $header, + 'Body' => [ (@report) ], + ); + $!=0; + $message->smtpsend( Host => "$smtpmachine" ) + or die "can't send report to $email via $smtpmachine: $!"; } @@ -183,7 +192,7 @@ user: From the mapsecrets file - see config.html from the base documentation =head1 VERSION -$Id: freeside-receivables-report,v 1.4 2002-03-06 00:17:32 ivan Exp $ +$Id: freeside-receivables-report,v 1.5 2002-03-07 19:50:24 jeff Exp $ =head1 BUGS diff --git a/FS/bin/freeside-tax-report b/FS/bin/freeside-tax-report index ec4b99f81..8d5021358 100755 --- a/FS/bin/freeside-tax-report +++ b/FS/bin/freeside-tax-report @@ -6,6 +6,9 @@ use Date::Parse; use Time::Local; use Getopt::Std; use Text::Template; +use Net::SMTP; +use Mail::Header; +use Mail::Internet; use FS::Conf; use FS::UID qw(adminsuidsetup); use FS::Record qw(qsearch); @@ -13,11 +16,9 @@ use FS::cust_bill; use FS::cust_bill_pay; use FS::cust_pay; -# Set the mail program -my $mail_program = "/usr/sbin/sendmail -t -n"; &untaint_argv; #what it sounds like (eww) -use vars qw($opt_v $opt_p $opt_m $opt_e $opt_t $opt_s $opt_f $report_lines $report_template @buf); +use vars qw($opt_v $opt_p $opt_m $opt_e $opt_t $opt_s $opt_f $report_lines $report_template @buf $header); getopts("vpmef:s:"); #switches #we're at now now (and later). @@ -44,6 +45,9 @@ adminsuidsetup $user; my $conf = new FS::Conf; my $lpr = $conf->config('lpr'); my $email = $conf->config('email'); +my $smtpmachine = $conf->config('smtpmachine'); +my $mail_sender = $conf->exists('invoice_from') ? $conf->config('invoice_from') : + 'postmaster'; my @report_template = $conf->config('report_template') or die "cannot load config file report_template"; $report_lines = 0; @@ -75,14 +79,14 @@ if ($lpr && $main::opt_p) if ($email && $main::opt_m) { - open (MAIL, "|$mail_program"); - print MAIL < $header, + 'Body' => [ (@report) ], + ); + $!=0; + $message->smtpsend( Host => "$smtpmachine" ) + or die "can't send report to $email via $smtpmachine: $!"; } @@ -258,7 +267,7 @@ user: From the mapsecrets file - see config.html from the base documentation =head1 VERSION -$Id: freeside-tax-report,v 1.3 2002-03-06 00:17:32 ivan Exp $ +$Id: freeside-tax-report,v 1.4 2002-03-07 19:50:24 jeff Exp $ =head1 BUGS -- cgit v1.2.1 From 56ef0a8a658b8449d1125fe017b21e0c636a8b0c Mon Sep 17 00:00:00 2001 From: khoff Date: Sat, 9 Mar 2002 10:19:38 +0000 Subject: Support for default CNAME/A records --- FS/FS/Conf.pm | 14 ++++++++++++++ FS/FS/svc_domain.pm | 40 ++++++++++++++++++++++++++++++++++++++-- 2 files changed, 52 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index e8686b575..5dba387fe 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -449,6 +449,20 @@ httemplate/docs/config.html 'type' => 'textarea', }, + { + 'key' => 'arecords', + 'section' => 'BIND', + 'description' => 'A list of tab seperated A records to add automatically when creating a domain', + 'type' => 'textarea', + }, + + { + 'key' => 'cnamerecords', + 'section' => 'BIND', + 'description' => 'A list of tab seperated CNAME records to add automatically when creating a domain', + 'type' => 'textarea', + }, + { 'key' => 'nismachines', 'section' => 'shell', diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm index 84a102911..1e16ba87f 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -3,7 +3,7 @@ package FS::svc_domain; use strict; use vars qw( @ISA $whois_hack $conf $smtpmachine @mxmachines @nsmachines $soadefaultttl $soaemail $soaexpire $soamachine - $soarefresh $soaretry $qshellmachine $nossh_hack + $soarefresh $soaretry $qshellmachine $nossh_hack %arecords %cnamerecords ); use Carp; use Mail::Internet; @@ -29,6 +29,8 @@ $FS::UID::callback{'FS::domain'} = sub { $smtpmachine = $conf->config('smtpmachine'); + %arecords = map { split /\t/ } $conf->config('arecords'); + %cnamerecords = map { split /\t/ } $conf->config('cnamerecords'); @mxmachines = $conf->config('mxmachines'); @nsmachines = $conf->config('nsmachines'); $soadefaultttl = $conf->config('soadefaultttl'); @@ -123,6 +125,10 @@ records are added to the domain_record table (see L). If any machines are defined in the I configuration file, MX records are added to the domain_record table (see L). +If the I configuration file exits, A records are added to the +domain_record table. The I file does the same thing for +CNAME records. + If a machine is defined in the I configuration value, the I configuration file exists, and the I field points to an an account with a home directory (see L), the command: @@ -224,6 +230,36 @@ sub insert { } } + foreach my $arecord ( keys %arecords ) { + my $arec = new FS::domain_record { + 'svcnum' => $self->svcnum, + 'reczone' => $arecord, + 'recaf' => 'IN', + 'rectype' => 'A', + 'recdata' => $arecords{$arecord}, + }; + my $error = $arec->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "WARNING: couldn't insert A record for new domain: $error"; + } + } + + foreach my $cnamerecord ( keys %cnamerecords ) { + my $cnamerec = new FS::domain_record { + 'svcnum' => $self->svcnum, + 'reczone' => $cnamerecord, + 'recaf' => 'IN', + 'rectype' => 'CNAME', + 'recdata' => $cnamerecords{$cnamerecord}, + }; + my $error = $cnamerec->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "WARNING: couldn't insert CNAME record for new domain: $error"; + } + } + } $dbh->commit or die $dbh->errstr if $oldAutoCommit; @@ -424,7 +460,7 @@ sub submit_internic { =head1 VERSION -$Id: svc_domain.pm,v 1.24 2002-02-20 01:03:09 ivan Exp $ +$Id: svc_domain.pm,v 1.25 2002-03-09 10:19:38 khoff Exp $ =head1 BUGS -- cgit v1.2.1 From daac302e231e2e09b84e771c0413b0f2119c52e8 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 18 Mar 2002 09:10:12 +0000 Subject: new config value `defaultrecords', documentation, javascript config file editor --- FS/FS/Conf.pm | 22 ++++++++++---- FS/FS/svc_domain.pm | 85 ++++++++++------------------------------------------- 2 files changed, 33 insertions(+), 74 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 5dba387fe..18725ced2 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -437,28 +437,40 @@ httemplate/docs/config.html { 'key' => 'mxmachines', - 'section' => 'BIND', + 'section' => 'deprecated', 'description' => 'MX entries for new domains, weight and machine, one per line, with trailing `.\'', 'type' => 'textarea', }, { 'key' => 'nsmachines', - 'section' => 'BIND', + 'section' => 'deprecated', 'description' => 'NS nameservers for new domains, one per line, with trailing `.\'', 'type' => 'textarea', }, { - 'key' => 'arecords', + 'key' => 'defaultrecords', 'section' => 'BIND', - 'description' => 'A list of tab seperated A records to add automatically when creating a domain', + 'description' => 'DNS entries add automatically when creating a domain', + 'type' => 'editlist', + 'editlist_parts' => [ { type=>'text' }, + { type=>'immutable', value=>'IN' }, + { type=>'select', + select_enum=>{ map { $_=>$_ } qw(A CNAME MX NS)} }, + { type=> 'text' }, ], + }, + + { + 'key' => 'arecords', + 'section' => 'deprecated', + 'description' => 'A list of tab seperated CNAME records to add automatically when creating a domain', 'type' => 'textarea', }, { 'key' => 'cnamerecords', - 'section' => 'BIND', + 'section' => 'deprecated', 'description' => 'A list of tab seperated CNAME records to add automatically when creating a domain', 'type' => 'textarea', }, diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm index 1e16ba87f..d01a403d1 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -2,8 +2,8 @@ package FS::svc_domain; use strict; use vars qw( @ISA $whois_hack $conf $smtpmachine - @mxmachines @nsmachines $soadefaultttl $soaemail $soaexpire $soamachine - $soarefresh $soaretry $qshellmachine $nossh_hack %arecords %cnamerecords + @defaultrecords $soadefaultttl $soaemail $soaexpire $soamachine + $soarefresh $soaretry $qshellmachine $nossh_hack ); use Carp; use Mail::Internet; @@ -29,10 +29,7 @@ $FS::UID::callback{'FS::domain'} = sub { $smtpmachine = $conf->config('smtpmachine'); - %arecords = map { split /\t/ } $conf->config('arecords'); - %cnamerecords = map { split /\t/ } $conf->config('cnamerecords'); - @mxmachines = $conf->config('mxmachines'); - @nsmachines = $conf->config('nsmachines'); + @defaultrecords = $conf->config('defaultrecords'); $soadefaultttl = $conf->config('soadefaultttl'); $soaemail = $conf->config('soaemail'); $soaexpire = $conf->config('soaexpire'); @@ -119,15 +116,9 @@ in the same package, it is automatically used. Otherwise an error is returned. If any I configuration file exists, an SOA record is added to the domain_record table (see ). -If any machines are defined in the I configuration file, NS -records are added to the domain_record table (see L). - -If any machines are defined in the I configuration file, MX -records are added to the domain_record table (see L). - -If the I configuration file exits, A records are added to the -domain_record table. The I file does the same thing for -CNAME records. +If any records are defined in the I configuration file, +appropriate records are added to the domain_record table (see +L). If a machine is defined in the I configuration value, the I configuration file exists, and the I field points @@ -200,63 +191,19 @@ sub insert { return "couldn't insert SOA record for new domain: $error"; } - foreach my $nsmachine ( @nsmachines ) { - my $ns = new FS::domain_record { - 'svcnum' => $self->svcnum, - 'reczone' => '@', - 'recaf' => 'IN', - 'rectype' => 'NS', - 'recdata' => $nsmachine, - }; - my $error = $ns->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "couldn't insert NS record for new domain: $error"; - } - } - - foreach my $mxmachine ( @mxmachines ) { - my $mx = new FS::domain_record { - 'svcnum' => $self->svcnum, - 'reczone' => '@', - 'recaf' => 'IN', - 'rectype' => 'MX', - 'recdata' => $mxmachine, - }; - my $error = $mx->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "couldn't insert MX record for new domain: $error"; - } - } - - foreach my $arecord ( keys %arecords ) { - my $arec = new FS::domain_record { - 'svcnum' => $self->svcnum, - 'reczone' => $arecord, - 'recaf' => 'IN', - 'rectype' => 'A', - 'recdata' => $arecords{$arecord}, - }; - my $error = $arec->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "WARNING: couldn't insert A record for new domain: $error"; - } - } - - foreach my $cnamerecord ( keys %cnamerecords ) { - my $cnamerec = new FS::domain_record { + foreach my $record ( @defaultrecords ) { + my($zone,$af,$type,$data) = split(/\s+/,$record,4); + my $record = new FS::domain_record { 'svcnum' => $self->svcnum, - 'reczone' => $cnamerecord, - 'recaf' => 'IN', - 'rectype' => 'CNAME', - 'recdata' => $cnamerecords{$cnamerecord}, + 'reczone' => $zone, + 'recaf' => $af, + 'rectype' => $type, + 'recdata' => $data, }; - my $error = $cnamerec->insert; + my $error = $record->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "WARNING: couldn't insert CNAME record for new domain: $error"; + return "couldn't insert record for new domain: $error"; } } @@ -460,7 +407,7 @@ sub submit_internic { =head1 VERSION -$Id: svc_domain.pm,v 1.25 2002-03-09 10:19:38 khoff Exp $ +$Id: svc_domain.pm,v 1.26 2002-03-18 09:10:12 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From d67496643d9a6b3366b57d614a4c18e37f723845 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 18 Mar 2002 14:17:40 +0000 Subject: add noment-specific RADIUS attributes --- FS/FS/raddb.pm | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'FS') diff --git a/FS/FS/raddb.pm b/FS/FS/raddb.pm index 04389c91b..497d98450 100644 --- a/FS/FS/raddb.pm +++ b/FS/FS/raddb.pm @@ -1081,6 +1081,11 @@ use vars qw(%attrib); 'bind_l2tp_flow_control' => 'Bind_L2TP_Flow_Control', 'ascend_cbcp_delay' => 'Ascend-CBCP-Delay', 'le_ipsec_deny_action' => 'LE-IPSec-Deny-Action', + + #NOMENT + 'nomadix_bw_down' => 'Nomadix-Bw-Down', + 'nomadix_bw_up' => 'Nomadix-Bw-Up', + 'nomadix_ip_upsell' => 'Nomadix-IP-Upsell', ); 1; -- cgit v1.2.1 From dd12d8bcbb33acb0ffa087a70c566e8328fbe9c3 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 18 Mar 2002 16:05:35 +0000 Subject: handle inserting cust_svc and svc_acct records separately also, to handle imports preserving svcnum --- FS/FS/svc_Common.pm | 10 +++++++++- FS/FS/svc_acct.pm | 10 ++++++++++ 2 files changed, 19 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/svc_Common.pm b/FS/FS/svc_Common.pm index 042c243fd..ee190fb8d 100644 --- a/FS/FS/svc_Common.pm +++ b/FS/FS/svc_Common.pm @@ -69,6 +69,14 @@ sub insert { return $error; } $svcnum = $self->svcnum($cust_svc->svcnum); + } else { + $cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum}); + unless ( $cust_svc ) { + $dbh->rollback if $oldAutoCommit; + return "no cust_svc record found for svcnum ". $self->svcnum; + } + $self->pkgnum($cust_svc->pkgnum); + $self->svcpart($cust_svc->svcpart); } $error = $self->SUPER::insert; @@ -207,7 +215,7 @@ sub cancel { ''; } =head1 VERSION -$Id: svc_Common.pm,v 1.7 2001-11-30 00:04:38 ivan Exp $ +$Id: svc_Common.pm,v 1.8 2002-03-18 16:05:35 ivan Exp $ =head1 BUGS diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 3c564ec9d..bb9fe67b3 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -273,6 +273,16 @@ sub insert { 'domsvc' => $self->domsvc, } ); + if ( $self->svcnum ) { + my $cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum}); + unless ( $cust_svc ) { + $dbh->rollback if $oldAutoCommit; + return "no cust_svc record found for svcnum ". $self->svcnum; + } + $self->pkgnum($cust_svc->pkgnum); + $self->svcpart($cust_svc->svcpart); + } + my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); return "Unknown svcpart" unless $part_svc; return "uid in use" -- cgit v1.2.1 From d4dabf21a2c9022dfb7023fb5df49f1536b2f29a Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 18 Mar 2002 19:49:10 +0000 Subject: fixes: bug #348 - adds the ability to email on deleted payments. --- FS/FS/Conf.pm | 4 ++-- FS/FS/Record.pm | 3 ++- FS/FS/cust_bill.pm | 3 ++- FS/FS/cust_pay.pm | 50 ++++++++++++++++++++++++++++++++++++++++++++++++-- 4 files changed, 54 insertions(+), 6 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 18725ced2..a3269b1c4 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -291,8 +291,8 @@ httemplate/docs/config.html { 'key' => 'deletepayments', 'section' => 'UI', - 'description' => 'Enable deletion of unclosed payments. Be very careful! Only delete payments that were data-entry errors, not adjustments.', - 'type' => 'checkbox', + 'description' => 'Enable deletion of unclosed payments. Be very careful! Only delete payments that were data-entry errors, not adjustments. Optionally specify one or more comma-separated email addresses to be notified when a payment is deleted.', + 'type' => [qw( checkbox text )], }, { diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index ea660d48a..0bd7aeda4 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -571,7 +571,8 @@ sub delete { $h_sth->execute or return $h_sth->errstr if $h_sth; dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit; - undef $self; #no need to keep object! + #no need to needlessly destoy the data either + #undef $self; #no need to keep object! ''; } diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index c3524b984..092c174b4 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -388,6 +388,7 @@ sub send { #my @print_text = $cust_bill->print_text; #( date ) my @invoicing_list = $self->cust_main->invoicing_list; if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice + #false laziness w/FS::cust_pay::delete #$ENV{SMTPHOSTS} = $smtpmachine; $ENV{MAILADDRESS} = $invoice_from; my $header = new Mail::Header ( [ @@ -882,7 +883,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.22 2002-03-07 14:13:21 ivan Exp $ +$Id: cust_bill.pm,v 1.23 2002-03-18 19:49:10 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index 6156eadeb..421f0200e 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -1,7 +1,10 @@ package FS::cust_pay; use strict; -use vars qw( @ISA $conf $unsuspendauto ); +use vars qw( @ISA $conf $unsuspendauto $smtpmachine $invoice_from ); +use Date::Format; +use Mail::Header; +use Mail::Internet; use Business::CreditCard; use FS::UID qw( dbh ); use FS::Record qw( dbh qsearch qsearchs dbh ); @@ -16,6 +19,8 @@ $FS::UID::callback{'FS::cust_pay'} = sub { $conf = new FS::Conf; $unsuspendauto = $conf->exists('unsuspendauto'); + $smtpmachine = $conf->config('smtpmachine'); + $invoice_from = $conf->config('invoice_from'); }; @@ -256,6 +261,47 @@ sub delete { return $error; } + if ( $conf->config('deletepayments') ne '' ) { + + my $cust_main = qsearchs('cust_main',{ 'custnum' => $self->custnum }); + #false laziness w/FS::cust_bill::send + $ENV{MAILADDRESS} = $conf->config('invoice_from'); #??? well as good as any + my $header = new Mail::Header ( [ + "From: $invoice_from", + "To: ". $conf->config('deletepayments'), + "Sender: $invoice_from", + "Reply-To: $invoice_from", + "Date: ". time2str("%a, %d %b %Y %X %z", time), + "Subject: FREESIDE NOTIFICATION: Payment deleted", + ] ); + my $message = new Mail::Internet ( + 'Header' => $header, + 'Body' => [ + "This is an automatic message from your Freeside installation\n", + "informing you that the following payment has been deleted:\n", + "\n", + 'paynum: '. $self->paynum. "\n", + 'custnum: '. $self->custnum. + " (". $cust_main->last. ", ". $cust_main->first. ")\n", + 'paid: $'. sprintf("%.2f", $self->paid). "\n", + 'date: '. time2str("%a %b %e %T %Y", $self->_date). "\n", + 'payby: '. $self->payby. "\n", + 'payinfo: '. $self->payinfo. "\n", + 'paybatch: '. $self->paybatch. "\n", + ], + ); + $!=0; + $message->smtpsend( Host => $smtpmachine ) + or $message->smtpsend( Host => $smtpmachine, Debug => 1 ) + or do { + $dbh->rollback if $oldAutoCommit; + return "(customer # ". $self->custnum. + ") can't send payment deletion email to ". + $conf->config('deletepayments'). + " via server $smtpmachine with SMTP: $!"; + }; + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -359,7 +405,7 @@ sub unapplied { =head1 VERSION -$Id: cust_pay.pm,v 1.17 2002-02-10 18:56:49 ivan Exp $ +$Id: cust_pay.pm,v 1.18 2002-03-18 19:49:10 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 105c166a23234dd923757a477b4efcda65fb2881 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 18 Mar 2002 20:51:09 +0000 Subject: okay, now you can specify an alternate invoice template, and it'll be auto-createad and added to the list of configuration options. closes: Bug#314 --- FS/FS/Conf.pm | 36 +++++++++++++++++++++++++++--------- FS/FS/part_bill_event.pm | 19 ++++++++++++++++++- 2 files changed, 45 insertions(+), 10 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index a3269b1c4..e1384bd4c 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -2,6 +2,7 @@ package FS::Conf; use vars qw($default_dir @config_items $DEBUG ); use IO::File; +use File::Basename; use FS::ConfItem; $DEBUG = 0; @@ -25,6 +26,10 @@ FS::Conf - Freeside configuration values @list = $conf->config('key'); $bool = $conf->exists('key'); + $conf->touch('key'); + $conf->set('key' => 'value'); + $conf->delete('key'); + @config_items = $conf->config_items; =head1 DESCRIPTION @@ -67,7 +72,7 @@ sub dir { $1; } -=item config +=item config KEY Returns the configuration value or values (depending on context) for key. @@ -90,7 +95,7 @@ sub config { } } -=item exists +=item exists KEY Returns true if the specified key exists, even if the corresponding value is undefined. @@ -103,7 +108,9 @@ sub exists { -e "$dir/$file"; } -=item touch +=item touch KEY + +Creates the specified configuration key if it does not exist. =cut @@ -116,7 +123,9 @@ sub touch { } } -=item set +=item set KEY VALUE + +Sets the specified configuration key to the given value. =cut @@ -139,7 +148,9 @@ sub set { # return ! eval { join('',@_), kill 0; 1; }; # } -=item delete +=item delete KEY + +Deletes the specified configuration key. =cut @@ -160,16 +171,23 @@ L. =cut sub config_items { -# my $self = shift; - @config_items; + my $self = shift; + #quelle kludge + @config_items, + map { new FS::ConfItem { + 'key' => basename($_), + 'section' => 'billing', + 'description' => 'Alternate template file for invoices. See the billing documentation for details.', + 'type' => 'textarea', + } + } glob($self->dir. '/invoice_template_*') + ; } =back =head1 BUGS -Write access (touch, set, delete) should be documented. - If this was more than just crud that will never be useful outside Freeside I'd worry that config_items is freeside-specific and icky. diff --git a/FS/FS/part_bill_event.pm b/FS/FS/part_bill_event.pm index 70c8a56ec..40f7fc79d 100644 --- a/FS/FS/part_bill_event.pm +++ b/FS/FS/part_bill_event.pm @@ -126,6 +126,8 @@ sub check { or $c =~ /^\s*\$cust_bill\->(comp|realtime_card|realtime_card_cybercash|batch_card|send)\(\);\s*$/ + or $c =~ /^\s*\$cust_bill\->send\(\'\w+\'\);\s*$/ + or $c =~ /^\s*\$cust_main\->apply_payments; \$cust_main->apply_credits; "";\s*$/ or $c =~ /^\s*\$cust_main\->charge\( \s*\d*\.?\d*\s*,\s*\'[\w \!\@\#\$\%\&\(\)\-\+\;\:\"\,\.\?\/]*\'\s*\);\s*$/ @@ -137,7 +139,7 @@ sub check { } - $self->ut_numbern('eventpart') + my $error = $self->ut_numbern('eventpart') || $self->ut_enum('payby', [qw( CARD BILL COMP )] ) || $self->ut_text('event') || $self->ut_anything('eventcode') @@ -147,6 +149,21 @@ sub check { || $self->ut_textn('plan') || $self->ut_anything('plandata') ; + return $error if $error; + + #quelle kludge + if ( $self->plandata =~ /^templatename\s+(.*)$/ ) { + my $name= $1; + unless ( $conf->config("invoice_template_$name") ) { + $conf->set( + "invoice_template_$name" => + join("\n", $conf->config('invoice_template') ) + ); + } + } + + ''; + } =back -- cgit v1.2.1 From d65d05b7aaa329fb6005fb7ed4a24daab4fa7941 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 18 Mar 2002 21:40:17 +0000 Subject: bugfixes, closes Bug#314 --- FS/FS/Conf.pm | 8 +++++-- FS/FS/cust_bill.pm | 62 ++++++++++++++++++++++++++---------------------- FS/FS/part_bill_event.pm | 2 +- 3 files changed, 40 insertions(+), 32 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index e1384bd4c..91fea7ef7 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -174,8 +174,12 @@ sub config_items { my $self = shift; #quelle kludge @config_items, - map { new FS::ConfItem { - 'key' => basename($_), + map { + my $basename = basename($_); + $basename =~ /^(.*)$/; + $basename = $1; + new FS::ConfItem { + 'key' => $basename, 'section' => 'billing', 'description' => 'Alternate template file for invoices. See the billing documentation for details.', 'type' => 'textarea', diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 092c174b4..0a8d4a4ae 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -1,7 +1,7 @@ package FS::cust_bill; use strict; -use vars qw( @ISA $conf $invoice_template $money_char ); +use vars qw( @ISA $conf $money_char ); use vars qw( $lpr $invoice_from $smtpmachine ); use vars qw( $processor ); use vars qw( $xaction $E_NoErr ); @@ -30,21 +30,6 @@ $FS::UID::callback{'FS::cust_bill'} = sub { $money_char = $conf->config('money_char') || '$'; - my @invoice_template = $conf->config('invoice_template') - or die "cannot load config file invoice_template"; - $invoice_lines = 0; - foreach ( grep /invoice_lines\(\d+\)/, @invoice_template ) { #kludgy - /invoice_lines\((\d+)\)/; - $invoice_lines += $1; - } - die "no invoice_lines() functions in template?" unless $invoice_lines; - $invoice_template = new Text::Template ( - TYPE => 'ARRAY', - SOURCE => [ map "$_\n", @invoice_template ], - ) or die "can't create new Text::Template object: $Text::Template::ERROR"; - $invoice_template->compile() - or die "can't compile template: $Text::Template::ERROR"; - $lpr = $conf->config('lpr'); $invoice_from = $conf->config('invoice_from'); $smtpmachine = $conf->config('smtpmachine'); @@ -383,7 +368,7 @@ emails or print. See L. =cut sub send { - my $self = shift; + my($self,$template) = @_; #my @print_text = $cust_bill->print_text; #( date ) my @invoicing_list = $self->cust_main->invoicing_list; @@ -401,7 +386,7 @@ sub send { ] ); my $message = new Mail::Internet ( 'Header' => $header, - 'Body' => [ $self->print_text ], #( date) + 'Body' => [ $self->print_text('', $template) ], #( date) ); $!=0; $message->smtpsend( Host => $smtpmachine ) @@ -702,7 +687,7 @@ L and L for conversion functions. sub print_text { - my( $self, $today ) = ( shift, shift ); + my( $self, $today, $template ) = @_; $today ||= time; # my $invnum = $self->invnum; my $cust_main = qsearchs('cust_main', { 'custnum', $self->custnum } ); @@ -811,8 +796,25 @@ sub print_text { push @buf,['Balance Due', $money_char. sprintf("%10.2f", $balance_due ) ]; + #create the template + my $templatefile = 'invoice_template'; + $templatefile .= "_$template" if $template; + my @invoice_template = $conf->config($templatefile) + or die "cannot load config file $templatefile"; + $invoice_lines = 0; + foreach ( grep /invoice_lines\(\d+\)/, @invoice_template ) { #kludgy + /invoice_lines\((\d+)\)/; + $invoice_lines += $1; + } + die "no invoice_lines() functions in template?" unless $invoice_lines; + my $invoice_template = new Text::Template ( + TYPE => 'ARRAY', + SOURCE => [ map "$_\n", @invoice_template ], + ) or die "can't create new Text::Template object: $Text::Template::ERROR"; + $invoice_template->compile() + or die "can't compile template: $Text::Template::ERROR"; + #setup template variables - package FS::cust_bill::_template; #! use vars qw( $invnum $date $page $total_pages @address $overdue @buf ); @@ -847,13 +849,13 @@ sub print_text { $FS::cust_bill::_template::address[$l++] = $cust_main->country unless $cust_main->country eq 'US'; - #overdue? (variable for the template) - $FS::cust_bill::_template::overdue = ( - $balance_due > 0 - && $today > $self->_date -# && $self->printed > 1 - && $self->printed > 0 - ); + # #overdue? (variable for the template) + # $FS::cust_bill::_template::overdue = ( + # $balance_due > 0 + # && $today > $self->_date + ## && $self->printed > 1 + # && $self->printed > 0 + # ); #and subroutine for the template @@ -864,7 +866,9 @@ sub print_text { } ( 1 .. $lines ); } - + + + #and fill it in $FS::cust_bill::_template::page = 1; my $lines; my @collect; @@ -883,7 +887,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.23 2002-03-18 19:49:10 ivan Exp $ +$Id: cust_bill.pm,v 1.24 2002-03-18 21:40:17 ivan Exp $ =head1 BUGS diff --git a/FS/FS/part_bill_event.pm b/FS/FS/part_bill_event.pm index 40f7fc79d..a31b09b36 100644 --- a/FS/FS/part_bill_event.pm +++ b/FS/FS/part_bill_event.pm @@ -154,7 +154,7 @@ sub check { #quelle kludge if ( $self->plandata =~ /^templatename\s+(.*)$/ ) { my $name= $1; - unless ( $conf->config("invoice_template_$name") ) { + unless ( $conf->exists("invoice_template_$name") ) { $conf->set( "invoice_template_$name" => join("\n", $conf->config('invoice_template') ) -- cgit v1.2.1 From cd2371a35a0c416366fa1822d99571ca68a5ad1e Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 19 Mar 2002 17:48:28 +0000 Subject: changes dum big "state/county/country" select to three, linked with javascript closes: Bug#353 --- FS/FS/cust_main_county.pm | 136 ++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 132 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main_county.pm b/FS/FS/cust_main_county.pm index 383360b7b..17fe164e4 100644 --- a/FS/FS/cust_main_county.pm +++ b/FS/FS/cust_main_county.pm @@ -1,10 +1,21 @@ package FS::cust_main_county; use strict; -use vars qw( @ISA ); -use FS::Record; +use vars qw( @ISA @EXPORT_OK $conf + @cust_main_county %cust_main_county $countyflag ); +use Exporter; +use FS::Record qw( qsearch ); @ISA = qw( FS::Record ); +@EXPORT_OK = qw( regionselector ); + +@cust_main_county = (); +$countyflag = ''; + +#ask FS::UID to run this stuff for us later +$FS::UID::callback{'FS::cust_main_county'} = sub { + $conf = new FS::Conf; +}; =head1 NAME @@ -25,6 +36,9 @@ FS::cust_main_county - Object methods for cust_main_county objects $error = $record->check; + ($county_html, $state_html, $country_html) = + FS::cust_main_county::regionselector( $county, $state, $country ); + =head1 DESCRIPTION An FS::cust_main_county object represents a tax rate, defined by locale. @@ -94,12 +108,126 @@ sub check { =back -=head1 VERSION +=head1 SUBROUTINES -$Id: cust_main_county.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ +=over 4 + +=item regionselector [ COUNTY STATE COUNTRY [ PREFIX [ ONCHANGE ] ] ] + +=cut + +sub regionselector { + my ( $selected_county, $selected_state, $selected_country, + $prefix, $onchange ) = @_; + $countyflag=1 if $selected_county; + + unless ( @cust_main_county ) { #cache + @cust_main_county = qsearch('cust_main_county', {} ); + foreach my $c ( @cust_main_county ) { + $countyflag=1 if $c->county; + push @{$cust_main_county{$c->country}{$c->state}}, $c->county; + } + } + + my $script_html = < + function opt(what,value,text) { + var optionName = new Option(text, value, false, false); + var length = what.length; + what.options[length] = optionName; + } + function ${prefix}country_changed(what) { + country = what.options[what.selectedIndex].text; + for ( var i = what.form.${prefix}state.length; i >= 0; i-- ) + what.form.${prefix}state.options[i] = null; +END + #what.form.${prefix}state.options[0] = new Option('', '', false, true); + + foreach my $country ( sort keys %cust_main_county ) { + $script_html .= "\nif ( country == \"$country\" ) {\n"; + foreach my $state ( sort keys %{$cust_main_county{$country}} ) { + my $text = $state || '(n/a)'; + $script_html .= qq!opt(what.form.${prefix}state, "$state", "$text");\n!; + } + $script_html .= "}\n"; + } + + $script_html .= <= 0; i-- ) + what.form.${prefix}county.options[i] = null; +END + + foreach my $country ( sort keys %cust_main_county ) { + $script_html .= "\nif ( country == \"$country\" ) {\n"; + foreach my $state ( sort keys %{$cust_main_county{$country}} ) { + $script_html .= "\nif ( state == \"$state\" ) {\n"; + foreach my $county ( sort @{$cust_main_county{$country}{$state}} ) { + my $text = $county || '(n/a)'; + $script_html .= + qq!opt(what.form.${prefix}county, "$county", "$text");\n!; + } + $script_html .= "}\n"; + } + $script_html .= "}\n"; + } + } + + $script_html .= < +END + + my $county_html = $script_html; + if ( $countyflag ) { + $county_html .= qq!'; + } else { + $county_html .= + qq!!; + } + + my $state_html = qq!'; + + $state_html .= ''; + + my $country_html = qq!'; + + ($county_html, $state_html, $country_html); + +} + +=back =head1 BUGS +regionseletor? putting web ui components in here? they should probably live +somewhere else... + =head1 SEE ALSO L, L, L, schema.html from the base -- cgit v1.2.1 From 74f795a943560dfc03f46642536386ce36355bb4 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 20 Mar 2002 07:37:05 +0000 Subject: disable region caching for now --- FS/FS/cust_main_county.pm | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main_county.pm b/FS/FS/cust_main_county.pm index 17fe164e4..95ed53dab 100644 --- a/FS/FS/cust_main_county.pm +++ b/FS/FS/cust_main_county.pm @@ -119,15 +119,17 @@ sub check { sub regionselector { my ( $selected_county, $selected_state, $selected_country, $prefix, $onchange ) = @_; - $countyflag=1 if $selected_county; - unless ( @cust_main_county ) { #cache + $countyflag = 0; + +# unless ( @cust_main_county ) { #cache @cust_main_county = qsearch('cust_main_county', {} ); foreach my $c ( @cust_main_county ) { $countyflag=1 if $c->county; push @{$cust_main_county{$c->country}{$c->state}}, $c->county; } - } +# } + $countyflag=1 if $selected_county; my $script_html = < -- cgit v1.2.1 From f1038a648b3d53db925b23519e7cd2a30c6837ed Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 20 Mar 2002 21:31:49 +0000 Subject: new export! infostreet and sqlradius provisioning switched over (Bug #299 - doesn't close it, but all the groundwork is done) also removes non-transactional ICRADIUS export from svc_acct.export (closes: Bug#347) --- FS/FS/Conf.pm | 12 +- FS/FS/part_export.pm | 427 +++++++++++++++++++++++++++++++++++++++++++- FS/FS/part_export_option.pm | 2 +- FS/FS/part_svc.pm | 12 +- FS/FS/svc_acct.pm | 236 +++++++----------------- FS/bin/freeside-queued | 3 +- 6 files changed, 509 insertions(+), 183 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 91fea7ef7..645dbf1c4 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -396,29 +396,29 @@ httemplate/docs/config.html { 'key' => 'icradiusmachines', - 'section' => 'radius', - 'description' => 'Turn this option on to enable radcheck and radreply table population - by default in the Freeside database, or in the database specified by the icradius_secrets config option (the radcheck and radreply tables needs to be created manually). You do not need to use MySQL for your Freeside database to export to an ICRADIUS/FreeRADIUS MySQL database with this option.
ADDITIONAL DEPRECATED FUNCTIONALITY (instead use MySQL replication or point icradius_secrets to the external database) - your ICRADIUS machines or FreeRADIUS (with MySQL authentication) machines, one per line. Machines listed in this file will have the radcheck table exported to them. Each line should contain four items, separted by whitespace: machine name, MySQL database name, MySQL username, and MySQL password. For example: "radius.isp.tld radius_db radius_user passw0rd"
', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, add sqlradius exports to Service definitions instead. This option used to enable radcheck and radreply table population - by default in the Freeside database, or in the database specified by the icradius_secrets config option (the radcheck and radreply tables needs to be created manually). You do not need to use MySQL for your Freeside database to export to an ICRADIUS/FreeRADIUS MySQL database with this option.
ADDITIONAL DEPRECATED FUNCTIONALITY (instead use MySQL replication or point icradius_secrets to the external database) - your ICRADIUS machines or FreeRADIUS (with MySQL authentication) machines, one per line. Machines listed in this file will have the radcheck table exported to them. Each line should contain four items, separted by whitespace: machine name, MySQL database name, MySQL username, and MySQL password. For example: "radius.isp.tld radius_db radius_user passw0rd"
', 'type' => [qw( checkbox textarea )], }, { 'key' => 'icradius_mysqldest', - 'section' => 'radius', + 'section' => 'deprecated', 'description' => 'DEPRECATED (instead use MySQL replication or point icradius_secrets to the external database) - Destination directory for the MySQL databases, on the ICRADIUS/FreeRADIUS machines. Defaults to "/usr/local/var/".', 'type' => 'text', }, { 'key' => 'icradius_mysqlsource', - 'section' => 'radius', + 'section' => 'deprecated', 'description' => 'DEPRECATED (instead use MySQL replication or point icradius_secrets to the external database) - Source directory for for the MySQL radcheck table files, on the Freeside machine. Defaults to "/usr/local/var/freeside".', 'type' => 'text', }, { 'key' => 'icradius_secrets', - 'section' => 'radius', - 'description' => 'Optionally specifies a database for ICRADIUS/FreeRADIUS export. Three lines: DBI data source, username and password.', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, add sqlradius exports to Service definitions instead. This option used to specify a database for ICRADIUS/FreeRADIUS export. Three lines: DBI data source, username and password.', 'type' => 'textarea', }, diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index a0de03b63..444e86aa0 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -122,6 +122,7 @@ sub insert { my $options = shift; foreach my $optionname ( keys %{$options} ) { my $part_export_option = new FS::part_export_option ( { + 'exportnum' => $self->exportnum, 'optionname' => $optionname, 'optionvalue' => $options->{$optionname}, } ); @@ -144,16 +145,92 @@ Delete this record from the database. =cut -# the delete method can be inherited from FS::Record +#foreign keys would make this much less tedious... grr dumb mysql +sub delete { + my $self = shift; + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $self->SUPER::delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + foreach my $part_export_option ( $self->part_export_option ) { + my $error = $part_export_option->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; -=item replace OLD_RECORD +} + +=item replace OLD_RECORD HASHREF Replaces the OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. +If a hash reference of options is supplied, part_export_option records are +created or modified (see L). + =cut -# the replace method can be inherited from FS::Record +sub replace { + my $self = shift; + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $self->SUPER::replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + my $options = shift; + foreach my $optionname ( keys %{$options} ) { + my $old = qsearchs( 'part_export_option', { + 'exportnum' => $self->exportnum, + 'optionname' => $optionname, + } ); + my $new = new FS::part_export_option ( { + 'exportnum' => $self->exportnum, + 'optionname' => $optionname, + 'optionvalue' => $options->{$optionname}, + } ); + my $error = $old ? $new->replace($old) : $new->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; + +}; =item check @@ -198,12 +275,356 @@ sub part_svc { qsearchs('part_svc', { svcpart => $self->svcpart } ); } +=item part_export_option + +=cut + +sub part_export_option { + my $self = shift; + qsearch('part_export_option', { 'exportnum' => $self->exportnum } ); +} + +=item options + +=cut + +sub options { + my $self = shift; + map { $_->optionname => $_->optionvalue } $self->part_export_option; +} + +=item option + +=cut + +sub option { + my $self = shift; + my $part_export_option = + qsearchs('part_export_option', { + exportnum => $self->exportnum, + optionname => shift, + } ); + $part_export_option ? $part_export_option->optionvalue : ''; +} + +=item rebless + +=cut + +sub rebless { + my $self = shift; + my $exporttype = $self->exporttype; + my $class = ref($self); + bless($self, $class."::$exporttype"); +} + +=item export_insert SVC_OBJECT + +Calls the appropriate export_I for this object's exporttype. + +=cut + +sub export_insert { + my $self = shift; + $self->rebless; + $self->_export_insert(@_); +} + +#sub AUTOLOAD { +# my $self = shift; +# $self->rebless; +# my $method = $AUTOLOAD; +# #$method =~ s/::(\w+)$/::_$1/; #infinite loop prevention +# $method =~ s/::(\w+)$/_$1/; #infinite loop prevention +# $self->$method(@_); +#} + +=item export_replace + +=cut + +sub export_replace { + my $self = shift; + $self->rebless; + $self->_export_replace(@_); +} + +=item export_delete + +=cut + +sub export_delete { + my $self = shift; + $self->rebless; + $self->_export_delete(@_); +} + =back +#infostreet + +package FS::part_export::infostreet; +use vars qw(@ISA); +@ISA = qw(FS::part_export); + +sub _export_insert { + my( $self, $svc_acct ) = (shift, shift); + $self->infostreet_queue( $svc_acct->svcnum, + 'createUser', $svc_acct->username, $svc_acct->password ); +} + +sub _export_replace { + my( $self, $new, $old ) = (shift, shift, shift); + return "can't change username with InfoStreet" + if $old->username ne $new->username; + return '' unless $old->_password ne $new->_password; + $self->infostreet_queue( $new->svcnum, + 'passwd', $new->username, $new->password ); +} + +sub _export_delete { + my( $self, $svc_acct ) = (shift, shift); + $self->infostreet_queue( $svc_acct->svcnum, + 'purgeAccount,releaseUsername', $svc_acct->username ); +} + +sub infostreet_queue { + my( $self, $svcnum, $method ) = (shift, shift, shift); + my $queue = new FS::queue { + 'svcnum' => $svcnum, + 'job' => 'FS::part_export::infostreet::infostreet_command', + }; + $queue->insert( + $self->option('url'), + $self->option('login'), + $self->option('password'), + $self->option('groupID'), + $method, + @_, + ); +} + +sub infostreet_command { #subroutine, not method + my($url, $username, $password, $groupID, $method, @args) = @_; + + #quelle hack + if ( $method =~ /,/ ) { + foreach my $part ( split(/,\s*/, $method) ) { + infostreet_command($url, $username, $password, $groupID, $part, @args); + } + return; + } + + eval "use Frontier::Client;"; + + my $conn = Frontier::Client->new( url => $url ); + my $key_result = $conn->call( 'authenticate', $username, $password, $groupID); + my %key_result = _infostreet_parse($key_result); + die $key_result{error} unless $key_result{success}; + my $key = $key_result{data}; + + my $result = $conn->call($opt{method}, $key, @{$opt{args}}); + my %result = _infostreet_parse($result); + die $result{error} unless $result{success}; + +} + +sub _infostreet_parse { #subroutine, not method + my $arg = shift; + map { + my $value = $arg->{$_}; + #warn ref($value); + $value = $value->value() + if ref($value) && $value->isa('Frontier::RPC2::DataType'); + $_=>$value; + } keys %$arg; +} + +#sqlradius + +package FS::part_export::sqlradius; +use vars qw(@ISA); +@ISA = qw(FS::part_export); + +sub _export_insert { + my($self, $svc_acct) = (shift, shift); + $self->sqlradius_queue( $svc_acct->svcnum, 'insert', + 'reply', $svc_acct->username, $svc_acct->radius_reply ); + $self->sqlradius_queue( $svc_acct->svcnum, 'insert', + 'check', $svc_acct->username, $svc_acct->radius_check ); +} + +sub _export_replace { + my( $self, $new, $old ) = (shift, shift, shift); + + #return "can't (yet) change username with sqlradius" + # if $old->username ne $new->username; + if ( $old->username ne $new->username ) { + my $error = $self->sqlradius_queue( $new->svcnum, 'rename', + $new->username, $old->username ); + return $error if $error; + } + + foreach my $table (qw(reply check)) { + my $method = "radius_$table"; + my %new = $new->$method; + my %old = $old->$method; + if ( grep { !exists $old{$_} #new attributes + || $new{$n} ne $old{$n} #changed + } keys %new + ) { + my $error = $self->sqlradius_queue( $new->svcnum, 'insert' + $table, $new->username, %new ); + return $error if $error; + } + + my @del = grep { !exists $new{$_} } keys %old; + my $error = $self->sqlradius_queue( $new->svcnum, 'sqlradius_attrib_delete', + $table, $new->username, @del ); + return $error if $error; + } + + ''; +} + +sub _export_delete { + my( $self, $svc_something ) = (shift, shift); + $self->sqlradius_queue( $svc_acct->svcnum, 'delete', + $svc_something->username ); +} + +sub sqlradius_queue { + my( $self, $svcnum, $method ) = (shift, shift, shift); + my $queue = new FS::queue { + 'svcnum' => $svcnum, + 'job' => "FS::part_export::sqlradius::sqlradius_$method", + }; + $queue->insert( + $self->option('datasrc'), + $self->option('username'), + $self->option('password'), + @_, + ); +} + +sub sqlradius_insert { #subroutine, not method + my $dbh = sqlradius_connect(shift, shift, shift); + my( $replycheck, $username, %attributes ) = @_; + + foreach my $attribute ( keys %attributes ) { + my $u_sth = $dbh->prepare( + "UPDATE rad$replycheck SET Value = ? WHERE UserName = ? AND Attribute = ?" ) or die $dbh->errstr; + my $i_sth = $dbh->prepare( + "INSERT INTO rad$replycheck ( id, UserName, Attribute, Value ) ". + "VALUES ( ?, ?, ?, ? )" ) + or die $dbh->errstr; + $u_sth->execute($attributes{$attribute}, $username, $attribute) > 0 + or $i_sth->execute( '', $username, $attribute, $attributes{$attribute} ) + or die "can't insert into rad$replycheck table: ". $i_sth->errstr; + } + $dbh->disconnect; +} + +sub sqlradius_rename { #subroutine, not method + my $dbh = sqlradius_connect(shift, shift, shift); + my($new_username, $old_username) = @_; + foreach my $table (qw(radreply radcheck)) { + my $sth = $dbh->prepare("UPDATE $table SET Username = ? WHERE UserName = ?") + or die $dbh->errstr; + $sth->execute($new_username, $old_username) + or die "can't update $table: ". $sth->errstr; + } + $dbh->disconnect; +} + +sub sqlradius_attrib_delete { #subroutine, not method + my $dbh = sqlradius_connect(shift, shift, shift); + my( $replycheck, $username, @attrib ) = @_; + + foreach my $attribute ( @attrib ) { + my $sth = $dbh->prepare( + "DELETE FROM $table WHERE UserName = ? AND Attribute = ?" ) + or die $dbh->errstr; + $sth->execute($username,$attribute) + or die "can't delete from $table table: ". $sth->errstr; + } + $dbh->disconnect; +} + +sub sqlradius_delete { #subroutine, not method + my $dbh = sqlradius_connect(shift, shift, shift); + my $username = shift; + + foreach my $table (qw( radcheck radreply )) { + my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" ); + $sth->execute($username) + or die "can't delete from $table table: ". $sth->errstr; + } + $dbh->disconnect; +} + +sub sqlradius_connect { + #my($datasrc, $username, $password) = @_; + #DBI->connect($datasrc, $username, $password) or die $DBI::errstr; + DBI->connect(@_) or die $DBI::errstr; +} + +=head1 NOTES + +Writing a new export class: + +#myexport + +package FS::part_export::myexport; +use vars qw(@ISA); +@ISA = qw(FS::part_export); + +sub _export_insert { + my($self, $svc_something) = (shift, shift); + $self->myexport_queue( $svc_acct->svcnum, 'insert', + $svc_something->username, $svc_something->password ); +} + +sub _export_replace { + my( $self, $new, $old ) = (shift, shift, shift); + #return "can't change username with myexport" + # if $old->username ne $new->username; + #return '' unless $old->_password ne $new->_password; + $self->myexport_queue( $new->svcnum, + 'replace', $new->username, $new->password ); +} + +sub _export_delete { + my( $self, $svc_something ) = (shift, shift); + $self->myexport_queue( $svc_acct->svcnum, + 'delete', $svc_something->username ); +} + +#a good idea to queue anything that could fail or take any time +sub myexport_queue { + my( $self, $svcnum, $method ) = (shift, shift, shift); + my $queue = new FS::queue { + 'svcnum' => $svcnum, + 'job' => "FS::part_export::myexport::myexport_$method", + }; + $queue->insert( @_ ); +} + +sub myexport_insert { #subroutine, not method +} +sub myexport_replace { #subroutine, not method +} +sub myexport_delete { #subroutine, not method +} + =head1 BUGS Probably. +Hmm, export code has wound up in here. Move those sub-classes out into their +own files, at least. Also hmm... cust_export class (not necessarily a +database table...) ... ? + =head1 SEE ALSO L, L, L, L, diff --git a/FS/FS/part_export_option.pm b/FS/FS/part_export_option.pm index 1ce0de65f..61ea956ae 100644 --- a/FS/FS/part_export_option.pm +++ b/FS/FS/part_export_option.pm @@ -40,7 +40,7 @@ currently supported: =item optionname - option name -=item opeionvalue - option value +=item optionvalue - option value =back diff --git a/FS/FS/part_svc.pm b/FS/FS/part_svc.pm index 41ee21d31..82935dd2b 100644 --- a/FS/FS/part_svc.pm +++ b/FS/FS/part_svc.pm @@ -295,11 +295,21 @@ sub all_part_svc_column { qsearch('part_svc_column', { 'svcpart' => $self->svcpart } ); } +=item part_export + +=cut + +sub part_export { + my $self = shift; + my %search = ( 'svcpart' => $self->svcpart ); + qsearch('part_export', \%search); +} + =back =head1 VERSION -$Id: part_svc.pm,v 1.9 2002-01-28 06:57:23 ivan Exp $ +$Id: part_svc.pm,v 1.10 2002-03-20 21:31:49 ivan Exp $ =head1 BUGS diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index bb9fe67b3..2305aeb80 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -1,7 +1,8 @@ package FS::svc_acct; use strict; -use vars qw( @ISA $nossh_hack $conf $dir_prefix @shells $usernamemin +use vars qw( @ISA $nossh_hack $noexport_hack $conf + $dir_prefix @shells $usernamemin $usernamemax $passwordmin $passwordmax $username_ampersand $username_letter $username_letterfirst $username_noperiod $username_uppercase @@ -9,7 +10,6 @@ use vars qw( @ISA $nossh_hack $conf $dir_prefix @shells $usernamemin $cyrus_server $cyrus_admin_user $cyrus_admin_pass $cp_server $cp_user $cp_pass $cp_workgroup $dirhash - $icradius_dbh @saltset @pw_set $rsync $ssh $exportdir $vpopdir); use Carp; @@ -88,18 +88,7 @@ $FS::UID::callback{'FS::svc_acct'} = sub { $cp_pass = ''; $cp_workgroup = ''; } - if ( $conf->exists('icradiusmachines') ) { - if ( $conf->exists('icradius_secrets') ) { - #need some sort of late binding so it's only connected to when - # actually used, hmm - $icradius_dbh = DBI->connect($conf->config('icradius_secrets')) - or die $DBI::errstr; - } else { - $icradius_dbh = dbh; - } - } else { - $icradius_dbh = ''; - } + $dirhash = $conf->config('dirhash') || 0; $exportdir = "/usr/local/etc/freeside/export." . datasrc; if ( $conf->exists('vpopmailmachines') ) { @@ -246,6 +235,8 @@ $username, $uid, $gid, $dir, and $shell. (TODOC: cyrus config file, L and L) +(TODOC: new exports! $noexport_hack) + =cut sub insert { @@ -297,6 +288,20 @@ sub insert { return $error; } + #new-style exports! + unless ( $noexport_hack ) { + foreach my $part_export ( $self->cust_svc->part_svc->part_export ) { + my $error = $part_export->export_insert($self); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "exporting to ". $part_export->exporttype. + " (transaction rolled back): $error"; + } + } + } + + #old-style exports + my( $username, $uid, $gid, $dir, $shell ) = ( $self->username, $self->uid, @@ -340,37 +345,6 @@ sub insert { } } - if ( $icradius_dbh ) { - - my $radcheck_queue = - new FS::queue { - 'svcnum' => $self->svcnum, - 'job' => 'FS::svc_acct::icradius_rc_insert' - }; - $error = $radcheck_queue->insert( $self->username, - $self->_password, - $self->radius_check - ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - - my $radreply_queue = - new FS::queue { - 'svcnum' => $self->svcnum, - 'job' => 'FS::svc_acct::icradius_rr_insert' - }; - $error = $radreply_queue->insert( $self->username, - $self->_password, - $self->radius_reply - ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - } - if ( $vpopdir ) { my $vpopmail_queue = @@ -390,6 +364,7 @@ sub insert { } + #end of old-style exports $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error @@ -451,56 +426,6 @@ sub cp_insert { die $app->message."\n" unless $app->ok; } -sub icradius_rc_insert { - my( $username, $password, %radcheck ) = @_; - - my $sth = $icradius_dbh->prepare( - "INSERT INTO radcheck ( id, UserName, Attribute, Value ) VALUES ( ". - join(", ", map { $icradius_dbh->quote($_) } ( - '', - $username, - "Password", - $password, - ) ). " )" - ); - $sth->execute or die "can't insert into radcheck table: ". $sth->errstr; - - foreach my $attribute ( keys %radcheck ) { - my $sth = $icradius_dbh->prepare( - "INSERT INTO radcheck ( id, UserName, Attribute, Value ) VALUES ( ". - join(", ", map { $icradius_dbh->quote($_) } ( - '', - $username, - $attribute, - $radcheck{$attribute}, - ) ). " )" - ); - $sth->execute or die "can't insert into radcheck table: ". $sth->errstr; - } - - 1; -} - -sub icradius_rr_insert { - my( $username, $password, %radreply ) = @_; - - foreach my $attribute ( keys %radreply ) { - my $sth = $icradius_dbh->prepare( - "INSERT INTO radreply ( id, UserName, Attribute, Value ) VALUES ( ". - join(", ", map { $icradius_dbh->quote($_) } ( - '', - $username, - $attribute, - $radreply{$attribute}, - ) ). " )" - ); - $sth->execute or die "can't insert into radreply table: ". $sth->errstr; - } - - 1; -} - - sub vpopmail_insert { my( $username, $password, $domain, $vpopdir ) = @_; @@ -571,6 +496,8 @@ $username and $dir. (TODOC: cyrus config file) +(TODOC: new exports! $noexport_hack) + =cut sub delete { @@ -590,7 +517,7 @@ sub delete { return "Can't delete an account with (svc_www) web service!" if qsearch( 'svc_www', { 'usersvc' => $self->usersvc } ); - # what about records in session ? + # what about records in session ? (they should refer to history table) local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -639,6 +566,20 @@ sub delete { return $error; } + #new-style exports! + unless ( $noexport_hack ) { + foreach my $part_export ( $self->cust_svc->part_svc->part_export ) { + my $error = $part_export->export_delete($self); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "exporting to ". $part_export->exporttype. + " (transaction rolled back): $error"; + } + } + } + + #old-style exports + my( $username, $dir ) = ( $self->username, $self->dir, @@ -671,24 +612,6 @@ sub delete { } } - if ( $icradius_dbh ) { - - my $radcheck_queue = - new FS::queue { 'job' => 'FS::svc_acct::icradius_rc_delete' }; - $error = $radcheck_queue->insert( $self->username ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - - my $radreply_queue = - new FS::queue { 'job' => 'FS::svc_acct::icradius_rr_delete' }; - $error = $radreply_queue->insert( $self->username ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - } if ( $vpopdir ) { my $queue = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_delete' }; $error = $queue->insert( $self->username, $self->domain ); @@ -699,6 +622,8 @@ sub delete { } + #end of old-style exports + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } @@ -742,30 +667,6 @@ sub cp_delete { die $app->message."\n" unless $app->ok; } -sub icradius_rc_delete { - my $username = shift; - - my $sth = $icradius_dbh->prepare( - 'DELETE FROM radcheck WHERE UserName = ?' - ); - $sth->execute($username) - or die "can't delete from radcheck table: ". $sth->errstr; - - 1; -} - -sub icradius_rr_delete { - my $username = shift; - - my $sth = $icradius_dbh->prepare( - 'DELETE FROM radreply WHERE UserName = ?' - ); - $sth->execute($username) - or die "can't delete from radreply table: ". $sth->errstr; - - 1; -} - sub vpopmail_delete { my( $username, $domain ) = @_; @@ -858,6 +759,20 @@ sub replace { return $error if $error; } + #new-style exports! + unless ( $noexport_hack ) { + foreach my $part_export ( $new->cust_svc->part_svc->part_export ) { + my $error = $part_export->export_replace($new,$old); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "exporting to ". $part_export->exporttype. + " (transaction rolled back): $error"; + } + } + } + + #old-style exports + my ( $old_dir, $new_dir, $uid, $gid ) = ( $old->getfield('dir'), $new->getfield('dir'), @@ -900,19 +815,6 @@ sub replace { } } - if ( $icradius_dbh ) { - my $queue = new FS::queue { - 'svcnum' => $new->svcnum, - 'job' => 'FS::svc_acct::icradius_rc_replace' - }; - $error = $queue->insert( $new->username, - $new->_password, - ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - } if ( $vpopdir ) { my $cpassword = crypt( $new->_password,$saltset[int(rand(64))].$saltset[int(rand(64))] @@ -938,23 +840,12 @@ sub replace { } } + #end of old-style exports $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error } -sub icradius_rc_replace { - my( $username, $new_password ) = @_; - - my $sth = $icradius_dbh->prepare( - "UPDATE radcheck SET Value = ? WHERE UserName = ? and Attribute = ?" - ); - $sth->execute($new_password, $username, 'Password' ) - or die "can't update radcheck table: ". $sth->errstr; - - 1; -} - sub cp_rename { my ( $old_username, $new_username ) = @_; @@ -1305,19 +1196,22 @@ sub radius_reply { 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. +Note that this is now the preferred method for reading RADIUS attributes - +accessing the columns directly is discouraged, as the column names are +expected to change in the future. =cut sub radius_check { my $self = shift; - map { - /^(rc_(.*))$/; - my($column, $attrib) = ($1, $2); - #$attrib =~ s/_/\-/g; - ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) ); - } grep { /^rc_/ && $self->getfield($_) } fields( $self->table ); + ( 'Password' => $self->_password, + map { + /^(rc_(.*))$/; + my($column, $attrib) = ($1, $2); + #$attrib =~ s/_/\-/g; + ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) ); + } grep { /^rc_/ && $self->getfield($_) } fields( $self->table ) + ); } =item domain diff --git a/FS/bin/freeside-queued b/FS/bin/freeside-queued index 56475d059..c3c9240d2 100644 --- a/FS/bin/freeside-queued +++ b/FS/bin/freeside-queued @@ -15,6 +15,7 @@ use FS::queue; use FS::cust_main; use FS::svc_acct; use Net::SSH 0.05; +use FS::part_export; my $pid_file = '/var/run/freeside-queued.pid'; @@ -85,7 +86,7 @@ while (1) { my $eval = "&". $ljob->job. '(@args);'; warn "running $eval"; - eval $eval; + eval $eval; #throw away return value? suppose so if ( $@ ) { warn "job $eval failed"; my %hash = $ljob->hash; -- cgit v1.2.1 From 415150fe1997eb2688dfd492710f644574e29daf Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 21 Mar 2002 06:57:20 +0000 Subject: more for the new world of export... --- FS/FS/part_export.pm | 119 +++++++++++++++++++++++++++------------------------ 1 file changed, 63 insertions(+), 56 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 444e86aa0..59024f651 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -22,7 +22,7 @@ FS::part_export - Object methods for part_export records ($new_record, $options) = $template_recored->clone( $svcpart ); $error = $record->insert( { 'option' => 'value' } ); - $error = $record->insert( \$options ); + $error = $record->insert( \%options ); $error = $new_record->replace($old_record); @@ -226,6 +226,15 @@ sub replace { } } + #remove extraneous old options? not necessary now, but... + #foreach my $opt ( grep { !exist $options->{$_->optionname} } $old->part_export_option ) { + # my $error = $opt->delete; + # if ( $error ) { + # $dbh->rollback if $oldAutoCommit; + # return $error; + # } + #} + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -320,8 +329,6 @@ sub rebless { =item export_insert SVC_OBJECT -Calls the appropriate export_I for this object's exporttype. - =cut sub export_insert { @@ -361,6 +368,8 @@ sub export_delete { =back +=cut + #infostreet package FS::part_export::infostreet; @@ -423,7 +432,7 @@ sub infostreet_command { #subroutine, not method die $key_result{error} unless $key_result{success}; my $key = $key_result{data}; - my $result = $conn->call($opt{method}, $key, @{$opt{args}}); + my $result = $conn->call($method, $key, @args); my %result = _infostreet_parse($result); die $result{error} unless $result{success}; @@ -470,10 +479,10 @@ sub _export_replace { my %new = $new->$method; my %old = $old->$method; if ( grep { !exists $old{$_} #new attributes - || $new{$n} ne $old{$n} #changed + || $new{$_} ne $old{$_} #changed } keys %new ) { - my $error = $self->sqlradius_queue( $new->svcnum, 'insert' + my $error = $self->sqlradius_queue( $new->svcnum, 'insert', $table, $new->username, %new ); return $error if $error; } @@ -488,9 +497,9 @@ sub _export_replace { } sub _export_delete { - my( $self, $svc_something ) = (shift, shift); + my( $self, $svc_acct ) = (shift, shift); $self->sqlradius_queue( $svc_acct->svcnum, 'delete', - $svc_something->username ); + $svc_acct->username ); } sub sqlradius_queue { @@ -543,10 +552,10 @@ sub sqlradius_attrib_delete { #subroutine, not method foreach my $attribute ( @attrib ) { my $sth = $dbh->prepare( - "DELETE FROM $table WHERE UserName = ? AND Attribute = ?" ) + "DELETE FROM rad$replycheck WHERE UserName = ? AND Attribute = ?" ) or die $dbh->errstr; $sth->execute($username,$attribute) - or die "can't delete from $table table: ". $sth->errstr; + or die "can't delete from rad$replycheck table: ". $sth->errstr; } $dbh->disconnect; } @@ -569,53 +578,51 @@ sub sqlradius_connect { DBI->connect(@_) or die $DBI::errstr; } -=head1 NOTES - -Writing a new export class: - -#myexport - -package FS::part_export::myexport; -use vars qw(@ISA); -@ISA = qw(FS::part_export); - -sub _export_insert { - my($self, $svc_something) = (shift, shift); - $self->myexport_queue( $svc_acct->svcnum, 'insert', - $svc_something->username, $svc_something->password ); -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - #return "can't change username with myexport" - # if $old->username ne $new->username; - #return '' unless $old->_password ne $new->_password; - $self->myexport_queue( $new->svcnum, - 'replace', $new->username, $new->password ); -} - -sub _export_delete { - my( $self, $svc_something ) = (shift, shift); - $self->myexport_queue( $svc_acct->svcnum, - 'delete', $svc_something->username ); -} - -#a good idea to queue anything that could fail or take any time -sub myexport_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::myexport::myexport_$method", - }; - $queue->insert( @_ ); -} +=head1 NEW EXPORT CLASSES -sub myexport_insert { #subroutine, not method -} -sub myexport_replace { #subroutine, not method -} -sub myexport_delete { #subroutine, not method -} + #myexport + + package FS::part_export::myexport; + use vars qw(@ISA); + @ISA = qw(FS::part_export); + + sub _export_insert { + my($self, $svc_something) = (shift, shift); + $self->myexport_queue( $svc_acct->svcnum, 'insert', + $svc_something->username, $svc_something->password ); + } + + sub _export_replace { + my( $self, $new, $old ) = (shift, shift, shift); + #return "can't change username with myexport" + # if $old->username ne $new->username; + #return '' unless $old->_password ne $new->_password; + $self->myexport_queue( $new->svcnum, + 'replace', $new->username, $new->password ); + } + + sub _export_delete { + my( $self, $svc_something ) = (shift, shift); + $self->myexport_queue( $svc_acct->svcnum, + 'delete', $svc_something->username ); + } + + #a good idea to queue anything that could fail or take any time + sub myexport_queue { + my( $self, $svcnum, $method ) = (shift, shift, shift); + my $queue = new FS::queue { + 'svcnum' => $svcnum, + 'job' => "FS::part_export::myexport::myexport_$method", + }; + $queue->insert( @_ ); + } + + sub myexport_insert { #subroutine, not method + } + sub myexport_replace { #subroutine, not method + } + sub myexport_delete { #subroutine, not method + } =head1 BUGS -- cgit v1.2.1 From b159f42fa3f48cc2ca3b43773e7661e17d2fb072 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 22 Mar 2002 12:49:43 +0000 Subject: more new export... --- FS/FS/Record.pm | 2 +- FS/FS/part_export.pm | 43 ++++++++++++++++++++++++++++++------------- FS/MANIFEST | 2 ++ FS/t/part_export.t | 5 +++++ FS/t/part_export_option.t | 5 +++++ 5 files changed, 43 insertions(+), 14 deletions(-) create mode 100644 FS/t/part_export.t create mode 100644 FS/t/part_export_option.t (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 0bd7aeda4..ff967817a 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -947,7 +947,7 @@ Check/untaint host and domain names. sub ut_domain { my( $self, $field ) = @_; #$self->getfield($field) =~/^(\w+\.)*\w+$/ - $self->getfield($field) =~/^(\w+\.)*\w+$/ + $self->getfield($field) =~/^([\w\-]+\.)*\w+$/ or return "Illegal (domain) $field: ". $self->getfield($field); $self->setfield($field,$1); ''; diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 59024f651..3f184be07 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -102,6 +102,7 @@ created (see L). #false laziness w/queue.pm sub insert { my $self = shift; + my $options = shift; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -119,7 +120,6 @@ sub insert { return $error; } - my $options = shift; foreach my $optionname ( keys %{$options} ) { my $part_export_option = new FS::part_export_option ( { 'exportnum' => $self->exportnum, @@ -191,6 +191,8 @@ created or modified (see L). sub replace { my $self = shift; + my $old = shift; + my $options = shift; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -202,13 +204,12 @@ sub replace { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $error = $self->SUPER::replace; + my $error = $self->SUPER::replace($old); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } - my $options = shift; foreach my $optionname ( keys %{$options} ) { my $old = qsearchs( 'part_export_option', { 'exportnum' => $self->exportnum, @@ -219,6 +220,7 @@ sub replace { 'optionname' => $optionname, 'optionvalue' => $options->{$optionname}, } ); + $new->optionnum($old->optionnum) if $old; my $error = $old ? $new->replace($old) : $new->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -226,14 +228,16 @@ sub replace { } } - #remove extraneous old options? not necessary now, but... - #foreach my $opt ( grep { !exist $options->{$_->optionname} } $old->part_export_option ) { - # my $error = $opt->delete; - # if ( $error ) { - # $dbh->rollback if $oldAutoCommit; - # return $error; - # } - #} + #remove extraneous old options + foreach my $opt ( + grep { !exists $options->{$_->optionname} } $old->part_export_option + ) { + my $error = $opt->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } $dbh->commit or die $dbh->errstr if $oldAutoCommit; @@ -253,6 +257,7 @@ sub check { my $self = shift; my $error = $self->ut_numbern('exportnum') + || $self->ut_domain('machine') || $self->ut_number('svcpart') || $self->ut_alpha('exporttype') ; @@ -286,6 +291,9 @@ sub part_svc { =item part_export_option +Returns all options as FS::part_export_option objects (see +L). + =cut sub part_export_option { @@ -295,6 +303,8 @@ sub part_export_option { =item options +Returns a list of option names and values suitable for assigning to a hash. + =cut sub options { @@ -302,7 +312,9 @@ sub options { map { $_->optionname => $_->optionvalue } $self->part_export_option; } -=item option +=item option OPTIONNAME + +Returns the option value for the given name, or the empty string. =cut @@ -318,6 +330,11 @@ sub option { =item rebless +Reblesses the object into the FS::part_export::EXPORTTYPE class, where +EXPORTTYPE is the object's I field. There should be better docs +on how to create new exports (and they should live in their own files and be +autoloaded-on-demand), but until then, see L. + =cut sub rebless { @@ -346,7 +363,7 @@ sub export_insert { # $self->$method(@_); #} -=item export_replace +=item export_replace NEW OLD =cut diff --git a/FS/MANIFEST b/FS/MANIFEST index c1aa5ef1a..19915cdc9 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -90,6 +90,8 @@ t/cust_svc.t t/domain_record.t t/nas.t t/part_bill_event.t +t/part_export.t +t/part_export_option.t t/part_pkg.t t/part_pop_local.t t/part_referral.t diff --git a/FS/t/part_export.t b/FS/t/part_export.t new file mode 100644 index 000000000..26b398791 --- /dev/null +++ b/FS/t/part_export.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export_option.t b/FS/t/part_export_option.t new file mode 100644 index 000000000..13200c213 --- /dev/null +++ b/FS/t/part_export_option.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export_option; +$loaded=1; +print "ok 1\n"; -- cgit v1.2.1 From 20bb426a02c0ea54d8feaea7c5da51735ab70293 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 22 Mar 2002 18:56:33 +0000 Subject: RADIUS groups on the way! --- FS/FS/cust_main_county.pm | 2 +- FS/FS/svc_acct.pm | 60 +++++++++++++++++++++++++++++++++++++++++++++++ FS/MANIFEST | 4 +++- FS/t/radius_usergroup.t | 5 ++++ 4 files changed, 69 insertions(+), 2 deletions(-) create mode 100644 FS/t/radius_usergroup.t (limited to 'FS') diff --git a/FS/FS/cust_main_county.pm b/FS/FS/cust_main_county.pm index 95ed53dab..56d29da94 100644 --- a/FS/FS/cust_main_county.pm +++ b/FS/FS/cust_main_county.pm @@ -227,7 +227,7 @@ END =head1 BUGS -regionseletor? putting web ui components in here? they should probably live +regionselector? putting web ui components in here? they should probably live somewhere else... =head1 SEE ALSO diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 2305aeb80..9da5a6671 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -27,6 +27,7 @@ use FS::cust_main_invoice; use FS::svc_domain; use FS::raddb; use FS::queue; +use FS::radius_usergroup; @ISA = qw( FS::svc_Common ); @@ -1282,8 +1283,64 @@ sub seconds_since { $self->cust_svc->seconds_since(@_); } +=item radius_groups + +Returns all RADIUS groups for this account (see L). + +=cut + +sub radius_groups { + my $self = shift; + map { $_->groupname } + qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } ); +} + =back +=head1 SUBROUTINES + +=item radius_usergroup_selector GROUPS_ARRAYREF + +=cut + +sub radius_usergroup_selector { + my $sel_groups = shift; + my %sel_groups = map { $_=>1 } @$sel_groups; + + my $selectname = shift || 'radius_usergroup'; + + my $dbh = dbh; + my $sth = $dbh->prepare( + 'SELECT DISTINCT(groupname) FROM radius_usergroup ORDER BY groupname' + ) or die $dbh->errstr; + $sth->execute() or die $sth->errstr; + my @all_groups = map { $_->[0] } @{$sth->fetchall_arrayref}; + + my $html = < + function ${selectname}_doadd(object) { + var myvalue = object.${selectname}_add.value; + var optionName = new Option(myvalue,myvalue,false,true); + var length = object.$selectname.length; + object.$selectname.options[length] = optionName; + } + + !. + qq!!; + + $html; +} + =head1 BUGS The $recref stuff in sub check should be cleaned up. @@ -1292,6 +1349,9 @@ The suspend, unsuspend and cancel methods update the database, but not the current object. This is probably a bug as it's unexpected and counterintuitive. +radius_usergroup_selector? putting web ui components in here? they should +probably live somewhere else... + =head1 SEE ALSO L, edit/part_svc.cgi from an installed web interface, diff --git a/FS/MANIFEST b/FS/MANIFEST index 19915cdc9..54aaaa19f 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -65,6 +65,7 @@ FS/prepay_credit.pm FS/svc_www.pm FS/svc_forward.pm FS/raddb.pm +FS/radius_usergroup.pm FS/queue.pm FS/queue_arg.pm t/agent.t @@ -72,6 +73,7 @@ t/agent_type.t t/CGI.t t/Conf.t t/ConfItem.t +t/Record.t t/cust_bill.t t/cust_bill_event.t t/cust_bill_pay.t @@ -100,7 +102,7 @@ t/part_svc_column.t t/pkg_svc.t t/port.t t/prepay_credit.t -t/Record.t +t/radius_usergroup.t t/session.t t/svc_acct.t t/svc_acct_pop.t diff --git a/FS/t/radius_usergroup.t b/FS/t/radius_usergroup.t new file mode 100644 index 000000000..325742cf5 --- /dev/null +++ b/FS/t/radius_usergroup.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::radius_usergroup; +$loaded=1; +print "ok 1\n"; -- cgit v1.2.1 From 4fb679b29788a552a1ce33a0cdf293d648e797bc Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 23 Mar 2002 07:54:05 +0000 Subject: redirect STDOUT/STDERR a bit later for better error reporting --- FS/bin/freeside-queued | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-queued b/FS/bin/freeside-queued index c3c9240d2..fff77f01b 100644 --- a/FS/bin/freeside-queued +++ b/FS/bin/freeside-queued @@ -21,7 +21,7 @@ my $pid_file = '/var/run/freeside-queued.pid'; my $user = shift or die &usage; -&daemonize; +&daemonize1; sub REAPER { my $pid = wait; $SIG{CHLD} = \&REAPER; } $SIG{CHLD} = \&REAPER; @@ -38,6 +38,8 @@ adminsuidsetup $user; $log_file = "/usr/local/etc/freeside/queuelog.". $FS::UID::datasrc; +&daemonize2; + $SIG{__DIE__} = \&_die; $SIG{__WARN__} = \&_logmsg; @@ -134,7 +136,7 @@ sub _logmsg { close $log; } -sub daemonize { +sub daemonize1 { chdir "/" or die "Can't chdir to /: $!"; open STDIN, '/dev/null' or die "Can't read /dev/null: $!"; @@ -146,11 +148,18 @@ sub daemonize { print $pidfh "$pid\n"; exit; } + #open STDOUT, '>/dev/null' + # or die "Can't write to /dev/null: $!"; + #setsid or die "Can't start a new session: $!"; + #open STDERR, '>&STDOUT' or die "Can't dup stdout: $!"; + +} + +sub daemonize2 { open STDOUT, '>/dev/null' or die "Can't write to /dev/null: $!"; setsid or die "Can't start a new session: $!"; open STDERR, '>&STDOUT' or die "Can't dup stdout: $!"; - } =head1 NAME -- cgit v1.2.1 From 8fe83dcb8807a86209625a5aab7e574073f0a907 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 23 Mar 2002 16:16:00 +0000 Subject: group editing seems to be working... everything except defaults... oh and export... --- FS/FS/part_export.pm | 8 +++--- FS/FS/queue.pm | 44 +++++++++++++++++------------- FS/FS/svc_acct.pm | 76 +++++++++++++++++++++++++++++++++++++++++++++++++--- 3 files changed, 103 insertions(+), 25 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 3f184be07..9aedd9f7a 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -505,9 +505,11 @@ sub _export_replace { } my @del = grep { !exists $new{$_} } keys %old; - my $error = $self->sqlradius_queue( $new->svcnum, 'sqlradius_attrib_delete', - $table, $new->username, @del ); - return $error if $error; + if ( @del ) { + my $error = $self->sqlradius_queue( $new->svcnum, 'attrib_delete', + $table, $new->username, @del ); + return $error if $error; + } } ''; diff --git a/FS/FS/queue.pm b/FS/FS/queue.pm index a6d78e143..7a38a6eef 100644 --- a/FS/FS/queue.pm +++ b/FS/FS/queue.pm @@ -222,7 +222,7 @@ sub cust_svc { qsearchs('cust_svc', { 'svcnum' => $self->svcnum } ); } -=item joblisting HASHREF +=item joblisting HASHREF NOACTIONS =cut @@ -232,21 +232,24 @@ sub joblisting { use Date::Format; use FS::CGI; + my @queue = qsearch( 'queue', $hashref ); + return '' unless scalar(@queue); + my $html = FS::CGI::table(). < Job Args Date Status - Account - END + $html .= 'Account' unless $hashref->{svcnum}; + $html .= ''; my $p = FS::CGI::popurl(2); foreach my $queue ( sort { $a->getfield('jobnum') <=> $b->getfield('jobnum') - } qsearch( 'queue', $hashref ) ) { - my $hashref = $queue->hashref; + } @queue ) { + my $queue_hashref = $queue->hashref; my $jobnum = $queue->jobnum; my $args = join(' ', $queue->args); my $date = time2str( "%a %b %e %T %Y", $queue->_date ); @@ -258,26 +261,31 @@ END qq! remove )!; } my $cust_svc = $queue->cust_svc; - my $account; - if ( $cust_svc ) { - my $table = $cust_svc->part_svc->svcdb; - my $label = ( $cust_svc->label )[1]; - $account = qq!$label!; - } else { - $account = ''; - } + $html .= < $jobnum - $hashref->{job} + $queue_hashref->{job} $args $date $status - $account - END + unless ( $hashref->{svcnum} ) { + my $account; + if ( $cust_svc ) { + my $table = $cust_svc->part_svc->svcdb; + my $label = ( $cust_svc->label )[1]; + $account = qq!$label!; + } else { + $account = ''; + } + $html .= "$account"; + } + + $html .= ''; + } $html .= ''; @@ -290,7 +298,7 @@ END =head1 VERSION -$Id: queue.pm,v 1.7 2002-03-07 14:10:10 ivan Exp $ +$Id: queue.pm,v 1.8 2002-03-23 16:16:00 ivan Exp $ =head1 BUGS diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 9da5a6671..bb6b9959b 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -192,8 +192,6 @@ FS::svc_Common. The following fields are currently supported: =item radius_I - I -=item domsvc - service number of svc_domain with which to associate - =back =head1 METHODS @@ -216,6 +214,10 @@ otherwise returns false. The additional fields pkgnum and svcpart (see L) should be defined. An FS::cust_svc record will be created and inserted. +The additional field I can optionally be defined; if so it should +contain an arrayref of group names. See L. (used in +sqlradius export only) + If the configuration value (see L) shellmachine exists, and the username, uid, and dir fields are defined, the command(s) specified in the shellmachine-useradd configuration are added to the job queue (see @@ -289,6 +291,20 @@ sub insert { return $error; } + if ( $self->usergroup ) { + foreach my $groupname ( @{$self->usergroup} ) { + my $radius_usergroup = new FS::radius_usergroup ( { + svcnum => $self->svcnum, + groupname => $groupname, + } ); + my $error = $radius_usergroup->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + } + #new-style exports! unless ( $noexport_hack ) { foreach my $part_export ( $self->cust_svc->part_svc->part_export ) { @@ -561,6 +577,16 @@ sub delete { } } + foreach my $radius_usergroup ( + qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } ) + ) { + my $error = $radius_usergroup->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + my $error = $self->SUPER::delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -700,6 +726,10 @@ sub vpopmail_delete { Replaces OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. +The additional field I can optionally be defined; if so it should +contain an arrayref of group names. See L. (used in +sqlradius export only) + If the configuration value (see L) shellmachine exists, and the dir field has changed, the command(s) specified in the shellmachine-usermod configuraiton file are added to the job queue (see L and @@ -760,6 +790,40 @@ sub replace { return $error if $error; } + $old->usergroup( [ $old->radius_groups ] ); + + if ( $new->usergroup ) { + + foreach my $groupname ( @{$old->usergroup} ) { + if ( grep { $groupname eq $_ } @{$new->usergroup} ) { + $new->usergroup( [ grep { $groupname ne $_ } @{$new->usergroup} ] ); + next; + } + my $radius_usergroup = qsearch('radius_usergroup', { + svcnum => $old->svcnum, + groupname => $groupname, + } ); + my $error = $radius_usergroup->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error deleting radius_usergroup $groupname: $error"; + } + } + + foreach my $groupname ( @{$new->usergroup} ) { + my $radius_usergroup = new FS::radius_usergroup ( { + svcnum => $new->svcnum, + groupname => $groupname, + } ); + my $error = $radius_usergroup->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error adding radius_usergroup $groupname: $error"; + } + } + + } + #new-style exports! unless ( $noexport_hack ) { foreach my $part_export ( $new->cust_svc->part_svc->part_export ) { @@ -1299,7 +1363,7 @@ sub radius_groups { =head1 SUBROUTINES -=item radius_usergroup_selector GROUPS_ARRAYREF +=item radius_usergroup_selector GROUPS_ARRAYREF [ SELECTNAME ] =cut @@ -1323,6 +1387,7 @@ sub radius_usergroup_selector { var optionName = new Option(myvalue,myvalue,false,true); var length = object.$selectname.length; object.$selectname.options[length] = optionName; + object.${selectname}_add.value = ""; } !. -- cgit v1.2.1 From 74e64d70361848f089aad9a7881c2af9caf6e479 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 23 Mar 2002 17:49:01 +0000 Subject: okay group editing UI as well as part_svc group editing UI seem to be working --- FS/FS/part_svc.pm | 24 +++++++++++++++++++----- FS/FS/svc_acct.pm | 7 +++++-- 2 files changed, 24 insertions(+), 7 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_svc.pm b/FS/FS/part_svc.pm index 82935dd2b..94f51fa98 100644 --- a/FS/FS/part_svc.pm +++ b/FS/FS/part_svc.pm @@ -57,19 +57,25 @@ database, see L<"insert">. sub table { 'part_svc'; } -=item insert +=item insert EXTRA_FIELDS_ARRAYREF Adds this service definition to the database. If there is an error, returns the error, otherwise returns false. +TODOC: + =item I__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 +TODOC: EXTRA_FIELDS_ARRAYREF + =cut sub insert { my $self = shift; + my @fields = (); + @fields = @{shift(@_)} if @_; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -96,7 +102,7 @@ sub insert { foreach my $field ( grep { $_ ne 'svcnum' && defined( $self->getfield($svcdb.'__'.$_.'_flag') ) - } fields($svcdb) + } (fields($svcdb), @fields) ) { my $part_svc_column = $self->part_svc_column($field); my $previous = qsearchs('part_svc_column', { @@ -141,11 +147,15 @@ sub delete { # check & make sure the svcpart isn't in cust_svc or pkg_svc (in any packages)? } -=item replace OLD_RECORD +=item replace OLD_RECORD [ '1.3-COMPAT' [ , EXTRA_FIELDS_ARRAYREF ] ] Replaces OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. +TODOC: 1.3-COMPAT + +TODOC: EXTRA_FIELDS_ARRAYREF + =cut sub replace { @@ -172,11 +182,15 @@ sub replace { } if ( @_ && $_[0] eq '1.3-COMPAT' ) { + shift; + my @fields = (); + @fields = @{shift(@_)} if @_; + my $svcdb = $new->svcdb; foreach my $field ( grep { $_ ne 'svcnum' && defined( $new->getfield($svcdb.'__'.$_.'_flag') ) - } fields($svcdb) + } (fields($svcdb),@fields) ) { my $part_svc_column = $new->part_svc_column($field); my $previous = qsearchs('part_svc_column', { @@ -309,7 +323,7 @@ sub part_export { =head1 VERSION -$Id: part_svc.pm,v 1.10 2002-03-20 21:31:49 ivan Exp $ +$Id: part_svc.pm,v 1.11 2002-03-23 17:49:01 ivan Exp $ =head1 BUGS diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index bb6b9959b..a3e97f74c 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -799,7 +799,7 @@ sub replace { $new->usergroup( [ grep { $groupname ne $_ } @{$new->usergroup} ] ); next; } - my $radius_usergroup = qsearch('radius_usergroup', { + my $radius_usergroup = qsearchs('radius_usergroup', { svcnum => $old->svcnum, groupname => $groupname, } ); @@ -1395,7 +1395,10 @@ END foreach my $group ( @all_groups ) { $html .= ' Date: Sun, 24 Mar 2002 14:29:00 +0000 Subject: ICRADIUS groups all done! UI and provisioning. closes: Bug#362 fix some bugs in the export and add queue_dangerous_controls option too --- FS/FS/Conf.pm | 7 +++ FS/FS/part_export.pm | 96 +++++++++++++++++++++++++++++++--- FS/FS/queue.pm | 13 +++-- FS/FS/radius_usergroup.pm | 130 ++++++++++++++++++++++++++++++++++++++++++++++ FS/FS/svc_acct.pm | 31 ++++++----- 5 files changed, 253 insertions(+), 24 deletions(-) create mode 100644 FS/FS/radius_usergroup.pm (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 645dbf1c4..2bc5e24c0 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -836,6 +836,13 @@ httemplate/docs/config.html 'type' => 'checkbox', }, + { + 'key' => 'queue_dangerous_controls', + 'section' => 'UI', + 'description' => 'Enable queue modification controls on account pages and for new jobs. Unless you are a developer working on new export code, you should probably leave this off to avoid causing provisioning problems.', + 'type' => 'checkbox', + }, + ); 1; diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 9aedd9f7a..eabcedec1 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -383,6 +383,22 @@ sub export_delete { $self->_export_delete(@_); } +#fallbacks providing useful error messages intead of infinite loops +sub _export_insert { + my $self = shift; + return "_export_insert: unknown export type ". $self->exporttype; +} + +sub _export_replace { + my $self = shift; + return "_export_replace: unknown export type ". $self->exporttype; +} + +sub _export_delete { + my $self = shift; + return "_export_delete: unknown export type ". $self->exporttype; +} + =back =cut @@ -474,10 +490,22 @@ use vars qw(@ISA); sub _export_insert { my($self, $svc_acct) = (shift, shift); - $self->sqlradius_queue( $svc_acct->svcnum, 'insert', - 'reply', $svc_acct->username, $svc_acct->radius_reply ); - $self->sqlradius_queue( $svc_acct->svcnum, 'insert', - 'check', $svc_acct->username, $svc_acct->radius_check ); + + foreach my $table (qw(reply check)) { + my $method = "radius_$table"; + my %attrib = $svc_acct->$method; + next unless keys %attrib; + my $error = $self->sqlradius_queue( $svc_acct->svcnum, 'insert', + $table, $svc_acct->username, %attrib ); + return $error if $error; + } + my @groups = $svc_acct->radius_groups; + if ( @groups ) { + my $error = $self->sqlradius_queue( $svc_acct->svcnum, 'usergroup_insert', + $svc_acct->username, @groups ); + return $error if $error; + } + ''; } sub _export_replace { @@ -512,6 +540,30 @@ sub _export_replace { } } + # (sorta) false laziness with FS::svc_acct::replace + my @oldgroups = @{$old->usergroup}; #uuuh + my @newgroups = $new->radius_groups; + my @delgroups = (); + foreach my $oldgroup ( @oldgroups ) { + if ( grep { $oldgroup eq $_ } @newgroups ) { + @newgroups = grep { $oldgroup ne $_ } @newgroups; + next; + } + push @delgroups, $oldgroup; + } + + if ( @delgroups ) { + my $error = $self->sqlradius_queue( $new->svcnum, 'usergroup_delete', + $new->username, @delgroups ); + return $error if $error; + } + + if ( @newgroups ) { + my $error = $self->sqlradius_queue( $new->svcnum, 'usergroup_insert', + $new->username, @newgroups ); + return $error if $error; + } + ''; } @@ -544,8 +596,8 @@ sub sqlradius_insert { #subroutine, not method "UPDATE rad$replycheck SET Value = ? WHERE UserName = ? AND Attribute = ?" ) or die $dbh->errstr; my $i_sth = $dbh->prepare( "INSERT INTO rad$replycheck ( id, UserName, Attribute, Value ) ". - "VALUES ( ?, ?, ?, ? )" ) - or die $dbh->errstr; + "VALUES ( ?, ?, ?, ? )" + ) or die $dbh->errstr; $u_sth->execute($attributes{$attribute}, $username, $attribute) > 0 or $i_sth->execute( '', $username, $attribute, $attributes{$attribute} ) or die "can't insert into rad$replycheck table: ". $i_sth->errstr; @@ -553,10 +605,38 @@ sub sqlradius_insert { #subroutine, not method $dbh->disconnect; } +sub sqlradius_usergroup_insert { #subroutine, not method + my $dbh = sqlradius_connect(shift, shift, shift); + my( $username, @groups ) = @_; + + my $sth = $dbh->prepare( + "INSERT INTO usergroup ( id, UserName, GroupName ) VALUES ( ?, ?, ? )" + ) or die $dbh->errstr; + foreach my $group ( @groups ) { + $sth->execute( '', $username, $group ) + or die "can't insert into groupname table: ". $sth->errstr; + } + $dbh->disconnect; +} + +sub sqlradius_usergroup_delete { #subroutine, not method + my $dbh = sqlradius_connect(shift, shift, shift); + my( $username, @groups ) = @_; + + my $sth = $dbh->prepare( + "DELETE FROM usergroup ( id, UserName, GroupName ) VALUES ( ?, ?, ? )" + ) or die $dbh->errstr; + foreach my $group ( @groups ) { + $sth->execute( '', $username, $group ) + or die "can't delete from groupname table: ". $sth->errstr; + } + $dbh->disconnect; +} + sub sqlradius_rename { #subroutine, not method my $dbh = sqlradius_connect(shift, shift, shift); my($new_username, $old_username) = @_; - foreach my $table (qw(radreply radcheck)) { + foreach my $table (qw(radreply radcheck usergroup )) { my $sth = $dbh->prepare("UPDATE $table SET Username = ? WHERE UserName = ?") or die $dbh->errstr; $sth->execute($new_username, $old_username) @@ -583,7 +663,7 @@ sub sqlradius_delete { #subroutine, not method my $dbh = sqlradius_connect(shift, shift, shift); my $username = shift; - foreach my $table (qw( radcheck radreply )) { + foreach my $table (qw( radcheck radreply usergroup )) { my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" ); $sth->execute($username) or die "can't delete from $table table: ". $sth->errstr; diff --git a/FS/FS/queue.pm b/FS/FS/queue.pm index 7a38a6eef..e5369cf82 100644 --- a/FS/FS/queue.pm +++ b/FS/FS/queue.pm @@ -1,8 +1,10 @@ package FS::queue; use strict; -use vars qw( @ISA @EXPORT_OK ); +use vars qw( @ISA @EXPORT_OK $conf ); use Exporter; +use FS::UID; +use FS::Conf; use FS::Record qw( qsearch qsearchs dbh ); #use FS::queue; use FS::queue_arg; @@ -11,6 +13,10 @@ use FS::cust_svc; @ISA = qw(FS::Record); @EXPORT_OK = qw( joblisting ); +$FS::UID::callback{'FS::queue'} = sub { + $conf = new FS::Conf; +}; + =head1 NAME FS::queue - Object methods for queue records @@ -255,7 +261,8 @@ END my $date = time2str( "%a %b %e %T %Y", $queue->_date ); my $status = $queue->status; $status .= ': '. $queue->statustext if $queue->statustext; - if ( ! $noactions && $status =~ /^failed/ || $status =~ /^locked/ ) { + if ( $conf->exists('queue_dangerous_controls') + || ( ! $noactions && $status =~ /^failed/ || $status =~ /^locked/ ) ) { $status .= qq! ( retry |!. qq! remove )!; @@ -298,7 +305,7 @@ END =head1 VERSION -$Id: queue.pm,v 1.8 2002-03-23 16:16:00 ivan Exp $ +$Id: queue.pm,v 1.9 2002-03-24 14:29:00 ivan Exp $ =head1 BUGS diff --git a/FS/FS/radius_usergroup.pm b/FS/FS/radius_usergroup.pm new file mode 100644 index 000000000..647621d28 --- /dev/null +++ b/FS/FS/radius_usergroup.pm @@ -0,0 +1,130 @@ +package FS::radius_usergroup; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearch qsearchs ); +use FS::svc_acct; + +@ISA = qw(FS::Record); + +=head1 NAME + +FS::radius_usergroup - Object methods for radius_usergroup records + +=head1 SYNOPSIS + + use FS::radius_usergroup; + + $record = new FS::radius_usergroup \%hash; + $record = new FS::radius_usergroup { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::radius_usergroup object links an account (see L) with a +RADIUS group. FS::radius_usergroup inherits from FS::Record. The following +fields are currently supported: + +=over 4 + +=item usergroupnum - primary key + +=item svcnum - Account (see L). + +=item groupname - group name + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new record. To add the record to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'radius_usergroup'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +#inherited from FS::Record + +=item delete + +Delete this record from the database. + +=cut + +#inherited from FS::Record + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +#inherited from FS::Record + +=item check + +Checks all fields to make sure this is a valid record. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +sub check { + my $self = shift; + + $self->ut_numbern('usergroupnum') + || $self->ut_number('svcnum') + || $self->ut_foreign_key('svcnum','svc_acct','svcnum') + || $self->ut_text('groupname') + ; +} + +=item svc_acct + +Returns the account associated with this record (see L). + +=cut + +sub svc_acct { + my $self = shift; + qsearchs('svc_acct', { svcnum => $self->svcnum } ); +} + +=back + +=head1 BUGS + +Don't let 'em get you down. + +=head1 SEE ALSO + +L, L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index a3e97f74c..197eec1b5 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -257,8 +257,6 @@ sub insert { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $amount = 0; - $error = $self->check; return $error if $error; @@ -587,6 +585,8 @@ sub delete { } } + my $part_svc = $self->cust_svc->part_svc; + my $error = $self->SUPER::delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -595,7 +595,7 @@ sub delete { #new-style exports! unless ( $noexport_hack ) { - foreach my $part_export ( $self->cust_svc->part_svc->part_export ) { + foreach my $part_export ( $part_svc->part_export ) { my $error = $part_export->export_delete($self); if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -791,34 +791,34 @@ sub replace { } $old->usergroup( [ $old->radius_groups ] ); - if ( $new->usergroup ) { - - foreach my $groupname ( @{$old->usergroup} ) { - if ( grep { $groupname eq $_ } @{$new->usergroup} ) { - $new->usergroup( [ grep { $groupname ne $_ } @{$new->usergroup} ] ); + #(sorta) false laziness with FS::part_export::sqlradius::_export_replace + my @newgroups = @{$new->usergroup}; + foreach my $oldgroup ( @{$old->usergroup} ) { + if ( grep { $oldgroup eq $_ } @newgroups ) { + @newgroups = grep { $oldgroup ne $_ } @newgroups; next; } my $radius_usergroup = qsearchs('radius_usergroup', { svcnum => $old->svcnum, - groupname => $groupname, + groupname => $oldgroup, } ); my $error = $radius_usergroup->delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "error deleting radius_usergroup $groupname: $error"; + return "error deleting radius_usergroup $oldgroup: $error"; } } - foreach my $groupname ( @{$new->usergroup} ) { + foreach my $newgroup ( @newgroups ) { my $radius_usergroup = new FS::radius_usergroup ( { svcnum => $new->svcnum, - groupname => $groupname, + groupname => $newgroup, } ); my $error = $radius_usergroup->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "error adding radius_usergroup $groupname: $error"; + return "error adding radius_usergroup $newgroup: $error"; } } @@ -1072,6 +1072,11 @@ sub check { return $x unless ref($x); my $part_svc = $x; + if ( $part_svc->part_svc_column('usergroup')->columnflag eq "F" ) { + $self->usergroup( + [ split(',', $part_svc->part_svc_column('usergroup')->columnvalue) ] ); + } + my $error = $self->ut_numbern('svcnum') || $self->ut_number('domsvc') ; -- cgit v1.2.1 From 1858140b774bfe3a694a2ededf70de797da31c51 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 24 Mar 2002 17:42:58 +0000 Subject: "subscription" price plan from "Luke Pfeifer" --- FS/FS/part_pkg.pm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index 3d536e7d9..00ce1d944 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -198,6 +198,8 @@ sub check { or $r =~ /^my \$mnow = \$sdate; my \(\$sec,\$min,\$hour,\$mday,\$mon,\$year\) = \(localtime\(\$sdate\) \)\[0,1,2,3,4,5\]; my \$mstart = timelocal\(0,0,0,1,\$mon,\$year\); my \$mend = timelocal\(0,0,0,1, \$mon == 11 \? 0 : \$mon\+1, \$year\+\(\$mon==11\)\); \$sdate = \$mstart; \( \$part_pkg->freq \- 1 \) \* \d*\.?\d* \/ \$part_pkg\-\>freq \+ \d*\.?\d* \/ \$part_pkg\-\>freq \* \(\$mend\-\$mnow\) \/ \(\$mend\-\$mstart\) ;\s*$/ + or $r =~ /^my \$mnow = \$sdate; my \(\$sec,\$min,\$hour,\$mday,\$mon,\$year\) = \(localtime\(\$sdate\) \)\[0,1,2,3,4,5\]; \$sdate = timelocal\(0,0,0,1,\$mon,\$year\); \s*\d*\.?\d*\s*;\s*$/ + or $r =~ /^my \$error = \$cust_pkg\->cust_main\->credit\( \s*\d*\.?\d*\s* \* scalar\(\$cust_pkg\->cust_main\->referral_cust_main_ncancelled\(\s*\d+\s*\)\), "commission" \); die \$error if \$error; \s*\d*\.?\d*\s*;\s*$/ or $r =~ /^my \$error = \$cust_pkg\->cust_main\->credit\( \s*\d*\.?\d*\s* \* scalar\(\$cust_pkg\->cust_main->referral_cust_pkg\(\s*\d+\s*\)\), "commission" \); die \$error if \$error; \s*\d*\.?\d*\s*;\s*$/ @@ -264,7 +266,7 @@ sub svcpart { =head1 VERSION -$Id: part_pkg.pm,v 1.8 2002-02-18 08:39:21 ivan Exp $ +$Id: part_pkg.pm,v 1.9 2002-03-24 17:42:58 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 0e475dcb559be6b39338a7070103527d9ae66e14 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 24 Mar 2002 18:23:47 +0000 Subject: tyop --- FS/FS/agent.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/agent.pm b/FS/FS/agent.pm index 1afe70641..f11a28db9 100644 --- a/FS/FS/agent.pm +++ b/FS/FS/agent.pm @@ -40,7 +40,7 @@ from FS::Record. The following fields are currently supported: =over 4 -=item agemtnum - primary key (assigned automatically for new agents) +=item agentnum - primary key (assigned automatically for new agents) =item agent - Text name of this agent @@ -145,7 +145,7 @@ sub pkgpart_hashref { =head1 VERSION -$Id: agent.pm,v 1.2 2000-12-03 13:45:15 ivan Exp $ +$Id: agent.pm,v 1.3 2002-03-24 18:23:47 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From c6da895a2fb2c233716381b7e45ebbeb1c2f6aaa Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 26 Mar 2002 00:32:46 +0000 Subject: further export bugfixing add 10 kid limit to freeside-queued sqlradius_reset now works (closes: Bug#372) --- FS/FS/part_export.pm | 8 +++++++- FS/bin/freeside-queued | 28 +++++++++++++++++++++------- 2 files changed, 28 insertions(+), 8 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index eabcedec1..41dfe77a1 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -409,6 +409,8 @@ package FS::part_export::infostreet; use vars qw(@ISA); @ISA = qw(FS::part_export); +sub rebless { shift; } + sub _export_insert { my( $self, $svc_acct ) = (shift, shift); $self->infostreet_queue( $svc_acct->svcnum, @@ -488,6 +490,8 @@ package FS::part_export::sqlradius; use vars qw(@ISA); @ISA = qw(FS::part_export); +sub rebless { shift; } + sub _export_insert { my($self, $svc_acct) = (shift, shift); @@ -684,7 +688,9 @@ sub sqlradius_connect { package FS::part_export::myexport; use vars qw(@ISA); @ISA = qw(FS::part_export); - + + sub rebless { shift; } + sub _export_insert { my($self, $svc_something) = (shift, shift); $self->myexport_queue( $svc_acct->svcnum, 'insert', diff --git a/FS/bin/freeside-queued b/FS/bin/freeside-queued index fff77f01b..f6226cca1 100644 --- a/FS/bin/freeside-queued +++ b/FS/bin/freeside-queued @@ -1,7 +1,7 @@ #!/usr/bin/perl -w use strict; -use vars qw( $log_file $sigterm $sigint ); +use vars qw( $log_file $sigterm $sigint $kids $max_kids ); use subs qw( _die _logmsg ); use Fcntl qw(:flock); use POSIX qw(setsid); @@ -19,15 +19,18 @@ use FS::part_export; my $pid_file = '/var/run/freeside-queued.pid'; +$max_kids = '10'; #guess it should be a config file... +$kids = 0; + my $user = shift or die &usage; &daemonize1; -sub REAPER { my $pid = wait; $SIG{CHLD} = \&REAPER; } +sub REAPER { my $pid = wait; $SIG{CHLD} = \&REAPER; $kids--; } $SIG{CHLD} = \&REAPER; - $sigterm = 0; - $sigint = 0; +$sigterm = 0; +$sigint = 0; $SIG{INT} = sub { warn "SIGINT received; shutting down\n"; $sigint++; }; $SIG{TERM} = sub { warn "SIGTERM received; shutting down\n"; $sigterm++; }; @@ -45,8 +48,17 @@ $SIG{__WARN__} = \&_logmsg; warn "freeside-queued starting\n"; +my $warnkids=0; while (1) { + #prevent runaway forking + if ( $kids >= $max_kids ) { + warn "WARNING: maximum $kids children reached\n" unless $warnkids++; + sleep 1; #waiting for signals is cheap + next; + } + $warnkids=0; + my $job = qsearchs( 'queue', { 'status' => 'new' }, @@ -55,7 +67,7 @@ while (1) { ? 'ORDER BY jobnum LIMIT 1 FOR UPDATE' : 'ORDER BY jobnum FOR UPDATE LIMIT 1' ) or do { - sleep 5; + sleep 5; #connecting to db is expensive next; }; @@ -67,7 +79,6 @@ while (1) { my @args = $ljob->args; - # number of children limit? defined( my $pid = fork ) or do { warn "WARNING: can't fork: $!\n"; my %hash = $job->hash; @@ -76,9 +87,12 @@ while (1) { my $ljob = new FS::queue ( \%hash ); my $error = $ljob->replace($job); die $error if $error; + next; #don't increment the kid counter }; - unless ( $pid ) { #kid time + if ( $pid ) { + $kids++; + } else { #kid time #get new db handles $FS::UID::dbh->{InactiveDestroy} = 1; -- cgit v1.2.1 From db81095a56b1e4504199c1983917a2e7a5e42a14 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 26 Mar 2002 13:58:29 +0000 Subject: forgot to use FS::part_export to search on it --- FS/FS/part_svc.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_svc.pm b/FS/FS/part_svc.pm index 94f51fa98..7ef996f5f 100644 --- a/FS/FS/part_svc.pm +++ b/FS/FS/part_svc.pm @@ -4,6 +4,7 @@ use strict; use vars qw( @ISA ); use FS::Record qw( qsearch qsearchs fields dbh ); use FS::part_svc_column; +use FS::part_export; @ISA = qw(FS::Record); @@ -323,7 +324,7 @@ sub part_export { =head1 VERSION -$Id: part_svc.pm,v 1.11 2002-03-23 17:49:01 ivan Exp $ +$Id: part_svc.pm,v 1.12 2002-03-26 13:58:29 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 8ea299358401bea12bef7c2dd1841cef3cf45c20 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 27 Mar 2002 05:36:10 +0000 Subject: s/referral/advertising source/ yes, the name sucks. got a better one? --- FS/FS/cust_main.pm | 6 +++--- FS/FS/part_referral.pm | 36 +++++++++++++++++++++--------------- 2 files changed, 24 insertions(+), 18 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 9eb569f96..b59b0d1ac 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -99,7 +99,7 @@ FS::Record. The following fields are currently supported: =item agentnum - agent (see L) -=item refnum - referral (see L) +=item refnum - Advertising source (see L) =item first - name @@ -531,14 +531,14 @@ sub check { || $self->ut_numbern('referral_custnum') ; #barf. need message catalogs. i18n. etc. - $error .= "Please select a referral." + $error .= "Please select a advertising source." if $error =~ /^Illegal or empty \(numeric\) refnum: /; return $error if $error; return "Unknown agent" unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } ); - return "Unknown referral" + return "Unknown refnum" unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } ); return "Unknown referring custnum ". $self->referral_custnum diff --git a/FS/FS/part_referral.pm b/FS/FS/part_referral.pm index 3f0af4b8e..23885dffd 100644 --- a/FS/FS/part_referral.pm +++ b/FS/FS/part_referral.pm @@ -27,26 +27,32 @@ FS::part_referral - Object methods for part_referral objects =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: +An FS::part_referral represents a advertising source - where a customer heard +of your services. This can be used to track the effectiveness of a particular +piece of advertising, for example. FS::part_referral inherits from FS::Record. +The following fields are currently supported: =over 4 =item refnum - primary key (assigned automatically for new referrals) -=item referral - Text name of this referral +=item referral - Text name of this advertising source =back +=head1 NOTE + +These were called B before version 1.4.0 - the name was changed +so as not to be confused with the new customer-to-customer referrals. + =head1 METHODS =over 4 =item new HASHREF -Creates a new referral. To add the referral to the database, see L<"insert">. +Creates a new advertising source. To add the referral to the database, see +L<"insert">. =cut @@ -54,8 +60,8 @@ sub table { 'part_referral'; } =item insert -Adds this referral to the database. If there is an error, returns the error, -otherwise returns false. +Adds this advertising source to the database. If there is an error, returns +the error, otherwise returns false. =item delete @@ -76,9 +82,9 @@ returns the error, otherwise returns false. =item check -Checks all fields to make sure this is a valid referral. If there is an error, -returns the error, otherwise returns false. Called by the insert and replace -methods. +Checks all fields to make sure this is a valid advertising source. If there is +an error, returns the error, otherwise returns false. Called by the insert and +replace methods. =cut @@ -92,14 +98,14 @@ sub check { =back -=head1 VERSION - -$Id: part_referral.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ - =head1 BUGS The delete method is unimplemented. +`Advertising source'. Yes, it's a sucky name. The only other ones I could +come up with were "Marketing channel" and "Heard Abouts" and those are +definately both worse. + =head1 SEE ALSO L, L, schema.html from the base documentation. -- cgit v1.2.1 From ab4e2900dd300d5f6e55227cdabb3cf2bf5db7a7 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 27 Mar 2002 07:08:08 +0000 Subject: don't show queue arguments (passwords!) on svc_* screens (unless queue_dangerous_options!) --- FS/FS/queue.pm | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/queue.pm b/FS/FS/queue.pm index e5369cf82..4b880a23c 100644 --- a/FS/FS/queue.pm +++ b/FS/FS/queue.pm @@ -251,17 +251,26 @@ END $html .= 'Account' unless $hashref->{svcnum}; $html .= ''; + my $dangerous = $conf->exists('queue_dangerous_controls'); + my $p = FS::CGI::popurl(2); foreach my $queue ( sort { $a->getfield('jobnum') <=> $b->getfield('jobnum') } @queue ) { my $queue_hashref = $queue->hashref; my $jobnum = $queue->jobnum; - my $args = join(' ', $queue->args); + + my $args; + if ( $dangerous || $queue->job !~ /^FS::part_export::/ || !$noactions ) { + $args = join(' ', $queue->args); + } else { + $args = ''; + } + my $date = time2str( "%a %b %e %T %Y", $queue->_date ); my $status = $queue->status; $status .= ': '. $queue->statustext if $queue->statustext; - if ( $conf->exists('queue_dangerous_controls') + if ( $dangerous || ( ! $noactions && $status =~ /^failed/ || $status =~ /^locked/ ) ) { $status .= qq! ( retry |!. @@ -305,7 +314,7 @@ END =head1 VERSION -$Id: queue.pm,v 1.9 2002-03-24 14:29:00 ivan Exp $ +$Id: queue.pm,v 1.10 2002-03-27 07:08:08 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 92badebcb286260d7861bd09a2450eea18c4259e Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 5 Apr 2002 00:42:21 +0000 Subject: Checkin of disparate changes from working on the road: - generic SQL query - move exports out to their own files - small cleanup of selfadmin server --- FS/FS/part_export.pm | 336 +--------------------------------------- FS/FS/part_export/infostreet.pm | 83 ++++++++++ FS/FS/part_export/sqlradius.pm | 198 +++++++++++++++++++++++ FS/MANIFEST | 6 + 4 files changed, 293 insertions(+), 330 deletions(-) create mode 100644 FS/FS/part_export/infostreet.pm create mode 100644 FS/FS/part_export/sqlradius.pm (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 41dfe77a1..a43c3844e 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -340,8 +340,9 @@ autoloaded-on-demand), but until then, see L. sub rebless { my $self = shift; my $exporttype = $self->exporttype; - my $class = ref($self); - bless($self, $class."::$exporttype"); + my $class = ref($self). "::$exporttype"; + eval "use $class;"; + bless($self, $class); } =item export_insert SVC_OBJECT @@ -401,341 +402,16 @@ sub _export_delete { =back -=cut - -#infostreet - -package FS::part_export::infostreet; -use vars qw(@ISA); -@ISA = qw(FS::part_export); - -sub rebless { shift; } - -sub _export_insert { - my( $self, $svc_acct ) = (shift, shift); - $self->infostreet_queue( $svc_acct->svcnum, - 'createUser', $svc_acct->username, $svc_acct->password ); -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - return "can't change username with InfoStreet" - if $old->username ne $new->username; - return '' unless $old->_password ne $new->_password; - $self->infostreet_queue( $new->svcnum, - 'passwd', $new->username, $new->password ); -} - -sub _export_delete { - my( $self, $svc_acct ) = (shift, shift); - $self->infostreet_queue( $svc_acct->svcnum, - 'purgeAccount,releaseUsername', $svc_acct->username ); -} - -sub infostreet_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => 'FS::part_export::infostreet::infostreet_command', - }; - $queue->insert( - $self->option('url'), - $self->option('login'), - $self->option('password'), - $self->option('groupID'), - $method, - @_, - ); -} - -sub infostreet_command { #subroutine, not method - my($url, $username, $password, $groupID, $method, @args) = @_; - - #quelle hack - if ( $method =~ /,/ ) { - foreach my $part ( split(/,\s*/, $method) ) { - infostreet_command($url, $username, $password, $groupID, $part, @args); - } - return; - } - - eval "use Frontier::Client;"; - - my $conn = Frontier::Client->new( url => $url ); - my $key_result = $conn->call( 'authenticate', $username, $password, $groupID); - my %key_result = _infostreet_parse($key_result); - die $key_result{error} unless $key_result{success}; - my $key = $key_result{data}; - - my $result = $conn->call($method, $key, @args); - my %result = _infostreet_parse($result); - die $result{error} unless $result{success}; - -} - -sub _infostreet_parse { #subroutine, not method - my $arg = shift; - map { - my $value = $arg->{$_}; - #warn ref($value); - $value = $value->value() - if ref($value) && $value->isa('Frontier::RPC2::DataType'); - $_=>$value; - } keys %$arg; -} - -#sqlradius - -package FS::part_export::sqlradius; -use vars qw(@ISA); -@ISA = qw(FS::part_export); - -sub rebless { shift; } - -sub _export_insert { - my($self, $svc_acct) = (shift, shift); - - foreach my $table (qw(reply check)) { - my $method = "radius_$table"; - my %attrib = $svc_acct->$method; - next unless keys %attrib; - my $error = $self->sqlradius_queue( $svc_acct->svcnum, 'insert', - $table, $svc_acct->username, %attrib ); - return $error if $error; - } - my @groups = $svc_acct->radius_groups; - if ( @groups ) { - my $error = $self->sqlradius_queue( $svc_acct->svcnum, 'usergroup_insert', - $svc_acct->username, @groups ); - return $error if $error; - } - ''; -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - - #return "can't (yet) change username with sqlradius" - # if $old->username ne $new->username; - if ( $old->username ne $new->username ) { - my $error = $self->sqlradius_queue( $new->svcnum, 'rename', - $new->username, $old->username ); - return $error if $error; - } - - foreach my $table (qw(reply check)) { - my $method = "radius_$table"; - my %new = $new->$method; - my %old = $old->$method; - if ( grep { !exists $old{$_} #new attributes - || $new{$_} ne $old{$_} #changed - } keys %new - ) { - my $error = $self->sqlradius_queue( $new->svcnum, 'insert', - $table, $new->username, %new ); - return $error if $error; - } - - my @del = grep { !exists $new{$_} } keys %old; - if ( @del ) { - my $error = $self->sqlradius_queue( $new->svcnum, 'attrib_delete', - $table, $new->username, @del ); - return $error if $error; - } - } - - # (sorta) false laziness with FS::svc_acct::replace - my @oldgroups = @{$old->usergroup}; #uuuh - my @newgroups = $new->radius_groups; - my @delgroups = (); - foreach my $oldgroup ( @oldgroups ) { - if ( grep { $oldgroup eq $_ } @newgroups ) { - @newgroups = grep { $oldgroup ne $_ } @newgroups; - next; - } - push @delgroups, $oldgroup; - } - - if ( @delgroups ) { - my $error = $self->sqlradius_queue( $new->svcnum, 'usergroup_delete', - $new->username, @delgroups ); - return $error if $error; - } - - if ( @newgroups ) { - my $error = $self->sqlradius_queue( $new->svcnum, 'usergroup_insert', - $new->username, @newgroups ); - return $error if $error; - } - - ''; -} - -sub _export_delete { - my( $self, $svc_acct ) = (shift, shift); - $self->sqlradius_queue( $svc_acct->svcnum, 'delete', - $svc_acct->username ); -} - -sub sqlradius_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::sqlradius::sqlradius_$method", - }; - $queue->insert( - $self->option('datasrc'), - $self->option('username'), - $self->option('password'), - @_, - ); -} - -sub sqlradius_insert { #subroutine, not method - my $dbh = sqlradius_connect(shift, shift, shift); - my( $replycheck, $username, %attributes ) = @_; - - foreach my $attribute ( keys %attributes ) { - my $u_sth = $dbh->prepare( - "UPDATE rad$replycheck SET Value = ? WHERE UserName = ? AND Attribute = ?" ) or die $dbh->errstr; - my $i_sth = $dbh->prepare( - "INSERT INTO rad$replycheck ( id, UserName, Attribute, Value ) ". - "VALUES ( ?, ?, ?, ? )" - ) or die $dbh->errstr; - $u_sth->execute($attributes{$attribute}, $username, $attribute) > 0 - or $i_sth->execute( '', $username, $attribute, $attributes{$attribute} ) - or die "can't insert into rad$replycheck table: ". $i_sth->errstr; - } - $dbh->disconnect; -} - -sub sqlradius_usergroup_insert { #subroutine, not method - my $dbh = sqlradius_connect(shift, shift, shift); - my( $username, @groups ) = @_; - - my $sth = $dbh->prepare( - "INSERT INTO usergroup ( id, UserName, GroupName ) VALUES ( ?, ?, ? )" - ) or die $dbh->errstr; - foreach my $group ( @groups ) { - $sth->execute( '', $username, $group ) - or die "can't insert into groupname table: ". $sth->errstr; - } - $dbh->disconnect; -} - -sub sqlradius_usergroup_delete { #subroutine, not method - my $dbh = sqlradius_connect(shift, shift, shift); - my( $username, @groups ) = @_; - - my $sth = $dbh->prepare( - "DELETE FROM usergroup ( id, UserName, GroupName ) VALUES ( ?, ?, ? )" - ) or die $dbh->errstr; - foreach my $group ( @groups ) { - $sth->execute( '', $username, $group ) - or die "can't delete from groupname table: ". $sth->errstr; - } - $dbh->disconnect; -} - -sub sqlradius_rename { #subroutine, not method - my $dbh = sqlradius_connect(shift, shift, shift); - my($new_username, $old_username) = @_; - foreach my $table (qw(radreply radcheck usergroup )) { - my $sth = $dbh->prepare("UPDATE $table SET Username = ? WHERE UserName = ?") - or die $dbh->errstr; - $sth->execute($new_username, $old_username) - or die "can't update $table: ". $sth->errstr; - } - $dbh->disconnect; -} - -sub sqlradius_attrib_delete { #subroutine, not method - my $dbh = sqlradius_connect(shift, shift, shift); - my( $replycheck, $username, @attrib ) = @_; - - foreach my $attribute ( @attrib ) { - my $sth = $dbh->prepare( - "DELETE FROM rad$replycheck WHERE UserName = ? AND Attribute = ?" ) - or die $dbh->errstr; - $sth->execute($username,$attribute) - or die "can't delete from rad$replycheck table: ". $sth->errstr; - } - $dbh->disconnect; -} - -sub sqlradius_delete { #subroutine, not method - my $dbh = sqlradius_connect(shift, shift, shift); - my $username = shift; - - foreach my $table (qw( radcheck radreply usergroup )) { - my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" ); - $sth->execute($username) - or die "can't delete from $table table: ". $sth->errstr; - } - $dbh->disconnect; -} - -sub sqlradius_connect { - #my($datasrc, $username, $password) = @_; - #DBI->connect($datasrc, $username, $password) or die $DBI::errstr; - DBI->connect(@_) or die $DBI::errstr; -} - =head1 NEW EXPORT CLASSES - #myexport - - package FS::part_export::myexport; - use vars qw(@ISA); - @ISA = qw(FS::part_export); - - sub rebless { shift; } - - sub _export_insert { - my($self, $svc_something) = (shift, shift); - $self->myexport_queue( $svc_acct->svcnum, 'insert', - $svc_something->username, $svc_something->password ); - } - - sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - #return "can't change username with myexport" - # if $old->username ne $new->username; - #return '' unless $old->_password ne $new->_password; - $self->myexport_queue( $new->svcnum, - 'replace', $new->username, $new->password ); - } - - sub _export_delete { - my( $self, $svc_something ) = (shift, shift); - $self->myexport_queue( $svc_acct->svcnum, - 'delete', $svc_something->username ); - } - - #a good idea to queue anything that could fail or take any time - sub myexport_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::myexport::myexport_$method", - }; - $queue->insert( @_ ); - } - - sub myexport_insert { #subroutine, not method - } - sub myexport_replace { #subroutine, not method - } - sub myexport_delete { #subroutine, not method - } +Should be added to httemplate/edit/part_export.cgi and a module should +be FS/FS/part_export/ (an example may be found in eg/export_template.pm) =head1 BUGS Probably. -Hmm, export code has wound up in here. Move those sub-classes out into their -own files, at least. Also hmm... cust_export class (not necessarily a -database table...) ... ? +Hmm... cust_export class (not necessarily a database table...) ... ? =head1 SEE ALSO diff --git a/FS/FS/part_export/infostreet.pm b/FS/FS/part_export/infostreet.pm new file mode 100644 index 000000000..c2386adb7 --- /dev/null +++ b/FS/FS/part_export/infostreet.pm @@ -0,0 +1,83 @@ +package FS::part_export::infostreet; + +use vars qw(@ISA); +use FS::part_export; + +@ISA = qw(FS::part_export); + +sub rebless { shift; } + +sub _export_insert { + my( $self, $svc_acct ) = (shift, shift); + $self->infostreet_queue( $svc_acct->svcnum, + 'createUser', $svc_acct->username, $svc_acct->password ); +} + +sub _export_replace { + my( $self, $new, $old ) = (shift, shift, shift); + return "can't change username with InfoStreet" + if $old->username ne $new->username; + return '' unless $old->_password ne $new->_password; + $self->infostreet_queue( $new->svcnum, + 'passwd', $new->username, $new->password ); +} + +sub _export_delete { + my( $self, $svc_acct ) = (shift, shift); + $self->infostreet_queue( $svc_acct->svcnum, + 'purgeAccount,releaseUsername', $svc_acct->username ); +} + +sub infostreet_queue { + my( $self, $svcnum, $method ) = (shift, shift, shift); + my $queue = new FS::queue { + 'svcnum' => $svcnum, + 'job' => 'FS::part_export::infostreet::infostreet_command', + }; + $queue->insert( + $self->option('url'), + $self->option('login'), + $self->option('password'), + $self->option('groupID'), + $method, + @_, + ); +} + +sub infostreet_command { #subroutine, not method + my($url, $username, $password, $groupID, $method, @args) = @_; + + #quelle hack + if ( $method =~ /,/ ) { + foreach my $part ( split(/,\s*/, $method) ) { + infostreet_command($url, $username, $password, $groupID, $part, @args); + } + return; + } + + eval "use Frontier::Client;"; + + my $conn = Frontier::Client->new( url => $url ); + my $key_result = $conn->call( 'authenticate', $username, $password, $groupID); + my %key_result = _infostreet_parse($key_result); + die $key_result{error} unless $key_result{success}; + my $key = $key_result{data}; + + my $result = $conn->call($method, $key, @args); + my %result = _infostreet_parse($result); + die $result{error} unless $result{success}; + +} + +sub _infostreet_parse { #subroutine, not method + my $arg = shift; + map { + my $value = $arg->{$_}; + #warn ref($value); + $value = $value->value() + if ref($value) && $value->isa('Frontier::RPC2::DataType'); + $_=>$value; + } keys %$arg; +} + + diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm new file mode 100644 index 000000000..fa2153f31 --- /dev/null +++ b/FS/FS/part_export/sqlradius.pm @@ -0,0 +1,198 @@ +package FS::part_export::sqlradius; + +use vars qw(@ISA); +use FS::part_export; + +@ISA = qw(FS::part_export); + +sub rebless { shift; } + +sub _export_insert { + my($self, $svc_acct) = (shift, shift); + + foreach my $table (qw(reply check)) { + my $method = "radius_$table"; + my %attrib = $svc_acct->$method; + next unless keys %attrib; + my $error = $self->sqlradius_queue( $svc_acct->svcnum, 'insert', + $table, $svc_acct->username, %attrib ); + return $error if $error; + } + my @groups = $svc_acct->radius_groups; + if ( @groups ) { + my $error = $self->sqlradius_queue( $svc_acct->svcnum, 'usergroup_insert', + $svc_acct->username, @groups ); + return $error if $error; + } + ''; +} + +sub _export_replace { + my( $self, $new, $old ) = (shift, shift, shift); + + #return "can't (yet) change username with sqlradius" + # if $old->username ne $new->username; + if ( $old->username ne $new->username ) { + my $error = $self->sqlradius_queue( $new->svcnum, 'rename', + $new->username, $old->username ); + return $error if $error; + } + + foreach my $table (qw(reply check)) { + my $method = "radius_$table"; + my %new = $new->$method; + my %old = $old->$method; + if ( grep { !exists $old{$_} #new attributes + || $new{$_} ne $old{$_} #changed + } keys %new + ) { + my $error = $self->sqlradius_queue( $new->svcnum, 'insert', + $table, $new->username, %new ); + return $error if $error; + } + + my @del = grep { !exists $new{$_} } keys %old; + if ( @del ) { + my $error = $self->sqlradius_queue( $new->svcnum, 'attrib_delete', + $table, $new->username, @del ); + return $error if $error; + } + } + + # (sorta) false laziness with FS::svc_acct::replace + my @oldgroups = @{$old->usergroup}; #uuuh + my @newgroups = $new->radius_groups; + my @delgroups = (); + foreach my $oldgroup ( @oldgroups ) { + if ( grep { $oldgroup eq $_ } @newgroups ) { + @newgroups = grep { $oldgroup ne $_ } @newgroups; + next; + } + push @delgroups, $oldgroup; + } + + if ( @delgroups ) { + my $error = $self->sqlradius_queue( $new->svcnum, 'usergroup_delete', + $new->username, @delgroups ); + return $error if $error; + } + + if ( @newgroups ) { + my $error = $self->sqlradius_queue( $new->svcnum, 'usergroup_insert', + $new->username, @newgroups ); + return $error if $error; + } + + ''; +} + +sub _export_delete { + my( $self, $svc_acct ) = (shift, shift); + $self->sqlradius_queue( $svc_acct->svcnum, 'delete', + $svc_acct->username ); +} + +sub sqlradius_queue { + my( $self, $svcnum, $method ) = (shift, shift, shift); + my $queue = new FS::queue { + 'svcnum' => $svcnum, + 'job' => "FS::part_export::sqlradius::sqlradius_$method", + }; + $queue->insert( + $self->option('datasrc'), + $self->option('username'), + $self->option('password'), + @_, + ); +} + +sub sqlradius_insert { #subroutine, not method + my $dbh = sqlradius_connect(shift, shift, shift); + my( $replycheck, $username, %attributes ) = @_; + + foreach my $attribute ( keys %attributes ) { + my $u_sth = $dbh->prepare( + "UPDATE rad$replycheck SET Value = ? WHERE UserName = ? AND Attribute = ?" ) or die $dbh->errstr; + my $i_sth = $dbh->prepare( + "INSERT INTO rad$replycheck ( id, UserName, Attribute, Value ) ". + "VALUES ( ?, ?, ?, ? )" + ) or die $dbh->errstr; + $u_sth->execute($attributes{$attribute}, $username, $attribute) > 0 + or $i_sth->execute( '', $username, $attribute, $attributes{$attribute} ) + or die "can't insert into rad$replycheck table: ". $i_sth->errstr; + } + $dbh->disconnect; +} + +sub sqlradius_usergroup_insert { #subroutine, not method + my $dbh = sqlradius_connect(shift, shift, shift); + my( $username, @groups ) = @_; + + my $sth = $dbh->prepare( + "INSERT INTO usergroup ( id, UserName, GroupName ) VALUES ( ?, ?, ? )" + ) or die $dbh->errstr; + foreach my $group ( @groups ) { + $sth->execute( '', $username, $group ) + or die "can't insert into groupname table: ". $sth->errstr; + } + $dbh->disconnect; +} + +sub sqlradius_usergroup_delete { #subroutine, not method + my $dbh = sqlradius_connect(shift, shift, shift); + my( $username, @groups ) = @_; + + my $sth = $dbh->prepare( + "DELETE FROM usergroup ( id, UserName, GroupName ) VALUES ( ?, ?, ? )" + ) or die $dbh->errstr; + foreach my $group ( @groups ) { + $sth->execute( '', $username, $group ) + or die "can't delete from groupname table: ". $sth->errstr; + } + $dbh->disconnect; +} + +sub sqlradius_rename { #subroutine, not method + my $dbh = sqlradius_connect(shift, shift, shift); + my($new_username, $old_username) = @_; + foreach my $table (qw(radreply radcheck usergroup )) { + my $sth = $dbh->prepare("UPDATE $table SET Username = ? WHERE UserName = ?") + or die $dbh->errstr; + $sth->execute($new_username, $old_username) + or die "can't update $table: ". $sth->errstr; + } + $dbh->disconnect; +} + +sub sqlradius_attrib_delete { #subroutine, not method + my $dbh = sqlradius_connect(shift, shift, shift); + my( $replycheck, $username, @attrib ) = @_; + + foreach my $attribute ( @attrib ) { + my $sth = $dbh->prepare( + "DELETE FROM rad$replycheck WHERE UserName = ? AND Attribute = ?" ) + or die $dbh->errstr; + $sth->execute($username,$attribute) + or die "can't delete from rad$replycheck table: ". $sth->errstr; + } + $dbh->disconnect; +} + +sub sqlradius_delete { #subroutine, not method + my $dbh = sqlradius_connect(shift, shift, shift); + my $username = shift; + + foreach my $table (qw( radcheck radreply usergroup )) { + my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" ); + $sth->execute($username) + or die "can't delete from $table table: ". $sth->errstr; + } + $dbh->disconnect; +} + +sub sqlradius_connect { + #my($datasrc, $username, $password) = @_; + #DBI->connect($datasrc, $username, $password) or die $DBI::errstr; + DBI->connect(@_) or die $DBI::errstr; +} + diff --git a/FS/MANIFEST b/FS/MANIFEST index 54aaaa19f..8f7dfe591 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -45,6 +45,10 @@ FS/cust_refund.pm FS/cust_credit_refund.pm FS/cust_svc.pm FS/part_bill_event.pm +FS/part_export.pm +FS/part_export_option.pm +FS/part_export/infostreet.pm +FS/part_export/sqlradius.pm FS/part_pkg.pm FS/part_pop_local.pm FS/part_referral.pm @@ -94,6 +98,8 @@ t/nas.t t/part_bill_event.t t/part_export.t t/part_export_option.t +t/part_export-infostreet.t +t/part_export-sqlradius.t t/part_pkg.t t/part_pop_local.t t/part_referral.t -- cgit v1.2.1 From 20d1b5c39c3674f3fdf5c0f784697a4442658648 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 5 Apr 2002 16:37:42 +0000 Subject: oops forgot these from working on the road --- FS/t/part_export-infostreet.t | 5 +++++ FS/t/part_export-sqlradius.t | 5 +++++ 2 files changed, 10 insertions(+) create mode 100644 FS/t/part_export-infostreet.t create mode 100644 FS/t/part_export-sqlradius.t (limited to 'FS') diff --git a/FS/t/part_export-infostreet.t b/FS/t/part_export-infostreet.t new file mode 100644 index 000000000..1b3341825 --- /dev/null +++ b/FS/t/part_export-infostreet.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::infostreet; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-sqlradius.t b/FS/t/part_export-sqlradius.t new file mode 100644 index 000000000..5fb23a5a6 --- /dev/null +++ b/FS/t/part_export-sqlradius.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::sqlradius; +$loaded=1; +print "ok 1\n"; -- cgit v1.2.1 From 87af741da0dd5f6a76bbb566b4d6c54cd5b15315 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 5 Apr 2002 23:51:18 +0000 Subject: - add message catalog table & beginning of web interface - add security_phrase and conf option to svc_acct.pm - random other stuff --- FS/FS/Conf.pm | 15 +++++ FS/FS/msgcat.pm | 187 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ FS/FS/svc_acct.pm | 1 + FS/MANIFEST | 2 + FS/t/msgcat.t | 5 ++ 5 files changed, 210 insertions(+) create mode 100644 FS/FS/msgcat.pm create mode 100644 FS/t/msgcat.t (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 2bc5e24c0..bda19c0a2 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -843,6 +843,21 @@ httemplate/docs/config.html 'type' => 'checkbox', }, + { + 'key' => 'security_phrase', + 'section' => 'password', + 'description' => 'Enable the tracking of a "security phrase" with each account. Not recommended, as it is vulnerable to social engineering.', + 'type' => 'checkbox', + }, + + { + 'key' => 'locale', + 'section' => 'UI', + 'description' => 'Message locale', + 'type' => 'select', + 'select_enum' => [ qw(en_US) ], + }, + ); 1; diff --git a/FS/FS/msgcat.pm b/FS/FS/msgcat.pm new file mode 100644 index 000000000..53a7aeee6 --- /dev/null +++ b/FS/FS/msgcat.pm @@ -0,0 +1,187 @@ +package FS::msgcat; + +use strict; +use vars qw( @ISA @EXPORT_OK $conf $locale ); +use Exporter; +use FS::UID; +use FS::Record qw( qsearchs ); +use FS::Conf; + +@ISA = qw(FS::Record); +@EXPORT_OK = qw( gettext geterror ); + +$FS::UID::callback{'msgcat'} = sub { + $conf = new FS::Conf; + $locale = $conf->config('locale') || 'en_US'; +}; + +=head1 NAME + +FS::msgcat - Object methods for message catalog entries + +=head1 SYNOPSIS + + use FS::msgcat qw(gettext); + + #simple interface for retreiving messages... + $message = gettext('msgcode'); + #or errors (includes the error code) + $message = geterror('msgcode'); + + #maintenance stuff + $record = new FS::msgcat \%hash; + $record = new FS::msgcat { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::msgcat object represents an message catalog entry. FS::msgcat inherits +from FS::Record. The following fields are currently supported: + +=over 4 + +=item msgnum - primary key + +=item msgcode - Error code + +=item locale - Locale + +=item msg - Message + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new example. To add the example to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'msgcat'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +# the insert method can be inherited from FS::Record + +=item delete + +Delete this record from the database. + +=cut + +# the delete method can be inherited from FS::Record + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +# the replace method can be inherited from FS::Record + +=item check + +Checks all fields to make sure this is a valid example. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +# the check method should currently be supplied - FS::Record contains some +# data checking routines + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('msgnum') + || $self->ut_text('msgcode') + || $self->ut_text('msg') + ; + return $error if $error; + + $self->locale =~ /^([\w\@]+)$/ or return "illegal locale: ". $self->locale; + $self->locale($1); + + ''; #no error +} + +=back + +=head1 SUBROUTINES + +=over 4 + +=item gettext MSGCODE + +Returns the full message for the supplied message code. + +=cut + +sub gettext { + my $msgcode = shift; + my $msgcat = qsearchs('msgcat', { + 'msgcode' => $msgcode, + 'locale' => $locale + } ); + if ( $msgcat ) { + $msgcat->msg; + } else { + warn "WARNING: message for msgcode $msgcode in locale $locale not found"; + $msgcode; + } + +} + +=item geterror MSGCODE + +Returns the full message for the supplied message code, including the message +code. + +=cut + +sub geterror { + my $msgcode = shift; + my $msg = gettext($msgcode); + if ( $msg eq $msgcode ) { + "Error code $msgcode (message for locale $locale not found)"; + } else { + "$msg (error code $msgcode)"; + } +} + +=back + +=head1 BUGS + +i18n/l10n is a mess. + +=head1 SEE ALSO + +L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 197eec1b5..8d22c21e0 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -1079,6 +1079,7 @@ sub check { my $error = $self->ut_numbern('svcnum') || $self->ut_number('domsvc') + || $self->ut_textn('sec_phrase') ; return $error if $error; diff --git a/FS/MANIFEST b/FS/MANIFEST index 8f7dfe591..dd9eb0906 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -72,6 +72,7 @@ FS/raddb.pm FS/radius_usergroup.pm FS/queue.pm FS/queue_arg.pm +FS/msgcat.pm t/agent.t t/agent_type.t t/CGI.t @@ -120,5 +121,6 @@ t/svc_www.t t/type_pkgs.t t/queue.t t/queue_arg.t +t/msgcat.t t/UID.t t/raddb.t diff --git a/FS/t/msgcat.t b/FS/t/msgcat.t new file mode 100644 index 000000000..c38c63935 --- /dev/null +++ b/FS/t/msgcat.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::msgcat; +$loaded=1; +print "ok 1\n"; -- cgit v1.2.1 From 195652229909566ccb3a6ae249d8fa26f25da55a Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 6 Apr 2002 00:08:08 +0000 Subject: security phrase bug fixes --- FS/FS/svc_acct.pm | 2 ++ 1 file changed, 2 insertions(+) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 8d22c21e0..8e25f6afc 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -170,6 +170,8 @@ FS::svc_Common. The following fields are currently supported: =item _password - generated if blank +=item sec_phrase - security phrase + =item popnum - Point of presence (see L) =item uid -- cgit v1.2.1 From 99a8652052e5b036e7db08c32603c0feadc60e85 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 6 Apr 2002 22:32:43 +0000 Subject: add a config option to set the Business::OnlinePayment description field, and make some useful data available for the config option. closes: Bug#378 --- FS/FS/Conf.pm | 7 +++++++ FS/FS/cust_bill.pm | 19 ++++++++++++++++--- FS/FS/cust_bill_pkg.pm | 13 ++++++++++++- FS/FS/cust_main.pm | 11 +++++++++++ 4 files changed, 46 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index bda19c0a2..74e28d8b1 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -268,6 +268,13 @@ httemplate/docs/config.html 'type' => 'textarea', }, + { + 'key' => 'business-onlinepayment-description', + 'section' => 'billing', + 'description' => 'String passed as the description field to Business::OnlinePayment. Evaluated as a double-quoted perl string, with the following variables available: $agent (the agent name), and $pkgs (a comma-separated list of packages to which the invoiced being charged applies)', + 'type' => 'textarea', + }, + { 'key' => 'bsdshellmachines', 'section' => 'shell', diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 0a8d4a4ae..2461e42f1 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -478,6 +478,19 @@ sub realtime_card { my $email = $invoicing_list[0]; my( $action1, $action2 ) = split(/\s*\,\s*/, $bop_action ); + + my $description = 'Internet Services'; + if ( $conf->exists('business-onlinepayment-description') ) { + my $dtempl = $conf->config('business-onlinepayment-description'); + + my $agent = $self->cust_main->agent->agent; + my $pkgs = join(', ', + map { $_->cust_pkg->part_pkg->pkg } + grep { $_->pkgnum } $self->cust_bill_pkg + ); + $description = eval qq("$dtempl"); + + } my $transaction = new Business::OnlinePayment( $bop_processor, @bop_options ); @@ -486,7 +499,7 @@ sub realtime_card { 'login' => $bop_login, 'password' => $bop_password, 'action' => $action1, - 'description' => 'Internet Services', + 'description' => $description, 'amount' => $amount, 'invoice_number' => $self->invnum, 'customer_id' => $self->custnum, @@ -520,7 +533,7 @@ sub realtime_card { order_number => $ordernum, amount => $amount, authorization => $auth, - description => 'Internet Services', + description => $description, ); $capture->submit(); @@ -887,7 +900,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.24 2002-03-18 21:40:17 ivan Exp $ +$Id: cust_bill.pm,v 1.25 2002-04-06 22:32:43 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_bill_pkg.pm b/FS/FS/cust_bill_pkg.pm index b3d3fcde2..72f9ce4a9 100644 --- a/FS/FS/cust_bill_pkg.pm +++ b/FS/FS/cust_bill_pkg.pm @@ -125,11 +125,22 @@ sub check { ''; #no error } +=item cust_pkg + +Returns the package (see L) for this invoice line item. + +=cut + +sub cust_pkg { + my $self = shift; + qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } ); +} + =back =head1 VERSION -$Id: cust_bill_pkg.pm,v 1.2 2001-02-11 17:34:44 ivan Exp $ +$Id: cust_bill_pkg.pm,v 1.3 2002-04-06 22:32:43 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index b59b0d1ac..499d149a6 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -817,6 +817,17 @@ sub cancel { grep { $_->cancel } $self->ncancelled_pkgs; } +=item agent + +Returns the agent (see L) for this customer. + +=cut + +sub agent { + my $self = shift; + qsearchs( 'agent', { 'agent' => $self->agentnum } ); +} + =item bill OPTIONS Generates invoices (see L) for this customer. Usually used in -- cgit v1.2.1 From fca110eff969104793774ed717985e91c53f5318 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 7 Apr 2002 00:00:41 +0000 Subject: - config option for signup server payment types - credit card type pulldown on signup server (closes: Bug#383) --- FS/FS/Conf.pm | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 74e28d8b1..b39c8217d 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -134,7 +134,7 @@ sub set { my $dir = $self->dir; $value =~ /^(.*)$/s; $value = $1; - unless ( $self->config($file) eq $value ) { + unless ( join("\n", @{[ $self->config($file) ]}) eq $value ) { warn "[FS::Conf] SET $file\n" if $DEBUG; # warn "$dir" if is_tainted($dir); # warn "$dir" if is_tainted($file); @@ -865,6 +865,15 @@ httemplate/docs/config.html 'select_enum' => [ qw(en_US) ], }, + { + 'key' => 'signup_server-payby', + 'section' => '', + 'description' => 'Acceptable payment types for the signup server', + 'type' => 'selectmultiple', + 'select_enum' => [ qw(CARD PREPAY BILL COMP) ], + }, + + ); 1; -- cgit v1.2.1 From 44e3eff0aa6e7bdb7f4ecd9ee1ddf141e1b68af3 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 7 Apr 2002 05:56:09 +0000 Subject: working message catalogs (not used for enough yet) - almost (but not quite) closes Bug#385 - still have to catalog the backend things triggered by signup server. --- FS/FS/Conf.pm | 6 ++++++ FS/FS/msgcat.pm | 11 ++++++++--- 2 files changed, 14 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index b39c8217d..6e588208a 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -873,6 +873,12 @@ httemplate/docs/config.html 'select_enum' => [ qw(CARD PREPAY BILL COMP) ], }, + { + 'key' => 'show-msgcat-codes', + 'section' => 'UI', + 'description' => 'Show msgcat codes in error messages. Turn this option on before reporting errors to the mailing list.', + 'type' => 'checkbox', + }, ); diff --git a/FS/FS/msgcat.pm b/FS/FS/msgcat.pm index 53a7aeee6..3eca14b83 100644 --- a/FS/FS/msgcat.pm +++ b/FS/FS/msgcat.pm @@ -1,7 +1,7 @@ package FS::msgcat; use strict; -use vars qw( @ISA @EXPORT_OK $conf $locale ); +use vars qw( @ISA @EXPORT_OK $conf $locale $debug ); use Exporter; use FS::UID; use FS::Record qw( qsearchs ); @@ -13,6 +13,7 @@ use FS::Conf; $FS::UID::callback{'msgcat'} = sub { $conf = new FS::Conf; $locale = $conf->config('locale') || 'en_US'; + $debug = $conf->exists('show-msgcat-codes') }; =head1 NAME @@ -140,6 +141,10 @@ Returns the full message for the supplied message code. =cut sub gettext { + $debug ? geterror(@_) : _gettext(@_); +} + +sub _gettext { my $msgcode = shift; my $msgcat = qsearchs('msgcat', { 'msgcode' => $msgcode, @@ -163,7 +168,7 @@ code. sub geterror { my $msgcode = shift; - my $msg = gettext($msgcode); + my $msg = _gettext($msgcode); if ( $msg eq $msgcode ) { "Error code $msgcode (message for locale $locale not found)"; } else { @@ -175,7 +180,7 @@ sub geterror { =head1 BUGS -i18n/l10n is a mess. +i18n/l10n, eek =head1 SEE ALSO -- cgit v1.2.1 From 17544eafba683f48cdc64fef09745d17be9b088a Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 7 Apr 2002 06:23:29 +0000 Subject: send email on signup server signups (closes: Bug#386) --- FS/FS/Conf.pm | 8 ++++++++ FS/FS/cust_bill.pm | 4 ++-- FS/FS/cust_pay.pm | 6 +++--- 3 files changed, 13 insertions(+), 5 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 6e588208a..14dce1abf 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -873,6 +873,14 @@ httemplate/docs/config.html 'select_enum' => [ qw(CARD PREPAY BILL COMP) ], }, + { + 'key' => 'signup_server-email', + 'section' => '', + 'description' => 'Comma-separated list of email addresses to receive notification of signups via the signup server.', + 'type' => 'text', + }, + + { 'key' => 'show-msgcat-codes', 'section' => 'UI', diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 2461e42f1..1f402fca4 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -373,7 +373,7 @@ sub send { #my @print_text = $cust_bill->print_text; #( date ) my @invoicing_list = $self->cust_main->invoicing_list; if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice - #false laziness w/FS::cust_pay::delete + #false laziness w/FS::cust_pay::delete & fs_signup_server #$ENV{SMTPHOSTS} = $smtpmachine; $ENV{MAILADDRESS} = $invoice_from; my $header = new Mail::Header ( [ @@ -900,7 +900,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.25 2002-04-06 22:32:43 ivan Exp $ +$Id: cust_bill.pm,v 1.26 2002-04-07 06:23:29 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index 421f0200e..ac60dc242 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -264,8 +264,8 @@ sub delete { if ( $conf->config('deletepayments') ne '' ) { my $cust_main = qsearchs('cust_main',{ 'custnum' => $self->custnum }); - #false laziness w/FS::cust_bill::send - $ENV{MAILADDRESS} = $conf->config('invoice_from'); #??? well as good as any + #false laziness w/FS::cust_bill::send & fs_signup_server + $ENV{MAILADDRESS} = $invoice_from; #??? well as good as any my $header = new Mail::Header ( [ "From: $invoice_from", "To: ". $conf->config('deletepayments'), @@ -405,7 +405,7 @@ sub unapplied { =head1 VERSION -$Id: cust_pay.pm,v 1.18 2002-03-18 19:49:10 ivan Exp $ +$Id: cust_pay.pm,v 1.19 2002-04-07 06:23:29 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 0b65ce59c7d2ee712389c27954382274ddf718a5 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 10 Apr 2002 13:42:49 +0000 Subject: bulk checkin from working on the road: - use msgcat for more error messages - should be all things that would come3 back from the signup server normally now - signup server: don't display access number !; + + } + $html .= ''; } $html .= ''; + if ( $areboxes ) { + $html .= '
'. + '
'; + } + $html; } @@ -314,7 +331,7 @@ END =head1 VERSION -$Id: queue.pm,v 1.10 2002-03-27 07:08:08 ivan Exp $ +$Id: queue.pm,v 1.11 2002-04-13 08:51:54 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From b6556f749fa0d341e161236f98f5d21358c9b8dd Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 13 Apr 2002 09:14:07 +0000 Subject: allow invoice_lines(0) meaning no limit, no padding (see Bug#388) --- FS/FS/cust_bill.pm | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 1f402fca4..f157f86f6 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -815,11 +815,13 @@ sub print_text { my @invoice_template = $conf->config($templatefile) or die "cannot load config file $templatefile"; $invoice_lines = 0; + my $wasfunc = 0; foreach ( grep /invoice_lines\(\d+\)/, @invoice_template ) { #kludgy /invoice_lines\((\d+)\)/; $invoice_lines += $1; + $wasfunc=1; } - die "no invoice_lines() functions in template?" unless $invoice_lines; + die "no invoice_lines() functions in template?" unless $wasfunc; my $invoice_template = new Text::Template ( TYPE => 'ARRAY', SOURCE => [ map "$_\n", @invoice_template ], @@ -835,11 +837,14 @@ sub print_text { $date = $self->_date; $page = 1; - $total_pages = - int( scalar(@FS::cust_bill::buf) / $FS::cust_bill::invoice_lines ); - $total_pages++ - if scalar(@FS::cust_bill::buf) % $FS::cust_bill::invoice_lines; - + if ( $FS::cust_bill::invoice_lines ) { + $total_pages = + int( scalar(@FS::cust_bill::buf) / $FS::cust_bill::invoice_lines ); + $total_pages++ + if scalar(@FS::cust_bill::buf) % $FS::cust_bill::invoice_lines; + } else { + $total_pages = 1; + } #format address (variable for the template) my $l = 0; @@ -873,7 +878,7 @@ sub print_text { #and subroutine for the template sub FS::cust_bill::_template::invoice_lines { - my $lines = shift; + my $lines = shift or return @buf; map { scalar(@buf) ? shift @buf : [ '', '' ]; } @@ -900,7 +905,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.26 2002-04-07 06:23:29 ivan Exp $ +$Id: cust_bill.pm,v 1.27 2002-04-13 09:14:07 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 327df8aefdcf96c9c83805570abf4cc242cf46b9 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 13 Apr 2002 13:36:26 +0000 Subject: - documentation updates - move Critical Path export to new-style export - bin/sqlradius_reset gets a manpage and becomes FS/bin/freeside-sqlradius-reset --- FS/FS.pm | 29 +++++++- FS/FS/Conf.pm | 6 +- FS/FS/part_export.pm | 11 +++- FS/FS/part_export/cp.pm | 117 +++++++++++++++++++++++++++++++++ FS/FS/svc_acct.pm | 142 ---------------------------------------- FS/bin/freeside-overdue | 3 + FS/bin/freeside-sqlradius-reset | 73 +++++++++++++++++++++ 7 files changed, 233 insertions(+), 148 deletions(-) create mode 100644 FS/FS/part_export/cp.pm create mode 100755 FS/bin/freeside-sqlradius-reset (limited to 'FS') diff --git a/FS/FS.pm b/FS/FS.pm index 36fabcb8e..287e50c67 100644 --- a/FS/FS.pm +++ b/FS/FS.pm @@ -5,6 +5,9 @@ use vars qw($VERSION); $VERSION = '0.01'; +#find missing entries in this file with: +# for a in `ls *pm | cut -d. -f1`; do grep 'L' ../FS.pm >/dev/null || echo "missing $a" ; done + 1; __END__ @@ -26,6 +29,12 @@ L - User class (not yet OO) L - Non OO-subroutines for the web interface. +L - Message catalog + +L - Message catalog + +L - RADIUS dictionary + =head2 Database record classes L - Database record base class @@ -43,6 +52,8 @@ L - Service base class L - Account (shell, RADIUS, POP3) class +L - RADIUS groups + L - Domain class L - DNS zone entries @@ -121,6 +132,8 @@ L - Job queue L - Job arguments +L - Message catalogs + =head1 Remote API modules L @@ -131,11 +144,23 @@ L =head2 Command-line utilities -L +L L -L +L + +L + +L + +L + +L + +L + +L L diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 0c41980ea..b02913258 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -305,8 +305,8 @@ httemplate/docs/config.html { 'key' => 'cp_app', - 'section' => 'mail', - 'description' => 'Integration with Critial Path Account Provisioning Protocol, four lines: "host:port", username, password, and workgroup (for new users).', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, add a cp export instead. This option used to integrate with Critial Path Account Provisioning Protocol, four lines: "host:port", username, password, and workgroup (for new users).', 'type' => 'textarea', }, @@ -404,7 +404,7 @@ httemplate/docs/config.html { 'key' => 'icradiusmachines', 'section' => 'deprecated', - 'description' => 'DEPRECATED, add sqlradius exports to Service definitions instead. This option used to enable radcheck and radreply table population - by default in the Freeside database, or in the database specified by the icradius_secrets config option (the radcheck and radreply tables needs to be created manually). You do not need to use MySQL for your Freeside database to export to an ICRADIUS/FreeRADIUS MySQL database with this option.
ADDITIONAL DEPRECATED FUNCTIONALITY (instead use MySQL replication or point icradius_secrets to the external database) - your ICRADIUS machines or FreeRADIUS (with MySQL authentication) machines, one per line. Machines listed in this file will have the radcheck table exported to them. Each line should contain four items, separted by whitespace: machine name, MySQL database name, MySQL username, and MySQL password. For example: "radius.isp.tld radius_db radius_user passw0rd"
', + 'description' => 'DEPRECATED, add a sqlradius export instead. This option used to enable radcheck and radreply table population - by default in the Freeside database, or in the database specified by the icradius_secrets config option (the radcheck and radreply tables needs to be created manually). You do not need to use MySQL for your Freeside database to export to an ICRADIUS/FreeRADIUS MySQL database with this option.
ADDITIONAL DEPRECATED FUNCTIONALITY (instead use MySQL replication or point icradius_secrets to the external database) - your ICRADIUS machines or FreeRADIUS (with MySQL authentication) machines, one per line. Machines listed in this file will have the radcheck table exported to them. Each line should contain four items, separted by whitespace: machine name, MySQL database name, MySQL username, and MySQL password. For example: "radius.isp.tld radius_db radius_user passw0rd"
', 'type' => [qw( checkbox textarea )], }, diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 835f5318f..7ae00f00c 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -505,13 +505,22 @@ sub exporttype2svcdb { 'password' => { label=>'Database password' }, }, 'nodomain' => 'Y', - 'notes' => 'Not specifying datasrc will export to the freeside database? (no... notes on MySQL replication, DBI::Proxy, etc., from Conf.pm && export.html etc., reset with bin/sqlradius_reset', + 'notes' => 'Real-time export of radcheck, radreply and usergroup tables to any SQL database for FreeRADIUS or ICRADIUS. Use freeside-sqlradius-reset to delete and repopulate the tables from the Freeside database.', }, 'cyrus' => { 'desc' => 'Real-time export to Cyrus IMAP server', }, 'cp' => { 'desc' => 'Real-time export to Critical Path Account Provisioning Protocol', + 'options' => { + 'host' => { label=>'Hostname' }, + 'port' => { label=>'Port number' }, + 'username' => { label=>'Username' }, + 'password' => { label=>'Password' }, + 'domain' => { label=>'Domain' }, + 'workgroup' => { label=>'Default Workgroup' }, + }, + 'notes' => 'Real-time export to Critial Path Account Provisioning Protocol. Requires installation of Net::APP from CPAN.', }, 'infostreet' => { 'desc' => 'Real-time export to InfoStreet streetSmartAPI', diff --git a/FS/FS/part_export/cp.pm b/FS/FS/part_export/cp.pm new file mode 100644 index 000000000..58ac85e8a --- /dev/null +++ b/FS/FS/part_export/cp.pm @@ -0,0 +1,117 @@ +package FS::part_export::cp; + +use vars qw(@ISA); +use FS::part_export; + +@ISA = qw(FS::part_export); + +sub rebless { shift; } + +sub _export_insert { + my( $self, $svc_acct ) = (shift, shift); + $self->cp_queue( $svc_acct->svcnum, 'create_mailbox', + Mailbox => $svc_acct->username, + Password => $svc_acct->_password, + Workgroup => $self->option('workgroup'), + Domain => $svc_acct->domain, + ); +} + +sub _export_replace { + my( $self, $new, $old ) = (shift, shift, shift); + return "can't change domain with Critical Path" + if $old->domain ne $new->domain; + return '' unless $old->username ne $new->username + || $old->_password ne $new->_password; + $self->cp_queue( $new->svcnum, 'replace', $new->domain, + $old->username, $new->username, $old->_password, $new->_password ); +} + +sub _export_delete { + my( $self, $svc_acct ) = (shift, shift); + $self->cp_queue( $svc_acct->svcnum, 'delete_mailbox', + Mailbox => $svc_acct->username, + Domain => $svc_acct->domain, + ); +} + +sub cp_queue { + my( $self, $svcnum, $method ) = (shift, shift, shift); + my $queue = new FS::queue { + 'svcnum' => $svcnum, + 'job' => 'FS::part_export::cp::cp_command', + }; + $queue->insert( + $self->option('host'), + $self->option('port'), + $self->option('username'), + $self->option('password'), + $self->option('domain'), + $method, + @_, + ); +} + +sub cp_command { #subroutine, not method + my($host, $port, $username, $password, $login_domain, $method, @args) = @_; + + #quelle hack + if ( $method eq 'replace' ) { + + my( $domain, $old_username, $new_username, $old_password, $new_password) + = @args; + + if ( $old_username ne $new_username ) { + cp_command($host, $port, $username, $password, 'rename_mailbox', + Domain => $domain, + Old_Mailbox => $old_username, + New_Mailbox => $new_username, + ); + } + + if ( $new_password =~ /^\*SUSPENDED\* (.*)$/ ) { + $new_password = $1; + cp_command($host, $port, $username, $password, 'set_mailbox_status', + Domain => $domain, + Mailbox => $new_username, + Other => 'T', + Other_Bounce => 'T', + ); + } else { + cp_command($host, $port, $username, $password, 'set_mailbox_status', + Domain => $domain, + Mailbox => $new_username, + Other => 'F', + Other_Bounce => 'F', + ); + } + + if ( $old_password ne $new_password ) { + cp_command($host, $port, $username, $password, 'change_mailbox', + Domain => $domain, + Mailbox => $new_username, + Password => $new_password, + ); + } + + return; + } + #eof quelle hack + + eval "use Net::APP;"; + + my $app = new Net::APP ( + "$host:$port", + User => $username, + Password => $password, + Domain => $login_domain, + Timeout => 60, + #Debug => 1, + ) or die "$@\n"; + + $app->$method( @args ); + + die $app->message."\n" unless $app->ok; + +} + diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 38e24c110..1e1cbb019 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -8,7 +8,6 @@ use vars qw( @ISA $nossh_hack $noexport_hack $conf $username_noperiod $username_uppercase $shellmachine $useradd $usermod $userdel $mydomain $cyrus_server $cyrus_admin_user $cyrus_admin_pass - $cp_server $cp_user $cp_pass $cp_workgroup $dirhash @saltset @pw_set $rsync $ssh $exportdir $vpopdir); @@ -80,16 +79,6 @@ $FS::UID::callback{'FS::svc_acct'} = sub { $cyrus_admin_user = ''; $cyrus_admin_pass = ''; } - if ( $conf->exists('cp_app') ) { - ($cp_server, $cp_user, $cp_pass, $cp_workgroup) = - $conf->config('cp_app'); - eval "use Net::APP;" - } else { - $cp_server = ''; - $cp_user = ''; - $cp_pass = ''; - $cp_workgroup = ''; - } $dirhash = $conf->config('dirhash') || 0; $exportdir = "/usr/local/etc/freeside/export." . datasrc; @@ -351,18 +340,6 @@ sub insert { } } - if ( $cp_server ) { - my $queue = new FS::queue { - 'svcnum' => $self->svcnum, - 'job' => 'FS::svc_acct::cp_insert' - }; - $error = $queue->insert($self->username, $self->_password); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - } - if ( $vpopdir ) { my $vpopmail_queue = @@ -423,27 +400,6 @@ sub cyrus_insert { 1; } -sub cp_insert { - my( $username, $password ) = @_; - - my $app = new Net::APP ( $cp_server, - User => $cp_user, - Password => $cp_pass, - Domain => $mydomain, - Timeout => 60, - #Debug => 1, - ) or die "$@\n"; - - $app->create_mailbox( - Mailbox => $username, - Password => $password, - Workgroup => $cp_workgroup, - Domain => $mydomain, - ); - - die $app->message."\n" unless $app->ok; -} - sub vpopmail_insert { my( $username, $password, $domain, $vpopdir ) = @_; @@ -633,15 +589,6 @@ sub delete { } } - if ( $cp_server ) { - my $queue = new FS::queue { 'job' => 'FS::svc_acct::cp_delete' }; - $error = $queue->insert($self->username); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - } - if ( $vpopdir ) { my $queue = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_delete' }; $error = $queue->insert( $self->username, $self->domain ); @@ -679,24 +626,6 @@ sub cyrus_delete { 1; } -sub cp_delete { - my( $username ) = @_; - my $app = new Net::APP ( $cp_server, - User => $cp_user, - Password => $cp_pass, - Domain => $mydomain, - Timeout => 60, - #Debug => 1, - ) or die "$@\n"; - - $app->delete_mailbox( - Mailbox => $username, - Domain => $mydomain, - ); - - die $app->message."\n" unless $app->ok; -} - sub vpopmail_delete { my( $username, $domain ) = @_; @@ -871,18 +800,6 @@ sub replace { } } - if ( $cp_server && $old->_password ne $new->_password ) { - my $queue = new FS::queue { - 'svcnum' => $new->svcnum, - 'job' => 'FS::svc_acct::cp_change' - }; - $error = $queue->insert( $new->username, $new->_password ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - } - if ( $vpopdir ) { my $cpassword = crypt( $new->_password,$saltset[int(rand(64))].$saltset[int(rand(64))] @@ -914,65 +831,6 @@ sub replace { ''; #no error } -sub cp_rename { - my ( $old_username, $new_username ) = @_; - - my $app = new Net::APP ( $cp_server, - User => $cp_user, - Password => $cp_pass, - Domain => $mydomain, - Timeout => 60, - #Debug => 1, - ) or die "$@\n"; - - $app->rename_mailbox( - Domain => $mydomain, - Old_Mailbox => $old_username, - New_Mailbox => $new_username, - ); - - die $app->message."\n" unless $app->ok; - -} - -sub cp_change { - my ( $username, $password ) = @_; - - my $app = new Net::APP ( $cp_server, - User => $cp_user, - Password => $cp_pass, - Domain => $mydomain, - Timeout => 60, - #Debug => 1, - ) or die "$@\n"; - - if ( $password =~ /^\*SUSPENDED\* (.*)$/ ) { - $password = $1; - $app->set_mailbox_status( - Domain => $mydomain, - Mailbox => $username, - Other => 'T', - Other_Bounce => 'T', - ); - } else { - $app->set_mailbox_status( - Domain => $mydomain, - Mailbox => $username, - Other => 'F', - Other_Bounce => 'F', - ); - } - die $app->message."\n" unless $app->ok; - - $app->change_mailbox( - Domain => $mydomain, - Mailbox => $username, - Password => $password, - ); - die $app->message."\n" unless $app->ok; - -} - sub vpopmail_replace_password { my( $username, $password, $domain ) = @_; diff --git a/FS/bin/freeside-overdue b/FS/bin/freeside-overdue index db99e62b4..116245f9c 100755 --- a/FS/bin/freeside-overdue +++ b/FS/bin/freeside-overdue @@ -129,6 +129,9 @@ freeside-overdue - Perform actions on overdue and/or expired accounts. =head1 DESCRIPTION +This script is deprecated in 1.4.0. You should use freeside-daily and invoice +events instead. + Performs actions on overdue and/or expired accounts. Selection options (at least one selection option is required): diff --git a/FS/bin/freeside-sqlradius-reset b/FS/bin/freeside-sqlradius-reset new file mode 100755 index 000000000..132be754a --- /dev/null +++ b/FS/bin/freeside-sqlradius-reset @@ -0,0 +1,73 @@ +#!/usr/bin/perl -Tw + +use strict; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch qsearchs); +use FS::part_export; +use FS::svc_acct; +use FS::cust_svc; + +my $user = shift or die &usage; +adminsuidsetup $user; + +#my $machine = shift or die &usage; + +my @exports = qsearch('part_export', { 'exporttype' => 'sqlradius' } ); + +foreach my $export ( @exports ) { + my $icradius_dbh = DBI->connect( + map { $export->option($_) } qw( datasrc username password ) + ) or die $DBI::errstr; + for my $table (qw( radcheck radreply usergroup )) { + my $sth = $icradius_dbh->prepare("DELETE FROM $table"); + $sth->execute or die "Can't reset $table table: ". $sth->errstr; + } +} + +foreach my $export ( @exports ) { + + #my @svcparts = map { $_->svcpart } $export->export_svc; + + my @svc_acct = + map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) } + map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) } + grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) } + $export->export_svc; + + foreach my $svc_acct ( @svc_acct ) { + + #false laziness with FS::svc_acct::insert (like it matters) + my $error = $export->export_insert($svc_acct); + die $error if $error; + + } +} + +sub usage { + #die "Usage:\n\n sqlradius_reset user machine\n"; + die "Usage:\n\n sqlradius_reset user\n"; +} + +=head1 NAME + +freeside-sqlradius-reset - Command line interface to reset and recreate RADIUS SQL tables + +=head1 SYNOPSIS + + freeside-sqlradius-reset username + +=head1 DESCRIPTION + +Deletes the radcheck, radreply and usergroup tables and repopulates them from +the Freeside database, for all sqlradius exports. + +B is a username added by freeside-adduser. + +=head1 SEE ALSO + +, L + +=cut + + + -- cgit v1.2.1 From 9bf26ed4b065b12826fc2980ff277a2f3be25c1d Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 14 Apr 2002 09:11:22 +0000 Subject: - move cyrus, shellcommands, CP exports exports to new-style - skeleton files for vpopmail exports - documentation updates - add big schema diagram to docs --- FS/FS/Conf.pm | 20 ++-- FS/FS/part_export.pm | 46 +++++++-- FS/FS/part_export/cp.pm | 21 ++--- FS/FS/part_export/cyrus.pm | 98 ++++++++++++++++++++ FS/FS/part_export/infostreet.pm | 4 +- FS/FS/part_export/shellcommands.pm | 59 ++++++++++++ FS/FS/part_export/vpopmail.pm | 47 ++++++++++ FS/FS/svc_acct.pm | 185 +------------------------------------ FS/MANIFEST | 8 ++ FS/t/part_export-cp.t | 5 + FS/t/part_export-cyrus.t | 5 + FS/t/part_export-shellcommands.t | 5 + FS/t/part_export-vpopmail.t | 5 + 13 files changed, 295 insertions(+), 213 deletions(-) create mode 100644 FS/FS/part_export/cyrus.pm create mode 100644 FS/FS/part_export/shellcommands.pm create mode 100644 FS/FS/part_export/vpopmail.pm create mode 100644 FS/t/part_export-cp.t create mode 100644 FS/t/part_export-cyrus.t create mode 100644 FS/t/part_export-shellcommands.t create mode 100644 FS/t/part_export-vpopmail.t (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index b02913258..d16dd9448 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -298,8 +298,8 @@ httemplate/docs/config.html { 'key' => 'cyrus', - 'section' => 'mail', - 'description' => 'Integration with Cyrus IMAP Server, three lines: IMAP server, admin username, and admin password. Cyrus::IMAP::Admin should be installed locally and the connection to the server secured.', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, add a cyrus export instead. This option used to integrate with Cyrus IMAP Server, three lines: IMAP server, admin username, and admin password. Cyrus::IMAP::Admin should be installed locally and the connection to the server secured.', 'type' => 'textarea', }, @@ -604,29 +604,29 @@ httemplate/docs/config.html { 'key' => 'shellmachine', - 'section' => 'shell', - 'description' => '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.', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, add a cp export instead. This option used to contain a single machine with user home directories mounted. This enables home directory creation, renaming and archiving/deletion. In conjunction with `qmailmachines\', it also enables `.qmail-extension\' file maintenance.', 'type' => 'text', }, { 'key' => 'shellmachine-useradd', - 'section' => 'shell', - 'description' => 'The command(s) to run on shellmachine when an account is created. If the shellmachine option is set but this option is not, useradd -d $dir -m -s $shell -u $uid $username is the default. If this option is set but empty, cp -pr /etc/skel $dir; chown -R $uid.$gid $dir is the default instead. Otherwise the value is evaluated as a double-quoted perl string, with the following variables available: $username, $uid, $gid, $dir, and $shell.', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, add a cp export instead. This option used to contain command(s) to run on shellmachine when an account is created. If the shellmachine option is set but this option is not, useradd -d $dir -m -s $shell -u $uid $username is the default. If this option is set but empty, cp -pr /etc/skel $dir; chown -R $uid.$gid $dir is the default instead. Otherwise the value is evaluated as a double-quoted perl string, with the following variables available: $username, $uid, $gid, $dir, and $shell.', 'type' => [qw( checkbox text )], }, { 'key' => 'shellmachine-userdel', - 'section' => 'shell', - 'description' => 'The command(s) to run on shellmachine when an account is deleted. If the shellmachine option is set but this option is not, userdel $username is the default. If this option is set but empty, rm -rf $dir is the default instead. Otherwise the value is evaluated as a double-quoted perl string, with the following variables available: $username and $dir.', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, add a cp export instead. This option used to contain command(s) to run on shellmachine when an account is deleted. If the shellmachine option is set but this option is not, userdel $username is the default. If this option is set but empty, rm -rf $dir is the default instead. Otherwise the value is evaluated as a double-quoted perl string, with the following variables available: $username and $dir.', 'type' => [qw( checkbox text )], }, { 'key' => 'shellmachine-usermod', - 'section' => 'shell', - 'description' => 'The command(s) to run on shellmachine when an account is modified. If the shellmachine option is set but this option 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.', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, add a cp export instead. This option used to contain command(s) to run on shellmachine when an account is modified. If the shellmachine option is set but this option 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.', #'type' => [qw( checkbox text )], 'type' => 'text', }, diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 7ae00f00c..82503c4ee 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -489,14 +489,37 @@ sub exporttype2svcdb { # 'Batch export of /etc/global/passwd and /etc/global/shadow for NIS ', # 'options' => {}, # }, - 'bsdshell' => { - 'desc' => - 'Batch export of /etc/passwd and /etc/master.passwd files (BSD)', - 'options' => {}, - }, 'textradius' => { 'desc' => 'Batch export of a text /etc/raddb/users file (Livingston, Cistron)', }, + + 'shellcommands' => { + 'desc' => 'Real-time export via arbitrary commands on a remote machine (i.e. useradd, userdel, etc.)', + 'options' => { + 'machine' => { label=>'Remote machine' }, + 'user' => { label=>'Remote username', default=>'root' }, + 'useradd' => { label=>'Insert command', + default=>'useradd -d $dir -m -s $shell -u $uid $username' + #default=>'cp -pr /etc/skel $dir; chown -R $uid.$gid $dir' + }, + 'userdel' => { label=>'Delete command', + default=>'userdel $username', + #default=>'rm -rf $dir', + }, + 'usermod' => { label=>'Modify command', + default=>'usermod -d $new_dir -l $new_username -s $new_shell -u $new_uid $old_username', + #default=>'[ -d $old_dir ] && mv $old_dir $new_dir || ( '. + # 'chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; '. + # 'find . -depth -print | cpio -pdm $new_dir; '. + # 'chmod u-t $new_dir; chown -R $uid.$gid $new_dir; '. + # 'rm -rf $old_dir'. + #')' + }, + }, + 'nodomain' => 'Y', + 'notes' => 'shellcommandsnotes... (this one is the nodomain one)', + }, + 'sqlradius' => { 'desc' => 'Real-time export to SQL-backed RADIUS (ICRADIUS, FreeRADIUS)', 'options' => { @@ -507,9 +530,18 @@ sub exporttype2svcdb { 'nodomain' => 'Y', 'notes' => 'Real-time export of radcheck, radreply and usergroup tables to any SQL database for FreeRADIUS or ICRADIUS. Use freeside-sqlradius-reset to delete and repopulate the tables from the Freeside database.', }, + 'cyrus' => { 'desc' => 'Real-time export to Cyrus IMAP server', + 'options' => { + 'server' => { label=>'IMAP server' }, + 'username' => { label=>'Admin username' }, + 'password' => { label=>'Admin password' }, + }, + 'nodomain' => 'Y', + 'notes' => 'Integration with Cyrus IMAP Server. Cyrus::IMAP::Admin should be installed locally and the connection to the server secured. svc_acct.quota is used to set the Cyrus quota if available. ' }, + 'cp' => { 'desc' => 'Real-time export to Critical Path Account Provisioning Protocol', 'options' => { @@ -522,6 +554,7 @@ sub exporttype2svcdb { }, 'notes' => 'Real-time export to Critial Path Account Provisioning Protocol. Requires installation of Net::APP from CPAN.', }, + 'infostreet' => { 'desc' => 'Real-time export to InfoStreet streetSmartAPI', 'options' => { @@ -532,7 +565,8 @@ sub exporttype2svcdb { }, 'nodomain' => 'Y', 'notes' => 'Real-time export to InfoStreet streetSmartAPI. Requires installation of Frontier::Client from CPAN.', - } + }, + }, 'svc_domain' => {}, diff --git a/FS/FS/part_export/cp.pm b/FS/FS/part_export/cp.pm index 58ac85e8a..d998c1d95 100644 --- a/FS/FS/part_export/cp.pm +++ b/FS/FS/part_export/cp.pm @@ -69,22 +69,17 @@ sub cp_command { #subroutine, not method ); } + my $other = 'F'; if ( $new_password =~ /^\*SUSPENDED\* (.*)$/ ) { $new_password = $1; - cp_command($host, $port, $username, $password, 'set_mailbox_status', - Domain => $domain, - Mailbox => $new_username, - Other => 'T', - Other_Bounce => 'T', - ); - } else { - cp_command($host, $port, $username, $password, 'set_mailbox_status', - Domain => $domain, - Mailbox => $new_username, - Other => 'F', - Other_Bounce => 'F', - ); + $other = 'T'; } + cp_command($host, $port, $username, $password, 'set_mailbox_status', + Domain => $domain, + Mailbox => $new_username, + Other => $other, + Other_Bounce => $other, + ); if ( $old_password ne $new_password ) { cp_command($host, $port, $username, $password, 'change_mailbox', diff --git a/FS/FS/part_export/cyrus.pm b/FS/FS/part_export/cyrus.pm new file mode 100644 index 000000000..110ff198f --- /dev/null +++ b/FS/FS/part_export/cyrus.pm @@ -0,0 +1,98 @@ +package FS::part_export::cyrus; + +use vars qw(@ISA); +use FS::part_export; + +@ISA = qw(FS::part_export); + +sub rebless { shift; } + +sub _export_insert { + my($self, $svc_acct) = (shift, shift); + $self->cyrus_queue( $svc_acct->svcnum, 'insert', + $svc_acct->username, $svc_acct->quota ); +} + +sub _export_replace { + my( $self, $new, $old ) = (shift, shift, shift); + return "can't change username using Cyrus" + if $old->username ne $new->username; + return ''; +# #return '' unless $old->_password ne $new->_password; +# $self->cyrus_queue( $new->svcnum, +# 'replace', $new->username, $new->_password ); +} + +sub _export_delete { + my( $self, $svc_acct ) = (shift, shift); + $self->cyrus_queue( $svc_acct->svcnum, 'delete', + $svc_acct->username ); +} + +#a good idea to queue anything that could fail or take any time +sub cyrus_queue { + my( $self, $svcnum, $method ) = (shift, shift, shift); + my $queue = new FS::queue { + 'svcnum' => $svcnum, + 'job' => "FS::part_export::cyrus::cyrus_$method", + }; + $queue->insert( + $self->option('server'), + $self->option('username'), + $self->option('password'), + @_ + ); +} + +sub cyrus_insert { #subroutine, not method + my $client = cyrus_connect(shift, shift, shift); + my( $username, $quota ) = @_; + my $rc = $client->create("user.$username"); + my $error = $client->error; + die "creating user.$username: $error" if $error; + + $rc = $client->setacl("user.$username", $username => 'all' ); + $error = $client->error; + die "setacl user.$username: $error" if $error; + + if ( $quota ) { + $rc = $client->setquota("user.$username", 'STORAGE' => $quota ); + $error = $client->error; + die "setquota user.$username: $error" if $error; + } + +} + +sub cyrus_delete { #subroutine, not method + my ( $server, $admin_username, $password_username, $username ) = @_; + my $client = cyrus_connect($server, $admin_username, $password_username); + + my $rc = $client->setacl("user.$username", $admin_username => 'all' ); + my $error = $client->error; + die $error if $error; + + $rc = $client->delete("user.$username"); + $error = $client->error; + die $error if $error; +} + +sub cyrus_connect { + + my( $server, $admin_username, $admin_password ) = @_; + + eval "use Cyrus::IMAP::Admin;"; + + my $client = Cyrus::IMAP::Admin->new($server); + $client->authenticate( + -user => $admin_username, + -mechanism => "login", + -password => $admin_password, + ); + $client; + +} + +#sub cyrus_replace { #subroutine, not method +#} + + diff --git a/FS/FS/part_export/infostreet.pm b/FS/FS/part_export/infostreet.pm index c2386adb7..e86e82a66 100644 --- a/FS/FS/part_export/infostreet.pm +++ b/FS/FS/part_export/infostreet.pm @@ -10,7 +10,7 @@ sub rebless { shift; } sub _export_insert { my( $self, $svc_acct ) = (shift, shift); $self->infostreet_queue( $svc_acct->svcnum, - 'createUser', $svc_acct->username, $svc_acct->password ); + 'createUser', $svc_acct->username, $svc_acct->_password ); } sub _export_replace { @@ -19,7 +19,7 @@ sub _export_replace { if $old->username ne $new->username; return '' unless $old->_password ne $new->_password; $self->infostreet_queue( $new->svcnum, - 'passwd', $new->username, $new->password ); + 'passwd', $new->username, $new->_password ); } sub _export_delete { diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm new file mode 100644 index 000000000..e99c382a4 --- /dev/null +++ b/FS/FS/part_export/shellcommands.pm @@ -0,0 +1,59 @@ +package FS::part_export::shellcommands; + +use vars qw(@ISA); +use FS::part_export; + +@ISA = qw(FS::part_export); + +sub rebless { shift; } + +sub _export_insert { + my($self) = shift; + $self->_export_command($self, 'useradd', @_); +} + +sub _export_delete { + my($self) = shift; + $self->_export_command($self, 'userdel', @_); +} + +sub _export_command { + my ( $self, $action, $svc_acct) = (shift, shift, shift); + my $command = $self->option($action); + no strict 'refs'; + ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields; + $self->shellcommands_queue( + $self->options('user')||'root'. "\@". $self->options('machine'), + eval(qq("$command")) + ); +} + +sub _export_replace { + my($self, $new, $old ) = (shift, shift, shift); + my $command = $self->option('usermod'); + no strict 'refs'; + ${"old_$_"} = $old->getfield($_) foreach $old->fields; + ${"new_$_"} = $new->getfield($_) foreach $new->fields; + $self->shellcommands_queue( + $self->options('user')||'root'. "\@". $self->options('machine'), + eval(qq("$command")) + ); +} + +#a good idea to queue anything that could fail or take any time +sub shellcommands_queue { + my( $self, $svcnum ) = (shift, shift); + my $queue = new FS::queue { + 'svcnum' => $svcnum, + 'job' => "Net::SSH::ssh_cmd", #freeside-queued pre-uses... + }; + $queue->insert( @_ ); +} + +#sub shellcommands_insert { #subroutine, not method +#} +#sub shellcommands_replace { #subroutine, not method +#} +#sub shellcommands_delete { #subroutine, not method +#} + diff --git a/FS/FS/part_export/vpopmail.pm b/FS/FS/part_export/vpopmail.pm new file mode 100644 index 000000000..7a59f3259 --- /dev/null +++ b/FS/FS/part_export/vpopmail.pm @@ -0,0 +1,47 @@ +package FS::part_export::myexport; + +use vars qw(@ISA); +use FS::part_export; + +@ISA = qw(FS::part_export); + +sub rebless { shift; } + +sub _export_insert { + my($self, $svc_acct) = (shift, shift); + $self->myexport_queue( $svc_acct->svcnum, 'insert', + $svc_acct->username, $svc_acct->_password ); +} + +sub _export_replace { + my( $self, $new, $old ) = (shift, shift, shift); + #return "can't change username with myexport" + # if $old->username ne $new->username; + #return '' unless $old->_password ne $new->_password; + $self->myexport_queue( $new->svcnum, + 'replace', $new->username, $new->_password ); +} + +sub _export_delete { + my( $self, $svc_acct ) = (shift, shift); + $self->myexport_queue( $svc_acct->svcnum, + 'delete', $svc_acct->username ); +} + +#a good idea to queue anything that could fail or take any time +sub myexport_queue { + my( $self, $svcnum, $method ) = (shift, shift, shift); + my $queue = new FS::queue { + 'svcnum' => $svcnum, + 'job' => "FS::part_export::myexport::myexport_$method", + }; + $queue->insert( @_ ); +} + +sub myexport_insert { #subroutine, not method +} +sub myexport_replace { #subroutine, not method +} +sub myexport_delete { #subroutine, not method +} + diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 1e1cbb019..ea1107823 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -6,8 +6,7 @@ use vars qw( @ISA $nossh_hack $noexport_hack $conf $usernamemax $passwordmin $passwordmax $username_ampersand $username_letter $username_letterfirst $username_noperiod $username_uppercase - $shellmachine $useradd $usermod $userdel $mydomain - $cyrus_server $cyrus_admin_user $cyrus_admin_pass + $mydomain $dirhash @saltset @pw_set $rsync $ssh $exportdir $vpopdir); @@ -38,47 +37,16 @@ $FS::UID::callback{'FS::svc_acct'} = sub { $conf = new FS::Conf; $dir_prefix = $conf->config('home'); @shells = $conf->config('shells'); - $shellmachine = $conf->config('shellmachine'); $usernamemin = $conf->config('usernamemin') || 2; $usernamemax = $conf->config('usernamemax'); $passwordmin = $conf->config('passwordmin') || 6; $passwordmax = $conf->config('passwordmax') || 8; - if ( $shellmachine ) { - if ( $conf->exists('shellmachine-useradd') ) { - $useradd = join("\n", $conf->config('shellmachine-useradd') ) - || 'cp -pr /etc/skel $dir; chown -R $uid.$gid $dir'; - } else { - $useradd = 'useradd -d $dir -m -s $shell -u $uid $username'; - } - if ( $conf->exists('shellmachine-userdel') ) { - $userdel = join("\n", $conf->config('shellmachine-userdel') ) - || 'rm -rf $dir'; - } else { - $userdel = 'userdel $username'; - } - $usermod = join("\n", $conf->config('shellmachine-usermod') ) - || '[ -d $old_dir ] && mv $old_dir $new_dir || ( '. - 'chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; '. - 'find . -depth -print | cpio -pdm $new_dir; '. - 'chmod u-t $new_dir; chown -R $uid.$gid $new_dir; '. - 'rm -rf $old_dir'. - ')'; - } $username_letter = $conf->exists('username-letter'); $username_letterfirst = $conf->exists('username-letterfirst'); $username_noperiod = $conf->exists('username-noperiod'); $username_uppercase = $conf->exists('username-uppercase'); $username_ampersand = $conf->exists('username-ampersand'); $mydomain = $conf->config('domain'); - if ( $conf->exists('cyrus') ) { - ($cyrus_server, $cyrus_admin_user, $cyrus_admin_pass) = - $conf->config('cyrus'); - eval "use Cyrus::IMAP::Admin;" - } else { - $cyrus_server = ''; - $cyrus_admin_user = ''; - $cyrus_admin_pass = ''; - } $dirhash = $conf->config('dirhash') || 0; $exportdir = "/usr/local/etc/freeside/export." . datasrc; @@ -94,8 +62,6 @@ $FS::UID::callback{'FS::svc_acct'} = sub { @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); @pw_set = ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '!', '.', ',' ); -#not needed in 5.004 #srand($$|time); - sub _cache { my $self = shift; my ( $hashref, $cache ) = @_; @@ -228,7 +194,7 @@ 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. -(TODOC: cyrus config file, L and L) +(TODOC: L and L) (TODOC: new exports! $noexport_hack) @@ -309,37 +275,6 @@ sub insert { #old-style exports - my( $username, $uid, $gid, $dir, $shell ) = ( - $self->username, - $self->uid, - $self->gid, - $self->dir, - $self->shell, - ); - if ( $username && $uid && $dir && $shellmachine && ! $nossh_hack ) { - my $queue = new FS::queue { - 'svcnum' => $self->svcnum, - 'job' => 'Net::SSH::ssh_cmd', - }; - $error = $queue->insert("root\@$shellmachine", eval qq("$useradd") ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - } - - if ( $cyrus_server ) { - my $queue = new FS::queue { - 'svcnum' => $self->svcnum, - 'job' => 'FS::svc_acct::cyrus_insert', - }; - $error = $queue->insert($self->username, $self->quota); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - } - if ( $vpopdir ) { my $vpopmail_queue = @@ -365,41 +300,6 @@ sub insert { ''; #no error } -sub cyrus_insert { - my( $username, $quota ) = @_; - - warn "cyrus_insert: starting for user $username, quota $quota\n"; - - warn "cyrus_insert: connecting to $cyrus_server\n"; - my $client = Cyrus::IMAP::Admin->new($cyrus_server); - - warn "cyrus_insert: authentication as $cyrus_admin_user\n"; - $client->authenticate( - -user => $cyrus_admin_user, - -mechanism => "login", - -password => $cyrus_admin_pass - ); - - warn "cyrus_insert: creating user.$username\n"; - my $rc = $client->create("user.$username"); - my $error = $client->error; - die "cyrus_insert: error creating user.$username: $error" if $error; - - warn "cyrus_insert: setacl user.$username, $username => all\n"; - $rc = $client->setacl("user.$username", $username => 'all' ); - $error = $client->error; - die "cyrus_insert: error setacl user.$username: $error" if $error; - - if ( $quota ) { - warn "cyrus_insert: setquota user.$username, STORAGE => $quota\n"; - $rc = $client->setquota("user.$username", 'STORAGE' => $quota ); - $error = $client->error; - die "cyrus_insert: error setquota user.$username: $error" if $error; - } - - 1; -} - sub vpopmail_insert { my( $username, $password, $domain, $vpopdir ) = @_; @@ -468,8 +368,6 @@ 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. -(TODOC: cyrus config file) - (TODOC: new exports! $noexport_hack) =cut @@ -566,29 +464,6 @@ sub delete { #old-style exports - my( $username, $dir ) = ( - $self->username, - $self->dir, - ); - if ( $username && $shellmachine && ! $nossh_hack ) { - my $queue = new FS::queue { 'job' => 'Net::SSH::ssh_cmd' }; - $error = $queue->insert("root\@$shellmachine", eval qq("$userdel") ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - - } - - if ( $cyrus_server ) { - my $queue = new FS::queue { 'job' => 'FS::svc_acct::cyrus_delete' }; - $error = $queue->insert($self->username); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - } - if ( $vpopdir ) { my $queue = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_delete' }; $error = $queue->insert( $self->username, $self->domain ); @@ -605,27 +480,6 @@ sub delete { ''; } -sub cyrus_delete { - my $username = shift; - - my $client = Cyrus::IMAP::Admin->new($cyrus_server); - $client->authenticate( - -user => $cyrus_admin_user, - -mechanism => "login", - -password => $cyrus_admin_pass - ); - - my $rc = $client->setacl("user.$username", $cyrus_admin_user => 'all' ); - my $error = $client->error; - die $error if $error; - - $rc = $client->delete("user.$username"); - $error = $client->error; - die $error if $error; - - 1; -} - sub vpopmail_delete { my( $username, $domain ) = @_; @@ -649,7 +503,7 @@ sub vpopmail_delete { flock(VPASSWD,LOCK_UN); close(VPASSWD); - rmtree "$exportdir/domains/$domain/$username" or die "can't destroy Maildir";+ + rmtree "$exportdir/domains/$domain/$username" or die "can't destroy Maildir"; 1; } @@ -699,9 +553,6 @@ sub replace { return "Can't change uid!" if $old->uid != $new->uid; } - return "can't change username using Cyrus" - if $cyrus_server && $old->username ne $new->username; - #change homdir when we change username $new->setfield('dir', '') if $old->username ne $new->username; @@ -770,36 +621,6 @@ sub replace { #old-style exports - my ( $old_dir, $new_dir, $uid, $gid ) = ( - $old->getfield('dir'), - $new->getfield('dir'), - $new->getfield('uid'), - $new->getfield('gid'), - ); - if ( $old_dir && $new_dir && $old_dir ne $new_dir && ! $nossh_hack ) { - my $queue = new FS::queue { - 'svcnum' => $new->svcnum, - 'job' => 'Net::SSH::ssh_cmd' - }; - $error = $queue->insert("root\@$shellmachine", eval qq("$usermod") ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - } - - if ( $cp_server && $old->username ne $new->username ) { - my $queue = new FS::queue { - 'svcnum' => $new->svcnum, - 'job' => 'FS::svc_acct::cp_rename' - }; - $error = $queue->insert( $old->username, $new->username ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - } - if ( $vpopdir ) { my $cpassword = crypt( $new->_password,$saltset[int(rand(64))].$saltset[int(rand(64))] diff --git a/FS/MANIFEST b/FS/MANIFEST index 1c90dfc0e..86516e3d9 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -51,6 +51,10 @@ FS/part_export.pm FS/part_export_option.pm FS/part_export/infostreet.pm FS/part_export/sqlradius.pm +FS/part_export/cyrus.pm +FS/part_export/cp.pm +FS/part_export/shellcommands.pm +FS/part_export/vpopmail.pm FS/part_pkg.pm FS/part_pop_local.pm FS/part_referral.pm @@ -106,6 +110,10 @@ t/part_export.t t/part_export_option.t t/part_export-infostreet.t t/part_export-sqlradius.t +t/part_export-cyrus.t +t/part_export-cp.t +t/part_export-shellcommands.t +t/part_export-vpopmail.t t/part_pkg.t t/part_pop_local.t t/part_referral.t diff --git a/FS/t/part_export-cp.t b/FS/t/part_export-cp.t new file mode 100644 index 000000000..bbefa6c1b --- /dev/null +++ b/FS/t/part_export-cp.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::cp; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-cyrus.t b/FS/t/part_export-cyrus.t new file mode 100644 index 000000000..e0b3f350e --- /dev/null +++ b/FS/t/part_export-cyrus.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::cyrus; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-shellcommands.t b/FS/t/part_export-shellcommands.t new file mode 100644 index 000000000..7bb47d3f8 --- /dev/null +++ b/FS/t/part_export-shellcommands.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::shellcommands; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-vpopmail.t b/FS/t/part_export-vpopmail.t new file mode 100644 index 000000000..2e37114a2 --- /dev/null +++ b/FS/t/part_export-vpopmail.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::vpopmail; +$loaded=1; +print "ok 1\n"; -- cgit v1.2.1 From 1290c097176adcd62d48b1250233d53adb4b50a5 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 16 Apr 2002 08:52:38 +0000 Subject: move the last of the real-time exports out of svc_acct.pm and into part_export --- FS/FS/Conf.pm | 12 +-- FS/FS/part_export.pm | 13 ++- FS/FS/part_export/vpopmail.pm | 166 ++++++++++++++++++++++++++--- FS/FS/svc_acct.pm | 241 +----------------------------------------- 4 files changed, 169 insertions(+), 263 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index d16dd9448..f9a49ca04 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -605,28 +605,28 @@ httemplate/docs/config.html { 'key' => 'shellmachine', 'section' => 'deprecated', - 'description' => 'DEPRECATED, add a cp export instead. This option used to contain a single machine with user home directories mounted. This enables home directory creation, renaming and archiving/deletion. In conjunction with `qmailmachines\', it also enables `.qmail-extension\' file maintenance.', + 'description' => 'DEPRECATED, add a shellcommands export instead. This option used to contain a single machine with user home directories mounted. This enables home directory creation, renaming and archiving/deletion. In conjunction with `qmailmachines\', it also enables `.qmail-extension\' file maintenance.', 'type' => 'text', }, { 'key' => 'shellmachine-useradd', 'section' => 'deprecated', - 'description' => 'DEPRECATED, add a cp export instead. This option used to contain command(s) to run on shellmachine when an account is created. If the shellmachine option is set but this option is not, useradd -d $dir -m -s $shell -u $uid $username is the default. If this option is set but empty, cp -pr /etc/skel $dir; chown -R $uid.$gid $dir is the default instead. Otherwise the value is evaluated as a double-quoted perl string, with the following variables available: $username, $uid, $gid, $dir, and $shell.', + 'description' => 'DEPRECATED, add a shellcommands export instead. This option used to contain command(s) to run on shellmachine when an account is created. If the shellmachine option is set but this option is not, useradd -d $dir -m -s $shell -u $uid $username is the default. If this option is set but empty, cp -pr /etc/skel $dir; chown -R $uid.$gid $dir is the default instead. Otherwise the value is evaluated as a double-quoted perl string, with the following variables available: $username, $uid, $gid, $dir, and $shell.', 'type' => [qw( checkbox text )], }, { 'key' => 'shellmachine-userdel', 'section' => 'deprecated', - 'description' => 'DEPRECATED, add a cp export instead. This option used to contain command(s) to run on shellmachine when an account is deleted. If the shellmachine option is set but this option is not, userdel $username is the default. If this option is set but empty, rm -rf $dir is the default instead. Otherwise the value is evaluated as a double-quoted perl string, with the following variables available: $username and $dir.', + 'description' => 'DEPRECATED, add a shellcommands export instead. This option used to contain command(s) to run on shellmachine when an account is deleted. If the shellmachine option is set but this option is not, userdel $username is the default. If this option is set but empty, rm -rf $dir is the default instead. Otherwise the value is evaluated as a double-quoted perl string, with the following variables available: $username and $dir.', 'type' => [qw( checkbox text )], }, { 'key' => 'shellmachine-usermod', 'section' => 'deprecated', - 'description' => 'DEPRECATED, add a cp export instead. This option used to contain command(s) to run on shellmachine when an account is modified. If the shellmachine option is set but this option 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.', + 'description' => 'DEPRECATED, add a shellcommands export instead. This option used to contain command(s) to run on shellmachine when an account is modified. If the shellmachine option is set but this option 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.', #'type' => [qw( checkbox text )], 'type' => 'text', }, @@ -796,8 +796,8 @@ httemplate/docs/config.html { 'key' => 'vpopmailmachines', - 'section' => 'mail', - 'description' => 'Your vpopmail pop toasters, one per line. Each line is of the form "machinename vpopdir vpopuid vpopgid". For example: poptoaster.domain.tld /home/vpopmail 508 508 Note: vpopuid and vpopgid are values taken from the vpopmail machine\'s /etc/passwd', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, add a cp export instead. This option used to contain your vpopmail pop toasters, one per line. Each line is of the form "machinename vpopdir vpopuid vpopgid". For example: poptoaster.domain.tld /home/vpopmail 508 508 Note: vpopuid and vpopgid are values taken from the vpopmail machine\'s /etc/passwd', 'type' => 'textarea', }, diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 82503c4ee..406b270ed 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -539,7 +539,7 @@ sub exporttype2svcdb { 'password' => { label=>'Admin password' }, }, 'nodomain' => 'Y', - 'notes' => 'Integration with Cyrus IMAP Server. Cyrus::IMAP::Admin should be installed locally and the connection to the server secured. svc_acct.quota is used to set the Cyrus quota if available. ' + 'notes' => 'Integration with Cyrus IMAP Server. Cyrus::IMAP::Admin should be installed locally and the connection to the server secured. svc_acct.quota, if available, is used to set the Cyrus quota. ' }, 'cp' => { @@ -567,6 +567,17 @@ sub exporttype2svcdb { 'notes' => 'Real-time export to InfoStreet streetSmartAPI. Requires installation of Frontier::Client from CPAN.', }, + 'vpopmail' => { + 'desc' => 'Real-time export to vpopmail text files', + 'options' => { + 'machine' => { label=>'vpopmail machine', }, + 'dir' => { label=>'directory', }, # ?more info? default? + 'uid' => { label=>'vpopmail uid' }, + 'gid' => { label=>'vpopmail gid' }, + }, + 'notes' => 'Real time export to vpopmail text files (...extended description from jeff?...)', + }, + }, 'svc_domain' => {}, diff --git a/FS/FS/part_export/vpopmail.pm b/FS/FS/part_export/vpopmail.pm index 7a59f3259..6a486faa1 100644 --- a/FS/FS/part_export/vpopmail.pm +++ b/FS/FS/part_export/vpopmail.pm @@ -1,47 +1,179 @@ -package FS::part_export::myexport; +package FS::part_export::vpopmail; -use vars qw(@ISA); +use vars qw(@ISA @saltset $exportdir $rsync $ssh); +use File::Path; +use FS::UID qw( datasrc ); use FS::part_export; @ISA = qw(FS::part_export); +@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); + +$rsync = "rsync"; +$ssh = "ssh"; + sub rebless { shift; } sub _export_insert { my($self, $svc_acct) = (shift, shift); - $self->myexport_queue( $svc_acct->svcnum, 'insert', - $svc_acct->username, $svc_acct->_password ); + $self->vpopmail_queue( $svc_acct->svcnum, 'insert', + $svc_acct->username, + crypt($svc_acct->_password,$saltset[int(rand(64))].$saltset[int(rand(64))]), + $svc_acct->domain, + ); } sub _export_replace { my( $self, $new, $old ) = (shift, shift, shift); - #return "can't change username with myexport" - # if $old->username ne $new->username; - #return '' unless $old->_password ne $new->_password; - $self->myexport_queue( $new->svcnum, - 'replace', $new->username, $new->_password ); + + my $cpassword = crypt( + $new->_password, $saltset[int(rand(64))].$saltset[int(rand(64))] + ); + + return "can't change username with vpopmail" + if $old->username ne $new->username; + + #no.... if mail can't be preserved, better to disallow username changes + #if ($old->username ne $new->username || $old->domain ne $new->domain ) { + # vpopmail_queue( $svc_acct->svcnum, 'delete', + # $old->username, $old->domain + # ); + # vpopmail_queue( $svc_acct->svcnum, 'insert', + # $new->username, + # $cpassword, + # $new->domain, + # ); + + return '' unless $old->_password ne $new->_password; + + $self->vpopmail_queue( $new->svcnum, 'replace', + $new->username, $cpassword, $new->domain ); } sub _export_delete { my( $self, $svc_acct ) = (shift, shift); - $self->myexport_queue( $svc_acct->svcnum, - 'delete', $svc_acct->username ); + $self->vpopmail_queue( $svc_acct->svcnum, 'delete', + $svc_acct->username, $svc_acct->domain ); } #a good idea to queue anything that could fail or take any time -sub myexport_queue { +sub vpopmail_queue { my( $self, $svcnum, $method ) = (shift, shift, shift); + my $exportdir = "/usr/local/etc/freeside/export." . datasrc; my $queue = new FS::queue { 'svcnum' => $svcnum, - 'job' => "FS::part_export::myexport::myexport_$method", + 'job' => "FS::part_export::vpopmail::vpopmail_$method", }; - $queue->insert( @_ ); + $queue->insert( + $exportdir, + $self->option('machine'), + $self->option('dir'), + $self->option('uid'), + $self->option('gid'), + @_ + ); } -sub myexport_insert { #subroutine, not method +sub vpopmail_insert { #subroutine, not method + my( $exportdir, $machine, $dir, $uid, $gid ) = splice @_,0,5; + my( $username, $password, $domain ) = @_; + + (open(VPASSWD, ">>$exportdir/domains/$domain/vpasswd") + and flock(VPASSWD,LOCK_EX) + ) or die "can't open vpasswd file for $username\@$domain: ". + "$exportdir/domains/$domain/vpasswd: $!"; + print VPASSWD join(":", + $username, + $password, + '1', + '0', + $username, + "$dir/domains/$domain/$username", + 'NOQUOTA', + ), "\n"; + + flock(VPASSWD,LOCK_UN); + close(VPASSWD); + + for my $mkdir ( + map { "$exportdir/domains/$domain/$username$_" } + ( '', qw( /Maildir /Maildir/cur /Maildir/new /Maildir/tmp ) ) + ) { + mkdir $mkdir, 0700 or die "can't mkdir $mkdir: $!"; + } + + vpopmail_sync( $exportdir, $machine, $dir, $uid, $gid ); + +} + +sub vpopmail_replace { #subroutine, not method + my( $exportdir, $machine, $dir, $uid, $gid ) = splice @_,0,5; + my( $username, $password, $domain ) = @_; + + (open(VPASSWD, "$exportdir/domains/$domain/vpasswd") + and flock(VPASSWD,LOCK_EX) + ) or die "can't open $exportdir/domains/$domain/vpasswd: $!"; + + open(VPASSWDTMP, ">$exportdir/domains/$domain/vpasswd.tmp") + or die "Can't open $exportdir/domains/$domain/vpasswd.tmp: $!"; + + while () { + my ($mailbox, $pw, @rest) = split(':', $_); + print VPASSWDTMP $_ unless $username eq $mailbox; + print VPASSWDTMP join (':', ($mailbox, $password, @rest)) + if $username eq $mailbox; + } + + close(VPASSWDTMP); + + rename "$exportdir/domains/$domain/vpasswd.tmp", "$exportdir/domains/$domain/vpasswd" + or die "Can't rename $exportdir/domains/$domain/vpasswd.tmp: $!"; + + flock(VPASSWD,LOCK_UN); + close(VPASSWD); + + vpopmail_sync( $exportdir, $machine, $dir, $uid, $gid ); + } -sub myexport_replace { #subroutine, not method + +sub vpopmail_delete { #subroutine, not method + my( $exportdir, $machine, $dir, $uid, $gid ) = splice @_,0,5; + my( $username, $domain ) = @_; + + (open(VPASSWD, "$exportdir/domains/$domain/vpasswd") + and flock(VPASSWD,LOCK_EX) + ) or die "can't open $exportdir/domains/$domain/vpasswd: $!"; + + open(VPASSWDTMP, ">$exportdir/domains/$domain/vpasswd.tmp") + or die "Can't open $exportdir/domains/$domain/vpasswd.tmp: $!"; + + while () { + my ($mailbox, $rest) = split(':', $_); + print VPASSWDTMP $_ unless $username eq $mailbox; + } + + close(VPASSWDTMP); + + rename "$exportdir/domains/$domain/vpasswd.tmp", + "$exportdir/domains/$domain/vpasswd" + or die "Can't rename $exportdir/domains/$domain/vpasswd.tmp: $!"; + + flock(VPASSWD,LOCK_UN); + close(VPASSWD); + + rmtree "$exportdir/domains/$domain/$username" + or die "can't rmtree $exportdir/domains/$domain/$username: $!"; + + vpopmail_sync( $exportdir, $machine, $dir, $uid, $gid ); } -sub myexport_delete { #subroutine, not method + +sub vpopmail_sync { + my( $exportdir, $machine, $dir, $uid, $gid ) = splice @_,0,5; + + chdir $exportdir; + my @args = ( $rsync, "-rlpt", "-e", $ssh, "domains/", + "vpopmail\@$machine:$dir/domains/" ); + system {$args[0]} @args; } + diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index ea1107823..7fcfd35df 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -1,17 +1,15 @@ package FS::svc_acct; use strict; -use vars qw( @ISA $nossh_hack $noexport_hack $conf +use vars qw( @ISA $noexport_hack $conf $dir_prefix @shells $usernamemin $usernamemax $passwordmin $passwordmax $username_ampersand $username_letter $username_letterfirst $username_noperiod $username_uppercase $mydomain $dirhash - @saltset @pw_set - $rsync $ssh $exportdir $vpopdir); + @saltset @pw_set ); use Carp; -use File::Path; use Fcntl qw(:flock); use FS::UID qw( datasrc ); use FS::Conf; @@ -32,8 +30,6 @@ use FS::Msgcat qw(gettext); #ask FS::UID to run this stuff for us later $FS::UID::callback{'FS::svc_acct'} = sub { - $rsync = "rsync"; - $ssh = "ssh"; $conf = new FS::Conf; $dir_prefix = $conf->config('home'); @shells = $conf->config('shells'); @@ -49,14 +45,6 @@ $FS::UID::callback{'FS::svc_acct'} = sub { $mydomain = $conf->config('domain'); $dirhash = $conf->config('dirhash') || 0; - $exportdir = "/usr/local/etc/freeside/export." . datasrc; - if ( $conf->exists('vpopmailmachines') ) { - my (@vpopmailmachines) = $conf->config('vpopmailmachines'); - my ($machine, $dir, $uid, $gid) = split (/\s+/, $vpopmailmachines[0]); - $vpopdir = $dir; - } else { - $vpopdir = ''; - } }; @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); @@ -176,24 +164,6 @@ The additional field I can optionally be defined; if so it should contain an arrayref of group names. See L. (used in sqlradius export only) -If the configuration value (see L) shellmachine exists, and the -username, uid, and dir fields are defined, the command(s) specified in -the shellmachine-useradd configuration are added to the job queue (see -L and L) to be 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. - (TODOC: L and L) (TODOC: new exports! $noexport_hack) @@ -273,76 +243,10 @@ sub insert { } } - #old-style exports - - if ( $vpopdir ) { - - my $vpopmail_queue = - new FS::queue { - 'svcnum' => $self->svcnum, - 'job' => 'FS::svc_acct::vpopmail_insert' - }; - $error = $vpopmail_queue->insert( $self->username, - crypt($self->_password,$saltset[int(rand(64))].$saltset[int(rand(64))]), - $self->domain, - $vpopdir, - ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - - } - - #end of old-style exports - $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error } -sub vpopmail_insert { - my( $username, $password, $domain, $vpopdir ) = @_; - - (open(VPASSWD, ">>$exportdir/domains/$domain/vpasswd") - and flock(VPASSWD,LOCK_EX) - ) or die "can't open vpasswd file for $username\@$domain: $exportdir/domains/$domain/vpasswd"; - print VPASSWD join(":", - $username, - $password, - '1', - '0', - $username, - "$vpopdir/domains/$domain/$username", - 'NOQUOTA', - ), "\n"; - - flock(VPASSWD,LOCK_UN); - close(VPASSWD); - - mkdir "$exportdir/domains/$domain/$username", 0700 or die "can't create Maildir"; - mkdir "$exportdir/domains/$domain/$username/Maildir", 0700 or die "can't create Maildir"; - mkdir "$exportdir/domains/$domain/$username/Maildir/cur", 0700 or die "can't create Maildir"; - mkdir "$exportdir/domains/$domain/$username/Maildir/new", 0700 or die "can't create Maildir"; - mkdir "$exportdir/domains/$domain/$username/Maildir/tmp", 0700 or die "can't create Maildir"; - - my $queue = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_sync' }; - my $error = $queue->insert; - die $error if $error; - - 1; -} - -sub vpopmail_sync { - - my (@vpopmailmachines) = $conf->config('vpopmailmachines'); - my ($machine, $dir, $uid, $gid) = split (/\s+/, $vpopmailmachines[0]); - - chdir $exportdir; - my @args = ("$rsync", "-rlpt", "-e", "$ssh", "domains/", "vpopmail\@$machine:$vpopdir/domains/"); - system {$args[0]} @args; - -} - =item delete Deletes this account from the database. If there is an error, returns the @@ -350,24 +254,6 @@ 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(s) specified in the shellmachine-userdel configuration file are -added to the job queue (see L and L) to be 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. - (TODOC: new exports! $noexport_hack) =cut @@ -462,51 +348,10 @@ sub delete { } } - #old-style exports - - if ( $vpopdir ) { - my $queue = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_delete' }; - $error = $queue->insert( $self->username, $self->domain ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - - } - - #end of old-style exports - $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } -sub vpopmail_delete { - my( $username, $domain ) = @_; - - (open(VPASSWD, "$exportdir/domains/$domain/vpasswd") - and flock(VPASSWD,LOCK_EX) - ) or die "can't open $exportdir/domains/$domain/vpasswd: $!"; - - open(VPASSWDTMP, ">$exportdir/domains/$domain/vpasswd.tmp") - or die "Can't open $exportdir/domains/$domain/vpasswd.tmp: $!"; - - while () { - my ($mailbox, $rest) = split(':', $_); - print VPASSWDTMP $_ unless $username eq $mailbox; - } - - close(VPASSWDTMP); - - rename "$exportdir/domains/$domain/vpasswd.tmp", "$exportdir/domains/$domain/vpasswd" - or die "Can't rename $exportdir/domains/$domain/vpasswd.tmp: $!"; - - flock(VPASSWD,LOCK_UN); - close(VPASSWD); - - rmtree "$exportdir/domains/$domain/$username" or die "can't destroy Maildir"; - 1; -} - =item replace OLD_RECORD Replaces OLD_RECORD with this one in the database. If there is an error, @@ -516,26 +361,6 @@ The additional field I can optionally be defined; if so it should contain an arrayref of group names. See L. (used in sqlradius export only) -If the configuration value (see L) shellmachine exists, and the -dir field has changed, the command(s) specified in the shellmachine-usermod -configuraiton file are added to the job queue (see L and -L) to be 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 the default. This behaviour can be surpressed by setting -$FS::svc_acct::nossh_hack true. - =cut sub replace { @@ -619,72 +444,10 @@ sub replace { } } - #old-style exports - - if ( $vpopdir ) { - my $cpassword = crypt( - $new->_password,$saltset[int(rand(64))].$saltset[int(rand(64))] - ); - - if ($old->username ne $new->username || $old->domain ne $new->domain ) { - my $queue = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_delete' }; - $error = $queue->insert( $old->username, $old->domain ); - my $queue2 = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_insert' }; - $error = $queue2->insert( $new->username, - $cpassword, - $new->domain, - $vpopdir, - ) - unless $error; - } elsif ($old->_password ne $new->_password) { - my $queue = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_replace_password' }; - $error = $queue->insert( $new->username, $cpassword, $new->domain ); - } - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - } - - #end of old-style exports - $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error } -sub vpopmail_replace_password { - my( $username, $password, $domain ) = @_; - - (open(VPASSWD, "$exportdir/domains/$domain/vpasswd") - and flock(VPASSWD,LOCK_EX) - ) or die "can't open $exportdir/domains/$domain/vpasswd: $!"; - - open(VPASSWDTMP, ">$exportdir/domains/$domain/vpasswd.tmp") - or die "Can't open $exportdir/domains/$domain/vpasswd.tmp: $!"; - - while () { - my ($mailbox, $pw, @rest) = split(':', $_); - print VPASSWDTMP $_ unless $username eq $mailbox; - print VPASSWDTMP join (':', ($mailbox, $password, @rest)) - if $username eq $mailbox; - } - - close(VPASSWDTMP); - - rename "$exportdir/domains/$domain/vpasswd.tmp", "$exportdir/domains/$domain/vpasswd" - or die "Can't rename $exportdir/domains/$domain/vpasswd.tmp: $!"; - - flock(VPASSWD,LOCK_UN); - close(VPASSWD); - - my $queue = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_sync' }; - my $error = $queue->insert; - die $error if $error; - - 1; -} - - =item suspend Suspends this account by prefixing *SUSPENDED* to the password. If there is an -- cgit v1.2.1 From 17ddcceb66e4c5c45abe890403d2ca98b128d375 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 16 Apr 2002 09:38:20 +0000 Subject: - send a notice to the customer when their card is declined - closes: Bug#351 - freeside-expiration-alerter works fine, closes: Bug#7 --- FS/FS/Conf.pm | 12 ++++++++++ FS/FS/cust_bill.pm | 47 ++++++++++++++++++++++++++++++++++---- FS/bin/freeside-expiration-alerter | 9 ++++---- 3 files changed, 60 insertions(+), 8 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index f9a49ca04..dc1cbb820 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -895,7 +895,19 @@ httemplate/docs/config.html 'type' => 'checkbox', }, + { + 'key' => 'declinetemplate' + 'section' => 'billing', + 'description' => 'Template file for credit card decline emails.', + 'type' => 'textarea', + }, + { + 'key' => 'emaildecline' + 'section' => 'billing', + 'description' => 'Enable emailing of credit card decline notices.', + 'type' => 'checkbox', + }, ); diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index f157f86f6..cb2aa4629 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -373,7 +373,7 @@ sub send { #my @print_text = $cust_bill->print_text; #( date ) my @invoicing_list = $self->cust_main->invoicing_list; if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice - #false laziness w/FS::cust_pay::delete & fs_signup_server + #false laziness w/FS::cust_pay::delete & fs_signup_server && ::realtime_card #$ENV{SMTPHOSTS} = $smtpmachine; $ENV{MAILADDRESS} = $invoice_from; my $header = new Mail::Header ( [ @@ -571,8 +571,47 @@ sub realtime_card { } #} elsif ( $options{'report_badcard'} ) { } else { - return "$processor error, invnum #". $self->invnum. ': '. - $transaction->result_code. ": ". $transaction->error_message; + + my $perror = "$processor error, invnum #". $self->invnum. ': '. + $transaction->result_code. ": ". $transaction->error_message; + + if ( $conf->exists('emaildecline') + && grep { $_ ne 'POST' } $cust_main->invoicing_list + ) { + my @templ = $conf->config('declinetemplate'); + my $template = new Text::Template ( + TYPE => 'ARRAY', + SOURCE => [ map "$_\n", @templ ], + ) or die "($perror) can't create template: $Text::Template::ERROR"; + $template->compile() + or die "($perror) can't compile template: $Text::Template::ERROR"; + + my $error = $transaction->error_message; + + #false laziness w/FS::cust_pay::delete & fs_signup_server && ::send + $ENV{MAILADDRESS} = $invoice_from; + my $header = new Mail::Header ( [ + "From: $invoice_from", + "To: ". join(', ', grep { $_ ne 'POST' } $cust_main->invoicing_list ), + "Sender: $invoice_from", + "Reply-To: $invoice_from", + "Date: ". time2str("%a, %d %b %Y %X %z", time), + "Subject: Your credit card could not be processed", + ] ); + my $message = new Mail::Internet ( + 'Header' => $header, + 'Body' => [ $template->fill_in() ], + ); + $!=0; + $message->smtpsend( Host => $smtpmachine ) + or $message->smtpsend( Host => $smtpmachine, Debug => 1 ) + or die "($perror) (customer # ". $self->custnum. + ") can't send card decline email to ". + join(', ', grep { $_ ne 'POST' } $cust_main->invoicing_list ). + " via server $smtpmachine with SMTP: $!"; + } + + return $perror; } } @@ -905,7 +944,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.27 2002-04-13 09:14:07 ivan Exp $ +$Id: cust_bill.pm,v 1.28 2002-04-16 09:38:19 ivan Exp $ =head1 BUGS diff --git a/FS/bin/freeside-expiration-alerter b/FS/bin/freeside-expiration-alerter index 365b96467..ee3c1fb92 100755 --- a/FS/bin/freeside-expiration-alerter +++ b/FS/bin/freeside-expiration-alerter @@ -142,7 +142,8 @@ foreach my $customer (@customers) ); $!=0; $message->smtpsend( Host => $smtpmachine ) - or die "Can't send expiration email!: $!"; #die? warn? + or $message->smtpsend( Host => $smtpmachine, Debug => 1 ) + or die "Can't send expiration email: $!"; } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) { push @body, sprintf(qq{%5d %-32.32s %4s %10s %12s %12s}, @@ -166,8 +167,8 @@ if (scalar(@body)) { $!=0; $message->smtpsend( Host => $smtpmachine ) or $message->smtpsend( Host => $smtpmachine, Debug => 1 ) - or return "can't send alerter failure email to $failure_recipient". - " via server $smtpmachine with SMTP: $!"; + or die "can't send alerter failure email to $failure_recipient". + " via server $smtpmachine with SMTP: $!"; } # subroutines @@ -199,7 +200,7 @@ user: From the mapsecrets file - see config.html from the base documentation =head1 VERSION -$Id: freeside-expiration-alerter,v 1.2 2002-03-07 19:50:24 jeff Exp $ +$Id: freeside-expiration-alerter,v 1.3 2002-04-16 09:38:19 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 4201aaaae8a957bc98ce345d3ee0e599da354766 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 16 Apr 2002 10:47:35 +0000 Subject: report on failed billing events... --- FS/FS/Conf.pm | 4 ++-- FS/FS/cust_bill.pm | 8 ++++---- FS/FS/cust_bill_event.pm | 11 +++++++++++ 3 files changed, 17 insertions(+), 6 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index dc1cbb820..6bcf9c43e 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -896,14 +896,14 @@ httemplate/docs/config.html }, { - 'key' => 'declinetemplate' + 'key' => 'declinetemplate', 'section' => 'billing', 'description' => 'Template file for credit card decline emails.', 'type' => 'textarea', }, { - 'key' => 'emaildecline' + 'key' => 'emaildecline', 'section' => 'billing', 'description' => 'Enable emailing of credit card decline notices.', 'type' => 'checkbox', diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index cb2aa4629..816553bda 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -582,9 +582,9 @@ sub realtime_card { my $template = new Text::Template ( TYPE => 'ARRAY', SOURCE => [ map "$_\n", @templ ], - ) or die "($perror) can't create template: $Text::Template::ERROR"; + ) or return "($perror) can't create template: $Text::Template::ERROR"; $template->compile() - or die "($perror) can't compile template: $Text::Template::ERROR"; + or return "($perror) can't compile template: $Text::Template::ERROR"; my $error = $transaction->error_message; @@ -605,7 +605,7 @@ sub realtime_card { $!=0; $message->smtpsend( Host => $smtpmachine ) or $message->smtpsend( Host => $smtpmachine, Debug => 1 ) - or die "($perror) (customer # ". $self->custnum. + or return "($perror) (customer # ". $self->custnum. ") can't send card decline email to ". join(', ', grep { $_ ne 'POST' } $cust_main->invoicing_list ). " via server $smtpmachine with SMTP: $!"; @@ -944,7 +944,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.28 2002-04-16 09:38:19 ivan Exp $ +$Id: cust_bill.pm,v 1.29 2002-04-16 10:47:34 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_bill_event.pm b/FS/FS/cust_bill_event.pm index 146a30e02..d5ca55f36 100644 --- a/FS/FS/cust_bill_event.pm +++ b/FS/FS/cust_bill_event.pm @@ -132,6 +132,17 @@ sub part_bill_event { qsearchs( 'part_bill_event', { 'eventpart' => $self->eventpart } ); } +=item cust_bill + +Returns the invoice (see L) for this completed invoice event. + +=cut + +sub cust_bill { + my $self = shift; + qsearchs( 'cust_bill', { 'invnum' => $self->invnum } ); +} + =back =head1 BUGS -- cgit v1.2.1 From 55dee0c595ea28dde3d2a30e1f238fc322e6e869 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 16 Apr 2002 21:24:45 +0000 Subject: auto-use export classes --- FS/bin/freeside-queued | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) (limited to 'FS') diff --git a/FS/bin/freeside-queued b/FS/bin/freeside-queued index f6226cca1..49b532ec3 100644 --- a/FS/bin/freeside-queued +++ b/FS/bin/freeside-queued @@ -100,6 +100,22 @@ while (1) { if $FS::svc_acct::icradius_dbh; forksuidsetup($user); + #auto-use export classes... + if ( $ljob->job =~ /(FS::part_export::\w+)::/ ) { + my $class = $1; + eval "use $class;"; + if ( $@ ) { + warn "job use $class failed"; + my %hash = $ljob->hash; + $hash{'status'} = 'failed'; + $hash{'statustext'} = $@; + my $fjob = new FS::queue( \%hash ); + my $error = $fjob->replace($ljob); + die $error if $error; + exit; #end-of-kid + }; + } + my $eval = "&". $ljob->job. '(@args);'; warn "running $eval"; eval $eval; #throw away return value? suppose so -- cgit v1.2.1 From 9fd7ef9a57a7eb49c310ae90f080bd0bcb4f1d6d Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 16 Apr 2002 22:38:04 +0000 Subject: eek, problem with authorize.net description field --- FS/FS/cust_bill.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 816553bda..68ef094e3 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -483,7 +483,7 @@ sub realtime_card { if ( $conf->exists('business-onlinepayment-description') ) { my $dtempl = $conf->config('business-onlinepayment-description'); - my $agent = $self->cust_main->agent->agent; + my $agent = $cust_main->agent->agent; my $pkgs = join(', ', map { $_->cust_pkg->part_pkg->pkg } grep { $_->pkgnum } $self->cust_bill_pkg @@ -944,7 +944,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.29 2002-04-16 10:47:34 ivan Exp $ +$Id: cust_bill.pm,v 1.30 2002-04-16 22:38:04 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 95a40a1b8ebf86c76784c220d0d561f952d934ef Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 16 Apr 2002 22:52:14 +0000 Subject: further authorize.net description debugging (agent??) and get rid of bad unique index on cust_bill_event --- FS/FS/Conf.pm | 2 +- FS/FS/cust_bill.pm | 5 +++-- 2 files changed, 4 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 6bcf9c43e..2a7a4c103 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -481,7 +481,7 @@ httemplate/docs/config.html { 'key' => 'defaultrecords', 'section' => 'BIND', - 'description' => 'DNS entries add automatically when creating a domain', + 'description' => 'DNS entries to add automatically when creating a domain', 'type' => 'editlist', 'editlist_parts' => [ { type=>'text' }, { type=>'immutable', value=>'IN' }, diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 68ef094e3..2c21f1e46 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -483,7 +483,8 @@ sub realtime_card { if ( $conf->exists('business-onlinepayment-description') ) { my $dtempl = $conf->config('business-onlinepayment-description'); - my $agent = $cust_main->agent->agent; + my $agent_obj = $cust_main->agent; + my $agent = $agent_obj->agent; my $pkgs = join(', ', map { $_->cust_pkg->part_pkg->pkg } grep { $_->pkgnum } $self->cust_bill_pkg @@ -944,7 +945,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.30 2002-04-16 22:38:04 ivan Exp $ +$Id: cust_bill.pm,v 1.31 2002-04-16 22:52:14 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From dcea1a8d60c672a36f82dfb9da3c86223f6fd740 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 16 Apr 2002 22:56:58 +0000 Subject: further debugging... --- FS/FS/cust_bill.pm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 2c21f1e46..a419ca8f9 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -483,7 +483,9 @@ sub realtime_card { if ( $conf->exists('business-onlinepayment-description') ) { my $dtempl = $conf->config('business-onlinepayment-description'); - my $agent_obj = $cust_main->agent; + my $agent_obj = $cust_main->agent + or die "can't retreive agent for $cust_main (agentnum ". + $cust_main->agentnum. ")"; my $agent = $agent_obj->agent; my $pkgs = join(', ', map { $_->cust_pkg->part_pkg->pkg } @@ -945,7 +947,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.31 2002-04-16 22:52:14 ivan Exp $ +$Id: cust_bill.pm,v 1.32 2002-04-16 22:56:58 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From d33826efa91645efc00dc8a20e8d0bda8f87ecbd Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 16 Apr 2002 23:14:30 +0000 Subject: there it is! fix bug with FS::cust_main::agent --- FS/FS/cust_main.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index fd1ccd772..66e032b0e 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -827,7 +827,7 @@ Returns the agent (see L) for this customer. sub agent { my $self = shift; - qsearchs( 'agent', { 'agent' => $self->agentnum } ); + qsearchs( 'agent', { 'agentnum' => $self->agentnum } ); } =item bill OPTIONS -- cgit v1.2.1 From 62afa0957fd72ec52e9a8defbdbcc796bd04fb82 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 17 Apr 2002 11:41:30 +0000 Subject: get rid of debugging cruft --- FS/FS/Record.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index cb42b266c..20da07e53 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -825,9 +825,9 @@ false. sub ut_text { my($self,$field)=@_; - warn "msgcat ". \&msgcat. "\n"; - warn "notexist ". \¬exist. "\n"; - warn "AUTOLOAD ". \&AUTOLOAD. "\n"; + #warn "msgcat ". \&msgcat. "\n"; + #warn "notexist ". \¬exist. "\n"; + #warn "AUTOLOAD ". \&AUTOLOAD. "\n"; $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/]+)$/ or return gettext('illegal_or_empty_text'). " $field: ". $self->getfield($field); -- cgit v1.2.1 From f03d05cfbcc04564f8ce40e798c3d1a49dba71d8 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 17 Apr 2002 19:47:17 +0000 Subject: allow = in ut_text --- FS/FS/Record.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 20da07e53..ed87b0c19 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -817,7 +817,7 @@ sub ut_money { =item ut_text COLUMN Check/untaint text. Alphanumerics, spaces, and the following punctuation -symbols are currently permitted: ! @ # $ % & ( ) - + ; : ' " , . ? / +symbols are currently permitted: ! @ # $ % & ( ) - + ; : ' " , . ? / = May not be null. If there is an error, returns the error, otherwise returns false. @@ -828,7 +828,7 @@ sub ut_text { #warn "msgcat ". \&msgcat. "\n"; #warn "notexist ". \¬exist. "\n"; #warn "AUTOLOAD ". \&AUTOLOAD. "\n"; - $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/]+)$/ + $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=]+)$/ or return gettext('illegal_or_empty_text'). " $field: ". $self->getfield($field); $self->setfield($field,$1); @@ -845,7 +845,7 @@ May be null. If there is an error, returns the error, otherwise returns false. sub ut_textn { my($self,$field)=@_; - $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/]*)$/ + $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=]*)$/ or return gettext('illegal_text'). " $field: ". $self->getfield($field); $self->setfield($field,$1); ''; -- cgit v1.2.1 From 6866bdda26d1feb152af991388113e2e9309fafb Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 17 Apr 2002 20:43:45 +0000 Subject: fix usergroup_delete DELETE syntax --- FS/FS/part_export/sqlradius.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm index fa2153f31..7337b5aa9 100644 --- a/FS/FS/part_export/sqlradius.pm +++ b/FS/FS/part_export/sqlradius.pm @@ -143,10 +143,10 @@ sub sqlradius_usergroup_delete { #subroutine, not method my( $username, @groups ) = @_; my $sth = $dbh->prepare( - "DELETE FROM usergroup ( id, UserName, GroupName ) VALUES ( ?, ?, ? )" + "DELETE FROM usergroup WHERE UserName = ? AND GroupName = ?" ) or die $dbh->errstr; foreach my $group ( @groups ) { - $sth->execute( '', $username, $group ) + $sth->execute( $username, $group ) or die "can't delete from groupname table: ". $sth->errstr; } $dbh->disconnect; -- cgit v1.2.1 From 98a73bb080f55f4f5d850102bcec6da2807e3d4f Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 19 Apr 2002 01:16:39 +0000 Subject: - add init file installation to Makefile, add unified init file - fix qsearch for op => '!=', value => '' searches - fix invalid_catd typo - add payby method to part_pkg and have fs_signup_server pass the data --- FS/FS/Record.pm | 20 +++++++++++++++++--- FS/FS/cust_main.pm | 4 ++-- FS/FS/part_pkg.pm | 24 +++++++++++++++++++++++- 3 files changed, 42 insertions(+), 6 deletions(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index ed87b0c19..ac8117e70 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -224,10 +224,24 @@ sub qsearch { } if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) { - if ( driver_name =~ /^Pg$/i ) { - qq-( $_ IS NULL OR $_ = '' )-; + if ( $op eq '=' ) { + if ( driver_name =~ /^Pg$/i ) { + qq-( $_ IS NULL OR $_ = '' )-; + } else { + qq-( $_ IS NULL OR $_ = "" )-; + } + } elsif ( $op eq '!=' ) { + if ( driver_name =~ /^Pg$/i ) { + qq-( $_ IS NOT NULL AND $_ != '' )-; + } else { + qq-( $_ IS NOT NULL AND $_ != "" )-; + } } else { - qq-( $_ IS NULL OR $_ = "" )-; + if ( driver_name =~ /^Pg$/i ) { + qq-( $_ $op '' )-; + } else { + qq-( $_ $op "" )-; + } } } else { "$_ $op ?"; diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 66e032b0e..445c6951a 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -644,11 +644,11 @@ sub check { my $payinfo = $self->payinfo; $payinfo =~ s/\D//g; $payinfo =~ /^(\d{13,16})$/ - or return gettext('invalid_catd'); # . ": ". $self->payinfo; + or return gettext('invalid_card'); # . ": ". $self->payinfo; $payinfo = $1; $self->payinfo($payinfo); validate($payinfo) - or return gettext('invalid_catd'); # . ": ". $self->payinfo; + or return gettext('invalid_card'); # . ": ". $self->payinfo; return gettext('unknown_card_type') if cardtype($self->payinfo) eq "Unknown"; diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index 00ce1d944..e8cc67713 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -262,11 +262,33 @@ sub svcpart { $pkg_svc[0]->svcpart; } +=item payby + +Returns a list of the acceptable payment types for this package. Eventually +this should come out of a database table and be editable, but currently has the +following logic instead; + +If the package has B<0> setup and B<0> recur, the single item B is +returned, otherwise, the single item B is returned. + +=cut + +sub payby { + my $self = shift; + #if ( $self->setup == 0 && $self->recur == 0 ) { + if ( $self->setup =~ /^\s*0+(\.0*)?\s*$/ + && $self->recur =~ /^\s*0+(\.0*)?\s*$/ ) { + ( 'BILL' ); + } else { + ( 'CARD' ); + } +} + =back =head1 VERSION -$Id: part_pkg.pm,v 1.9 2002-03-24 17:42:58 ivan Exp $ +$Id: part_pkg.pm,v 1.10 2002-04-19 01:16:39 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 1da06b18de4aee602da3fffb166da8d833343262 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 19 Apr 2002 14:27:34 +0000 Subject: add phone to Business::OnlinePayment usage --- FS/FS/cust_bill.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index a419ca8f9..63a70cd5b 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -518,6 +518,7 @@ sub realtime_card { 'expiration' => $exp, 'referer' => 'http://cleanwhisker.420.am/', 'email' => $email, + 'phone' => $cust_main->daytime || $cust_main->night, ); $transaction->submit(); @@ -947,7 +948,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.32 2002-04-16 22:56:58 ivan Exp $ +$Id: cust_bill.pm,v 1.33 2002-04-19 14:27:34 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 167292308b03b20e5e2ba790491ee28a3af85578 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 19 Apr 2002 23:25:54 +0000 Subject: maybe just for debugging --- FS/FS/svc_acct.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 7fcfd35df..d3c415ce3 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -531,11 +531,11 @@ sub check { my $ulen = $usernamemax || $self->dbdef_table->column('username')->length; if ( $username_uppercase ) { $recref->{username} =~ /^([a-z0-9_\-\.\&]{$usernamemin,$ulen})$/i - or return gettext('illegal_username'). ": ". $recref->{username}; + or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username}; $recref->{username} = $1; } else { $recref->{username} =~ /^([a-z0-9_\-\.\&]{$usernamemin,$ulen})$/ - or return gettext('illegal_username'). ": ". $recref->{username}; + or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username}; $recref->{username} = $1; } -- cgit v1.2.1 From e5f29642854dbdb606aa5763213e944ca449fc8a Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 20 Apr 2002 02:06:38 +0000 Subject: fix problem with edge case where there *is* a pkg_svc record with quantity 0, when changing packages and using the special case new service code --- FS/FS/cust_pkg.pm | 12 +++++++++--- FS/FS/cust_svc.pm | 6 +++++- 2 files changed, 14 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index f858a999d..0fc21478a 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -577,7 +577,9 @@ sub order { push @cust_svc, [ map { ( $svcnum{$_} && @{ $svcnum{$_} } ) ? shift @{ $svcnum{$_} } : (); - } map { $_->svcpart } qsearch('pkg_svc', { 'pkgpart' => $pkgpart }) + } map { $_->svcpart } + qsearch('pkg_svc', { pkgpart => $pkgpart, + quantity => { op=>'>', value=>'0', } } ) ]; } @@ -597,7 +599,11 @@ sub order { #find an empty place to put one my $i = 0; foreach my $pkgpart ( @{$pkgparts} ) { - my @pkg_svc = qsearch('pkg_svc', { pkgpart=>$pkgpart } ); + my @pkg_svc = + qsearch('pkg_svc', { pkgpart => $pkgpart, + quantity => { op=>'>', value=>'0', } } ); + #my @pkg_svc = + # grep { $_->quantity > 0 } qsearch('pkg_svc', { pkgpart=>$pkgpart } ); if ( ! @{$cust_svc[$i]} #find an empty place to put them with && grep { $svcdb eq $_->part_svc->svcdb } #with appropriate svcdb @pkg_svc @@ -689,7 +695,7 @@ sub order { =head1 VERSION -$Id: cust_pkg.pm,v 1.17 2002-04-12 15:14:58 ivan Exp $ +$Id: cust_pkg.pm,v 1.18 2002-04-20 02:06:38 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index 23a3980ef..e6194b5b7 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -159,6 +159,10 @@ sub check { 'pkgpart' => $cust_pkg->pkgpart, 'svcpart' => $self->svcpart, }); + # or new FS::pkg_svc ( { 'pkgpart' => $cust_pkg->pkgpart, + # 'svcpart' => $self->svcpart, + # 'quantity' => 0 } ); + my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $self->pkgnum, 'svcpart' => $self->svcpart, @@ -282,7 +286,7 @@ sub seconds_since { =head1 VERSION -$Id: cust_svc.pm,v 1.13 2002-04-12 15:14:58 ivan Exp $ +$Id: cust_svc.pm,v 1.14 2002-04-20 02:06:38 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 0da1c2b1d5dbe10b304d131f6807b18a237b5d45 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 20 Apr 2002 10:09:42 +0000 Subject: allow uppercase zones... --- FS/FS/domain_record.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/domain_record.pm b/FS/FS/domain_record.pm index 0f634bff3..9f0035689 100644 --- a/FS/FS/domain_record.pm +++ b/FS/FS/domain_record.pm @@ -107,7 +107,7 @@ sub check { return "Unknown svcnum (in svc_domain)" unless qsearchs('svc_domain', { 'svcnum' => $self->svcnum } ); - $self->reczone =~ /^(@|[a-z0-9\.\-]+)$/ + $self->reczone =~ /^(@|[a-zA-Z0-9\.\-]+)$/ or return "Illegal reczone: ". $self->reczone; $self->reczone($1); @@ -156,7 +156,7 @@ sub check { =head1 VERSION -$Id: domain_record.pm,v 1.3 2001-08-21 02:44:47 ivan Exp $ +$Id: domain_record.pm,v 1.4 2002-04-20 10:09:42 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 01d8a89e66c00077619e408ce8a79f847e32214c Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 20 Apr 2002 10:12:26 +0000 Subject: allow uppercase in zone data. --- FS/FS/domain_record.pm | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) (limited to 'FS') diff --git a/FS/FS/domain_record.pm b/FS/FS/domain_record.pm index 9f0035689..23955b62e 100644 --- a/FS/FS/domain_record.pm +++ b/FS/FS/domain_record.pm @@ -107,7 +107,7 @@ sub check { return "Unknown svcnum (in svc_domain)" unless qsearchs('svc_domain', { 'svcnum' => $self->svcnum } ); - $self->reczone =~ /^(@|[a-zA-Z0-9\.\-]+)$/ + $self->reczone =~ /^(@|[a-z0-9\.\-]+)$/i or return "Illegal reczone: ". $self->reczone; $self->reczone($1); @@ -122,15 +122,15 @@ sub check { if ( $self->rectype eq 'SOA' ) { my $recdata = $self->recdata; $recdata =~ s/\s+/ /g; - $recdata =~ /^([a-z0-9\.\-]+ [\w\-\+]+\.[a-z0-9\.\-]+ \( (\d+ ){5}\))$/ + $recdata =~ /^([a-z0-9\.\-]+ [\w\-\+]+\.[a-z0-9\.\-]+ \( (\d+ ){5}\))$/i or return "Illegal data for SOA record: $recdata"; $self->recdata($1); } elsif ( $self->rectype eq 'NS' ) { - $self->recdata =~ /^([a-z0-9\.\-]+)$/ + $self->recdata =~ /^([a-z0-9\.\-]+)$/i or return "Illegal data for NS record: ". $self->recdata; $self->recdata($1); } elsif ( $self->rectype eq 'MX' ) { - $self->recdata =~ /^(\d+)\s+([a-z0-9\.\-]+)$/ + $self->recdata =~ /^(\d+)\s+([a-z0-9\.\-]+)$/i or return "Illegal data for MX record: ". $self->recdata; $self->recdata("$1 $2"); } elsif ( $self->rectype eq 'A' ) { @@ -138,11 +138,11 @@ sub check { or return "Illegal data for A record: ". $self->recdata; $self->recdata($1); } elsif ( $self->rectype eq 'PTR' ) { - $self->recdata =~ /^([a-z0-9\.\-]+)$/ + $self->recdata =~ /^([a-z0-9\.\-]+)$/i or return "Illegal data for PTR record: ". $self->recdata; $self->recdata($1); } elsif ( $self->rectype eq 'CNAME' ) { - $self->recdata =~ /^([a-z0-9\.\-]+)$/ + $self->recdata =~ /^([a-z0-9\.\-]+)$/i or return "Illegal data for CNAME record: ". $self->recdata; $self->recdata($1); } else { @@ -156,7 +156,7 @@ sub check { =head1 VERSION -$Id: domain_record.pm,v 1.4 2002-04-20 10:09:42 ivan Exp $ +$Id: domain_record.pm,v 1.5 2002-04-20 10:12:26 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From cb63b8c06cdf912ce61b4b459a238dadfd9c64fc Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 20 Apr 2002 10:49:33 +0000 Subject: allow * MX records --- FS/FS/domain_record.pm | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/domain_record.pm b/FS/FS/domain_record.pm index 23955b62e..24db4c2f4 100644 --- a/FS/FS/domain_record.pm +++ b/FS/FS/domain_record.pm @@ -107,7 +107,7 @@ sub check { return "Unknown svcnum (in svc_domain)" unless qsearchs('svc_domain', { 'svcnum' => $self->svcnum } ); - $self->reczone =~ /^(@|[a-z0-9\.\-]+)$/i + $self->reczone =~ /^(@|[a-z0-9\.\-\*]+)$/i or return "Illegal reczone: ". $self->reczone; $self->reczone($1); @@ -119,6 +119,9 @@ sub check { $self->rectype; $self->rectype($1); + return "Illegal reczone for ". $self->rectype. ": ". $self->reczone + if $self->rectype !~ /^MX$/i && $self->reczone =~ /\*/; + if ( $self->rectype eq 'SOA' ) { my $recdata = $self->recdata; $recdata =~ s/\s+/ /g; @@ -156,7 +159,7 @@ sub check { =head1 VERSION -$Id: domain_record.pm,v 1.5 2002-04-20 10:12:26 ivan Exp $ +$Id: domain_record.pm,v 1.6 2002-04-20 10:49:33 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 4d5485150720c91d9945c3ae3cad9427ece23833 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 20 Apr 2002 11:57:36 +0000 Subject: working BIND import --- FS/FS/domain_record.pm | 7 +++++-- FS/FS/part_export.pm | 7 ++++++- 2 files changed, 11 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/domain_record.pm b/FS/FS/domain_record.pm index 24db4c2f4..6f4dd0287 100644 --- a/FS/FS/domain_record.pm +++ b/FS/FS/domain_record.pm @@ -114,7 +114,7 @@ sub check { $self->recaf =~ /^(IN)$/ or return "Illegal recaf: ". $self->recaf; $self->recaf($1); - $self->rectype =~ /^(SOA|NS|MX|A|PTR|CNAME)$/ + $self->rectype =~ /^(SOA|NS|MX|A|PTR|CNAME|_mstr)$/ or return "Illegal rectype (only SOA NS MX A PTR CNAME recognized): ". $self->rectype; $self->rectype($1); @@ -148,6 +148,9 @@ sub check { $self->recdata =~ /^([a-z0-9\.\-]+)$/i or return "Illegal data for CNAME record: ". $self->recdata; $self->recdata($1); + } elsif ( $self->rectype eq '_mstr' ) { + $self->recdata =~ /^((\d{1,3}\.){3}\d{1,3})$/ + or return "Illegal data for _master pseudo-record: ". $self->recdata; } else { die "ack!"; } @@ -159,7 +162,7 @@ sub check { =head1 VERSION -$Id: domain_record.pm,v 1.6 2002-04-20 10:49:33 ivan Exp $ +$Id: domain_record.pm,v 1.7 2002-04-20 11:57:35 ivan Exp $ =head1 BUGS diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 406b270ed..49e21307b 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -580,7 +580,12 @@ sub exporttype2svcdb { }, - 'svc_domain' => {}, + 'svc_domain' => { + 'bind' => 'Batch export to BIND named', + 'options' => { + }, + 'notes' => 'bind export notes', + }, 'svc_acct_sm' => {}, -- cgit v1.2.1 From ffe9f4473c5c9c7cb7caeaa5b39160d7b3e8d137 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 20 Apr 2002 12:37:23 +0000 Subject: bind export --- FS/FS/part_export.pm | 32 +++++++++++++++++++++++++++----- 1 file changed, 27 insertions(+), 5 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 49e21307b..d1148fa0a 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -472,6 +472,7 @@ sub exporttype2svcdb { ''; } +#export names cannot have dashes... %exports = ( 'svc_acct' => { 'sysvshell' => { @@ -494,9 +495,9 @@ sub exporttype2svcdb { }, 'shellcommands' => { - 'desc' => 'Real-time export via arbitrary commands on a remote machine (i.e. useradd, userdel, etc.)', + 'desc' => 'Real-time export via remote SSH (i.e. useradd, userdel, etc.)', 'options' => { - 'machine' => { label=>'Remote machine' }, + #'machine' => { label=>'Remote machine' }, 'user' => { label=>'Remote username', default=>'root' }, 'useradd' => { label=>'Insert command', default=>'useradd -d $dir -m -s $shell -u $uid $username' @@ -581,10 +582,31 @@ sub exporttype2svcdb { }, 'svc_domain' => { - 'bind' => 'Batch export to BIND named', - 'options' => { + + 'bind' => { + 'desc' =>'Batch export to BIND named', + 'options' => { + #'machine' => { label=>'named machine' }, + 'named_conf' => { label => 'named.conf location', + default=> '/etc/bind/named.conf' }, + 'zonepath' => { label => 'path to zone files', + default=> '/etc/bind/', }, + }, + 'notes' => 'bind export notes', }, - 'notes' => 'bind export notes', + + 'bind_slave' => { + 'desc' =>'Batch export to slave BIND named', + 'options' => { + #'machine' => { label=> 'Slave machine' }, + 'master' => { label=> 'Master IP address' }, + 'named_conf' => { label => 'named.conf location', + default=> '/etc/bind/named.conf' }, + }, + 'notes' => 'bind export notes (secondary munge)', + }, + + }, 'svc_acct_sm' => {}, -- cgit v1.2.1 From 6fa9f6fe4cd0b090ea1f0b6236a00241070d0bdc Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 22 Apr 2002 20:47:21 +0000 Subject: - check agentnum ability to order packages in FS::cust_pkg, not signup server - order by recur price in signup-alternate template --- FS/FS/cust_pkg.pm | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 0fc21478a..b7633c196 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -139,7 +139,13 @@ sub insert { my $error = $self->ut_number('custnum'); return $error if $error; - return "Unknown customer ". $self->custnum unless $self->cust_main; + my $cust_main = $self->cust_main; + return "Unknown customer ". $self->custnum unless $cust_main; + + my $agent = qsearchs( 'agent', { 'agentnum' => $cust_main->agentnum } ); + my $pkgpart_href = $agent->pkgpart_hashref; + return "agent ". $agent->agentnum. " can't purchase pkgpart ". $self->pkgpart + unless $pkgpart_href->{ $self->{pkgpart} }; $self->SUPER::insert; @@ -695,7 +701,7 @@ sub order { =head1 VERSION -$Id: cust_pkg.pm,v 1.18 2002-04-20 02:06:38 ivan Exp $ +$Id: cust_pkg.pm,v 1.19 2002-04-22 20:47:21 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 280ec2e44b48809e0e0a472b31cfa49adce52d5c Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 22 Apr 2002 21:23:16 +0000 Subject: fix bug checking agents allowed to purchase packages (moved from signups server) --- FS/FS/cust_pkg.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index b7633c196..08c04a06b 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -145,7 +145,7 @@ sub insert { my $agent = qsearchs( 'agent', { 'agentnum' => $cust_main->agentnum } ); my $pkgpart_href = $agent->pkgpart_hashref; return "agent ". $agent->agentnum. " can't purchase pkgpart ". $self->pkgpart - unless $pkgpart_href->{ $self->{pkgpart} }; + unless $pkgpart_href->{ $self->pkgpart }; $self->SUPER::insert; @@ -701,7 +701,7 @@ sub order { =head1 VERSION -$Id: cust_pkg.pm,v 1.19 2002-04-22 20:47:21 ivan Exp $ +$Id: cust_pkg.pm,v 1.20 2002-04-22 21:23:16 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 3bc29c4f296049c223ded80aa69831b1db1ac428 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 22 Apr 2002 21:36:05 +0000 Subject: don't show extended debugging in error messages that could end up on the signup server --- FS/FS/cust_main.pm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 445c6951a..6fefe0db3 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -256,7 +256,8 @@ sub insert { my $error = $self->SUPER::insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "inserting cust_main record (transaction rolled back): $error"; + #return "inserting cust_main record (transaction rolled back): $error"; + return $error; } if ( @param ) { # CUST_PKG_HASHREF @@ -277,7 +278,8 @@ sub insert { $error = $svc_something->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "inserting svc_ (transaction rolled back): $error"; + #return "inserting svc_ (transaction rolled back): $error"; + return $error; } } } -- cgit v1.2.1 From b9c0e290993085518e2bae5fae90cff7e9f91974 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 22 Apr 2002 22:45:34 +0000 Subject: use Tie::IxHash to present export options in a reasonable order --- FS/FS/part_export.pm | 149 +++++++++++++++++++++++++++++---------------------- 1 file changed, 85 insertions(+), 64 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index d1148fa0a..e3b2eb3fc 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -3,6 +3,7 @@ package FS::part_export; use strict; use vars qw( @ISA @EXPORT_OK %exports ); use Exporter; +use Tie::IxHash; use FS::Record qw( qsearch qsearchs dbh ); use FS::part_svc; use FS::part_export_option; @@ -472,6 +473,80 @@ sub exporttype2svcdb { ''; } +tie my %shellcommands_options, 'Tie::IxHash', + #'machine' => { label=>'Remote machine' }, + 'user' => { label=>'Remote username', default=>'root' }, + 'useradd' => { label=>'Insert command', + default=>'useradd -d $dir -m -s $shell -u $uid $username' + #default=>'cp -pr /etc/skel $dir; chown -R $uid.$gid $dir' + }, + 'userdel' => { label=>'Delete command', + default=>'userdel $username', + #default=>'rm -rf $dir', + }, + 'usermod' => { label=>'Modify command', + default=>'usermod -d $new_dir -l $new_username -s $new_shell -u $new_uid $old_username', + #default=>'[ -d $old_dir ] && mv $old_dir $new_dir || ( '. + # 'chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; '. + # 'find . -depth -print | cpio -pdm $new_dir; '. + # 'chmod u-t $new_dir; chown -R $uid.$gid $new_dir; '. + # 'rm -rf $old_dir'. + #')' + }, +; + +tie my %sqlradius_options, 'Tie::IxHash', + 'datasrc' => { label=>'DBI data source' }, + 'username' => { label=>'Database username' }, + 'password' => { label=>'Database password' }, +; + +tie my %cyrus_options, 'Tie::IxHash', + 'server' => { label=>'IMAP server' }, + 'username' => { label=>'Admin username' }, + 'password' => { label=>'Admin password' }, +; + +tie my %cp_options, 'Tie::IxHash', + 'host' => { label=>'Hostname' }, + 'port' => { label=>'Port number' }, + 'username' => { label=>'Username' }, + 'password' => { label=>'Password' }, + 'domain' => { label=>'Domain' }, + 'workgroup' => { label=>'Default Workgroup' }, +; + +tie my %infostreet_options, 'Tie::IxHash', + 'url' => { label=>'XML-RPC Access URL', }, + 'login' => { label=>'InfoStreet login', }, + 'password' => { label=>'InfoStreet password', }, + 'groupID' => { label=>'InfoStreet groupID', }, +; + +tie my %vpopmail_options, 'Tie::IxHash', + 'machine' => { label=>'vpopmail machine', }, + 'dir' => { label=>'directory', }, # ?more info? default? + 'uid' => { label=>'vpopmail uid' }, + 'gid' => { label=>'vpopmail gid' }, +; + +tie my %bind_options, 'Tie::IxHash', + #'machine' => { label=>'named machine' }, + 'named_conf' => { label => 'named.conf location', + default=> '/etc/bind/named.conf' }, + 'zonepath' => { label => 'path to zone files', + default=> '/etc/bind/', }, +; + +tie my %bind_slave_options, 'Tie::IxHash', + #'machine' => { label=> 'Slave machine' }, + 'master' => { label=> 'Master IP address' }, + 'named_conf' => { label => 'named.conf location', + default=> '/etc/bind/named.conf' }, +; + + + #export names cannot have dashes... %exports = ( 'svc_acct' => { @@ -492,90 +567,47 @@ sub exporttype2svcdb { # }, 'textradius' => { 'desc' => 'Batch export of a text /etc/raddb/users file (Livingston, Cistron)', + 'options' => {}, }, 'shellcommands' => { 'desc' => 'Real-time export via remote SSH (i.e. useradd, userdel, etc.)', - 'options' => { - #'machine' => { label=>'Remote machine' }, - 'user' => { label=>'Remote username', default=>'root' }, - 'useradd' => { label=>'Insert command', - default=>'useradd -d $dir -m -s $shell -u $uid $username' - #default=>'cp -pr /etc/skel $dir; chown -R $uid.$gid $dir' - }, - 'userdel' => { label=>'Delete command', - default=>'userdel $username', - #default=>'rm -rf $dir', - }, - 'usermod' => { label=>'Modify command', - default=>'usermod -d $new_dir -l $new_username -s $new_shell -u $new_uid $old_username', - #default=>'[ -d $old_dir ] && mv $old_dir $new_dir || ( '. - # 'chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; '. - # 'find . -depth -print | cpio -pdm $new_dir; '. - # 'chmod u-t $new_dir; chown -R $uid.$gid $new_dir; '. - # 'rm -rf $old_dir'. - #')' - }, - }, + 'options' => \%shellcommands_options, 'nodomain' => 'Y', 'notes' => 'shellcommandsnotes... (this one is the nodomain one)', }, 'sqlradius' => { 'desc' => 'Real-time export to SQL-backed RADIUS (ICRADIUS, FreeRADIUS)', - 'options' => { - 'datasrc' => { label=>'DBI data source' }, - 'username' => { label=>'Database username' }, - 'password' => { label=>'Database password' }, - }, + 'options' => \%sqlradius_options, 'nodomain' => 'Y', 'notes' => 'Real-time export of radcheck, radreply and usergroup tables to any SQL database for FreeRADIUS or ICRADIUS. Use freeside-sqlradius-reset to delete and repopulate the tables from the Freeside database.', }, 'cyrus' => { 'desc' => 'Real-time export to Cyrus IMAP server', - 'options' => { - 'server' => { label=>'IMAP server' }, - 'username' => { label=>'Admin username' }, - 'password' => { label=>'Admin password' }, - }, + 'options' => \%cyrus_options, 'nodomain' => 'Y', 'notes' => 'Integration with Cyrus IMAP Server. Cyrus::IMAP::Admin should be installed locally and the connection to the server secured. svc_acct.quota, if available, is used to set the Cyrus quota. ' }, 'cp' => { 'desc' => 'Real-time export to Critical Path Account Provisioning Protocol', - 'options' => { - 'host' => { label=>'Hostname' }, - 'port' => { label=>'Port number' }, - 'username' => { label=>'Username' }, - 'password' => { label=>'Password' }, - 'domain' => { label=>'Domain' }, - 'workgroup' => { label=>'Default Workgroup' }, - }, + 'options' => \%cp_options, 'notes' => 'Real-time export to Critial Path Account Provisioning Protocol. Requires installation of Net::APP from CPAN.', }, 'infostreet' => { 'desc' => 'Real-time export to InfoStreet streetSmartAPI', - 'options' => { - 'url' => { label=>'XML-RPC Access URL', }, - 'login' => { label=>'InfoStreet login', }, - 'password' => { label=>'InfoStreet password', }, - 'groupID' => { label=>'InfoStreet groupID', }, - }, + 'options' => \%infostreet_options, 'nodomain' => 'Y', 'notes' => 'Real-time export to InfoStreet streetSmartAPI. Requires installation of Frontier::Client from CPAN.', }, 'vpopmail' => { 'desc' => 'Real-time export to vpopmail text files', - 'options' => { - 'machine' => { label=>'vpopmail machine', }, - 'dir' => { label=>'directory', }, # ?more info? default? - 'uid' => { label=>'vpopmail uid' }, - 'gid' => { label=>'vpopmail gid' }, - }, + 'options' => \%vpopmail_options, + 'notes' => 'Real time export to vpopmail text files (...extended description from jeff?...)', }, @@ -585,24 +617,13 @@ sub exporttype2svcdb { 'bind' => { 'desc' =>'Batch export to BIND named', - 'options' => { - #'machine' => { label=>'named machine' }, - 'named_conf' => { label => 'named.conf location', - default=> '/etc/bind/named.conf' }, - 'zonepath' => { label => 'path to zone files', - default=> '/etc/bind/', }, - }, + 'options' => \%bind_options, 'notes' => 'bind export notes', }, 'bind_slave' => { 'desc' =>'Batch export to slave BIND named', - 'options' => { - #'machine' => { label=> 'Slave machine' }, - 'master' => { label=> 'Master IP address' }, - 'named_conf' => { label => 'named.conf location', - default=> '/etc/bind/named.conf' }, - }, + 'options' => \%bind_slave_options, 'notes' => 'bind export notes (secondary munge)', }, -- cgit v1.2.1 From 62403391487a8e2d1518fa850ea27f15d466882b Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 23 Apr 2002 07:10:19 +0000 Subject: fixes inserting strings that end in numbers to TEXT columns... gah i hate SQL --- FS/FS/Record.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index ac8117e70..f7c3a41c8 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -1155,7 +1155,7 @@ sub _quote { my($dbh)=dbh; if ( $value =~ /^\d+(\.\d+)?$/ && # ! ( datatype($table,$field) =~ /^char/ ) - ! ( $dbdef->table($table)->column($field)->type =~ /(char|binary)$/i ) + ! $dbdef->table($table)->column($field)->type =~ /(char|binary|text)$/i ) { $value; } else { -- cgit v1.2.1 From f3d48cda02218523b2cafcc3c3edfe5771d8676e Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 24 Apr 2002 09:03:37 +0000 Subject: msgcat error for credit card expiration (closes: Bug#407) --- FS/FS/cust_main.pm | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 6fefe0db3..4a6a95251 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -683,11 +683,10 @@ sub check { } else { $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ or return "Illegal expiration date: ". $self->paydate; - if ( length($2) == 4 ) { - $self->paydate("$2-$1-01"); - } else { - $self->paydate("20$2-$1-01"); - } + my $y = length($2) == 4 ? $2 : "20$2"; + $self->paydate("$y-$1-01"); + my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900; + return gettext('expired_card') if $y<$nowy || ( $y==$nowy && $1<$nowm ); } if ( $self->payname eq '' ) { -- cgit v1.2.1 From 70e1035b6a95d2bb0b2bacc4316e9d0a973db813 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 24 Apr 2002 09:09:36 +0000 Subject: require_cardname option --- FS/FS/Conf.pm | 7 +++++++ FS/FS/cust_main.pm | 2 +- 2 files changed, 8 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 2a7a4c103..3565be965 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -909,6 +909,13 @@ httemplate/docs/config.html 'type' => 'checkbox', }, + { + 'key' => 'require_cardname', + 'section' => 'billing', + 'description' => 'Require an "Exact name on card" to be entered explicitly; don\'t default to using the first and last name.', + 'type' => 'checkbox', + }, + ); 1; diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 4a6a95251..64e9b5f91 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -689,7 +689,7 @@ sub check { return gettext('expired_card') if $y<$nowy || ( $y==$nowy && $1<$nowm ); } - if ( $self->payname eq '' ) { + if ( $self->payname eq '' && ! $conf->exists('require_cardname') ) { $self->payname( $self->first. " ". $self->getfield('last') ); } else { $self->payname =~ /^([\w \,\.\-\']+)$/ -- cgit v1.2.1 From b5124265c3f3781d0f961b836cbf674fde12ce54 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 25 Apr 2002 01:15:33 +0000 Subject: don't require_cardname for non-CARD payby's --- FS/FS/cust_main.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 64e9b5f91..4316988ca 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -689,7 +689,8 @@ sub check { return gettext('expired_card') if $y<$nowy || ( $y==$nowy && $1<$nowm ); } - if ( $self->payname eq '' && ! $conf->exists('require_cardname') ) { + if ( $self->payname eq '' && + ( ! $conf->exists('require_cardname') || $self->payby ne 'CARD' ) ) { $self->payname( $self->first. " ". $self->getfield('last') ); } else { $self->payname =~ /^([\w \,\.\-\']+)$/ -- cgit v1.2.1 From a351f58cf394121aa1f72139356567c4785bf47f Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 25 Apr 2002 09:47:25 +0000 Subject: add flat_delayed plan --- FS/FS/part_pkg.pm | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index e8cc67713..0cb766eef 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -59,6 +59,8 @@ inherits from FS::Record. The following fields are currently supported: =item recurtax - Recurring fee tax exempt flag, empty or `Y' +=item taxclass - Texas tax class flag, empty or "none", "access", or "hosting" + =item plan - Price plan =item plandata - Price plan data @@ -196,6 +198,8 @@ sub check { $r =~ /^\s*\d*\.?\d*\s*$/ + or $r =~ /^\$sdate += 86400 \* \s*\d+\s*; \s*\d*\.?\d*\s*$/ + or $r =~ /^my \$mnow = \$sdate; my \(\$sec,\$min,\$hour,\$mday,\$mon,\$year\) = \(localtime\(\$sdate\) \)\[0,1,2,3,4,5\]; my \$mstart = timelocal\(0,0,0,1,\$mon,\$year\); my \$mend = timelocal\(0,0,0,1, \$mon == 11 \? 0 : \$mon\+1, \$year\+\(\$mon==11\)\); \$sdate = \$mstart; \( \$part_pkg->freq \- 1 \) \* \d*\.?\d* \/ \$part_pkg\-\>freq \+ \d*\.?\d* \/ \$part_pkg\-\>freq \* \(\$mend\-\$mnow\) \/ \(\$mend\-\$mstart\) ;\s*$/ or $r =~ /^my \$mnow = \$sdate; my \(\$sec,\$min,\$hour,\$mday,\$mon,\$year\) = \(localtime\(\$sdate\) \)\[0,1,2,3,4,5\]; \$sdate = timelocal\(0,0,0,1,\$mon,\$year\); \s*\d*\.?\d*\s*;\s*$/ @@ -227,6 +231,7 @@ sub check { || $self->ut_anything('plandata') || $self->ut_enum('setuptax', [ '', 'Y' ] ) || $self->ut_enum('recurtax', [ '', 'Y' ] ) + || $self->ut_enum('texastax', [ '', 'none', 'access', 'hosting' ] ) || $self->ut_enum('disabled', [ '', 'Y' ] ) ; } @@ -288,7 +293,7 @@ sub payby { =head1 VERSION -$Id: part_pkg.pm,v 1.10 2002-04-19 01:16:39 ivan Exp $ +$Id: part_pkg.pm,v 1.11 2002-04-25 09:47:25 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 2a22a4862979750c1886ac8f125043854be47d58 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 25 Apr 2002 10:37:08 +0000 Subject: free_delayed try #2 --- FS/FS/part_pkg.pm | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index 0cb766eef..8ab8ad452 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -189,16 +189,20 @@ sub check { my $s = $self->setup; - $s =~ /^\s*\d*\.?\d*\s*$/ or do { - #log! - return "illegal setup: $s"; - }; + $s =~ /^\s*\d*\.?\d*\s*$/ + + or $s =~ /^my \$d = \$cust_pkg->bill || \$time; \$d += 86400 \* \s*\d+\s*; \$cust_pkg->bill\(\$d\); \$cust_pkg_mod_flag=1; \s*\d*\.?\d*\s*$/ + + or do { + #log! + return "illegal setup: $s"; + }; my $r = $self->recur; $r =~ /^\s*\d*\.?\d*\s*$/ - or $r =~ /^\$sdate += 86400 \* \s*\d+\s*; \s*\d*\.?\d*\s*$/ + #or $r =~ /^\$sdate += 86400 \* \s*\d+\s*; \s*\d*\.?\d*\s*$/ or $r =~ /^my \$mnow = \$sdate; my \(\$sec,\$min,\$hour,\$mday,\$mon,\$year\) = \(localtime\(\$sdate\) \)\[0,1,2,3,4,5\]; my \$mstart = timelocal\(0,0,0,1,\$mon,\$year\); my \$mend = timelocal\(0,0,0,1, \$mon == 11 \? 0 : \$mon\+1, \$year\+\(\$mon==11\)\); \$sdate = \$mstart; \( \$part_pkg->freq \- 1 \) \* \d*\.?\d* \/ \$part_pkg\-\>freq \+ \d*\.?\d* \/ \$part_pkg\-\>freq \* \(\$mend\-\$mnow\) \/ \(\$mend\-\$mstart\) ;\s*$/ @@ -293,7 +297,7 @@ sub payby { =head1 VERSION -$Id: part_pkg.pm,v 1.11 2002-04-25 09:47:25 ivan Exp $ +$Id: part_pkg.pm,v 1.12 2002-04-25 10:37:08 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From da1388d2f8196c2240ad0bc5debc925618d71806 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 26 Apr 2002 11:14:37 +0000 Subject: add username-nounderscore and username-nodash config files --- FS/FS/Conf.pm | 14 ++++++++++++++ FS/FS/svc_acct.pm | 11 ++++++++++- 2 files changed, 24 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 3565be965..6e45ec052 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -778,6 +778,20 @@ httemplate/docs/config.html 'type' => 'checkbox', }, + { + 'key' => 'username-nounderscore', + 'section' => 'username', + 'description' => 'Disallow underscores in usernames', + 'type' => 'checkbox', + }, + + { + 'key' => 'username-nodash', + 'section' => 'username', + 'description' => 'Disallow dashes in usernames', + 'type' => 'checkbox', + }, + { 'key' => 'username-uppercase', 'section' => 'username', diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index d3c415ce3..bb8c5e21e 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -5,7 +5,8 @@ use vars qw( @ISA $noexport_hack $conf $dir_prefix @shells $usernamemin $usernamemax $passwordmin $passwordmax $username_ampersand $username_letter $username_letterfirst - $username_noperiod $username_uppercase + $username_noperiod $username_nounderscore $username_nodash + $username_uppercase $mydomain $dirhash @saltset @pw_set ); @@ -40,6 +41,8 @@ $FS::UID::callback{'FS::svc_acct'} = sub { $username_letter = $conf->exists('username-letter'); $username_letterfirst = $conf->exists('username-letterfirst'); $username_noperiod = $conf->exists('username-noperiod'); + $username_nounderscore = $conf->exists('username-nounderscore'); + $username_nodash = $conf->exists('username-nodash'); $username_uppercase = $conf->exists('username-uppercase'); $username_ampersand = $conf->exists('username-ampersand'); $mydomain = $conf->config('domain'); @@ -547,6 +550,12 @@ sub check { if ( $username_noperiod ) { $recref->{username} =~ /\./ and return gettext('illegal_username'); } + if ( $username_nounderscore ) { + $recref->{username} =~ /_/ and return gettext('illegal_username'); + } + if ( $username_nodash ) { + $recref->{username} =~ /\-/ and return gettext('illegal_username'); + } unless ( $username_ampersand ) { $recref->{username} =~ /\&/ and return gettext('illegal_username'); } -- cgit v1.2.1 From f363d77173f26ec00eb72ecd9a54374831e04dd0 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 30 Apr 2002 05:43:34 +0000 Subject: better BIND integration --- FS/FS/part_export.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index e3b2eb3fc..752bbb1d3 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -540,9 +540,9 @@ tie my %bind_options, 'Tie::IxHash', tie my %bind_slave_options, 'Tie::IxHash', #'machine' => { label=> 'Slave machine' }, - 'master' => { label=> 'Master IP address' }, - 'named_conf' => { label => 'named.conf location', - default=> '/etc/bind/named.conf' }, + 'master' => { label=> 'Master IP address(s) (semicolon-separated)' }, + 'named_conf' => { label => 'named.conf location', + default => '/etc/bind/named.conf' }, ; -- cgit v1.2.1 From 99230201dec5366bf58b33b29fb2f7ab4724b764 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 4 May 2002 00:47:24 +0000 Subject: prevent stuff passed from template/user from being used in searches by signup server --- FS/FS/cust_pkg.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 08c04a06b..a4256ea1f 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -225,7 +225,7 @@ sub check { return "Unknown customer ". $self->custnum unless $self->cust_main; } - return "Unknown pkgpart" + return "Unknown pkgpart: ". $self->pkgpart unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } ); $self->otaker(getotaker) unless $self->otaker; @@ -701,7 +701,7 @@ sub order { =head1 VERSION -$Id: cust_pkg.pm,v 1.20 2002-04-22 21:23:16 ivan Exp $ +$Id: cust_pkg.pm,v 1.21 2002-05-04 00:47:24 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From f36b6a178c9811357ff5d5291874aa239d22bc2a Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 4 May 2002 15:00:18 +0000 Subject: schema changes for proper texas tax --- FS/FS.pm | 2 + FS/FS/cust_main_county.pm | 8 +++ FS/FS/cust_tax_exempt.pm | 131 ++++++++++++++++++++++++++++++++++++++++++++++ FS/FS/part_pkg.pm | 4 +- FS/MANIFEST | 2 + FS/t/cust_tax_exempt.pm | 5 ++ 6 files changed, 150 insertions(+), 2 deletions(-) create mode 100644 FS/FS/cust_tax_exempt.pm create mode 100644 FS/t/cust_tax_exempt.pm (limited to 'FS') diff --git a/FS/FS.pm b/FS/FS.pm index 287e50c67..3a9c9f336 100644 --- a/FS/FS.pm +++ b/FS/FS.pm @@ -48,6 +48,8 @@ L - Referral class L - Locale (tax rate) class +L - Tax exemption record class + L - Service base class L - Account (shell, RADIUS, POP3) class diff --git a/FS/FS/cust_main_county.pm b/FS/FS/cust_main_county.pm index 56d29da94..a9a4a85bd 100644 --- a/FS/FS/cust_main_county.pm +++ b/FS/FS/cust_main_county.pm @@ -57,6 +57,10 @@ currently supported: =item tax - percentage +=item taxclass + +=item exempt_amount + =back =head1 METHODS @@ -97,11 +101,15 @@ methods. sub check { my $self = shift; + $self->amount(0) unless $self->amount; + $self->ut_numbern('taxnum') || $self->ut_textn('state') || $self->ut_textn('county') || $self->ut_text('country') || $self->ut_float('tax') + || $self->ut_textn('taxclass') # ... + || $self->ut_money('amount') ; } diff --git a/FS/FS/cust_tax_exempt.pm b/FS/FS/cust_tax_exempt.pm new file mode 100644 index 000000000..ab873c0a7 --- /dev/null +++ b/FS/FS/cust_tax_exempt.pm @@ -0,0 +1,131 @@ +package FS::cust_tax_exempt; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearch qsearchs ); + +@ISA = qw(FS::Record); + +=head1 NAME + +FS::cust_tax_exempt - Object methods for cust_tax_exempt records + +=head1 SYNOPSIS + + use FS::cust_tax_exempt; + + $record = new FS::cust_tax_exempt \%hash; + $record = new FS::cust_tax_exempt { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cust_tax_exempt object represents a historical record of a customer tax +exemption. Currently this is only used for "texas tax". FS::cust_tax_exempt +inherits from FS::Record. The following fields are currently supported: + +=over 4 + +=item exemptnum - primary key + +=item custnum - customer (see L) + +=item taxnum - tax rate (see L) + +=item year + +=item month + +=item amount + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new exemption record. To add the example to the database, see +L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'cust_tax_exempt'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +# the insert method can be inherited from FS::Record + +=item delete + +Delete this record from the database. + +=cut + +# the delete method can be inherited from FS::Record + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +# the replace method can be inherited from FS::Record + +=item check + +Checks all fields to make sure this is a valid example. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +# the check method should currently be supplied - FS::Record contains some +# data checking routines + +sub check { + my $self = shift; + + $self->ut_numbern('exemptnum') + || $self->ut_foreign_key('custnum', 'cust_main', 'custnum') + || $self->ut_foreign_key('taxnum', 'cust_main_county', 'taxnum') + || $self->ut_number('year') #check better + || $self->ut_number('month') #check better + || $self->ut_money('amount') + ; +} + +=back + +=head1 BUGS + +Texas tax is a royal pain in the ass. + +=head1 SEE ALSO + +L, L, L, schema.html from the +base documentation. + +=cut + +1; + diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index 8ab8ad452..1f3106544 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -235,7 +235,7 @@ sub check { || $self->ut_anything('plandata') || $self->ut_enum('setuptax', [ '', 'Y' ] ) || $self->ut_enum('recurtax', [ '', 'Y' ] ) - || $self->ut_enum('texastax', [ '', 'none', 'access', 'hosting' ] ) + || $self->ut_enum('taxclass', [ '', 'none', 'access', 'hosting' ] ) || $self->ut_enum('disabled', [ '', 'Y' ] ) ; } @@ -297,7 +297,7 @@ sub payby { =head1 VERSION -$Id: part_pkg.pm,v 1.12 2002-04-25 10:37:08 ivan Exp $ +$Id: part_pkg.pm,v 1.13 2002-05-04 15:00:18 ivan Exp $ =head1 BUGS diff --git a/FS/MANIFEST b/FS/MANIFEST index 86516e3d9..2e72d5af8 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -79,6 +79,7 @@ FS/radius_usergroup.pm FS/queue.pm FS/queue_arg.pm FS/msgcat.pm +FS/cust_tax_exempt.pm t/agent.t t/agent_type.t t/CGI.t @@ -136,3 +137,4 @@ t/queue.t t/queue_arg.t t/msgcat.t t/raddb.t +t/cust_tax_exempt.t diff --git a/FS/t/cust_tax_exempt.pm b/FS/t/cust_tax_exempt.pm new file mode 100644 index 000000000..8af13e3aa --- /dev/null +++ b/FS/t/cust_tax_exempt.pm @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_tax_exempt; +$loaded=1; +print "ok 1\n"; -- cgit v1.2.1 From e324bf00eaee9bd13702348b777642d7096b88a0 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 6 May 2002 13:36:02 +0000 Subject: fixes gratuitous "Illegal payname" errors reported by noment --- FS/FS/cust_bill.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 63a70cd5b..449ab74b9 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -458,7 +458,7 @@ sub realtime_card { my($payname, $payfirst, $paylast); if ( $cust_main->payname ) { $payname = $cust_main->payname; - $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)$/ + $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/ or do { #$dbh->rollback if $oldAutoCommit; return "Illegal payname $payname"; @@ -466,7 +466,7 @@ sub realtime_card { ($payfirst, $paylast) = ($1, $2); } else { $payfirst = $cust_main->getfield('first'); - $paylast = $cust_main->getfield('first'); + $paylast = $cust_main->getfield('last'); $payname = "$payfirst $paylast"; } @@ -948,7 +948,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.33 2002-04-19 14:27:34 ivan Exp $ +$Id: cust_bill.pm,v 1.34 2002-05-06 13:36:02 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From a63b2729682586d8860290576e9307629424dbe0 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 9 May 2002 12:38:40 +0000 Subject: texas tax! --- FS/FS/Conf.pm | 7 ++ FS/FS/cust_main.pm | 160 ++++++++++++++++++++++++++++++++++------------ FS/FS/cust_main_county.pm | 4 +- FS/FS/part_pkg.pm | 6 +- FS/t/cust_tax_exempt.t | 5 ++ 5 files changed, 137 insertions(+), 45 deletions(-) create mode 100644 FS/t/cust_tax_exempt.t (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 6e45ec052..126461763 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -930,6 +930,13 @@ httemplate/docs/config.html 'type' => 'checkbox', }, + { + 'key' => 'enable_taxclasses', + 'section' => 'billing', + 'description' => 'Enable per-package tax classes', + 'type' => 'checkbox', + }, + ); 1; diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 4316988ca..0faa60ca6 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -26,6 +26,7 @@ use FS::queue; use FS::part_pkg; use FS::part_bill_event; use FS::cust_bill_event; +use FS::cust_tax_exempt; use FS::Msgcat qw(gettext); @ISA = qw( FS::Record ); @@ -874,8 +875,11 @@ sub bill { # & generate invoice database. my( $total_setup, $total_recur ) = ( 0, 0 ); - my( $taxable_setup, $taxable_recur ) = ( 0, 0 ); + #my( $taxable_setup, $taxable_recur ) = ( 0, 0 ); my @cust_bill_pkg = (); + my $tax = 0;## + #my $taxable_charged = 0;## + #my $charged = 0;## foreach my $cust_pkg ( qsearch('cust_pkg', { 'custnum' => $self->custnum } ) @@ -888,7 +892,7 @@ sub bill { $cust_pkg->setfield('bill', '') unless defined($cust_pkg->bill); - my $part_pkg = qsearchs( 'part_pkg', { 'pkgpart' => $cust_pkg->pkgpart } ); + my $part_pkg = $cust_pkg->part_pkg; #so we don't modify cust_pkg record unnecessarily my $cust_pkg_mod_flag = 0; @@ -958,7 +962,7 @@ sub bill { # here $sdate = $cust_pkg->bill || $cust_pkg->setup || $time; - $mon += $part_pkg->getfield('freq'); + $mon += $part_pkg->freq; until ( $mon < 12 ) { $mon -= 12; $year++; } $cust_pkg->setfield('bill', timelocal($sec,$min,$hour,$mday,$mon,$year)); @@ -969,6 +973,7 @@ sub bill { warn "\$recur is undefined" unless defined($recur); warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill); + my $taxable_charged = 0; if ( $cust_pkg_mod_flag ) { $error=$cust_pkg->replace($old_cust_pkg); if ( $error ) { #just in case @@ -996,51 +1001,126 @@ sub bill { push @cust_bill_pkg, $cust_bill_pkg; $total_setup += $setup; $total_recur += $recur; - $taxable_setup += $setup - unless $part_pkg->dbdef_table->column('setuptax') - && $part_pkg->setuptax =~ /^Y$/i; - $taxable_recur += $recur - unless $part_pkg->dbdef_table->column('recurtax') - && $part_pkg->recurtax =~ /^Y$/i; - } - } - - } + $taxable_charged += $setup + unless $part_pkg->setuptax =~ /^Y$/i; + $taxable_charged += $recur + unless $part_pkg->recurtax =~ /^Y$/i; + + unless ( $self->tax =~ /Y/i + || $self->payby eq 'COMP' + || $taxable_charged == 0 ) { + + my $cust_main_county = + qsearchs('cust_main_county',{ + 'state' => $self->state, + 'county' => $self->county, + 'country' => $self->country, + 'taxclass' => $part_pkg->taxclass, + } ) + or qsearchs('cust_main_county',{ + 'state' => $self->state, + 'county' => $self->county, + 'country' => $self->country, + 'taxclass' => '', + } ) + or do { + $dbh->rollback if $oldAutoCommit; + return + "fatal: can't find tax rate for state/county/country/taxclass ". + join('/', map $self->$_(), qw(state county country taxclass) ). + "\n"; + }; + + if ( $cust_main_county->exempt_amount ) { + my ($mon,$year) = (localtime($sdate) )[4,5]; + $mon++; + my $freq = $part_pkg->freq || 1; + my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq ); + foreach my $which_month ( 1 .. $freq ) { + my %hash = ( + 'custnum' => $self->custnum, + 'taxnum' => $cust_main_county->taxnum, + 'year' => 1900+$year, + 'month' => $mon++, + ); + #until ( $mon < 12 ) { $mon -= 12; $year++; } + until ( $mon < 13 ) { $mon -= 12; $year++; } + my $cust_tax_exempt = + qsearchs('cust_tax_exempt', \%hash) + || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } ); + my $remaining_exemption = sprintf("%.2f", + $cust_main_county->exempt_amount - $cust_tax_exempt->amount ); + if ( $remaining_exemption > 0 ) { + my $addl = $remaining_exemption > $taxable_per_month + ? $taxable_per_month + : $remaining_exemption; + $taxable_charged -= $addl; + my $new_cust_tax_exempt = new FS::cust_tax_exempt ( { + $cust_tax_exempt->hash, + 'amount' => sprintf("%.2f", $cust_tax_exempt->amount + $addl), + } ); + $error = $new_cust_tax_exempt->exemptnum + ? $new_cust_tax_exempt->replace($cust_tax_exempt) + : $new_cust_tax_exempt->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "fatal: can't update cust_tax_exempt: $error"; + } + + } # if $remaining_exemption > 0 + + } #foreach $which_month + + } #if $cust_main_county->exempt_amount + + $taxable_charged = sprintf( "%.2f", $taxable_charged); + $tax += $taxable_charged * $cust_main_county->tax / 100 + + } #unless $self->tax =~ /Y/i + # || $self->payby eq 'COMP' + # || $taxable_charged == 0 + + } #if $setup > 0 || $recur > 0 + + } #if $cust_pkg_mod_flag + + } #foreach my $cust_pkg my $charged = sprintf( "%.2f", $total_setup + $total_recur ); - my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur ); +# my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur ); - unless ( @cust_bill_pkg ) { + unless ( @cust_bill_pkg ) { #don't create invoices with no line items $dbh->commit or die $dbh->errstr if $oldAutoCommit; return ''; } - unless ( $self->tax =~ /Y/i - || $self->payby eq 'COMP' - || $taxable_charged == 0 ) { - my $cust_main_county = qsearchs('cust_main_county',{ - 'state' => $self->state, - 'county' => $self->county, - 'country' => $self->country, - } ) or die "fatal: can't find tax rate for state/county/country ". - $self->state. "/". $self->county. "/". $self->country. "\n"; - my $tax = sprintf( "%.2f", - $taxable_charged * ( $cust_main_county->getfield('tax') / 100 ) - ); - - if ( $tax > 0 ) { - $charged = sprintf( "%.2f", $charged+$tax ); - - my $cust_bill_pkg = new FS::cust_bill_pkg ({ - 'pkgnum' => 0, - 'setup' => $tax, - 'recur' => 0, - 'sdate' => '', - 'edate' => '', - }); - push @cust_bill_pkg, $cust_bill_pkg; - } +# unless ( $self->tax =~ /Y/i +# || $self->payby eq 'COMP' +# || $taxable_charged == 0 ) { +# my $cust_main_county = qsearchs('cust_main_county',{ +# 'state' => $self->state, +# 'county' => $self->county, +# 'country' => $self->country, +# } ) or die "fatal: can't find tax rate for state/county/country ". +# $self->state. "/". $self->county. "/". $self->country. "\n"; +# my $tax = sprintf( "%.2f", +# $taxable_charged * ( $cust_main_county->getfield('tax') / 100 ) +# ); + + $tax = sprintf("%.2f", $tax); + if ( $tax > 0 ) { + $charged = sprintf( "%.2f", $charged+$tax ); + + my $cust_bill_pkg = new FS::cust_bill_pkg ({ + 'pkgnum' => 0, + 'setup' => $tax, + 'recur' => 0, + 'sdate' => '', + 'edate' => '', + }); + push @cust_bill_pkg, $cust_bill_pkg; } +# } my $cust_bill = new FS::cust_bill ( { 'custnum' => $self->custnum, diff --git a/FS/FS/cust_main_county.pm b/FS/FS/cust_main_county.pm index a9a4a85bd..8e83b1a1d 100644 --- a/FS/FS/cust_main_county.pm +++ b/FS/FS/cust_main_county.pm @@ -101,7 +101,7 @@ methods. sub check { my $self = shift; - $self->amount(0) unless $self->amount; + $self->exempt_amount(0) unless $self->exempt_amount; $self->ut_numbern('taxnum') || $self->ut_textn('state') @@ -109,7 +109,7 @@ sub check { || $self->ut_text('country') || $self->ut_float('tax') || $self->ut_textn('taxclass') # ... - || $self->ut_money('amount') + || $self->ut_money('exempt_amount') ; } diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index 1f3106544..9c33e9a3b 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -59,7 +59,7 @@ inherits from FS::Record. The following fields are currently supported: =item recurtax - Recurring fee tax exempt flag, empty or `Y' -=item taxclass - Texas tax class flag, empty or "none", "access", or "hosting" +=item taxclass - Tax class flag =item plan - Price plan @@ -235,7 +235,7 @@ sub check { || $self->ut_anything('plandata') || $self->ut_enum('setuptax', [ '', 'Y' ] ) || $self->ut_enum('recurtax', [ '', 'Y' ] ) - || $self->ut_enum('taxclass', [ '', 'none', 'access', 'hosting' ] ) + || $self->ut_textn('taxclass') || $self->ut_enum('disabled', [ '', 'Y' ] ) ; } @@ -297,7 +297,7 @@ sub payby { =head1 VERSION -$Id: part_pkg.pm,v 1.13 2002-05-04 15:00:18 ivan Exp $ +$Id: part_pkg.pm,v 1.14 2002-05-09 12:38:39 ivan Exp $ =head1 BUGS diff --git a/FS/t/cust_tax_exempt.t b/FS/t/cust_tax_exempt.t new file mode 100644 index 000000000..8af13e3aa --- /dev/null +++ b/FS/t/cust_tax_exempt.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_tax_exempt; +$loaded=1; +print "ok 1\n"; -- cgit v1.2.1 From 2d3b0ecdb9b1c6f39dcfb64757ed4b9d50abaae0 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 9 May 2002 15:12:38 +0000 Subject: don't duplicate state/county/country pulldowns even with taxrates... --- FS/FS/cust_main_county.pm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main_county.pm b/FS/FS/cust_main_county.pm index 8e83b1a1d..28f69c262 100644 --- a/FS/FS/cust_main_county.pm +++ b/FS/FS/cust_main_county.pm @@ -134,7 +134,8 @@ sub regionselector { @cust_main_county = qsearch('cust_main_county', {} ); foreach my $c ( @cust_main_county ) { $countyflag=1 if $c->county; - push @{$cust_main_county{$c->country}{$c->state}}, $c->county; + #push @{$cust_main_county{$c->country}{$c->state}}, $c->county; + $cust_main_county{$c->country}{$c->state}{$c->county} = 1; } # } $countyflag=1 if $selected_county; @@ -179,7 +180,8 @@ END $script_html .= "\nif ( country == \"$country\" ) {\n"; foreach my $state ( sort keys %{$cust_main_county{$country}} ) { $script_html .= "\nif ( state == \"$state\" ) {\n"; - foreach my $county ( sort @{$cust_main_county{$country}{$state}} ) { + #foreach my $county ( sort @{$cust_main_county{$country}{$state}} ) { + foreach my $county ( sort keys %{$cust_main_county{$country}{$state}} ) { my $text = $county || '(n/a)'; $script_html .= qq!opt(what.form.${prefix}county, "$county", "$text");\n!; -- cgit v1.2.1 From 91249e69d7126b456ba444686ab9f7485c121534 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 10 May 2002 07:45:29 +0000 Subject: bad reuse of variable --- FS/FS/svc_domain.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm index d01a403d1..97c5b3147 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -193,14 +193,14 @@ sub insert { foreach my $record ( @defaultrecords ) { my($zone,$af,$type,$data) = split(/\s+/,$record,4); - my $record = new FS::domain_record { + my $domain_record = new FS::domain_record { 'svcnum' => $self->svcnum, 'reczone' => $zone, 'recaf' => $af, 'rectype' => $type, 'recdata' => $data, }; - my $error = $record->insert; + my $error = $domain_record->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; return "couldn't insert record for new domain: $error"; @@ -407,7 +407,7 @@ sub submit_internic { =head1 VERSION -$Id: svc_domain.pm,v 1.26 2002-03-18 09:10:12 ivan Exp $ +$Id: svc_domain.pm,v 1.27 2002-05-10 07:45:29 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 0eb4dc23ad6d145ee394884a95bad09e2668e74d Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 14 May 2002 00:27:06 +0000 Subject: shellcomands oops --- FS/FS/part_export/shellcommands.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm index e99c382a4..ccde72a68 100644 --- a/FS/FS/part_export/shellcommands.pm +++ b/FS/FS/part_export/shellcommands.pm @@ -9,12 +9,12 @@ sub rebless { shift; } sub _export_insert { my($self) = shift; - $self->_export_command($self, 'useradd', @_); + $self->_export_command('useradd', @_); } sub _export_delete { my($self) = shift; - $self->_export_command($self, 'userdel', @_); + $self->_export_command('userdel', @_); } sub _export_command { -- cgit v1.2.1 From ce119821d508611bce8d2c62c3faec237faa6612 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 14 May 2002 07:36:47 +0000 Subject: don't use return value of UPDATE to decide whether or not to INSERT. --- FS/FS/part_export/sqlradius.pm | 40 ++++++++++++++++++++++++++++------------ 1 file changed, 28 insertions(+), 12 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm index 7337b5aa9..fc680d41b 100644 --- a/FS/FS/part_export/sqlradius.pm +++ b/FS/FS/part_export/sqlradius.pm @@ -108,18 +108,34 @@ sub sqlradius_queue { sub sqlradius_insert { #subroutine, not method my $dbh = sqlradius_connect(shift, shift, shift); - my( $replycheck, $username, %attributes ) = @_; + my( $table, $username, %attributes ) = @_; foreach my $attribute ( keys %attributes ) { - my $u_sth = $dbh->prepare( - "UPDATE rad$replycheck SET Value = ? WHERE UserName = ? AND Attribute = ?" ) or die $dbh->errstr; - my $i_sth = $dbh->prepare( - "INSERT INTO rad$replycheck ( id, UserName, Attribute, Value ) ". - "VALUES ( ?, ?, ?, ? )" + + my $s_sth = $dbh->prepare( + "SELECT COUNT(*) FROM rad$table WHERE UserName = ? AND Attribute = ?" ) or die $dbh->errstr; - $u_sth->execute($attributes{$attribute}, $username, $attribute) > 0 - or $i_sth->execute( '', $username, $attribute, $attributes{$attribute} ) - or die "can't insert into rad$replycheck table: ". $i_sth->errstr; + $s_sth->execute( $username, $attribute ) or die $s_sth->errstr; + + if ( $s_sth->fetchrow_arrayref->[0] ) { + + my $u_sth = $dbh->prepare( + "UPDATE rad$table SET Value = ? WHERE UserName = ? AND Attribute = ?" + ) or die $dbh->errstr; + $u_sth->execute($attributes{$attribute}, $username, $attribute) + or die $u_sth->errstr; + + } else { + + my $i_sth = $dbh->prepare( + "INSERT INTO rad$table ( id, UserName, Attribute, Value ) ". + "VALUES ( ?, ?, ?, ? )" + ) or die $dbh->errstr; + $i_sth->execute( '', $username, $attribute, $attributes{$attribute} ) + or die $i_sth->errstr; + + } + } $dbh->disconnect; } @@ -166,14 +182,14 @@ sub sqlradius_rename { #subroutine, not method sub sqlradius_attrib_delete { #subroutine, not method my $dbh = sqlradius_connect(shift, shift, shift); - my( $replycheck, $username, @attrib ) = @_; + my( $table, $username, @attrib ) = @_; foreach my $attribute ( @attrib ) { my $sth = $dbh->prepare( - "DELETE FROM rad$replycheck WHERE UserName = ? AND Attribute = ?" ) + "DELETE FROM rad$table WHERE UserName = ? AND Attribute = ?" ) or die $dbh->errstr; $sth->execute($username,$attribute) - or die "can't delete from rad$replycheck table: ". $sth->errstr; + or die "can't delete from rad$table table: ". $sth->errstr; } $dbh->disconnect; } -- cgit v1.2.1 From eb7c552dd8290d6b33a4e026c5dc21ebf01105cf Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 15 May 2002 13:24:26 +0000 Subject: queue dependancies --- FS/FS.pm | 4 +- FS/FS/part_export/sqlradius.pm | 34 ++++++------ FS/FS/queue.pm | 37 +++++++++++-- FS/FS/queue_depend.pm | 120 +++++++++++++++++++++++++++++++++++++++++ FS/MANIFEST | 1 + FS/bin/freeside-queued | 12 +++-- FS/t/queue_depend.t | 5 ++ 7 files changed, 187 insertions(+), 26 deletions(-) create mode 100644 FS/FS/queue_depend.pm create mode 100644 FS/t/queue_depend.t (limited to 'FS') diff --git a/FS/FS.pm b/FS/FS.pm index 3a9c9f336..963c73548 100644 --- a/FS/FS.pm +++ b/FS/FS.pm @@ -31,7 +31,7 @@ L - Non OO-subroutines for the web interface. L - Message catalog -L - Message catalog +L - Search cache L - RADIUS dictionary @@ -134,6 +134,8 @@ L - Job queue L - Job arguments +L - Job dependencies + L - Message catalogs =head1 Remote API modules diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm index fc680d41b..51a828001 100644 --- a/FS/FS/part_export/sqlradius.pm +++ b/FS/FS/part_export/sqlradius.pm @@ -14,15 +14,16 @@ sub _export_insert { my $method = "radius_$table"; my %attrib = $svc_acct->$method; next unless keys %attrib; - my $error = $self->sqlradius_queue( $svc_acct->svcnum, 'insert', + my $err_or_queue = $self->sqlradius_queue( $svc_acct->svcnum, 'insert', $table, $svc_acct->username, %attrib ); - return $error if $error; + return $err_or_queue unless ref($err_or_queue); } my @groups = $svc_acct->radius_groups; if ( @groups ) { - my $error = $self->sqlradius_queue( $svc_acct->svcnum, 'usergroup_insert', + my $err_or_queue = $self->sqlradius_queue( + $svc_acct->svcnum, 'usergroup_insert', $svc_acct->username, @groups ); - return $error if $error; + return $err_or_queue unless ref($err_or_queue); } ''; } @@ -33,9 +34,9 @@ sub _export_replace { #return "can't (yet) change username with sqlradius" # if $old->username ne $new->username; if ( $old->username ne $new->username ) { - my $error = $self->sqlradius_queue( $new->svcnum, 'rename', + my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'rename', $new->username, $old->username ); - return $error if $error; + return $err_or_queue unless ref($err_or_queue); } foreach my $table (qw(reply check)) { @@ -46,16 +47,16 @@ sub _export_replace { || $new{$_} ne $old{$_} #changed } keys %new ) { - my $error = $self->sqlradius_queue( $new->svcnum, 'insert', + my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert', $table, $new->username, %new ); - return $error if $error; + return $err_or_queue unless ref($err_or_queue); } my @del = grep { !exists $new{$_} } keys %old; if ( @del ) { - my $error = $self->sqlradius_queue( $new->svcnum, 'attrib_delete', + my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'attrib_delete', $table, $new->username, @del ); - return $error if $error; + return $err_or_queue unless ref($err_or_queue); } } @@ -72,15 +73,15 @@ sub _export_replace { } if ( @delgroups ) { - my $error = $self->sqlradius_queue( $new->svcnum, 'usergroup_delete', + my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'usergroup_delete', $new->username, @delgroups ); - return $error if $error; + return $err_or_queue unless ref($err_or_queue); } if ( @newgroups ) { - my $error = $self->sqlradius_queue( $new->svcnum, 'usergroup_insert', + my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'usergroup_insert', $new->username, @newgroups ); - return $error if $error; + return $err_or_queue unless ref($err_or_queue); } ''; @@ -88,8 +89,9 @@ sub _export_replace { sub _export_delete { my( $self, $svc_acct ) = (shift, shift); - $self->sqlradius_queue( $svc_acct->svcnum, 'delete', + my $err_or_queue = $self->sqlradius_queue( $svc_acct->svcnum, 'delete', $svc_acct->username ); + ref($err_or_queue) ? '' : $err_or_queue; } sub sqlradius_queue { @@ -103,7 +105,7 @@ sub sqlradius_queue { $self->option('username'), $self->option('password'), @_, - ); + ) or $queue; } sub sqlradius_insert { #subroutine, not method diff --git a/FS/FS/queue.pm b/FS/FS/queue.pm index 5719eff70..c75f75874 100644 --- a/FS/FS/queue.pm +++ b/FS/FS/queue.pm @@ -8,6 +8,7 @@ use FS::Conf; use FS::Record qw( qsearch qsearchs dbh ); #use FS::queue; use FS::queue_arg; +use FS::queue_depend; use FS::cust_svc; @ISA = qw(FS::Record); @@ -144,7 +145,8 @@ sub delete { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my @args = qsearch( 'queue_arg', { 'jobnum' => $self->jobnum } ); + my @del = qsearch( 'queue_arg', { 'jobnum' => $self->jobnum } ); + push @del, qsearch( 'queue_depend', { 'depend_jobnum' => $self->jobnum } ); my $error = $self->SUPER::delete; if ( $error ) { @@ -152,8 +154,8 @@ sub delete { return $error; } - foreach my $arg ( @args ) { - $error = $arg->delete; + foreach my $del ( @del ) { + $error = $del->delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -206,6 +208,8 @@ sub check { =item args +Returns a list of the arguments associated with this job. + =cut sub args { @@ -228,6 +232,31 @@ sub cust_svc { qsearchs('cust_svc', { 'svcnum' => $self->svcnum } ); } +=item depend_insert OTHER_JOBNUM + +Inserts a dependancy for this job. If there is an error, returns the error, +otherwise returns false. + +When using job dependancies, you should wrap the insertion of jobs in a +database transaction. + +=cut + +sub depend_insert { + my($self, $other_jobnum) = @_; + my $queue_depend = new FS::queue_depend ( + 'jobnum' => $self->jobnum, + 'depend_jobnum' => $other_jobnum, + ); + $queue_depend->insert; +} + +=back + +=head1 SUBROUTINES + +=over 4 + =item joblisting HASHREF NOACTIONS =cut @@ -331,7 +360,7 @@ END =head1 VERSION -$Id: queue.pm,v 1.11 2002-04-13 08:51:54 ivan Exp $ +$Id: queue.pm,v 1.12 2002-05-15 13:24:24 ivan Exp $ =head1 BUGS diff --git a/FS/FS/queue_depend.pm b/FS/FS/queue_depend.pm new file mode 100644 index 000000000..4a4e3c55c --- /dev/null +++ b/FS/FS/queue_depend.pm @@ -0,0 +1,120 @@ +package FS::queue_depend; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearch qsearchs ); +use FS::queue; + +@ISA = qw(FS::Record); + +=head1 NAME + +FS::queue_depend - Object methods for queue_depend records + +=head1 SYNOPSIS + + use FS::queue_depend; + + $record = new FS::queue_depend \%hash; + $record = new FS::queue_depend { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::queue_depend object represents an job dependancy. FS::queue_depend +inherits from FS::Record. The following fields are currently supported: + +=over 4 + +=item dependnum - primary key + +=item jobnum - source jobnum (see L). + +=item depend_jobnum - dependancy jobnum (see L) + +=back + +The job specified by B depends on the job specified B - +the B job will not be run until the B job has completed +sucessfully (or manually removed). + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new dependancy. To add the dependancy to the database, see +L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'queue_depend'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +# the insert method can be inherited from FS::Record + +=item delete + +Delete this record from the database. + +=cut + +# the delete method can be inherited from FS::Record + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +# the replace method can be inherited from FS::Record + +=item check + +Checks all fields to make sure this is a valid dependancy. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +sub check { + my $self = shift; + + $self->ut_numbern('dependnum') + || $self->ut_foreign_key('jobnum', 'queue', 'jobnum') + || $self->ut_foreign_key('depend_jobnum', 'queue', 'jobnum') + ; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/MANIFEST b/FS/MANIFEST index 2e72d5af8..a95470bb4 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -78,6 +78,7 @@ FS/raddb.pm FS/radius_usergroup.pm FS/queue.pm FS/queue_arg.pm +FS/queue_depend.pm FS/msgcat.pm FS/cust_tax_exempt.pm t/agent.t diff --git a/FS/bin/freeside-queued b/FS/bin/freeside-queued index 49b532ec3..1539a48af 100644 --- a/FS/bin/freeside-queued +++ b/FS/bin/freeside-queued @@ -59,13 +59,16 @@ while (1) { } $warnkids=0; + my $nodepend = 'AND 0 = ( SELECT COUNT(*) FROM queue_depend'. + ' WHERE queue_depend.jobnum = queue.jobnum ) '; + my $job = qsearchs( 'queue', { 'status' => 'new' }, '', driver_name =~ /^mysql$/i - ? 'ORDER BY jobnum LIMIT 1 FOR UPDATE' - : 'ORDER BY jobnum FOR UPDATE LIMIT 1' + ? "$nodepend ORDER BY jobnum LIMIT 1 FOR UPDATE" + : "$nodepend ORDER BY jobnum FOR UPDATE LIMIT 1" ) or do { sleep 5; #connecting to db is expensive next; @@ -94,10 +97,9 @@ while (1) { $kids++; } else { #kid time - #get new db handles + #get new db handle $FS::UID::dbh->{InactiveDestroy} = 1; - $FS::svc_acct::icradius_dbh->{InactiveDestroy} = 1 - if $FS::svc_acct::icradius_dbh; + forksuidsetup($user); #auto-use export classes... diff --git a/FS/t/queue_depend.t b/FS/t/queue_depend.t new file mode 100644 index 000000000..8eaa2cdb3 --- /dev/null +++ b/FS/t/queue_depend.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::queue_depend; +$loaded=1; +print "ok 1\n"; -- cgit v1.2.1 From b26a63c1a75b80652506f39a99a6786193d956bf Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 15 May 2002 14:00:33 +0000 Subject: use job dependancies in FS::part_export::sqlradius.pm display job dependancies in FS::queue::joblisting --- FS/FS/part_export/sqlradius.pm | 71 +++++++++++++++++++++++++++++++++++++----- FS/FS/queue.pm | 28 ++++++++++++++--- 2 files changed, 87 insertions(+), 12 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm index 51a828001..b31ec5cd3 100644 --- a/FS/FS/part_export/sqlradius.pm +++ b/FS/FS/part_export/sqlradius.pm @@ -1,6 +1,7 @@ package FS::part_export::sqlradius; use vars qw(@ISA); +use FS::Record qw( dbh ); use FS::part_export; @ISA = qw(FS::part_export); @@ -31,12 +32,26 @@ sub _export_insert { sub _export_replace { my( $self, $new, $old ) = (shift, shift, shift); - #return "can't (yet) change username with sqlradius" - # if $old->username ne $new->username; + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $jobnum = ''; if ( $old->username ne $new->username ) { my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'rename', $new->username, $old->username ); - return $err_or_queue unless ref($err_or_queue); + unless ( ref($err_or_queue) ) { + $dbh->rollback if $oldAutoCommit; + return $err_or_queue; + } + $jobnum = $err_or_queue->jobnum; } foreach my $table (qw(reply check)) { @@ -49,14 +64,34 @@ sub _export_replace { ) { my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert', $table, $new->username, %new ); - return $err_or_queue unless ref($err_or_queue); + unless ( ref($err_or_queue) ) { + $dbh->rollback if $oldAutoCommit; + return $err_or_queue; + } + if ( $jobnum ) { + my $error = $err_or_queue->depend_insert( $jobnum ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } } my @del = grep { !exists $new{$_} } keys %old; if ( @del ) { my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'attrib_delete', $table, $new->username, @del ); - return $err_or_queue unless ref($err_or_queue); + unless ( ref($err_or_queue) ) { + $dbh->rollback if $oldAutoCommit; + return $err_or_queue; + } + if ( $jobnum ) { + my $error = $err_or_queue->depend_insert( $jobnum ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } } } @@ -75,15 +110,37 @@ sub _export_replace { if ( @delgroups ) { my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'usergroup_delete', $new->username, @delgroups ); - return $err_or_queue unless ref($err_or_queue); + unless ( ref($err_or_queue) ) { + $dbh->rollback if $oldAutoCommit; + return $err_or_queue; + } + if ( $jobnum ) { + my $error = $err_or_queue->depend_insert( $jobnum ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } } if ( @newgroups ) { my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'usergroup_insert', $new->username, @newgroups ); - return $err_or_queue unless ref($err_or_queue); + unless ( ref($err_or_queue) ) { + $dbh->rollback if $oldAutoCommit; + return $err_or_queue; + } + if ( $jobnum ) { + my $error = $err_or_queue->depend_insert( $jobnum ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; } diff --git a/FS/FS/queue.pm b/FS/FS/queue.pm index c75f75874..df92c5654 100644 --- a/FS/FS/queue.pm +++ b/FS/FS/queue.pm @@ -232,13 +232,26 @@ sub cust_svc { qsearchs('cust_svc', { 'svcnum' => $self->svcnum } ); } +=item queue_depend + +Returns the FS::queue_depend objects associated with this job, if any. + +=cut + +sub queue_depend { + my $self = shift; + qsearch('queue_depend', { 'jobnum' => $self->jobnum } ); +} + + =item depend_insert OTHER_JOBNUM -Inserts a dependancy for this job. If there is an error, returns the error, -otherwise returns false. +Inserts a dependancy for this job - it will not be run until the other job +specified completes. If there is an error, returns the error, otherwise +returns false. -When using job dependancies, you should wrap the insertion of jobs in a -database transaction. +When using job dependancies, you should wrap the insertion of all relevant jobs +in a database transaction. =cut @@ -303,6 +316,11 @@ END my $date = time2str( "%a %b %e %T %Y", $queue->_date ); my $status = $queue->status; $status .= ': '. $queue->statustext if $queue->statustext; + my @queue_depend = $queue->queue_depend; + $status .= ' (waiting for '. + join(', ', map { $_->other_jobnum } @queue_depend ). + ')' + if @queue_depend; my $changable = $dangerous || ( ! $noactions && $status =~ /^failed/ || $status =~ /^locked/ ); if ( $changable ) { @@ -360,7 +378,7 @@ END =head1 VERSION -$Id: queue.pm,v 1.12 2002-05-15 13:24:24 ivan Exp $ +$Id: queue.pm,v 1.13 2002-05-15 14:00:32 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 7ccc8f47305f2bacb63b79dda665b2c7f5310ba5 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 16 May 2002 13:42:30 +0000 Subject: allow freebsd `toor' root user --- FS/FS/svc_acct.pm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index bb8c5e21e..7ea4c10f8 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -577,7 +577,9 @@ sub check { #you can set a fixed gid in part_svc return "Only root can have uid 0" - if $recref->{uid} == 0 && $recref->{username} ne 'root'; + if $recref->{uid} == 0 + && $recref->{username} ne 'root' + && $recref->{username} ne 'toor'; # $error = $self->ut_textn('finger'); # return $error if $error; -- cgit v1.2.1 From 6c22d1f804ed99ecae591af6483a326e1c825560 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 16 May 2002 14:21:20 +0000 Subject: force all infostreet arguments to be string type, fixes: "0 as first character in password" problem. also see the Frontier::Client manpage --- FS/FS/part_export/infostreet.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export/infostreet.pm b/FS/FS/part_export/infostreet.pm index e86e82a66..2ce556339 100644 --- a/FS/FS/part_export/infostreet.pm +++ b/FS/FS/part_export/infostreet.pm @@ -63,7 +63,8 @@ sub infostreet_command { #subroutine, not method die $key_result{error} unless $key_result{success}; my $key = $key_result{data}; - my $result = $conn->call($method, $key, @args); + #my $result = $conn->call($method, $key, @args); + my $result = $conn->call($method, $key, map { $conn->string($_) } @args); my %result = _infostreet_parse($result); die $result{error} unless $result{success}; -- cgit v1.2.1 From da311364707d64a2188cb959b3779178563d0ac8 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 16 May 2002 14:27:58 +0000 Subject: add (stub) bsdshell and textradius exports --- FS/MANIFEST | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) (limited to 'FS') diff --git a/FS/MANIFEST b/FS/MANIFEST index a95470bb4..4c6d243df 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -49,11 +49,13 @@ FS/part_bill_event.pm FS/export_svc.pm FS/part_export.pm FS/part_export_option.pm -FS/part_export/infostreet.pm -FS/part_export/sqlradius.pm -FS/part_export/cyrus.pm +FS/part_export/bsdshell.pm FS/part_export/cp.pm +FS/part_export/cyrus.pm +FS/part_export/infostreet.pm FS/part_export/shellcommands.pm +FS/part_export/sqlradius.pm +FS/part_export/textradius.pm FS/part_export/vpopmail.pm FS/part_pkg.pm FS/part_pop_local.pm @@ -110,11 +112,13 @@ t/part_bill_event.t t/export_svc.t t/part_export.t t/part_export_option.t -t/part_export-infostreet.t -t/part_export-sqlradius.t -t/part_export-cyrus.t +t/part_export-bsdshell.t t/part_export-cp.t +t/part_export-cyrus.t +t/part_export-infostreet.t t/part_export-shellcommands.t +t/part_export-sqlradius.t +t/part_export-textradius.t t/part_export-vpopmail.t t/part_pkg.t t/part_pop_local.t -- cgit v1.2.1 From 9554f2be960fdb511a4c9d8b519261614319f0aa Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 16 May 2002 14:28:57 +0000 Subject: adding (stub) bsdshell and textradius exports --- FS/FS/part_export/bsdshell.pm | 50 +++++++++++++++++++++++++++++++++++++++++ FS/FS/part_export/textradius.pm | 50 +++++++++++++++++++++++++++++++++++++++++ FS/t/part_export-bsdshell.t | 5 +++++ FS/t/part_export-textradius.t | 5 +++++ 4 files changed, 110 insertions(+) create mode 100644 FS/FS/part_export/bsdshell.pm create mode 100644 FS/FS/part_export/textradius.pm create mode 100644 FS/t/part_export-bsdshell.t create mode 100644 FS/t/part_export-textradius.t (limited to 'FS') diff --git a/FS/FS/part_export/bsdshell.pm b/FS/FS/part_export/bsdshell.pm new file mode 100644 index 000000000..4a890d051 --- /dev/null +++ b/FS/FS/part_export/bsdshell.pm @@ -0,0 +1,50 @@ +package FS::part_export::bsdshell; + +use vars qw(@ISA); +use FS::part_export; + +@ISA = qw(FS::part_export); + +sub rebless { shift; } + +sub _export_insert { + my($self, $svc_acct) = (shift, shift); + $err_or_queue = $self->bsdshell_queue( $svc_acct->svcnum, 'insert', + $svc_acct->username, $svc_acct->_password ); + ref($err_or_queue) ? '' : $err_or_queue; +} + +sub _export_replace { + my( $self, $new, $old ) = (shift, shift, shift); + #return "can't change username with bsdshell" + # if $old->username ne $new->username; + #return '' unless $old->_password ne $new->_password; + $err_or_queue = $self->bsdshell_queue( $new->svcnum, + 'replace', $new->username, $new->_password ); + ref($err_or_queue) ? '' : $err_or_queue; +} + +sub _export_delete { + my( $self, $svc_acct ) = (shift, shift); + $err_or_queue = $self->bsdshell_queue( $svc_acct->svcnum, + 'delete', $svc_acct->username ); + ref($err_or_queue) ? '' : $err_or_queue; +} + +#a good idea to queue anything that could fail or take any time +sub bsdshell_queue { + my( $self, $svcnum, $method ) = (shift, shift, shift); + my $queue = new FS::queue { + 'svcnum' => $svcnum, + 'job' => "FS::part_export::bsdshell::bsdshell_$method", + }; + $queue->insert( @_ ) or $queue; +} + +sub bsdshell_insert { #subroutine, not method +} +sub bsdshell_replace { #subroutine, not method +} +sub bsdshell_delete { #subroutine, not method +} + diff --git a/FS/FS/part_export/textradius.pm b/FS/FS/part_export/textradius.pm new file mode 100644 index 000000000..9a0468f6d --- /dev/null +++ b/FS/FS/part_export/textradius.pm @@ -0,0 +1,50 @@ +package FS::part_export::textradius; + +use vars qw(@ISA); +use FS::part_export; + +@ISA = qw(FS::part_export); + +sub rebless { shift; } + +sub _export_insert { + my($self, $svc_acct) = (shift, shift); + $err_or_queue = $self->textradius_queue( $svc_acct->svcnum, 'insert', + $svc_acct->username, $svc_acct->_password ); + ref($err_or_queue) ? '' : $err_or_queue; +} + +sub _export_replace { + my( $self, $new, $old ) = (shift, shift, shift); + #return "can't change username with textradius" + # if $old->username ne $new->username; + #return '' unless $old->_password ne $new->_password; + $err_or_queue = $self->textradius_queue( $new->svcnum, + 'replace', $new->username, $new->_password ); + ref($err_or_queue) ? '' : $err_or_queue; +} + +sub _export_delete { + my( $self, $svc_acct ) = (shift, shift); + $err_or_queue = $self->textradius_queue( $svc_acct->svcnum, + 'delete', $svc_acct->username ); + ref($err_or_queue) ? '' : $err_or_queue; +} + +#a good idea to queue anything that could fail or take any time +sub textradius_queue { + my( $self, $svcnum, $method ) = (shift, shift, shift); + my $queue = new FS::queue { + 'svcnum' => $svcnum, + 'job' => "FS::part_export::textradius::textradius_$method", + }; + $queue->insert( @_ ) or $queue; +} + +sub textradius_insert { #subroutine, not method +} +sub textradius_replace { #subroutine, not method +} +sub textradius_delete { #subroutine, not method +} + diff --git a/FS/t/part_export-bsdshell.t b/FS/t/part_export-bsdshell.t new file mode 100644 index 000000000..eaf417a70 --- /dev/null +++ b/FS/t/part_export-bsdshell.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::bsdshell; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-textradius.t b/FS/t/part_export-textradius.t new file mode 100644 index 000000000..d8a48a0c8 --- /dev/null +++ b/FS/t/part_export-textradius.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::textradius; +$loaded=1; +print "ok 1\n"; -- cgit v1.2.1 From 8203228392fc2f15f568dbdfdace2d70baad681c Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 17 May 2002 03:47:06 +0000 Subject: freebsd `toor' user --- FS/FS/svc_acct.pm | 1 + 1 file changed, 1 insertion(+) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 7ea4c10f8..17ae41583 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -212,6 +212,7 @@ sub insert { if $part_svc->part_svc_column('uid')->columnflag ne 'F' && qsearchs( 'svc_acct', { 'uid' => $self->uid } ) && $self->username !~ /^(hyla)?fax$/ + && $self->username !~ /^toor$/ #FreeBSD ; $error = $self->SUPER::insert; -- cgit v1.2.1 From a1e5529209c50a7b281e19c57f903f311e2adeef Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 18 May 2002 09:51:30 +0000 Subject: Mail::Internet 1.44 --- FS/FS/cust_bill.pm | 4 ++-- FS/FS/cust_pay.pm | 4 ++-- FS/FS/svc_domain.pm | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 449ab74b9..e2705fd83 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -8,7 +8,7 @@ use vars qw( $xaction $E_NoErr ); use vars qw( $bop_processor $bop_login $bop_password $bop_action @bop_options ); use vars qw( $invoice_lines @buf ); #yuck use Date::Format; -use Mail::Internet; +use Mail::Internet 1.44; use Mail::Header; use Text::Template; use FS::Record qw( qsearch qsearchs ); @@ -948,7 +948,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.34 2002-05-06 13:36:02 ivan Exp $ +$Id: cust_bill.pm,v 1.35 2002-05-18 09:51:30 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index ac60dc242..fcd902b1b 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -4,7 +4,7 @@ use strict; use vars qw( @ISA $conf $unsuspendauto $smtpmachine $invoice_from ); use Date::Format; use Mail::Header; -use Mail::Internet; +use Mail::Internet 1.44; use Business::CreditCard; use FS::UID qw( dbh ); use FS::Record qw( dbh qsearch qsearchs dbh ); @@ -405,7 +405,7 @@ sub unapplied { =head1 VERSION -$Id: cust_pay.pm,v 1.19 2002-04-07 06:23:29 ivan Exp $ +$Id: cust_pay.pm,v 1.20 2002-05-18 09:51:30 ivan Exp $ =head1 BUGS diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm index 97c5b3147..3dea7050f 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -6,7 +6,7 @@ use vars qw( @ISA $whois_hack $conf $smtpmachine $soarefresh $soaretry $qshellmachine $nossh_hack ); use Carp; -use Mail::Internet; +use Mail::Internet 1.44; use Mail::Header; use Date::Format; use Net::Whois 1.0; @@ -407,7 +407,7 @@ sub submit_internic { =head1 VERSION -$Id: svc_domain.pm,v 1.27 2002-05-10 07:45:29 ivan Exp $ +$Id: svc_domain.pm,v 1.28 2002-05-18 09:51:30 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 9616707e5bfbad90aa63aaafffb6f47556f2adca Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 22 May 2002 02:09:32 +0000 Subject: 5.6-isms --- FS/FS/part_export/sqlradius.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm index b31ec5cd3..3c781c043 100644 --- a/FS/FS/part_export/sqlradius.pm +++ b/FS/FS/part_export/sqlradius.pm @@ -13,7 +13,7 @@ sub _export_insert { foreach my $table (qw(reply check)) { my $method = "radius_$table"; - my %attrib = $svc_acct->$method; + my %attrib = $svc_acct->$method(); next unless keys %attrib; my $err_or_queue = $self->sqlradius_queue( $svc_acct->svcnum, 'insert', $table, $svc_acct->username, %attrib ); @@ -56,8 +56,8 @@ sub _export_replace { foreach my $table (qw(reply check)) { my $method = "radius_$table"; - my %new = $new->$method; - my %old = $old->$method; + my %new = $new->$method(); + my %old = $old->$method(); if ( grep { !exists $old{$_} #new attributes || $new{$_} ne $old{$_} #changed } keys %new -- cgit v1.2.1 From e93c23ed5b4fc2fd81501b2371927e6cdfad7a65 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 22 May 2002 11:39:53 +0000 Subject: - remove some out of date documentation - die if an export class won't compile --- FS/FS/part_export.pm | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 752bbb1d3..94b819d13 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -361,8 +361,7 @@ sub option { Reblesses the object into the FS::part_export::EXPORTTYPE class, where EXPORTTYPE is the object's I field. There should be better docs -on how to create new exports (and they should live in their own files and be -autoloaded-on-demand), but until then, see L. +on how to create new exports, but until then, see L. =cut @@ -370,7 +369,7 @@ sub rebless { my $self = shift; my $exporttype = $self->exporttype; my $class = ref($self). "::$exporttype"; - eval "use $class;"; + eval "use $class;" or die $@; bless($self, $class); } -- cgit v1.2.1 From a55f1c9e63b5428c55aa75d55ab4a280889be288 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 22 May 2002 12:17:06 +0000 Subject: move some code from FS::cust_pkg to FS::cust_svc, becomes the cancel method --- FS/FS/cust_pkg.pm | 28 +++--------------------- FS/FS/cust_svc.pm | 64 ++++++++++++++++++++++++++++++++++++++++++++++++++++--- 2 files changed, 64 insertions(+), 28 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index a4256ea1f..8b65ac4bd 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -268,33 +268,11 @@ sub cancel { foreach my $cust_svc ( qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ) { - my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } ); - - $part_svc->svcdb =~ /^([\w\-]+)$/ or do { - $dbh->rollback if $oldAutoCommit; - return "Illegal svcdb value in part_svc!"; - }; - my $svcdb = $1; - require "FS/$svcdb.pm"; - - my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } ); - if ($svc) { - $error = $svc->cancel; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Error cancelling service: $error" - } - $error = $svc->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Error deleting service: $error"; - } - } + my $error = $cust_svc->cancel; - $error = $cust_svc->delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "Error deleting cust_svc: $error"; + return "Error cancelling cust_svc: $error"; } } @@ -701,7 +679,7 @@ sub order { =head1 VERSION -$Id: cust_pkg.pm,v 1.21 2002-05-04 00:47:24 ivan Exp $ +$Id: cust_pkg.pm,v 1.22 2002-05-22 12:17:06 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index e6194b5b7..c7cc4b322 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -85,9 +85,67 @@ otherwise returns false. =item delete Deletes this service from the database. If there is an error, returns the -error, otherwise returns false. +error, otherwise returns false. Note that this only removes the cust_svc +record - you should probably use the B method instead. -Called by the cancel method of the package (see L). +=item cancel + +Cancels the relevant service by calling the B method of the associated +FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object), +deleting the FS::svc_XXX record and then deleting this record. + +If there is an error, returns the error, otherwise returns false. + +=cut + +sub cancel { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $part_svc = $self->part_svc; + + $part_svc->svcdb =~ /^([\w\-]+)$/ or do { + $dbh->rollback if $oldAutoCommit; + return "Illegal svcdb value in part_svc!"; + }; + my $svcdb = $1; + require "FS/$svcdb.pm"; + + my $svc = $self->svc_x; + if ($svc) { + my $error = $svc->cancel; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error canceling service: $error"; + } + $error = $svc->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error deleting service: $error"; + } + } + + my $error = $self->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error deleting cust_svc: $error"; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; #no errors + +} =item replace OLD_RECORD @@ -286,7 +344,7 @@ sub seconds_since { =head1 VERSION -$Id: cust_svc.pm,v 1.14 2002-04-20 02:06:38 ivan Exp $ +$Id: cust_svc.pm,v 1.15 2002-05-22 12:17:06 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 23186f0338ec248d930c85db08cc997bca42525b Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 22 May 2002 18:44:01 +0000 Subject: bind export, editing zones, deleting unaudited domains, mmm --- FS/FS/domain_record.pm | 129 ++++++++++++++++++++++++++++++++++++++++++++++++- FS/FS/part_export.pm | 11 +++-- FS/FS/svc_domain.pm | 51 +++++++++++++++++-- 3 files changed, 180 insertions(+), 11 deletions(-) (limited to 'FS') diff --git a/FS/FS/domain_record.pm b/FS/FS/domain_record.pm index 6f4dd0287..44e70ade1 100644 --- a/FS/FS/domain_record.pm +++ b/FS/FS/domain_record.pm @@ -3,7 +3,7 @@ package FS::domain_record; use strict; use vars qw( @ISA ); #use FS::Record qw( qsearch qsearchs ); -use FS::Record qw( qsearchs ); +use FS::Record qw( qsearchs dbh ); use FS::svc_domain; @ISA = qw(FS::Record); @@ -71,12 +71,80 @@ otherwise returns false. =cut +sub insert { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $self->SUPER::insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + unless ( $self->rectype =~ /^(SOA|_mstr)$/ ) { + my $error = $self->increment_serial; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; + +} + =item delete Delete this record from the database. =cut +sub delete { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $self->SUPER::delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + unless ( $self->rectype =~ /^(SOA|_mstr)$/ ) { + my $error = $self->increment_serial; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; + +} + =item replace OLD_RECORD Replaces the OLD_RECORD with this one in the database. If there is an error, @@ -84,6 +152,40 @@ returns the error, otherwise returns false. =cut +sub replace { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $self->SUPER::replace(@_); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + unless ( $self->rectype eq 'SOA' ) { + my $error = $self->increment_serial; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; + +} + =item check Checks all fields to make sure this is a valid example. If there is @@ -158,11 +260,34 @@ sub check { ''; #no error } +=item increment_serial + +=cut + +sub increment_serial { + my $self = shift; + + my $soa = qsearchs('domain_record', { + svcnum => $self->svcnum, + reczone => '@', #or full domain ? + recaf => 'IN', + rectype => 'SOA', + } ) or return "soa record not found; can't increment serial"; + + my $data = $soa->recdata; + $data =~ s/(\(\D*)(\d+)/$1.($2+1)/e; #well, it works. + + my %hash = $soa->hash; + $hash{recdata} = $data; + my $new = new FS::domain_record \%hash; + $new->replace($soa); +} + =back =head1 VERSION -$Id: domain_record.pm,v 1.7 2002-04-20 11:57:35 ivan Exp $ +$Id: domain_record.pm,v 1.8 2002-05-22 18:44:01 ivan Exp $ =head1 BUGS diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 94b819d13..8a7ac8bf9 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -141,7 +141,7 @@ sub insert { ''; -}; +} =item delete @@ -361,7 +361,8 @@ sub option { Reblesses the object into the FS::part_export::EXPORTTYPE class, where EXPORTTYPE is the object's I field. There should be better docs -on how to create new exports, but until then, see L. +on how to create new exports (and they should live in their own files and be +autoloaded-on-demand), but until then, see L. =cut @@ -369,7 +370,7 @@ sub rebless { my $self = shift; my $exporttype = $self->exporttype; my $class = ref($self). "::$exporttype"; - eval "use $class;" or die $@; + eval "use $class;"; bless($self, $class); } @@ -617,13 +618,13 @@ tie my %bind_slave_options, 'Tie::IxHash', 'bind' => { 'desc' =>'Batch export to BIND named', 'options' => \%bind_options, - 'notes' => 'bind export notes', + 'notes' => 'bind export notes File::Rsync dependancy, run bind.export', }, 'bind_slave' => { 'desc' =>'Batch export to slave BIND named', 'options' => \%bind_slave_options, - 'notes' => 'bind export notes (secondary munge)', + 'notes' => 'bind export notes (secondary munge) File::Rsync dependancy, run bind.export', }, diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm index 3dea7050f..a9a2fd0eb 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -255,10 +255,33 @@ sub delete { if defined( $FS::Record::dbdef->table('svc_acct_sm') ) && qsearch('svc_acct_sm', { 'domsvc' => $self->svcnum } ); - return "Can't delete a domain with (domain_record) zone entries!" - if qsearch('domain_record', { 'svcnum' => $self->svcnum } ); + #return "Can't delete a domain with (domain_record) zone entries!" + # if qsearch('domain_record', { 'svcnum' => $self->svcnum } ); - $self->SUPER::delete; + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $self->SUPER::delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + foreach my $domain_record ( reverse $self->domain_record ) { + my $error = $domain_record->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } } =item replace OLD_RECORD @@ -369,6 +392,26 @@ sub check { } +=item domain_record + +=cut + +sub domain_record { + my $self = shift; + + my %order = ( + SOA => 1, + NS => 2, + MX => 3, + CNAME => 4, + A => 5, + ); + + sort { $order{$a->rectype} <=> $order{$b->rectype} } + qsearch('domain_record', { svcnum => $self->svcnum } ); + +} + =item whois Returns the Net::Whois::Domain object (see L) for this domain, or @@ -407,7 +450,7 @@ sub submit_internic { =head1 VERSION -$Id: svc_domain.pm,v 1.28 2002-05-18 09:51:30 ivan Exp $ +$Id: svc_domain.pm,v 1.29 2002-05-22 18:44:01 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 4920ad2671d712afe23d731e25bc5b53955397b7 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 23 May 2002 13:00:08 +0000 Subject: bind: allow adding slave domains too --- FS/FS/domain_record.pm | 26 ++++++++++++++++++++++++-- 1 file changed, 24 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/domain_record.pm b/FS/FS/domain_record.pm index 44e70ade1..4ed713c77 100644 --- a/FS/FS/domain_record.pm +++ b/FS/FS/domain_record.pm @@ -1,7 +1,7 @@ package FS::domain_record; use strict; -use vars qw( @ISA ); +use vars qw( @ISA $noserial_hack ); #use FS::Record qw( qsearch qsearchs ); use FS::Record qw( qsearchs dbh ); use FS::svc_domain; @@ -85,6 +85,16 @@ sub insert { local $FS::UID::AutoCommit = 0; my $dbh = dbh; + if ( $self->rectype eq '_mstr' ) { #delete all other records + foreach my $domain_record ( reverse $self->svc_domain->domain_record ) { + my $error = $domain_record->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + } + my $error = $self->SUPER::insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -265,6 +275,7 @@ sub check { =cut sub increment_serial { + return '' if $noserial_hack; my $self = shift; my $soa = qsearchs('domain_record', { @@ -283,11 +294,22 @@ sub increment_serial { $new->replace($soa); } +=item svc_domain + +Returns the domain (see L $self->svcnum } ); +} + =back =head1 VERSION -$Id: domain_record.pm,v 1.8 2002-05-22 18:44:01 ivan Exp $ +$Id: domain_record.pm,v 1.9 2002-05-23 13:00:08 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From ee1a01a4d001bf993b9cce54e59f119db20e49f0 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 28 May 2002 07:55:20 +0000 Subject: point people at DBI/DBD documentation for information on data sources. *sigh* --- FS/FS/part_export.pm | 4 ++-- FS/FS/part_export/shellcommands.pm | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 8a7ac8bf9..89625420e 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -496,7 +496,7 @@ tie my %shellcommands_options, 'Tie::IxHash', ; tie my %sqlradius_options, 'Tie::IxHash', - 'datasrc' => { label=>'DBI data source' }, + 'datasrc' => { label=>'DBI data source ' }, 'username' => { label=>'Database username' }, 'password' => { label=>'Database password' }, ; @@ -581,7 +581,7 @@ tie my %bind_slave_options, 'Tie::IxHash', 'desc' => 'Real-time export to SQL-backed RADIUS (ICRADIUS, FreeRADIUS)', 'options' => \%sqlradius_options, 'nodomain' => 'Y', - 'notes' => 'Real-time export of radcheck, radreply and usergroup tables to any SQL database for FreeRADIUS or ICRADIUS. Use freeside-sqlradius-reset to delete and repopulate the tables from the Freeside database.', + 'notes' => 'Real-time export of radcheck, radreply and usergroup tables to any SQL database for FreeRADIUS or ICRADIUS. Use freeside-sqlradius-reset to delete and repopulate the tables from the Freeside database. See the DBI documentation and the documentation for your DBD for the exact syntax of a DBI data source.', }, 'cyrus' => { diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm index ccde72a68..7a87bd3e0 100644 --- a/FS/FS/part_export/shellcommands.pm +++ b/FS/FS/part_export/shellcommands.pm @@ -22,7 +22,7 @@ sub _export_command { my $command = $self->option($action); no strict 'refs'; ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields; - $self->shellcommands_queue( + $self->shellcommands_queue( $svc_acct->svcnum, $self->options('user')||'root'. "\@". $self->options('machine'), eval(qq("$command")) ); @@ -34,7 +34,7 @@ sub _export_replace { no strict 'refs'; ${"old_$_"} = $old->getfield($_) foreach $old->fields; ${"new_$_"} = $new->getfield($_) foreach $new->fields; - $self->shellcommands_queue( + $self->shellcommands_queue( $new->svcnum, $self->options('user')||'root'. "\@". $self->options('machine'), eval(qq("$command")) ); -- cgit v1.2.1 From 97646ed2e0ad524f959f9dc2632fa2fea25f5010 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 28 May 2002 21:22:15 +0000 Subject: better error message for "Illegal password" --- FS/FS/svc_acct.pm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 17ae41583..a43f97ab5 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -676,7 +676,9 @@ sub check { $recref->{_password} = '!!'; } else { #return "Illegal password"; - return gettext('illegal_password'). ": ". $recref->{_password}; + return gettext('illegal_password'). "$passwordmin-$passwordmax". + FS::Msgcat::_gettext('illegal_password_characters'). + ": ". $recref->{_password}; } ''; #no error -- cgit v1.2.1 From 23c7d48df691c406aecb84776437698447405518 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 29 May 2002 15:56:02 +0000 Subject: freeradius 0.5 doc --- FS/FS/part_export.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 89625420e..1d4ec23cd 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -581,7 +581,7 @@ tie my %bind_slave_options, 'Tie::IxHash', 'desc' => 'Real-time export to SQL-backed RADIUS (ICRADIUS, FreeRADIUS)', 'options' => \%sqlradius_options, 'nodomain' => 'Y', - 'notes' => 'Real-time export of radcheck, radreply and usergroup tables to any SQL database for FreeRADIUS or ICRADIUS. Use freeside-sqlradius-reset to delete and repopulate the tables from the Freeside database. See the DBI documentation and the documentation for your DBD for the exact syntax of a DBI data source.', + 'notes' => 'Real-time export of radcheck, radreply and usergroup tables to any SQL database for FreeRADIUS or ICRADIUS. Use freeside-sqlradius-reset to delete and repopulate the tables from the Freeside database. See the DBI documentation and the documentation for your DBD for the exact syntax of a DBI data source. If using FreeRADIUS 0.5 or above, make sure your op fields are set to allow NULL values.', }, 'cyrus' => { -- cgit v1.2.1 From 4aaa65f643469cf2df1d97f5e12e05d0122d9570 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 29 May 2002 20:45:04 +0000 Subject: eliminate harmless "Database handle destroyed without explicit disconnect" errors --- FS/bin/freeside-sqlradius-reset | 1 + 1 file changed, 1 insertion(+) (limited to 'FS') diff --git a/FS/bin/freeside-sqlradius-reset b/FS/bin/freeside-sqlradius-reset index 132be754a..41f3358f6 100755 --- a/FS/bin/freeside-sqlradius-reset +++ b/FS/bin/freeside-sqlradius-reset @@ -22,6 +22,7 @@ foreach my $export ( @exports ) { my $sth = $icradius_dbh->prepare("DELETE FROM $table"); $sth->execute or die "Can't reset $table table: ". $sth->errstr; } + $icradius_dbh->disconnect; } foreach my $export ( @exports ) { -- cgit v1.2.1 From 03809f7b4f5a7ff34adaba7dd5d4cdf1039fbd22 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 30 May 2002 17:49:18 +0000 Subject: GRRRRRRRRRRRRR --- FS/FS/part_export.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 1d4ec23cd..08e436da0 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -370,7 +370,7 @@ sub rebless { my $self = shift; my $exporttype = $self->exporttype; my $class = ref($self). "::$exporttype"; - eval "use $class;"; + eval "use $class;" or die $@; bless($self, $class); } -- cgit v1.2.1 From cf4a05afd3aea5747e16e8dcb426f9552aaef444 Mon Sep 17 00:00:00 2001 From: khoff Date: Fri, 31 May 2002 00:18:57 +0000 Subject: Moved new-style export calls to svc_Common. --- FS/FS/svc_Common.pm | 81 +++++++++++++++++++++++++++++++++++++++++++++++++++-- FS/FS/svc_acct.pm | 36 ------------------------ FS/FS/svc_domain.pm | 7 +++-- 3 files changed, 83 insertions(+), 41 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_Common.pm b/FS/FS/svc_Common.pm index ee190fb8d..5cddb91cf 100644 --- a/FS/FS/svc_Common.pm +++ b/FS/FS/svc_Common.pm @@ -1,7 +1,7 @@ package FS::svc_Common; use strict; -use vars qw( @ISA ); +use vars qw( @ISA $noexport_hack ); use FS::Record qw( qsearchs fields dbh ); use FS::cust_svc; use FS::part_svc; @@ -85,6 +85,18 @@ sub insert { return $error; } + #new-style exports! + unless ( $noexport_hack ) { + foreach my $part_export ( $self->cust_svc->part_svc->part_export ) { + my $error = $part_export->export_insert($self); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "exporting to ". $part_export->exporttype. + " (transaction rolled back): $error"; + } + } + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -112,16 +124,81 @@ sub delete { my $svcnum = $self->svcnum; + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + $error = $self->SUPER::delete; return $error if $error; + #new-style exports! + unless ( $noexport_hack ) { + foreach my $part_export ( $self->cust_svc->part_svc->part_export ) { + my $error = $part_export->export_delete($self); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "exporting to ". $part_export->exporttype. + " (transaction rolled back): $error"; + } + } + } + + return $error if $error; + my $cust_svc = $self->cust_svc; $error = $cust_svc->delete; return $error if $error; + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; +} + +=item replace OLD_RECORD + +Replaces OLD_RECORD with this one. If there is an error, returns the error, +otherwise returns false. + +=cut + +sub replace { + my ($new, $old) = (shift, shift); + my $error; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $new->SUPER::replace($old); + if ($error) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + #new-style exports! + unless ( $noexport_hack ) { + foreach my $part_export ( $new->cust_svc->part_svc->part_export ) { + my $error = $part_export->export_replace($new,$old); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "exporting to ". $part_export->exporttype. + " (transaction rolled back): $error"; + } + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } + =item setfixed Sets any fixed fields for this service (see L). If there is an @@ -215,7 +292,7 @@ sub cancel { ''; } =head1 VERSION -$Id: svc_Common.pm,v 1.8 2002-03-18 16:05:35 ivan Exp $ +$Id: svc_Common.pm,v 1.9 2002-05-31 00:18:56 khoff Exp $ =head1 BUGS diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index a43f97ab5..e3589d846 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -235,18 +235,6 @@ sub insert { } } - #new-style exports! - unless ( $noexport_hack ) { - foreach my $part_export ( $self->cust_svc->part_svc->part_export ) { - my $error = $part_export->export_insert($self); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "exporting to ". $part_export->exporttype. - " (transaction rolled back): $error"; - } - } - } - $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error } @@ -340,18 +328,6 @@ sub delete { return $error; } - #new-style exports! - unless ( $noexport_hack ) { - foreach my $part_export ( $part_svc->part_export ) { - my $error = $part_export->export_delete($self); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "exporting to ". $part_export->exporttype. - " (transaction rolled back): $error"; - } - } - } - $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } @@ -436,18 +412,6 @@ sub replace { } - #new-style exports! - unless ( $noexport_hack ) { - foreach my $part_export ( $new->cust_svc->part_svc->part_export ) { - my $error = $part_export->export_replace($new,$old); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "exporting to ". $part_export->exporttype. - " (transaction rolled back): $error"; - } - } - } - $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error } diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm index a9a2fd0eb..fd57713c8 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -282,6 +282,7 @@ sub delete { return $error; } } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; } =item replace OLD_RECORD @@ -298,8 +299,8 @@ sub replace { return "Can't change domain - reorder." if $old->getfield('domain') ne $new->getfield('domain'); - $new->SUPER::replace($old); - + my $error = $new->SUPER::replace($old); + return $error if $error; } =item suspend @@ -450,7 +451,7 @@ sub submit_internic { =head1 VERSION -$Id: svc_domain.pm,v 1.29 2002-05-22 18:44:01 ivan Exp $ +$Id: svc_domain.pm,v 1.30 2002-05-31 00:18:57 khoff Exp $ =head1 BUGS -- cgit v1.2.1 From 3c3b524da13f32623eca3c0889350b912ec41605 Mon Sep 17 00:00:00 2001 From: khoff Date: Fri, 31 May 2002 00:20:38 +0000 Subject: part_export module to export svc_acct, svc_domain, and svc_forward to an external database --- FS/FS/part_export/sqlmail.pm | 111 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 111 insertions(+) create mode 100644 FS/FS/part_export/sqlmail.pm (limited to 'FS') diff --git a/FS/FS/part_export/sqlmail.pm b/FS/FS/part_export/sqlmail.pm new file mode 100644 index 000000000..4194daf0c --- /dev/null +++ b/FS/FS/part_export/sqlmail.pm @@ -0,0 +1,111 @@ +package FS::part_export::sqlmail; + +use vars qw(@ISA %fs_mail_table %fields); +use FS::part_export; + +@ISA = qw(FS::part_export); + +%fs_mail_table = ( svc_acct => 'user', + svc_domain => 'domain' ); + +# fields that need to be copied into the fs_mail tables +$fields{user} = [qw(username _password finger domsvc svcnum )]; +$fields{domain} = [qw(domain svcnum catchall )]; + +sub rebless { shift; } + +sub _export_insert { + my($self, $svc) = (shift, shift); + # this is a svc_something. + + my $table = $fs_mail_table{$svc->cust_svc->part_svc->svcdb}; + my @attrib = map {$svc->$_} @{$fields{$table}}; + my $error = $self->sqlmail_queue( $svc->svcnum, 'insert', + $table, @attrib ); + return $error if $error; + ''; +} + +sub _export_replace { + my( $self, $new, $old ) = (shift, shift, shift); + + my $table = $fs_mail_table{$new->cust_svc->part_svc->svcdb}; + + my @old = ($old->svcnum, 'delete', $table, $old->svcnum); + my @narf = map {$new->$_} @{$fields{$table}}; + $self->sqlmail_queue($new->svcnum, 'replace', $table, + $new->svcnum, @narf); + + return $error if $error; + ''; +} + +sub _export_delete { + my( $self, $svc ) = (shift, shift); + my $table = $fs_mail_table{$new->cust_svc->part_svc->svcdb}; + $self->sqlmail_queue( $svc->svcnum, 'delete', $table, + $svc->svcnum ); +} + +sub sqlmail_queue { + my( $self, $svcnum, $method, $table ) = (shift, shift, shift); + my $queue = new FS::queue { + 'svcnum' => $svcnum, + 'job' => "FS::part_export::sqlmail::sqlmail_$method", + }; + $queue->insert( + $self->option('datasrc'), + $self->option('username'), + $self->option('password'), + @_, + ); +} + +sub sqlmail_insert { #subroutine, not method + my $dbh = sqlmail_connect(shift, shift, shift); + my( $table, @attrib ) = @_; + + my $sth = $dbh->prepare( + "INSERT INTO $table (" . join (',', @{$fields{$table}}) . + ") VALUES ('" . join ("','", @attrib) . "')" + ) or die $dbh->errstr; + $sth->execute() or die $sth->errstr; + + $dbh->disconnect; +} + +sub sqlmail_delete { #subroutine, not method + my $dbh = sqlmail_connect(shift, shift, shift); + my( $table, $svcnum ) = @_; + + my $sth = $dbh->prepare( + "DELETE FROM $table WHERE svcnum = $svcnum" + ) or die $dbh->errstr; + $sth->execute() or die $sth->errstr; + + $dbh->disconnect; +} + +sub sqlmail_replace { + my $dbh = sqlmail_connect(shift, shift, shift); + my( $table, $svcnum, @attrib ) = @_; + + my %data; + @data{@{$fields{$table}}} = @attrib; + + my $sth = $dbh->prepare( + "UPDATE $table SET " . + ( join ',', map {$_ . "='" . $data{$_} . "'"} keys(%data) ) . + " WHERE svcnum = $svcnum" + ) or die $dbh->errstr; + $sth->execute() or die $sth->errstr; + + $dbh->disconnect; +} + +sub sqlmail_connect { + #my($datasrc, $username, $password) = @_; + #DBI->connect($datasrc, $username, $password) or die $DBI::errstr; + DBI->connect(@_) or die $DBI::errstr; +} + -- cgit v1.2.1 From bbbdd40d71fa66405224872a173a080a7a7dbfef Mon Sep 17 00:00:00 2001 From: khoff Date: Fri, 31 May 2002 00:22:09 +0000 Subject: updated hashes 'n stuff for FS::part_export::sqlmail --- FS/FS/part_export.pm | 40 ++++++++++++++++++++++++++++++++++++++-- 1 file changed, 38 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 08e436da0..14e4676e9 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -370,7 +370,8 @@ sub rebless { my $self = shift; my $exporttype = $self->exporttype; my $class = ref($self). "::$exporttype"; - eval "use $class;" or die $@; +# eval "use $class;" or die $@; + eval "use $class;"; bless($self, $class); } @@ -465,6 +466,12 @@ Returns the applicable I for an I. =cut +# This subroutine should be modified or removed. In its present form, it +# imposes the arbitrary restriction that no export type can be associated +# with more than one svcdb. The only place it's used is in edit/part_svc.cgi +# to generate the list of allowed exports, which can be done more cleanly by +# export_info anyway. + sub exporttype2svcdb { my $exporttype = $_[0]; foreach my $svcdb ( keys %exports ) { @@ -545,6 +552,11 @@ tie my %bind_slave_options, 'Tie::IxHash', default => '/etc/bind/named.conf' }, ; +tie my %sqlmail_options, 'Tie::IxHash', + 'datasrc' => { label=>'DBI data source' }, + 'username' => { label=>'Database username' }, + 'password' => { label=>'Database password' }, +; #export names cannot have dashes... @@ -584,6 +596,14 @@ tie my %bind_slave_options, 'Tie::IxHash', 'notes' => 'Real-time export of radcheck, radreply and usergroup tables to any SQL database for FreeRADIUS or ICRADIUS. Use freeside-sqlradius-reset to delete and repopulate the tables from the Freeside database. See the DBI documentation and the documentation for your DBD for the exact syntax of a DBI data source. If using FreeRADIUS 0.5 or above, make sure your op fields are set to allow NULL values.', }, + 'sqlmail' => { + 'desc' => 'Real-time export to SQL-backed mail server', + 'options' => \%sqlmail_options, + 'nodomain' => 'Y', + 'notes' => 'Database schema can be made to work with Courier IMAP and + Exim. Others could work but are untested.', + }, + 'cyrus' => { 'desc' => 'Real-time export to Cyrus IMAP server', 'options' => \%cyrus_options, @@ -627,12 +647,28 @@ tie my %bind_slave_options, 'Tie::IxHash', 'notes' => 'bind export notes (secondary munge) File::Rsync dependancy, run bind.export', }, + 'sqlmail' => { + 'desc' => 'Real-time export to SQL-backed mail server', + 'options' => \%sqlmail_options, + 'nodomain' => 'Y', + 'notes' => 'Database schema can be made to work with Courier IMAP and + Exim. Others could work but are untested.', + }, + }, 'svc_acct_sm' => {}, - 'svc_forward' => {}, + 'svc_forward' => { + 'sqlmail' => { + 'desc' => 'Real-time export to SQL-backed mail server', + 'options' => \%sqlmail_options, + 'nodomain' => 'Y', + 'notes' => 'Database schema can be made to work with Courier IMAP and + Exim. Others could work but are untested.', + }, + }, 'svc_www' => {}, -- cgit v1.2.1 From 19416b51cad45853a7cf620af6bbde7973bedbe5 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 31 May 2002 02:13:23 +0000 Subject: no, actually throw an exception if an export class won't compile. --- FS/FS/part_export.pm | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 14e4676e9..f4f46b0e9 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -370,8 +370,7 @@ sub rebless { my $self = shift; my $exporttype = $self->exporttype; my $class = ref($self). "::$exporttype"; -# eval "use $class;" or die $@; - eval "use $class;"; + eval "use $class;" or die $@; bless($self, $class); } -- cgit v1.2.1 From 7c50e5b2a527bf475860d682826b8e7229af1c59 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 31 May 2002 17:50:37 +0000 Subject: typo noticed by --- FS/FS/svc_forward.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_forward.pm b/FS/FS/svc_forward.pm index 12f8b9236..1c5b5c40d 100644 --- a/FS/FS/svc_forward.pm +++ b/FS/FS/svc_forward.pm @@ -402,7 +402,7 @@ sub check { return "Unknown srcsvc" unless $self->srcsvc_acct; - return "Both dstsvc and dst were defined; one one can be specified" + return "Both dstsvc and dst were defined; only one can be specified" if $self->dstsvc && $self->dst; return "one of dstsvc or dst is required" @@ -452,7 +452,7 @@ sub dstsvc_acct { =head1 VERSION -$Id: svc_forward.pm,v 1.11 2002-02-20 01:03:09 ivan Exp $ +$Id: svc_forward.pm,v 1.12 2002-05-31 17:50:37 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 9dbe1e81eaad947203f196165a5c10c7f40da8a8 Mon Sep 17 00:00:00 2001 From: khoff Date: Fri, 31 May 2002 18:45:13 +0000 Subject: added sqlmail.pm and test --- FS/MANIFEST | 2 ++ 1 file changed, 2 insertions(+) (limited to 'FS') diff --git a/FS/MANIFEST b/FS/MANIFEST index 4c6d243df..daf27b7e4 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -54,6 +54,7 @@ FS/part_export/cp.pm FS/part_export/cyrus.pm FS/part_export/infostreet.pm FS/part_export/shellcommands.pm +FS/part_export/sqlmail.pm FS/part_export/sqlradius.pm FS/part_export/textradius.pm FS/part_export/vpopmail.pm @@ -117,6 +118,7 @@ t/part_export-cp.t t/part_export-cyrus.t t/part_export-infostreet.t t/part_export-shellcommands.t +t/part_export-sqlmail.t t/part_export-sqlradius.t t/part_export-textradius.t t/part_export-vpopmail.t -- cgit v1.2.1 From 2b98ba63e33b3ab12d3561cf1179911eedcdbde4 Mon Sep 17 00:00:00 2001 From: khoff Date: Fri, 31 May 2002 18:48:13 +0000 Subject: Don't ask me. I just hacked Ivan's test. --- FS/t/part_export-sqlmail.t | 5 +++++ 1 file changed, 5 insertions(+) create mode 100644 FS/t/part_export-sqlmail.t (limited to 'FS') diff --git a/FS/t/part_export-sqlmail.t b/FS/t/part_export-sqlmail.t new file mode 100644 index 000000000..b048a75a5 --- /dev/null +++ b/FS/t/part_export-sqlmail.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::sqlmail; +$loaded=1; +print "ok 1\n"; -- cgit v1.2.1 From 439a47a6cfd81793c34bf5ded2cee3bb29becfe4 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 31 May 2002 20:31:05 +0000 Subject: better error reporting --- FS/FS/cust_bill.pm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index e2705fd83..f67ef96aa 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -726,8 +726,10 @@ sub batch_card { 'payname' => $cust_main->getfield('payname'), 'amount' => $self->owed, } ); - $cust_pay_batch->insert; + my $error = $cust_pay_batch->insert; + die $error if $error; + ''; } =item print_text [TIME]; @@ -948,7 +950,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.35 2002-05-18 09:51:30 ivan Exp $ +$Id: cust_bill.pm,v 1.36 2002-05-31 20:31:05 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 0466aab2988c550d1ff76c0017059c06228c2045 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 31 May 2002 20:34:03 +0000 Subject: dammit i want to catch export subclass compilation problems --- FS/FS/part_export.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index f4f46b0e9..ae201464d 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -370,7 +370,8 @@ sub rebless { my $self = shift; my $exporttype = $self->exporttype; my $class = ref($self). "::$exporttype"; - eval "use $class;" or die $@; + eval "use $class;"; + die $@ if $@; bless($self, $class); } -- cgit v1.2.1 From 0f298b30924be46dd3660ed0525f7b1b6f2d3353 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 4 Jun 2002 14:35:52 +0000 Subject: fix unsuspendauto --- FS/FS/cust_credit.pm | 6 +++--- FS/FS/cust_pay.pm | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm index 0ce5ac614..284d59de2 100644 --- a/FS/FS/cust_credit.pm +++ b/FS/FS/cust_credit.pm @@ -104,8 +104,6 @@ sub insert { return "error inserting $self: $error"; } - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - #false laziness w/ cust_credit::insert if ( $unsuspendauto && $old_balance && $cust_main->balance <= 0 ) { my @errors = $cust_main->unsuspend; @@ -117,6 +115,8 @@ sub insert { } #eslaf + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; } @@ -242,7 +242,7 @@ sub credited { =head1 VERSION -$Id: cust_credit.pm,v 1.15 2002-01-28 06:57:23 ivan Exp $ +$Id: cust_credit.pm,v 1.16 2002-06-04 14:35:52 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index fcd902b1b..98eba704b 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -152,8 +152,6 @@ sub insert { } } - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - #false laziness w/ cust_credit::insert if ( $unsuspendauto && $old_balance && $cust_main->balance <= 0 ) { my @errors = $cust_main->unsuspend; @@ -165,6 +163,8 @@ sub insert { } #eslaf + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; } @@ -405,7 +405,7 @@ sub unapplied { =head1 VERSION -$Id: cust_pay.pm,v 1.20 2002-05-18 09:51:30 ivan Exp $ +$Id: cust_pay.pm,v 1.21 2002-06-04 14:35:52 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 0ada85923cfb057caf1d0e66b73a08b2700703bd Mon Sep 17 00:00:00 2001 From: khoff Date: Fri, 7 Jun 2002 20:33:27 +0000 Subject: Setup hash for CC failed Text::Template --- FS/FS/cust_bill.pm | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index f67ef96aa..20755857b 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -525,6 +525,7 @@ sub realtime_card { if ( $transaction->is_success() && $action2 ) { my $auth = $transaction->authorization; my $ordernum = $transaction->order_number; + #warn "********* $auth ***********\n"; #warn "********* $ordernum ***********\n"; my $capture = @@ -590,7 +591,7 @@ sub realtime_card { $template->compile() or return "($perror) can't compile template: $Text::Template::ERROR"; - my $error = $transaction->error_message; + my $templ_hash = { error => $transaction->error_message }; #false laziness w/FS::cust_pay::delete & fs_signup_server && ::send $ENV{MAILADDRESS} = $invoice_from; @@ -604,7 +605,7 @@ sub realtime_card { ] ); my $message = new Mail::Internet ( 'Header' => $header, - 'Body' => [ $template->fill_in() ], + 'Body' => [ $template->fill_in(HASH => $templ_hash) ], ); $!=0; $message->smtpsend( Host => $smtpmachine ) @@ -950,7 +951,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.36 2002-05-31 20:31:05 ivan Exp $ +$Id: cust_bill.pm,v 1.37 2002-06-07 20:33:27 khoff Exp $ =head1 BUGS -- cgit v1.2.1 From 0e8861ca6b3b04b99ea9477e8c1555561b21c929 Mon Sep 17 00:00:00 2001 From: khoff Date: Sat, 8 Jun 2002 07:48:37 +0000 Subject: Default svcpart support for part_pkg. Fixes 'bug' with new customer and online signup. --- FS/FS/part_pkg.pm | 22 ++++++++++++++++++++-- FS/FS/pkg_svc.pm | 32 +++++++++++++++++++++++++++++--- 2 files changed, 49 insertions(+), 5 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index 9c33e9a3b..420ffcb3d 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -2,7 +2,7 @@ package FS::part_pkg; use strict; use vars qw( @ISA ); -use FS::Record qw( qsearch dbh ); +use FS::Record qw( qsearch qsearchs dbh ); use FS::pkg_svc; use FS::agent_type; use FS::type_pkgs; @@ -225,6 +225,12 @@ sub check { } + if ($self->def_svcpart and my @pkg_svc = $self->pkg_svc) { + unless (grep { $_->svcpart == $self->def_svcpart } @pkg_svc) { + return "no svcparts for this package match def_svcpart ".$self->def_svcpart; + } + } + $self->ut_numbern('pkgpart') || $self->ut_text('pkg') || $self->ut_text('comment') @@ -259,11 +265,23 @@ associated with this billing item definition (see L). 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, +If the part_pkg has a nonzero def_svcpart, it takes precedence, even if it has +quantity > 1 and/or there are other service definitions, UNLESS SVCDB is specified +and doesn't match the svcdb of the def_svcpart. + =cut sub svcpart { my $self = shift; my $svcdb = shift; + + if ($self->def_svcpart) { + if ((not $svcdb) or qsearchs('part_svc', { svcpart => $self->def_svcpart, + svcdb => $svcdb })) { + return $self->def_svcpart; + } + } + my @pkg_svc = $self->pkg_svc; return '' if scalar(@pkg_svc) != 1 || $pkg_svc[0]->quantity != 1 @@ -297,7 +315,7 @@ sub payby { =head1 VERSION -$Id: part_pkg.pm,v 1.14 2002-05-09 12:38:39 ivan Exp $ +$Id: part_pkg.pm,v 1.15 2002-06-08 07:48:36 khoff Exp $ =head1 BUGS diff --git a/FS/FS/pkg_svc.pm b/FS/FS/pkg_svc.pm index 1812dbf29..d64d10db2 100644 --- a/FS/FS/pkg_svc.pm +++ b/FS/FS/pkg_svc.pm @@ -67,8 +67,24 @@ otherwise returns false. =item delete -Deletes this record from the database. If there is an error, returns the -error, otherwise returns false. +Deletes this record from the database. If this svcpart is also the default svcpart, +we set part_pkg.def_svcpart to NULL. If there is an error, returns the error, +otherwise returns false. + +sub delete { + my $self = shift; + my $part_pkg = qsearchs( 'part_pkg', { pkgpart => $self->pkgpart } ); + + # Should this be wrapped in a transaction? + if ( $part_pkg->def_svcpart == $self->svcpart ) { + my $new = new FS::part_pkg $part_pkg->hash; + $new->def_svcpart = 0; + my $error = $new->replace($part_pkg); + return $error if $error; + } + + $self->SUPER::delete; +} =item replace OLD_RECORD @@ -83,6 +99,16 @@ sub replace { return "Can't change pkgpart!" if $old->pkgpart != $new->pkgpart; return "Can't change svcpart!" if $old->svcpart != $new->svcpart; + my $part_pkg = qsearchs( 'part_pkg', { pkgpart => $new->pkgpart } ); + + # Should this be wrapped in a transaction? + if ( ($part_pkg->def_svcpart == $new->svcpart) && ($new->quantity == 0) ) { + my $new_part_pkg = new FS::part_pkg $part_pkg->hash; + $new_part_pkg->def_svcpart = 0; + my $error = $new_part_pkg->replace($part_pkg); + return $error if $error; + } + $new->SUPER::replace($old); } @@ -137,7 +163,7 @@ sub part_svc { =head1 VERSION -$Id: pkg_svc.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ +$Id: pkg_svc.pm,v 1.2 2002-06-08 07:48:37 khoff Exp $ =head1 BUGS -- cgit v1.2.1 From 3162b06a6d3be9ddf4daea2c29cd94516ac40f68 Mon Sep 17 00:00:00 2001 From: khoff Date: Mon, 10 Jun 2002 01:39:51 +0000 Subject: Rollback part_pkg.def_svcpart changes. --- FS/FS/part_pkg.pm | 22 ++-------------------- FS/FS/pkg_svc.pm | 32 +++----------------------------- 2 files changed, 5 insertions(+), 49 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index 420ffcb3d..e914636e4 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -2,7 +2,7 @@ package FS::part_pkg; use strict; use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs dbh ); +use FS::Record qw( qsearch dbh ); use FS::pkg_svc; use FS::agent_type; use FS::type_pkgs; @@ -225,12 +225,6 @@ sub check { } - if ($self->def_svcpart and my @pkg_svc = $self->pkg_svc) { - unless (grep { $_->svcpart == $self->def_svcpart } @pkg_svc) { - return "no svcparts for this package match def_svcpart ".$self->def_svcpart; - } - } - $self->ut_numbern('pkgpart') || $self->ut_text('pkg') || $self->ut_text('comment') @@ -265,23 +259,11 @@ associated with this billing item definition (see L). 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, -If the part_pkg has a nonzero def_svcpart, it takes precedence, even if it has -quantity > 1 and/or there are other service definitions, UNLESS SVCDB is specified -and doesn't match the svcdb of the def_svcpart. - =cut sub svcpart { my $self = shift; my $svcdb = shift; - - if ($self->def_svcpart) { - if ((not $svcdb) or qsearchs('part_svc', { svcpart => $self->def_svcpart, - svcdb => $svcdb })) { - return $self->def_svcpart; - } - } - my @pkg_svc = $self->pkg_svc; return '' if scalar(@pkg_svc) != 1 || $pkg_svc[0]->quantity != 1 @@ -315,7 +297,7 @@ sub payby { =head1 VERSION -$Id: part_pkg.pm,v 1.15 2002-06-08 07:48:36 khoff Exp $ +$Id: part_pkg.pm,v 1.16 2002-06-10 01:39:50 khoff Exp $ =head1 BUGS diff --git a/FS/FS/pkg_svc.pm b/FS/FS/pkg_svc.pm index d64d10db2..3c544ffd8 100644 --- a/FS/FS/pkg_svc.pm +++ b/FS/FS/pkg_svc.pm @@ -67,24 +67,8 @@ otherwise returns false. =item delete -Deletes this record from the database. If this svcpart is also the default svcpart, -we set part_pkg.def_svcpart to NULL. If there is an error, returns the error, -otherwise returns false. - -sub delete { - my $self = shift; - my $part_pkg = qsearchs( 'part_pkg', { pkgpart => $self->pkgpart } ); - - # Should this be wrapped in a transaction? - if ( $part_pkg->def_svcpart == $self->svcpart ) { - my $new = new FS::part_pkg $part_pkg->hash; - $new->def_svcpart = 0; - my $error = $new->replace($part_pkg); - return $error if $error; - } - - $self->SUPER::delete; -} +Deletes this record from the database. If there is an error, returns the +error, otherwise returns false. =item replace OLD_RECORD @@ -99,16 +83,6 @@ sub replace { return "Can't change pkgpart!" if $old->pkgpart != $new->pkgpart; return "Can't change svcpart!" if $old->svcpart != $new->svcpart; - my $part_pkg = qsearchs( 'part_pkg', { pkgpart => $new->pkgpart } ); - - # Should this be wrapped in a transaction? - if ( ($part_pkg->def_svcpart == $new->svcpart) && ($new->quantity == 0) ) { - my $new_part_pkg = new FS::part_pkg $part_pkg->hash; - $new_part_pkg->def_svcpart = 0; - my $error = $new_part_pkg->replace($part_pkg); - return $error if $error; - } - $new->SUPER::replace($old); } @@ -163,7 +137,7 @@ sub part_svc { =head1 VERSION -$Id: pkg_svc.pm,v 1.2 2002-06-08 07:48:37 khoff Exp $ +$Id: pkg_svc.pm,v 1.3 2002-06-10 01:39:50 khoff Exp $ =head1 BUGS -- cgit v1.2.1 From 27fc2f8819d8f144efc7b131c5824cc73938d06c Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 10 Jun 2002 02:51:53 +0000 Subject: unused global --- FS/FS/CGI.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/CGI.pm b/FS/FS/CGI.pm index 190c0aa37..28b3a06fa 100644 --- a/FS/FS/CGI.pm +++ b/FS/FS/CGI.pm @@ -1,7 +1,7 @@ package FS::CGI; use strict; -use vars qw(@EXPORT_OK @ISA @header); +use vars qw(@EXPORT_OK @ISA); use Exporter; use CGI; use URI::URL; -- cgit v1.2.1 From f6fcf4327c0d5efe31ce3717ba1dae5099eb50cd Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 10 Jun 2002 02:52:20 +0000 Subject: silence undefined warnings --- FS/FS/cust_main_county.pm | 2 ++ 1 file changed, 2 insertions(+) (limited to 'FS') diff --git a/FS/FS/cust_main_county.pm b/FS/FS/cust_main_county.pm index 28f69c262..e41564d21 100644 --- a/FS/FS/cust_main_county.pm +++ b/FS/FS/cust_main_county.pm @@ -128,6 +128,8 @@ sub regionselector { my ( $selected_county, $selected_state, $selected_country, $prefix, $onchange ) = @_; + $prefix = '' unless defined $prefix; + $countyflag = 0; # unless ( @cust_main_county ) { #cache -- cgit v1.2.1 From bdcc6cb95cadf46e4b71e3967de41ccd35f2f047 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 10 Jun 2002 02:52:48 +0000 Subject: re-my'ed var --- FS/FS/svc_Common.pm | 5 ++--- FS/FS/svc_domain.pm | 3 +-- 2 files changed, 3 insertions(+), 5 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_Common.pm b/FS/FS/svc_Common.pm index 5cddb91cf..c804242de 100644 --- a/FS/FS/svc_Common.pm +++ b/FS/FS/svc_Common.pm @@ -163,7 +163,6 @@ otherwise returns false. sub replace { my ($new, $old) = (shift, shift); - my $error; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -188,7 +187,7 @@ sub replace { my $error = $part_export->export_replace($new,$old); if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "exporting to ". $part_export->exporttype. + return "error exporting to ". $part_export->exporttype. " (transaction rolled back): $error"; } } @@ -292,7 +291,7 @@ sub cancel { ''; } =head1 VERSION -$Id: svc_Common.pm,v 1.9 2002-05-31 00:18:56 khoff Exp $ +$Id: svc_Common.pm,v 1.10 2002-06-10 02:52:37 ivan Exp $ =head1 BUGS diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm index fd57713c8..b06d03013 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -294,7 +294,6 @@ returns the error, otherwise returns false. sub replace { my ( $new, $old ) = ( shift, shift ); - my $error; return "Can't change domain - reorder." if $old->getfield('domain') ne $new->getfield('domain'); @@ -451,7 +450,7 @@ sub submit_internic { =head1 VERSION -$Id: svc_domain.pm,v 1.30 2002-05-31 00:18:57 khoff Exp $ +$Id: svc_domain.pm,v 1.31 2002-06-10 02:52:48 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 25354a69186b74866b163d2b5c2b3aa52aa5658c Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 10 Jun 2002 22:07:24 +0000 Subject: retry realtime_card invoice events when a card changes (closes: Bug#417) --- FS/FS/cust_bill_event.pm | 15 +++++++++++++++ FS/FS/cust_main.pm | 48 +++++++++++++++++++++++++++++++++++++++++++++--- 2 files changed, 60 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill_event.pm b/FS/FS/cust_bill_event.pm index d5ca55f36..f631987aa 100644 --- a/FS/FS/cust_bill_event.pm +++ b/FS/FS/cust_bill_event.pm @@ -143,6 +143,21 @@ sub cust_bill { qsearchs( 'cust_bill', { 'invnum' => $self->invnum } ); } +=item retry + +Changes the status of this event from B to B, allowing it to be +retried. + +=cut + +sub retry { + my $self = shift; + return '' unless $self->status eq 'done'; + my $old = ref($self)->new( { $self->hash } ); + $self->status('failed'); + $self->replace($old); +} + =back =head1 BUGS diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 0faa60ca6..8a0124a9b 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -482,6 +482,27 @@ sub replace { $self->invoicing_list( $invoicing_list ); } + if ( $self->payby eq 'CARD' && + grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) { + # card info has changed, want to retry realtime_card invoice events + foreach my $cust_bill_event ( + grep { + #$_->part_bill_event->plan eq 'realtime-card' + $_->part_bill_event->eventcode eq '$cust_bill->realtime_card();' + && $_->status eq 'done' + && $_->statustext + } + $self->open_cust_bill->cust_bill_event + ) { + my $error = $cust_bill_event->retry; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error scheduling invoice events for retry: $error"; + } + } + + } + #false laziness with sub insert my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; $error = $queue->insert($self->getfield('last'), $self->company); @@ -1203,9 +1224,7 @@ sub collect { return ''; } - foreach my $cust_bill ( - qsearch('cust_bill', { 'custnum' => $self->custnum, } ) - ) { + foreach my $cust_bill ( $self->cust_bill ) { #this has to be before next's my $amount = sprintf( "%.2f", $balance < $cust_bill->owed @@ -1708,6 +1727,29 @@ sub charge { } +=item cust_bill + +Returns all the invoices (see L) for this customer. + +=cut + +sub cust_bill { + my $self = shift; + qsearch('cust_bill', { 'custnum' => $self->custnum, } ) +} + +=item open_cust_bill + +Returns all the open (owed > 0) invoices (see L) for this +customer. + +=cut + +sub open_cust_bill { + my $self = shift; + grep { $_->owed > 0 } $self->cust_bill; +} + =back =head1 SUBROUTINES -- cgit v1.2.1 From f21edcf70602d7f2ea314d65382bd8c40f51d530 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 10 Jun 2002 22:48:03 +0000 Subject: also retry cards when user clicks "Bill now" (closes: Bug#417) --- FS/FS/cust_main.pm | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 8a0124a9b..b6600fb29 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -485,6 +485,7 @@ sub replace { if ( $self->payby eq 'CARD' && grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) { # card info has changed, want to retry realtime_card invoice events + #false laziness w/collect foreach my $cust_bill_event ( grep { #$_->part_bill_event->plan eq 'realtime-card' @@ -500,6 +501,7 @@ sub replace { return "error scheduling invoice events for retry: $error"; } } + #eslaf } @@ -1192,6 +1194,8 @@ 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. +retry_card - Retry cards even when not scheduled by invoice events. + batch_card - This option is deprecated. See the invoice events web interface to control whether cards are batched or run against a realtime gateway. @@ -1224,6 +1228,26 @@ sub collect { return ''; } + if ( exists($options{'retry_card'}) && $options{'retry_card'} ) { + #false laziness w/replace + foreach my $cust_bill_event ( + grep { + #$_->part_bill_event->plan eq 'realtime-card' + $_->part_bill_event->eventcode eq '$cust_bill->realtime_card();' + && $_->status eq 'done' + && $_->statustext + } + $self->open_cust_bill->cust_bill_event + ) { + my $error = $cust_bill_event->retry; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error scheduling invoice events for retry: $error"; + } + } + #eslaf + } + foreach my $cust_bill ( $self->cust_bill ) { #this has to be before next's @@ -1242,6 +1266,7 @@ sub collect { next unless $amount > 0; + foreach my $part_bill_event ( sort { $a->seconds <=> $b->seconds || $a->weight <=> $b->weight -- cgit v1.2.1 From 75f034098e0dc30b2a34ec4273a8f9fbe1147e5e Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 10 Jun 2002 23:02:41 +0000 Subject: fix *** ERROR: unterminated L<...> at line 299 in file FS/domain_record.pm --- FS/FS/domain_record.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/domain_record.pm b/FS/FS/domain_record.pm index 4ed713c77..03f9e10bb 100644 --- a/FS/FS/domain_record.pm +++ b/FS/FS/domain_record.pm @@ -296,7 +296,7 @@ sub increment_serial { =item svc_domain -Returns the domain (see L) for this record. =cut @@ -309,7 +309,7 @@ sub svc_domain { =head1 VERSION -$Id: domain_record.pm,v 1.9 2002-05-23 13:00:08 ivan Exp $ +$Id: domain_record.pm,v 1.10 2002-06-10 23:02:41 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 6a5e93685fe7d6d3ca00d389338487578a848b84 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 11 Jun 2002 03:25:03 +0000 Subject: - add new suspend and unsuspend export hooks (with null defaults) - infostreet export: actually suspend/unsuspend at infostreet (closes: Bug#418) - infostreet export: set some contact fields @ infostreet (Bug#419) --- FS/FS/part_export.pm | 34 ++++++++++++++++++ FS/FS/part_export/infostreet.pm | 51 +++++++++++++++++++++++++-- FS/FS/svc_Common.pm | 76 ++++++++++++++++++++++++++++++++++++++--- FS/FS/svc_acct.pm | 14 ++++---- 4 files changed, 163 insertions(+), 12 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index ae201464d..bf6072089 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -414,6 +414,26 @@ sub export_delete { $self->_export_delete(@_); } +=item export_suspend + +=cut + +sub export_suspend { + my $self = shift; + $self->rebless; + $self->_export_suspend(@_); +} + +=item export_unsuspend + +=cut + +sub export_unsuspend { + my $self = shift; + $self->rebless; + $self->_export_unsuspend(@_); +} + #fallbacks providing useful error messages intead of infinite loops sub _export_insert { my $self = shift; @@ -430,6 +450,20 @@ sub _export_delete { return "_export_delete: unknown export type ". $self->exporttype; } +#fallbacks providing null operations + +sub _export_suspend { + my $self = shift; + #warn "warning: _export_suspened unimplemented for". ref($self); + ''; +} + +sub _export_unsuspend { + my $self = shift; + #warn "warning: _export_unsuspend unimplemented for ". ref($self); + ''; +} + =back =head1 SUBROUTINES diff --git a/FS/FS/part_export/infostreet.pm b/FS/FS/part_export/infostreet.pm index 2ce556339..8bf227d82 100644 --- a/FS/FS/part_export/infostreet.pm +++ b/FS/FS/part_export/infostreet.pm @@ -1,16 +1,42 @@ package FS::part_export::infostreet; -use vars qw(@ISA); +use vars qw(@ISA %infostreet2cust_main); use FS::part_export; @ISA = qw(FS::part_export); +%infostreet2cust_main = ( + 'firstName' => 'first', + 'lastName' => 'last', + 'address1' => 'address1', + 'address2' => 'address2', + 'city' => 'city', + 'state' => 'state', + 'zipCode' => 'zip', + 'country' => 'country', + 'phoneNumber' => 'dayphone', +); + sub rebless { shift; } sub _export_insert { my( $self, $svc_acct ) = (shift, shift); - $self->infostreet_queue( $svc_acct->svcnum, + my $cust_main = $svc_acct->cust_svc->cust_pkg->cust_main; + my $accountID = $self->infostreet_queue( $svc_acct->svcnum, 'createUser', $svc_acct->username, $svc_acct->_password ); + foreach my $infostreet_field ( keys %infostreet2cust_main ) { + my $error = $self->infostreet_queue( $svc_acct->svcnum, + 'setContactField', $accountID, $infostreet_field, + $cust_main->getfield( $infostreet2cust_main{$infostreet_field} ) ); + return $error if $error; + } + + $self->infostreet_queue( $svc_acct->svcnum, + 'setContactField', $accountID, 'email', $cust_main->invoicing_list ) + #this one is kinda noment-specific + || $self->infostreet_queue( $svc_acct->svcnum, + 'setContactField', $accountID, 'title', $cust_main->agent->agent ); + } sub _export_replace { @@ -28,6 +54,18 @@ sub _export_delete { 'purgeAccount,releaseUsername', $svc_acct->username ); } +sub _export_suspend { + my( $self, $svc_acct ) = (shift, shift); + $self->infostreet_queue( $svc_acct->svcnum, + 'setStatus', $svc_acct->username, 'DISABLED' ); +} + +sub _export_unsuspend { + my( $self, $svc_acct ) = (shift, shift); + $self->infostreet_queue( $svc_acct->svcnum, + 'setStatus', $svc_acct->username, 'ACTIVE' ); +} + sub infostreet_queue { my( $self, $svcnum, $method ) = (shift, shift, shift); my $queue = new FS::queue { @@ -68,8 +106,17 @@ sub infostreet_command { #subroutine, not method my %result = _infostreet_parse($result); die $result{error} unless $result{success}; + $result->{data}; + } +#sub infostreet_command_byid { #subroutine, not method; +# my($url, $username, $password, $groupID, $method, @args ) = @_; +# +# infostreet_command +# +#} + sub _infostreet_parse { #subroutine, not method my $arg = shift; map { diff --git a/FS/FS/svc_Common.pm b/FS/FS/svc_Common.pm index c804242de..cd278efb5 100644 --- a/FS/FS/svc_Common.pm +++ b/FS/FS/svc_Common.pm @@ -274,24 +274,92 @@ sub cust_svc { =item suspend +Runs export_suspend callbacks. + +=cut + +sub suspend { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + #new-style exports! + unless ( $noexport_hack ) { + foreach my $part_export ( $self->cust_svc->part_svc->part_export ) { + my $error = $part_export->export_suspend($self); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error exporting to ". $part_export->exporttype. + " (transaction rolled back): $error"; + } + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + =item unsuspend +Runs export_unsuspend callbacks. + +=cut + +sub unsuspend { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + #new-style exports! + unless ( $noexport_hack ) { + foreach my $part_export ( $self->cust_svc->part_svc->part_export ) { + my $error = $part_export->export_unsuspend($self); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error exporting to ". $part_export->exporttype. + " (transaction rolled back): $error"; + } + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + =item cancel -Stubs - return false (no error) so derived classes don't need to define these +Stub - returns false (no error) so derived classes don't need to define these methods. Called by the cancel method of FS::cust_pkg (see L). =cut -sub suspend { ''; } -sub unsuspend { ''; } sub cancel { ''; } =back =head1 VERSION -$Id: svc_Common.pm,v 1.10 2002-06-10 02:52:37 ivan Exp $ +$Id: svc_Common.pm,v 1.11 2002-06-11 03:25:03 ivan Exp $ =head1 BUGS diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index e3589d846..f0b0abc2a 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -433,10 +433,11 @@ sub suspend { ) { $hash{_password} = '*SUSPENDED* '.$hash{_password}; my $new = new FS::svc_acct ( \%hash ); - $new->replace($self); - } else { - ''; #no error (already suspended) + my $error = $new->replace($self); + return $error if $error; } + + $self->SUPER::suspend; } =item unsuspend @@ -454,10 +455,11 @@ sub unsuspend { if ( $hash{_password} =~ /^\*SUSPENDED\* (.*)$/ ) { $hash{_password} = $1; my $new = new FS::svc_acct ( \%hash ); - $new->replace($self); - } else { - ''; #no error (already unsuspended) + my $error = $new->replace($self); + return $error if $error; } + + $self->SUPER::unsuspend; } =item cancel -- cgit v1.2.1 From 0ff28424ec1178ba6369d643d3b5f43d51a17514 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 11 Jun 2002 08:29:09 +0000 Subject: add crypt option to (bsd|sysv)shell export --- FS/FS/part_export.pm | 26 ++++++++++++++++++++++---- 1 file changed, 22 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index bf6072089..7661d7e10 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -514,6 +514,20 @@ sub exporttype2svcdb { ''; } +tie my %sysvshell_options, 'Tie::IxHash', + 'crypt' => { label=>'Password encryption', + type=>'select', options=>[qw(crypt md5)], + default=>'crypt', + }, +; + +tie my %bsdshell_options, 'Tie::IxHash', + 'crypt' => { label=>'Password encryption', + type=>'select', options=>[qw(crypt md5)], + default=>'crypt', + }, +; + tie my %shellcommands_options, 'Tie::IxHash', #'machine' => { label=>'Remote machine' }, 'user' => { label=>'Remote username', default=>'root' }, @@ -599,12 +613,16 @@ tie my %sqlmail_options, 'Tie::IxHash', 'sysvshell' => { 'desc' => 'Batch export of /etc/passwd and /etc/shadow files (Linux/SysV)', - 'options' => {}, + 'options' => \%sysvshell_options, + 'nodomain' => 'Y', + 'notes' => 'MD5 crypt requires installation of Crypt::PasswdMD5 from CPAN.', }, 'bsdshell' => { 'desc' => 'Batch export of /etc/passwd and /etc/master.passwd files (BSD)', - 'options' => {}, + 'options' => \%bsdshell_options, + 'nodomain' => 'Y', + 'notes' => 'MD5 crypt requires installation of Crypt::PasswdMD5 from CPAN.', }, # 'nis' => { # 'desc' => @@ -614,6 +632,7 @@ tie my %sqlmail_options, 'Tie::IxHash', 'textradius' => { 'desc' => 'Batch export of a text /etc/raddb/users file (Livingston, Cistron)', 'options' => {}, + 'notes' => 'unfinished...', }, 'shellcommands' => { @@ -634,8 +653,7 @@ tie my %sqlmail_options, 'Tie::IxHash', 'desc' => 'Real-time export to SQL-backed mail server', 'options' => \%sqlmail_options, 'nodomain' => 'Y', - 'notes' => 'Database schema can be made to work with Courier IMAP and - Exim. Others could work but are untested.', + 'notes' => 'Database schema can be made to work with Courier IMAP and Exim. Others could work but are untested.', }, 'cyrus' => { -- cgit v1.2.1 From b475b428df20541c8f2dec5c9ef101ebb9f1cf94 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 11 Jun 2002 09:14:02 +0000 Subject: export-based duplicate username checking! --- FS/FS/svc_acct.pm | 67 +++++++++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 63 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index f0b0abc2a..03230dd06 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -25,6 +25,8 @@ use FS::svc_domain; use FS::raddb; use FS::queue; use FS::radius_usergroup; +use FS::export_svc; +use FS::part_export; use FS::Msgcat qw(gettext); @ISA = qw( FS::svc_Common ); @@ -191,10 +193,67 @@ sub insert { $error = $self->check; return $error if $error; - return gettext('username_in_use'). ": ". $self->username - if qsearchs( 'svc_acct', { 'username' => $self->username, - 'domsvc' => $self->domsvc, - } ); + #no, duplicate checking just got a whole lot more complicated + + #return gettext('username_in_use'). ": ". $self->username + # if qsearchs( 'svc_acct', { 'username' => $self->username, + # 'domsvc' => $self->domsvc, + # } ); + + my @dup_user = qsearch( 'svc_acct', { 'username' => $self->username } ); + my @dup_userdomain = qsearchs( 'svc_acct', { 'username' => $self->username, + 'domsvc' => $self->domsvc } ); + + if ( @dup_user || @dup_userdomain ) { + my $exports = FS::part_export::export_info('svc_acct'); + my( %conflict_user_svcpart, %conflict_userdomain_svcpart ); + + foreach my $part_export ( $self->cust_svc->part_svc->part_export ) { + + #this will catch to the same exact export + my @svcparts = map { $_->svcpart } + qsearch('export_svc', { 'exportnum' => $part_export->exportnum }); + + #this will catch exports w/same exporthost+type ??? + #my @other_part_export = qsearch('part_export', { + # 'machine' => $part_export->machine, + # 'exporttype' => $part_export->exporttype, + #} ); + #foreach my $other_part_export ( @other_part_export ) { + # push @svcparts, map { $_->svcpart } + # qsearch('export_svc', { 'exportnum' => $part_export->exportnum }); + #} + + my $nodomain = $exports->{$part_export->exporttype}{'nodomain'}; + if ( $nodomain =~ /^Y/i ) { + $conflict_user_svcpart{$_} = $part_export->exportnum + foreach @svcparts; + } else { + $conflict_userdomain_svcpart{$_} = $part_export->exportnum + foreach @svcparts; + } + } + + foreach my $dup_user ( @dup_user ) { + my $dup_svcpart = $dup_user->cust_svc->svcpart; + if ( exists($conflict_user_svcpart{$dup_svcpart}) ) { + return "duplicate username: conflicts with svcnum ". $dup_user->svcnum. + " via exportnum ". $conflict_user_svcpart{$dup_svcpart}; + } + } + + foreach my $dup_userdomain ( @dup_userdomain ) { + my $dup_svcpart = $dup_userdomain->cust_svc->svcpart; + if ( exists($conflict_user_svcpart{$dup_svcpart}) ) { + return "duplicate username\@domain: conflicts with svcnum ". + $dup_userdomain->svcnum. " via exportnum ". + $conflict_user_svcpart{$dup_svcpart}; + } + } + + } + + #see? i told you it was more complicated if ( $self->svcnum ) { my $cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum}); -- cgit v1.2.1 From 340906d63346ccf1cffe138e58feb5244e1aa0a2 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 11 Jun 2002 09:51:23 +0000 Subject: notes --- FS/FS/part_export.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 7661d7e10..52c8213a0 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -615,14 +615,14 @@ tie my %sqlmail_options, 'Tie::IxHash', 'Batch export of /etc/passwd and /etc/shadow files (Linux/SysV)', 'options' => \%sysvshell_options, 'nodomain' => 'Y', - 'notes' => 'MD5 crypt requires installation of Crypt::PasswdMD5 from CPAN.', + 'notes' => 'MD5 crypt requires installation of Crypt::PasswdMD5 from CPAN. Run shell.export, etc.', }, 'bsdshell' => { 'desc' => 'Batch export of /etc/passwd and /etc/master.passwd files (BSD)', 'options' => \%bsdshell_options, 'nodomain' => 'Y', - 'notes' => 'MD5 crypt requires installation of Crypt::PasswdMD5 from CPAN.', + 'notes' => 'MD5 crypt requires installation of Crypt::PasswdMD5 from CPAN. Run shell.export, etc.', }, # 'nis' => { # 'desc' => -- cgit v1.2.1 From 1f637f27c25b2c402261e519094fb8b9d683935a Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 12 Jun 2002 16:26:52 +0000 Subject: fix problems with code that resets invoice events --- FS/FS/cust_main.pm | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index b6600fb29..6be6cdb74 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -493,7 +493,10 @@ sub replace { && $_->status eq 'done' && $_->statustext } - $self->open_cust_bill->cust_bill_event + map { $_->cust_bill_event } + grep { $_->cust_bill_event } + $self->open_cust_bill + ) { my $error = $cust_bill_event->retry; if ( $error ) { @@ -1237,7 +1240,9 @@ sub collect { && $_->status eq 'done' && $_->statustext } - $self->open_cust_bill->cust_bill_event + map { $_->cust_bill_event } + grep { $_->cust_bill_event } + $self->open_cust_bill ) { my $error = $cust_bill_event->retry; if ( $error ) { -- cgit v1.2.1 From 8646bec77602ba7b5b9928a8d408ff5bea5b0bc1 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 12 Jun 2002 20:31:28 +0000 Subject: fix new duplicate username checking --- FS/FS/svc_acct.pm | 35 +++++++++++++++++++++-------------- 1 file changed, 21 insertions(+), 14 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 03230dd06..ce76fe51b 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -194,12 +194,25 @@ sub insert { return $error if $error; #no, duplicate checking just got a whole lot more complicated + #(perhaps keep this check with a config option to turn on?) #return gettext('username_in_use'). ": ". $self->username # if qsearchs( 'svc_acct', { 'username' => $self->username, # 'domsvc' => $self->domsvc, # } ); + if ( $self->svcnum ) { + my $cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum}); + unless ( $cust_svc ) { + $dbh->rollback if $oldAutoCommit; + return "no cust_svc record found for svcnum ". $self->svcnum; + } + $self->pkgnum($cust_svc->pkgnum); + $self->svcpart($cust_svc->svcpart); + } + + #new duplicate username checking + my @dup_user = qsearch( 'svc_acct', { 'username' => $self->username } ); my @dup_userdomain = qsearchs( 'svc_acct', { 'username' => $self->username, 'domsvc' => $self->domsvc } ); @@ -208,13 +221,19 @@ sub insert { my $exports = FS::part_export::export_info('svc_acct'); my( %conflict_user_svcpart, %conflict_userdomain_svcpart ); - foreach my $part_export ( $self->cust_svc->part_svc->part_export ) { + my $part_svc = qsearchs('part_svc', { 'svcpart' => $self->svcpart } ); + unless ( $part_svc ) { + $dbh->rollback if $oldAutoCommit; + return 'unknown svcpart '. $self->svcpart; + } + + foreach my $part_export ( $part_svc->part_export ) { #this will catch to the same exact export my @svcparts = map { $_->svcpart } qsearch('export_svc', { 'exportnum' => $part_export->exportnum }); - #this will catch exports w/same exporthost+type ??? + #this will catch to exports w/same exporthost+type ??? #my @other_part_export = qsearch('part_export', { # 'machine' => $part_export->machine, # 'exporttype' => $part_export->exporttype, @@ -255,16 +274,6 @@ sub insert { #see? i told you it was more complicated - if ( $self->svcnum ) { - my $cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum}); - unless ( $cust_svc ) { - $dbh->rollback if $oldAutoCommit; - return "no cust_svc record found for svcnum ". $self->svcnum; - } - $self->pkgnum($cust_svc->pkgnum); - $self->svcpart($cust_svc->svcpart); - } - my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); return "Unknown svcpart" unless $part_svc; return "uid in use" @@ -379,8 +388,6 @@ sub delete { } } - my $part_svc = $self->cust_svc->part_svc; - my $error = $self->SUPER::delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; -- cgit v1.2.1 From 13f822a442f093f5658e5571c3d236b80be0113f Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 13 Jun 2002 23:00:15 +0000 Subject: fuzzy username searching (Bug#422) --- FS/FS/svc_acct.pm | 102 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 102 insertions(+) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index ce76fe51b..aa089d065 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -303,6 +303,14 @@ sub insert { } } + #false laziness with sub replace (and cust_main) + my $queue = new FS::queue { 'job' => 'FS::svc_acct::append_fuzzyfiles' }; + $error = $queue->insert($self->username); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error } @@ -478,6 +486,15 @@ sub replace { } + #false laziness with sub insert (and cust_main) + my $queue = new FS::queue { 'job' => 'FS::svc_acct::append_fuzzyfiles' }; + $error = $queue->insert($new->username); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error } @@ -860,6 +877,89 @@ sub radius_groups { =head1 SUBROUTINES +=over 4 + +=item check_and_rebuild_fuzzyfiles + +=cut + +sub check_and_rebuild_fuzzyfiles { + my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; + -e "$dir/svc_acct.username" + or &rebuild_fuzzyfiles; +} + +=item rebuild_fuzzyfiles + +=cut + +sub rebuild_fuzzyfiles { + + use Fcntl qw(:flock); + + my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; + + #username + + open(USERNAMELOCK,">>$dir/svc_acct.username") + or die "can't open $dir/svc_acct.username: $!"; + flock(USERNAMELOCK,LOCK_EX) + or die "can't lock $dir/svc_acct.username: $!"; + + my @all_username = map $_->getfield('username'), qsearch('svc_acct', {}); + + open (USERNAMECACHE,">$dir/svc_acct.username.tmp") + or die "can't open $dir/svc_acct.username.tmp: $!"; + print USERNAMECACHE join("\n", @all_username), "\n"; + close USERNAMECACHE or die "can't close $dir/svc_acct.username.tmp: $!"; + + rename "$dir/svc_acct.username.tmp", "$dir/svc_acct.username"; + close USERNAMELOCK; + +} + +=item all_username + +=cut + +sub all_username { + my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; + open(USERNAMECACHE,"<$dir/svc_acct.username") + or die "can't open $dir/svc_acct.username: $!"; + my @array = map { chomp; $_; } ; + close USERNAMECACHE; + \@array; +} + +=item append_fuzzyfiles USERNAME + +=cut + +sub append_fuzzyfiles { + my $username = shift; + + &check_and_rebuild_fuzzyfiles; + + use Fcntl qw(:flock); + + my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; + + open(USERNAME,">>$dir/svc_acct.username") + or die "can't open $dir/svc_acct.username: $!"; + flock(USERNAME,LOCK_EX) + or die "can't lock $dir/svc_acct.username: $!"; + + print USERNAME "$username\n"; + + flock(USERNAME,LOCK_UN) + or die "can't unlock $dir/svc_acct.username: $!"; + close USERNAME; + + 1; +} + + + =item radius_usergroup_selector GROUPS_ARRAYREF [ SELECTNAME ] =cut @@ -909,6 +1009,8 @@ END $html; } +=back + =head1 BUGS The $recref stuff in sub check should be cleaned up. -- cgit v1.2.1 From 72afe3cf4a355a22e942fb59068815270538999f Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 14 Jun 2002 02:25:34 +0000 Subject: mysql compatibility? --- FS/bin/freeside-queued | 64 +++++++++++++++++++++++++++++++++----------------- 1 file changed, 42 insertions(+), 22 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-queued b/FS/bin/freeside-queued index 1539a48af..67e5e2bca 100644 --- a/FS/bin/freeside-queued +++ b/FS/bin/freeside-queued @@ -7,9 +7,10 @@ use Fcntl qw(:flock); use POSIX qw(setsid); use Date::Format; use IO::File; -use FS::UID qw(adminsuidsetup forksuidsetup driver_name); +use FS::UID qw(adminsuidsetup forksuidsetup driver_name dbh); use FS::Record qw(qsearchs); use FS::queue; +use FS::queue_depend; # no autoloading just yet use FS::cust_main; @@ -17,13 +18,14 @@ use FS::svc_acct; use Net::SSH 0.05; use FS::part_export; -my $pid_file = '/var/run/freeside-queued.pid'; - $max_kids = '10'; #guess it should be a config file... $kids = 0; my $user = shift or die &usage; +#my $pid_file = "/var/run/freeside-queued.$user.pid"; +my $pid_file = "/var/run/freeside-queued.pid"; + &daemonize1; sub REAPER { my $pid = wait; $SIG{CHLD} = \&REAPER; $kids--; } @@ -59,26 +61,44 @@ while (1) { } $warnkids=0; - my $nodepend = 'AND 0 = ( SELECT COUNT(*) FROM queue_depend'. - ' WHERE queue_depend.jobnum = queue.jobnum ) '; - - my $job = qsearchs( - 'queue', - { 'status' => 'new' }, - '', - driver_name =~ /^mysql$/i - ? "$nodepend ORDER BY jobnum LIMIT 1 FOR UPDATE" - : "$nodepend ORDER BY jobnum FOR UPDATE LIMIT 1" - ) or do { - sleep 5; #connecting to db is expensive - next; - }; + my $nodepend = driver name eq 'mysql' + ? '' + : 'AND 0 = ( SELECT COUNT(*) FROM queue_depend'. + ' WHERE queue_depend.jobnum = queue.jobnum ) '; + + my($job, $ljob); + { + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + $job = qsearchs( + 'queue', + { 'status' => 'new' }, + '', + driver_name eq 'mysql' + ? "$nodepend ORDER BY jobnum LIMIT 1 FOR UPDATE" + : "$nodepend ORDER BY jobnum FOR UPDATE LIMIT 1" + ) or do { + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + sleep 5; #connecting to db is expensive + next; + }; + + if ( driver_name eq 'mysql' + && qsearch('queue_depend', { 'jobnum' => $job->jobnum } ) ) { + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + next; + } + + my %hash = $job->hash; + $hash{'status'} = 'locked'; + $ljob = new FS::queue ( \%hash ); + my $error = $ljob->replace($job); + die $error if $error; - my %hash = $job->hash; - $hash{'status'} = 'locked'; - my $ljob = new FS::queue ( \%hash ); - my $error = $ljob->replace($job); - die $error if $error; + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + } my @args = $ljob->args; -- cgit v1.2.1 From 251c436ab3d9b79d74ab4fc9af05aac4acf26489 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 14 Jun 2002 09:19:33 +0000 Subject: only run callbacks once... should speed things up (no dbdef reloading) --- FS/FS/UID.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm index d34d28e06..87830cb04 100644 --- a/FS/FS/UID.pm +++ b/FS/FS/UID.pm @@ -92,6 +92,7 @@ sub forksuidsetup { foreach ( keys %callback ) { &{$callback{$_}}; + delete $callback{$_}; #run once } $dbh; @@ -255,7 +256,7 @@ coderef into the hash %FS::UID::callback : =head1 VERSION -$Id: UID.pm,v 1.14 2002-02-23 07:00:21 ivan Exp $ +$Id: UID.pm,v 1.15 2002-06-14 09:19:33 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From a930f5bc47c9c2de989074f1570beaa8f116bd22 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 14 Jun 2002 11:22:53 +0000 Subject: working job dependancies FS::queue::joblisting html excapes & truncates long arguments welcome email (sheesh!) closes: Bug#420 (haha at 4:20 am, too. really!) --- FS/FS/Conf.pm | 49 ++++++++++++++++++----- FS/FS/cust_main.pm | 59 ++++++++++++++-------------- FS/FS/queue.pm | 21 +++++++--- FS/FS/svc_Common.pm | 9 ++++- FS/FS/svc_acct.pm | 104 +++++++++++++++++++++++++++++++++++++++++++++++-- FS/bin/freeside-queued | 66 ++++++++++++++++--------------- 6 files changed, 225 insertions(+), 83 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 126461763..dbb3682d0 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -249,15 +249,15 @@ httemplate/docs/config.html { 'key' => 'bindprimary', - 'section' => 'BIND', - 'description' => 'Your BIND primary nameserver. This enables export of /var/named/named.conf and zone files into /var/named', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, add a bind export instead. Your BIND primary nameserver. This enables export of /var/named/named.conf and zone files into /var/named', 'type' => 'text', }, { 'key' => 'bindsecondaries', - 'section' => 'BIND', - 'description' => 'Your BIND secondary nameservers, one per line. This enables export of /var/named/named.conf', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, add a bind_slave export instead. Your BIND secondary nameservers, one per line. This enables export of /var/named/named.conf', 'type' => 'textarea', }, @@ -277,8 +277,8 @@ httemplate/docs/config.html { 'key' => 'bsdshellmachines', - 'section' => 'shell', - 'description' => 'Your BSD flavored shell (and mail) machines, one per line. This enables export of `/etc/passwd\' and `/etc/master.passwd\'.', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, add a bsdshell export instead. Your BSD flavored shell (and mail) machines, one per line. This enables export of `/etc/passwd\' and `/etc/master.passwd\'.', 'type' => 'textarea', }, @@ -506,8 +506,8 @@ httemplate/docs/config.html { 'key' => 'nismachines', - 'section' => 'shell', - 'description' => 'Your NIS master (not slave master) machines, one per line. This enables export of `/etc/global/passwd\' and `/etc/global/shadow\'.', + 'section' => 'deprecated', + 'description' => 'DEPRECATED. Your NIS master (not slave master) machines, one per line. This enables export of `/etc/global/passwd\' and `/etc/global/shadow\'.', 'type' => 'textarea', }, @@ -633,8 +633,8 @@ httemplate/docs/config.html { 'key' => 'shellmachines', - 'section' => 'shell', - 'description' => 'Your Linux and System V flavored shell (and mail) machines, one per line. This enables export of `/etc/passwd\' and `/etc/shadow\' files.', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, add a sysvshell export instead. Your Linux and System V flavored shell (and mail) machines, one per line. This enables export of `/etc/passwd\' and `/etc/shadow\' files.', 'type' => 'textarea', }, @@ -937,6 +937,35 @@ httemplate/docs/config.html 'type' => 'checkbox', }, + { + 'key' => 'welcome_email', + 'section' => '', + 'description' => 'Template file for welcome email. Welcome emails are sent to the customer email invoice destination(s) each time a svc_acct record is created. See the Text::Template documentation for details on the template substitution language. The following variables are available: $username, $password, $first, $last and $pkg.', + 'type' => 'textarea', + }, + + { + 'key' => 'welcome_email-from', + 'section' => '', + 'description' => 'From: address header for welcome email', + 'type' => 'text', + }, + + { + 'key' => 'welcome_email-subject', + 'section' => '', + 'description' => 'Subject: header for welcome email', + 'type' => 'text', + }, + + { + 'key' => 'welcome_email-mimetype', + 'section' => '', + 'description' => 'MIME type for welcome email', + 'type' => 'select', + 'select_enum' => [ 'text/plain', 'text/html' ], + }, + ); 1; diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 6be6cdb74..b39a77fd7 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -220,7 +220,8 @@ invoicing_list destination to the newly-created svc_acct. Here's an example: sub insert { my $self = shift; - my @param = @_; + my $cust_pkgs = @_ ? shift : {}; + my $invoicing_list = @_ ? shift : ''; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -261,27 +262,35 @@ sub insert { return $error; } - if ( @param ) { # CUST_PKG_HASHREF - my $cust_pkgs = shift @param; - foreach my $cust_pkg ( keys %$cust_pkgs ) { - $cust_pkg->custnum( $self->custnum ); - $error = $cust_pkg->insert; + # invoicing list + if ( $invoicing_list ) { + $error = $self->check_invoicing_list( $invoicing_list ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "checking invoicing_list (transaction rolled back): $error"; + } + $self->invoicing_list( $invoicing_list ); + } + + # packages + foreach my $cust_pkg ( keys %$cust_pkgs ) { + $cust_pkg->custnum( $self->custnum ); + $error = $cust_pkg->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "inserting cust_pkg (transaction rolled back): $error"; + } + foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) { + $svc_something->pkgnum( $cust_pkg->pkgnum ); + if ( $seconds && $svc_something->isa('FS::svc_acct') ) { + $svc_something->seconds( $svc_something->seconds + $seconds ); + $seconds = 0; + } + $error = $svc_something->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "inserting cust_pkg (transaction rolled back): $error"; - } - foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) { - $svc_something->pkgnum( $cust_pkg->pkgnum ); - if ( $seconds && $svc_something->isa('FS::svc_acct') ) { - $svc_something->seconds( $svc_something->seconds + $seconds ); - $seconds = 0; - } - $error = $svc_something->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - #return "inserting svc_ (transaction rolled back): $error"; - return $error; - } + #return "inserting svc_ (transaction rolled back): $error"; + return $error; } } } @@ -291,16 +300,6 @@ sub insert { return "No svc_acct record to apply pre-paid time"; } - if ( @param ) { # INVOICING_LIST_ARYREF - my $invoicing_list = shift @param; - $error = $self->check_invoicing_list( $invoicing_list ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "checking invoicing_list (transaction rolled back): $error"; - } - $self->invoicing_list( $invoicing_list ); - } - if ( $amount ) { my $cust_credit = new FS::cust_credit { 'custnum' => $self->custnum, diff --git a/FS/FS/queue.pm b/FS/FS/queue.pm index df92c5654..1de19b7b5 100644 --- a/FS/FS/queue.pm +++ b/FS/FS/queue.pm @@ -1,7 +1,7 @@ package FS::queue; use strict; -use vars qw( @ISA @EXPORT_OK $conf ); +use vars qw( @ISA @EXPORT_OK $conf $jobnums); use Exporter; use FS::UID; use FS::Conf; @@ -18,6 +18,8 @@ $FS::UID::callback{'FS::queue'} = sub { $conf = new FS::Conf; }; +$jobnums = ''; + =head1 NAME FS::queue - Object methods for queue records @@ -118,6 +120,8 @@ sub insert { } } + push @$jobnums, $self->jobnum if $jobnums; + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -257,10 +261,10 @@ in a database transaction. sub depend_insert { my($self, $other_jobnum) = @_; - my $queue_depend = new FS::queue_depend ( + my $queue_depend = new FS::queue_depend ( { 'jobnum' => $self->jobnum, 'depend_jobnum' => $other_jobnum, - ); + } ); $queue_depend->insert; } @@ -278,6 +282,7 @@ sub joblisting { my($hashref, $noactions) = @_; use Date::Format; + use HTML::Entities; use FS::CGI; my @queue = qsearch( 'queue', $hashref ); @@ -308,7 +313,9 @@ END my $args; if ( $dangerous || $queue->job !~ /^FS::part_export::/ || !$noactions ) { - $args = join(' ', $queue->args); + $args = encode_entities( join(' ', + map { length($_)<54 ? $_ : substr($_,0,32)."..." } $queue->args #1&g + ) ); } else { $args = ''; } @@ -318,7 +325,7 @@ END $status .= ': '. $queue->statustext if $queue->statustext; my @queue_depend = $queue->queue_depend; $status .= ' (waiting for '. - join(', ', map { $_->other_jobnum } @queue_depend ). + join(', ', map { $_->depend_jobnum } @queue_depend ). ')' if @queue_depend; my $changable = $dangerous @@ -378,10 +385,12 @@ END =head1 VERSION -$Id: queue.pm,v 1.13 2002-05-15 14:00:32 ivan Exp $ +$Id: queue.pm,v 1.14 2002-06-14 11:22:53 ivan Exp $ =head1 BUGS +$jobnums global + =head1 SEE ALSO L, schema.html from the base documentation. diff --git a/FS/FS/svc_Common.pm b/FS/FS/svc_Common.pm index cd278efb5..87b6097aa 100644 --- a/FS/FS/svc_Common.pm +++ b/FS/FS/svc_Common.pm @@ -5,6 +5,7 @@ use vars qw( @ISA $noexport_hack ); use FS::Record qw( qsearchs fields dbh ); use FS::cust_svc; use FS::part_svc; +use FS::queue; @ISA = qw( FS::Record ); @@ -27,7 +28,7 @@ inherit from, i.e. FS::svc_acct. FS::svc_Common inherits from FS::Record. =over 4 -=item insert +=item insert [ JOBNUM_ARRAYREF ] Adds this record to the database. If there is an error, returns the error, otherwise returns false. @@ -35,10 +36,14 @@ 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 an arrayref is passed as parameter, the Bs of any export jobs will +be added to the array. + =cut sub insert { my $self = shift; + local $FS::queue::jobnums = shift if @_; my $error; local $SIG{HUP} = 'IGNORE'; @@ -359,7 +364,7 @@ sub cancel { ''; } =head1 VERSION -$Id: svc_Common.pm,v 1.11 2002-06-11 03:25:03 ivan Exp $ +$Id: svc_Common.pm,v 1.12 2002-06-14 11:22:53 ivan Exp $ =head1 BUGS diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index aa089d065..9186e8107 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -8,6 +8,8 @@ use vars qw( @ISA $noexport_hack $conf $username_noperiod $username_nounderscore $username_nodash $username_uppercase $mydomain + $welcome_template $welcome_from $welcome_subject $welcome_mimetype + $smtpmachine $dirhash @saltset @pw_set ); use Carp; @@ -48,8 +50,19 @@ $FS::UID::callback{'FS::svc_acct'} = sub { $username_uppercase = $conf->exists('username-uppercase'); $username_ampersand = $conf->exists('username-ampersand'); $mydomain = $conf->config('domain'); - $dirhash = $conf->config('dirhash') || 0; + if ( $conf->exists('welcome_email') ) { + $welcome_template = new Text::Template ( + TYPE => 'ARRAY', + SOURCE => [ map "$_\n", $conf->config('welcome_email') ] + ) or warn "can't create welcome email template: $Text::Template::ERROR"; + $welcome_from = $conf->config('welcome_email-from'); # || 'your-isp-is-dum' + $welcome_subject = $conf->config('welcome_email-subject') || 'Welcome'; + $welcome_mimetype = $conf->config('welcome_email-mimetype') || 'text/plain'; + } else { + $welcome_template = ''; + } + $smtpmachine = $conf->config('smtpmachine'); }; @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); @@ -283,7 +296,8 @@ sub insert { && $self->username !~ /^toor$/ #FreeBSD ; - $error = $self->SUPER::insert; + my @jobnums; + $error = $self->SUPER::insert(\@jobnums); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -304,13 +318,58 @@ sub insert { } #false laziness with sub replace (and cust_main) - my $queue = new FS::queue { 'job' => 'FS::svc_acct::append_fuzzyfiles' }; + my $queue = new FS::queue { + 'svcnum' => $self->svcnum, + 'job' => 'FS::svc_acct::append_fuzzyfiles' + }; $error = $queue->insert($self->username); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "queueing job (transaction rolled back): $error"; } + #welcome email + my $cust_pkg = $self->cust_svc->cust_pkg; + my( $cust_main, $to ) = ( '', '' ); + if ( $welcome_template && $cust_pkg ) { + my $cust_main = $cust_pkg->cust_main; + my $to = join(', ', grep { $_ ne 'POST' } $cust_main->invoicing_list ); + if ( $to ) { + my $wqueue = new FS::queue { + 'svcnum' => $self->svcnum, + 'job' => 'FS::svc_acct::send_email' + }; + warn "attempting to queue email to $to"; + my $error = $wqueue->insert( + 'to' => $to, + 'from' => $welcome_from, + 'subject' => $welcome_subject, + 'mimetype' => $welcome_mimetype, + 'body' => $welcome_template->fill_in( HASH => { + 'username' => $self->username, + 'password' => $self->_password, + 'first' => $cust_main->first, + 'last' => $cust_main->getfield('last'), + 'pkg' => $cust_pkg->part_pkg->pkg, + } ), + ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queuing welcome email: $error"; + } + + foreach my $jobnum ( @jobnums ) { + my $error = $wqueue->depend_insert($jobnum); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queuing welcome email job dependancy: $error"; + } + } + + } + + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error } @@ -487,7 +546,10 @@ sub replace { } #false laziness with sub insert (and cust_main) - my $queue = new FS::queue { 'job' => 'FS::svc_acct::append_fuzzyfiles' }; + my $queue = new FS::queue { + 'svcnum' => $new->svcnum, + 'job' => 'FS::svc_acct::append_fuzzyfiles' + }; $error = $queue->insert($new->username); if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -879,6 +941,40 @@ sub radius_groups { =over 4 +=item send_email + +=cut + +sub send_email { + my %opt = @_; + + use Date::Format; + use Mail::Internet 1.44; + use Mail::Header; + + $opt{mimetype} ||= 'text/plain'; + $opt{mimetype} .= '; charset="iso-8859-1"' unless $opt{mimetype} =~ /charset/; + + $ENV{MAILADDRESS} = $opt{from}; + my $header = new Mail::Header ( [ + "From: $opt{from}", + "To: $opt{to}", + "Sender: $opt{from}", + "Reply-To: $opt{from}", + "Date: ". time2str("%a, %d %b %Y %X %z", time), + "Subject: $opt{subject}", + "Content-Type: $opt{mimetype}", + ] ); + my $message = new Mail::Internet ( + 'Header' => $header, + 'Body' => [ map "$_\n", split("\n", $opt{body}) ], + ); + $!=0; + $message->smtpsend( Host => $smtpmachine ) + or $message->smtpsend( Host => $smtpmachine, Debug => 1 ) + or die "can't send email to $opt{to} via $smtpmachine with SMTP: $!"; +} + =item check_and_rebuild_fuzzyfiles =cut diff --git a/FS/bin/freeside-queued b/FS/bin/freeside-queued index 67e5e2bca..846055dc3 100644 --- a/FS/bin/freeside-queued +++ b/FS/bin/freeside-queued @@ -61,44 +61,48 @@ while (1) { } $warnkids=0; - my $nodepend = driver name eq 'mysql' + my $nodepend = driver_name eq 'mysql' ? '' : 'AND 0 = ( SELECT COUNT(*) FROM queue_depend'. ' WHERE queue_depend.jobnum = queue.jobnum ) '; - my($job, $ljob); - { - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; + #my($job, $ljob); + #{ + # my $oldAutoCommit = $FS::UID::AutoCommit; + # local $FS::UID::AutoCommit = 0; + $FS::UID::AutoCommit = 0; + my $dbh = dbh; - $job = qsearchs( - 'queue', - { 'status' => 'new' }, - '', - driver_name eq 'mysql' - ? "$nodepend ORDER BY jobnum LIMIT 1 FOR UPDATE" - : "$nodepend ORDER BY jobnum FOR UPDATE LIMIT 1" - ) or do { - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - sleep 5; #connecting to db is expensive - next; - }; - - if ( driver_name eq 'mysql' - && qsearch('queue_depend', { 'jobnum' => $job->jobnum } ) ) { - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - next; - } + my $job = qsearchs( + 'queue', + { 'status' => 'new' }, + '', + driver_name eq 'mysql' + ? "$nodepend ORDER BY jobnum LIMIT 1 FOR UPDATE" + : "$nodepend ORDER BY jobnum FOR UPDATE LIMIT 1" + ) or do { + $dbh->commit or die $dbh->errstr; #if $oldAutoCommit; + sleep 5; #connecting to db is expensive + next; + }; - my %hash = $job->hash; - $hash{'status'} = 'locked'; - $ljob = new FS::queue ( \%hash ); - my $error = $ljob->replace($job); - die $error if $error; + if ( driver_name eq 'mysql' + && qsearch('queue_depend', { 'jobnum' => $job->jobnum } ) ) { + $dbh->commit or die $dbh->errstr; #if $oldAutoCommit; + sleep 5; #would be better if mysql could do everything in query above + next; + } + + my %hash = $job->hash; + $hash{'status'} = 'locked'; + my $ljob = new FS::queue ( \%hash ); + my $error = $ljob->replace($job); + die $error if $error; + + $dbh->commit or die $dbh->errstr; #if $oldAutoCommit; - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - } + $FS::UID::AutoCommit = 1; + #} my @args = $ljob->args; -- cgit v1.2.1 From d7adf8a88198c98305dae4c5030bb82107595b43 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 14 Jun 2002 21:35:44 +0000 Subject: freeside night to infostreet faxNumber (? dunno, what noment wants) --- FS/FS/part_export/infostreet.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export/infostreet.pm b/FS/FS/part_export/infostreet.pm index 8bf227d82..40dee487a 100644 --- a/FS/FS/part_export/infostreet.pm +++ b/FS/FS/part_export/infostreet.pm @@ -14,7 +14,8 @@ use FS::part_export; 'state' => 'state', 'zipCode' => 'zip', 'country' => 'country', - 'phoneNumber' => 'dayphone', + 'phoneNumber' => 'daytime', + 'faxNumber' => 'night', ); sub rebless { shift; } -- cgit v1.2.1 From 19aebb0a743cf80a620f34fc7c6ad71f79764265 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 15 Jun 2002 01:12:29 +0000 Subject: mark@pc-intouch.com: exporttype2svcdb removal --- FS/FS/part_export.pm | 32 +++++++++++++------------------- 1 file changed, 13 insertions(+), 19 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 52c8213a0..9af00174d 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -494,25 +494,19 @@ sub export_info { my $r = { map { %{$exports{$_}} } keys %exports }; } -=item exporttype2svcdb EXPORTTYPE - -Returns the applicable I for an I. - -=cut - -# This subroutine should be modified or removed. In its present form, it -# imposes the arbitrary restriction that no export type can be associated -# with more than one svcdb. The only place it's used is in edit/part_svc.cgi -# to generate the list of allowed exports, which can be done more cleanly by -# export_info anyway. - -sub exporttype2svcdb { - my $exporttype = $_[0]; - foreach my $svcdb ( keys %exports ) { - return $svcdb if grep { $exporttype eq $_ } keys %{$exports{$svcdb}}; - } - ''; -} +#=item exporttype2svcdb EXPORTTYPE +# +#Returns the applicable I for an I. +# +#=cut +# +#sub exporttype2svcdb { +# my $exporttype = $_[0]; +# foreach my $svcdb ( keys %exports ) { +# return $svcdb if grep { $exporttype eq $_ } keys %{$exports{$svcdb}}; +# } +# ''; +#} tie my %sysvshell_options, 'Tie::IxHash', 'crypt' => { label=>'Password encryption', -- cgit v1.2.1 From ef6202c5eded27360d058c84cb8cb2b5cf69478f Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 19 Jun 2002 00:58:57 +0000 Subject: fix problem provisioning RADIUS groups caused by kristian/mark/pc-intouch's changes moving exports into svc_Common - changed sequence of events such that groups were not provisioned when the sqlradius export was run --- FS/FS/svc_acct.pm | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 9186e8107..0be6e5b8d 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -931,8 +931,14 @@ Returns all RADIUS groups for this account (see L). sub radius_groups { my $self = shift; - map { $_->groupname } - qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } ); + if ( $self->usergroup ) { + #when provisioning records, export callback runs in svc_Common.pm before + #radius_usergroup records can be inserted... + @{$self->usergroup}; + } else { + map { $_->groupname } + qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } ); + } } =back -- cgit v1.2.1 From 0eea8f4255a5c65666db673b302de7585f6f06a1 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 19 Jun 2002 01:03:56 +0000 Subject: and the same for changes... --- FS/FS/svc_acct.pm | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 0be6e5b8d..1d68fc99e 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -505,12 +505,6 @@ sub replace { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - $error = $new->SUPER::replace($old); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error if $error; - } - $old->usergroup( [ $old->radius_groups ] ); if ( $new->usergroup ) { #(sorta) false laziness with FS::part_export::sqlradius::_export_replace @@ -545,6 +539,12 @@ sub replace { } + $error = $new->SUPER::replace($old); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error if $error; + } + #false laziness with sub insert (and cust_main) my $queue = new FS::queue { 'svcnum' => $new->svcnum, -- cgit v1.2.1 From 88f0ff8531750c6eafd0495b7bbdc440d78db379 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 19 Jun 2002 04:03:15 +0000 Subject: fix setContactField email --- FS/FS/part_export/infostreet.pm | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export/infostreet.pm b/FS/FS/part_export/infostreet.pm index 40dee487a..e6d68c1e2 100644 --- a/FS/FS/part_export/infostreet.pm +++ b/FS/FS/part_export/infostreet.pm @@ -32,11 +32,16 @@ sub _export_insert { return $error if $error; } - $self->infostreet_queue( $svc_acct->svcnum, - 'setContactField', $accountID, 'email', $cust_main->invoicing_list ) + my @emails = grep { $_ ne 'POST' } $cust_main->invoicing_list; + if ( @emails ) { + my $error = $self->infostreet_queue( $svc_acct->svcnum, + 'setContactField', $accountID, 'email', $emails[0] ); + return $error if $error; + } + #this one is kinda noment-specific - || $self->infostreet_queue( $svc_acct->svcnum, - 'setContactField', $accountID, 'title', $cust_main->agent->agent ); + $self->infostreet_queue( $svc_acct->svcnum, + 'setContactField', $accountID, 'title', $cust_main->agent->agent ); } -- cgit v1.2.1 From cf6020a0c273d549d33f3e9999bd8b68d9b6d133 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 20 Jun 2002 01:29:21 +0000 Subject: shellcommands w/passwords --- FS/FS/part_export.pm | 16 ++++++++++++++-- FS/FS/part_export/shellcommands.pm | 21 ++++++++++++++++----- FS/bin/freeside-queued | 2 +- 3 files changed, 31 insertions(+), 8 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 9af00174d..20e3ab474 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -526,21 +526,33 @@ tie my %shellcommands_options, 'Tie::IxHash', #'machine' => { label=>'Remote machine' }, 'user' => { label=>'Remote username', default=>'root' }, 'useradd' => { label=>'Insert command', - default=>'useradd -d $dir -m -s $shell -u $uid $username' + default=>'useradd -d $dir -m -s $shell -u $uid $username; passwd $username' #default=>'cp -pr /etc/skel $dir; chown -R $uid.$gid $dir' }, + 'useradd_stdin' => { label=>'Insert command STDIN', + type =>'textarea', + default=>'$_password\n$_password\n', + }, 'userdel' => { label=>'Delete command', default=>'userdel $username', #default=>'rm -rf $dir', }, + 'userdel_stdin' => { label=>'Delete command STDIN', + type =>'textarea', + default=>'', + }, 'usermod' => { label=>'Modify command', - default=>'usermod -d $new_dir -l $new_username -s $new_shell -u $new_uid $old_username', + default=>'usermod -d $new_dir -l $new_username -s $new_shell -u $new_uid $old_username; passwd $new_username', #default=>'[ -d $old_dir ] && mv $old_dir $new_dir || ( '. # 'chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; '. # 'find . -depth -print | cpio -pdm $new_dir; '. # 'chmod u-t $new_dir; chown -R $uid.$gid $new_dir; '. # 'rm -rf $old_dir'. #')' + 'usermod_stdin' => { label=>'Modify command STDIN', + type =>'textarea', + default=>'$_password\n$_password\n', + }, }, ; diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm index 7a87bd3e0..870d7f1ee 100644 --- a/FS/FS/part_export/shellcommands.pm +++ b/FS/FS/part_export/shellcommands.pm @@ -20,23 +20,29 @@ sub _export_delete { sub _export_command { my ( $self, $action, $svc_acct) = (shift, shift, shift); my $command = $self->option($action); + my $stdin = $self->option($action."_stdin"); no strict 'refs'; ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields; $self->shellcommands_queue( $svc_acct->svcnum, - $self->options('user')||'root'. "\@". $self->options('machine'), - eval(qq("$command")) + user => $self->options('user')||'root', + host => $self->options('machine'), + command => eval(qq("$command")), + stdin_string => eval(qq("$stdin")), ); } sub _export_replace { my($self, $new, $old ) = (shift, shift, shift); my $command = $self->option('usermod'); + my $stdin = $self->option('usermod_stdin'); no strict 'refs'; ${"old_$_"} = $old->getfield($_) foreach $old->fields; ${"new_$_"} = $new->getfield($_) foreach $new->fields; $self->shellcommands_queue( $new->svcnum, - $self->options('user')||'root'. "\@". $self->options('machine'), - eval(qq("$command")) + user => $self->options('user')||'root', + host => $self->options('machine'), + command => eval(qq("$command")), + stdin_string => eval(qq("$stdin")), ); } @@ -45,11 +51,16 @@ sub shellcommands_queue { my( $self, $svcnum ) = (shift, shift); my $queue = new FS::queue { 'svcnum' => $svcnum, - 'job' => "Net::SSH::ssh_cmd", #freeside-queued pre-uses... + 'job' => "FS::part_export::shellcommands::ssh_cmd", }; $queue->insert( @_ ); } +sub ssh_cmd { #subroutine, not method + use Net::SSH '0.06'; + &Net::SSH::ssh_cmd( { @_ } ); +} + #sub shellcommands_insert { #subroutine, not method #} #sub shellcommands_replace { #subroutine, not method diff --git a/FS/bin/freeside-queued b/FS/bin/freeside-queued index 846055dc3..48d283a75 100644 --- a/FS/bin/freeside-queued +++ b/FS/bin/freeside-queued @@ -15,7 +15,7 @@ use FS::queue_depend; # no autoloading just yet use FS::cust_main; use FS::svc_acct; -use Net::SSH 0.05; +use Net::SSH 0.06; use FS::part_export; $max_kids = '10'; #guess it should be a config file... -- cgit v1.2.1 From 29bb6991a3b7187784cd14a3806b0c9db38dd51b Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 20 Jun 2002 22:35:17 +0000 Subject: fix infostreet contact field foo --- FS/FS/part_export/infostreet.pm | 90 ++++++++++++++++++++++++++++++++++------- 1 file changed, 75 insertions(+), 15 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export/infostreet.pm b/FS/FS/part_export/infostreet.pm index e6d68c1e2..8a68a2077 100644 --- a/FS/FS/part_export/infostreet.pm +++ b/FS/FS/part_export/infostreet.pm @@ -1,6 +1,7 @@ package FS::part_export::infostreet; use vars qw(@ISA %infostreet2cust_main); +use FS::UID qw(dbh); use FS::part_export; @ISA = qw(FS::part_export); @@ -15,7 +16,7 @@ use FS::part_export; 'zipCode' => 'zip', 'country' => 'country', 'phoneNumber' => 'daytime', - 'faxNumber' => 'night', + 'faxNumber' => 'night', #noment-request... ); sub rebless { shift; } @@ -23,25 +24,41 @@ sub rebless { shift; } sub _export_insert { my( $self, $svc_acct ) = (shift, shift); my $cust_main = $svc_acct->cust_svc->cust_pkg->cust_main; - my $accountID = $self->infostreet_queue( $svc_acct->svcnum, + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $err_or_queue = $self->infostreet_err_or_queue( $svc_acct->svcnum, 'createUser', $svc_acct->username, $svc_acct->_password ); - foreach my $infostreet_field ( keys %infostreet2cust_main ) { - my $error = $self->infostreet_queue( $svc_acct->svcnum, - 'setContactField', $accountID, $infostreet_field, - $cust_main->getfield( $infostreet2cust_main{$infostreet_field} ) ); - return $error if $error; - } + return $err_or_queue unless ref($err_or_queue); + my $jobnum = $err_or_queue->jobnum; + + my %contact_info = ( map { + $_ => $cust_main->getfield( $infostreet2cust_main{$_} ); + } keys %infostreet2cust_main ); my @emails = grep { $_ ne 'POST' } $cust_main->invoicing_list; - if ( @emails ) { - my $error = $self->infostreet_queue( $svc_acct->svcnum, - 'setContactField', $accountID, 'email', $emails[0] ); - return $error if $error; - } + $contact_info{'email'} = $emails[0] if @emails; #this one is kinda noment-specific - $self->infostreet_queue( $svc_acct->svcnum, - 'setContactField', $accountID, 'title', $cust_main->agent->agent ); + $contact_info{'title'} = $cust_main->agent->agent; + + $err_or_queue = $self->infostreet_queueContact( $svc_acct->svcnum, + $svc_acct->username, %contact_info ); + return $err_or_queue unless ref($err_or_queue); + my $error = $err_or_queue->depend_insert( $jobnum ); + return $error if $error; + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; } @@ -88,6 +105,49 @@ sub infostreet_queue { ); } +#ick false laziness +sub infostreet_err_or_queue { + my( $self, $svcnum, $method ) = (shift, shift, shift); + my $queue = new FS::queue { + 'svcnum' => $svcnum, + 'job' => 'FS::part_export::infostreet::infostreet_command', + }; + $queue->insert( + $self->option('url'), + $self->option('login'), + $self->option('password'), + $self->option('groupID'), + $method, + @_, + ) or $queue; +} + +sub infostreet_queueContact { + my( $self, $svcnum ) = (shift, shift); + my $queue = new FS::queue { + 'svcnum' => $svcnum, + 'job' => 'FS::part_export::infostreet::infostreet_setContact', + }; + $queue->insert( + $self->option('url'), + $self->option('login'), + $self->option('password'), + $self->option('groupID'), + @_, + ) or $queue; +} + +sub infostreet_setContact { + my($url, $is_username, $is_password, $groupID, $username, %contact_info) = @_; + my $accountID = infostreet_command($url, $is_username, $is_password, $groupID, + 'getAccountID', $username); + foreach my $field ( %contact_info ) { + infostreet_command($url, $is_username, $is_password, $groupID, + 'setContactField', $field, $contact_info{$field} ); + } + +} + sub infostreet_command { #subroutine, not method my($url, $username, $password, $groupID, $method, @args) = @_; -- cgit v1.2.1 From 78f11947cf539b3e258e7a7804c13dcd2a2f1160 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 21 Jun 2002 09:56:08 +0000 Subject: better error messages on uid duplicates... uid stuff still needs to be rewritten for new exports --- FS/FS/svc_acct.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 1d68fc99e..e2ac18639 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -289,7 +289,7 @@ sub insert { my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); return "Unknown svcpart" unless $part_svc; - return "uid in use" + return "uid ". $self->uid. " in use" if $part_svc->part_svc_column('uid')->columnflag ne 'F' && qsearchs( 'svc_acct', { 'uid' => $self->uid } ) && $self->username !~ /^(hyla)?fax$/ -- cgit v1.2.1 From 185eb6429f5ae208dfaf206395db4d3a16fe8ae3 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 21 Jun 2002 20:17:43 +0000 Subject: debugging option --- FS/FS/part_export/infostreet.pm | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export/infostreet.pm b/FS/FS/part_export/infostreet.pm index 8a68a2077..a2fc049f4 100644 --- a/FS/FS/part_export/infostreet.pm +++ b/FS/FS/part_export/infostreet.pm @@ -1,11 +1,13 @@ package FS::part_export::infostreet; -use vars qw(@ISA %infostreet2cust_main); +use vars qw(@ISA %infostreet2cust_main $DEBUG); use FS::UID qw(dbh); use FS::part_export; @ISA = qw(FS::part_export); +$DEBUG = 0; + %infostreet2cust_main = ( 'firstName' => 'first', 'lastName' => 'last', @@ -151,6 +153,8 @@ sub infostreet_setContact { sub infostreet_command { #subroutine, not method my($url, $username, $password, $groupID, $method, @args) = @_; + warn "[FS::part_export::infostreet] $method ".join(' ', @args)."\n" if $DEBUG; + #quelle hack if ( $method =~ /,/ ) { foreach my $part ( split(/,\s*/, $method) ) { -- cgit v1.2.1 From 5939c0f1ae7bea08adde82f6d3578e6c5ac31248 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 21 Jun 2002 20:26:14 +0000 Subject: fix infostreet contact field setting --- FS/FS/part_export/infostreet.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export/infostreet.pm b/FS/FS/part_export/infostreet.pm index a2fc049f4..89ab06d22 100644 --- a/FS/FS/part_export/infostreet.pm +++ b/FS/FS/part_export/infostreet.pm @@ -143,9 +143,9 @@ sub infostreet_setContact { my($url, $is_username, $is_password, $groupID, $username, %contact_info) = @_; my $accountID = infostreet_command($url, $is_username, $is_password, $groupID, 'getAccountID', $username); - foreach my $field ( %contact_info ) { + foreach my $field ( keys %contact_info ) { infostreet_command($url, $is_username, $is_password, $groupID, - 'setContactField', $field, $contact_info{$field} ); + 'setContactField', $accountID, $field, $contact_info{$field} ); } } -- cgit v1.2.1 From 835228e1989d99fabc2689363aa174d41440188d Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 21 Jun 2002 21:49:25 +0000 Subject: s/title/organization/ at noment's request --- FS/FS/part_export/infostreet.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export/infostreet.pm b/FS/FS/part_export/infostreet.pm index 89ab06d22..2464e5dee 100644 --- a/FS/FS/part_export/infostreet.pm +++ b/FS/FS/part_export/infostreet.pm @@ -50,7 +50,7 @@ sub _export_insert { $contact_info{'email'} = $emails[0] if @emails; #this one is kinda noment-specific - $contact_info{'title'} = $cust_main->agent->agent; + $contact_info{'organization'} = $cust_main->agent->agent; $err_or_queue = $self->infostreet_queueContact( $svc_acct->svcnum, $svc_acct->username, %contact_info ); -- cgit v1.2.1 From 5086b5ee6ace8f535a1adb9a97cce4da87450cb1 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 23 Jun 2002 01:36:19 +0000 Subject: forgot . between zone and domain, patch from "Stephen Bechard" , thanks --- FS/FS/svc_www.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/svc_www.pm b/FS/FS/svc_www.pm index f09a3f89d..6415a3012 100644 --- a/FS/FS/svc_www.pm +++ b/FS/FS/svc_www.pm @@ -154,7 +154,7 @@ sub insert { my $dom_svcnum = $domain_record->svcnum; my $svc_domain = qsearchs('svc_domain', { 'svcnum' => $dom_svcnum } ); # or die ? - $zone .= $svc_domain->domain; + $zone .= '.'. $svc_domain->domain; } my $svc_acct = qsearchs('svc_acct', { 'svcnum' => $self->usersvc } ); -- cgit v1.2.1 From b32a862877102bd755bec2c83713b6f3ffb35dfa Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 23 Jun 2002 19:16:45 +0000 Subject: domain_record records attached to svc_www records are no longer delete-able, patch from "Stephen Bechard" , thanks! closes: Bug#434 --- FS/FS/domain_record.pm | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/domain_record.pm b/FS/FS/domain_record.pm index 03f9e10bb..37cc6c9e8 100644 --- a/FS/FS/domain_record.pm +++ b/FS/FS/domain_record.pm @@ -5,6 +5,7 @@ use vars qw( @ISA $noserial_hack ); #use FS::Record qw( qsearch qsearchs ); use FS::Record qw( qsearchs dbh ); use FS::svc_domain; +use FS::svc_www; @ISA = qw(FS::Record); @@ -124,6 +125,9 @@ Delete this record from the database. sub delete { my $self = shift; + return "Can't delete a domain record which has a website!" + if qsearchs( 'svc_www', { 'recnum' => $self->recnum } ); + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -309,7 +313,7 @@ sub svc_domain { =head1 VERSION -$Id: domain_record.pm,v 1.10 2002-06-10 23:02:41 ivan Exp $ +$Id: domain_record.pm,v 1.11 2002-06-23 19:16:45 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From fe610572852e2eb7c3458e77dc167c25a098c84a Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 25 Jun 2002 07:18:40 +0000 Subject: might work again under mysql --- FS/bin/freeside-queued | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/bin/freeside-queued b/FS/bin/freeside-queued index 48d283a75..42d00cebe 100644 --- a/FS/bin/freeside-queued +++ b/FS/bin/freeside-queued @@ -8,7 +8,7 @@ use POSIX qw(setsid); use Date::Format; use IO::File; use FS::UID qw(adminsuidsetup forksuidsetup driver_name dbh); -use FS::Record qw(qsearchs); +use FS::Record qw(qsearch qsearchs); use FS::queue; use FS::queue_depend; -- cgit v1.2.1 From ecb895ccbbf52ed2babc0885c9925022175e33a0 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 26 Jun 2002 01:35:08 +0000 Subject: working one-time charges --- FS/FS/cust_main.pm | 33 +++++++++++++++++++++++++++++++-- 1 file changed, 31 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index b39a77fd7..b68bf9e8f 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1743,16 +1743,45 @@ the error, otherwise returns false. sub charge { my ( $self, $amount, $pkg, $comment ) = @_; + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + my $part_pkg = new FS::part_pkg ( { 'pkg' => $pkg || 'One-time charge', - 'comment' => $comment || '$'. sprintf("%.2f".$amount), + 'comment' => $comment || '$'. sprintf("%.2f",$amount), 'setup' => $amount, 'freq' => 0, 'recur' => '0', 'disabled' => 'Y', } ); - $part_pkg->insert; + my $error = $part_pkg->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + my $cust_pkg = new FS::cust_pkg ( { + 'custnum' => $self->custnum, + 'pkgpart' => $part_pkg->pkgpart, + } ); + + $error = $cust_pkg->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; } -- cgit v1.2.1 From a4c1722b8da9045825692715e0c2f8dde2741080 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 26 Jun 2002 02:37:48 +0000 Subject: fix not sending postal invoices to customers with email invoices too --- FS/FS/cust_bill.pm | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 20755857b..5a9fdd09b 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -369,9 +369,9 @@ emails or print. See L. sub send { my($self,$template) = @_; - - #my @print_text = $cust_bill->print_text; #( date ) + my @print_text = $self->print_text('', $template); my @invoicing_list = $self->cust_main->invoicing_list; + if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice #false laziness w/FS::cust_pay::delete & fs_signup_server && ::realtime_card #$ENV{SMTPHOSTS} = $smtpmachine; @@ -386,7 +386,7 @@ sub send { ] ); my $message = new Mail::Internet ( 'Header' => $header, - 'Body' => [ $self->print_text('', $template) ], #( date) + 'Body' => [ @print_text ], #( date) ); $!=0; $message->smtpsend( Host => $smtpmachine ) @@ -395,11 +395,12 @@ sub send { " to ". join(', ', grep { $_ ne 'POST' } @invoicing_list ). " via server $smtpmachine with SMTP: $!"; - #} elsif ( grep { $_ eq 'POST' } @invoicing_list ) { - } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) { + } + + if ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) { #postal open(LPR, "|$lpr") or return "Can't open pipe to $lpr: $!"; - print LPR $self->print_text; #( date ) + print LPR @print_text; close LPR or return $! ? "Error closing $lpr: $!" : "Exit status $? from $lpr"; @@ -951,7 +952,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.37 2002-06-07 20:33:27 khoff Exp $ +$Id: cust_bill.pm,v 1.38 2002-06-26 02:37:48 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 3039741d0802064c9cd1daea38513ed9bf6bce0e Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 26 Jun 2002 03:53:33 +0000 Subject: export options can be anything --- FS/FS/part_export_option.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export_option.pm b/FS/FS/part_export_option.pm index 61ea956ae..a0b19fde1 100644 --- a/FS/FS/part_export_option.pm +++ b/FS/FS/part_export_option.pm @@ -106,7 +106,7 @@ sub check { $self->ut_numbern('optionnum') || $self->ut_number('exportnum') || $self->ut_alpha('optionname') - || $self->ut_textn('optionvalue') + || $self->ut_anything('optionvalue') ; return $error if $error; -- cgit v1.2.1 From 4329b50ca24073d39e16ce808ee49286309150e9 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 26 Jun 2002 08:12:52 +0000 Subject: add type_pkgs record if necessary for one-time charges --- FS/FS/cust_main.pm | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index b68bf9e8f..efe94027d 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -27,6 +27,7 @@ use FS::part_pkg; use FS::part_bill_event; use FS::cust_bill_event; use FS::cust_tax_exempt; +use FS::type_pkgs; use FS::Msgcat qw(gettext); @ISA = qw( FS::Record ); @@ -1769,9 +1770,20 @@ sub charge { return $error; } + my $pkgpart = $part_pkg->pkgpart; + my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart ); + unless ( qsearchs('type_pkgs', \%type_pkgs ) ) { + my $type_pkgs = new FS::type_pkgs \%type_pkgs; + $error = $type_pkgs->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + my $cust_pkg = new FS::cust_pkg ( { 'custnum' => $self->custnum, - 'pkgpart' => $part_pkg->pkgpart, + 'pkgpart' => $pkgpart, } ); $error = $cust_pkg->insert; -- cgit v1.2.1 From 1126f78d0ff7708ade671422d3e6ceae3411241e Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 26 Jun 2002 08:32:21 +0000 Subject: better export docs/defaults --- FS/FS/part_export.pm | 79 ++++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 58 insertions(+), 21 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 20e3ab474..cbd1dc8bd 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -531,7 +531,7 @@ tie my %shellcommands_options, 'Tie::IxHash', }, 'useradd_stdin' => { label=>'Insert command STDIN', type =>'textarea', - default=>'$_password\n$_password\n', + default=>"\$_password\n\$_password\n", }, 'userdel' => { label=>'Delete command', default=>'userdel $username', @@ -549,11 +549,36 @@ tie my %shellcommands_options, 'Tie::IxHash', # 'chmod u-t $new_dir; chown -R $uid.$gid $new_dir; '. # 'rm -rf $old_dir'. #')' + }, 'usermod_stdin' => { label=>'Modify command STDIN', type =>'textarea', - default=>'$_password\n$_password\n', + default=>"\$_password\n\$_password\n", + }, +; + +tie my %shellcommands_withdomain_options, 'Tie::IxHash', + 'user' => { label=>'Remote username', default=>'root' }, + 'useradd' => { label=>'Insert command', + #default=>'' + }, + 'useradd_stdin' => { label=>'Insert command STDIN', + type =>'textarea', + #default=>"$_password\n$_password\n", }, + 'userdel' => { label=>'Delete command', + #default=>'', }, + 'userdel_stdin' => { label=>'Delete command STDIN', + type =>'textarea', + #default=>'', + }, + 'usermod' => { label=>'Modify command', + default=>'', + }, + 'usermod_stdin' => { label=>'Modify command STDIN', + type =>'textarea', + #default=>"$_password\n$_password\n", + }, ; tie my %sqlradius_options, 'Tie::IxHash', @@ -618,17 +643,17 @@ tie my %sqlmail_options, 'Tie::IxHash', 'svc_acct' => { 'sysvshell' => { 'desc' => - 'Batch export of /etc/passwd and /etc/shadow files (Linux/SysV)', + 'Batch export of /etc/passwd and /etc/shadow files (Linux/SysV).', 'options' => \%sysvshell_options, 'nodomain' => 'Y', - 'notes' => 'MD5 crypt requires installation of Crypt::PasswdMD5 from CPAN. Run shell.export, etc.', + 'notes' => 'MD5 crypt requires installation of Crypt::PasswdMD5 from CPAN. Run bin/sysvshell.export to export the files.', }, 'bsdshell' => { 'desc' => - 'Batch export of /etc/passwd and /etc/master.passwd files (BSD)', + 'Batch export of /etc/passwd and /etc/master.passwd files (BSD).', 'options' => \%bsdshell_options, 'nodomain' => 'Y', - 'notes' => 'MD5 crypt requires installation of Crypt::PasswdMD5 from CPAN. Run shell.export, etc.', + 'notes' => 'MD5 crypt requires installation of Crypt::PasswdMD5 from CPAN. Run bin/bsdshell.export to export the files.', }, # 'nis' => { # 'desc' => @@ -638,28 +663,35 @@ tie my %sqlmail_options, 'Tie::IxHash', 'textradius' => { 'desc' => 'Batch export of a text /etc/raddb/users file (Livingston, Cistron)', 'options' => {}, - 'notes' => 'unfinished...', + 'notes' => 'unfinished', }, 'shellcommands' => { 'desc' => 'Real-time export via remote SSH (i.e. useradd, userdel, etc.)', 'options' => \%shellcommands_options, 'nodomain' => 'Y', - 'notes' => 'shellcommandsnotes... (this one is the nodomain one)', + 'notes' => 'Run remote commands via SSH. Usernames are considered unique (also see shellcommands_withdomain).', + }, + + 'shellcommands_withdomain' => { + 'desc' => 'Real-time export via remote SSH,', + 'options' => \%shellcommands_withdomain_options, + 'nodomain' => 'Y', + 'notes' => 'Run remote commands via SSH. username@domain (rather than just usernames) are considered unique (also see shellcommands)', }, 'sqlradius' => { 'desc' => 'Real-time export to SQL-backed RADIUS (ICRADIUS, FreeRADIUS)', 'options' => \%sqlradius_options, 'nodomain' => 'Y', - 'notes' => 'Real-time export of radcheck, radreply and usergroup tables to any SQL database for FreeRADIUS or ICRADIUS. Use freeside-sqlradius-reset to delete and repopulate the tables from the Freeside database. See the DBI documentation and the documentation for your DBD for the exact syntax of a DBI data source. If using FreeRADIUS 0.5 or above, make sure your op fields are set to allow NULL values.', + 'notes' => 'Real-time export of radcheck, radreply and usergroup tables to any SQL database for FreeRADIUS or ICRADIUS. An existing RADIUS database will be updated in realtime, but you can use freeside-sqlradius-reset to delete the entire RADIUS database and repopulate the tables from the Freeside database. See the DBI documentation and the documentation for your DBD for the exact syntax of a DBI data source. If using FreeRADIUS 0.5 or above, make sure your op fields are set to allow NULL values.', }, 'sqlmail' => { 'desc' => 'Real-time export to SQL-backed mail server', 'options' => \%sqlmail_options, 'nodomain' => 'Y', - 'notes' => 'Database schema can be made to work with Courier IMAP and Exim. Others could work but are untested.', + 'notes' => 'Database schema can be made to work with Courier IMAP and Exim. Others could work but are untested. (...extended description from pc-intouch?...)', }, 'cyrus' => { @@ -685,7 +717,6 @@ tie my %sqlmail_options, 'Tie::IxHash', 'vpopmail' => { 'desc' => 'Real-time export to vpopmail text files', 'options' => \%vpopmail_options, - 'notes' => 'Real time export to vpopmail text files (...extended description from jeff?...)', }, @@ -696,21 +727,20 @@ tie my %sqlmail_options, 'Tie::IxHash', 'bind' => { 'desc' =>'Batch export to BIND named', 'options' => \%bind_options, - 'notes' => 'bind export notes File::Rsync dependancy, run bind.export', + 'notes' => 'Batch export of BIND zone and configuration files to primary nameserver. File::Rsync must be installed. Run bin/bind.export to export the files.', }, 'bind_slave' => { 'desc' =>'Batch export to slave BIND named', 'options' => \%bind_slave_options, - 'notes' => 'bind export notes (secondary munge) File::Rsync dependancy, run bind.export', + 'notes' => 'Batch export of BIND configuration file to a secondary nameserver. Zones are slaved from the listed masters. File::Rsync must be installed. Run bin/bind.export to export the files.', }, 'sqlmail' => { 'desc' => 'Real-time export to SQL-backed mail server', 'options' => \%sqlmail_options, - 'nodomain' => 'Y', - 'notes' => 'Database schema can be made to work with Courier IMAP and - Exim. Others could work but are untested.', + #'nodomain' => 'Y', + 'notes' => 'Database schema can be made to work with Courier IMAP and Exim. Others could work but are untested. (...extended description from pc-intouch?...)', }, @@ -722,13 +752,19 @@ tie my %sqlmail_options, 'Tie::IxHash', 'sqlmail' => { 'desc' => 'Real-time export to SQL-backed mail server', 'options' => \%sqlmail_options, - 'nodomain' => 'Y', - 'notes' => 'Database schema can be made to work with Courier IMAP and - Exim. Others could work but are untested.', + #'nodomain' => 'Y', + 'notes' => 'Database schema can be made to work with Courier IMAP and Exim. Others could work but are untested. (...extended description from pc-intouch?...)', }, }, - 'svc_www' => {}, + 'svc_www' => { + 'www_shellcommands' => { + 'desc' => 'www_shellcommands', + 'options' => {}, # \%www_shellcommands_options, + 'notes' => 'svc_www commands', + }, + + }, ); @@ -741,7 +777,8 @@ FS/FS/part_export/ (an example may be found in eg/export_template.pm) =head1 BUGS -Probably. +All the stuff in the %exports hash should be generated from the specific +export modules. Hmm... cust_export class (not necessarily a database table...) ... ? -- cgit v1.2.1 From a644b239bd83709b67b7b26f4af6e0cc8c172f37 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 26 Jun 2002 08:36:12 +0000 Subject: tyop --- FS/FS/part_export.pm | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index cbd1dc8bd..74f7006ca 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -674,9 +674,8 @@ tie my %sqlmail_options, 'Tie::IxHash', }, 'shellcommands_withdomain' => { - 'desc' => 'Real-time export via remote SSH,', + 'desc' => 'Real-time export via remote SSH.', 'options' => \%shellcommands_withdomain_options, - 'nodomain' => 'Y', 'notes' => 'Run remote commands via SSH. username@domain (rather than just usernames) are considered unique (also see shellcommands)', }, -- cgit v1.2.1 From 76e9abe03157deaa2a5ec7253624c9a59464b8fc Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 27 Jun 2002 09:19:33 +0000 Subject: export updates --- FS/FS/part_export/bsdshell.pm | 47 +---------------------- FS/FS/part_export/null.pm | 13 +++++++ FS/FS/part_export/sysvshell.pm | 7 ++++ FS/FS/part_export/www_shellcommands.pm | 70 ++++++++++++++++++++++++++++++++++ FS/t/part_export-null.t | 5 +++ FS/t/part_export-sysvshell.t | 5 +++ FS/t/part_export-www_shellcommands.t | 5 +++ 7 files changed, 107 insertions(+), 45 deletions(-) create mode 100644 FS/FS/part_export/null.pm create mode 100644 FS/FS/part_export/sysvshell.pm create mode 100644 FS/FS/part_export/www_shellcommands.pm create mode 100644 FS/t/part_export-null.t create mode 100644 FS/t/part_export-sysvshell.t create mode 100644 FS/t/part_export-www_shellcommands.t (limited to 'FS') diff --git a/FS/FS/part_export/bsdshell.pm b/FS/FS/part_export/bsdshell.pm index 4a890d051..06642097f 100644 --- a/FS/FS/part_export/bsdshell.pm +++ b/FS/FS/part_export/bsdshell.pm @@ -1,50 +1,7 @@ package FS::part_export::bsdshell; use vars qw(@ISA); -use FS::part_export; +use FS::part_export::null; -@ISA = qw(FS::part_export); - -sub rebless { shift; } - -sub _export_insert { - my($self, $svc_acct) = (shift, shift); - $err_or_queue = $self->bsdshell_queue( $svc_acct->svcnum, 'insert', - $svc_acct->username, $svc_acct->_password ); - ref($err_or_queue) ? '' : $err_or_queue; -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - #return "can't change username with bsdshell" - # if $old->username ne $new->username; - #return '' unless $old->_password ne $new->_password; - $err_or_queue = $self->bsdshell_queue( $new->svcnum, - 'replace', $new->username, $new->_password ); - ref($err_or_queue) ? '' : $err_or_queue; -} - -sub _export_delete { - my( $self, $svc_acct ) = (shift, shift); - $err_or_queue = $self->bsdshell_queue( $svc_acct->svcnum, - 'delete', $svc_acct->username ); - ref($err_or_queue) ? '' : $err_or_queue; -} - -#a good idea to queue anything that could fail or take any time -sub bsdshell_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::bsdshell::bsdshell_$method", - }; - $queue->insert( @_ ) or $queue; -} - -sub bsdshell_insert { #subroutine, not method -} -sub bsdshell_replace { #subroutine, not method -} -sub bsdshell_delete { #subroutine, not method -} +@ISA = qw(FS::part_export::null); diff --git a/FS/FS/part_export/null.pm b/FS/FS/part_export/null.pm new file mode 100644 index 000000000..0145af3a4 --- /dev/null +++ b/FS/FS/part_export/null.pm @@ -0,0 +1,13 @@ +package FS::part_export::null; + +use vars qw(@ISA); +use FS::part_export; + +@ISA = qw(FS::part_export); + +sub rebless { shift; } + +sub _export_insert {} +sub _export_replace {} +sub _export_delete {} + diff --git a/FS/FS/part_export/sysvshell.pm b/FS/FS/part_export/sysvshell.pm new file mode 100644 index 000000000..f3f6b34b6 --- /dev/null +++ b/FS/FS/part_export/sysvshell.pm @@ -0,0 +1,7 @@ +package FS::part_export::sysvshell; + +use vars qw(@ISA); +use FS::part_export::null; + +@ISA = qw(FS::part_export::null); + diff --git a/FS/FS/part_export/www_shellcommands.pm b/FS/FS/part_export/www_shellcommands.pm new file mode 100644 index 000000000..870d7f1ee --- /dev/null +++ b/FS/FS/part_export/www_shellcommands.pm @@ -0,0 +1,70 @@ +package FS::part_export::shellcommands; + +use vars qw(@ISA); +use FS::part_export; + +@ISA = qw(FS::part_export); + +sub rebless { shift; } + +sub _export_insert { + my($self) = shift; + $self->_export_command('useradd', @_); +} + +sub _export_delete { + my($self) = shift; + $self->_export_command('userdel', @_); +} + +sub _export_command { + my ( $self, $action, $svc_acct) = (shift, shift, shift); + my $command = $self->option($action); + my $stdin = $self->option($action."_stdin"); + no strict 'refs'; + ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields; + $self->shellcommands_queue( $svc_acct->svcnum, + user => $self->options('user')||'root', + host => $self->options('machine'), + command => eval(qq("$command")), + stdin_string => eval(qq("$stdin")), + ); +} + +sub _export_replace { + my($self, $new, $old ) = (shift, shift, shift); + my $command = $self->option('usermod'); + my $stdin = $self->option('usermod_stdin'); + no strict 'refs'; + ${"old_$_"} = $old->getfield($_) foreach $old->fields; + ${"new_$_"} = $new->getfield($_) foreach $new->fields; + $self->shellcommands_queue( $new->svcnum, + user => $self->options('user')||'root', + host => $self->options('machine'), + command => eval(qq("$command")), + stdin_string => eval(qq("$stdin")), + ); +} + +#a good idea to queue anything that could fail or take any time +sub shellcommands_queue { + my( $self, $svcnum ) = (shift, shift); + my $queue = new FS::queue { + 'svcnum' => $svcnum, + 'job' => "FS::part_export::shellcommands::ssh_cmd", + }; + $queue->insert( @_ ); +} + +sub ssh_cmd { #subroutine, not method + use Net::SSH '0.06'; + &Net::SSH::ssh_cmd( { @_ } ); +} + +#sub shellcommands_insert { #subroutine, not method +#} +#sub shellcommands_replace { #subroutine, not method +#} +#sub shellcommands_delete { #subroutine, not method +#} + diff --git a/FS/t/part_export-null.t b/FS/t/part_export-null.t new file mode 100644 index 000000000..055cdcee6 --- /dev/null +++ b/FS/t/part_export-null.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::null; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-sysvshell.t b/FS/t/part_export-sysvshell.t new file mode 100644 index 000000000..7fc24acb1 --- /dev/null +++ b/FS/t/part_export-sysvshell.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::sysvshell; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-www_shellcommands.t b/FS/t/part_export-www_shellcommands.t new file mode 100644 index 000000000..2ea79cf97 --- /dev/null +++ b/FS/t/part_export-www_shellcommands.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::www_shellcommands; +$loaded=1; +print "ok 1\n"; -- cgit v1.2.1 From 4c7ddc2010ddeaca45d40140993b05d43b7fe030 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 27 Jun 2002 09:23:05 +0000 Subject: null bind exports --- FS/FS/part_export/bind.pm | 7 +++++++ FS/FS/part_export/bind_slave.pm | 7 +++++++ FS/t/part_export-bind.t | 5 +++++ FS/t/part_export-bind_slave.t | 5 +++++ 4 files changed, 24 insertions(+) create mode 100644 FS/FS/part_export/bind.pm create mode 100644 FS/FS/part_export/bind_slave.pm create mode 100644 FS/t/part_export-bind.t create mode 100644 FS/t/part_export-bind_slave.t (limited to 'FS') diff --git a/FS/FS/part_export/bind.pm b/FS/FS/part_export/bind.pm new file mode 100644 index 000000000..b72c9bdb0 --- /dev/null +++ b/FS/FS/part_export/bind.pm @@ -0,0 +1,7 @@ +package FS::part_export::bind; + +use vars qw(@ISA); +use FS::part_export::null; + +@ISA = qw(FS::part_export::null); + diff --git a/FS/FS/part_export/bind_slave.pm b/FS/FS/part_export/bind_slave.pm new file mode 100644 index 000000000..ebb29c1d7 --- /dev/null +++ b/FS/FS/part_export/bind_slave.pm @@ -0,0 +1,7 @@ +package FS::part_export::bind_slave; + +use vars qw(@ISA); +use FS::part_export::null; + +@ISA = qw(FS::part_export::null); + diff --git a/FS/t/part_export-bind.t b/FS/t/part_export-bind.t new file mode 100644 index 000000000..d0c96be40 --- /dev/null +++ b/FS/t/part_export-bind.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::bind; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-bind_slave.t b/FS/t/part_export-bind_slave.t new file mode 100644 index 000000000..c6a038610 --- /dev/null +++ b/FS/t/part_export-bind_slave.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::bind_slave; +$loaded=1; +print "ok 1\n"; -- cgit v1.2.1 From 25747983ac27c3b804a2f15312c8c7b59769e014 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 28 Jun 2002 08:23:44 +0000 Subject: fix multi-database installs, while hopefully keeping performance improvement --- FS/FS/Record.pm | 8 +++++--- FS/FS/UID.pm | 4 ++-- 2 files changed, 7 insertions(+), 5 deletions(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index f7c3a41c8..7d5ff0582 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -2,7 +2,7 @@ package FS::Record; use strict; use vars qw( $dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK $DEBUG - $me ); + $me %dbdef_cache ); use subs qw(reload_dbdef); use Exporter; use Carp qw(carp cluck croak confess); @@ -1130,8 +1130,10 @@ I<$FS::Record::setup_hack> is true. Returns a DBIx::DBSchema object. sub reload_dbdef { my $file = shift || $dbdef_file; - $dbdef = load DBIx::DBSchema $file - or die "can't load database schema from $file"; + $dbdef = exists $dbdef_cache{$file} + ? $dbdef_cache{$file} + : $dbdef_cache{$file} = DBIx::DBSchema->load( $file ) + or die "can't load database schema from $file"; } =item dbdef diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm index 87830cb04..b1e590f2f 100644 --- a/FS/FS/UID.pm +++ b/FS/FS/UID.pm @@ -92,7 +92,7 @@ sub forksuidsetup { foreach ( keys %callback ) { &{$callback{$_}}; - delete $callback{$_}; #run once + # breaks multi-database installs # delete $callback{$_}; #run once } $dbh; @@ -256,7 +256,7 @@ coderef into the hash %FS::UID::callback : =head1 VERSION -$Id: UID.pm,v 1.15 2002-06-14 09:19:33 ivan Exp $ +$Id: UID.pm,v 1.16 2002-06-28 08:23:44 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 11deba5ca03afd00c0450bc4e0b9345e87e08829 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 28 Jun 2002 10:49:05 +0000 Subject: remove extraneous check --- FS/FS/Record.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 7d5ff0582..10fff99dd 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -735,7 +735,7 @@ sub unique { my($self,$field) = @_; my($table)=$self->table; - croak("&FS::UID::checkruid failed") unless &checkruid; + #croak("&FS::UID::checkruid failed") unless &checkruid; croak "Unique called on field $field, but it is ", $self->getfield($field), -- cgit v1.2.1 From 6d295788b1c6bfb1c96c8917043a1b209c8491e1 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 28 Jun 2002 20:21:35 +0000 Subject: better error message for missing tax classes --- FS/FS/cust_main.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index efe94027d..9ed3f2cab 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1053,8 +1053,8 @@ sub bill { $dbh->rollback if $oldAutoCommit; return "fatal: can't find tax rate for state/county/country/taxclass ". - join('/', map $self->$_(), qw(state county country taxclass) ). - "\n"; + join('/', ( map $self->$_(), qw(state county country) ), + $part_pkg->taxclass ). "\n"; }; if ( $cust_main_county->exempt_amount ) { -- cgit v1.2.1 From 87efb86d904887f9ee48dcf77fb1470d4c23a87f Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 28 Jun 2002 20:31:30 +0000 Subject: better error message for illegal password --- FS/FS/svc_acct.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index e2ac18639..2bbbdcbb7 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -787,7 +787,7 @@ sub check { $recref->{_password} = '!!'; } else { #return "Illegal password"; - return gettext('illegal_password'). "$passwordmin-$passwordmax". + return gettext('illegal_password'). " $passwordmin-$passwordmax ". FS::Msgcat::_gettext('illegal_password_characters'). ": ". $recref->{_password}; } -- cgit v1.2.1 From 87e22680728124c7d339a32d99f61442ccc204d7 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 30 Jun 2002 02:13:33 +0000 Subject: export! --- FS/FS/part_export.pm | 15 ++++++++++----- FS/FS/part_export/shellcommands_withdomain.pm | 7 +++++++ FS/MANIFEST | 12 ++++++++++++ FS/t/part_export-shellcommands_withdomain.t | 5 +++++ 4 files changed, 34 insertions(+), 5 deletions(-) create mode 100644 FS/FS/part_export/shellcommands_withdomain.pm create mode 100644 FS/t/part_export-shellcommands_withdomain.t (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 74f7006ca..23f948f6a 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -581,6 +581,11 @@ tie my %shellcommands_withdomain_options, 'Tie::IxHash', }, ; +tie my %textradius_options, 'Tie::IxHash', + 'user' => { label=>'Remote username', default=>'root' }, + 'users' => { label=>'users file location', default=>'/etc/raddb/users' }, +; + tie my %sqlradius_options, 'Tie::IxHash', 'datasrc' => { label=>'DBI data source ' }, 'username' => { label=>'Database username' }, @@ -661,22 +666,22 @@ tie my %sqlmail_options, 'Tie::IxHash', # 'options' => {}, # }, 'textradius' => { - 'desc' => 'Batch export of a text /etc/raddb/users file (Livingston, Cistron)', - 'options' => {}, - 'notes' => 'unfinished', + 'desc' => 'Real-time export to a text /etc/raddb/users file (Livingston, Cistron)', + 'options' => \%textradius_options, + 'notes' => 'This will edit a text RADIUS users file in place on a remote server. Requires installation of RADIUS::UserFile from CPAN. If using RADIUS::UserFile 1.01, make sure to apply this patch. Also make sure rsync is installed on the remote machine, and SSH is setup for unattended operation.', }, 'shellcommands' => { 'desc' => 'Real-time export via remote SSH (i.e. useradd, userdel, etc.)', 'options' => \%shellcommands_options, 'nodomain' => 'Y', - 'notes' => 'Run remote commands via SSH. Usernames are considered unique (also see shellcommands_withdomain).', + 'notes' => 'Run remote commands via SSH. Usernames are considered unique (also see shellcommands_withdomain). You probably want this if the commands you are running will not accept a domain as a parameter. You will need to setup SSH for unattended operation.', }, 'shellcommands_withdomain' => { 'desc' => 'Real-time export via remote SSH.', 'options' => \%shellcommands_withdomain_options, - 'notes' => 'Run remote commands via SSH. username@domain (rather than just usernames) are considered unique (also see shellcommands)', + 'notes' => 'Run remote commands via SSH. username@domain (rather than just usernames) are considered unique (also see shellcommands). You probably want this if the commands you are running will accept a domain as a parameter, and will allow the same username with different domains. You will need to setup SSH for unattended operation.', }, 'sqlradius' => { diff --git a/FS/FS/part_export/shellcommands_withdomain.pm b/FS/FS/part_export/shellcommands_withdomain.pm new file mode 100644 index 000000000..a15c24d88 --- /dev/null +++ b/FS/FS/part_export/shellcommands_withdomain.pm @@ -0,0 +1,7 @@ +package FS::part_export::shellcommands_withdomain; + +use vars qw(@ISA); +use FS::part_export::shellcommands; + +@ISA = qw(FS::part_export::shellcommands); + diff --git a/FS/MANIFEST b/FS/MANIFEST index daf27b7e4..c932f3aa0 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -49,15 +49,21 @@ FS/part_bill_event.pm FS/export_svc.pm FS/part_export.pm FS/part_export_option.pm +FS/part_export/bind.pm +FS/part_export/bind_slave.pm FS/part_export/bsdshell.pm FS/part_export/cp.pm FS/part_export/cyrus.pm FS/part_export/infostreet.pm +FS/part_export/null.pm FS/part_export/shellcommands.pm +FS/part_export/shellcommands_withdomain.pm FS/part_export/sqlmail.pm FS/part_export/sqlradius.pm +FS/part_export/sysvshell.pm FS/part_export/textradius.pm FS/part_export/vpopmail.pm +FS/part_export/www_shellcommands.pm FS/part_pkg.pm FS/part_pop_local.pm FS/part_referral.pm @@ -113,15 +119,21 @@ t/part_bill_event.t t/export_svc.t t/part_export.t t/part_export_option.t +t/part_export-bind.t +t/part_export-bind_slave.t t/part_export-bsdshell.t t/part_export-cp.t t/part_export-cyrus.t t/part_export-infostreet.t +t/part_export-null.t t/part_export-shellcommands.t +t/part_export-shellcommands_withdomain.t t/part_export-sqlmail.t t/part_export-sqlradius.t +t/part_export-sysvshell.t t/part_export-textradius.t t/part_export-vpopmail.t +t/part_export-www_shellcommands.t t/part_pkg.t t/part_pop_local.t t/part_referral.t diff --git a/FS/t/part_export-shellcommands_withdomain.t b/FS/t/part_export-shellcommands_withdomain.t new file mode 100644 index 000000000..c0bd1bbb0 --- /dev/null +++ b/FS/t/part_export-shellcommands_withdomain.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::shellcommands_withdomain; +$loaded=1; +print "ok 1\n"; -- cgit v1.2.1 From 6914db4bdd641adcab054b3aa0508d482f3dab9e Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 30 Jun 2002 07:04:08 +0000 Subject: fix dbdef caching --- FS/FS/Record.pm | 29 +++++++++++++++++------------ 1 file changed, 17 insertions(+), 12 deletions(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 10fff99dd..5fa0a466a 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -250,7 +250,7 @@ sub qsearch { } $statement .= " $extra_sql" if defined($extra_sql); - warn "[debug]$me $statement\n" if $DEBUG; + warn "[debug]$me $statement\n" if $DEBUG > 1; my $sth = $dbh->prepare($statement) or croak "$dbh->errstr doing $statement"; @@ -502,13 +502,13 @@ sub insert { join( ', ', @values ). ")" ; - warn "[debug]$me $statement\n" if $DEBUG; + warn "[debug]$me $statement\n" if $DEBUG > 1; my $sth = dbh->prepare($statement) or return dbh->errstr; my $h_sth; if ( defined $dbdef->table('h_'. $self->table) ) { my $h_statement = $self->_h_statement('insert'); - warn "[debug]$me $h_statement\n" if $DEBUG; + warn "[debug]$me $h_statement\n" if $DEBUG > 2; $h_sth = dbh->prepare($h_statement) or return dbh->errstr; } else { $h_sth = ''; @@ -562,13 +562,13 @@ sub delete { ? ( $self->dbdef_table->primary_key) : $self->fields ); - warn "[debug]$me $statement\n" if $DEBUG; + warn "[debug]$me $statement\n" if $DEBUG > 1; my $sth = dbh->prepare($statement) or return dbh->errstr; my $h_sth; if ( defined $dbdef->table('h_'. $self->table) ) { my $h_statement = $self->_h_statement('delete'); - warn "[debug]$me $h_statement\n" if $DEBUG; + warn "[debug]$me $h_statement\n" if $DEBUG > 2; $h_sth = dbh->prepare($h_statement) or return dbh->errstr; } else { $h_sth = ''; @@ -647,13 +647,13 @@ sub replace { } ( $primary_key ? ( $primary_key ) : $old->fields ) ) ; - warn "[debug]$me $statement\n" if $DEBUG; + warn "[debug]$me $statement\n" if $DEBUG > 1; my $sth = dbh->prepare($statement) or return dbh->errstr; my $h_old_sth; if ( defined $dbdef->table('h_'. $old->table) ) { my $h_old_statement = $old->_h_statement('replace_old'); - warn "[debug]$me $h_old_statement\n" if $DEBUG; + warn "[debug]$me $h_old_statement\n" if $DEBUG > 2; $h_old_sth = dbh->prepare($h_old_statement) or return dbh->errstr; } else { $h_old_sth = ''; @@ -662,7 +662,7 @@ sub replace { my $h_new_sth; if ( defined $dbdef->table('h_'. $new->table) ) { my $h_new_statement = $new->_h_statement('replace_new'); - warn "[debug]$me $h_new_statement\n" if $DEBUG; + warn "[debug]$me $h_new_statement\n" if $DEBUG > 2; $h_new_sth = dbh->prepare($h_new_statement) or return dbh->errstr; } else { $h_new_sth = ''; @@ -1130,10 +1130,15 @@ I<$FS::Record::setup_hack> is true. Returns a DBIx::DBSchema object. sub reload_dbdef { my $file = shift || $dbdef_file; - $dbdef = exists $dbdef_cache{$file} - ? $dbdef_cache{$file} - : $dbdef_cache{$file} = DBIx::DBSchema->load( $file ) - or die "can't load database schema from $file"; + + unless ( exists $dbdef_cache{$file} ) { + warn "[debug]$me loading dbdef for $file\n" if $DEBUG; + $dbdef_cache{$file} = DBIx::DBSchema->load( $file ) + or die "can't load database schema from $file"; + } else { + warn "[debug]$me re-using cached dbdef for $file\n" if $DEBUG; + } + $dbdef = $dbdef_cache{$file}; } =item dbdef -- cgit v1.2.1 From 33aa71dbc113342361b6872e9587945bbcfe88a3 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 30 Jun 2002 07:16:29 +0000 Subject: get rid of unneeded Pg-cruft (don't use native Pg money type) --- FS/FS/Record.pm | 11 ++--------- 1 file changed, 2 insertions(+), 9 deletions(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 5fa0a466a..3404a67fe 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -132,15 +132,8 @@ sub new { 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/\,//; - } + foreach my $field ( grep defined($hashref->{$_}), $self->fields ) { + $hashref->{$field}=''; } $self->_cache($hashref, shift) if $self->can('_cache') && @_; -- cgit v1.2.1 From a486765cc7b6e1cb110720ba199788cf0f7c1280 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 30 Jun 2002 07:17:48 +0000 Subject: oops, very bad --- FS/FS/Record.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 3404a67fe..e6126a13b 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -132,7 +132,7 @@ sub new { my $hashref = $self->{'Hash'} = shift; - foreach my $field ( grep defined($hashref->{$_}), $self->fields ) { + foreach my $field ( grep !defined($hashref->{$_}), $self->fields ) { $hashref->{$field}=''; } -- cgit v1.2.1 From 6f8f8741b105fdc1fc005536e6ee0acbd5783793 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 1 Jul 2002 09:15:56 +0000 Subject: real-time! text radius export --- FS/FS/part_export/textradius.pm | 126 ++++++++++++++++++++++++++++++++++++---- 1 file changed, 115 insertions(+), 11 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export/textradius.pm b/FS/FS/part_export/textradius.pm index 9a0468f6d..691753f25 100644 --- a/FS/FS/part_export/textradius.pm +++ b/FS/FS/part_export/textradius.pm @@ -1,33 +1,37 @@ package FS::part_export::textradius; -use vars qw(@ISA); +use vars qw(@ISA $prefix); +use Fcntl qw(:flock); +use FS::UID qw(datasrc); use FS::part_export; @ISA = qw(FS::part_export); +$prefix = "/usr/local/etc/freeside/export."; + sub rebless { shift; } sub _export_insert { my($self, $svc_acct) = (shift, shift); $err_or_queue = $self->textradius_queue( $svc_acct->svcnum, 'insert', - $svc_acct->username, $svc_acct->_password ); + $svc_acct->username, $svc_acct->radius_check, '-', $svc_acct->radius_reply); ref($err_or_queue) ? '' : $err_or_queue; } sub _export_replace { my( $self, $new, $old ) = (shift, shift, shift); - #return "can't change username with textradius" - # if $old->username ne $new->username; + return "can't (yet?) change username with textradius" + if $old->username ne $new->username; #return '' unless $old->_password ne $new->_password; - $err_or_queue = $self->textradius_queue( $new->svcnum, - 'replace', $new->username, $new->_password ); + $err_or_queue = $self->textradius_queue( $new->svcnum, 'insert', + $new->username, $new->radius_check, '-', $new->radius_reply); ref($err_or_queue) ? '' : $err_or_queue; } sub _export_delete { my( $self, $svc_acct ) = (shift, shift); - $err_or_queue = $self->textradius_queue( $svc_acct->svcnum, - 'delete', $svc_acct->username ); + $err_or_queue = $self->textradius_queue( $svc_acct->svcnum, 'delete', + $svc_acct->username ); ref($err_or_queue) ? '' : $err_or_queue; } @@ -38,13 +42,113 @@ sub textradius_queue { 'svcnum' => $svcnum, 'job' => "FS::part_export::textradius::textradius_$method", }; - $queue->insert( @_ ) or $queue; + $queue->insert( + $self->option('user'), + $self->machine, + $self->option('users'), + @_, + ) or $queue; } sub textradius_insert { #subroutine, not method + my( $user, $host, $users, $username, @attributes ) = @_; + + #silly arg processing + my($att, @check); + push @check, $att while ($att=shift @attributes) ne '-'; + my %check = @check; + my %reply = @attributes; + + my $file = textradius_download($user, $host, $users); + + eval "use RADIUS::UserFile;"; + die $@ if $@; + + my $userfile = new RADIUS::UserFile( + File => $file, + Who => [ $username ], + Check_Items => [ keys %check ], + ) or die "error parsing $file"; + + $userfile->remove($username); + $userfile->add( + Who => $username, + Attributes => { %check, %reply }, + Comment => 'user added by Freeside', + ) or die "error adding to $file"; + + $userfile->update( Who => [ $username ] ) + or die "error updating $file"; + + textradius_upload($user, $host, $users); + } -sub textradius_replace { #subroutine, not method -} + sub textradius_delete { #subroutine, not method + my( $user, $host, $users, $username ) = @_; + + my $file = textradius_download($user, $host, $users); + + eval "use RADIUS::UserFile;"; + die $@ if $@; + + my $userfile = new RADIUS::UserFile( + File => $file, + Who => [ $username ], + ) or die "error parsing $file"; + + $userfile->remove($username); + + $userfile->update( Who => [ $username ] ) + or die "error updating $file"; + + textradius_upload($user, $host, $users); +} + +sub textradius_download { + my( $user, $host, $users ) = @_; + + my $dir = $prefix. datasrc; + mkdir $dir, 0700 or die $! unless -d $dir; + $dir .= "/$host"; + mkdir $dir, 0700 or die $! unless -d $dir; + + my $dest = "$dir/users"; + + eval "use File::Rsync;"; + die $@ if $@; + my $rsync = File::Rsync->new({ rsh => 'ssh' }); + + open(LOCK, "+>>$dest.lock") + and flock(LOCK,LOCK_EX) + or die "can't open $dest.lock: $!"; + + $rsync->exec( { + src => "$user\@$host:$users", + dest => $dest, + } ); + + $dest; +} + +sub textradius_upload { + my( $user, $host, $users ) = @_; + + my $dir = $prefix. datasrc. "/$host"; + + eval "use File::Rsync;"; + die $@ if $@; + my $rsync = File::Rsync->new({ + rsh => 'ssh', + #dry_run => 1, + }); + $rsync->exec( { + src => "$dir/users", + dest => "$user\@$host:$users", + } ); + + flock(LOCK,LOCK_UN); + close LOCK; + } -- cgit v1.2.1 From 3b7715909d2f2983a077ff97ff66faac40cb9558 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 1 Jul 2002 22:38:21 +0000 Subject: prevent any possible infinite looping --- FS/FS/part_export/textradius.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export/textradius.pm b/FS/FS/part_export/textradius.pm index 691753f25..de0158b50 100644 --- a/FS/FS/part_export/textradius.pm +++ b/FS/FS/part_export/textradius.pm @@ -55,7 +55,7 @@ sub textradius_insert { #subroutine, not method #silly arg processing my($att, @check); - push @check, $att while ($att=shift @attributes) ne '-'; + push @check, $att while @attributes && ($att=shift @attributes) ne '-'; my %check = @check; my %reply = @attributes; -- cgit v1.2.1 From eb783504f4b23a30e2391269283e565e04e9aece Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 2 Jul 2002 06:48:59 +0000 Subject: error messages can have other chars --- FS/FS/queue.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/queue.pm b/FS/FS/queue.pm index 1de19b7b5..d35dc883f 100644 --- a/FS/FS/queue.pm +++ b/FS/FS/queue.pm @@ -196,7 +196,7 @@ sub check { || $self->ut_anything('job') || $self->ut_numbern('_date') || $self->ut_enum('status',['', qw( new locked failed )]) - || $self->ut_textn('statustext') + || $self->ut_anything('statustext') || $self->ut_numbern('svcnum') ; return $error if $error; @@ -385,7 +385,7 @@ END =head1 VERSION -$Id: queue.pm,v 1.14 2002-06-14 11:22:53 ivan Exp $ +$Id: queue.pm,v 1.15 2002-07-02 06:48:59 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From b57dbad22a76abc65dc73745990dca5e8bfe9411 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 2 Jul 2002 06:58:27 +0000 Subject: s/options/option/, oops, and machine isn't an option --- FS/FS/part_export/shellcommands.pm | 8 ++++---- FS/FS/part_export/www_shellcommands.pm | 8 ++++---- 2 files changed, 8 insertions(+), 8 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm index 870d7f1ee..e95939b8c 100644 --- a/FS/FS/part_export/shellcommands.pm +++ b/FS/FS/part_export/shellcommands.pm @@ -24,8 +24,8 @@ sub _export_command { no strict 'refs'; ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields; $self->shellcommands_queue( $svc_acct->svcnum, - user => $self->options('user')||'root', - host => $self->options('machine'), + user => $self->option('user')||'root', + host => $self->machine, command => eval(qq("$command")), stdin_string => eval(qq("$stdin")), ); @@ -39,8 +39,8 @@ sub _export_replace { ${"old_$_"} = $old->getfield($_) foreach $old->fields; ${"new_$_"} = $new->getfield($_) foreach $new->fields; $self->shellcommands_queue( $new->svcnum, - user => $self->options('user')||'root', - host => $self->options('machine'), + user => $self->option('user')||'root', + host => $self->machine, command => eval(qq("$command")), stdin_string => eval(qq("$stdin")), ); diff --git a/FS/FS/part_export/www_shellcommands.pm b/FS/FS/part_export/www_shellcommands.pm index 870d7f1ee..e95939b8c 100644 --- a/FS/FS/part_export/www_shellcommands.pm +++ b/FS/FS/part_export/www_shellcommands.pm @@ -24,8 +24,8 @@ sub _export_command { no strict 'refs'; ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields; $self->shellcommands_queue( $svc_acct->svcnum, - user => $self->options('user')||'root', - host => $self->options('machine'), + user => $self->option('user')||'root', + host => $self->machine, command => eval(qq("$command")), stdin_string => eval(qq("$stdin")), ); @@ -39,8 +39,8 @@ sub _export_replace { ${"old_$_"} = $old->getfield($_) foreach $old->fields; ${"new_$_"} = $new->getfield($_) foreach $new->fields; $self->shellcommands_queue( $new->svcnum, - user => $self->options('user')||'root', - host => $self->options('machine'), + user => $self->option('user')||'root', + host => $self->machine, command => eval(qq("$command")), stdin_string => eval(qq("$stdin")), ); -- cgit v1.2.1 From 6dcf9258234427eb6cd6ad3e9912c4f1dac91ceb Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 2 Jul 2002 07:13:28 +0000 Subject: better error reporting from rsync --- FS/FS/part_export/textradius.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export/textradius.pm b/FS/FS/part_export/textradius.pm index de0158b50..74807878b 100644 --- a/FS/FS/part_export/textradius.pm +++ b/FS/FS/part_export/textradius.pm @@ -126,7 +126,7 @@ sub textradius_download { $rsync->exec( { src => "$user\@$host:$users", dest => $dest, - } ); + } ) or die "error downloading $user\@$host:$users : ". $rsync->err; $dest; } @@ -145,7 +145,7 @@ sub textradius_upload { $rsync->exec( { src => "$dir/users", dest => "$user\@$host:$users", - } ); + } ) or die "error uploading to $user\@$host:$users : ". $rsync->err; flock(LOCK,LOCK_UN); close LOCK; -- cgit v1.2.1 From 4c9602a986e835d56471a090afe8e5bd8fae5108 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 2 Jul 2002 07:31:42 +0000 Subject: working textradius --- FS/FS/part_export/textradius.pm | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export/textradius.pm b/FS/FS/part_export/textradius.pm index 74807878b..c96bcfc48 100644 --- a/FS/FS/part_export/textradius.pm +++ b/FS/FS/part_export/textradius.pm @@ -43,7 +43,7 @@ sub textradius_queue { 'job' => "FS::part_export::textradius::textradius_$method", }; $queue->insert( - $self->option('user'), + $self->option('user')||'root', $self->machine, $self->option('users'), @_, @@ -126,7 +126,8 @@ sub textradius_download { $rsync->exec( { src => "$user\@$host:$users", dest => $dest, - } ) or die "error downloading $user\@$host:$users : ". $rsync->err; + } ) or die "error downloading $user\@$host:$users : ". + join(" / ", $rsync->err); $dest; } @@ -145,7 +146,8 @@ sub textradius_upload { $rsync->exec( { src => "$dir/users", dest => "$user\@$host:$users", - } ) or die "error uploading to $user\@$host:$users : ". $rsync->err; + } ) or die "error uploading to $user\@$host:$users : ". + join(" / ", $rsync->err); flock(LOCK,LOCK_UN); close LOCK; -- cgit v1.2.1 From 72395edddb5a3887092b51056d719584f7979005 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 2 Jul 2002 09:39:04 +0000 Subject: freebsd is sofa king broken --- FS/bin/freeside-queued | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-queued b/FS/bin/freeside-queued index 42d00cebe..4ddc70a48 100644 --- a/FS/bin/freeside-queued +++ b/FS/bin/freeside-queued @@ -36,8 +36,13 @@ $sigint = 0; $SIG{INT} = sub { warn "SIGINT received; shutting down\n"; $sigint++; }; $SIG{TERM} = sub { warn "SIGTERM received; shutting down\n"; $sigterm++; }; -$> = $FS::UID::freeside_uid unless $>; -$< = $>; +$< = FS::UID::freeside_uid; + +#freebsd is sofa king broken, won't setuid() +$> = $FS::UID::freeside_uid; +($<,$>) = ($>,$<); +$> = $FS::UID::freeside_uid; + $ENV{HOME} = (getpwuid($>))[7]; #for ssh adminsuidsetup $user; -- cgit v1.2.1 From cc9c574e5f772917515e85a5c07ce263a8552a03 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 2 Jul 2002 09:42:38 +0000 Subject: fleabsd grr --- FS/bin/freeside-queued | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/bin/freeside-queued b/FS/bin/freeside-queued index 4ddc70a48..46d39f2b0 100644 --- a/FS/bin/freeside-queued +++ b/FS/bin/freeside-queued @@ -36,7 +36,7 @@ $sigint = 0; $SIG{INT} = sub { warn "SIGINT received; shutting down\n"; $sigint++; }; $SIG{TERM} = sub { warn "SIGTERM received; shutting down\n"; $sigterm++; }; -$< = FS::UID::freeside_uid; +$< = $FS::UID::freeside_uid; #freebsd is sofa king broken, won't setuid() $> = $FS::UID::freeside_uid; -- cgit v1.2.1 From 00613fa78edb718fdc96640fe08d806079a81ad2 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 2 Jul 2002 10:14:45 +0000 Subject: grr old openssh grr freebsd --- FS/bin/freeside-queued | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-queued b/FS/bin/freeside-queued index 46d39f2b0..20a6ff9fb 100644 --- a/FS/bin/freeside-queued +++ b/FS/bin/freeside-queued @@ -36,10 +36,17 @@ $sigint = 0; $SIG{INT} = sub { warn "SIGINT received; shutting down\n"; $sigint++; }; $SIG{TERM} = sub { warn "SIGTERM received; shutting down\n"; $sigterm++; }; -$< = $FS::UID::freeside_uid; +my $freeside_gid = scalar(getgrnam('freeside')) + or die "can't setgid to freeside group\n"; +$) = $freeside_gid; +$( = $freeside_gid; +#if freebsd can't setuid(), presumably it can't setgid() either. grr fleabsd +($<,$>) = ($>,$<); +$> = $freeside_gid; -#freebsd is sofa king broken, won't setuid() $> = $FS::UID::freeside_uid; +$< = $FS::UID::freeside_uid; +#freebsd is sofa king broken, won't setuid() ($<,$>) = ($>,$<); $> = $FS::UID::freeside_uid; -- cgit v1.2.1 From 7308f9eeb141bab0f550cce772a42f18a5cc7319 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 2 Jul 2002 11:27:53 +0000 Subject: useful shellcommands presets --- FS/FS/part_export.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 23f948f6a..072074b96 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -675,7 +675,7 @@ tie my %sqlmail_options, 'Tie::IxHash', 'desc' => 'Real-time export via remote SSH (i.e. useradd, userdel, etc.)', 'options' => \%shellcommands_options, 'nodomain' => 'Y', - 'notes' => 'Run remote commands via SSH. Usernames are considered unique (also see shellcommands_withdomain). You probably want this if the commands you are running will not accept a domain as a parameter. You will need to setup SSH for unattended operation.', + 'notes' => 'Run remote commands via SSH. Usernames are considered unique (also see shellcommands_withdomain). You probably want this if the commands you are running will not accept a domain as a parameter. You will need to setup SSH for unattended operation.

Use these buttons for some useful presets:
', }, 'shellcommands_withdomain' => { @@ -765,7 +765,7 @@ tie my %sqlmail_options, 'Tie::IxHash', 'www_shellcommands' => { 'desc' => 'www_shellcommands', 'options' => {}, # \%www_shellcommands_options, - 'notes' => 'svc_www commands', + 'notes' => 'unfinished...', }, }, -- cgit v1.2.1 From c0ab97dcaeae4c1f6426f8020f2d84639fa08bcd Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 2 Jul 2002 11:29:26 +0000 Subject: fix for freebsd presets --- FS/FS/part_export.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 072074b96..e02575810 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -675,7 +675,7 @@ tie my %sqlmail_options, 'Tie::IxHash', 'desc' => 'Real-time export via remote SSH (i.e. useradd, userdel, etc.)', 'options' => \%shellcommands_options, 'nodomain' => 'Y', - 'notes' => 'Run remote commands via SSH. Usernames are considered unique (also see shellcommands_withdomain). You probably want this if the commands you are running will not accept a domain as a parameter. You will need to setup SSH for unattended operation.

Use these buttons for some useful presets:
', + 'notes' => 'Run remote commands via SSH. Usernames are considered unique (also see shellcommands_withdomain). You probably want this if the commands you are running will not accept a domain as a parameter. You will need to setup SSH for unattended operation.

Use these buttons for some useful presets:
', }, 'shellcommands_withdomain' => { -- cgit v1.2.1 From cd5d6c049041ee198e38687e7dd0a63f3d21b2ef Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 2 Jul 2002 13:00:25 +0000 Subject: working linux and freebsd shellcommands --- FS/FS/part_export.pm | 10 +++++----- FS/FS/part_export/shellcommands.pm | 8 +++++++- 2 files changed, 12 insertions(+), 6 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index e02575810..157924813 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -526,12 +526,12 @@ tie my %shellcommands_options, 'Tie::IxHash', #'machine' => { label=>'Remote machine' }, 'user' => { label=>'Remote username', default=>'root' }, 'useradd' => { label=>'Insert command', - default=>'useradd -d $dir -m -s $shell -u $uid $username; passwd $username' + default=>'useradd -d $dir -m -s $shell -u $uid -p $crypt_password $username' #default=>'cp -pr /etc/skel $dir; chown -R $uid.$gid $dir' }, 'useradd_stdin' => { label=>'Insert command STDIN', type =>'textarea', - default=>"\$_password\n\$_password\n", + default=>"", }, 'userdel' => { label=>'Delete command', default=>'userdel $username', @@ -542,7 +542,7 @@ tie my %shellcommands_options, 'Tie::IxHash', default=>'', }, 'usermod' => { label=>'Modify command', - default=>'usermod -d $new_dir -l $new_username -s $new_shell -u $new_uid $old_username; passwd $new_username', + default=>'usermod -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -p $new_crypt_password $old_username', #default=>'[ -d $old_dir ] && mv $old_dir $new_dir || ( '. # 'chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; '. # 'find . -depth -print | cpio -pdm $new_dir; '. @@ -552,7 +552,7 @@ tie my %shellcommands_options, 'Tie::IxHash', }, 'usermod_stdin' => { label=>'Modify command STDIN', type =>'textarea', - default=>"\$_password\n\$_password\n", + default=>"", }, ; @@ -675,7 +675,7 @@ tie my %sqlmail_options, 'Tie::IxHash', 'desc' => 'Real-time export via remote SSH (i.e. useradd, userdel, etc.)', 'options' => \%shellcommands_options, 'nodomain' => 'Y', - 'notes' => 'Run remote commands via SSH. Usernames are considered unique (also see shellcommands_withdomain). You probably want this if the commands you are running will not accept a domain as a parameter. You will need to setup SSH for unattended operation.

Use these buttons for some useful presets:
', + 'notes' => 'Run remote commands via SSH. Usernames are considered unique (also see shellcommands_withdomain). You probably want this if the commands you are running will not accept a domain as a parameter. You will need to setup SSH for unattended operation.

Use these buttons for some useful presets:
', }, 'shellcommands_withdomain' => { diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm index e95939b8c..4e943605f 100644 --- a/FS/FS/part_export/shellcommands.pm +++ b/FS/FS/part_export/shellcommands.pm @@ -1,10 +1,12 @@ package FS::part_export::shellcommands; -use vars qw(@ISA); +use vars qw(@ISA @saltset); use FS::part_export; @ISA = qw(FS::part_export); +@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); + sub rebless { shift; } sub _export_insert { @@ -23,6 +25,8 @@ sub _export_command { my $stdin = $self->option($action."_stdin"); no strict 'refs'; ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields; + $crypt_password = crypt( $svc_acct->_password, + $saltset[int(rand(64))].$saltset[int(rand(64))] ); $self->shellcommands_queue( $svc_acct->svcnum, user => $self->option('user')||'root', host => $self->machine, @@ -38,6 +42,8 @@ sub _export_replace { no strict 'refs'; ${"old_$_"} = $old->getfield($_) foreach $old->fields; ${"new_$_"} = $new->getfield($_) foreach $new->fields; + $new_crypt_password = crypt( $svc_acct->_password, + $saltset[int(rand(64))].$saltset[int(rand(64))]); $self->shellcommands_queue( $new->svcnum, user => $self->option('user')||'root', host => $self->machine, -- cgit v1.2.1 From 9db8ce085c415b8f3ea76cd7daf76723d0edb2a3 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 2 Jul 2002 13:04:57 +0000 Subject: no warnings --- FS/FS/part_export/shellcommands.pm | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm index 4e943605f..56cd569af 100644 --- a/FS/FS/part_export/shellcommands.pm +++ b/FS/FS/part_export/shellcommands.pm @@ -23,10 +23,13 @@ sub _export_command { my ( $self, $action, $svc_acct) = (shift, shift, shift); my $command = $self->option($action); my $stdin = $self->option($action."_stdin"); - no strict 'refs'; - ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields; + { + no strict 'refs'; + ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields; + } + $crypt_password = ''; #surpress "used only once" warnings $crypt_password = crypt( $svc_acct->_password, - $saltset[int(rand(64))].$saltset[int(rand(64))] ); + $saltset[int(rand(64))].$saltset[int(rand(64))] ); $self->shellcommands_queue( $svc_acct->svcnum, user => $self->option('user')||'root', host => $self->machine, @@ -39,10 +42,13 @@ sub _export_replace { my($self, $new, $old ) = (shift, shift, shift); my $command = $self->option('usermod'); my $stdin = $self->option('usermod_stdin'); - no strict 'refs'; - ${"old_$_"} = $old->getfield($_) foreach $old->fields; - ${"new_$_"} = $new->getfield($_) foreach $new->fields; - $new_crypt_password = crypt( $svc_acct->_password, + { + no strict 'refs'; + ${"old_$_"} = $old->getfield($_) foreach $old->fields; + ${"new_$_"} = $new->getfield($_) foreach $new->fields; + } + $new_crypt_password = ''; #surpress "used only once" warnings + $new_crypt_password = crypt( $new->_password, $saltset[int(rand(64))].$saltset[int(rand(64))]); $self->shellcommands_queue( $new->svcnum, user => $self->option('user')||'root', -- cgit v1.2.1 From 0d9e6fc32b9fc3b3a05c2bf0446ee57d484e79a9 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 2 Jul 2002 14:00:37 +0000 Subject: better diagnostics --- FS/FS/part_export/textradius.pm | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export/textradius.pm b/FS/FS/part_export/textradius.pm index c96bcfc48..450a0e57b 100644 --- a/FS/FS/part_export/textradius.pm +++ b/FS/FS/part_export/textradius.pm @@ -127,7 +127,9 @@ sub textradius_download { src => "$user\@$host:$users", dest => $dest, } ) or die "error downloading $user\@$host:$users : ". - join(" / ", $rsync->err); + 'exit status: '. $rsync->status. ', '. + 'STDERR: '. join(" / ", $rsync->err). ', '. + 'STDOUT: '. join(" / ", $rsync->out); $dest; } @@ -147,7 +149,9 @@ sub textradius_upload { src => "$dir/users", dest => "$user\@$host:$users", } ) or die "error uploading to $user\@$host:$users : ". - join(" / ", $rsync->err); + 'exit status: '. $rsync->status. ', '. + 'STDERR: '. join(" / ", $rsync->err). ', '. + 'STDOUT: '. join(" / ", $rsync->out); flock(LOCK,LOCK_UN); close LOCK; -- cgit v1.2.1 From d5ae9f38bdea9e3de50f76aa8caf06956b4fb706 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 2 Jul 2002 14:22:21 +0000 Subject: working textradius export --- FS/FS/part_export/textradius.pm | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export/textradius.pm b/FS/FS/part_export/textradius.pm index 450a0e57b..1492f2672 100644 --- a/FS/FS/part_export/textradius.pm +++ b/FS/FS/part_export/textradius.pm @@ -126,10 +126,13 @@ sub textradius_download { $rsync->exec( { src => "$user\@$host:$users", dest => $dest, - } ) or die "error downloading $user\@$host:$users : ". - 'exit status: '. $rsync->status. ', '. - 'STDERR: '. join(" / ", $rsync->err). ', '. - 'STDOUT: '. join(" / ", $rsync->out); + } ); # true/false return value from exec is not working, alas + if ( $rsync->err ) { + die "error downloading $user\@$host:$users : ". + 'exit status: '. $rsync->status. ', '. + 'STDERR: '. join(" / ", $rsync->err). ', '. + 'STDOUT: '. join(" / ", $rsync->out); + } $dest; } @@ -148,10 +151,13 @@ sub textradius_upload { $rsync->exec( { src => "$dir/users", dest => "$user\@$host:$users", - } ) or die "error uploading to $user\@$host:$users : ". - 'exit status: '. $rsync->status. ', '. - 'STDERR: '. join(" / ", $rsync->err). ', '. - 'STDOUT: '. join(" / ", $rsync->out); + } ); # true/false return value from exec is not working, alas + if ( $rsync->err ) { + die "error uploading to $user\@$host:$users : ". + 'exit status: '. $rsync->status. ', '. + 'STDERR: '. join(" / ", $rsync->err). ', '. + 'STDOUT: '. join(" / ", $rsync->out); + } flock(LOCK,LOCK_UN); close LOCK; -- cgit v1.2.1 From ee94f6beec79b0b92ef05152ed3cca96e8b31cdc Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 2 Jul 2002 23:03:30 +0000 Subject: fix usermod commands for freebsd --- FS/FS/part_export.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 157924813..d15a87986 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -675,7 +675,7 @@ tie my %sqlmail_options, 'Tie::IxHash', 'desc' => 'Real-time export via remote SSH (i.e. useradd, userdel, etc.)', 'options' => \%shellcommands_options, 'nodomain' => 'Y', - 'notes' => 'Run remote commands via SSH. Usernames are considered unique (also see shellcommands_withdomain). You probably want this if the commands you are running will not accept a domain as a parameter. You will need to setup SSH for unattended operation.

Use these buttons for some useful presets:
', + 'notes' => 'Run remote commands via SSH. Usernames are considered unique (also see shellcommands_withdomain). You probably want this if the commands you are running will not accept a domain as a parameter. You will need to setup SSH for unattended operation.

Use these buttons for some useful presets:
', }, 'shellcommands_withdomain' => { -- cgit v1.2.1 From 96d1ff9741744ce60dbc123fa92ec794dbac2d17 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 3 Jul 2002 01:01:26 +0000 Subject: fix usage message --- FS/bin/freeside-sqlradius-reset | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/bin/freeside-sqlradius-reset b/FS/bin/freeside-sqlradius-reset index 41f3358f6..9cb2e2905 100755 --- a/FS/bin/freeside-sqlradius-reset +++ b/FS/bin/freeside-sqlradius-reset @@ -46,7 +46,7 @@ foreach my $export ( @exports ) { sub usage { #die "Usage:\n\n sqlradius_reset user machine\n"; - die "Usage:\n\n sqlradius_reset user\n"; + die "Usage:\n\n freeside-sqlradius-reset user\n"; } =head1 NAME -- cgit v1.2.1 From 8b8a9f09b5072db2af7f08d49d916b91f0b1bac7 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 3 Jul 2002 01:05:24 +0000 Subject: pod --- FS/bin/freeside-sqlradius-reset | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/bin/freeside-sqlradius-reset b/FS/bin/freeside-sqlradius-reset index 9cb2e2905..9d3a6a700 100755 --- a/FS/bin/freeside-sqlradius-reset +++ b/FS/bin/freeside-sqlradius-reset @@ -66,7 +66,7 @@ B is a username added by freeside-adduser. =head1 SEE ALSO -, L +L, L, L =cut -- cgit v1.2.1 From b3ea4da977be6a246a61852be9cd40a5b0a11dfe Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 3 Jul 2002 01:47:06 +0000 Subject: freeside-reexport --- FS/MANIFEST | 1 + FS/bin/freeside-reexport | 62 ++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 63 insertions(+) create mode 100644 FS/bin/freeside-reexport (limited to 'FS') diff --git a/FS/MANIFEST b/FS/MANIFEST index c932f3aa0..d9860b15f 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -16,6 +16,7 @@ bin/freeside-tax-report bin/freeside-cc-receipts-report bin/freeside-credit-report bin/freeside-expiration-alerter +bin/freeside-reexport FS.pm FS/CGI.pm FS/Conf.pm diff --git a/FS/bin/freeside-reexport b/FS/bin/freeside-reexport new file mode 100644 index 000000000..b5c50a422 --- /dev/null +++ b/FS/bin/freeside-reexport @@ -0,0 +1,62 @@ +#!/usr/bin/perl -Tw + +use strict; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch qsearchs); +use FS::part_export; +use FS::svc_acct; +use FS::cust_svc; + +my $user = shift or die &usage; +adminsuidsetup $user; + +my $export_x = shift or die &usage; +my @part_export; +if ( $export_x =~ /^(\d+)$/ ) { + @part_export = qsearchs('part_export', { exportnum=>$1 } ) + or die "exportnum $export_x not found\n"; +} else { + @part_export = qsearch('part_export', { exporttype=>$export_x } ) + or die "no exports of type $export_x found\n"; +} + +my $svc_something = shift or die &usage; +my $svc_x; +if ( $svc_something =~ /^(\d+)$/ ) { + my $cust_svc = qsearchs('cust_svc', { svcnum=>$1 } ) + or die "svcnum $svc_something not found\n"; + $svc_x = $cust_svc->svc_x; +} else { + $svc_x = qsearchs('svc_acct', { username=>$svc_something } ) + or die "username $svc_something not found\n"; +} + +foreach my $part_export ( @part_export ) { + my $error = $part_export->export_insert($svc_x); + die $error if $error; +} + + +sub usage { + die "Usage:\n\n freeside-reexport user exportnum|exporttype svcnum|username\n"; +} + +=head1 NAME + +freeside-reexport - Command line tool to re-trigger export jobs for existing services + +=head1 SYNOPSIS + + freeside-reexport user exportnum|exporttype svcnum|username + +=head1 DESCRIPTION + + Re-queues the export job for the specified exportnum or exporttype(s) and + specified service (selected by svcnum or username). + +=head1 SEE ALSO + +L, L + +=cut + -- cgit v1.2.1 From e1ef1693e6942bbf82ee088f782d871a3b5eefee Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 3 Jul 2002 02:26:00 +0000 Subject: deprecate text radius config options update config docs --- FS/FS/Conf.pm | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index dbb3682d0..25c674301 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -348,7 +348,7 @@ httemplate/docs/config.html { 'key' => 'editreferrals', 'section' => 'UI', - 'description' => 'Enable referral modification for existing customers', + 'description' => 'Enable advertising source modification for existing customers', 'type' => 'checkbox', }, @@ -404,28 +404,28 @@ httemplate/docs/config.html { 'key' => 'icradiusmachines', 'section' => 'deprecated', - 'description' => 'DEPRECATED, add a sqlradius export instead. This option used to enable radcheck and radreply table population - by default in the Freeside database, or in the database specified by the icradius_secrets config option (the radcheck and radreply tables needs to be created manually). You do not need to use MySQL for your Freeside database to export to an ICRADIUS/FreeRADIUS MySQL database with this option.
ADDITIONAL DEPRECATED FUNCTIONALITY (instead use MySQL replication or point icradius_secrets to the external database) - your ICRADIUS machines or FreeRADIUS (with MySQL authentication) machines, one per line. Machines listed in this file will have the radcheck table exported to them. Each line should contain four items, separted by whitespace: machine name, MySQL database name, MySQL username, and MySQL password. For example: "radius.isp.tld radius_db radius_user passw0rd"
', + 'description' => 'DEPRECATED, add an sqlradius export instead. This option used to enable radcheck and radreply table population - by default in the Freeside database, or in the database specified by the icradius_secrets config option (the radcheck and radreply tables needs to be created manually). You do not need to use MySQL for your Freeside database to export to an ICRADIUS/FreeRADIUS MySQL database with this option.
ADDITIONAL DEPRECATED FUNCTIONALITY (instead use MySQL replication or point icradius_secrets to the external database) - your ICRADIUS machines or FreeRADIUS (with MySQL authentication) machines, one per line. Machines listed in this file will have the radcheck table exported to them. Each line should contain four items, separted by whitespace: machine name, MySQL database name, MySQL username, and MySQL password. For example: "radius.isp.tld radius_db radius_user passw0rd"
', 'type' => [qw( checkbox textarea )], }, { 'key' => 'icradius_mysqldest', 'section' => 'deprecated', - 'description' => 'DEPRECATED (instead use MySQL replication or point icradius_secrets to the external database) - Destination directory for the MySQL databases, on the ICRADIUS/FreeRADIUS machines. Defaults to "/usr/local/var/".', + 'description' => 'DEPRECATED, add an sqlradius https://billing.crosswind.net/freeside/browse/part_export.cgi">export instead. Used to be the destination directory for the MySQL databases, on the ICRADIUS/FreeRADIUS machines. Defaults to "/usr/local/var/".', 'type' => 'text', }, { 'key' => 'icradius_mysqlsource', 'section' => 'deprecated', - 'description' => 'DEPRECATED (instead use MySQL replication or point icradius_secrets to the external database) - Source directory for for the MySQL radcheck table files, on the Freeside machine. Defaults to "/usr/local/var/freeside".', + 'description' => 'DEPRECATED, add an sqlradius https://billing.crosswind.net/freeside/browse/part_export.cgi">export instead. Used to be the source directory for for the MySQL radcheck table files, on the Freeside machine. Defaults to "/usr/local/var/freeside".', 'type' => 'text', }, { 'key' => 'icradius_secrets', 'section' => 'deprecated', - 'description' => 'DEPRECATED, add sqlradius exports to Service definitions instead. This option used to specify a database for ICRADIUS/FreeRADIUS export. Three lines: DBI data source, username and password.', + 'description' => 'DEPRECATED, add an sqlradius https://billing.crosswind.net/freeside/browse/part_export.cgi">export instead. This option used to specify a database for ICRADIUS/FreeRADIUS export. Three lines: DBI data source, username and password.', 'type' => 'textarea', }, @@ -534,8 +534,8 @@ httemplate/docs/config.html { 'key' => 'radiusmachines', - 'section' => 'radius', - 'description' => 'Your RADIUS authentication machines, one per line. This enables export of `/etc/raddb/users\'.', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, add an sqlradius export instead. This option used to export to be: your RADIUS authentication machines, one per line. This enables export of `/etc/raddb/users\'.', 'type' => 'textarea', }, @@ -717,15 +717,15 @@ httemplate/docs/config.html { 'key' => 'radiusprepend', - 'section' => 'radius', - 'description' => 'The contents will be prepended to the top of the RADIUS users file (text exports only).', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, real-time text radius now edits an existing file in place - just (turn off freeside-queued and) edit your RADIUS users file directly. The contents used to be be prepended to the top of the RADIUS users file (text exports only).', 'type' => 'textarea', }, { 'key' => 'textradiusprepend', 'section' => 'deprecated', - 'description' => 'DEPRECATED, use RADIUS check attributes instead. This option will be removed soon. The contents will be prepended to the first line of a user\'s RADIUS entry in text exports.', + 'description' => 'DEPRECATED, use RADIUS check attributes instead. The contents used to be prepended to the first line of a user\'s RADIUS entry in text exports.', 'type' => 'text', }, -- cgit v1.2.1 From 2c9b97801b3981efaf6c65118e3cc1a0368e649c Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 3 Jul 2002 03:47:40 +0000 Subject: one-time charges with tax classes --- FS/FS/cust_main.pm | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 9ed3f2cab..6edb6ae8f 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1734,7 +1734,7 @@ sub credit { $cust_credit->insert; } -=item charge AMOUNT PKG COMMENT +=item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ] Creates a one-time charge for this customer. If there is an error, returns the error, otherwise returns false. @@ -1742,7 +1742,10 @@ the error, otherwise returns false. =cut sub charge { - my ( $self, $amount, $pkg, $comment ) = @_; + my ( $self, $amount ) = @_; + my $pkg = @_ ? shift : 'One-time charge'; + my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount); + my $taxclass = @_ ? shift : ''; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -1756,12 +1759,13 @@ sub charge { my $dbh = dbh; my $part_pkg = new FS::part_pkg ( { - 'pkg' => $pkg || 'One-time charge', - 'comment' => $comment || '$'. sprintf("%.2f",$amount), + 'pkg' => $pkg, + 'comment' => $comment, 'setup' => $amount, 'freq' => 0, 'recur' => '0', 'disabled' => 'Y', + 'taxclass' => $taxclass, } ); my $error = $part_pkg->insert; -- cgit v1.2.1 From e48985560b4c23e511658f2d638b762c061beee1 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 3 Jul 2002 03:57:08 +0000 Subject: working one-time charges again --- FS/FS/cust_main.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 6edb6ae8f..02e906aed 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1742,7 +1742,7 @@ the error, otherwise returns false. =cut sub charge { - my ( $self, $amount ) = @_; + my ( $self, $amount ) = ( shift, shift ); my $pkg = @_ ? shift : 'One-time charge'; my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount); my $taxclass = @_ ? shift : ''; -- cgit v1.2.1 From 0da4c69a66e13410b0eff18966e13170d1306f22 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 3 Jul 2002 10:33:37 +0000 Subject: preload all dbdefs --- FS/FS/InitHandler.pm | 75 ++++++++++++++++++++++++++++++++++++++++++++++++++++ FS/MANIFEST | 2 ++ FS/t/InitHandler.t | 5 ++++ 3 files changed, 82 insertions(+) create mode 100644 FS/FS/InitHandler.pm create mode 100644 FS/t/InitHandler.t (limited to 'FS') diff --git a/FS/FS/InitHandler.pm b/FS/FS/InitHandler.pm new file mode 100644 index 000000000..9a2154aa1 --- /dev/null +++ b/FS/FS/InitHandler.pm @@ -0,0 +1,75 @@ +package FS::InitHandler; + +use strict; +use FS::UID qw(adminsuidsetup); +use FS::Record; + +sub handler { + +=pod + + use Date::Format; + use Date::Parse; + use Tie::IxHash; + use HTML::Entities; + use IO::Handle; + use IO::File; + use String::Approx: + use HTML::Widgets::SelectLayers 0.02; + #use FS::UID; + #use FS::Record; + use FS::Conf; + use FS::CGI; + use FS::Msgcat; + + use FS::agent; + use FS::agent_type; + use FS::domain_record; + use FS::cust_bill; + use FS::cust_bill_pay; + use FS::cust_credit; + use FS::cust_credit_bill; + use FS::cust_main; + use FS::cust_main_county; + use FS::cust_pay; + use FS::cust_pkg; + use FS::cust_refund; + use FS::cust_svc; + use FS::nas; + use FS::part_bill_event; + use FS::part_pkg; + use FS::part_referral; + use FS::part_svc; + use FS::pkg_svc; + use FS::port; + use FS::queue qw(joblisting); + use FS::raddb; + use FS::session; + use FS::svc_acct; + use FS::svc_acct_pop qw(popselector); + use FS::svc_acct_sm; + use FS::svc_domain; + use FS::svc_forward; + use FS::svc_www; + use FS::type_pkgs; + use FS::part_export; + use FS::part_export_option; + use FS::export_svc; + use FS::msgcat; + +=cut + + open(MAPSECRETS,"<$FS::UID::conf_dir/mapsecrets") + or die "can't read $FS::UID::conf_dir/mapsecrets: $!"; + + while () { + /^([\w\-\.]+)\s/ or do { warn "strange line in mapsecrets: $_"; next; }; + my $user = $1; + adminsuidsetup($user); + } + + close MAPSECRETS; + +} + +1; diff --git a/FS/MANIFEST b/FS/MANIFEST index d9860b15f..da04b1d5c 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -19,6 +19,7 @@ bin/freeside-expiration-alerter bin/freeside-reexport FS.pm FS/CGI.pm +FS/InitHandler.pm FS/Conf.pm FS/ConfItem.pm FS/Record.pm @@ -94,6 +95,7 @@ FS/cust_tax_exempt.pm t/agent.t t/agent_type.t t/CGI.t +t/InitHandler.t t/Conf.t t/ConfItem.t t/Record.t diff --git a/FS/t/InitHandler.t b/FS/t/InitHandler.t new file mode 100644 index 000000000..0ce60c833 --- /dev/null +++ b/FS/t/InitHandler.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::InitHandler; +$loaded=1; +print "ok 1\n"; -- cgit v1.2.1 From e9af247503b619f0c61a3ba14481bc76752bdd8b Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 3 Jul 2002 10:48:05 +0000 Subject: debug --- FS/FS/InitHandler.pm | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/InitHandler.pm b/FS/FS/InitHandler.pm index 9a2154aa1..73697300e 100644 --- a/FS/FS/InitHandler.pm +++ b/FS/FS/InitHandler.pm @@ -1,9 +1,12 @@ package FS::InitHandler; use strict; +use vars qw($DEBUG); use FS::UID qw(adminsuidsetup); use FS::Record; +$DEBUG = 1; + sub handler { =pod @@ -59,12 +62,18 @@ sub handler { =cut + warn "[FS::InitHandler] handler called\n" if $DEBUG; + open(MAPSECRETS,"<$FS::UID::conf_dir/mapsecrets") or die "can't read $FS::UID::conf_dir/mapsecrets: $!"; + my %seen; while () { - /^([\w\-\.]+)\s/ or do { warn "strange line in mapsecrets: $_"; next; }; - my $user = $1; + /^([\w\-\.]+)\s(.*)$/ + or do { warn "strange line in mapsecrets: $_"; next; }; + my($user, $datasrc) = ($1, $2); + next if $seen{$datasrc}++; + warn "[FS::InitHandler] preloading $datasrc for $user\n" if $DEBUG; adminsuidsetup($user); } -- cgit v1.2.1 From ab33e906a196646c5351c21848b5d6f63b4400dd Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 3 Jul 2002 10:50:11 +0000 Subject: skip comment & blank lines --- FS/FS/InitHandler.pm | 1 + 1 file changed, 1 insertion(+) (limited to 'FS') diff --git a/FS/FS/InitHandler.pm b/FS/FS/InitHandler.pm index 73697300e..b1b9eaf03 100644 --- a/FS/FS/InitHandler.pm +++ b/FS/FS/InitHandler.pm @@ -69,6 +69,7 @@ sub handler { my %seen; while () { + next if /^\s*(#|$)/; /^([\w\-\.]+)\s(.*)$/ or do { warn "strange line in mapsecrets: $_"; next; }; my($user, $datasrc) = ($1, $2); -- cgit v1.2.1 From 98567e531e90ee1c7c195d5f1e708898d47a8452 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 3 Jul 2002 11:10:12 +0000 Subject: allow InitHandler to work during apache startup --- FS/FS/UID.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm index b1e590f2f..15f15a171 100644 --- a/FS/FS/UID.pm +++ b/FS/FS/UID.pm @@ -83,7 +83,7 @@ sub forksuidsetup { $ENV{'ENV'} = ''; $ENV{'BASH_ENV'} = ''; - croak "Not running uid freeside!" unless checkeuid(); + croak "Not running uid freeside!" unless checkeuid() || !$>; getsecrets; $dbh = DBI->connect($datasrc,$db_user,$db_pass, { 'AutoCommit' => 0, @@ -256,7 +256,7 @@ coderef into the hash %FS::UID::callback : =head1 VERSION -$Id: UID.pm,v 1.16 2002-06-28 08:23:44 ivan Exp $ +$Id: UID.pm,v 1.17 2002-07-03 11:10:12 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 5786c8244a188823b01b87e2d7e9fd6bc72644b3 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 3 Jul 2002 11:23:25 +0000 Subject: fix to allow running during apache init --- FS/FS/InitHandler.pm | 7 +++++++ FS/FS/UID.pm | 4 ++-- 2 files changed, 9 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/InitHandler.pm b/FS/FS/InitHandler.pm index b1b9eaf03..31aacc731 100644 --- a/FS/FS/InitHandler.pm +++ b/FS/FS/InitHandler.pm @@ -64,6 +64,9 @@ sub handler { warn "[FS::InitHandler] handler called\n" if $DEBUG; + #this is sure to be broken on freebsd + $> = $FS::UID::freeside_uid; + open(MAPSECRETS,"<$FS::UID::conf_dir/mapsecrets") or die "can't read $FS::UID::conf_dir/mapsecrets: $!"; @@ -80,6 +83,10 @@ sub handler { close MAPSECRETS; + #lalala probably broken on freebsd + ($<, $>) = ($>, $<); + $< = 0; + } 1; diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm index 15f15a171..0b10612c5 100644 --- a/FS/FS/UID.pm +++ b/FS/FS/UID.pm @@ -83,7 +83,7 @@ sub forksuidsetup { $ENV{'ENV'} = ''; $ENV{'BASH_ENV'} = ''; - croak "Not running uid freeside!" unless checkeuid() || !$>; + croak "Not running uid freeside!" unless checkeuid(); getsecrets; $dbh = DBI->connect($datasrc,$db_user,$db_pass, { 'AutoCommit' => 0, @@ -256,7 +256,7 @@ coderef into the hash %FS::UID::callback : =head1 VERSION -$Id: UID.pm,v 1.17 2002-07-03 11:10:12 ivan Exp $ +$Id: UID.pm,v 1.18 2002-07-03 11:23:25 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 62ab6a5c3fbececbc753691fa2288cfeb8531602 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 3 Jul 2002 11:31:28 +0000 Subject: preload modules --- FS/FS/InitHandler.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/InitHandler.pm b/FS/FS/InitHandler.pm index 31aacc731..45bf1acfa 100644 --- a/FS/FS/InitHandler.pm +++ b/FS/FS/InitHandler.pm @@ -9,7 +9,7 @@ $DEBUG = 1; sub handler { -=pod +#=pod use Date::Format; use Date::Parse; -- cgit v1.2.1 From 5a4e653a8a08c5ddbc6e5ab984ff5a1a6e897cc9 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 3 Jul 2002 11:35:21 +0000 Subject: sacrifice memory for speed --- FS/FS/InitHandler.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/InitHandler.pm b/FS/FS/InitHandler.pm index 45bf1acfa..e8177f8d7 100644 --- a/FS/FS/InitHandler.pm +++ b/FS/FS/InitHandler.pm @@ -17,7 +17,7 @@ sub handler { use HTML::Entities; use IO::Handle; use IO::File; - use String::Approx: + use String::Approx; use HTML::Widgets::SelectLayers 0.02; #use FS::UID; #use FS::Record; -- cgit v1.2.1 From 65b084de4b964abf527f08b6b8359f68ae592679 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 3 Jul 2002 11:37:45 +0000 Subject: 54 --- FS/FS/InitHandler.pm | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) (limited to 'FS') diff --git a/FS/FS/InitHandler.pm b/FS/FS/InitHandler.pm index e8177f8d7..87f507c22 100644 --- a/FS/FS/InitHandler.pm +++ b/FS/FS/InitHandler.pm @@ -9,8 +9,6 @@ $DEBUG = 1; sub handler { -#=pod - use Date::Format; use Date::Parse; use Tie::IxHash; @@ -45,11 +43,11 @@ sub handler { use FS::part_svc; use FS::pkg_svc; use FS::port; - use FS::queue qw(joblisting); + use FS::queue; use FS::raddb; use FS::session; use FS::svc_acct; - use FS::svc_acct_pop qw(popselector); + use FS::svc_acct_pop; use FS::svc_acct_sm; use FS::svc_domain; use FS::svc_forward; @@ -60,8 +58,6 @@ sub handler { use FS::export_svc; use FS::msgcat; -=cut - warn "[FS::InitHandler] handler called\n" if $DEBUG; #this is sure to be broken on freebsd -- cgit v1.2.1 From 8bc1ee56aea60731d98efd0e2399b202e9969187 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 3 Jul 2002 14:21:56 +0000 Subject: http export --- FS/FS/part_export.pm | 37 ++++++++++++++++++++ FS/FS/part_export/http.pm | 88 +++++++++++++++++++++++++++++++++++++++++++++++ FS/MANIFEST | 2 ++ FS/t/part_export-http.t | 5 +++ 4 files changed, 132 insertions(+) create mode 100644 FS/FS/part_export/http.pm create mode 100644 FS/t/part_export-http.t (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index d15a87986..15b207e03 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -636,6 +636,37 @@ tie my %bind_slave_options, 'Tie::IxHash', default => '/etc/bind/named.conf' }, ; +tie my %http_options, 'Tie::IxHash', + 'method' => { label =>'Method', + type =>'select', + #options =>[qw(POST GET)], + options =>[qw(POST)], + default =>'POST' }, + 'url' => { label => 'URL', default => 'http://', }, + 'insert_data' => { + label => 'Insert data', + type => 'textarea', + default => join("\n", + 'DomainName $svc_x->domain', + 'Email ( grep { $_ ne "POST" } $svc_x->cust_svc->cust_pkg->cust_main->invoicing_list)[0]', + 'test 1', + 'reseller $svc_x->cust_svc->cust_pkg->part_pkg->pkg =~ /reseller/i', + ), + }, + 'delete_data' => { + label => 'Delete data', + type => 'textarea', + default => join("\n", + ), + }, + 'replace_data' => { + label => 'Replace data', + type => 'textarea', + default => join("\n", + ), + }, +; + tie my %sqlmail_options, 'Tie::IxHash', 'datasrc' => { label=>'DBI data source' }, 'username' => { label=>'Database username' }, @@ -740,6 +771,12 @@ tie my %sqlmail_options, 'Tie::IxHash', 'notes' => 'Batch export of BIND configuration file to a secondary nameserver. Zones are slaved from the listed masters. File::Rsync must be installed. Run bin/bind.export to export the files.', }, + 'http' => { + 'desc' => 'Send an HTTP or HTTPS GET or POST request', + 'options' => \%http_options, + 'notes' => 'Send an HTTP or HTTPS GET or POST to the specified URL. libwww-perl must be installed. For HTTPS support, Crypt::SSLeay or IO::Socket::SSL is required.', + }, + 'sqlmail' => { 'desc' => 'Real-time export to SQL-backed mail server', 'options' => \%sqlmail_options, diff --git a/FS/FS/part_export/http.pm b/FS/FS/part_export/http.pm new file mode 100644 index 000000000..0e02f0f8e --- /dev/null +++ b/FS/FS/part_export/http.pm @@ -0,0 +1,88 @@ +package FS::part_export::http; + +use vars qw(@ISA); +use FS::part_export; + +@ISA = qw(FS::part_export); + +sub rebless { shift; } + +sub _export_insert { + my $self = shift; + $self->_export_command('insert', @_); +} + +sub _export_delete { + my $self = shift; + $self->_export_command('delete', @_); +} + +sub _export_command { + my( $self, $action, $svc_x ) = ( shift, shift, shift ); + + return unless $self->option("${action}_data"); + + $self->http_queue( $svc_x->svcnum, + $self->option('method'), + $self->option('url'), + map { + /^\s*(\S+)\s+(.*)$/ or /()()/; + my( $field, $value_expression ) = ( $1, $2 ); + my $value = eval $value_expression; + die $@ if $@; + ( $field, $value ); + } split(/\n/, $self->option("${action}_data") ) + ); + +} + +sub _export_replace { + my( $self, $new, $old ) = ( shift, shift, shift ); + + return unless $self->option('replace_data'); + + $self->http_queue( $svc_x->svcnum, + $self->option('method'), + $self->option('url'), + map { + /^\s*(\S+)\s+(.*)$/ or /()()/; + my( $field, $value_expression ) = ( $1, $2 ); + die $@ if $@; + ( $field, $value ); + } split(/\n/, $self->option('replace_data') ) + ); + +} + +sub http_queue { + my($self, $svcnum) = (shift, shift); + my $queue = new FS::queue { + 'svcnum' => $svcnum, + 'job' => "FS::part_export::http::http", + }; + $queue->insert( @_ ); +} + +sub http { + my($method, $url, @data) = @_; + + $method = lc($method); + + eval "use LWP::UserAgent;"; + die "using LWP::UserAgent: $@" if $@; + eval "use HTTP::Request::Common;"; + die "using HTTP::Request::Common: $@" if $@; + + my $ua = LWP::UserAgent->new; + + #my $response = $ua->$method( + # $url, \%data, + # 'Content-Type'=>'application/x-www-form-urlencoded' + #); + my $req = HTTP::Request::Common::POST( $url, \@data ); + my $response = $ua->request($req); + + die $response->error_as_HTML if $response->is_error; + +} + diff --git a/FS/MANIFEST b/FS/MANIFEST index da04b1d5c..a6a8d935e 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -56,6 +56,7 @@ FS/part_export/bind_slave.pm FS/part_export/bsdshell.pm FS/part_export/cp.pm FS/part_export/cyrus.pm +FS/part_export/http.pm FS/part_export/infostreet.pm FS/part_export/null.pm FS/part_export/shellcommands.pm @@ -127,6 +128,7 @@ t/part_export-bind_slave.t t/part_export-bsdshell.t t/part_export-cp.t t/part_export-cyrus.t +t/part_export-http.t t/part_export-infostreet.t t/part_export-null.t t/part_export-shellcommands.t diff --git a/FS/t/part_export-http.t b/FS/t/part_export-http.t new file mode 100644 index 000000000..ba7209d10 --- /dev/null +++ b/FS/t/part_export-http.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::http_post; +$loaded=1; +print "ok 1\n"; -- cgit v1.2.1 From 50c327ded5ad9b96c5f5975643d46511abc01d49 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 3 Jul 2002 14:45:59 +0000 Subject: s/_post// --- FS/t/part_export-http.t | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/t/part_export-http.t b/FS/t/part_export-http.t index ba7209d10..ea41b939f 100644 --- a/FS/t/part_export-http.t +++ b/FS/t/part_export-http.t @@ -1,5 +1,5 @@ BEGIN { $| = 1; print "1..1\n" } END {print "not ok 1\n" unless $loaded;} -use FS::part_export::http_post; +use FS::part_export::http; $loaded=1; print "ok 1\n"; -- cgit v1.2.1 From 1302ec4f2c77dbfd53d9e1c92decf40bfe9d2806 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 6 Jul 2002 04:20:22 +0000 Subject: typo --- FS/FS/svc_acct.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 2bbbdcbb7..84faac338 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -876,7 +876,7 @@ sub domain { =item svc_domain Returns the FS::svc_domain record for this account's domain (see -L. +L). =cut -- cgit v1.2.1 From 5c5006bb59066f59270cdb5b916c1f3d857e5782 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 6 Jul 2002 07:30:38 +0000 Subject: move svc_www ssh jobs to the job queue & exports, and make them configurable --- FS/FS/Conf.pm | 8 ++-- FS/FS/part_export.pm | 23 ++++++++--- FS/FS/part_export/www_shellcommands.pm | 68 +++++++++++++++++++++++++------ FS/FS/svc_www.pm | 74 ++++++++++++---------------------- 4 files changed, 102 insertions(+), 71 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 25c674301..e93eaf3fc 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -221,8 +221,8 @@ httemplate/docs/config.html { 'key' => 'apacheroot', - 'section' => 'apache', - 'description' => 'The directory containing Apache virtual hosts', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, add a www_shellcommands export instead. The directory containing Apache virtual hosts', 'type' => 'text', }, @@ -235,8 +235,8 @@ httemplate/docs/config.html { 'key' => 'apachemachine', - 'section' => 'apache', - 'description' => 'A machine with the apacheroot directory and user home directories. The existance of this file enables setup of virtual host directories, and, in conjunction with the `home\' configuration file, symlinks into user home directories.', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, add a www_shellcommands export instead. A machine with the apacheroot directory and user home directories. The existance of this file enables setup of virtual host directories, and, in conjunction with the `home\' configuration file, symlinks into user home directories.', 'type' => 'text', }, diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 15b207e03..3982168a5 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -531,7 +531,7 @@ tie my %shellcommands_options, 'Tie::IxHash', }, 'useradd_stdin' => { label=>'Insert command STDIN', type =>'textarea', - default=>"", + default=>'', }, 'userdel' => { label=>'Delete command', default=>'userdel $username', @@ -552,7 +552,7 @@ tie my %shellcommands_options, 'Tie::IxHash', }, 'usermod_stdin' => { label=>'Modify command STDIN', type =>'textarea', - default=>"", + default=>'', }, ; @@ -581,6 +581,19 @@ tie my %shellcommands_withdomain_options, 'Tie::IxHash', }, ; +tie my %www_shellcommands_options, 'Tie::IxHash', + 'user' => { lable=>'Remote username', default=>'root' }, + 'useradd' => { label=>'Insert command', + default=>'mkdir /var/www/$zone; chown $username /var/www/$zone; ln -s /var/www/$zone $homedir/$zone', + }, + 'userdel' => { label=>'Delete command', + default=>'[ -n "$zone" ] && rm -rf /var/www/$zone; rm $homedir/$zone', + }, + 'usermod' => { label=>'Modify command', + default=>'[ -n "$old_zone" ] && rm $old_homedir/$old_zone; [ "$old_zone" != "$new_zone" -a -n "$new_zone" ] && mv /var/www/$old_zone /var/www/$new_zone; [ "$old_username" != "$new_username" ] && chown -R $new_username /var/www/$new_zone; ln -s /var/www/$new_zone $new_homedir/$new_zone', + }, +; + tie my %textradius_options, 'Tie::IxHash', 'user' => { label=>'Remote username', default=>'root' }, 'users' => { label=>'users file location', default=>'/etc/raddb/users' }, @@ -800,9 +813,9 @@ tie my %sqlmail_options, 'Tie::IxHash', 'svc_www' => { 'www_shellcommands' => { - 'desc' => 'www_shellcommands', - 'options' => {}, # \%www_shellcommands_options, - 'notes' => 'unfinished...', + 'desc' => 'Run remote commands via SSH, for virtual web sites.', + 'options' => \%www_shellcommands_options, + 'notes' => 'Run remote commands via SSH, for virtual web sites. You will need to setup SSH for unattended operation.', }, }, diff --git a/FS/FS/part_export/www_shellcommands.pm b/FS/FS/part_export/www_shellcommands.pm index e95939b8c..84c162761 100644 --- a/FS/FS/part_export/www_shellcommands.pm +++ b/FS/FS/part_export/www_shellcommands.pm @@ -1,5 +1,6 @@ -package FS::part_export::shellcommands; +package FS::part_export::www_shellcommands; +use strict; use vars qw(@ISA); use FS::part_export; @@ -18,31 +19,72 @@ sub _export_delete { } sub _export_command { - my ( $self, $action, $svc_acct) = (shift, shift, shift); + my ( $self, $action, $svc_www) = (shift, shift, shift); my $command = $self->option($action); - my $stdin = $self->option($action."_stdin"); - no strict 'refs'; - ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields; - $self->shellcommands_queue( $svc_acct->svcnum, + + #set variable for the command + { + no strict 'refs'; + ${$_} = $svc_www->getfield($_) foreach $svc_www->fields; + } + my $domain_record = $svc_www->domain_record; # or die ? + my $zone = $domain_record->reczone; # or die ? + unless ( $zone =~ /\.$/ ) { + my $svc_domain = $domain_record->svc_domain; # or die ? + $zone .= '.'. $svc_domain->domain; + } + + my $svc_acct = $svc_www->svc_acct; # or die ? + my $username = $svc_acct->username; + my $homedir = $svc_acct->dir; # or die ? + + #done setting variables for the command + + $self->shellcommands_queue( $svc_www->svcnum, user => $self->option('user')||'root', host => $self->machine, command => eval(qq("$command")), - stdin_string => eval(qq("$stdin")), ); } sub _export_replace { my($self, $new, $old ) = (shift, shift, shift); my $command = $self->option('usermod'); - my $stdin = $self->option('usermod_stdin'); - no strict 'refs'; - ${"old_$_"} = $old->getfield($_) foreach $old->fields; - ${"new_$_"} = $new->getfield($_) foreach $new->fields; + + #set variable for the command + { + no strict 'refs'; + ${"old_$_"} = $old->getfield($_) foreach $old->fields; + ${"new_$_"} = $new->getfield($_) foreach $new->fields; + } + my $old_domain_record = $old->domain_record; # or die ? + my $old_zone = $old_domain_record->reczone; # or die ? + unless ( $old_zone =~ /\.$/ ) { + my $old_svc_domain = $old_domain_record->svc_domain; # or die ? + $old_zone .= '.'. $old_svc_domain->domain; + } + + my $old_svc_acct = $old->svc_acct; # or die ? + my $old_username = $old_svc_acct->username; + my $old_homedir = $old_svc_acct->dir; # or die ? + + my $new_domain_record = $new->domain_record; # or die ? + my $new_zone = $new_domain_record->reczone; # or die ? + unless ( $new_zone =~ /\.$/ ) { + my $new_svc_domain = $new_domain_record->svc_domain; # or die ? + $new_zone .= '.'. $new_svc_domain->domain; + } + + my $new_svc_acct = $new->svc_acct; # or die ? + my $new_username = $new_svc_acct->username; + my $new_homedir = $new_svc_acct->dir; # or die ? + + #done setting variables for the command + $self->shellcommands_queue( $new->svcnum, user => $self->option('user')||'root', host => $self->machine, command => eval(qq("$command")), - stdin_string => eval(qq("$stdin")), ); } @@ -51,7 +93,7 @@ sub shellcommands_queue { my( $self, $svcnum ) = (shift, shift); my $queue = new FS::queue { 'svcnum' => $svcnum, - 'job' => "FS::part_export::shellcommands::ssh_cmd", + 'job' => "FS::part_export::www_shellcommands::ssh_cmd", }; $queue->insert( @_ ); } diff --git a/FS/FS/svc_www.pm b/FS/FS/svc_www.pm index 6415a3012..d7a42c8ae 100644 --- a/FS/FS/svc_www.pm +++ b/FS/FS/svc_www.pm @@ -1,7 +1,7 @@ package FS::svc_www; use strict; -use vars qw(@ISA $conf $apacheroot $apachemachine $apacheip $nossh_hack ); +use vars qw(@ISA $conf $apacheip); #use FS::Record qw( qsearch qsearchs ); use FS::Record qw( qsearchs dbh ); use FS::svc_Common; @@ -9,15 +9,12 @@ use FS::cust_svc; use FS::domain_record; use FS::svc_acct; use FS::svc_domain; -use Net::SSH qw(ssh); @ISA = qw( FS::svc_Common ); #ask FS::UID to run this stuff for us later $FS::UID::callback{'FS::svc_www'} = sub { $conf = new FS::Conf; - $apacheroot = $conf->config('apacheroot'); - $apachemachine = $conf->config('apachemachine'); $apacheip = $conf->config('apacheip'); }; @@ -85,20 +82,6 @@ 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) I, and -I exist, the command: - - mkdir $apacheroot/$zone; - chown $username $apacheroot/$zone; - ln -s $apacheroot/$zone $homedir/$zone - -I<$zone> is the DNS A record pointed to by I -I<$username> is the username pointed to by I -I<$homedir> is that user's home directory - -is executed on I via ssh. This behaviour can be surpressed by -setting $FS::svc_www::nossh_hack true. - =cut sub insert { @@ -147,37 +130,6 @@ sub insert { return $error; } - my $domain_record = qsearchs('domain_record', { 'recnum' => $self->recnum } ); # or die ? - my $zone = $domain_record->reczone; - # or die ? - unless ( $zone =~ /\.$/ ) { - my $dom_svcnum = $domain_record->svcnum; - my $svc_domain = qsearchs('svc_domain', { 'svcnum' => $dom_svcnum } ); - # or die ? - $zone .= '.'. $svc_domain->domain; - } - - my $svc_acct = qsearchs('svc_acct', { 'svcnum' => $self->usersvc } ); - # or die ? - my $username = $svc_acct->username; - # or die ? - my $homedir = $svc_acct->dir; - # or die ? - - if ( $apachemachine - && $apacheroot - && $zone - && $username - && $homedir - && ! $nossh_hack - ) { - ssh("root\@$apachemachine", - "mkdir $apacheroot/$zone; ". - "chown $username $apacheroot/$zone; ". - "ln -s $apacheroot/$zone $homedir/$zone" - ); - } - $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } @@ -285,6 +237,30 @@ sub check { ''; #no error } +=item domain_record + +Returns the FS::domain_record record for this web virtual host's zone (see +L). + +=cut + +sub domain_record { + my $self = shift; + qsearchs('domain_record', { 'recnum' => $self->recnum } ); +} + +=item svc_acct + +Returns the FS::svc_acct record for this web virtual host's owner (see +L). + +=cut + +sub svc_acct { + my $self = shift; + qsearchs('svc_acct', { 'svcnum' => $self->usersvc } ); +} + =back =head1 BUGS -- cgit v1.2.1 From 0d14601b500fee8a808f1fff59e622a332b0e5a1 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 7 Jul 2002 17:49:47 +0000 Subject: rewrite uid-dup checking to be new-export-aware, closes: #431 --- FS/FS/svc_acct.pm | 44 ++++++++++++++++++++++++++------------------ 1 file changed, 26 insertions(+), 18 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 84faac338..bd01adfdc 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -226,20 +226,27 @@ sub insert { #new duplicate username checking + my $part_svc = qsearchs('part_svc', { 'svcpart' => $self->svcpart } ); + unless ( $part_svc ) { + $dbh->rollback if $oldAutoCommit; + return 'unknown svcpart '. $self->svcpart; + } + my @dup_user = qsearch( 'svc_acct', { 'username' => $self->username } ); my @dup_userdomain = qsearchs( 'svc_acct', { 'username' => $self->username, 'domsvc' => $self->domsvc } ); + my @dup_uid; + if ( $part_svc->part_svc_column('uid')->columnflag ne 'F' + && $self->username !~ /^(toor|(hyla)?fax)$/ ) { + @dup_uid = qsearch( 'svc_acct', { 'uid' => $self->uid } ); + } else { + @dup_uid = (); + } - if ( @dup_user || @dup_userdomain ) { + if ( @dup_user || @dup_userdomain || @dup_uid ) { my $exports = FS::part_export::export_info('svc_acct'); my( %conflict_user_svcpart, %conflict_userdomain_svcpart ); - my $part_svc = qsearchs('part_svc', { 'svcpart' => $self->svcpart } ); - unless ( $part_svc ) { - $dbh->rollback if $oldAutoCommit; - return 'unknown svcpart '. $self->svcpart; - } - foreach my $part_export ( $part_svc->part_export ) { #this will catch to the same exact export @@ -276,10 +283,20 @@ sub insert { foreach my $dup_userdomain ( @dup_userdomain ) { my $dup_svcpart = $dup_userdomain->cust_svc->svcpart; - if ( exists($conflict_user_svcpart{$dup_svcpart}) ) { + if ( exists($conflict_userdomain_svcpart{$dup_svcpart}) ) { return "duplicate username\@domain: conflicts with svcnum ". $dup_userdomain->svcnum. " via exportnum ". - $conflict_user_svcpart{$dup_svcpart}; + $conflict_userdomain_svcpart{$dup_svcpart}; + } + } + + foreach my $dup_uid ( @dup_uid ) { + my $dup_svcpart = $dup_uid->cust_svc->svcpart; + if ( exists($conflict_user_svcpart{$dup_svcpart}) + || exists($conflict_userdomain_svcpart{$dup_svcpart}) ) { + return "duplicate uid: conflicts with svcnum". $dup_uid->svcnum. + "via exportnum ". $conflict_user_svcpart{$dup_svcpart} + || $conflict_userdomain_svcpart{$dup_svcpart}; } } @@ -287,15 +304,6 @@ sub insert { #see? i told you it was more complicated - my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); - return "Unknown svcpart" unless $part_svc; - return "uid ". $self->uid. " in use" - if $part_svc->part_svc_column('uid')->columnflag ne 'F' - && qsearchs( 'svc_acct', { 'uid' => $self->uid } ) - && $self->username !~ /^(hyla)?fax$/ - && $self->username !~ /^toor$/ #FreeBSD - ; - my @jobnums; $error = $self->SUPER::insert(\@jobnums); if ( $error ) { -- cgit v1.2.1 From 98d6bdc2b96ad27bc1bfa30721715e3f33f5c717 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 8 Jul 2002 10:01:03 +0000 Subject: default linux/netbsd shellcommand userdel should remove home directories --- FS/FS/part_export.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 3982168a5..0597cddf2 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -534,7 +534,7 @@ tie my %shellcommands_options, 'Tie::IxHash', default=>'', }, 'userdel' => { label=>'Delete command', - default=>'userdel $username', + default=>'userdel -r $username', #default=>'rm -rf $dir', }, 'userdel_stdin' => { label=>'Delete command STDIN', @@ -719,7 +719,7 @@ tie my %sqlmail_options, 'Tie::IxHash', 'desc' => 'Real-time export via remote SSH (i.e. useradd, userdel, etc.)', 'options' => \%shellcommands_options, 'nodomain' => 'Y', - 'notes' => 'Run remote commands via SSH. Usernames are considered unique (also see shellcommands_withdomain). You probably want this if the commands you are running will not accept a domain as a parameter. You will need to setup SSH for unattended operation.

Use these buttons for some useful presets:
', + 'notes' => 'Run remote commands via SSH. Usernames are considered unique (also see shellcommands_withdomain). You probably want this if the commands you are running will not accept a domain as a parameter. You will need to setup SSH for unattended operation.

Use these buttons for some useful presets:
', }, 'shellcommands_withdomain' => { -- cgit v1.2.1 From fc99564551bfb9c5dbb1f6e6f8e751d6124e001a Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 8 Jul 2002 17:14:23 +0000 Subject: oops, fix for bug only surfacing with different freeside uid/gid --- FS/bin/freeside-queued | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-queued b/FS/bin/freeside-queued index 20a6ff9fb..83074b9e4 100644 --- a/FS/bin/freeside-queued +++ b/FS/bin/freeside-queued @@ -41,8 +41,8 @@ my $freeside_gid = scalar(getgrnam('freeside')) $) = $freeside_gid; $( = $freeside_gid; #if freebsd can't setuid(), presumably it can't setgid() either. grr fleabsd -($<,$>) = ($>,$<); -$> = $freeside_gid; +($(,$)) = ($),$(); +$) = $freeside_gid; $> = $FS::UID::freeside_uid; $< = $FS::UID::freeside_uid; -- cgit v1.2.1 From 46b6aae489f468a46be6c66f8ae6da48b41fe70c Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 16 Jul 2002 03:47:34 +0000 Subject: fix XML-RPC weirdness --- FS/FS/part_export/infostreet.pm | 19 +++++++++++++++++-- 1 file changed, 17 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export/infostreet.pm b/FS/FS/part_export/infostreet.pm index 2464e5dee..fbf58bd60 100644 --- a/FS/FS/part_export/infostreet.pm +++ b/FS/FS/part_export/infostreet.pm @@ -145,7 +145,7 @@ sub infostreet_setContact { 'getAccountID', $username); foreach my $field ( keys %contact_info ) { infostreet_command($url, $is_username, $is_password, $groupID, - 'setContactField', $accountID, $field, $contact_info{$field} ); + 'setContactField', [ 'int'=>$accountID ], $field, $contact_info{$field} ); } } @@ -165,6 +165,13 @@ sub infostreet_command { #subroutine, not method eval "use Frontier::Client;"; + eval 'sub Frontier::RPC2::String::repr { + my $self = shift + my $value = $$self; + $value =~ s/([&<>\"])/$Frontier::RPC2::char_entities{$1}/ge; + $value; + }'; + my $conn = Frontier::Client->new( url => $url ); my $key_result = $conn->call( 'authenticate', $username, $password, $groupID); my %key_result = _infostreet_parse($key_result); @@ -172,7 +179,15 @@ sub infostreet_command { #subroutine, not method my $key = $key_result{data}; #my $result = $conn->call($method, $key, @args); - my $result = $conn->call($method, $key, map { $conn->string($_) } @args); + my $result = $conn->call( $method, $key, + map { + if ( ref($_) ) { + my( $type, $value) = @{$_}; + $conn->$type($value); + } else { + $conn->string($_); + } + } @args ); my %result = _infostreet_parse($result); die $result{error} unless $result{success}; -- cgit v1.2.1 From 0d0bee036173beccb207f11712830f083b4eb2bc Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 16 Jul 2002 03:56:16 +0000 Subject: better error handling --- FS/FS/part_export/infostreet.pm | 2 ++ 1 file changed, 2 insertions(+) (limited to 'FS') diff --git a/FS/FS/part_export/infostreet.pm b/FS/FS/part_export/infostreet.pm index fbf58bd60..0f478d254 100644 --- a/FS/FS/part_export/infostreet.pm +++ b/FS/FS/part_export/infostreet.pm @@ -164,6 +164,7 @@ sub infostreet_command { #subroutine, not method } eval "use Frontier::Client;"; + die $@ if $@; eval 'sub Frontier::RPC2::String::repr { my $self = shift @@ -171,6 +172,7 @@ sub infostreet_command { #subroutine, not method $value =~ s/([&<>\"])/$Frontier::RPC2::char_entities{$1}/ge; $value; }'; + die $@ if $@; my $conn = Frontier::Client->new( url => $url ); my $key_result = $conn->call( 'authenticate', $username, $password, $groupID); -- cgit v1.2.1 From 2db0b73231b1cc8b9203d8c482ea9da2973f2768 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 16 Jul 2002 03:57:57 +0000 Subject: missing ; in eval'ed sub --- FS/FS/part_export/infostreet.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export/infostreet.pm b/FS/FS/part_export/infostreet.pm index 0f478d254..f2d519932 100644 --- a/FS/FS/part_export/infostreet.pm +++ b/FS/FS/part_export/infostreet.pm @@ -167,7 +167,7 @@ sub infostreet_command { #subroutine, not method die $@ if $@; eval 'sub Frontier::RPC2::String::repr { - my $self = shift + my $self = shift; my $value = $$self; $value =~ s/([&<>\"])/$Frontier::RPC2::char_entities{$1}/ge; $value; -- cgit v1.2.1 From f22694a83b1acce62cdc10cf91884274af0e40a2 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 16 Jul 2002 12:29:05 +0000 Subject: ClientAPI --- FS/FS/ClientAPI.pm | 44 ++++++++++++++ FS/FS/ClientAPI/MyAccount.pm | 136 +++++++++++++++++++++++++++++++++++++++++++ FS/FS/ClientAPI/passwd.pm | 56 ++++++++++++++++++ FS/MANIFEST | 4 ++ 4 files changed, 240 insertions(+) create mode 100644 FS/FS/ClientAPI.pm create mode 100644 FS/FS/ClientAPI/MyAccount.pm create mode 100644 FS/FS/ClientAPI/passwd.pm (limited to 'FS') diff --git a/FS/FS/ClientAPI.pm b/FS/FS/ClientAPI.pm new file mode 100644 index 000000000..f7b8eb028 --- /dev/null +++ b/FS/FS/ClientAPI.pm @@ -0,0 +1,44 @@ +package FS::ClientAPI; + +use strict; +use vars qw(%handler); + +%handler = (); + +#find modules +foreach my $INC ( @INC ) { + foreach my $file ( glob("$INC/FS/ClientAPI/*") ) { + $file =~ /\/(\w+)\.pm$/ or do { + warn "unrecognized ClientAPI file: $file"; + next + }; + my $mod = $1; + #warn "using FS::ClientAPI::$mod"; + eval "use FS::ClientAPI::$mod;"; + die "error using FS::ClientAPI::$mod: $@" if $@; + } +} + +#(sub for modules) +sub register_handlers { + my $self = shift; + my %new_handlers = @_; + foreach my $key ( keys %new_handlers ) { + warn "WARNING: redefining sub $key" if exists $handler{$key}; + #warn "registering $key"; + $handler{$key} = $new_handlers{$key}; + } +} + +#--- + +sub dispatch { + my ( $self, $name ) = ( shift, shift ); + my $sub = $handler{$name} + or die "unknown FS::ClientAPI sub $name (known: ". join(" ", keys %handler ); + #or die "unknown FS::ClientAPI sub $name"; + &{$sub}(@_); +} + +1; + diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm new file mode 100644 index 000000000..674785524 --- /dev/null +++ b/FS/FS/ClientAPI/MyAccount.pm @@ -0,0 +1,136 @@ +package FS::ClientAPI::MyAccount; + +use strict; +use vars qw($cache); +use Digest::MD5 qw(md5_hex); +use Date::Format; +use Cache::SharedMemoryCache; #store in db? +use FS::CGI qw(small_custview); #doh +use FS::Conf; +use FS::Record qw(qsearchs); +use FS::svc_acct; +use FS::svc_domain; +use FS::cust_main; +use FS::cust_bill; + +use FS::ClientAPI; #hmm +FS::ClientAPI->register_handlers( + 'MyAccount/login' => \&login, + 'MyAccount/customer_info' => \&customer_info, + 'MyAccount/invoice' => \&invoice, +); + +#store in db? +my $cache = new Cache::SharedMemoryCache(); + +#false laziness w/FS::ClientAPI::passwd::passwd (needs to handle encrypted pw) +sub login { + my $p = shift; + + my $svc_domain = qsearchs('svc_domain', { 'domain' => $p->{'domain'} } ) + or return { error => "Domain not found" }; + + my $svc_acct = + ( length($p->{'password'}) < 13 + && qsearchs( 'svc_acct', { 'username' => $p->{'username'}, + 'domsvc' => $svc_domain->svcnum, + '_password' => $p->{'password'} } ) + ) + || qsearchs( 'svc_acct', { 'username' => $p->{'username'}, + 'domsvc' => $svc_domain->svcnum, + '_password' => $p->{'password'} } ); + + unless ( $svc_acct ) { return { error => 'Incorrect password.' } } + + my $session = { + 'svcnum' => $svc_acct->svcnum, + }; + + my $cust_pkg = $svc_acct->cust_svc->cust_pkg; + if ( $cust_pkg ) { + my $cust_main = $cust_pkg->cust_main; + $session->{'custnum'} = $cust_main->custnum; + } + + my $session_id; + do { + $session_id = md5_hex(md5_hex(time(). {}. rand(). $$)) + } until ( ! defined $cache->get($session_id) ); #just in case + + $cache->set( $session_id, $session, '1 hour' ); + + return { 'error' => '', + 'session_id' => $session_id, + }; +} + +sub customer_info { + my $p = shift; + my $session = $cache->get($p->{'session_id'}) + or return { 'error' => "Can't resume session" }; #better error message + + my %return; + + my $custnum = $session->{'custnum'}; + + if ( $custnum ) { #customer record + + my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ) + or return { 'error' => "unknown custnum $custnum" }; + + $return{balance} = $cust_main->balance; + + my @open = map { + { + invnum => $_->invnum, + date => time2str("%b %o, %Y", $_->_date), + owed => $_->owed, + }; + } $cust_main->open_cust_bill; + $return{open_invoices} = \@open; + + my $conf = new FS::Conf; + $return{small_custview} = + small_custview( $cust_main, $conf->config('defaultcountry') ); + + $return{name} = $cust_main->first. ' '. $cust_main->get('last'); + + } else { #no customer record + + my $svc_acct = qsearchs('svc_acct', { 'svcnum' => $session->{'svcnum'} } ) + or die "unknown svcnum"; + $return{name} = $svc_acct->email; + + } + + + return { 'error' => '', + 'custnum' => $custnum, + %return, + }; + +} + +sub invoice { + my $p = shift; + my $session = $cache->get($p->{'session_id'}) + or return { 'error' => "Can't resume session" }; #better error message + + my $custnum = $session->{'custnum'}; + + my $invnum = $p->{'invnum'}; + + my $cust_bill = qsearchs('cust_bill', { 'invnum' => $invnum, + 'custnum' => $custnum } ) + or return { 'error' => "Can't find invnum" }; + + #my %return; + + return { 'error' => '', + 'invnum' => $invnum, + 'invoice_text' => join('', $cust_bill->print_text ), + }; + +} + + diff --git a/FS/FS/ClientAPI/passwd.pm b/FS/FS/ClientAPI/passwd.pm new file mode 100644 index 000000000..29606227d --- /dev/null +++ b/FS/FS/ClientAPI/passwd.pm @@ -0,0 +1,56 @@ +package FS::ClientAPI::passwd; + +use strict; +use FS::Record qw(qsearchs); +use FS::svc_acct; +#use FS::svc_domain; + +use FS::ClientAPI; #hmm +FS::ClientAPI->register_handlers( + 'passwd/passwd' => \&passwd, + 'passwd/chfn' => \&chfn, + 'passwd/chsh' => \&chsh, +); + +sub passwd { + my $packet = shift; + + #my $domain = qsearchs('svc_domain', { 'domain' => $packet->{'domain'} } ) + # or return { error => "Domain $domain not found" }; + + my $old_password = $packet->{'old_password'}; + my $new_password = $packet->{'new_password'}; + my $new_gecos = $packet->{'new_gecos'}; + my $new_shell = $packet->{'new_shell'}; + +#false laziness w/FS::ClientAPI::MyAccount::login (needs to handle encrypted pw) + my $svc_acct = + ( length($old_password) < 13 + && qsearchs( 'svc_acct', { 'username' => $packet->{'username'}, + #'domsvc' => $svc_domain->svcnum, + '_password' => $old_password } ) + ) + || qsearchs( 'svc_acct', { 'username' => $packet->{'username'}, + #'domsvc' => $svc_domain->svcnum, + '_password' => $old_password } ); + + unless ( $svc_acct ) { return { error => 'Incorrect password.' } } + + my %hash = $svc_acct->hash; + my $new_svc_acct = new FS::svc_acct ( \%hash ); + $new_svc_acct->setfield('_password', $new_password ) + if $new_password && $new_password ne $old_password; + $new_svc_acct->setfield('finger',$new_gecos) if $new_gecos; + $new_svc_acct->setfield('shell',$new_shell) if $new_shell; + my $error = $new_svc_acct->replace($svc_acct); + + return { error => $error }; + +} + +sub chfn {} + +sub chsh {} + +1; + diff --git a/FS/MANIFEST b/FS/MANIFEST index a6a8d935e..8355e40fb 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -20,6 +20,9 @@ bin/freeside-reexport FS.pm FS/CGI.pm FS/InitHandler.pm +FS/ClientAPI.pm +FS/ClientAPI/passwd.pm +FS/ClientAPI/MyAccount.pm FS/Conf.pm FS/ConfItem.pm FS/Record.pm @@ -97,6 +100,7 @@ t/agent.t t/agent_type.t t/CGI.t t/InitHandler.t +t/ClientAPI.t t/Conf.t t/ConfItem.t t/Record.t -- cgit v1.2.1 From c8c220ea0d5776aaf42581a0e3e61336a8d798f3 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 22 Jul 2002 10:18:44 +0000 Subject: sort bills by date --- FS/FS/cust_main.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 02e906aed..eb468d981 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1809,7 +1809,8 @@ Returns all the invoices (see L) for this customer. sub cust_bill { my $self = shift; - qsearch('cust_bill', { 'custnum' => $self->custnum, } ) + sort { $a->_date <=> $b->_date } + qsearch('cust_bill', { 'custnum' => $self->custnum, } ) } =item open_cust_bill -- cgit v1.2.1 From 5e4671b1c30d8f6d68a770c7ad2dd40462ed6f2b Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 22 Jul 2002 10:18:56 +0000 Subject: UI --- FS/FS/CGI.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/CGI.pm b/FS/FS/CGI.pm index 28b3a06fa..e44ebcc0a 100644 --- a/FS/FS/CGI.pm +++ b/FS/FS/CGI.pm @@ -253,7 +253,7 @@ sub small_custview { my $html = 'Customer #'. $cust_main->custnum. ''. ntable('#e8e8e8'). ''. ntable("#cccccc",2). - 'Billing'. + 'Billing
Address'. $cust_main->getfield('last'). ', '. $cust_main->first. '
'; $html .= $cust_main->company. '
' if $cust_main->company; @@ -270,7 +270,7 @@ sub small_custview { my $pre = $cust_main->ship_last ? 'ship_' : ''; $html .= ''. ntable("#cccccc",2). - 'Service'. + 'Service
Address'. $cust_main->get("${pre}last"). ', '. $cust_main->get("${pre}first"). '
'; $html .= $cust_main->get("${pre}company"). '
' -- cgit v1.2.1 From 920c0d8dea4535893157a547c87dda63dca64599 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 22 Jul 2002 10:51:22 +0000 Subject: adding --- FS/t/ClientAPI.t | 5 +++++ 1 file changed, 5 insertions(+) create mode 100644 FS/t/ClientAPI.t (limited to 'FS') diff --git a/FS/t/ClientAPI.t b/FS/t/ClientAPI.t new file mode 100644 index 000000000..973d8dada --- /dev/null +++ b/FS/t/ClientAPI.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::ClientAPI; +$loaded=1; +print "ok 1\n"; -- cgit v1.2.1 From bcaf38373e4a191dacca83b4dae24e521908819b Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 23 Jul 2002 12:37:51 +0000 Subject: fix small bugs in duplicate username checking --- FS/FS/svc_acct.pm | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index bd01adfdc..878d76b9d 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -19,6 +19,7 @@ use FS::Conf; use FS::Record qw( qsearch qsearchs fields dbh ); use FS::svc_Common; use Net::SSH; +use FS::cust_svc; use FS::part_svc; use FS::svc_acct_pop; use FS::svc_acct_sm; @@ -233,8 +234,8 @@ sub insert { } my @dup_user = qsearch( 'svc_acct', { 'username' => $self->username } ); - my @dup_userdomain = qsearchs( 'svc_acct', { 'username' => $self->username, - 'domsvc' => $self->domsvc } ); + my @dup_userdomain = qsearch( 'svc_acct', { 'username' => $self->username, + 'domsvc' => $self->domsvc } ); my @dup_uid; if ( $part_svc->part_svc_column('uid')->columnflag ne 'F' && $self->username !~ /^(toor|(hyla)?fax)$/ ) { @@ -276,6 +277,7 @@ sub insert { foreach my $dup_user ( @dup_user ) { my $dup_svcpart = $dup_user->cust_svc->svcpart; if ( exists($conflict_user_svcpart{$dup_svcpart}) ) { + $dbh->rollback if $oldAutoCommit; return "duplicate username: conflicts with svcnum ". $dup_user->svcnum. " via exportnum ". $conflict_user_svcpart{$dup_svcpart}; } @@ -284,6 +286,7 @@ sub insert { foreach my $dup_userdomain ( @dup_userdomain ) { my $dup_svcpart = $dup_userdomain->cust_svc->svcpart; if ( exists($conflict_userdomain_svcpart{$dup_svcpart}) ) { + $dbh->rollback if $oldAutoCommit; return "duplicate username\@domain: conflicts with svcnum ". $dup_userdomain->svcnum. " via exportnum ". $conflict_userdomain_svcpart{$dup_svcpart}; @@ -294,6 +297,7 @@ sub insert { my $dup_svcpart = $dup_uid->cust_svc->svcpart; if ( exists($conflict_user_svcpart{$dup_svcpart}) || exists($conflict_userdomain_svcpart{$dup_svcpart}) ) { + $dbh->rollback if $oldAutoCommit; return "duplicate uid: conflicts with svcnum". $dup_uid->svcnum. "via exportnum ". $conflict_user_svcpart{$dup_svcpart} || $conflict_userdomain_svcpart{$dup_svcpart}; -- cgit v1.2.1 From dba4eeaf3610792b0ed1149723a8383cc4a6fef1 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 26 Jul 2002 02:33:27 +0000 Subject: shellcommands edit gecos field too --- FS/FS/part_export.pm | 2 +- FS/FS/part_export/shellcommands.pm | 3 +++ 2 files changed, 4 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 0597cddf2..64d21d723 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -719,7 +719,7 @@ tie my %sqlmail_options, 'Tie::IxHash', 'desc' => 'Real-time export via remote SSH (i.e. useradd, userdel, etc.)', 'options' => \%shellcommands_options, 'nodomain' => 'Y', - 'notes' => 'Run remote commands via SSH. Usernames are considered unique (also see shellcommands_withdomain). You probably want this if the commands you are running will not accept a domain as a parameter. You will need to setup SSH for unattended operation.

Use these buttons for some useful presets:
', + 'notes' => 'Run remote commands via SSH. Usernames are considered unique (also see shellcommands_withdomain). You probably want this if the commands you are running will not accept a domain as a parameter. You will need to setup SSH for unattended operation.

Use these buttons for some useful presets:
', }, 'shellcommands_withdomain' => { diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm index 56cd569af..e4005761b 100644 --- a/FS/FS/part_export/shellcommands.pm +++ b/FS/FS/part_export/shellcommands.pm @@ -1,6 +1,7 @@ package FS::part_export::shellcommands; use vars qw(@ISA @saltset); +use String::ShellQuote; use FS::part_export; @ISA = qw(FS::part_export); @@ -27,6 +28,7 @@ sub _export_command { no strict 'refs'; ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields; } + $finger = shell_quote $finger; $crypt_password = ''; #surpress "used only once" warnings $crypt_password = crypt( $svc_acct->_password, $saltset[int(rand(64))].$saltset[int(rand(64))] ); @@ -47,6 +49,7 @@ sub _export_replace { ${"old_$_"} = $old->getfield($_) foreach $old->fields; ${"new_$_"} = $new->getfield($_) foreach $new->fields; } + $new_finger = shell_quote $new_finger; $new_crypt_password = ''; #surpress "used only once" warnings $new_crypt_password = crypt( $new->_password, $saltset[int(rand(64))].$saltset[int(rand(64))]); -- cgit v1.2.1 From 6414c4c23d3fac2012d1524f17c0aae5e5012935 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 27 Jul 2002 02:47:12 +0000 Subject: vacuum pg databases daily --- FS/bin/freeside-daily | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/bin/freeside-daily b/FS/bin/freeside-daily index e6f02df33..142b0c73a 100755 --- a/FS/bin/freeside-daily +++ b/FS/bin/freeside-daily @@ -4,7 +4,7 @@ use strict; use Fcntl qw(:flock); use Date::Parse; use Getopt::Std; -use FS::UID qw(adminsuidsetup); +use FS::UID qw(adminsuidsetup driver_name dbh); use FS::Record qw(qsearch qsearchs); use FS::cust_main; @@ -41,6 +41,13 @@ foreach $cust_main ( @cust_main ) { } +if ( driver_name eq 'Pg' ) { + foreach my $statement ( 'vacuum', 'vacuum analyze' ) { + my $sth = dbh->prepare($statement) or die dbh->errstr; + $sth->execute or die $sth->errstr; + } +} + # subroutines sub untaint_argv { -- cgit v1.2.1 From 4d49d138a801dd653ab73004144afe64961042f6 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 31 Jul 2002 13:18:03 +0000 Subject: fix bug with static IP addresses --- FS/FS/svc_acct.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 878d76b9d..c95df94cf 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -838,8 +838,8 @@ sub radius_reply { #$attrib =~ s/_/\-/g; ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) ); } grep { /^radius_/ && $self->getfield($_) } fields( $self->table ); - if ( $self->ip && $self->ip ne '0e0' ) { - $reply{'Framed-IP-Address'} = $self->ip; + if ( $self->slipip && $self->slipip ne '0e0' ) { + $reply{'Framed-IP-Address'} = $self->slipip; } %reply; } -- cgit v1.2.1 From ababd9b098c0a91383aff1df8a0a24492b58aba7 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 31 Jul 2002 18:55:04 +0000 Subject: delete directories when deleting users on freebsd --- FS/FS/part_export.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 64d21d723..4f45fbeec 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -719,7 +719,7 @@ tie my %sqlmail_options, 'Tie::IxHash', 'desc' => 'Real-time export via remote SSH (i.e. useradd, userdel, etc.)', 'options' => \%shellcommands_options, 'nodomain' => 'Y', - 'notes' => 'Run remote commands via SSH. Usernames are considered unique (also see shellcommands_withdomain). You probably want this if the commands you are running will not accept a domain as a parameter. You will need to setup SSH for unattended operation.

Use these buttons for some useful presets:
', + 'notes' => 'Run remote commands via SSH. Usernames are considered unique (also see shellcommands_withdomain). You probably want this if the commands you are running will not accept a domain as a parameter. You will need to setup SSH for unattended operation.

Use these buttons for some useful presets:
', }, 'shellcommands_withdomain' => { -- cgit v1.2.1 From 160be29a0dc62e79a4fb95d2ab8c0c7e5996760e Mon Sep 17 00:00:00 2001 From: cvs2git Date: Mon, 12 Aug 2002 06:17:10 +0000 Subject: This commit was manufactured by cvs2svn to create branch 'BESTPRACTICAL'. --- FS/Changes | 5 - FS/FS.pm | 231 --- FS/FS/CGI.pm | 314 ---- FS/FS/ClientAPI.pm | 44 - FS/FS/ClientAPI/MyAccount.pm | 136 -- FS/FS/ClientAPI/passwd.pm | 56 - FS/FS/Conf.pm | 972 ------------ FS/FS/ConfItem.pm | 63 - FS/FS/InitHandler.pm | 88 -- FS/FS/Msgcat.pm | 98 -- FS/FS/Record.pm | 1258 ---------------- FS/FS/SearchCache.pm | 96 -- FS/FS/UI/Base.pm | 194 --- FS/FS/UI/CGI.pm | 239 --- FS/FS/UI/Gtk.pm | 224 --- FS/FS/UI/agent.pm | 62 - FS/FS/UID.pm | 281 ---- FS/FS/agent.pm | 160 -- FS/FS/agent_type.pm | 165 -- FS/FS/cust_bill.pm | 976 ------------ FS/FS/cust_bill_event.pm | 175 --- FS/FS/cust_bill_pay.pm | 219 --- FS/FS/cust_bill_pkg.pm | 155 -- FS/FS/cust_credit.pm | 260 ---- FS/FS/cust_credit_bill.pm | 162 -- FS/FS/cust_credit_refund.pm | 205 --- FS/FS/cust_main.pm | 1994 ------------------------- FS/FS/cust_main_county.pm | 253 ---- FS/FS/cust_main_invoice.pm | 184 --- FS/FS/cust_pay.pm | 422 ------ FS/FS/cust_pay_batch.pm | 209 --- FS/FS/cust_pkg.pm | 710 --------- FS/FS/cust_refund.pm | 282 ---- FS/FS/cust_svc.pm | 367 ----- FS/FS/cust_tax_exempt.pm | 131 -- FS/FS/domain_record.pm | 332 ---- FS/FS/export_svc.pm | 123 -- FS/FS/msgcat.pm | 132 -- FS/FS/nas.pm | 152 -- FS/FS/part_bill_event.pm | 183 --- FS/FS/part_export.pm | 850 ----------- FS/FS/part_export/bind.pm | 7 - FS/FS/part_export/bind_slave.pm | 7 - FS/FS/part_export/bsdshell.pm | 7 - FS/FS/part_export/cp.pm | 112 -- FS/FS/part_export/cyrus.pm | 98 -- FS/FS/part_export/http.pm | 88 -- FS/FS/part_export/infostreet.pm | 218 --- FS/FS/part_export/null.pm | 13 - FS/FS/part_export/shellcommands.pm | 85 -- FS/FS/part_export/shellcommands_withdomain.pm | 7 - FS/FS/part_export/sqlmail.pm | 111 -- FS/FS/part_export/sqlradius.pm | 273 ---- FS/FS/part_export/sysvshell.pm | 7 - FS/FS/part_export/textradius.pm | 166 -- FS/FS/part_export/vpopmail.pm | 179 --- FS/FS/part_export/www_shellcommands.pm | 112 -- FS/FS/part_export_option.pm | 134 -- FS/FS/part_pkg.pm | 317 ---- FS/FS/part_pop_local.pm | 116 -- FS/FS/part_referral.pm | 116 -- FS/FS/part_svc.pm | 348 ----- FS/FS/part_svc_column.pm | 118 -- FS/FS/pkg_svc.pm | 152 -- FS/FS/port.pm | 160 -- FS/FS/prepay_credit.pm | 126 -- FS/FS/queue.pm | 401 ----- FS/FS/queue_arg.pm | 121 -- FS/FS/queue_depend.pm | 120 -- FS/FS/raddb.pm | 1091 -------------- FS/FS/radius_usergroup.pm | 130 -- FS/FS/session.pm | 269 ---- FS/FS/svc_Common.pm | 381 ----- FS/FS/svc_acct.pm | 1150 -------------- FS/FS/svc_acct_pop.pm | 204 --- FS/FS/svc_acct_sm.pm | 260 ---- FS/FS/svc_domain.pm | 478 ------ FS/FS/svc_forward.pm | 470 ------ FS/FS/svc_www.pm | 276 ---- FS/FS/type_pkgs.pm | 113 -- FS/MANIFEST | 168 --- FS/MANIFEST.SKIP | 1 - FS/Makefile.PL | 8 - FS/README | 6 - FS/bin/freeside-adduser | 57 - FS/bin/freeside-apply-credits | 21 - FS/bin/freeside-bill | 128 -- FS/bin/freeside-cc-receipts-report | 270 ---- FS/bin/freeside-credit-report | 224 --- FS/bin/freeside-daily | 99 -- FS/bin/freeside-email | 61 - FS/bin/freeside-expiration-alerter | 224 --- FS/bin/freeside-overdue | 196 --- FS/bin/freeside-queued | 254 ---- FS/bin/freeside-receivables-report | 217 --- FS/bin/freeside-reexport | 62 - FS/bin/freeside-setinvoice | 42 - FS/bin/freeside-sqlradius-reset | 74 - FS/bin/freeside-tax-report | 292 ---- FS/t/CGI.t | 5 - FS/t/ClientAPI.t | 5 - FS/t/Conf.t | 5 - FS/t/ConfItem.t | 5 - FS/t/InitHandler.t | 5 - FS/t/Msgcat.t | 5 - FS/t/Record.t | 5 - FS/t/SearchCache.t | 5 - FS/t/UID.t | 5 - FS/t/agent.t | 5 - FS/t/agent_type.t | 5 - FS/t/cust_bill.t | 5 - FS/t/cust_bill_event.t | 5 - FS/t/cust_bill_pay.t | 5 - FS/t/cust_bill_pkg.t | 5 - FS/t/cust_credit.t | 5 - FS/t/cust_credit_bill.t | 5 - FS/t/cust_credit_refund.t | 5 - FS/t/cust_main.t | 5 - FS/t/cust_main_county.t | 5 - FS/t/cust_main_invoice.t | 5 - FS/t/cust_pay.t | 5 - FS/t/cust_pay_batch.t | 5 - FS/t/cust_pkg.t | 5 - FS/t/cust_refund.t | 5 - FS/t/cust_svc.t | 5 - FS/t/cust_tax_exempt.pm | 5 - FS/t/cust_tax_exempt.t | 5 - FS/t/domain_record.t | 5 - FS/t/export_svc.t | 5 - FS/t/msgcat.t | 5 - FS/t/nas.t | 5 - FS/t/part_bill_event.t | 5 - FS/t/part_export-bind.t | 5 - FS/t/part_export-bind_slave.t | 5 - FS/t/part_export-bsdshell.t | 5 - FS/t/part_export-cp.t | 5 - FS/t/part_export-cyrus.t | 5 - FS/t/part_export-http.t | 5 - FS/t/part_export-infostreet.t | 5 - FS/t/part_export-null.t | 5 - FS/t/part_export-shellcommands.t | 5 - FS/t/part_export-shellcommands_withdomain.t | 5 - FS/t/part_export-sqlmail.t | 5 - FS/t/part_export-sqlradius.t | 5 - FS/t/part_export-sysvshell.t | 5 - FS/t/part_export-textradius.t | 5 - FS/t/part_export-vpopmail.t | 5 - FS/t/part_export-www_shellcommands.t | 5 - FS/t/part_export.t | 5 - FS/t/part_export_option.t | 5 - FS/t/part_pkg.t | 5 - FS/t/part_pop_local.t | 5 - FS/t/part_referral.t | 5 - FS/t/part_svc.t | 5 - FS/t/part_svc_column.t | 5 - FS/t/pkg_svc.t | 5 - FS/t/port.t | 5 - FS/t/prepay_credit.t | 5 - FS/t/queue.t | 5 - FS/t/queue_arg.t | 5 - FS/t/queue_depend.t | 5 - FS/t/raddb.t | 5 - FS/t/radius_usergroup.t | 5 - FS/t/session.t | 5 - FS/t/svc_Common.t | 5 - FS/t/svc_acct.t | 5 - FS/t/svc_acct_pop.t | 5 - FS/t/svc_acct_sm.t | 5 - FS/t/svc_domain.t | 5 - FS/t/svc_forward.t | 5 - FS/t/svc_www.t | 5 - FS/t/type_pkgs.t | 5 - 172 files changed, 24472 deletions(-) delete mode 100644 FS/Changes delete mode 100644 FS/FS.pm delete mode 100644 FS/FS/CGI.pm delete mode 100644 FS/FS/ClientAPI.pm delete mode 100644 FS/FS/ClientAPI/MyAccount.pm delete mode 100644 FS/FS/ClientAPI/passwd.pm delete mode 100644 FS/FS/Conf.pm delete mode 100644 FS/FS/ConfItem.pm delete mode 100644 FS/FS/InitHandler.pm delete mode 100644 FS/FS/Msgcat.pm delete mode 100644 FS/FS/Record.pm delete mode 100644 FS/FS/SearchCache.pm delete mode 100644 FS/FS/UI/Base.pm delete mode 100644 FS/FS/UI/CGI.pm delete mode 100644 FS/FS/UI/Gtk.pm delete mode 100644 FS/FS/UI/agent.pm delete mode 100644 FS/FS/UID.pm delete mode 100644 FS/FS/agent.pm delete mode 100644 FS/FS/agent_type.pm delete mode 100644 FS/FS/cust_bill.pm delete mode 100644 FS/FS/cust_bill_event.pm delete mode 100644 FS/FS/cust_bill_pay.pm delete mode 100644 FS/FS/cust_bill_pkg.pm delete mode 100644 FS/FS/cust_credit.pm delete mode 100644 FS/FS/cust_credit_bill.pm delete mode 100644 FS/FS/cust_credit_refund.pm delete mode 100644 FS/FS/cust_main.pm delete mode 100644 FS/FS/cust_main_county.pm delete mode 100644 FS/FS/cust_main_invoice.pm delete mode 100644 FS/FS/cust_pay.pm delete mode 100644 FS/FS/cust_pay_batch.pm delete mode 100644 FS/FS/cust_pkg.pm delete mode 100644 FS/FS/cust_refund.pm delete mode 100644 FS/FS/cust_svc.pm delete mode 100644 FS/FS/cust_tax_exempt.pm delete mode 100644 FS/FS/domain_record.pm delete mode 100644 FS/FS/export_svc.pm delete mode 100644 FS/FS/msgcat.pm delete mode 100644 FS/FS/nas.pm delete mode 100644 FS/FS/part_bill_event.pm delete mode 100644 FS/FS/part_export.pm delete mode 100644 FS/FS/part_export/bind.pm delete mode 100644 FS/FS/part_export/bind_slave.pm delete mode 100644 FS/FS/part_export/bsdshell.pm delete mode 100644 FS/FS/part_export/cp.pm delete mode 100644 FS/FS/part_export/cyrus.pm delete mode 100644 FS/FS/part_export/http.pm delete mode 100644 FS/FS/part_export/infostreet.pm delete mode 100644 FS/FS/part_export/null.pm delete mode 100644 FS/FS/part_export/shellcommands.pm delete mode 100644 FS/FS/part_export/shellcommands_withdomain.pm delete mode 100644 FS/FS/part_export/sqlmail.pm delete mode 100644 FS/FS/part_export/sqlradius.pm delete mode 100644 FS/FS/part_export/sysvshell.pm delete mode 100644 FS/FS/part_export/textradius.pm delete mode 100644 FS/FS/part_export/vpopmail.pm delete mode 100644 FS/FS/part_export/www_shellcommands.pm delete mode 100644 FS/FS/part_export_option.pm delete mode 100644 FS/FS/part_pkg.pm delete mode 100644 FS/FS/part_pop_local.pm delete mode 100644 FS/FS/part_referral.pm delete mode 100644 FS/FS/part_svc.pm delete mode 100644 FS/FS/part_svc_column.pm delete mode 100644 FS/FS/pkg_svc.pm delete mode 100644 FS/FS/port.pm delete mode 100644 FS/FS/prepay_credit.pm delete mode 100644 FS/FS/queue.pm delete mode 100644 FS/FS/queue_arg.pm delete mode 100644 FS/FS/queue_depend.pm delete mode 100644 FS/FS/raddb.pm delete mode 100644 FS/FS/radius_usergroup.pm delete mode 100644 FS/FS/session.pm delete mode 100644 FS/FS/svc_Common.pm delete mode 100644 FS/FS/svc_acct.pm delete mode 100644 FS/FS/svc_acct_pop.pm delete mode 100644 FS/FS/svc_acct_sm.pm delete mode 100644 FS/FS/svc_domain.pm delete mode 100644 FS/FS/svc_forward.pm delete mode 100644 FS/FS/svc_www.pm delete mode 100644 FS/FS/type_pkgs.pm delete mode 100644 FS/MANIFEST delete mode 100644 FS/MANIFEST.SKIP delete mode 100644 FS/Makefile.PL delete mode 100644 FS/README delete mode 100644 FS/bin/freeside-adduser delete mode 100755 FS/bin/freeside-apply-credits delete mode 100755 FS/bin/freeside-bill delete mode 100755 FS/bin/freeside-cc-receipts-report delete mode 100755 FS/bin/freeside-credit-report delete mode 100755 FS/bin/freeside-daily delete mode 100755 FS/bin/freeside-email delete mode 100755 FS/bin/freeside-expiration-alerter delete mode 100755 FS/bin/freeside-overdue delete mode 100644 FS/bin/freeside-queued delete mode 100755 FS/bin/freeside-receivables-report delete mode 100644 FS/bin/freeside-reexport delete mode 100644 FS/bin/freeside-setinvoice delete mode 100755 FS/bin/freeside-sqlradius-reset delete mode 100755 FS/bin/freeside-tax-report delete mode 100644 FS/t/CGI.t delete mode 100644 FS/t/ClientAPI.t delete mode 100644 FS/t/Conf.t delete mode 100644 FS/t/ConfItem.t delete mode 100644 FS/t/InitHandler.t delete mode 100644 FS/t/Msgcat.t delete mode 100644 FS/t/Record.t delete mode 100644 FS/t/SearchCache.t delete mode 100644 FS/t/UID.t delete mode 100644 FS/t/agent.t delete mode 100644 FS/t/agent_type.t delete mode 100644 FS/t/cust_bill.t delete mode 100644 FS/t/cust_bill_event.t delete mode 100644 FS/t/cust_bill_pay.t delete mode 100644 FS/t/cust_bill_pkg.t delete mode 100644 FS/t/cust_credit.t delete mode 100644 FS/t/cust_credit_bill.t delete mode 100644 FS/t/cust_credit_refund.t delete mode 100644 FS/t/cust_main.t delete mode 100644 FS/t/cust_main_county.t delete mode 100644 FS/t/cust_main_invoice.t delete mode 100644 FS/t/cust_pay.t delete mode 100644 FS/t/cust_pay_batch.t delete mode 100644 FS/t/cust_pkg.t delete mode 100644 FS/t/cust_refund.t delete mode 100644 FS/t/cust_svc.t delete mode 100644 FS/t/cust_tax_exempt.pm delete mode 100644 FS/t/cust_tax_exempt.t delete mode 100644 FS/t/domain_record.t delete mode 100644 FS/t/export_svc.t delete mode 100644 FS/t/msgcat.t delete mode 100644 FS/t/nas.t delete mode 100644 FS/t/part_bill_event.t delete mode 100644 FS/t/part_export-bind.t delete mode 100644 FS/t/part_export-bind_slave.t delete mode 100644 FS/t/part_export-bsdshell.t delete mode 100644 FS/t/part_export-cp.t delete mode 100644 FS/t/part_export-cyrus.t delete mode 100644 FS/t/part_export-http.t delete mode 100644 FS/t/part_export-infostreet.t delete mode 100644 FS/t/part_export-null.t delete mode 100644 FS/t/part_export-shellcommands.t delete mode 100644 FS/t/part_export-shellcommands_withdomain.t delete mode 100644 FS/t/part_export-sqlmail.t delete mode 100644 FS/t/part_export-sqlradius.t delete mode 100644 FS/t/part_export-sysvshell.t delete mode 100644 FS/t/part_export-textradius.t delete mode 100644 FS/t/part_export-vpopmail.t delete mode 100644 FS/t/part_export-www_shellcommands.t delete mode 100644 FS/t/part_export.t delete mode 100644 FS/t/part_export_option.t delete mode 100644 FS/t/part_pkg.t delete mode 100644 FS/t/part_pop_local.t delete mode 100644 FS/t/part_referral.t delete mode 100644 FS/t/part_svc.t delete mode 100644 FS/t/part_svc_column.t delete mode 100644 FS/t/pkg_svc.t delete mode 100644 FS/t/port.t delete mode 100644 FS/t/prepay_credit.t delete mode 100644 FS/t/queue.t delete mode 100644 FS/t/queue_arg.t delete mode 100644 FS/t/queue_depend.t delete mode 100644 FS/t/raddb.t delete mode 100644 FS/t/radius_usergroup.t delete mode 100644 FS/t/session.t delete mode 100644 FS/t/svc_Common.t delete mode 100644 FS/t/svc_acct.t delete mode 100644 FS/t/svc_acct_pop.t delete mode 100644 FS/t/svc_acct_sm.t delete mode 100644 FS/t/svc_domain.t delete mode 100644 FS/t/svc_forward.t delete mode 100644 FS/t/svc_www.t delete mode 100644 FS/t/type_pkgs.t (limited to 'FS') diff --git a/FS/Changes b/FS/Changes deleted file mode 100644 index c94ef10f5..000000000 --- a/FS/Changes +++ /dev/null @@ -1,5 +0,0 @@ -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 deleted file mode 100644 index 963c73548..000000000 --- a/FS/FS.pm +++ /dev/null @@ -1,231 +0,0 @@ -package FS; - -use strict; -use vars qw($VERSION); - -$VERSION = '0.01'; - -#find missing entries in this file with: -# for a in `ls *pm | cut -d. -f1`; do grep 'L' ../FS.pm >/dev/null || echo "missing $a" ; done - -1; -__END__ - -=head1 NAME - -FS - Freeside Perl modules - -=head1 SYNOPSIS - -Freeside perl modules and CLI utilities. - -=head2 Utility classes - -L - Freeside configuration values - -L - Freeside configuration option meta-data. - -L - User class (not yet OO) - -L - Non OO-subroutines for the web interface. - -L - Message catalog - -L - Search cache - -L - RADIUS dictionary - -=head2 Database record classes - -L - Database record base class - -L - POP (Point of Presence, not Post -Office Protocol) class - -L - Local calling area class - -L - Referral class - -L - Locale (tax rate) class - -L - Tax exemption record class - -L - Service base class - -L - Account (shell, RADIUS, POP3) class - -L - RADIUS groups - -L - Domain class - -L - DNS zone entries - -L - Mail forwarding class - -L - (Depreciated) Vitual mail alias class - -L - Web virtual host class. - -L - Service definition class - -L - Column constraint class - -L - Class linking service definitions (see L) -with exports (see L) - -L - External provisioning export class - -L - Export option 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 - Invoice event definition class - -L - Completed invoice event class - -L - Payment class - -L - Payment application class - -L - Credit class - -L - Refund class - -L - Refund application class - -L - Credit invoice application 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 - -L - Job queue - -L - Job arguments - -L - Job dependencies - -L - Message catalogs - -=head1 Remote API modules - -L - -L - -L - -=head2 Command-line utilities - -L - -L - -L - -L - -L - -L - -L - -L - -L - -L - -L - -=head2 User Interface classes (under (stalled) 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." - -If you've never used OO modules before, -http://www.cpan.org/doc/FMTEYEWTK/easy_objects.html might help you out. - -=head1 DESCRIPTION - -Freeside is a billing and administration package for Internet Service -Providers. - -The Freeside home page is at . - -The main documentation is in httemplate/docs. - -=head1 SUPPORT - -A mailing list for users is available. Send a blank message to - to subscribe. - -A mailing list for developers is available. It is intended to be lower volume -and higher SNR than the users list. Send a blank message to - 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 - -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 deleted file mode 100644 index e44ebcc0a..000000000 --- a/FS/FS/CGI.pm +++ /dev/null @@ -1,314 +0,0 @@ -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 - small_custview myexit); - -=head1 NAME - -FS::CGI - Subroutines for the web interface - -=head1 SYNOPSIS - - use FS::CGI qw(header menubar idiot eidiot popurl); - - print header( 'Title', '' ); - print header( 'Title', menubar('item', 'URL', ... ) ); - - idiot "error message"; - eidiot "error message"; - - $url = popurl; #returns current url - $url = popurl(3); #three levels up - -=head1 DESCRIPTION - -Provides a few common subroutines for the web interface. - -=head1 SUBROUTINES - -=over 4 - -=item header TITLE, MENUBAR - -Returns an HTML header. - -=cut - -sub header { - my($title,$menubar,$etc)=@_; #$etc is for things like onLoad= etc. - #use Carp; - $etc = '' unless defined $etc; - - my $x = < - - - $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 an HTML error message. - -=cut - -sub idiot { - #warn "idiot depriciated"; - my($error)=@_; -# my $cgi = &FS::UID::cgi(); -# if ( $cgi->isa('CGI::Base') ) { -# no strict 'subs'; -# &CGI::Base::SendHeaders; -# } else { -# print $cgi->header( @FS::CGI::header ); -# } - print < - - 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 an HTML error message, then exits. - -=cut - -sub eidiot { - warn "eidiot depriciated"; - $HTML::Mason::Commands::r->send_http_header - if defined $HTML::Mason::Commands::r; - idiot(@_); - &myexit(); -} - -=item myexit - -You probably shouldn't use this; but if you must: - -If running under mod_perl, calles Apache::exit, otherwise, calls exit. - -=cut - -sub myexit { - if (exists $ENV{MOD_PERL}) { - - if ( defined $main::Response - && $main::Response->isa('Apache::ASP::Response') ) { #Apache::ASP - $main::Response->End(); - require Apache; - Apache::exit(); - } elsif ( defined $HTML::Mason::Commands::m ) { #Mason - #$HTML::Mason::Commands::m->flush_buffer(); - $HTML::Mason::Commands::m->abort(); - die "shouldn't fall through to here (mason \$m->abort didn't)"; - } else { - #??? well, it is $ENV{MOD_PERL} - warn "running under unknown mod_perl environment; trying Apache::exit()"; - require Apache; - Apache::exit(); - } - } else { - exit; - } -} - -=item popurl LEVEL - -Returns current URL with LEVEL levels of path removed from the end (default 0). - -=cut - -sub popurl { - my($up)=@_; - my $cgi = &FS::UID::cgi; - my $url = new URI::URL ( $cgi->isa('Apache') ? $cgi->uri : $cgi->url ); - my(@path)=$url->path_components; - splice @path, 0-$up; - $url->path_components(@path); - my $x = $url->as_string; - $x .= '/' unless $x =~ /\/$/; - $x; -} - -=item table - -Returns HTML tag for beginning a table. - -=cut - -sub table { - my $col = shift; - if ( $col ) { - qq!!; - } 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 { - '
'; - } - -} - -=item small_custview CUSTNUM || CUST_MAIN_OBJECT, COUNTRYDEFAULT - -Sheesh. I should just switch to Mason. - -=cut - -sub small_custview { - use FS::Record qw(qsearchs); - use FS::cust_main; - - my $arg = shift; - my $countrydefault = shift || 'US'; - - my $cust_main = ref($arg) ? $arg - : qsearchs('cust_main', { 'custnum' => $arg } ) - or die "unknown custnum $arg"; - - my $html = 'Customer #'. $cust_main->custnum. ''. - ntable('#e8e8e8'). '
'. ntable("#cccccc",2). - '
Billing
Address		'. - $cust_main->getfield('last'). ', '. $cust_main->first. '
'; - - $html .= $cust_main->company. '
' if $cust_main->company; - $html .= $cust_main->address1. '
'; - $html .= $cust_main->address2. '
' if $cust_main->address2; - $html .= $cust_main->city. ', '. $cust_main->state. ' '. $cust_main->zip. '
'; - $html .= $cust_main->country. '
' - if $cust_main->country && $cust_main->country ne $countrydefault; - - $html .= '
'; - - if ( defined $cust_main->dbdef_table->column('ship_last') ) { - - my $pre = $cust_main->ship_last ? 'ship_' : ''; - - $html .= ''. ntable("#cccccc",2). - 'Service
Address'. - $cust_main->get("${pre}last"). ', '. - $cust_main->get("${pre}first"). '
'; - $html .= $cust_main->get("${pre}company"). '
' - if $cust_main->get("${pre}company"); - $html .= $cust_main->get("${pre}address1"). '
'; - $html .= $cust_main->get("${pre}address2"). '
' - if $cust_main->get("${pre}address2"); - $html .= $cust_main->get("${pre}city"). ', '. - $cust_main->get("${pre}state"). ' '. - $cust_main->get("${pre}ship_zip"). '
'; - $html .= $cust_main->get("${pre}country"). '
' - if $cust_main->get("${pre}country") - && $cust_main->get("${pre}country") ne $countrydefault; - - $html .= ''; - } - - $html .= ''; - - $html; -} - -=back - -=head1 BUGS - -Not OO. - -Not complete. - -small_custview sooooo doesn't belong here. i should just switch to Mason. - -=head1 SEE ALSO - -L, L - -=cut - -1; - - diff --git a/FS/FS/ClientAPI.pm b/FS/FS/ClientAPI.pm deleted file mode 100644 index f7b8eb028..000000000 --- a/FS/FS/ClientAPI.pm +++ /dev/null @@ -1,44 +0,0 @@ -package FS::ClientAPI; - -use strict; -use vars qw(%handler); - -%handler = (); - -#find modules -foreach my $INC ( @INC ) { - foreach my $file ( glob("$INC/FS/ClientAPI/*") ) { - $file =~ /\/(\w+)\.pm$/ or do { - warn "unrecognized ClientAPI file: $file"; - next - }; - my $mod = $1; - #warn "using FS::ClientAPI::$mod"; - eval "use FS::ClientAPI::$mod;"; - die "error using FS::ClientAPI::$mod: $@" if $@; - } -} - -#(sub for modules) -sub register_handlers { - my $self = shift; - my %new_handlers = @_; - foreach my $key ( keys %new_handlers ) { - warn "WARNING: redefining sub $key" if exists $handler{$key}; - #warn "registering $key"; - $handler{$key} = $new_handlers{$key}; - } -} - -#--- - -sub dispatch { - my ( $self, $name ) = ( shift, shift ); - my $sub = $handler{$name} - or die "unknown FS::ClientAPI sub $name (known: ". join(" ", keys %handler ); - #or die "unknown FS::ClientAPI sub $name"; - &{$sub}(@_); -} - -1; - diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm deleted file mode 100644 index 674785524..000000000 --- a/FS/FS/ClientAPI/MyAccount.pm +++ /dev/null @@ -1,136 +0,0 @@ -package FS::ClientAPI::MyAccount; - -use strict; -use vars qw($cache); -use Digest::MD5 qw(md5_hex); -use Date::Format; -use Cache::SharedMemoryCache; #store in db? -use FS::CGI qw(small_custview); #doh -use FS::Conf; -use FS::Record qw(qsearchs); -use FS::svc_acct; -use FS::svc_domain; -use FS::cust_main; -use FS::cust_bill; - -use FS::ClientAPI; #hmm -FS::ClientAPI->register_handlers( - 'MyAccount/login' => \&login, - 'MyAccount/customer_info' => \&customer_info, - 'MyAccount/invoice' => \&invoice, -); - -#store in db? -my $cache = new Cache::SharedMemoryCache(); - -#false laziness w/FS::ClientAPI::passwd::passwd (needs to handle encrypted pw) -sub login { - my $p = shift; - - my $svc_domain = qsearchs('svc_domain', { 'domain' => $p->{'domain'} } ) - or return { error => "Domain not found" }; - - my $svc_acct = - ( length($p->{'password'}) < 13 - && qsearchs( 'svc_acct', { 'username' => $p->{'username'}, - 'domsvc' => $svc_domain->svcnum, - '_password' => $p->{'password'} } ) - ) - || qsearchs( 'svc_acct', { 'username' => $p->{'username'}, - 'domsvc' => $svc_domain->svcnum, - '_password' => $p->{'password'} } ); - - unless ( $svc_acct ) { return { error => 'Incorrect password.' } } - - my $session = { - 'svcnum' => $svc_acct->svcnum, - }; - - my $cust_pkg = $svc_acct->cust_svc->cust_pkg; - if ( $cust_pkg ) { - my $cust_main = $cust_pkg->cust_main; - $session->{'custnum'} = $cust_main->custnum; - } - - my $session_id; - do { - $session_id = md5_hex(md5_hex(time(). {}. rand(). $$)) - } until ( ! defined $cache->get($session_id) ); #just in case - - $cache->set( $session_id, $session, '1 hour' ); - - return { 'error' => '', - 'session_id' => $session_id, - }; -} - -sub customer_info { - my $p = shift; - my $session = $cache->get($p->{'session_id'}) - or return { 'error' => "Can't resume session" }; #better error message - - my %return; - - my $custnum = $session->{'custnum'}; - - if ( $custnum ) { #customer record - - my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ) - or return { 'error' => "unknown custnum $custnum" }; - - $return{balance} = $cust_main->balance; - - my @open = map { - { - invnum => $_->invnum, - date => time2str("%b %o, %Y", $_->_date), - owed => $_->owed, - }; - } $cust_main->open_cust_bill; - $return{open_invoices} = \@open; - - my $conf = new FS::Conf; - $return{small_custview} = - small_custview( $cust_main, $conf->config('defaultcountry') ); - - $return{name} = $cust_main->first. ' '. $cust_main->get('last'); - - } else { #no customer record - - my $svc_acct = qsearchs('svc_acct', { 'svcnum' => $session->{'svcnum'} } ) - or die "unknown svcnum"; - $return{name} = $svc_acct->email; - - } - - - return { 'error' => '', - 'custnum' => $custnum, - %return, - }; - -} - -sub invoice { - my $p = shift; - my $session = $cache->get($p->{'session_id'}) - or return { 'error' => "Can't resume session" }; #better error message - - my $custnum = $session->{'custnum'}; - - my $invnum = $p->{'invnum'}; - - my $cust_bill = qsearchs('cust_bill', { 'invnum' => $invnum, - 'custnum' => $custnum } ) - or return { 'error' => "Can't find invnum" }; - - #my %return; - - return { 'error' => '', - 'invnum' => $invnum, - 'invoice_text' => join('', $cust_bill->print_text ), - }; - -} - - diff --git a/FS/FS/ClientAPI/passwd.pm b/FS/FS/ClientAPI/passwd.pm deleted file mode 100644 index 29606227d..000000000 --- a/FS/FS/ClientAPI/passwd.pm +++ /dev/null @@ -1,56 +0,0 @@ -package FS::ClientAPI::passwd; - -use strict; -use FS::Record qw(qsearchs); -use FS::svc_acct; -#use FS::svc_domain; - -use FS::ClientAPI; #hmm -FS::ClientAPI->register_handlers( - 'passwd/passwd' => \&passwd, - 'passwd/chfn' => \&chfn, - 'passwd/chsh' => \&chsh, -); - -sub passwd { - my $packet = shift; - - #my $domain = qsearchs('svc_domain', { 'domain' => $packet->{'domain'} } ) - # or return { error => "Domain $domain not found" }; - - my $old_password = $packet->{'old_password'}; - my $new_password = $packet->{'new_password'}; - my $new_gecos = $packet->{'new_gecos'}; - my $new_shell = $packet->{'new_shell'}; - -#false laziness w/FS::ClientAPI::MyAccount::login (needs to handle encrypted pw) - my $svc_acct = - ( length($old_password) < 13 - && qsearchs( 'svc_acct', { 'username' => $packet->{'username'}, - #'domsvc' => $svc_domain->svcnum, - '_password' => $old_password } ) - ) - || qsearchs( 'svc_acct', { 'username' => $packet->{'username'}, - #'domsvc' => $svc_domain->svcnum, - '_password' => $old_password } ); - - unless ( $svc_acct ) { return { error => 'Incorrect password.' } } - - my %hash = $svc_acct->hash; - my $new_svc_acct = new FS::svc_acct ( \%hash ); - $new_svc_acct->setfield('_password', $new_password ) - if $new_password && $new_password ne $old_password; - $new_svc_acct->setfield('finger',$new_gecos) if $new_gecos; - $new_svc_acct->setfield('shell',$new_shell) if $new_shell; - my $error = $new_svc_acct->replace($svc_acct); - - return { error => $error }; - -} - -sub chfn {} - -sub chsh {} - -1; - diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm deleted file mode 100644 index e93eaf3fc..000000000 --- a/FS/FS/Conf.pm +++ /dev/null @@ -1,972 +0,0 @@ -package FS::Conf; - -use vars qw($default_dir @config_items $DEBUG ); -use IO::File; -use File::Basename; -use FS::ConfItem; - -$DEBUG = 0; - -=head1 NAME - -FS::Conf - Freeside configuration values - -=head1 SYNOPSIS - - use FS::Conf; - - $conf = new FS::Conf "/config/directory"; - - $FS::Conf::default_dir = "/config/directory"; - $conf = new FS::Conf; - - $dir = $conf->dir; - - $value = $conf->config('key'); - @list = $conf->config('key'); - $bool = $conf->exists('key'); - - $conf->touch('key'); - $conf->set('key' => 'value'); - $conf->delete('key'); - - @config_items = $conf->config_items; - -=head1 DESCRIPTION - -Read and write Freeside configuration values. Keys currently map to filenames, -but this may change in the future. - -=head1 METHODS - -=over 4 - -=item new [ DIRECTORY ] - -Create a new configuration object. A directory arguement is required if -$FS::Conf::default_dir has not been set. - -=cut - -sub new { - my($proto,$dir) = @_; - my($class) = ref($proto) || $proto; - my($self) = { 'dir' => $dir || $default_dir } ; - bless ($self, $class); -} - -=item dir - -Returns the directory. - -=cut - -sub dir { - my($self) = @_; - my $dir = $self->{dir}; - -e $dir or die "FATAL: $dir doesn't exist!"; - -d $dir or die "FATAL: $dir isn't a directory!"; - -r $dir or die "FATAL: Can't read $dir!"; - -x $dir or die "FATAL: $dir not searchable (executable)!"; - $dir =~ /^(.*)$/; - $1; -} - -=item config KEY - -Returns the configuration value or values (depending on context) for key. - -=cut - -sub config { - my($self,$file)=@_; - my($dir)=$self->dir; - my $fh = new IO::File "<$dir/$file" or return; - if ( wantarray ) { - map { - /^(.*)$/ - or die "Illegal line (array context) in $dir/$file:\n$_\n"; - $1; - } <$fh>; - } else { - <$fh> =~ /^(.*)$/ - or die "Illegal line (scalar context) in $dir/$file:\n$_\n"; - $1; - } -} - -=item exists KEY - -Returns true if the specified key exists, even if the corresponding value -is undefined. - -=cut - -sub exists { - my($self,$file)=@_; - my($dir) = $self->dir; - -e "$dir/$file"; -} - -=item touch KEY - -Creates the specified configuration key if it does not exist. - -=cut - -sub touch { - my($self, $file) = @_; - my $dir = $self->dir; - unless ( $self->exists($file) ) { - warn "[FS::Conf] TOUCH $file\n" if $DEBUG; - system('touch', "$dir/$file"); - } -} - -=item set KEY VALUE - -Sets the specified configuration key to the given value. - -=cut - -sub set { - my($self, $file, $value) = @_; - my $dir = $self->dir; - $value =~ /^(.*)$/s; - $value = $1; - unless ( join("\n", @{[ $self->config($file) ]}) eq $value ) { - warn "[FS::Conf] SET $file\n" if $DEBUG; -# warn "$dir" if is_tainted($dir); -# warn "$dir" if is_tainted($file); - chmod 0644, "$dir/$file"; - my $fh = new IO::File ">$dir/$file" or return; - chmod 0644, "$dir/$file"; - print $fh "$value\n"; - } -} -#sub is_tainted { -# return ! eval { join('',@_), kill 0; 1; }; -# } - -=item delete KEY - -Deletes the specified configuration key. - -=cut - -sub delete { - my($self, $file) = @_; - my $dir = $self->dir; - if ( $self->exists($file) ) { - warn "[FS::Conf] DELETE $file\n"; - unlink "$dir/$file"; - } -} - -=item config_items - -Returns all of the possible configuration items as FS::ConfItem objects. See -L. - -=cut - -sub config_items { - my $self = shift; - #quelle kludge - @config_items, - map { - my $basename = basename($_); - $basename =~ /^(.*)$/; - $basename = $1; - new FS::ConfItem { - 'key' => $basename, - 'section' => 'billing', - 'description' => 'Alternate template file for invoices. See the billing documentation for details.', - 'type' => 'textarea', - } - } glob($self->dir. '/invoice_template_*') - ; -} - -=back - -=head1 BUGS - -If this was more than just crud that will never be useful outside Freeside I'd -worry that config_items is freeside-specific and icky. - -=head1 SEE ALSO - -"Configuration" in the web interface (config/config.cgi). - -httemplate/docs/config.html - -=cut - -@config_items = map { new FS::ConfItem $_ } ( - - { - 'key' => 'address', - 'section' => 'deprecated', - 'description' => 'This configuration option is no longer used. See invoice_template instead.', - 'type' => 'text', - }, - - { - 'key' => 'alerter_template', - 'section' => 'billing', - 'description' => 'Template file for billing method expiration alerts. See the billing documentation for details.', - 'type' => 'textarea', - }, - - { - 'key' => 'apacheroot', - 'section' => 'deprecated', - 'description' => 'DEPRECATED, add a www_shellcommands export instead. The directory containing Apache virtual hosts', - 'type' => 'text', - }, - - { - 'key' => 'apacheip', - 'section' => 'apache', - 'description' => 'The current IP address to assign to new virtual hosts', - 'type' => 'text', - }, - - { - 'key' => 'apachemachine', - 'section' => 'deprecated', - 'description' => 'DEPRECATED, add a www_shellcommands export instead. A machine with the apacheroot directory and user home directories. The existance of this file enables setup of virtual host directories, and, in conjunction with the `home\' configuration file, symlinks into user home directories.', - 'type' => 'text', - }, - - { - 'key' => 'apachemachines', - 'section' => 'apache', - 'description' => 'Your Apache machines, one per line. This enables export of `/etc/apache/vhosts.conf\', which can be included in your Apache configuration via the Include directive.', - 'type' => 'textarea', - }, - - { - 'key' => 'bindprimary', - 'section' => 'deprecated', - 'description' => 'DEPRECATED, add a bind export instead. Your BIND primary nameserver. This enables export of /var/named/named.conf and zone files into /var/named', - 'type' => 'text', - }, - - { - 'key' => 'bindsecondaries', - 'section' => 'deprecated', - 'description' => 'DEPRECATED, add a bind_slave export instead. Your BIND secondary nameservers, one per line. This enables export of /var/named/named.conf', - 'type' => 'textarea', - }, - - { - 'key' => 'business-onlinepayment', - 'section' => 'billing', - 'description' => 'Business::OnlinePayment support, at least three lines: processor, login, and password. An optional fourth line specifies the action or actions (multiple actions are separated with `,\': for example: `Authorization Only, Post Authorization\'). Optional additional lines are passed to Business::OnlinePayment as %processor_options.', - 'type' => 'textarea', - }, - - { - 'key' => 'business-onlinepayment-description', - 'section' => 'billing', - 'description' => 'String passed as the description field to Business::OnlinePayment. Evaluated as a double-quoted perl string, with the following variables available: $agent (the agent name), and $pkgs (a comma-separated list of packages to which the invoiced being charged applies)', - 'type' => 'text', - }, - - { - 'key' => 'bsdshellmachines', - 'section' => 'deprecated', - 'description' => 'DEPRECATED, add a bsdshell export instead. Your BSD flavored shell (and mail) machines, one per line. This enables export of `/etc/passwd\' and `/etc/master.passwd\'.', - 'type' => 'textarea', - }, - - { - 'key' => 'countrydefault', - 'section' => 'UI', - 'description' => 'Default two-letter country code (if not supplied, the default is `US\')', - 'type' => 'text', - }, - - { - 'key' => 'cybercash3.2', - 'section' => 'billing', - 'description' => 'CyberCash Cashregister v3.2 support. Two lines: the full path and name of your merchant_conf file, and the transaction type (`mauthonly\' or `mauthcapture\').', - 'type' => 'textarea', - }, - - { - 'key' => 'cyrus', - 'section' => 'deprecated', - 'description' => 'DEPRECATED, add a cyrus export instead. This option used to integrate with Cyrus IMAP Server, three lines: IMAP server, admin username, and admin password. Cyrus::IMAP::Admin should be installed locally and the connection to the server secured.', - 'type' => 'textarea', - }, - - { - 'key' => 'cp_app', - 'section' => 'deprecated', - 'description' => 'DEPRECATED, add a cp export instead. This option used to integrate with Critial Path Account Provisioning Protocol, four lines: "host:port", username, password, and workgroup (for new users).', - 'type' => 'textarea', - }, - - { - 'key' => 'deletecustomers', - 'section' => 'UI', - 'description' => 'Enable customer deletions. Be very careful! Deleting a customer will remove all traces that this customer ever existed! It should probably only be used when auditing a legacy database. Normally, you cancel all of a customers\' packages if they cancel service.', - 'type' => 'checkbox', - }, - - { - 'key' => 'deletepayments', - 'section' => 'UI', - 'description' => 'Enable deletion of unclosed payments. Be very careful! Only delete payments that were data-entry errors, not adjustments. Optionally specify one or more comma-separated email addresses to be notified when a payment is deleted.', - 'type' => [qw( checkbox text )], - }, - - { - 'key' => 'dirhash', - 'section' => 'shell', - 'description' => 'Optional numeric value to control directory hashing. If positive, hashes directories for the specified number of levels from the front of the username. If negative, hashes directories for the specified number of levels from the end of the username. Some examples:

  • 1: user -> /home/u/user
  • 2: user -> /home/u/s/user
  • -1: user -> /home/r/user
  • -2: user -> home/r/e/user
', - 'type' => 'text', - }, - - { - 'key' => 'disable_customer_referrals', - 'section' => 'UI', - 'description' => 'Disable new customer-to-customer referrals in the web interface', - 'type' => 'checkbox', - }, - - { - 'key' => 'domain', - 'section' => 'deprecated', - 'description' => 'Your domain name.', - 'type' => 'text', - }, - - { - 'key' => 'editreferrals', - 'section' => 'UI', - 'description' => 'Enable advertising source modification for existing customers', - 'type' => 'checkbox', - }, - - { - 'key' => 'emailinvoiceonly', - 'section' => 'billing', - 'description' => 'Disables postal mail invoices', - 'type' => 'checkbox', - }, - - { - 'key' => 'disablepostalinvoicedefault', - 'section' => 'billing', - 'description' => 'Disables postal mail invoices as the default option in the UI. Be careful not to setup customers which are not sent invoices. See emailinvoiceauto.', - 'type' => 'checkbox', - }, - - { - 'key' => 'emailinvoiceauto', - 'section' => 'billing', - 'description' => 'Automatically adds new accounts to the email invoice list upon customer creation', - 'type' => 'checkbox', - }, - - { - 'key' => 'erpcdmachines', - 'section' => '', - 'description' => 'Your ERPCD authenticaion machines, one per line. This enables export of `/usr/annex/acp_passwd\' and `/usr/annex/acp_dialup\'', - 'type' => 'textarea', - }, - - { - 'key' => 'hidecancelledpackages', - 'section' => 'UI', - 'description' => 'Prevent cancelled packages from showing up in listings (though they will still be in the database)', - 'type' => 'checkbox', - }, - - { - 'key' => 'hidecancelledcustomers', - 'section' => 'UI', - 'description' => 'Prevent customers with only cancelled packages from showing up in listings (though they will still be in the database)', - 'type' => 'checkbox', - }, - - { - 'key' => 'home', - 'section' => 'required', - 'description' => 'For new users, prefixed to username to create a directory name. Should have a leading but not a trailing slash.', - 'type' => 'text', - }, - - { - 'key' => 'icradiusmachines', - 'section' => 'deprecated', - 'description' => 'DEPRECATED, add an sqlradius export instead. This option used to enable radcheck and radreply table population - by default in the Freeside database, or in the database specified by the icradius_secrets config option (the radcheck and radreply tables needs to be created manually). You do not need to use MySQL for your Freeside database to export to an ICRADIUS/FreeRADIUS MySQL database with this option.
ADDITIONAL DEPRECATED FUNCTIONALITY (instead use MySQL replication or point icradius_secrets to the external database) - your ICRADIUS machines or FreeRADIUS (with MySQL authentication) machines, one per line. Machines listed in this file will have the radcheck table exported to them. Each line should contain four items, separted by whitespace: machine name, MySQL database name, MySQL username, and MySQL password. For example: "radius.isp.tld radius_db radius_user passw0rd"
', - 'type' => [qw( checkbox textarea )], - }, - - { - 'key' => 'icradius_mysqldest', - 'section' => 'deprecated', - 'description' => 'DEPRECATED, add an sqlradius https://billing.crosswind.net/freeside/browse/part_export.cgi">export instead. Used to be the destination directory for the MySQL databases, on the ICRADIUS/FreeRADIUS machines. Defaults to "/usr/local/var/".', - 'type' => 'text', - }, - - { - 'key' => 'icradius_mysqlsource', - 'section' => 'deprecated', - 'description' => 'DEPRECATED, add an sqlradius https://billing.crosswind.net/freeside/browse/part_export.cgi">export instead. Used to be the source directory for for the MySQL radcheck table files, on the Freeside machine. Defaults to "/usr/local/var/freeside".', - 'type' => 'text', - }, - - { - 'key' => 'icradius_secrets', - 'section' => 'deprecated', - 'description' => 'DEPRECATED, add an sqlradius https://billing.crosswind.net/freeside/browse/part_export.cgi">export instead. This option used to specify a database for ICRADIUS/FreeRADIUS export. Three lines: DBI data source, username and password.', - 'type' => 'textarea', - }, - - { - 'key' => 'invoice_from', - 'section' => 'required', - 'description' => 'Return address on email invoices', - 'type' => 'text', - }, - - { - 'key' => 'invoice_template', - 'section' => 'required', - 'description' => 'Required template file for invoices. See the billing documentation for details.', - 'type' => 'textarea', - }, - - { - 'key' => 'lpr', - 'section' => 'required', - 'description' => 'Print command for paper invoices, for example `lpr -h\'', - 'type' => 'text', - }, - - { - 'key' => 'maildisablecatchall', - 'section' => 'deprecated', - 'description' => 'DEPRECATED, now the default. Turning this option on used to disable the requirement that each virtual domain have a catch-all mailbox.', - 'type' => 'checkbox', - }, - - { - 'key' => 'money_char', - 'section' => '', - 'description' => 'Currency symbol - defaults to `$\'', - 'type' => 'text', - }, - - { - 'key' => 'mxmachines', - 'section' => 'deprecated', - 'description' => 'MX entries for new domains, weight and machine, one per line, with trailing `.\'', - 'type' => 'textarea', - }, - - { - 'key' => 'nsmachines', - 'section' => 'deprecated', - 'description' => 'NS nameservers for new domains, one per line, with trailing `.\'', - 'type' => 'textarea', - }, - - { - 'key' => 'defaultrecords', - 'section' => 'BIND', - 'description' => 'DNS entries to add automatically when creating a domain', - 'type' => 'editlist', - 'editlist_parts' => [ { type=>'text' }, - { type=>'immutable', value=>'IN' }, - { type=>'select', - select_enum=>{ map { $_=>$_ } qw(A CNAME MX NS)} }, - { type=> 'text' }, ], - }, - - { - 'key' => 'arecords', - 'section' => 'deprecated', - 'description' => 'A list of tab seperated CNAME records to add automatically when creating a domain', - 'type' => 'textarea', - }, - - { - 'key' => 'cnamerecords', - 'section' => 'deprecated', - 'description' => 'A list of tab seperated CNAME records to add automatically when creating a domain', - 'type' => 'textarea', - }, - - { - 'key' => 'nismachines', - 'section' => 'deprecated', - 'description' => 'DEPRECATED. Your NIS master (not slave master) machines, one per line. This enables export of `/etc/global/passwd\' and `/etc/global/shadow\'.', - 'type' => 'textarea', - }, - - { - 'key' => 'passwordmin', - 'section' => 'password', - 'description' => 'Minimum password length (default 6)', - 'type' => 'text', - }, - - { - 'key' => 'passwordmax', - 'section' => 'password', - 'description' => 'Maximum password length (default 8) (don\'t set this over 12 if you need to import or export crypt() passwords)', - 'type' => 'text', - }, - - { - 'key' => 'qmailmachines', - 'section' => 'mail', - 'description' => 'Your qmail machines, one per line. This enables export of `/var/qmail/control/virtualdomains\', `/var/qmail/control/recipientmap\', and `/var/qmail/control/rcpthosts\'. Setting this option (even if empty) also turns on user `.qmail-extension\' file maintenance in conjunction with the shellmachine option.', - 'type' => [qw( checkbox textarea )], - }, - - { - 'key' => 'radiusmachines', - 'section' => 'deprecated', - 'description' => 'DEPRECATED, add an sqlradius export instead. This option used to export to be: your RADIUS authentication machines, one per line. This enables export of `/etc/raddb/users\'.', - 'type' => 'textarea', - }, - - { - 'key' => 'referraldefault', - 'section' => 'UI', - 'description' => 'Default referral, specified by refnum', - 'type' => 'text', - }, - -# { -# 'key' => 'registries', -# 'section' => 'required', -# 'description' => 'Directory which contains domain registry information. Each registry is a directory.', -# }, - - { - 'key' => 'report_template', - 'section' => 'required', - 'description' => 'Required template file for reports. See the billing documentation for details.', - 'type' => 'textarea', - }, - - - { - 'key' => 'maxsearchrecordsperpage', - 'section' => 'UI', - 'description' => 'If set, number of search records to return per page.', - 'type' => 'text', - }, - - { - 'key' => 'sendmailconfigpath', - 'section' => 'mail', - 'description' => 'Sendmail configuration file path. Defaults to `/etc\'. Many newer distributions use `/etc/mail\'.', - 'type' => 'text', - }, - - { - 'key' => 'sendmailmachines', - 'section' => 'mail', - 'description' => 'Your sendmail machines, one per line. This enables export of `/etc/virtusertable\' and `/etc/sendmail.cw\'.', - 'type' => 'textarea', - }, - - { - 'key' => 'sendmailrestart', - 'section' => 'mail', - 'description' => 'If defined, the command which is run on sendmail machines after files are copied.', - 'type' => 'text', - }, - - { - 'key' => 'session-start', - 'section' => 'session', - 'description' => 'If defined, the command which is executed on the Freeside machine when a session begins. The contents of the file are treated as a double-quoted perl string, with the following variables available: $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.', - 'type' => 'text', - }, - - { - 'key' => 'session-stop', - 'section' => 'session', - 'description' => 'If defined, the command which is executed on the Freeside machine when a session ends. The contents of the file are treated as a double-quoted perl string, with the following variables available: $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.', - 'type' => 'text', - }, - - { - 'key' => 'shellmachine', - 'section' => 'deprecated', - 'description' => 'DEPRECATED, add a shellcommands export instead. This option used to contain a single machine with user home directories mounted. This enables home directory creation, renaming and archiving/deletion. In conjunction with `qmailmachines\', it also enables `.qmail-extension\' file maintenance.', - 'type' => 'text', - }, - - { - 'key' => 'shellmachine-useradd', - 'section' => 'deprecated', - 'description' => 'DEPRECATED, add a shellcommands export instead. This option used to contain command(s) to run on shellmachine when an account is created. If the shellmachine option is set but this option is not, useradd -d $dir -m -s $shell -u $uid $username is the default. If this option is set but empty, cp -pr /etc/skel $dir; chown -R $uid.$gid $dir is the default instead. Otherwise the value is evaluated as a double-quoted perl string, with the following variables available: $username, $uid, $gid, $dir, and $shell.', - 'type' => [qw( checkbox text )], - }, - - { - 'key' => 'shellmachine-userdel', - 'section' => 'deprecated', - 'description' => 'DEPRECATED, add a shellcommands export instead. This option used to contain command(s) to run on shellmachine when an account is deleted. If the shellmachine option is set but this option is not, userdel $username is the default. If this option is set but empty, rm -rf $dir is the default instead. Otherwise the value is evaluated as a double-quoted perl string, with the following variables available: $username and $dir.', - 'type' => [qw( checkbox text )], - }, - - { - 'key' => 'shellmachine-usermod', - 'section' => 'deprecated', - 'description' => 'DEPRECATED, add a shellcommands export instead. This option used to contain command(s) to run on shellmachine when an account is modified. If the shellmachine option is set but this option 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.', - #'type' => [qw( checkbox text )], - 'type' => 'text', - }, - - { - 'key' => 'shellmachines', - 'section' => 'deprecated', - 'description' => 'DEPRECATED, add a sysvshell export instead. Your Linux and System V flavored shell (and mail) machines, one per line. This enables export of `/etc/passwd\' and `/etc/shadow\' files.', - 'type' => 'textarea', - }, - - { - 'key' => 'shells', - 'section' => 'required', - 'description' => 'Legal shells (think /etc/shells). You probably want to `cut -d: -f7 /etc/passwd | sort | uniq\' initially so that importing doesn\'t fail with `Illegal shell\' errors, then remove any special entries afterwords. A blank line specifies that an empty shell is permitted.', - 'type' => 'textarea', - }, - - { - 'key' => 'showpasswords', - 'section' => 'UI', - 'description' => 'Display unencrypted user passwords in the web interface', - 'type' => 'checkbox', - }, - - { - 'key' => 'signupurl', - 'section' => 'UI', - 'description' => 'if you are using customer-to-customer referrals, and you enter the URL of your signup server CGI, the customer view screen will display a customized link to the signup server with the appropriate customer as referral', - 'type' => 'text', - }, - - { - 'key' => 'smtpmachine', - 'section' => 'required', - 'description' => 'SMTP relay for Freeside\'s outgoing mail', - 'type' => 'text', - }, - - { - 'key' => 'soadefaultttl', - 'section' => 'BIND', - 'description' => 'SOA default TTL for new domains.', - 'type' => 'text', - }, - - { - 'key' => 'soaemail', - 'section' => 'BIND', - 'description' => 'SOA email for new domains, in BIND form (`.\' instead of `@\'), with trailing `.\'', - 'type' => 'text', - }, - - { - 'key' => 'soaexpire', - 'section' => 'BIND', - 'description' => 'SOA expire for new domains', - 'type' => 'text', - }, - - { - 'key' => 'soamachine', - 'section' => 'BIND', - 'description' => 'SOA machine for new domains, with trailing `.\'', - 'type' => 'text', - }, - - { - 'key' => 'soarefresh', - 'section' => 'BIND', - 'description' => 'SOA refresh for new domains', - 'type' => 'text', - }, - - { - 'key' => 'soaretry', - 'section' => 'BIND', - 'description' => 'SOA retry for new domains', - 'type' => 'text', - }, - - { - 'key' => 'statedefault', - 'section' => 'UI', - 'description' => 'Default state or province (if not supplied, the default is `CA\')', - 'type' => 'text', - }, - - { - 'key' => 'radiusprepend', - 'section' => 'deprecated', - 'description' => 'DEPRECATED, real-time text radius now edits an existing file in place - just (turn off freeside-queued and) edit your RADIUS users file directly. The contents used to be be prepended to the top of the RADIUS users file (text exports only).', - 'type' => 'textarea', - }, - - { - 'key' => 'textradiusprepend', - 'section' => 'deprecated', - 'description' => 'DEPRECATED, use RADIUS check attributes instead. The contents used to be prepended to the first line of a user\'s RADIUS entry in text exports.', - 'type' => 'text', - }, - - { - 'key' => 'unsuspendauto', - 'section' => 'billing', - 'description' => 'Enables the automatic unsuspension of suspended packages when a customer\'s balance due changes from positive to zero or negative as the result of a payment or credit', - 'type' => 'checkbox', - }, - - { - 'key' => 'usernamemin', - 'section' => 'username', - 'description' => 'Minimum username length (default 2)', - 'type' => 'text', - }, - - { - 'key' => 'usernamemax', - 'section' => 'username', - 'description' => 'Maximum username length', - 'type' => 'text', - }, - - { - 'key' => 'username-ampersand', - 'section' => 'username', - 'description' => 'Allow the ampersand character (&) in usernames. Be careful when using this option in conjunction with shellmachine-useradd and other configuration options which execute shell commands, as the ampersand will be interpreted by the shell if not quoted.', - 'type' => 'checkbox', - }, - - { - 'key' => 'username-letter', - 'section' => 'username', - 'description' => 'Usernames must contain at least one letter', - 'type' => 'checkbox', - }, - - { - 'key' => 'username-letterfirst', - 'section' => 'username', - 'description' => 'Usernames must start with a letter', - 'type' => 'checkbox', - }, - - { - 'key' => 'username-noperiod', - 'section' => 'username', - 'description' => 'Disallow periods in usernames', - 'type' => 'checkbox', - }, - - { - 'key' => 'username-nounderscore', - 'section' => 'username', - 'description' => 'Disallow underscores in usernames', - 'type' => 'checkbox', - }, - - { - 'key' => 'username-nodash', - 'section' => 'username', - 'description' => 'Disallow dashes in usernames', - 'type' => 'checkbox', - }, - - { - 'key' => 'username-uppercase', - 'section' => 'username', - 'description' => 'Allow uppercase characters in usernames', - 'type' => 'checkbox', - }, - - { - 'key' => 'username_policy', - 'section' => '', - 'description' => 'This file controls the mechanism for preventing duplicate usernames in passwd/radius files exported from svc_accts. This should be one of \'prepend domsvc\' \'append domsvc\' \'append domain\' or \'append @domain\'', - 'type' => 'select', - 'select_enum' => [ 'prepend domsvc', 'append domsvc', 'append domain', 'append @domain' ], - #'type' => 'text', - }, - - { - 'key' => 'vpopmailmachines', - 'section' => 'deprecated', - 'description' => 'DEPRECATED, add a cp export instead. This option used to contain your vpopmail pop toasters, one per line. Each line is of the form "machinename vpopdir vpopuid vpopgid". For example: poptoaster.domain.tld /home/vpopmail 508 508 Note: vpopuid and vpopgid are values taken from the vpopmail machine\'s /etc/passwd', - 'type' => 'textarea', - }, - - { - 'key' => 'vpopmailrestart', - 'section' => 'mail', - 'description' => 'If defined, the shell commands to run on vpopmail machines after files are copied. An example can be found in eg/vpopmailrestart of the source distribution.', - 'type' => 'textarea', - }, - - { - 'key' => 'safe-part_pkg', - 'section' => 'UI', - 'description' => 'Validates package definition setup and recur expressions against a preset list. Useful for webdemos, annoying to powerusers.', - 'type' => 'checkbox', - }, - - { - 'key' => 'safe-part_bill_event', - 'section' => 'UI', - 'description' => 'Validates invoice event expressions against a preset list. Useful for webdemos, annoying to powerusers.', - 'type' => 'checkbox', - }, - - { - 'key' => 'show_ss', - 'section' => 'UI', - 'description' => 'Turns on display/collection of SS# in the web interface.', - 'type' => 'checkbox', - }, - - { - 'key' => 'agent_defaultpkg', - 'section' => 'UI', - 'description' => 'Setting this option will cause new packages to be available to all agent types by default.', - 'type' => 'checkbox', - }, - - { - 'key' => 'legacy_link', - 'section' => 'UI', - 'description' => 'Display options in the web interface to link legacy pre-Freeside services.', - 'type' => 'checkbox', - }, - - { - 'key' => 'queue_dangerous_controls', - 'section' => 'UI', - 'description' => 'Enable queue modification controls on account pages and for new jobs. Unless you are a developer working on new export code, you should probably leave this off to avoid causing provisioning problems.', - 'type' => 'checkbox', - }, - - { - 'key' => 'security_phrase', - 'section' => 'password', - 'description' => 'Enable the tracking of a "security phrase" with each account. Not recommended, as it is vulnerable to social engineering.', - 'type' => 'checkbox', - }, - - { - 'key' => 'locale', - 'section' => 'UI', - 'description' => 'Message locale', - 'type' => 'select', - 'select_enum' => [ qw(en_US) ], - }, - - { - 'key' => 'signup_server-payby', - 'section' => '', - 'description' => 'Acceptable payment types for the signup server', - 'type' => 'selectmultiple', - 'select_enum' => [ qw(CARD PREPAY BILL COMP) ], - }, - - { - 'key' => 'signup_server-email', - 'section' => '', - 'description' => 'Comma-separated list of email addresses to receive notification of signups via the signup server.', - 'type' => 'text', - }, - - - { - 'key' => 'show-msgcat-codes', - 'section' => 'UI', - 'description' => 'Show msgcat codes in error messages. Turn this option on before reporting errors to the mailing list.', - 'type' => 'checkbox', - }, - - { - 'key' => 'signup_server-realtime', - 'section' => '', - 'description' => 'Run billing for signup server signups immediately, and suspend accounts which subsequently have a balance.', - 'type' => 'checkbox', - }, - - { - 'key' => 'declinetemplate', - 'section' => 'billing', - 'description' => 'Template file for credit card decline emails.', - 'type' => 'textarea', - }, - - { - 'key' => 'emaildecline', - 'section' => 'billing', - 'description' => 'Enable emailing of credit card decline notices.', - 'type' => 'checkbox', - }, - - { - 'key' => 'require_cardname', - 'section' => 'billing', - 'description' => 'Require an "Exact name on card" to be entered explicitly; don\'t default to using the first and last name.', - 'type' => 'checkbox', - }, - - { - 'key' => 'enable_taxclasses', - 'section' => 'billing', - 'description' => 'Enable per-package tax classes', - 'type' => 'checkbox', - }, - - { - 'key' => 'welcome_email', - 'section' => '', - 'description' => 'Template file for welcome email. Welcome emails are sent to the customer email invoice destination(s) each time a svc_acct record is created. See the Text::Template documentation for details on the template substitution language. The following variables are available: $username, $password, $first, $last and $pkg.', - 'type' => 'textarea', - }, - - { - 'key' => 'welcome_email-from', - 'section' => '', - 'description' => 'From: address header for welcome email', - 'type' => 'text', - }, - - { - 'key' => 'welcome_email-subject', - 'section' => '', - 'description' => 'Subject: header for welcome email', - 'type' => 'text', - }, - - { - 'key' => 'welcome_email-mimetype', - 'section' => '', - 'description' => 'MIME type for welcome email', - 'type' => 'select', - 'select_enum' => [ 'text/plain', 'text/html' ], - }, - -); - -1; - diff --git a/FS/FS/ConfItem.pm b/FS/FS/ConfItem.pm deleted file mode 100644 index 83295b4fa..000000000 --- a/FS/FS/ConfItem.pm +++ /dev/null @@ -1,63 +0,0 @@ -package FS::ConfItem; - -=head1 NAME - -FS::ConfItem - Configutaion option meta-data. - -=head1 SYNOPSIS - - use FS::Conf; - @config_items = $conf->config_items; - - foreach $item ( @config_items ) { - $key = $item->key; - $section = $item->section; - $description = $item->description; - } - -=head1 DESCRIPTION - -=head1 METHODS - -=over 4 - -=item new - -=cut - -sub new { - my $proto = shift; - my $class = ref($proto) || $proto; - my $self = @_ ? shift : {}; - bless ($self, $class); -} - -=item key - -=item section - -=item description - -=cut - -sub AUTOLOAD { - my $self = shift; - my $field = $AUTOLOAD; - $field =~ s/.*://; - $self->{$field}; -} - -=back - -=head1 BUGS - -Terse docs. - -=head1 SEE ALSO - -L - -=cut - -1; - diff --git a/FS/FS/InitHandler.pm b/FS/FS/InitHandler.pm deleted file mode 100644 index 87f507c22..000000000 --- a/FS/FS/InitHandler.pm +++ /dev/null @@ -1,88 +0,0 @@ -package FS::InitHandler; - -use strict; -use vars qw($DEBUG); -use FS::UID qw(adminsuidsetup); -use FS::Record; - -$DEBUG = 1; - -sub handler { - - use Date::Format; - use Date::Parse; - use Tie::IxHash; - use HTML::Entities; - use IO::Handle; - use IO::File; - use String::Approx; - use HTML::Widgets::SelectLayers 0.02; - #use FS::UID; - #use FS::Record; - use FS::Conf; - use FS::CGI; - use FS::Msgcat; - - use FS::agent; - use FS::agent_type; - use FS::domain_record; - use FS::cust_bill; - use FS::cust_bill_pay; - use FS::cust_credit; - use FS::cust_credit_bill; - use FS::cust_main; - use FS::cust_main_county; - use FS::cust_pay; - use FS::cust_pkg; - use FS::cust_refund; - use FS::cust_svc; - use FS::nas; - use FS::part_bill_event; - use FS::part_pkg; - use FS::part_referral; - use FS::part_svc; - use FS::pkg_svc; - use FS::port; - use FS::queue; - use FS::raddb; - use FS::session; - use FS::svc_acct; - use FS::svc_acct_pop; - use FS::svc_acct_sm; - use FS::svc_domain; - use FS::svc_forward; - use FS::svc_www; - use FS::type_pkgs; - use FS::part_export; - use FS::part_export_option; - use FS::export_svc; - use FS::msgcat; - - warn "[FS::InitHandler] handler called\n" if $DEBUG; - - #this is sure to be broken on freebsd - $> = $FS::UID::freeside_uid; - - open(MAPSECRETS,"<$FS::UID::conf_dir/mapsecrets") - or die "can't read $FS::UID::conf_dir/mapsecrets: $!"; - - my %seen; - while () { - next if /^\s*(#|$)/; - /^([\w\-\.]+)\s(.*)$/ - or do { warn "strange line in mapsecrets: $_"; next; }; - my($user, $datasrc) = ($1, $2); - next if $seen{$datasrc}++; - warn "[FS::InitHandler] preloading $datasrc for $user\n" if $DEBUG; - adminsuidsetup($user); - } - - close MAPSECRETS; - - #lalala probably broken on freebsd - ($<, $>) = ($>, $<); - $< = 0; - -} - -1; diff --git a/FS/FS/Msgcat.pm b/FS/FS/Msgcat.pm deleted file mode 100644 index 625743dc0..000000000 --- a/FS/FS/Msgcat.pm +++ /dev/null @@ -1,98 +0,0 @@ -package FS::Msgcat; - -use strict; -use vars qw( @ISA @EXPORT_OK $conf $locale $debug ); -use Exporter; -use FS::UID; -#use FS::Record qw( qsearchs ); # wtf? won't import... -use FS::Record; -use FS::Conf; -use FS::msgcat; - -@ISA = qw(Exporter); -@EXPORT_OK = qw( gettext geterror ); - -$FS::UID::callback{'Msgcat'} = sub { - $conf = new FS::Conf; - $locale = $conf->config('locale') || 'en_US'; - $debug = $conf->exists('show-msgcat-codes') -}; - -=head1 NAME - -FS::Msgcat - Message catalog functions - -=head1 SYNOPSIS - - use FS::Msgcat qw(gettext geterror); - - #simple interface for retreiving messages... - $message = gettext('msgcode'); - #or errors (includes the error code) - $message = geterror('msgcode'); - -=head1 DESCRIPTION - -FS::Msgcat provides functions to use the message catalog. If you want to -maintain the message catalog database, see L instead. - -=head1 SUBROUTINES - -=over 4 - -=item gettext MSGCODE - -Returns the full message for the supplied message code. - -=cut - -sub gettext { - $debug ? geterror(@_) : _gettext(@_); -} - -sub _gettext { - my $msgcode = shift; - my $msgcat = FS::Record::qsearchs('msgcat', { - 'msgcode' => $msgcode, - 'locale' => $locale - } ); - if ( $msgcat ) { - $msgcat->msg; - } else { - warn "WARNING: message for msgcode $msgcode in locale $locale not found"; - $msgcode; - } - -} - -=item geterror MSGCODE - -Returns the full message for the supplied message code, including the message -code. - -=cut - -sub geterror { - my $msgcode = shift; - my $msg = _gettext($msgcode); - if ( $msg eq $msgcode ) { - "Error code $msgcode (message for locale $locale not found)"; - } else { - "$msg (error code $msgcode)"; - } -} - -=back - -=head1 BUGS - -i18n/l10n, eek - -=head1 SEE ALSO - -L, L, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm deleted file mode 100644 index e6126a13b..000000000 --- a/FS/FS/Record.pm +++ /dev/null @@ -1,1258 +0,0 @@ -package FS::Record; - -use strict; -use vars qw( $dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK $DEBUG - $me %dbdef_cache ); -use subs qw(reload_dbdef); -use Exporter; -use Carp qw(carp cluck croak confess); -use File::CounterFile; -use Locale::Country; -use DBI qw(:sql_types); -use DBIx::DBSchema 0.19; -use FS::UID qw(dbh checkruid getotaker datasrc driver_name); -use FS::SearchCache; -use FS::Msgcat qw(gettext); - -@ISA = qw(Exporter); -@EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef jsearch); - -$DEBUG = 0; -$me = '[FS::Record]'; - -#ask FS::UID to run this stuff for us later -$FS::UID::callback{'FS::Record'} = sub { - $File::CounterFile::DEFAULT_DIR = "/usr/local/etc/freeside/counters.". datasrc; - $dbdef_file = "/usr/local/etc/freeside/dbdef.". datasrc; - &reload_dbdef unless $setup_hack; #$setup_hack needed now? -}; - -=head1 NAME - -FS::Record - Database record objects - -=head1 SYNOPSIS - - use FS::Record; - use FS::Record qw(dbh fields qsearch qsearchs dbdef); - - $record = new FS::Record 'table', \%hash; - $record = new FS::Record 'table', { 'column' => 'value', ... }; - - $record = qsearchs FS::Record 'table', \%hash; - $record = qsearchs FS::Record 'table', { 'column' => 'value', ... }; - @records = qsearch FS::Record 'table', \%hash; - @records = qsearch FS::Record 'table', { 'column' => 'value', ... }; - - $table = $record->table; - $dbdef_table = $record->dbdef_table; - - $value = $record->get('column'); - $value = $record->getfield('column'); - $value = $record->column; - - $record->set( 'column' => 'value' ); - $record->setfield( 'column' => 'value' ); - $record->column('value'); - - %hash = $record->hash; - - $hashref = $record->hashref; - - $error = $record->insert; - #$error = $record->add; #deprecated - - $error = $record->delete; - #$error = $record->del; #deprecated - - $error = $new_record->replace($old_record); - #$error = $new_record->rep($old_record); #deprecated - - $value = $record->unique('column'); - - $error = $record->ut_float('column'); - $error = $record->ut_number('column'); - $error = $record->ut_numbern('column'); - $error = $record->ut_money('column'); - $error = $record->ut_text('column'); - $error = $record->ut_textn('column'); - $error = $record->ut_alpha('column'); - $error = $record->ut_alphan('column'); - $error = $record->ut_phonen('column'); - $error = $record->ut_anything('column'); - $error = $record->ut_name('column'); - - $dbdef = reload_dbdef; - $dbdef = reload_dbdef "/non/standard/filename"; - $dbdef = dbdef; - - $quoted_value = _quote($value,'table','field'); - - #depriciated - $fields = hfields('table'); - if ( $fields->{Field} ) { # etc. - - @fields = fields 'table'; #as a subroutine - @fields = $record->fields; #as a method call - - -=head1 DESCRIPTION - -(Mostly) object-oriented interface to database records. Records are currently -implemented on top of DBI. FS::Record is intended as a base class for -table-specific classes to inherit from, i.e. FS::cust_main. - -=head1 CONSTRUCTORS - -=over 4 - -=item new [ TABLE, ] HASHREF - -Creates a new record. It doesn't store it in the database, though. See -L<"insert"> for that. - -Note that the object stores this hash reference, not a distinct copy of the -hash it points to. You can ask the object for a copy with the I -method. - -TABLE can only be omitted when a dervived class overrides the table method. - -=cut - -sub new { - my $proto = shift; - my $class = ref($proto) || $proto; - my $self = {}; - bless ($self, $class); - - unless ( defined ( $self->table ) ) { - $self->{'Table'} = shift; - carp "warning: FS::Record::new called with table name ". $self->{'Table'}; - } - - my $hashref = $self->{'Hash'} = shift; - - foreach my $field ( grep !defined($hashref->{$_}), $self->fields ) { - $hashref->{$field}=''; - } - - $self->_cache($hashref, shift) if $self->can('_cache') && @_; - - $self; -} - -sub new_or_cached { - my $proto = shift; - my $class = ref($proto) || $proto; - my $self = {}; - bless ($self, $class); - - $self->{'Table'} = shift unless defined ( $self->table ); - - my $hashref = $self->{'Hash'} = shift; - my $cache = shift; - if ( defined( $cache->cache->{$hashref->{$cache->key}} ) ) { - my $obj = $cache->cache->{$hashref->{$cache->key}}; - $obj->_cache($hashref, $cache) if $obj->can('_cache'); - $obj; - } else { - $cache->cache->{$hashref->{$cache->key}} = $self->new($hashref, $cache); - } - -} - -sub create { - my $proto = shift; - my $class = ref($proto) || $proto; - my $self = {}; - bless ($self, $class); - if ( defined $self->table ) { - cluck "create constructor is depriciated, use new!"; - $self->new(@_); - } else { - croak "FS::Record::create called (not from a subclass)!"; - } -} - -=item qsearch TABLE, HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ - -Searches the database for all records matching (at least) the key/value pairs -in HASHREF. Returns all the records found as `FS::TABLE' objects if that -module is loaded (i.e. via `use FS::cust_main;'), otherwise returns FS::Record -objects. - -###oops, argh, FS::Record::new only lets us create database fields. -#Normal behaviour if SELECT is not specified is `*', as in -#C!; - $county_html .= ''; - } else { - $county_html .= - qq!!; - } - - my $state_html = qq!'; - - $state_html .= ''; - - my $country_html = qq!'; - - ($county_html, $state_html, $country_html); - -} - -=back - -=head1 BUGS - -regionselector? putting web ui components in here? they should probably live -somewhere else... - -=head1 SEE ALSO - -L, L, L, schema.html from the base -documentation. - -=cut - -1; - diff --git a/FS/FS/cust_main_invoice.pm b/FS/FS/cust_main_invoice.pm deleted file mode 100644 index a5533a088..000000000 --- a/FS/FS/cust_main_invoice.pm +++ /dev/null @@ -1,184 +0,0 @@ -package FS::cust_main_invoice; - -use strict; -use vars qw(@ISA $conf); -use Exporter; -use FS::Record qw( qsearchs ); -use FS::Conf; -use FS::cust_main; -use FS::svc_acct; -use FS::Msgcat qw(gettext); - -@ISA = qw( FS::Record ); - -=head1 NAME - -FS::cust_main_invoice - Object methods for cust_main_invoice records - -=head1 SYNOPSIS - - use FS::cust_main_invoice; - - $record = new FS::cust_main_invoice \%hash; - $record = new FS::cust_main_invoice { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - - $email_address = $record->address; - -=head1 DESCRIPTION - -An FS::cust_main_invoice object represents an invoice destination. FS::cust_main_invoice inherits from -FS::Record. The following fields are currently supported: - -=over 4 - -=item destnum - primary key - -=item custnum - customer (see L) - -=item dest - Invoice destination: If numeric, a svcnum (see L), if string, a literal email address, or `POST' to enable mailing (the default if no cust_main_invoice records exist) - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new invoice destination. To add the invoice destination to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I method. - -=cut - -sub table { 'cust_main_invoice'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=item delete - -Delete this record from the database. - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -sub replace { - my ( $new, $old ) = ( shift, shift ); - - return "Can't change custnum!" unless $old->custnum == $new->custnum; - - $new->SUPER::replace($old); -} - - -=item check - -Checks all fields to make sure this is a valid invoice destination. If there is -an error, returns the error, otherwise returns false. Called by the insert -and repalce methods. - -=cut - -sub check { - my $self = shift; - - my $error = $self->ut_numbern('destnum') - || $self->ut_number('custnum') - || $self->checkdest; - ; - return $error if $error; - - return "Unknown customer" - unless qsearchs('cust_main',{ 'custnum' => $self->custnum }); - - ''; #noerror -} - -=item checkdest - -Checks the dest field only. - -#If it finds that the account ends in the -#same domain configured as the B configuration file, it will change the -#invoice destination from an email address to a service number (see -#L). - -=cut - -sub checkdest { - my $self = shift; - - my $error = $self->ut_text('dest'); - return $error if $error; - - if ( $self->dest eq 'POST' ) { - #contemplate our navel - } elsif ( $self->dest =~ /^(\d+)$/ ) { - return "Unknown local account (specified by svcnum: ". $self->dest. ")" - unless qsearchs( 'svc_acct', { 'svcnum' => $self->dest } ); - } elsif ( $self->dest =~ /^([\w\.\-\&\+]+)\@(([\w\.\-]+\.)+\w+)$/ ) { - my($user, $domain) = ($1, $2); -# if ( $domain eq $mydomain ) { -# my $svc_acct = qsearchs( 'svc_acct', { 'username' => $user } ); -# return "Unknown local account: $user\@$domain (specified literally)" -# unless $svc_acct; -# $svc_acct->svcnum =~ /^(\d+)$/ or die "Non-numeric svcnum?!"; -# $self->dest($1); -# } - $self->dest("$1\@$2"); - } else { - return gettext("illegal_email_invoice_address"); - } - - ''; #no error -} - -=item address - -Returns the literal email address for this record (or `POST'). - -=cut - -sub address { - my $self = shift; - if ( $self->dest =~ /^(\d+)$/ ) { - my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $1 } ) - or return undef; - $svc_acct->email; - } else { - $self->dest; - } -} - -=back - -=head1 VERSION - -$Id: cust_main_invoice.pm,v 1.12 2002-04-12 13:22:02 ivan Exp $ - -=head1 BUGS - -=head1 SEE ALSO - -L, L - -=cut - -1; - diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm deleted file mode 100644 index 98eba704b..000000000 --- a/FS/FS/cust_pay.pm +++ /dev/null @@ -1,422 +0,0 @@ -package FS::cust_pay; - -use strict; -use vars qw( @ISA $conf $unsuspendauto $smtpmachine $invoice_from ); -use Date::Format; -use Mail::Header; -use Mail::Internet 1.44; -use Business::CreditCard; -use FS::UID qw( dbh ); -use FS::Record qw( dbh qsearch qsearchs dbh ); -use FS::cust_bill; -use FS::cust_bill_pay; -use FS::cust_main; - -@ISA = qw( FS::Record ); - -#ask FS::UID to run this stuff for us later -$FS::UID::callback{'FS::cust_pay'} = sub { - - $conf = new FS::Conf; - $unsuspendauto = $conf->exists('unsuspendauto'); - $smtpmachine = $conf->config('smtpmachine'); - $invoice_from = $conf->config('invoice_from'); - -}; - -=head1 NAME - -FS::cust_pay - Object methods for cust_pay objects - -=head1 SYNOPSIS - - use FS::cust_pay; - - $record = new FS::cust_pay \%hash; - $record = new FS::cust_pay { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::cust_pay object represents a payment; the transfer of money from a -customer. FS::cust_pay inherits from FS::Record. The following fields are -currently supported: - -=over 4 - -=item paynum - primary key (assigned automatically for new payments) - -=item custnum - customer (see L) - -=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, check #, or comp issuer (4-8 lowercase alphanumerics; think username), respectively - -=item paybatch - text field for tracking card processing - -=item closed - books closed flag, empty or `Y' - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new payment. To add the payment to the databse, see L<"insert">. - -=cut - -sub table { 'cust_pay'; } - -=item insert - -Adds this payment to the database. - -For backwards-compatibility and convenience, if the additional field invnum -is defined, an FS::cust_bill_pay record for the full amount of the payment -will be created. In this case, custnum is optional. - -=cut - -sub insert { - my $self = shift; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - if ( $self->invnum ) { - my $cust_bill = qsearchs('cust_bill', { 'invnum' => $self->invnum } ) - or do { - $dbh->rollback if $oldAutoCommit; - return "Unknown cust_bill.invnum: ". $self->invnum; - }; - $self->custnum($cust_bill->custnum ); - } - - my $cust_main = qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); - my $old_balance = $cust_main->balance; - - my $error = $self->check; - return $error if $error; - - $error = $self->SUPER::insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error inserting $self: $error"; - } - - if ( $self->invnum ) { - my $cust_bill_pay = new FS::cust_bill_pay { - 'invnum' => $self->invnum, - 'paynum' => $self->paynum, - 'amount' => $self->paid, - '_date' => $self->_date, - }; - $error = $cust_bill_pay->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error inserting $cust_bill_pay: $error"; - } - } - - if ( $self->paybatch =~ /^webui-/ ) { - my @cust_pay = qsearch('cust_pay', { - 'custnum' => $self->custnum, - 'paybatch' => $self->paybatch, - } ); - if ( scalar(@cust_pay) > 1 ) { - $dbh->rollback if $oldAutoCommit; - return "a payment with webui token ". $self->paybatch. " already exists"; - } - } - - #false laziness w/ cust_credit::insert - if ( $unsuspendauto && $old_balance && $cust_main->balance <= 0 ) { - my @errors = $cust_main->unsuspend; - #return - # side-fx with nested transactions? upstack rolls back? - warn "WARNING:Errors unsuspending customer ". $cust_main->custnum. ": ". - join(' / ', @errors) - if @errors; - } - #eslaf - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; - -} - -sub upgrade_replace { #1.3.x->1.4.x - my $self = shift; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $error = $self->check; - return $error if $error; - - my %new = $self->hash; - my $new = FS::cust_pay->new(\%new); - - if ( $self->invnum ) { - my $cust_bill_pay = new FS::cust_bill_pay { - 'invnum' => $self->invnum, - 'paynum' => $self->paynum, - 'amount' => $self->paid, - '_date' => $self->_date, - }; - $error = $cust_bill_pay->insert; - if ( $error =~ - /total cust_bill_pay.amount and cust_credit_bill.amount .* for invnum .* greater than cust_bill.charged/ ) { - #warn $error; - my $cust_bill = qsearchs( 'cust_bill', { 'invnum' => $self->invnum } ); - $new->custnum($cust_bill->custnum); - } elsif ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } else { - $new->custnum($cust_bill_pay->cust_bill->custnum); - } - } else { - die; - } - - $error = $new->SUPER::replace($self); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; - - -} - -=item delete - -Deletes this payment and all associated applications (see L), -unless the closed flag is set. - -=cut - -sub delete { - my $self = shift; - return "Can't delete closed payment" if $self->closed =~ /^Y/i; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - foreach my $cust_bill_pay ( $self->cust_bill_pay ) { - my $error = $cust_bill_pay->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - my $error = $self->SUPER::delete(@_); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - if ( $conf->config('deletepayments') ne '' ) { - - my $cust_main = qsearchs('cust_main',{ 'custnum' => $self->custnum }); - #false laziness w/FS::cust_bill::send & fs_signup_server - $ENV{MAILADDRESS} = $invoice_from; #??? well as good as any - my $header = new Mail::Header ( [ - "From: $invoice_from", - "To: ". $conf->config('deletepayments'), - "Sender: $invoice_from", - "Reply-To: $invoice_from", - "Date: ". time2str("%a, %d %b %Y %X %z", time), - "Subject: FREESIDE NOTIFICATION: Payment deleted", - ] ); - my $message = new Mail::Internet ( - 'Header' => $header, - 'Body' => [ - "This is an automatic message from your Freeside installation\n", - "informing you that the following payment has been deleted:\n", - "\n", - 'paynum: '. $self->paynum. "\n", - 'custnum: '. $self->custnum. - " (". $cust_main->last. ", ". $cust_main->first. ")\n", - 'paid: $'. sprintf("%.2f", $self->paid). "\n", - 'date: '. time2str("%a %b %e %T %Y", $self->_date). "\n", - 'payby: '. $self->payby. "\n", - 'payinfo: '. $self->payinfo. "\n", - 'paybatch: '. $self->paybatch. "\n", - ], - ); - $!=0; - $message->smtpsend( Host => $smtpmachine ) - or $message->smtpsend( Host => $smtpmachine, Debug => 1 ) - or do { - $dbh->rollback if $oldAutoCommit; - return "(customer # ". $self->custnum. - ") can't send payment deletion email to ". - $conf->config('deletepayments'). - " via server $smtpmachine with SMTP: $!"; - }; - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; - -} - -=item replace OLD_RECORD - -Currently unimplemented (accounting reasons). - -=cut - -sub replace { - return "Can't (yet?) modify cust_pay records!"; -} - -=item check - -Checks all fields to make sure this is a valid payment. If there is an error, -returns the error, otherwise returns false. Called by the insert method. - -=cut - -sub check { - my $self = shift; - - my $error = - $self->ut_numbern('paynum') - || $self->ut_numbern('custnum') - || $self->ut_money('paid') - || $self->ut_numbern('_date') - || $self->ut_textn('paybatch') - || $self->ut_enum('closed', [ '', 'Y' ]) - ; - return $error if $error; - - return "paid must be > 0 " if $self->paid <= 0; - - return "unknown cust_main.custnum: ". $self->custnum - unless $self->invnum - || qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); - - $self->_date(time) unless $self->_date; - - $self->payby =~ /^(CARD|BILL|COMP)$/ or return "Illegal payby"; - $self->payby($1); - - #false laziness with cust_refund::check - if ( $self->payby eq 'CARD' ) { - my $payinfo = $self->payinfo; - $payinfo =~ s/\D//g; - $self->payinfo($payinfo); - if ( $self->payinfo ) { - $self->payinfo =~ /^(\d{13,16})$/ - or return "Illegal (mistyped?) credit card number (payinfo)"; - $self->payinfo($1); - validate($self->payinfo) or return "Illegal credit card number"; - return "Unknown card type" if cardtype($self->payinfo) eq "Unknown"; - } else { - $self->payinfo('N/A'); - } - - } else { - $error = $self->ut_textn('payinfo'); - return $error if $error; - } - - ''; #no error - -} - -=item cust_bill_pay - -Returns all applications to invoices (see L) for this -payment. - -=cut - -sub cust_bill_pay { - my $self = shift; - sort { $a->_date <=> $b->_date } - qsearch( 'cust_bill_pay', { 'paynum' => $self->paynum } ) - ; -} - -=item unapplied - -Returns the amount of this payment that is still unapplied; which is -paid minus all payment applications (see L). - -=cut - -sub unapplied { - my $self = shift; - my $amount = $self->paid; - $amount -= $_->amount foreach ( $self->cust_bill_pay ); - sprintf("%.2f", $amount ); -} - -=back - -=head1 VERSION - -$Id: cust_pay.pm,v 1.21 2002-06-04 14:35:52 ivan Exp $ - -=head1 BUGS - -Delete and replace methods. - -=head1 SEE ALSO - -L, L, L, schema.html from the -base documentation. - -=cut - -1; - diff --git a/FS/FS/cust_pay_batch.pm b/FS/FS/cust_pay_batch.pm deleted file mode 100644 index c4427c387..000000000 --- a/FS/FS/cust_pay_batch.pm +++ /dev/null @@ -1,209 +0,0 @@ -package FS::cust_pay_batch; - -use strict; -use vars qw( @ISA ); -use FS::Record; -use Business::CreditCard; - -@ISA = qw( FS::Record ); - -=head1 NAME - -FS::cust_pay_batch - Object methods for batch cards - -=head1 SYNOPSIS - - use FS::cust_pay_batch; - - $record = new FS::cust_pay_batch \%hash; - $record = new FS::cust_pay_batch { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::cust_pay_batch object represents a credit card transaction ready to be -batched (sent to a processor). FS::cust_pay_batch inherits from FS::Record. -Typically called by the collect method of an FS::cust_main object. The -following fields are currently supported: - -=over 4 - -=item paybatchnum - primary key (automatically assigned) - -=item cardnum - -=item exp - card expiration - -=item amount - -=item invnum - invoice - -=item custnum - customer - -=item payname - name on card - -=item first - name - -=item last - name - -=item address1 - -=item address2 - -=item city - -=item state - -=item zip - -=item country - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new record. To add the record to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I method. - -=cut - -sub table { 'cust_pay_batch'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=item delete - -Delete this record from the database. If there is an error, returns the error, -otherwise returns false. - -=item replace OLD_RECORD - -#inactive -# -#Replaces the OLD_RECORD with this one in the database. If there is an error, -#returns the error, otherwise returns false. - -=cut - -sub replace { - return "Can't (yet?) replace batched transactions!"; -} - -=item check - -Checks all fields to make sure this is a valid transaction. If there is -an error, returns the error, otherwise returns false. Called by the insert -and repalce methods. - -=cut - -sub check { - my $self = shift; - - my $error = - $self->ut_numbern('paybatchnum') - || $self->ut_numbern('trancode') #depriciated - || $self->ut_number('cardnum') - || $self->ut_money('amount') - || $self->ut_number('invnum') - || $self->ut_number('custnum') - || $self->ut_text('address1') - || $self->ut_textn('address2') - || $self->ut_text('city') - || $self->ut_textn('state') - ; - - return $error if $error; - - $self->getfield('last') =~ /^([\w \,\.\-\']+)$/ or return "Illegal last name"; - $self->setfield('last',$1); - - $self->first =~ /^([\w \,\.\-\']+)$/ or return "Illegal first name"; - $self->first($1); - - my $cardnum = $self->cardnum; - $cardnum =~ s/\D//g; - $cardnum =~ /^(\d{13,16})$/ - or return "Illegal credit card number"; - $cardnum = $1; - $self->cardnum($cardnum); - validate($cardnum) or return "Illegal credit card number"; - return "Unknown card type" if cardtype($cardnum) eq "Unknown"; - - if ( $self->exp eq '' ) { - return "Expriation date required"; #unless - $self->exp(''); - } else { - if ( $self->exp =~ /^(\d{4})[\/\-](\d{1,2})[\/\-](\d{1,2})$/ ) { - $self->exp("$1-$2-$3"); - } elsif ( $self->exp =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) { - if ( length($2) == 4 ) { - $self->exp("$2-$1-01"); - } elsif ( $2 > 98 ) { #should pry change to check for "this year" - $self->exp("19$2-$1-01"); - } else { - $self->exp("20$2-$1-01"); - } - } else { - return "Illegal expiration date"; - } - } - - if ( $self->payname eq '' ) { - $self->payname( $self->first. " ". $self->getfield('last') ); - } else { - $self->payname =~ /^([\w \,\.\-\']+)$/ - or return "Illegal billing name"; - $self->payname($1); - } - - #$self->zip =~ /^\s*(\w[\w\-\s]{3,8}\w)\s*$/ - # or return "Illegal zip: ". $self->zip; - #$self->zip($1); - - $self->country =~ /^(\w\w)$/ or return "Illegal country: ". $self->country; - $self->country($1); - - $error = $self->ut_zip('zip', $self->country); - return $error if $error; - - #check invnum, custnum, ? - - ''; #no error -} - -=back - -=head1 VERSION - -$Id: cust_pay_batch.pm,v 1.6 2002-02-22 23:08:11 ivan Exp $ - -=head1 BUGS - -There should probably be a configuration file with a list of allowed credit -card types. - -=head1 SEE ALSO - -L, L - -=cut - -1; - diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm deleted file mode 100644 index 8b65ac4bd..000000000 --- a/FS/FS/cust_pkg.pm +++ /dev/null @@ -1,710 +0,0 @@ -package FS::cust_pkg; - -use strict; -use vars qw(@ISA); -use FS::UID qw( getotaker dbh ); -use FS::Record qw( qsearch qsearchs ); -use FS::cust_svc; -use FS::part_pkg; -use FS::cust_main; -use FS::type_pkgs; -use FS::pkg_svc; - -# need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend, -# setup } -# because they load configuraion by setting FS::UID::callback (see TODO) -use FS::svc_acct; -use FS::svc_acct_sm; -use FS::svc_domain; -use FS::svc_www; -use FS::svc_forward; - -@ISA = qw( FS::Record ); - -sub _cache { - my $self = shift; - my ( $hashref, $cache ) = @_; - #if ( $hashref->{'pkgpart'} ) { - if ( $hashref->{'pkg'} ) { - # #@{ $self->{'_pkgnum'} } = (); - # my $subcache = $cache->subcache('pkgpart', 'part_pkg'); - # $self->{'_pkgpart'} = $subcache; - # #push @{ $self->{'_pkgnum'} }, - # FS::part_pkg->new_or_cached($hashref, $subcache); - $self->{'_pkgpart'} = FS::part_pkg->new($hashref); - } - if ( exists $hashref->{'svcnum'} ) { - #@{ $self->{'_pkgnum'} } = (); - my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum}); - $self->{'_svcnum'} = $subcache; - #push @{ $self->{'_pkgnum'} }, - FS::cust_svc->new_or_cached($hashref, $subcache) if $hashref->{svcnum}; - } -} - -=head1 NAME - -FS::cust_pkg - Object methods for cust_pkg objects - -=head1 SYNOPSIS - - use FS::cust_pkg; - - $record = new FS::cust_pkg \%hash; - $record = new FS::cust_pkg { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - - $error = $record->cancel; - - $error = $record->suspend; - - $error = $record->unsuspend; - - $part_pkg = $record->part_pkg; - - @labels = $record->labels; - - $seconds = $record->seconds_since($timestamp); - - $error = FS::cust_pkg::order( $custnum, \@pkgparts ); - $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] ); - -=head1 DESCRIPTION - -An FS::cust_pkg object represents a customer billing item. FS::cust_pkg -inherits from FS::Record. The following fields are currently supported: - -=over 4 - -=item pkgnum - primary key (assigned automatically for new billing items) - -=item custnum - Customer (see L) - -=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) - -=item manual_flag - If this field is set to 1, disables the automatic -unsuspension of this package when using the B config file. - -=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 new HASHREF - -Create a new billing item. To add the item to the database, see L<"insert">. - -=cut - -sub table { 'cust_pkg'; } - -=item insert - -Adds this billing item to the database ("Orders" the item). If there is an -error, returns the error, otherwise returns false. - -=cut - -sub insert { - my $self = shift; - - # custnum might not have have been defined in sub check (for one-shot new - # customers), so check it here instead - # (is this still necessary with transactions?) - - my $error = $self->ut_number('custnum'); - return $error if $error; - - my $cust_main = $self->cust_main; - return "Unknown customer ". $self->custnum unless $cust_main; - - my $agent = qsearchs( 'agent', { 'agentnum' => $cust_main->agentnum } ); - my $pkgpart_href = $agent->pkgpart_hashref; - return "agent ". $agent->agentnum. " can't purchase pkgpart ". $self->pkgpart - unless $pkgpart_href->{ $self->pkgpart }; - - $self->SUPER::insert; - -} - -=item delete - -This method now works but you probably shouldn't use it. - -You don't want to delete billing items, because there would then be no record -the customer ever purchased the item. Instead, see the cancel method. - -=cut - -#sub delete { -# return "Can't delete cust_pkg records!"; -#} - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -Currently, custnum, setup, bill, susp, expire, and cancel may be changed. - -Changing pkgpart may have disasterous effects. See the order subroutine. - -setup and bill are normally updated by calling the bill method of a customer -object (see L). - -suspend is normally updated by the suspend and unsuspend methods. - -cancel is normally updated by the cancel method (and also the order subroutine -in some cases). - -=cut - -sub replace { - my( $new, $old ) = ( shift, shift ); - - #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart; - return "Can't change otaker!" if $old->otaker ne $new->otaker; - - #allow this *sigh* - #return "Can't change setup once it exists!" - # if $old->getfield('setup') && - # $old->getfield('setup') != $new->getfield('setup'); - - #some logic for bill, susp, cancel? - - $new->SUPER::replace($old); -} - -=item check - -Checks all fields to make sure this is a valid billing item. If there is an -error, returns the error, otherwise returns false. Called by the insert and -replace methods. - -=cut - -sub check { - my $self = shift; - - my $error = - $self->ut_numbern('pkgnum') - || $self->ut_numbern('custnum') - || $self->ut_number('pkgpart') - || $self->ut_numbern('setup') - || $self->ut_numbern('bill') - || $self->ut_numbern('susp') - || $self->ut_numbern('cancel') - ; - return $error if $error; - - if ( $self->custnum ) { - return "Unknown customer ". $self->custnum unless $self->cust_main; - } - - return "Unknown pkgpart: ". $self->pkgpart - unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } ); - - $self->otaker(getotaker) unless $self->otaker; - $self->otaker =~ /^(\w{0,16})$/ or return "Illegal otaker"; - $self->otaker($1); - - if ( $self->dbdef_table->column('manual_flag') ) { - $self->manual_flag =~ /^([01]?)$/ or return "Illegal manual_flag"; - $self->manual_flag($1); - } - - ''; #no error -} - -=item cancel - -Cancels and removes all services (see L 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 = shift; - my $error; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - foreach my $cust_svc ( - qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) - ) { - my $error = $cust_svc->cancel; - - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Error cancelling cust_svc: $error"; - } - - } - - unless ( $self->getfield('cancel') ) { - my %hash = $self->hash; - $hash{'cancel'} = time; - my $new = new FS::cust_pkg ( \%hash ); - $error = $new->replace($self); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; #no errors -} - -=item suspend - -Suspends all services (see L 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 = shift; - my $error ; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - foreach my $cust_svc ( - qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) - ) { - my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } ); - - $part_svc->svcdb =~ /^([\w\-]+)$/ or do { - $dbh->rollback if $oldAutoCommit; - return "Illegal svcdb value in part_svc!"; - }; - my $svcdb = $1; - require "FS/$svcdb.pm"; - - my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } ); - if ($svc) { - $error = $svc->suspend; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - } - - unless ( $self->getfield('susp') ) { - my %hash = $self->hash; - $hash{'susp'} = time; - my $new = new FS::cust_pkg ( \%hash ); - $error = $new->replace($self); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; #no errors -} - -=item unsuspend - -Unsuspends all services (see L 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 = shift; - my($error); - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - foreach my $cust_svc ( - qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } ) - ) { - my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } ); - - $part_svc->svcdb =~ /^([\w\-]+)$/ or do { - $dbh->rollback if $oldAutoCommit; - return "Illegal svcdb value in part_svc!"; - }; - my $svcdb = $1; - require "FS/$svcdb.pm"; - - my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } ); - if ($svc) { - $error = $svc->unsuspend; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - } - - unless ( ! $self->getfield('susp') ) { - my %hash = $self->hash; - $hash{'susp'} = ''; - my $new = new FS::cust_pkg ( \%hash ); - $error = $new->replace($self); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; #no errors -} - -=item part_pkg - -Returns the definition for this billing item, as an FS::part_pkg object (see -L). - -=cut - -sub part_pkg { - my $self = shift; - #exists( $self->{'_pkgpart'} ) - $self->{'_pkgpart'} - ? $self->{'_pkgpart'} - : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } ); -} - -=item cust_svc - -Returns the services for this package, as FS::cust_svc objects (see -L) - -=cut - -sub cust_svc { - my $self = shift; - if ( $self->{'_svcnum'} ) { - values %{ $self->{'_svcnum'}->cache }; - } else { - qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } ); - } -} - -=item labels - -Returns a list of lists, calling the label method for all services -(see L) of this billing item. - -=cut - -sub labels { - my $self = shift; - map { [ $_->label ] } $self->cust_svc; -} - -=item cust_main - -Returns the parent customer object (see L). - -=cut - -sub cust_main { - my $self = shift; - qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); -} - -=item seconds_since TIMESTAMP - -Returns the number of seconds all accounts (see L) in this -package have been online since TIMESTAMP. - -TIMESTAMP is specified as a UNIX timestamp; see L. Also see -L and L for conversion functions. - -=cut - -sub seconds_since { - my($self, $since) = @_; - my $seconds = 0; - - foreach my $cust_svc ( - grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc - ) { - $seconds += $cust_svc->seconds_since($since); - } - - $seconds; - -} - -=back - -=head1 SUBROUTINES - -=over 4 - -=item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ] ] - -CUSTNUM is a customer (see L) - -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). An empty arrayref is equivalent to not specifying this -parameter. - -RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the -newly-created cust_pkg objects. - -=cut - -sub order { - my($custnum, $pkgparts, $remove_pkgnums, $return_cust_pkg) = @_; - $remove_pkgnums = [] unless defined($remove_pkgnums); - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - # generate %part_pkg - # $part_pkg{$pkgpart} is true iff $custnum may purchase $pkgpart - # - my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum}); - my($agent)=qsearchs('agent',{'agentnum'=> $cust_main->agentnum }); - my %part_pkg = %{ $agent->pkgpart_hashref }; - - my(%svcnum); - # generate %svcnum - # for those packages being removed: - #@{ $svcnum{$svcpart} } goes from a svcpart to a list of FS::cust_svc objects - my($pkgnum); - foreach $pkgnum ( @{$remove_pkgnums} ) { - foreach my $cust_svc (qsearch('cust_svc',{'pkgnum'=>$pkgnum})) { - push @{ $svcnum{$cust_svc->getfield('svcpart')} }, $cust_svc; - } - } - - my @cust_svc; - #generate @cust_svc - # for those packages the customer is purchasing: - # @{$pkgparts} is a list of said packages, by pkgpart - # @cust_svc is a corresponding list of lists of FS::Record objects - foreach my $pkgpart ( @{$pkgparts} ) { - unless ( $part_pkg{$pkgpart} ) { - $dbh->rollback if $oldAutoCommit; - return "Customer not permitted to purchase pkgpart $pkgpart!"; - } - push @cust_svc, [ - map { - ( $svcnum{$_} && @{ $svcnum{$_} } ) ? shift @{ $svcnum{$_} } : (); - } map { $_->svcpart } - qsearch('pkg_svc', { pkgpart => $pkgpart, - quantity => { op=>'>', value=>'0', } } ) - ]; - } - - #special-case until this can be handled better - # move services to new svcparts - even if the svcparts don't match (svcdb - # needs to...) - # looks like they're moved in no particular order, ewwwwwwww - # and looks like just one of each svcpart can be moved... o well - - #start with still-leftover services - #foreach my $svcpart ( grep { scalar(@{ $svcnum{$_} }) } keys %svcnum ) { - foreach my $svcpart ( keys %svcnum ) { - next unless @{ $svcnum{$svcpart} }; - - my $svcdb = $svcnum{$svcpart}->[0]->part_svc->svcdb; - - #find an empty place to put one - my $i = 0; - foreach my $pkgpart ( @{$pkgparts} ) { - my @pkg_svc = - qsearch('pkg_svc', { pkgpart => $pkgpart, - quantity => { op=>'>', value=>'0', } } ); - #my @pkg_svc = - # grep { $_->quantity > 0 } qsearch('pkg_svc', { pkgpart=>$pkgpart } ); - if ( ! @{$cust_svc[$i]} #find an empty place to put them with - && grep { $svcdb eq $_->part_svc->svcdb } #with appropriate svcdb - @pkg_svc - ) { - my $new_svcpart = - ( grep { $svcdb eq $_->part_svc->svcdb } @pkg_svc )[0]->svcpart; - my $cust_svc = shift @{$svcnum{$svcpart}}; - $cust_svc->svcpart($new_svcpart); - #warn "changing from $svcpart to $new_svcpart!!!\n"; - $cust_svc[$i] = [ $cust_svc ]; - } - $i++; - } - - } - - #check for leftover services - foreach (keys %svcnum) { - next unless @{ $svcnum{$_} }; - $dbh->rollback if $oldAutoCommit; - return "Leftover services, svcpart $_: svcnum ". - join(', ', map { $_->svcnum } @{ $svcnum{$_} } ); - } - - #no leftover services, let's make changes. - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - #first cancel old packages - foreach my $pkgnum ( @{$remove_pkgnums} ) { - my($old) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); - unless ( $old ) { - $dbh->rollback if $oldAutoCommit; - return "Package $pkgnum not found to remove!"; - } - my(%hash) = $old->hash; - $hash{'cancel'}=time; - my($new) = new FS::cust_pkg ( \%hash ); - my($error)=$new->replace($old); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Couldn't update package $pkgnum: $error"; - } - } - - #now add new packages, changing cust_svc records if necessary - my $pkgpart; - while ($pkgpart=shift @{$pkgparts} ) { - - my $new = new FS::cust_pkg { - 'custnum' => $custnum, - 'pkgpart' => $pkgpart, - }; - my $error = $new->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Couldn't insert new cust_pkg record: $error"; - } - push @{$return_cust_pkg}, $new if $return_cust_pkg; - my $pkgnum = $new->pkgnum; - - foreach my $cust_svc ( @{ shift @cust_svc } ) { - my(%hash) = $cust_svc->hash; - $hash{'pkgnum'}=$pkgnum; - my $new = new FS::cust_svc ( \%hash ); - - #avoid Record diffing missing changed svcpart field from above. - my $old = qsearchs('cust_svc', { 'svcnum' => $cust_svc->svcnum } ); - - my $error = $new->replace($old); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Couldn't link old service to new package: $error"; - } - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; #no errors -} - -=back - -=head1 VERSION - -$Id: cust_pkg.pm,v 1.22 2002-05-22 12:17:06 ivan Exp $ - -=head1 BUGS - -sub order is not OO. Perhaps it should be moved to FS::cust_main and made so? - -In sub order, the @pkgparts array (passed by reference) is clobbered. - -Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard -method to pass dates to the recur_prog expression, it should do so. - -FS::svc_acct, FS::svc_acct_sm, and FS::svc_domain are loaded via 'use' at -compile time, rather than via 'require' in sub { setup, suspend, unsuspend, -cancel } because they use %FS::UID::callback to load configuration values. -Probably need a subroutine which decides what to do based on whether or not -we've fetched the user yet, rather than a hash. See FS::UID and the TODO. - -Now that things are transactional should the check in the insert method be -moved to check ? - -=head1 SEE ALSO - -L, L, L, L, -L, schema.html from the base documentation - -=cut - -1; - diff --git a/FS/FS/cust_refund.pm b/FS/FS/cust_refund.pm deleted file mode 100644 index 8fe6876d3..000000000 --- a/FS/FS/cust_refund.pm +++ /dev/null @@ -1,282 +0,0 @@ -package FS::cust_refund; - -use strict; -use vars qw( @ISA ); -use Business::CreditCard; -use FS::Record qw( qsearchs dbh ); -use FS::UID qw(getotaker); -use FS::cust_credit; -use FS::cust_credit_refund; -use FS::cust_main; - -@ISA = qw( FS::Record ); - -=head1 NAME - -FS::cust_refund - Object method for cust_refund objects - -=head1 SYNOPSIS - - use FS::cust_refund; - - $record = new FS::cust_refund \%hash; - $record = new FS::cust_refund { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::cust_refund represents a refund: the transfer of money to a customer; -equivalent to a negative payment (see L). FS::cust_refund -inherits from FS::Record. The following fields are currently supported: - -=over 4 - -=item refundnum - primary key (assigned automatically for new refunds) - -=item custnum - customer (see L) - -=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 paybatch - text field for tracking card processing - -=item otaker - order taker (assigned automatically, see L) - -=item closed - books closed flag, empty or `Y' - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new refund. To add the refund to the database, see L<"insert">. - -=cut - -sub table { 'cust_refund'; } - -=item insert - -Adds this refund to the database. - -For backwards-compatibility and convenience, if the additional field crednum is -defined, an FS::cust_credit_refund record for the full amount of the refund -will be created. In this case, custnum is optional. - -=cut - -sub insert { - my $self = shift; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - if ( $self->crednum ) { - my $cust_credit = qsearchs('cust_credit', { 'crednum' => $self->crednum } ) - or do { - $dbh->rollback if $oldAutoCommit; - return "Unknown cust_credit.crednum: ". $self->crednum; - }; - $self->custnum($cust_credit->custnum); - } - - my $error = $self->check; - return $error if $error; - - $error = $self->SUPER::insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - if ( $self->crednum ) { - my $cust_credit_refund = new FS::cust_credit_refund { - 'crednum' => $self->crednum, - 'refundnum' => $self->refundnum, - 'amount' => $self->refund, - '_date' => $self->_date, - }; - $error = $cust_credit_refund->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - #$self->custnum($cust_credit_refund->cust_credit->custnum); - } - - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; - -} - -sub upgrade_replace { #1.3.x->1.4.x - my $self = shift; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $error = $self->check; - return $error if $error; - - my %new = $self->hash; - my $new = FS::cust_refund->new(\%new); - - if ( $self->crednum ) { - my $cust_credit_refund = new FS::cust_credit_refund { - 'crednum' => $self->crednum, - 'refundnum' => $self->refundnum, - 'amount' => $self->refund, - '_date' => $self->_date, - }; - $error = $cust_credit_refund->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - $new->custnum($cust_credit_refund->cust_credit->custnum); - } else { - die; - } - - $error = $new->SUPER::replace($self); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; - -} - -=item delete - -Currently unimplemented (accounting reasons). - -=cut - -sub delete { - my $self = shift; - return "Can't delete closed refund" if $self->closed =~ /^Y/i; - $self->SUPER::delete(@_); -} - -=item replace OLD_RECORD - -Currently unimplemented (accounting reasons). - -=cut - -sub replace { - return "Can't (yet?) modify cust_refund records!"; -} - -=item check - -Checks all fields to make sure this is a valid refund. If there is an error, -returns the error, otherwise returns false. Called by the insert method. - -=cut - -sub check { - my $self = shift; - - my $error = - $self->ut_numbern('refundnum') - || $self->ut_numbern('custnum') - || $self->ut_money('refund') - || $self->ut_numbern('_date') - || $self->ut_textn('paybatch') - || $self->ut_enum('closed', [ '', 'Y' ]) - ; - return $error if $error; - - return "refund must be > 0 " if $self->refund <= 0; - - $self->_date(time) unless $self->_date; - - return "unknown cust_main.custnum: ". $self->custnum - unless $self->crednum - || qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); - - $self->payby =~ /^(CARD|BILL|COMP)$/ or return "Illegal payby"; - $self->payby($1); - - #false laziness with cust_pay::check - if ( $self->payby eq 'CARD' ) { - my $payinfo = $self->payinfo; - $payinfo =~ s/\D//g; - $self->payinfo($payinfo); - if ( $self->payinfo ) { - $self->payinfo =~ /^(\d{13,16})$/ - or return "Illegal (mistyped?) credit card number (payinfo)"; - $self->payinfo($1); - validate($self->payinfo) or return "Illegal credit card number"; - return "Unknown card type" if cardtype($self->payinfo) eq "Unknown"; - } else { - $self->payinfo('N/A'); - } - - } else { - $error = $self->ut_textn('payinfo'); - return $error if $error; - } - - $self->otaker(getotaker); - - ''; #no error -} - -=back - -=head1 VERSION - -$Id: cust_refund.pm,v 1.18 2002-02-19 03:22:39 jeff Exp $ - -=head1 BUGS - -Delete and replace methods. - -=head1 SEE ALSO - -L, L, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm deleted file mode 100644 index c7cc4b322..000000000 --- a/FS/FS/cust_svc.pm +++ /dev/null @@ -1,367 +0,0 @@ -package FS::cust_svc; - -use strict; -use vars qw( @ISA ); -use Carp qw( cluck ); -use FS::Record qw( qsearch qsearchs dbh ); -use FS::cust_pkg; -use FS::part_pkg; -use FS::part_svc; -use FS::pkg_svc; -use FS::svc_acct; -use FS::svc_acct_sm; -use FS::svc_domain; -use FS::svc_forward; -use FS::domain_record; - -@ISA = qw( FS::Record ); - -sub _cache { - my $self = shift; - my ( $hashref, $cache ) = @_; - if ( $hashref->{'username'} ) { - $self->{'_svc_acct'} = FS::svc_acct->new($hashref, ''); - } - if ( $hashref->{'svc'} ) { - $self->{'_svcpart'} = FS::part_svc->new($hashref); - } -} - -=head1 NAME - -FS::cust_svc - Object method for cust_svc objects - -=head1 SYNOPSIS - - use FS::cust_svc; - - $record = new FS::cust_svc \%hash - $record = new FS::cust_svc { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - - ($label, $value) = $record->label; - -=head1 DESCRIPTION - -An FS::cust_svc represents a service. FS::cust_svc inherits from FS::Record. -The following fields are currently supported: - -=over 4 - -=item svcnum - primary key (assigned automatically for new services) - -=item pkgnum - Package (see L) - -=item svcpart - Service definition (see L) - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new service. To add the refund to the database, see L<"insert">. -Services are normally created by creating FS::svc_ objects (see -L, L, and L, among others). - -=cut - -sub table { 'cust_svc'; } - -=item insert - -Adds this service to the database. If there is an error, returns the error, -otherwise returns false. - -=item delete - -Deletes this service from the database. If there is an error, returns the -error, otherwise returns false. Note that this only removes the cust_svc -record - you should probably use the B method instead. - -=item cancel - -Cancels the relevant service by calling the B method of the associated -FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object), -deleting the FS::svc_XXX record and then deleting this record. - -If there is an error, returns the error, otherwise returns false. - -=cut - -sub cancel { - my $self = shift; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $part_svc = $self->part_svc; - - $part_svc->svcdb =~ /^([\w\-]+)$/ or do { - $dbh->rollback if $oldAutoCommit; - return "Illegal svcdb value in part_svc!"; - }; - my $svcdb = $1; - require "FS/$svcdb.pm"; - - my $svc = $self->svc_x; - if ($svc) { - my $error = $svc->cancel; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Error canceling service: $error"; - } - $error = $svc->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Error deleting service: $error"; - } - } - - my $error = $self->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Error deleting cust_svc: $error"; - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; #no errors - -} - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -sub replace { - my ( $new, $old ) = ( shift, shift ); - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $error = $new->SUPER::replace($old); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error if $error; - } - - if ( $new->svcpart != $old->svcpart ) { - my $svc_x = $new->svc_x; - my $new_svc_x = ref($svc_x)->new({$svc_x->hash}); - my $error = $new_svc_x->replace($svc_x); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error if $error; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; #no error - -} - -=item check - -Checks all fields to make sure this is a valid service. If there is an error, -returns the error, otehrwise returns false. Called by the insert and -replace methods. - -=cut - -sub check { - my $self = shift; - - my $error = - $self->ut_numbern('svcnum') - || $self->ut_numbern('pkgnum') - || $self->ut_number('svcpart') - ; - return $error if $error; - - my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); - return "Unknown svcpart" unless $part_svc; - - if ( $self->pkgnum ) { - my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } ); - return "Unknown pkgnum" unless $cust_pkg; - my $pkg_svc = qsearchs( 'pkg_svc', { - 'pkgpart' => $cust_pkg->pkgpart, - 'svcpart' => $self->svcpart, - }); - # or new FS::pkg_svc ( { 'pkgpart' => $cust_pkg->pkgpart, - # 'svcpart' => $self->svcpart, - # 'quantity' => 0 } ); - - my @cust_svc = qsearch('cust_svc', { - 'pkgnum' => $self->pkgnum, - 'svcpart' => $self->svcpart, - }); - return "Already ". scalar(@cust_svc). " ". $part_svc->svc. - " services for pkgnum ". $self->pkgnum - if scalar(@cust_svc) >= $pkg_svc->quantity; - } - - ''; #no error -} - -=item part_svc - -Returns the definition for this service, as a FS::part_svc object (see -L). - -=cut - -sub part_svc { - my $self = shift; - $self->{'_svcpart'} - ? $self->{'_svcpart'} - : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); -} - -=item cust_pkg - -Returns the definition for this service, as a FS::part_svc object (see -L). - -=cut - -sub cust_pkg { - my $self = shift; - qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } ); -} - -=item label - -Returns a list consisting of: -- The name of this service (from part_svc) -- A meaningful identifier (username, domain, or mail alias) -- The table name (i.e. svc_domain) for this service - -=cut - -sub label { - my $self = shift; - my $svcdb = $self->part_svc->svcdb; - my $svc_x = $self->svc_x - or die "can't find $svcdb.svcnum ". $self->svcnum; - my $tag; - if ( $svcdb eq 'svc_acct' ) { - $tag = $svc_x->email; - } elsif ( $svcdb eq 'svc_acct_sm' ) { - my $domuser = $svc_x->domuser eq '*' ? '(anything)' : $svc_x->domuser; - my $svc_domain = qsearchs ( 'svc_domain', { 'svcnum' => $svc_x->domsvc } ); - my $domain = $svc_domain->domain; - $tag = "$domuser\@$domain"; - } elsif ( $svcdb eq 'svc_forward' ) { - my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_x->srcsvc } ); - $tag = $svc_acct->email. '->'; - if ( $svc_x->dstsvc ) { - $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_x->dstsvc } ); - $tag .= $svc_acct->email; - } else { - $tag .= $svc_x->dst; - } - } elsif ( $svcdb eq 'svc_domain' ) { - $tag = $svc_x->getfield('domain'); - } elsif ( $svcdb eq 'svc_www' ) { - my $domain = qsearchs( 'domain_record', { 'recnum' => $svc_x->recnum } ); - $tag = $domain->reczone; - } else { - cluck "warning: asked for label of unsupported svcdb; using svcnum"; - $tag = $svc_x->getfield('svcnum'); - } - $self->part_svc->svc, $tag, $svcdb; -} - -=item svc_x - -Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or -FS::svc_domain object, etc.) - -=cut - -sub svc_x { - my $self = shift; - my $svcdb = $self->part_svc->svcdb; - if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) { - $self->{'_svc_acct'}; - } else { - qsearchs( $svcdb, { 'svcnum' => $self->svcnum } ); - } -} - -=item seconds_since TIMESTAMP - -See L. Equivalent to -$cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records -where B is not "svc_acct". - -=cut - -#note: implementation here, POD in FS::svc_acct -sub seconds_since { - my($self, $since) = @_; - my $dbh = dbh; - my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session - WHERE svcnum = ? - AND login >= ? - AND logout IS NOT NULL' - ) or die $dbh->errstr; - $sth->execute($self->svcnum, $since) or die $sth->errstr; - $sth->fetchrow_arrayref->[0]; -} - -=back - -=head1 VERSION - -$Id: cust_svc.pm,v 1.15 2002-05-22 12:17:06 ivan Exp $ - -=head1 BUGS - -Behaviour of changing the svcpart of cust_svc records is undefined and should -possibly be prohibited, and pkg_svc records are not checked. - -pkg_svc records are not checked in general (here). - -Deleting this record doesn't check or delete the svc_* record associated -with this record. - -=head1 SEE ALSO - -L, L, L, L, -schema.html from the base documentation - -=cut - -1; - diff --git a/FS/FS/cust_tax_exempt.pm b/FS/FS/cust_tax_exempt.pm deleted file mode 100644 index ab873c0a7..000000000 --- a/FS/FS/cust_tax_exempt.pm +++ /dev/null @@ -1,131 +0,0 @@ -package FS::cust_tax_exempt; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::cust_tax_exempt - Object methods for cust_tax_exempt records - -=head1 SYNOPSIS - - use FS::cust_tax_exempt; - - $record = new FS::cust_tax_exempt \%hash; - $record = new FS::cust_tax_exempt { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::cust_tax_exempt object represents a historical record of a customer tax -exemption. Currently this is only used for "texas tax". FS::cust_tax_exempt -inherits from FS::Record. The following fields are currently supported: - -=over 4 - -=item exemptnum - primary key - -=item custnum - customer (see L) - -=item taxnum - tax rate (see L) - -=item year - -=item month - -=item amount - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new exemption record. To add the example to the database, see -L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'cust_tax_exempt'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=cut - -# the insert method can be inherited from FS::Record - -=item delete - -Delete this record from the database. - -=cut - -# the delete method can be inherited from FS::Record - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -# the replace method can be inherited from FS::Record - -=item check - -Checks all fields to make sure this is a valid example. If there is -an error, returns the error, otherwise returns false. Called by the insert -and replace methods. - -=cut - -# the check method should currently be supplied - FS::Record contains some -# data checking routines - -sub check { - my $self = shift; - - $self->ut_numbern('exemptnum') - || $self->ut_foreign_key('custnum', 'cust_main', 'custnum') - || $self->ut_foreign_key('taxnum', 'cust_main_county', 'taxnum') - || $self->ut_number('year') #check better - || $self->ut_number('month') #check better - || $self->ut_money('amount') - ; -} - -=back - -=head1 BUGS - -Texas tax is a royal pain in the ass. - -=head1 SEE ALSO - -L, L, L, schema.html from the -base documentation. - -=cut - -1; - diff --git a/FS/FS/domain_record.pm b/FS/FS/domain_record.pm deleted file mode 100644 index 37cc6c9e8..000000000 --- a/FS/FS/domain_record.pm +++ /dev/null @@ -1,332 +0,0 @@ -package FS::domain_record; - -use strict; -use vars qw( @ISA $noserial_hack ); -#use FS::Record qw( qsearch qsearchs ); -use FS::Record qw( qsearchs dbh ); -use FS::svc_domain; -use FS::svc_www; - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::domain_record - Object methods for domain_record records - -=head1 SYNOPSIS - - use FS::domain_record; - - $record = new FS::domain_record \%hash; - $record = new FS::domain_record { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::domain_record object represents an entry in a DNS zone. -FS::domain_record inherits from FS::Record. The following fields are currently -supported: - -=over 4 - -=item recnum - primary key - -=item svcnum - Domain (see L) of this entry - -=item reczone - partial (or full) zone for this entry - -=item recaf - address family for this entry, currently only `IN' is recognized. - -=item rectype - record type for this entry (A, MX, etc.) - -=item recdata - data for this entry - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new entry. To add the example to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I method. - -=cut - -sub table { 'domain_record'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=cut - -sub insert { - my $self = shift; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - if ( $self->rectype eq '_mstr' ) { #delete all other records - foreach my $domain_record ( reverse $self->svc_domain->domain_record ) { - my $error = $domain_record->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - } - - my $error = $self->SUPER::insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - unless ( $self->rectype =~ /^(SOA|_mstr)$/ ) { - my $error = $self->increment_serial; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; - -} - -=item delete - -Delete this record from the database. - -=cut - -sub delete { - my $self = shift; - - return "Can't delete a domain record which has a website!" - if qsearchs( 'svc_www', { 'recnum' => $self->recnum } ); - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $error = $self->SUPER::delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - unless ( $self->rectype =~ /^(SOA|_mstr)$/ ) { - my $error = $self->increment_serial; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; - -} - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -sub replace { - my $self = shift; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $error = $self->SUPER::replace(@_); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - unless ( $self->rectype eq 'SOA' ) { - my $error = $self->increment_serial; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; - -} - -=item check - -Checks all fields to make sure this is a valid example. If there is -an error, returns the error, otherwise returns false. Called by the insert -and replace methods. - -=cut - -# the check method should currently be supplied - FS::Record contains some -# data checking routines - -sub check { - my $self = shift; - - my $error = - $self->ut_numbern('recnum') - || $self->ut_number('svcnum') - ; - return $error if $error; - - return "Unknown svcnum (in svc_domain)" - unless qsearchs('svc_domain', { 'svcnum' => $self->svcnum } ); - - $self->reczone =~ /^(@|[a-z0-9\.\-\*]+)$/i - or return "Illegal reczone: ". $self->reczone; - $self->reczone($1); - - $self->recaf =~ /^(IN)$/ or return "Illegal recaf: ". $self->recaf; - $self->recaf($1); - - $self->rectype =~ /^(SOA|NS|MX|A|PTR|CNAME|_mstr)$/ - or return "Illegal rectype (only SOA NS MX A PTR CNAME recognized): ". - $self->rectype; - $self->rectype($1); - - return "Illegal reczone for ". $self->rectype. ": ". $self->reczone - if $self->rectype !~ /^MX$/i && $self->reczone =~ /\*/; - - if ( $self->rectype eq 'SOA' ) { - my $recdata = $self->recdata; - $recdata =~ s/\s+/ /g; - $recdata =~ /^([a-z0-9\.\-]+ [\w\-\+]+\.[a-z0-9\.\-]+ \( (\d+ ){5}\))$/i - or return "Illegal data for SOA record: $recdata"; - $self->recdata($1); - } elsif ( $self->rectype eq 'NS' ) { - $self->recdata =~ /^([a-z0-9\.\-]+)$/i - or return "Illegal data for NS record: ". $self->recdata; - $self->recdata($1); - } elsif ( $self->rectype eq 'MX' ) { - $self->recdata =~ /^(\d+)\s+([a-z0-9\.\-]+)$/i - or return "Illegal data for MX record: ". $self->recdata; - $self->recdata("$1 $2"); - } elsif ( $self->rectype eq 'A' ) { - $self->recdata =~ /^((\d{1,3}\.){3}\d{1,3})$/ - or return "Illegal data for A record: ". $self->recdata; - $self->recdata($1); - } elsif ( $self->rectype eq 'PTR' ) { - $self->recdata =~ /^([a-z0-9\.\-]+)$/i - or return "Illegal data for PTR record: ". $self->recdata; - $self->recdata($1); - } elsif ( $self->rectype eq 'CNAME' ) { - $self->recdata =~ /^([a-z0-9\.\-]+)$/i - or return "Illegal data for CNAME record: ". $self->recdata; - $self->recdata($1); - } elsif ( $self->rectype eq '_mstr' ) { - $self->recdata =~ /^((\d{1,3}\.){3}\d{1,3})$/ - or return "Illegal data for _master pseudo-record: ". $self->recdata; - } else { - die "ack!"; - } - - ''; #no error -} - -=item increment_serial - -=cut - -sub increment_serial { - return '' if $noserial_hack; - my $self = shift; - - my $soa = qsearchs('domain_record', { - svcnum => $self->svcnum, - reczone => '@', #or full domain ? - recaf => 'IN', - rectype => 'SOA', - } ) or return "soa record not found; can't increment serial"; - - my $data = $soa->recdata; - $data =~ s/(\(\D*)(\d+)/$1.($2+1)/e; #well, it works. - - my %hash = $soa->hash; - $hash{recdata} = $data; - my $new = new FS::domain_record \%hash; - $new->replace($soa); -} - -=item svc_domain - -Returns the domain (see L) for this record. - -=cut - -sub svc_domain { - my $self = shift; - qsearchs('svc_domain', { svcnum => $self->svcnum } ); -} - -=back - -=head1 VERSION - -$Id: domain_record.pm,v 1.11 2002-06-23 19:16:45 ivan Exp $ - -=head1 BUGS - -The data validation doesn't check everything it could. In particular, -there is no protection against bad data that passes the regex, duplicate -SOA records, forgetting the trailing `.', impossible IP addersses, etc. Of -course, it's still better than editing the zone files directly. :) - -=head1 SEE ALSO - -L, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/export_svc.pm b/FS/FS/export_svc.pm deleted file mode 100644 index da9ac698a..000000000 --- a/FS/FS/export_svc.pm +++ /dev/null @@ -1,123 +0,0 @@ -package FS::export_svc; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); -use FS::part_export; -use FS::part_svc; - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::export_svc - Object methods for export_svc records - -=head1 SYNOPSIS - - use FS::export_svc; - - $record = new FS::export_svc \%hash; - $record = new FS::export_svc { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::export_svc object links a service definition (see L) to -an export (see L). FS::export_svc inherits from FS::Record. -The following fields are currently supported: - -=over 4 - -=item exportsvcnum - primary key - -=item exportnum - export (see L) - -=item svcpart - service definition (see L) - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new record. To add the record to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'export_svc'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=cut - -# the insert method can be inherited from FS::Record - -=item delete - -Delete this record from the database. - -=cut - -# the delete method can be inherited from FS::Record - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -# the replace method can be inherited from FS::Record - -=item check - -Checks all fields to make sure this is a valid record. If there is -an error, returns the error, otherwise returns false. Called by the insert -and replace methods. - -=cut - -# the check method should currently be supplied - FS::Record contains some -# data checking routines - -sub check { - my $self = shift; - - $self->ut_numbern('exportsvcnum') - || $self->ut_number('exportnum') - || $self->ut_foreign_key('exportnum', 'part_export', 'exportnum') - || $self->ut_number('svcpart') - || $self->ut_foreign_key('svcpart', 'part_svc', 'svcpart') - ; -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L, L, L, schema.html from the base -documentation. - -=cut - -1; - diff --git a/FS/FS/msgcat.pm b/FS/FS/msgcat.pm deleted file mode 100644 index fa10d34fa..000000000 --- a/FS/FS/msgcat.pm +++ /dev/null @@ -1,132 +0,0 @@ -package FS::msgcat; - -use strict; -use vars qw( @ISA ); -use Exporter; -use FS::UID; -use FS::Record qw( qsearchs ); - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::msgcat - Object methods for message catalog entries - -=head1 SYNOPSIS - - use FS::msgcat; - - $record = new FS::msgcat \%hash; - $record = new FS::msgcat { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::msgcat object represents an message catalog entry. FS::msgcat inherits -from FS::Record. The following fields are currently supported: - -=over 4 - -=item msgnum - primary key - -=item msgcode - Error code - -=item locale - Locale - -=item msg - Message - -=back - -If you just want to B message catalogs, see L. - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new example. To add the example to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'msgcat'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=cut - -# the insert method can be inherited from FS::Record - -=item delete - -Delete this record from the database. - -=cut - -# the delete method can be inherited from FS::Record - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -# the replace method can be inherited from FS::Record - -=item check - -Checks all fields to make sure this is a valid example. If there is -an error, returns the error, otherwise returns false. Called by the insert -and replace methods. - -=cut - -# the check method should currently be supplied - FS::Record contains some -# data checking routines - -sub check { - my $self = shift; - - my $error = - $self->ut_numbern('msgnum') - || $self->ut_text('msgcode') - || $self->ut_text('msg') - ; - return $error if $error; - - $self->locale =~ /^([\w\@]+)$/ or return "illegal locale: ". $self->locale; - $self->locale($1); - - ''; #no error -} - -=back - -=head1 BUGS - -i18n/l10n, eek - -=head1 SEE ALSO - -L, L, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/nas.pm b/FS/FS/nas.pm deleted file mode 100644 index 58c6827ea..000000000 --- a/FS/FS/nas.pm +++ /dev/null @@ -1,152 +0,0 @@ -package FS::nas; - -use strict; -use vars qw( @ISA ); -use FS::Record qw(qsearchs); #qsearch); -use FS::UID qw( dbh ); - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::nas - Object methods for nas records - -=head1 SYNOPSIS - - use FS::nas; - - $record = new FS::nas \%hash; - $record = new FS::nas { - 'nasnum' => 1, - 'nasip' => '10.4.20.23', - 'nasfqdn' => 'box1.brc.nv.us.example.net', - }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - - $error = $record->heartbeat($timestamp); - -=head1 DESCRIPTION - -An FS::nas object represents an Network Access Server on your network, such as -a terminal server or equivalent. FS::nas inherits from FS::Record. The -following fields are currently supported: - -=over 4 - -=item nasnum - primary key - -=item nas - NAS name - -=item nasip - NAS ip address - -=item nasfqdn - NAS fully-qualified domain name - -=item last - timestamp indicating the last instant the NAS was in a known - state (used by the session monitoring). - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new NAS. To add the NAS to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'nas'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=cut - -# the insert method can be inherited from FS::Record - -=item delete - -Delete this record from the database. - -=cut - -# the delete method can be inherited from FS::Record - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -# the replace method can be inherited from FS::Record - -=item check - -Checks all fields to make sure this is a valid example. If there is -an error, returns the error, otherwise returns false. Called by the insert -and replace methods. - -=cut - -# the check method should currently be supplied - FS::Record contains some -# data checking routines - -sub check { - my $self = shift; - - $self->ut_numbern('nasnum') - || $self->ut_text('nas') - || $self->ut_ip('nasip') - || $self->ut_domain('nasfqdn') - || $self->ut_numbern('last'); -} - -=item heartbeat TIMESTAMP - -Updates the timestamp for this nas - -=cut - -sub heartbeat { - my($self, $timestamp) = @_; - my $dbh = dbh; - my $sth = - $dbh->prepare("UPDATE nas SET last = ? WHERE nasnum = ? AND last < ?"); - $sth->execute($timestamp, $self->nasnum, $timestamp) or die $sth->errstr; - $self->last($timestamp); -} - -=back - -=head1 VERSION - -$Id: nas.pm,v 1.6 2002-03-04 12:48:49 ivan Exp $ - -=head1 BUGS - -heartbeat method uses SQL directly and doesn't update history tables. - -=head1 SEE ALSO - -L, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/part_bill_event.pm b/FS/FS/part_bill_event.pm deleted file mode 100644 index a31b09b36..000000000 --- a/FS/FS/part_bill_event.pm +++ /dev/null @@ -1,183 +0,0 @@ -package FS::part_bill_event; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); -use FS::Conf; - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::part_bill_event - Object methods for part_bill_event records - -=head1 SYNOPSIS - - use FS::part_bill_event; - - $record = new FS::part_bill_event \%hash; - $record = new FS::part_bill_event { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::part_bill_event object represents an invoice event definition - -a callback which is triggered when an invoice is a certain amount of time -overdue. FS::part_bill_event inherits from -FS::Record. The following fields are currently supported: - -=over 4 - -=item eventpart - primary key - -=item payby - CARD, BILL, or COMP - -=item event - event name - -=item eventcode - event action - -=item seconds - how long after the invoice date events of this type are triggered - -=item weight - ordering for events with identical seconds - -=item plan - eventcode plan - -=item plandata - additional plan data - -=item disabled - Disabled flag, empty or `Y' - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new invoice event definition. To add the example to the database, -see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'part_bill_event'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=cut - -# the insert method can be inherited from FS::Record - -=item delete - -Delete this record from the database. - -=cut - -# the delete method can be inherited from FS::Record - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -# the replace method can be inherited from FS::Record - -=item check - -Checks all fields to make sure this is a valid invoice event definition. If -there is an error, returns the error, otherwise returns false. Called by the -insert and replace methods. - -=cut - -# the check method should currently be supplied - FS::Record contains some -# data checking routines - -sub check { - my $self = shift; - - $self->weight(0) unless $self->weight; - - my $conf = new FS::Conf; - if ( $conf->exists('safe-part_bill_event') ) { - my $error = $self->ut_anything('eventcode'); - return $error if $error; - - my $c = $self->eventcode; - - $c =~ /^\s*\$cust_main\->(suspend|cancel|invoicing_list_addpost|bill|collect)\(\);\s*("";)?\s*$/ - - or $c =~ /^\s*\$cust_bill\->(comp|realtime_card|realtime_card_cybercash|batch_card|send)\(\);\s*$/ - - or $c =~ /^\s*\$cust_bill\->send\(\'\w+\'\);\s*$/ - - or $c =~ /^\s*\$cust_main\->apply_payments; \$cust_main->apply_credits; "";\s*$/ - - or $c =~ /^\s*\$cust_main\->charge\( \s*\d*\.?\d*\s*,\s*\'[\w \!\@\#\$\%\&\(\)\-\+\;\:\"\,\.\?\/]*\'\s*\);\s*$/ - - or do { - #log - return "illegal eventcode: $c"; - }; - - } - - my $error = $self->ut_numbern('eventpart') - || $self->ut_enum('payby', [qw( CARD BILL COMP )] ) - || $self->ut_text('event') - || $self->ut_anything('eventcode') - || $self->ut_number('seconds') - || $self->ut_enum('disabled', [ '', 'Y' ] ) - || $self->ut_number('weight') - || $self->ut_textn('plan') - || $self->ut_anything('plandata') - ; - return $error if $error; - - #quelle kludge - if ( $self->plandata =~ /^templatename\s+(.*)$/ ) { - my $name= $1; - unless ( $conf->exists("invoice_template_$name") ) { - $conf->set( - "invoice_template_$name" => - join("\n", $conf->config('invoice_template') ) - ); - } - } - - ''; - -} - -=back - -=head1 BUGS - -Alas. - -=head1 SEE ALSO - -L, L, L, schema.html from the -base documentation. - -=cut - -1; - diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm deleted file mode 100644 index 4f45fbeec..000000000 --- a/FS/FS/part_export.pm +++ /dev/null @@ -1,850 +0,0 @@ -package FS::part_export; - -use strict; -use vars qw( @ISA @EXPORT_OK %exports ); -use Exporter; -use Tie::IxHash; -use FS::Record qw( qsearch qsearchs dbh ); -use FS::part_svc; -use FS::part_export_option; -use FS::export_svc; - -@ISA = qw(FS::Record); -@EXPORT_OK = qw(export_info); - -=head1 NAME - -FS::part_export - Object methods for part_export records - -=head1 SYNOPSIS - - use FS::part_export; - - $record = new FS::part_export \%hash; - $record = new FS::part_export { 'column' => 'value' }; - - #($new_record, $options) = $template_recored->clone( $svcpart ); - - $error = $record->insert( { 'option' => 'value' } ); - $error = $record->insert( \%options ); - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::part_export object represents an export of Freeside data to an external -provisioning system. FS::part_export inherits from FS::Record. The following -fields are currently supported: - -=over 4 - -=item exportnum - primary key - -=item machine - Machine name - -=item exporttype - Export type - -=item nodomain - blank or "Y" : usernames are exported to this service with no domain - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new export. To add the export to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'part_export'; } - -=cut - -#=item clone SVCPART -# -#An alternate constructor. Creates a new export by duplicating an existing -#export. The given svcpart is assigned to the new export. -# -#Returns a list consisting of the new export object and a hashref of options. -# -#=cut -# -#sub clone { -# my $self = shift; -# my $class = ref($self); -# my %hash = $self->hash; -# $hash{'exportnum'} = ''; -# $hash{'svcpart'} = shift; -# ( $class->new( \%hash ), -# { map { $_->optionname => $_->optionvalue } -# qsearch('part_export_option', { 'exportnum' => $self->exportnum } ) -# } -# ); -#} - -=item insert HASHREF - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -If a hash reference of options is supplied, part_export_option records are -created (see L). - -=cut - -#false laziness w/queue.pm -sub insert { - my $self = shift; - my $options = shift; - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $error = $self->SUPER::insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - foreach my $optionname ( keys %{$options} ) { - my $part_export_option = new FS::part_export_option ( { - 'exportnum' => $self->exportnum, - 'optionname' => $optionname, - 'optionvalue' => $options->{$optionname}, - } ); - $error = $part_export_option->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; - -} - -=item delete - -Delete this record from the database. - -=cut - -#foreign keys would make this much less tedious... grr dumb mysql -sub delete { - my $self = shift; - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $error = $self->SUPER::delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - foreach my $part_export_option ( $self->part_export_option ) { - my $error = $part_export_option->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - foreach my $export_svc ( $self->export_svc ) { - my $error = $export_svc->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; - -} - -=item replace OLD_RECORD HASHREF - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -If a hash reference of options is supplied, part_export_option records are -created or modified (see L). - -=cut - -sub replace { - my $self = shift; - my $old = shift; - my $options = shift; - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $error = $self->SUPER::replace($old); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - foreach my $optionname ( keys %{$options} ) { - my $old = qsearchs( 'part_export_option', { - 'exportnum' => $self->exportnum, - 'optionname' => $optionname, - } ); - my $new = new FS::part_export_option ( { - 'exportnum' => $self->exportnum, - 'optionname' => $optionname, - 'optionvalue' => $options->{$optionname}, - } ); - $new->optionnum($old->optionnum) if $old; - my $error = $old ? $new->replace($old) : $new->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - #remove extraneous old options - foreach my $opt ( - grep { !exists $options->{$_->optionname} } $old->part_export_option - ) { - my $error = $opt->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; - -}; - -=item check - -Checks all fields to make sure this is a valid export. If there is -an error, returns the error, otherwise returns false. Called by the insert -and replace methods. - -=cut - -sub check { - my $self = shift; - my $error = - $self->ut_numbern('exportnum') - || $self->ut_domain('machine') - || $self->ut_alpha('exporttype') - ; - return $error if $error; - - warn $self->machine. "!!!\n"; - - $self->machine =~ /^([\w\-\.]*)$/ - or return "Illegal machine: ". $self->machine; - $self->machine($1); - - $self->nodomain =~ /^(Y?)$/ or return "Illegal nodomain: ". $self->nodomain; - $self->nodomain($1); - - $self->deprecated(1); #BLAH - - #check exporttype? - - ''; #no error -} - -#=item part_svc -# -#Returns the service definition (see L) for this export. -# -#=cut -# -#sub part_svc { -# my $self = shift; -# qsearchs('part_svc', { svcpart => $self->svcpart } ); -#} - -sub part_svc { - use Carp; - croak "FS::part_export::part_svc deprecated"; - #confess "FS::part_export::part_svc deprecated"; -} - -=item export_svc - -Returns a list of associated FS::export_svc records. - -=cut - -sub export_svc { - my $self = shift; - qsearch('export_svc', { 'exportnum' => $self->exportnum } ); -} - -=item part_export_option - -Returns all options as FS::part_export_option objects (see -L). - -=cut - -sub part_export_option { - my $self = shift; - qsearch('part_export_option', { 'exportnum' => $self->exportnum } ); -} - -=item options - -Returns a list of option names and values suitable for assigning to a hash. - -=cut - -sub options { - my $self = shift; - map { $_->optionname => $_->optionvalue } $self->part_export_option; -} - -=item option OPTIONNAME - -Returns the option value for the given name, or the empty string. - -=cut - -sub option { - my $self = shift; - my $part_export_option = - qsearchs('part_export_option', { - exportnum => $self->exportnum, - optionname => shift, - } ); - $part_export_option ? $part_export_option->optionvalue : ''; -} - -=item rebless - -Reblesses the object into the FS::part_export::EXPORTTYPE class, where -EXPORTTYPE is the object's I field. There should be better docs -on how to create new exports (and they should live in their own files and be -autoloaded-on-demand), but until then, see L. - -=cut - -sub rebless { - my $self = shift; - my $exporttype = $self->exporttype; - my $class = ref($self). "::$exporttype"; - eval "use $class;"; - die $@ if $@; - bless($self, $class); -} - -=item export_insert SVC_OBJECT - -=cut - -sub export_insert { - my $self = shift; - $self->rebless; - $self->_export_insert(@_); -} - -#sub AUTOLOAD { -# my $self = shift; -# $self->rebless; -# my $method = $AUTOLOAD; -# #$method =~ s/::(\w+)$/::_$1/; #infinite loop prevention -# $method =~ s/::(\w+)$/_$1/; #infinite loop prevention -# $self->$method(@_); -#} - -=item export_replace NEW OLD - -=cut - -sub export_replace { - my $self = shift; - $self->rebless; - $self->_export_replace(@_); -} - -=item export_delete - -=cut - -sub export_delete { - my $self = shift; - $self->rebless; - $self->_export_delete(@_); -} - -=item export_suspend - -=cut - -sub export_suspend { - my $self = shift; - $self->rebless; - $self->_export_suspend(@_); -} - -=item export_unsuspend - -=cut - -sub export_unsuspend { - my $self = shift; - $self->rebless; - $self->_export_unsuspend(@_); -} - -#fallbacks providing useful error messages intead of infinite loops -sub _export_insert { - my $self = shift; - return "_export_insert: unknown export type ". $self->exporttype; -} - -sub _export_replace { - my $self = shift; - return "_export_replace: unknown export type ". $self->exporttype; -} - -sub _export_delete { - my $self = shift; - return "_export_delete: unknown export type ". $self->exporttype; -} - -#fallbacks providing null operations - -sub _export_suspend { - my $self = shift; - #warn "warning: _export_suspened unimplemented for". ref($self); - ''; -} - -sub _export_unsuspend { - my $self = shift; - #warn "warning: _export_unsuspend unimplemented for ". ref($self); - ''; -} - -=back - -=head1 SUBROUTINES - -=over 4 - -=item export_info [ SVCDB ] - -Returns a hash reference of the exports for the given I, or if no -I is specified, for all exports. The keys of the hash are -Is and the values are again hash references containing information -on the export: - - 'desc' => 'Description', - 'options' => { - 'option' => { label=>'Option Label' }, - 'option2' => { label=>'Another label' }, - }, - 'nodomain' => 'Y', #or '' - 'notes' => 'Additional notes', - -=cut - -sub export_info { - #warn $_[0]; - return $exports{$_[0]} if @_; - #{ map { %{$exports{$_}} } keys %exports }; - my $r = { map { %{$exports{$_}} } keys %exports }; -} - -#=item exporttype2svcdb EXPORTTYPE -# -#Returns the applicable I for an I. -# -#=cut -# -#sub exporttype2svcdb { -# my $exporttype = $_[0]; -# foreach my $svcdb ( keys %exports ) { -# return $svcdb if grep { $exporttype eq $_ } keys %{$exports{$svcdb}}; -# } -# ''; -#} - -tie my %sysvshell_options, 'Tie::IxHash', - 'crypt' => { label=>'Password encryption', - type=>'select', options=>[qw(crypt md5)], - default=>'crypt', - }, -; - -tie my %bsdshell_options, 'Tie::IxHash', - 'crypt' => { label=>'Password encryption', - type=>'select', options=>[qw(crypt md5)], - default=>'crypt', - }, -; - -tie my %shellcommands_options, 'Tie::IxHash', - #'machine' => { label=>'Remote machine' }, - 'user' => { label=>'Remote username', default=>'root' }, - 'useradd' => { label=>'Insert command', - default=>'useradd -d $dir -m -s $shell -u $uid -p $crypt_password $username' - #default=>'cp -pr /etc/skel $dir; chown -R $uid.$gid $dir' - }, - 'useradd_stdin' => { label=>'Insert command STDIN', - type =>'textarea', - default=>'', - }, - 'userdel' => { label=>'Delete command', - default=>'userdel -r $username', - #default=>'rm -rf $dir', - }, - 'userdel_stdin' => { label=>'Delete command STDIN', - type =>'textarea', - default=>'', - }, - 'usermod' => { label=>'Modify command', - default=>'usermod -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -p $new_crypt_password $old_username', - #default=>'[ -d $old_dir ] && mv $old_dir $new_dir || ( '. - # 'chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; '. - # 'find . -depth -print | cpio -pdm $new_dir; '. - # 'chmod u-t $new_dir; chown -R $uid.$gid $new_dir; '. - # 'rm -rf $old_dir'. - #')' - }, - 'usermod_stdin' => { label=>'Modify command STDIN', - type =>'textarea', - default=>'', - }, -; - -tie my %shellcommands_withdomain_options, 'Tie::IxHash', - 'user' => { label=>'Remote username', default=>'root' }, - 'useradd' => { label=>'Insert command', - #default=>'' - }, - 'useradd_stdin' => { label=>'Insert command STDIN', - type =>'textarea', - #default=>"$_password\n$_password\n", - }, - 'userdel' => { label=>'Delete command', - #default=>'', - }, - 'userdel_stdin' => { label=>'Delete command STDIN', - type =>'textarea', - #default=>'', - }, - 'usermod' => { label=>'Modify command', - default=>'', - }, - 'usermod_stdin' => { label=>'Modify command STDIN', - type =>'textarea', - #default=>"$_password\n$_password\n", - }, -; - -tie my %www_shellcommands_options, 'Tie::IxHash', - 'user' => { lable=>'Remote username', default=>'root' }, - 'useradd' => { label=>'Insert command', - default=>'mkdir /var/www/$zone; chown $username /var/www/$zone; ln -s /var/www/$zone $homedir/$zone', - }, - 'userdel' => { label=>'Delete command', - default=>'[ -n "$zone" ] && rm -rf /var/www/$zone; rm $homedir/$zone', - }, - 'usermod' => { label=>'Modify command', - default=>'[ -n "$old_zone" ] && rm $old_homedir/$old_zone; [ "$old_zone" != "$new_zone" -a -n "$new_zone" ] && mv /var/www/$old_zone /var/www/$new_zone; [ "$old_username" != "$new_username" ] && chown -R $new_username /var/www/$new_zone; ln -s /var/www/$new_zone $new_homedir/$new_zone', - }, -; - -tie my %textradius_options, 'Tie::IxHash', - 'user' => { label=>'Remote username', default=>'root' }, - 'users' => { label=>'users file location', default=>'/etc/raddb/users' }, -; - -tie my %sqlradius_options, 'Tie::IxHash', - 'datasrc' => { label=>'DBI data source ' }, - 'username' => { label=>'Database username' }, - 'password' => { label=>'Database password' }, -; - -tie my %cyrus_options, 'Tie::IxHash', - 'server' => { label=>'IMAP server' }, - 'username' => { label=>'Admin username' }, - 'password' => { label=>'Admin password' }, -; - -tie my %cp_options, 'Tie::IxHash', - 'host' => { label=>'Hostname' }, - 'port' => { label=>'Port number' }, - 'username' => { label=>'Username' }, - 'password' => { label=>'Password' }, - 'domain' => { label=>'Domain' }, - 'workgroup' => { label=>'Default Workgroup' }, -; - -tie my %infostreet_options, 'Tie::IxHash', - 'url' => { label=>'XML-RPC Access URL', }, - 'login' => { label=>'InfoStreet login', }, - 'password' => { label=>'InfoStreet password', }, - 'groupID' => { label=>'InfoStreet groupID', }, -; - -tie my %vpopmail_options, 'Tie::IxHash', - 'machine' => { label=>'vpopmail machine', }, - 'dir' => { label=>'directory', }, # ?more info? default? - 'uid' => { label=>'vpopmail uid' }, - 'gid' => { label=>'vpopmail gid' }, -; - -tie my %bind_options, 'Tie::IxHash', - #'machine' => { label=>'named machine' }, - 'named_conf' => { label => 'named.conf location', - default=> '/etc/bind/named.conf' }, - 'zonepath' => { label => 'path to zone files', - default=> '/etc/bind/', }, -; - -tie my %bind_slave_options, 'Tie::IxHash', - #'machine' => { label=> 'Slave machine' }, - 'master' => { label=> 'Master IP address(s) (semicolon-separated)' }, - 'named_conf' => { label => 'named.conf location', - default => '/etc/bind/named.conf' }, -; - -tie my %http_options, 'Tie::IxHash', - 'method' => { label =>'Method', - type =>'select', - #options =>[qw(POST GET)], - options =>[qw(POST)], - default =>'POST' }, - 'url' => { label => 'URL', default => 'http://', }, - 'insert_data' => { - label => 'Insert data', - type => 'textarea', - default => join("\n", - 'DomainName $svc_x->domain', - 'Email ( grep { $_ ne "POST" } $svc_x->cust_svc->cust_pkg->cust_main->invoicing_list)[0]', - 'test 1', - 'reseller $svc_x->cust_svc->cust_pkg->part_pkg->pkg =~ /reseller/i', - ), - }, - 'delete_data' => { - label => 'Delete data', - type => 'textarea', - default => join("\n", - ), - }, - 'replace_data' => { - label => 'Replace data', - type => 'textarea', - default => join("\n", - ), - }, -; - -tie my %sqlmail_options, 'Tie::IxHash', - 'datasrc' => { label=>'DBI data source' }, - 'username' => { label=>'Database username' }, - 'password' => { label=>'Database password' }, -; - - -#export names cannot have dashes... -%exports = ( - 'svc_acct' => { - 'sysvshell' => { - 'desc' => - 'Batch export of /etc/passwd and /etc/shadow files (Linux/SysV).', - 'options' => \%sysvshell_options, - 'nodomain' => 'Y', - 'notes' => 'MD5 crypt requires installation of Crypt::PasswdMD5 from CPAN. Run bin/sysvshell.export to export the files.', - }, - 'bsdshell' => { - 'desc' => - 'Batch export of /etc/passwd and /etc/master.passwd files (BSD).', - 'options' => \%bsdshell_options, - 'nodomain' => 'Y', - 'notes' => 'MD5 crypt requires installation of Crypt::PasswdMD5 from CPAN. Run bin/bsdshell.export to export the files.', - }, -# 'nis' => { -# 'desc' => -# 'Batch export of /etc/global/passwd and /etc/global/shadow for NIS ', -# 'options' => {}, -# }, - 'textradius' => { - 'desc' => 'Real-time export to a text /etc/raddb/users file (Livingston, Cistron)', - 'options' => \%textradius_options, - 'notes' => 'This will edit a text RADIUS users file in place on a remote server. Requires installation of RADIUS::UserFile from CPAN. If using RADIUS::UserFile 1.01, make sure to apply this patch. Also make sure rsync is installed on the remote machine, and SSH is setup for unattended operation.', - }, - - 'shellcommands' => { - 'desc' => 'Real-time export via remote SSH (i.e. useradd, userdel, etc.)', - 'options' => \%shellcommands_options, - 'nodomain' => 'Y', - 'notes' => 'Run remote commands via SSH. Usernames are considered unique (also see shellcommands_withdomain). You probably want this if the commands you are running will not accept a domain as a parameter. You will need to setup SSH for unattended operation.

Use these buttons for some useful presets:
', - }, - - 'shellcommands_withdomain' => { - 'desc' => 'Real-time export via remote SSH.', - 'options' => \%shellcommands_withdomain_options, - 'notes' => 'Run remote commands via SSH. username@domain (rather than just usernames) are considered unique (also see shellcommands). You probably want this if the commands you are running will accept a domain as a parameter, and will allow the same username with different domains. You will need to setup SSH for unattended operation.', - }, - - 'sqlradius' => { - 'desc' => 'Real-time export to SQL-backed RADIUS (ICRADIUS, FreeRADIUS)', - 'options' => \%sqlradius_options, - 'nodomain' => 'Y', - 'notes' => 'Real-time export of radcheck, radreply and usergroup tables to any SQL database for FreeRADIUS or ICRADIUS. An existing RADIUS database will be updated in realtime, but you can use freeside-sqlradius-reset to delete the entire RADIUS database and repopulate the tables from the Freeside database. See the DBI documentation and the documentation for your DBD for the exact syntax of a DBI data source. If using FreeRADIUS 0.5 or above, make sure your op fields are set to allow NULL values.', - }, - - 'sqlmail' => { - 'desc' => 'Real-time export to SQL-backed mail server', - 'options' => \%sqlmail_options, - 'nodomain' => 'Y', - 'notes' => 'Database schema can be made to work with Courier IMAP and Exim. Others could work but are untested. (...extended description from pc-intouch?...)', - }, - - 'cyrus' => { - 'desc' => 'Real-time export to Cyrus IMAP server', - 'options' => \%cyrus_options, - 'nodomain' => 'Y', - 'notes' => 'Integration with Cyrus IMAP Server. Cyrus::IMAP::Admin should be installed locally and the connection to the server secured. svc_acct.quota, if available, is used to set the Cyrus quota. ' - }, - - 'cp' => { - 'desc' => 'Real-time export to Critical Path Account Provisioning Protocol', - 'options' => \%cp_options, - 'notes' => 'Real-time export to Critial Path Account Provisioning Protocol. Requires installation of Net::APP from CPAN.', - }, - - 'infostreet' => { - 'desc' => 'Real-time export to InfoStreet streetSmartAPI', - 'options' => \%infostreet_options, - 'nodomain' => 'Y', - 'notes' => 'Real-time export to InfoStreet streetSmartAPI. Requires installation of Frontier::Client from CPAN.', - }, - - 'vpopmail' => { - 'desc' => 'Real-time export to vpopmail text files', - 'options' => \%vpopmail_options, - 'notes' => 'Real time export to vpopmail text files (...extended description from jeff?...)', - }, - - }, - - 'svc_domain' => { - - 'bind' => { - 'desc' =>'Batch export to BIND named', - 'options' => \%bind_options, - 'notes' => 'Batch export of BIND zone and configuration files to primary nameserver. File::Rsync must be installed. Run bin/bind.export to export the files.', - }, - - 'bind_slave' => { - 'desc' =>'Batch export to slave BIND named', - 'options' => \%bind_slave_options, - 'notes' => 'Batch export of BIND configuration file to a secondary nameserver. Zones are slaved from the listed masters. File::Rsync must be installed. Run bin/bind.export to export the files.', - }, - - 'http' => { - 'desc' => 'Send an HTTP or HTTPS GET or POST request', - 'options' => \%http_options, - 'notes' => 'Send an HTTP or HTTPS GET or POST to the specified URL. libwww-perl must be installed. For HTTPS support, Crypt::SSLeay or IO::Socket::SSL is required.', - }, - - 'sqlmail' => { - 'desc' => 'Real-time export to SQL-backed mail server', - 'options' => \%sqlmail_options, - #'nodomain' => 'Y', - 'notes' => 'Database schema can be made to work with Courier IMAP and Exim. Others could work but are untested. (...extended description from pc-intouch?...)', - }, - - - }, - - 'svc_acct_sm' => {}, - - 'svc_forward' => { - 'sqlmail' => { - 'desc' => 'Real-time export to SQL-backed mail server', - 'options' => \%sqlmail_options, - #'nodomain' => 'Y', - 'notes' => 'Database schema can be made to work with Courier IMAP and Exim. Others could work but are untested. (...extended description from pc-intouch?...)', - }, - }, - - 'svc_www' => { - 'www_shellcommands' => { - 'desc' => 'Run remote commands via SSH, for virtual web sites.', - 'options' => \%www_shellcommands_options, - 'notes' => 'Run remote commands via SSH, for virtual web sites. You will need to setup SSH for unattended operation.', - }, - - }, - -); - -=back - -=head1 NEW EXPORT CLASSES - -Should be added to the %export hash here, and a module should be added in -FS/FS/part_export/ (an example may be found in eg/export_template.pm) - -=head1 BUGS - -All the stuff in the %exports hash should be generated from the specific -export modules. - -Hmm... cust_export class (not necessarily a database table...) ... ? - -deprecated column... - -=head1 SEE ALSO - -L, L, L, -L, -L, L, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/part_export/bind.pm b/FS/FS/part_export/bind.pm deleted file mode 100644 index b72c9bdb0..000000000 --- a/FS/FS/part_export/bind.pm +++ /dev/null @@ -1,7 +0,0 @@ -package FS::part_export::bind; - -use vars qw(@ISA); -use FS::part_export::null; - -@ISA = qw(FS::part_export::null); - diff --git a/FS/FS/part_export/bind_slave.pm b/FS/FS/part_export/bind_slave.pm deleted file mode 100644 index ebb29c1d7..000000000 --- a/FS/FS/part_export/bind_slave.pm +++ /dev/null @@ -1,7 +0,0 @@ -package FS::part_export::bind_slave; - -use vars qw(@ISA); -use FS::part_export::null; - -@ISA = qw(FS::part_export::null); - diff --git a/FS/FS/part_export/bsdshell.pm b/FS/FS/part_export/bsdshell.pm deleted file mode 100644 index 06642097f..000000000 --- a/FS/FS/part_export/bsdshell.pm +++ /dev/null @@ -1,7 +0,0 @@ -package FS::part_export::bsdshell; - -use vars qw(@ISA); -use FS::part_export::null; - -@ISA = qw(FS::part_export::null); - diff --git a/FS/FS/part_export/cp.pm b/FS/FS/part_export/cp.pm deleted file mode 100644 index d998c1d95..000000000 --- a/FS/FS/part_export/cp.pm +++ /dev/null @@ -1,112 +0,0 @@ -package FS::part_export::cp; - -use vars qw(@ISA); -use FS::part_export; - -@ISA = qw(FS::part_export); - -sub rebless { shift; } - -sub _export_insert { - my( $self, $svc_acct ) = (shift, shift); - $self->cp_queue( $svc_acct->svcnum, 'create_mailbox', - Mailbox => $svc_acct->username, - Password => $svc_acct->_password, - Workgroup => $self->option('workgroup'), - Domain => $svc_acct->domain, - ); -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - return "can't change domain with Critical Path" - if $old->domain ne $new->domain; - return '' unless $old->username ne $new->username - || $old->_password ne $new->_password; - $self->cp_queue( $new->svcnum, 'replace', $new->domain, - $old->username, $new->username, $old->_password, $new->_password ); -} - -sub _export_delete { - my( $self, $svc_acct ) = (shift, shift); - $self->cp_queue( $svc_acct->svcnum, 'delete_mailbox', - Mailbox => $svc_acct->username, - Domain => $svc_acct->domain, - ); -} - -sub cp_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => 'FS::part_export::cp::cp_command', - }; - $queue->insert( - $self->option('host'), - $self->option('port'), - $self->option('username'), - $self->option('password'), - $self->option('domain'), - $method, - @_, - ); -} - -sub cp_command { #subroutine, not method - my($host, $port, $username, $password, $login_domain, $method, @args) = @_; - - #quelle hack - if ( $method eq 'replace' ) { - - my( $domain, $old_username, $new_username, $old_password, $new_password) - = @args; - - if ( $old_username ne $new_username ) { - cp_command($host, $port, $username, $password, 'rename_mailbox', - Domain => $domain, - Old_Mailbox => $old_username, - New_Mailbox => $new_username, - ); - } - - my $other = 'F'; - if ( $new_password =~ /^\*SUSPENDED\* (.*)$/ ) { - $new_password = $1; - $other = 'T'; - } - cp_command($host, $port, $username, $password, 'set_mailbox_status', - Domain => $domain, - Mailbox => $new_username, - Other => $other, - Other_Bounce => $other, - ); - - if ( $old_password ne $new_password ) { - cp_command($host, $port, $username, $password, 'change_mailbox', - Domain => $domain, - Mailbox => $new_username, - Password => $new_password, - ); - } - - return; - } - #eof quelle hack - - eval "use Net::APP;"; - - my $app = new Net::APP ( - "$host:$port", - User => $username, - Password => $password, - Domain => $login_domain, - Timeout => 60, - #Debug => 1, - ) or die "$@\n"; - - $app->$method( @args ); - - die $app->message."\n" unless $app->ok; - -} - diff --git a/FS/FS/part_export/cyrus.pm b/FS/FS/part_export/cyrus.pm deleted file mode 100644 index 110ff198f..000000000 --- a/FS/FS/part_export/cyrus.pm +++ /dev/null @@ -1,98 +0,0 @@ -package FS::part_export::cyrus; - -use vars qw(@ISA); -use FS::part_export; - -@ISA = qw(FS::part_export); - -sub rebless { shift; } - -sub _export_insert { - my($self, $svc_acct) = (shift, shift); - $self->cyrus_queue( $svc_acct->svcnum, 'insert', - $svc_acct->username, $svc_acct->quota ); -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - return "can't change username using Cyrus" - if $old->username ne $new->username; - return ''; -# #return '' unless $old->_password ne $new->_password; -# $self->cyrus_queue( $new->svcnum, -# 'replace', $new->username, $new->_password ); -} - -sub _export_delete { - my( $self, $svc_acct ) = (shift, shift); - $self->cyrus_queue( $svc_acct->svcnum, 'delete', - $svc_acct->username ); -} - -#a good idea to queue anything that could fail or take any time -sub cyrus_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::cyrus::cyrus_$method", - }; - $queue->insert( - $self->option('server'), - $self->option('username'), - $self->option('password'), - @_ - ); -} - -sub cyrus_insert { #subroutine, not method - my $client = cyrus_connect(shift, shift, shift); - my( $username, $quota ) = @_; - my $rc = $client->create("user.$username"); - my $error = $client->error; - die "creating user.$username: $error" if $error; - - $rc = $client->setacl("user.$username", $username => 'all' ); - $error = $client->error; - die "setacl user.$username: $error" if $error; - - if ( $quota ) { - $rc = $client->setquota("user.$username", 'STORAGE' => $quota ); - $error = $client->error; - die "setquota user.$username: $error" if $error; - } - -} - -sub cyrus_delete { #subroutine, not method - my ( $server, $admin_username, $password_username, $username ) = @_; - my $client = cyrus_connect($server, $admin_username, $password_username); - - my $rc = $client->setacl("user.$username", $admin_username => 'all' ); - my $error = $client->error; - die $error if $error; - - $rc = $client->delete("user.$username"); - $error = $client->error; - die $error if $error; -} - -sub cyrus_connect { - - my( $server, $admin_username, $admin_password ) = @_; - - eval "use Cyrus::IMAP::Admin;"; - - my $client = Cyrus::IMAP::Admin->new($server); - $client->authenticate( - -user => $admin_username, - -mechanism => "login", - -password => $admin_password, - ); - $client; - -} - -#sub cyrus_replace { #subroutine, not method -#} - - diff --git a/FS/FS/part_export/http.pm b/FS/FS/part_export/http.pm deleted file mode 100644 index 0e02f0f8e..000000000 --- a/FS/FS/part_export/http.pm +++ /dev/null @@ -1,88 +0,0 @@ -package FS::part_export::http; - -use vars qw(@ISA); -use FS::part_export; - -@ISA = qw(FS::part_export); - -sub rebless { shift; } - -sub _export_insert { - my $self = shift; - $self->_export_command('insert', @_); -} - -sub _export_delete { - my $self = shift; - $self->_export_command('delete', @_); -} - -sub _export_command { - my( $self, $action, $svc_x ) = ( shift, shift, shift ); - - return unless $self->option("${action}_data"); - - $self->http_queue( $svc_x->svcnum, - $self->option('method'), - $self->option('url'), - map { - /^\s*(\S+)\s+(.*)$/ or /()()/; - my( $field, $value_expression ) = ( $1, $2 ); - my $value = eval $value_expression; - die $@ if $@; - ( $field, $value ); - } split(/\n/, $self->option("${action}_data") ) - ); - -} - -sub _export_replace { - my( $self, $new, $old ) = ( shift, shift, shift ); - - return unless $self->option('replace_data'); - - $self->http_queue( $svc_x->svcnum, - $self->option('method'), - $self->option('url'), - map { - /^\s*(\S+)\s+(.*)$/ or /()()/; - my( $field, $value_expression ) = ( $1, $2 ); - die $@ if $@; - ( $field, $value ); - } split(/\n/, $self->option('replace_data') ) - ); - -} - -sub http_queue { - my($self, $svcnum) = (shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::http::http", - }; - $queue->insert( @_ ); -} - -sub http { - my($method, $url, @data) = @_; - - $method = lc($method); - - eval "use LWP::UserAgent;"; - die "using LWP::UserAgent: $@" if $@; - eval "use HTTP::Request::Common;"; - die "using HTTP::Request::Common: $@" if $@; - - my $ua = LWP::UserAgent->new; - - #my $response = $ua->$method( - # $url, \%data, - # 'Content-Type'=>'application/x-www-form-urlencoded' - #); - my $req = HTTP::Request::Common::POST( $url, \@data ); - my $response = $ua->request($req); - - die $response->error_as_HTML if $response->is_error; - -} - diff --git a/FS/FS/part_export/infostreet.pm b/FS/FS/part_export/infostreet.pm deleted file mode 100644 index f2d519932..000000000 --- a/FS/FS/part_export/infostreet.pm +++ /dev/null @@ -1,218 +0,0 @@ -package FS::part_export::infostreet; - -use vars qw(@ISA %infostreet2cust_main $DEBUG); -use FS::UID qw(dbh); -use FS::part_export; - -@ISA = qw(FS::part_export); - -$DEBUG = 0; - -%infostreet2cust_main = ( - 'firstName' => 'first', - 'lastName' => 'last', - 'address1' => 'address1', - 'address2' => 'address2', - 'city' => 'city', - 'state' => 'state', - 'zipCode' => 'zip', - 'country' => 'country', - 'phoneNumber' => 'daytime', - 'faxNumber' => 'night', #noment-request... -); - -sub rebless { shift; } - -sub _export_insert { - my( $self, $svc_acct ) = (shift, shift); - my $cust_main = $svc_acct->cust_svc->cust_pkg->cust_main; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $err_or_queue = $self->infostreet_err_or_queue( $svc_acct->svcnum, - 'createUser', $svc_acct->username, $svc_acct->_password ); - return $err_or_queue unless ref($err_or_queue); - my $jobnum = $err_or_queue->jobnum; - - my %contact_info = ( map { - $_ => $cust_main->getfield( $infostreet2cust_main{$_} ); - } keys %infostreet2cust_main ); - - my @emails = grep { $_ ne 'POST' } $cust_main->invoicing_list; - $contact_info{'email'} = $emails[0] if @emails; - - #this one is kinda noment-specific - $contact_info{'organization'} = $cust_main->agent->agent; - - $err_or_queue = $self->infostreet_queueContact( $svc_acct->svcnum, - $svc_acct->username, %contact_info ); - return $err_or_queue unless ref($err_or_queue); - my $error = $err_or_queue->depend_insert( $jobnum ); - return $error if $error; - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; - -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - return "can't change username with InfoStreet" - if $old->username ne $new->username; - return '' unless $old->_password ne $new->_password; - $self->infostreet_queue( $new->svcnum, - 'passwd', $new->username, $new->_password ); -} - -sub _export_delete { - my( $self, $svc_acct ) = (shift, shift); - $self->infostreet_queue( $svc_acct->svcnum, - 'purgeAccount,releaseUsername', $svc_acct->username ); -} - -sub _export_suspend { - my( $self, $svc_acct ) = (shift, shift); - $self->infostreet_queue( $svc_acct->svcnum, - 'setStatus', $svc_acct->username, 'DISABLED' ); -} - -sub _export_unsuspend { - my( $self, $svc_acct ) = (shift, shift); - $self->infostreet_queue( $svc_acct->svcnum, - 'setStatus', $svc_acct->username, 'ACTIVE' ); -} - -sub infostreet_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => 'FS::part_export::infostreet::infostreet_command', - }; - $queue->insert( - $self->option('url'), - $self->option('login'), - $self->option('password'), - $self->option('groupID'), - $method, - @_, - ); -} - -#ick false laziness -sub infostreet_err_or_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => 'FS::part_export::infostreet::infostreet_command', - }; - $queue->insert( - $self->option('url'), - $self->option('login'), - $self->option('password'), - $self->option('groupID'), - $method, - @_, - ) or $queue; -} - -sub infostreet_queueContact { - my( $self, $svcnum ) = (shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => 'FS::part_export::infostreet::infostreet_setContact', - }; - $queue->insert( - $self->option('url'), - $self->option('login'), - $self->option('password'), - $self->option('groupID'), - @_, - ) or $queue; -} - -sub infostreet_setContact { - my($url, $is_username, $is_password, $groupID, $username, %contact_info) = @_; - my $accountID = infostreet_command($url, $is_username, $is_password, $groupID, - 'getAccountID', $username); - foreach my $field ( keys %contact_info ) { - infostreet_command($url, $is_username, $is_password, $groupID, - 'setContactField', [ 'int'=>$accountID ], $field, $contact_info{$field} ); - } - -} - -sub infostreet_command { #subroutine, not method - my($url, $username, $password, $groupID, $method, @args) = @_; - - warn "[FS::part_export::infostreet] $method ".join(' ', @args)."\n" if $DEBUG; - - #quelle hack - if ( $method =~ /,/ ) { - foreach my $part ( split(/,\s*/, $method) ) { - infostreet_command($url, $username, $password, $groupID, $part, @args); - } - return; - } - - eval "use Frontier::Client;"; - die $@ if $@; - - eval 'sub Frontier::RPC2::String::repr { - my $self = shift; - my $value = $$self; - $value =~ s/([&<>\"])/$Frontier::RPC2::char_entities{$1}/ge; - $value; - }'; - die $@ if $@; - - my $conn = Frontier::Client->new( url => $url ); - my $key_result = $conn->call( 'authenticate', $username, $password, $groupID); - my %key_result = _infostreet_parse($key_result); - die $key_result{error} unless $key_result{success}; - my $key = $key_result{data}; - - #my $result = $conn->call($method, $key, @args); - my $result = $conn->call( $method, $key, - map { - if ( ref($_) ) { - my( $type, $value) = @{$_}; - $conn->$type($value); - } else { - $conn->string($_); - } - } @args ); - my %result = _infostreet_parse($result); - die $result{error} unless $result{success}; - - $result->{data}; - -} - -#sub infostreet_command_byid { #subroutine, not method; -# my($url, $username, $password, $groupID, $method, @args ) = @_; -# -# infostreet_command -# -#} - -sub _infostreet_parse { #subroutine, not method - my $arg = shift; - map { - my $value = $arg->{$_}; - #warn ref($value); - $value = $value->value() - if ref($value) && $value->isa('Frontier::RPC2::DataType'); - $_=>$value; - } keys %$arg; -} - - diff --git a/FS/FS/part_export/null.pm b/FS/FS/part_export/null.pm deleted file mode 100644 index 0145af3a4..000000000 --- a/FS/FS/part_export/null.pm +++ /dev/null @@ -1,13 +0,0 @@ -package FS::part_export::null; - -use vars qw(@ISA); -use FS::part_export; - -@ISA = qw(FS::part_export); - -sub rebless { shift; } - -sub _export_insert {} -sub _export_replace {} -sub _export_delete {} - diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm deleted file mode 100644 index e4005761b..000000000 --- a/FS/FS/part_export/shellcommands.pm +++ /dev/null @@ -1,85 +0,0 @@ -package FS::part_export::shellcommands; - -use vars qw(@ISA @saltset); -use String::ShellQuote; -use FS::part_export; - -@ISA = qw(FS::part_export); - -@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); - -sub rebless { shift; } - -sub _export_insert { - my($self) = shift; - $self->_export_command('useradd', @_); -} - -sub _export_delete { - my($self) = shift; - $self->_export_command('userdel', @_); -} - -sub _export_command { - my ( $self, $action, $svc_acct) = (shift, shift, shift); - my $command = $self->option($action); - my $stdin = $self->option($action."_stdin"); - { - no strict 'refs'; - ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields; - } - $finger = shell_quote $finger; - $crypt_password = ''; #surpress "used only once" warnings - $crypt_password = crypt( $svc_acct->_password, - $saltset[int(rand(64))].$saltset[int(rand(64))] ); - $self->shellcommands_queue( $svc_acct->svcnum, - user => $self->option('user')||'root', - host => $self->machine, - command => eval(qq("$command")), - stdin_string => eval(qq("$stdin")), - ); -} - -sub _export_replace { - my($self, $new, $old ) = (shift, shift, shift); - my $command = $self->option('usermod'); - my $stdin = $self->option('usermod_stdin'); - { - no strict 'refs'; - ${"old_$_"} = $old->getfield($_) foreach $old->fields; - ${"new_$_"} = $new->getfield($_) foreach $new->fields; - } - $new_finger = shell_quote $new_finger; - $new_crypt_password = ''; #surpress "used only once" warnings - $new_crypt_password = crypt( $new->_password, - $saltset[int(rand(64))].$saltset[int(rand(64))]); - $self->shellcommands_queue( $new->svcnum, - user => $self->option('user')||'root', - host => $self->machine, - command => eval(qq("$command")), - stdin_string => eval(qq("$stdin")), - ); -} - -#a good idea to queue anything that could fail or take any time -sub shellcommands_queue { - my( $self, $svcnum ) = (shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::shellcommands::ssh_cmd", - }; - $queue->insert( @_ ); -} - -sub ssh_cmd { #subroutine, not method - use Net::SSH '0.06'; - &Net::SSH::ssh_cmd( { @_ } ); -} - -#sub shellcommands_insert { #subroutine, not method -#} -#sub shellcommands_replace { #subroutine, not method -#} -#sub shellcommands_delete { #subroutine, not method -#} - diff --git a/FS/FS/part_export/shellcommands_withdomain.pm b/FS/FS/part_export/shellcommands_withdomain.pm deleted file mode 100644 index a15c24d88..000000000 --- a/FS/FS/part_export/shellcommands_withdomain.pm +++ /dev/null @@ -1,7 +0,0 @@ -package FS::part_export::shellcommands_withdomain; - -use vars qw(@ISA); -use FS::part_export::shellcommands; - -@ISA = qw(FS::part_export::shellcommands); - diff --git a/FS/FS/part_export/sqlmail.pm b/FS/FS/part_export/sqlmail.pm deleted file mode 100644 index 4194daf0c..000000000 --- a/FS/FS/part_export/sqlmail.pm +++ /dev/null @@ -1,111 +0,0 @@ -package FS::part_export::sqlmail; - -use vars qw(@ISA %fs_mail_table %fields); -use FS::part_export; - -@ISA = qw(FS::part_export); - -%fs_mail_table = ( svc_acct => 'user', - svc_domain => 'domain' ); - -# fields that need to be copied into the fs_mail tables -$fields{user} = [qw(username _password finger domsvc svcnum )]; -$fields{domain} = [qw(domain svcnum catchall )]; - -sub rebless { shift; } - -sub _export_insert { - my($self, $svc) = (shift, shift); - # this is a svc_something. - - my $table = $fs_mail_table{$svc->cust_svc->part_svc->svcdb}; - my @attrib = map {$svc->$_} @{$fields{$table}}; - my $error = $self->sqlmail_queue( $svc->svcnum, 'insert', - $table, @attrib ); - return $error if $error; - ''; -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - - my $table = $fs_mail_table{$new->cust_svc->part_svc->svcdb}; - - my @old = ($old->svcnum, 'delete', $table, $old->svcnum); - my @narf = map {$new->$_} @{$fields{$table}}; - $self->sqlmail_queue($new->svcnum, 'replace', $table, - $new->svcnum, @narf); - - return $error if $error; - ''; -} - -sub _export_delete { - my( $self, $svc ) = (shift, shift); - my $table = $fs_mail_table{$new->cust_svc->part_svc->svcdb}; - $self->sqlmail_queue( $svc->svcnum, 'delete', $table, - $svc->svcnum ); -} - -sub sqlmail_queue { - my( $self, $svcnum, $method, $table ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::sqlmail::sqlmail_$method", - }; - $queue->insert( - $self->option('datasrc'), - $self->option('username'), - $self->option('password'), - @_, - ); -} - -sub sqlmail_insert { #subroutine, not method - my $dbh = sqlmail_connect(shift, shift, shift); - my( $table, @attrib ) = @_; - - my $sth = $dbh->prepare( - "INSERT INTO $table (" . join (',', @{$fields{$table}}) . - ") VALUES ('" . join ("','", @attrib) . "')" - ) or die $dbh->errstr; - $sth->execute() or die $sth->errstr; - - $dbh->disconnect; -} - -sub sqlmail_delete { #subroutine, not method - my $dbh = sqlmail_connect(shift, shift, shift); - my( $table, $svcnum ) = @_; - - my $sth = $dbh->prepare( - "DELETE FROM $table WHERE svcnum = $svcnum" - ) or die $dbh->errstr; - $sth->execute() or die $sth->errstr; - - $dbh->disconnect; -} - -sub sqlmail_replace { - my $dbh = sqlmail_connect(shift, shift, shift); - my( $table, $svcnum, @attrib ) = @_; - - my %data; - @data{@{$fields{$table}}} = @attrib; - - my $sth = $dbh->prepare( - "UPDATE $table SET " . - ( join ',', map {$_ . "='" . $data{$_} . "'"} keys(%data) ) . - " WHERE svcnum = $svcnum" - ) or die $dbh->errstr; - $sth->execute() or die $sth->errstr; - - $dbh->disconnect; -} - -sub sqlmail_connect { - #my($datasrc, $username, $password) = @_; - #DBI->connect($datasrc, $username, $password) or die $DBI::errstr; - DBI->connect(@_) or die $DBI::errstr; -} - diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm deleted file mode 100644 index 3c781c043..000000000 --- a/FS/FS/part_export/sqlradius.pm +++ /dev/null @@ -1,273 +0,0 @@ -package FS::part_export::sqlradius; - -use vars qw(@ISA); -use FS::Record qw( dbh ); -use FS::part_export; - -@ISA = qw(FS::part_export); - -sub rebless { shift; } - -sub _export_insert { - my($self, $svc_acct) = (shift, shift); - - foreach my $table (qw(reply check)) { - my $method = "radius_$table"; - my %attrib = $svc_acct->$method(); - next unless keys %attrib; - my $err_or_queue = $self->sqlradius_queue( $svc_acct->svcnum, 'insert', - $table, $svc_acct->username, %attrib ); - return $err_or_queue unless ref($err_or_queue); - } - my @groups = $svc_acct->radius_groups; - if ( @groups ) { - my $err_or_queue = $self->sqlradius_queue( - $svc_acct->svcnum, 'usergroup_insert', - $svc_acct->username, @groups ); - return $err_or_queue unless ref($err_or_queue); - } - ''; -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $jobnum = ''; - if ( $old->username ne $new->username ) { - my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'rename', - $new->username, $old->username ); - unless ( ref($err_or_queue) ) { - $dbh->rollback if $oldAutoCommit; - return $err_or_queue; - } - $jobnum = $err_or_queue->jobnum; - } - - foreach my $table (qw(reply check)) { - my $method = "radius_$table"; - my %new = $new->$method(); - my %old = $old->$method(); - if ( grep { !exists $old{$_} #new attributes - || $new{$_} ne $old{$_} #changed - } keys %new - ) { - my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert', - $table, $new->username, %new ); - unless ( ref($err_or_queue) ) { - $dbh->rollback if $oldAutoCommit; - return $err_or_queue; - } - if ( $jobnum ) { - my $error = $err_or_queue->depend_insert( $jobnum ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - } - - my @del = grep { !exists $new{$_} } keys %old; - if ( @del ) { - my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'attrib_delete', - $table, $new->username, @del ); - unless ( ref($err_or_queue) ) { - $dbh->rollback if $oldAutoCommit; - return $err_or_queue; - } - if ( $jobnum ) { - my $error = $err_or_queue->depend_insert( $jobnum ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - } - } - - # (sorta) false laziness with FS::svc_acct::replace - my @oldgroups = @{$old->usergroup}; #uuuh - my @newgroups = $new->radius_groups; - my @delgroups = (); - foreach my $oldgroup ( @oldgroups ) { - if ( grep { $oldgroup eq $_ } @newgroups ) { - @newgroups = grep { $oldgroup ne $_ } @newgroups; - next; - } - push @delgroups, $oldgroup; - } - - if ( @delgroups ) { - my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'usergroup_delete', - $new->username, @delgroups ); - unless ( ref($err_or_queue) ) { - $dbh->rollback if $oldAutoCommit; - return $err_or_queue; - } - if ( $jobnum ) { - my $error = $err_or_queue->depend_insert( $jobnum ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - } - - if ( @newgroups ) { - my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'usergroup_insert', - $new->username, @newgroups ); - unless ( ref($err_or_queue) ) { - $dbh->rollback if $oldAutoCommit; - return $err_or_queue; - } - if ( $jobnum ) { - my $error = $err_or_queue->depend_insert( $jobnum ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; -} - -sub _export_delete { - my( $self, $svc_acct ) = (shift, shift); - my $err_or_queue = $self->sqlradius_queue( $svc_acct->svcnum, 'delete', - $svc_acct->username ); - ref($err_or_queue) ? '' : $err_or_queue; -} - -sub sqlradius_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::sqlradius::sqlradius_$method", - }; - $queue->insert( - $self->option('datasrc'), - $self->option('username'), - $self->option('password'), - @_, - ) or $queue; -} - -sub sqlradius_insert { #subroutine, not method - my $dbh = sqlradius_connect(shift, shift, shift); - my( $table, $username, %attributes ) = @_; - - foreach my $attribute ( keys %attributes ) { - - my $s_sth = $dbh->prepare( - "SELECT COUNT(*) FROM rad$table WHERE UserName = ? AND Attribute = ?" - ) or die $dbh->errstr; - $s_sth->execute( $username, $attribute ) or die $s_sth->errstr; - - if ( $s_sth->fetchrow_arrayref->[0] ) { - - my $u_sth = $dbh->prepare( - "UPDATE rad$table SET Value = ? WHERE UserName = ? AND Attribute = ?" - ) or die $dbh->errstr; - $u_sth->execute($attributes{$attribute}, $username, $attribute) - or die $u_sth->errstr; - - } else { - - my $i_sth = $dbh->prepare( - "INSERT INTO rad$table ( id, UserName, Attribute, Value ) ". - "VALUES ( ?, ?, ?, ? )" - ) or die $dbh->errstr; - $i_sth->execute( '', $username, $attribute, $attributes{$attribute} ) - or die $i_sth->errstr; - - } - - } - $dbh->disconnect; -} - -sub sqlradius_usergroup_insert { #subroutine, not method - my $dbh = sqlradius_connect(shift, shift, shift); - my( $username, @groups ) = @_; - - my $sth = $dbh->prepare( - "INSERT INTO usergroup ( id, UserName, GroupName ) VALUES ( ?, ?, ? )" - ) or die $dbh->errstr; - foreach my $group ( @groups ) { - $sth->execute( '', $username, $group ) - or die "can't insert into groupname table: ". $sth->errstr; - } - $dbh->disconnect; -} - -sub sqlradius_usergroup_delete { #subroutine, not method - my $dbh = sqlradius_connect(shift, shift, shift); - my( $username, @groups ) = @_; - - my $sth = $dbh->prepare( - "DELETE FROM usergroup WHERE UserName = ? AND GroupName = ?" - ) or die $dbh->errstr; - foreach my $group ( @groups ) { - $sth->execute( $username, $group ) - or die "can't delete from groupname table: ". $sth->errstr; - } - $dbh->disconnect; -} - -sub sqlradius_rename { #subroutine, not method - my $dbh = sqlradius_connect(shift, shift, shift); - my($new_username, $old_username) = @_; - foreach my $table (qw(radreply radcheck usergroup )) { - my $sth = $dbh->prepare("UPDATE $table SET Username = ? WHERE UserName = ?") - or die $dbh->errstr; - $sth->execute($new_username, $old_username) - or die "can't update $table: ". $sth->errstr; - } - $dbh->disconnect; -} - -sub sqlradius_attrib_delete { #subroutine, not method - my $dbh = sqlradius_connect(shift, shift, shift); - my( $table, $username, @attrib ) = @_; - - foreach my $attribute ( @attrib ) { - my $sth = $dbh->prepare( - "DELETE FROM rad$table WHERE UserName = ? AND Attribute = ?" ) - or die $dbh->errstr; - $sth->execute($username,$attribute) - or die "can't delete from rad$table table: ". $sth->errstr; - } - $dbh->disconnect; -} - -sub sqlradius_delete { #subroutine, not method - my $dbh = sqlradius_connect(shift, shift, shift); - my $username = shift; - - foreach my $table (qw( radcheck radreply usergroup )) { - my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" ); - $sth->execute($username) - or die "can't delete from $table table: ". $sth->errstr; - } - $dbh->disconnect; -} - -sub sqlradius_connect { - #my($datasrc, $username, $password) = @_; - #DBI->connect($datasrc, $username, $password) or die $DBI::errstr; - DBI->connect(@_) or die $DBI::errstr; -} - diff --git a/FS/FS/part_export/sysvshell.pm b/FS/FS/part_export/sysvshell.pm deleted file mode 100644 index f3f6b34b6..000000000 --- a/FS/FS/part_export/sysvshell.pm +++ /dev/null @@ -1,7 +0,0 @@ -package FS::part_export::sysvshell; - -use vars qw(@ISA); -use FS::part_export::null; - -@ISA = qw(FS::part_export::null); - diff --git a/FS/FS/part_export/textradius.pm b/FS/FS/part_export/textradius.pm deleted file mode 100644 index 1492f2672..000000000 --- a/FS/FS/part_export/textradius.pm +++ /dev/null @@ -1,166 +0,0 @@ -package FS::part_export::textradius; - -use vars qw(@ISA $prefix); -use Fcntl qw(:flock); -use FS::UID qw(datasrc); -use FS::part_export; - -@ISA = qw(FS::part_export); - -$prefix = "/usr/local/etc/freeside/export."; - -sub rebless { shift; } - -sub _export_insert { - my($self, $svc_acct) = (shift, shift); - $err_or_queue = $self->textradius_queue( $svc_acct->svcnum, 'insert', - $svc_acct->username, $svc_acct->radius_check, '-', $svc_acct->radius_reply); - ref($err_or_queue) ? '' : $err_or_queue; -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - return "can't (yet?) change username with textradius" - if $old->username ne $new->username; - #return '' unless $old->_password ne $new->_password; - $err_or_queue = $self->textradius_queue( $new->svcnum, 'insert', - $new->username, $new->radius_check, '-', $new->radius_reply); - ref($err_or_queue) ? '' : $err_or_queue; -} - -sub _export_delete { - my( $self, $svc_acct ) = (shift, shift); - $err_or_queue = $self->textradius_queue( $svc_acct->svcnum, 'delete', - $svc_acct->username ); - ref($err_or_queue) ? '' : $err_or_queue; -} - -#a good idea to queue anything that could fail or take any time -sub textradius_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::textradius::textradius_$method", - }; - $queue->insert( - $self->option('user')||'root', - $self->machine, - $self->option('users'), - @_, - ) or $queue; -} - -sub textradius_insert { #subroutine, not method - my( $user, $host, $users, $username, @attributes ) = @_; - - #silly arg processing - my($att, @check); - push @check, $att while @attributes && ($att=shift @attributes) ne '-'; - my %check = @check; - my %reply = @attributes; - - my $file = textradius_download($user, $host, $users); - - eval "use RADIUS::UserFile;"; - die $@ if $@; - - my $userfile = new RADIUS::UserFile( - File => $file, - Who => [ $username ], - Check_Items => [ keys %check ], - ) or die "error parsing $file"; - - $userfile->remove($username); - $userfile->add( - Who => $username, - Attributes => { %check, %reply }, - Comment => 'user added by Freeside', - ) or die "error adding to $file"; - - $userfile->update( Who => [ $username ] ) - or die "error updating $file"; - - textradius_upload($user, $host, $users); - -} - -sub textradius_delete { #subroutine, not method - my( $user, $host, $users, $username ) = @_; - - my $file = textradius_download($user, $host, $users); - - eval "use RADIUS::UserFile;"; - die $@ if $@; - - my $userfile = new RADIUS::UserFile( - File => $file, - Who => [ $username ], - ) or die "error parsing $file"; - - $userfile->remove($username); - - $userfile->update( Who => [ $username ] ) - or die "error updating $file"; - - textradius_upload($user, $host, $users); -} - -sub textradius_download { - my( $user, $host, $users ) = @_; - - my $dir = $prefix. datasrc; - mkdir $dir, 0700 or die $! unless -d $dir; - $dir .= "/$host"; - mkdir $dir, 0700 or die $! unless -d $dir; - - my $dest = "$dir/users"; - - eval "use File::Rsync;"; - die $@ if $@; - my $rsync = File::Rsync->new({ rsh => 'ssh' }); - - open(LOCK, "+>>$dest.lock") - and flock(LOCK,LOCK_EX) - or die "can't open $dest.lock: $!"; - - $rsync->exec( { - src => "$user\@$host:$users", - dest => $dest, - } ); # true/false return value from exec is not working, alas - if ( $rsync->err ) { - die "error downloading $user\@$host:$users : ". - 'exit status: '. $rsync->status. ', '. - 'STDERR: '. join(" / ", $rsync->err). ', '. - 'STDOUT: '. join(" / ", $rsync->out); - } - - $dest; -} - -sub textradius_upload { - my( $user, $host, $users ) = @_; - - my $dir = $prefix. datasrc. "/$host"; - - eval "use File::Rsync;"; - die $@ if $@; - my $rsync = File::Rsync->new({ - rsh => 'ssh', - #dry_run => 1, - }); - $rsync->exec( { - src => "$dir/users", - dest => "$user\@$host:$users", - } ); # true/false return value from exec is not working, alas - if ( $rsync->err ) { - die "error uploading to $user\@$host:$users : ". - 'exit status: '. $rsync->status. ', '. - 'STDERR: '. join(" / ", $rsync->err). ', '. - 'STDOUT: '. join(" / ", $rsync->out); - } - - flock(LOCK,LOCK_UN); - close LOCK; - -} - diff --git a/FS/FS/part_export/vpopmail.pm b/FS/FS/part_export/vpopmail.pm deleted file mode 100644 index 6a486faa1..000000000 --- a/FS/FS/part_export/vpopmail.pm +++ /dev/null @@ -1,179 +0,0 @@ -package FS::part_export::vpopmail; - -use vars qw(@ISA @saltset $exportdir $rsync $ssh); -use File::Path; -use FS::UID qw( datasrc ); -use FS::part_export; - -@ISA = qw(FS::part_export); - -@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); - -$rsync = "rsync"; -$ssh = "ssh"; - -sub rebless { shift; } - -sub _export_insert { - my($self, $svc_acct) = (shift, shift); - $self->vpopmail_queue( $svc_acct->svcnum, 'insert', - $svc_acct->username, - crypt($svc_acct->_password,$saltset[int(rand(64))].$saltset[int(rand(64))]), - $svc_acct->domain, - ); -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - - my $cpassword = crypt( - $new->_password, $saltset[int(rand(64))].$saltset[int(rand(64))] - ); - - return "can't change username with vpopmail" - if $old->username ne $new->username; - - #no.... if mail can't be preserved, better to disallow username changes - #if ($old->username ne $new->username || $old->domain ne $new->domain ) { - # vpopmail_queue( $svc_acct->svcnum, 'delete', - # $old->username, $old->domain - # ); - # vpopmail_queue( $svc_acct->svcnum, 'insert', - # $new->username, - # $cpassword, - # $new->domain, - # ); - - return '' unless $old->_password ne $new->_password; - - $self->vpopmail_queue( $new->svcnum, 'replace', - $new->username, $cpassword, $new->domain ); -} - -sub _export_delete { - my( $self, $svc_acct ) = (shift, shift); - $self->vpopmail_queue( $svc_acct->svcnum, 'delete', - $svc_acct->username, $svc_acct->domain ); -} - -#a good idea to queue anything that could fail or take any time -sub vpopmail_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my $exportdir = "/usr/local/etc/freeside/export." . datasrc; - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::vpopmail::vpopmail_$method", - }; - $queue->insert( - $exportdir, - $self->option('machine'), - $self->option('dir'), - $self->option('uid'), - $self->option('gid'), - @_ - ); -} - -sub vpopmail_insert { #subroutine, not method - my( $exportdir, $machine, $dir, $uid, $gid ) = splice @_,0,5; - my( $username, $password, $domain ) = @_; - - (open(VPASSWD, ">>$exportdir/domains/$domain/vpasswd") - and flock(VPASSWD,LOCK_EX) - ) or die "can't open vpasswd file for $username\@$domain: ". - "$exportdir/domains/$domain/vpasswd: $!"; - print VPASSWD join(":", - $username, - $password, - '1', - '0', - $username, - "$dir/domains/$domain/$username", - 'NOQUOTA', - ), "\n"; - - flock(VPASSWD,LOCK_UN); - close(VPASSWD); - - for my $mkdir ( - map { "$exportdir/domains/$domain/$username$_" } - ( '', qw( /Maildir /Maildir/cur /Maildir/new /Maildir/tmp ) ) - ) { - mkdir $mkdir, 0700 or die "can't mkdir $mkdir: $!"; - } - - vpopmail_sync( $exportdir, $machine, $dir, $uid, $gid ); - -} - -sub vpopmail_replace { #subroutine, not method - my( $exportdir, $machine, $dir, $uid, $gid ) = splice @_,0,5; - my( $username, $password, $domain ) = @_; - - (open(VPASSWD, "$exportdir/domains/$domain/vpasswd") - and flock(VPASSWD,LOCK_EX) - ) or die "can't open $exportdir/domains/$domain/vpasswd: $!"; - - open(VPASSWDTMP, ">$exportdir/domains/$domain/vpasswd.tmp") - or die "Can't open $exportdir/domains/$domain/vpasswd.tmp: $!"; - - while () { - my ($mailbox, $pw, @rest) = split(':', $_); - print VPASSWDTMP $_ unless $username eq $mailbox; - print VPASSWDTMP join (':', ($mailbox, $password, @rest)) - if $username eq $mailbox; - } - - close(VPASSWDTMP); - - rename "$exportdir/domains/$domain/vpasswd.tmp", "$exportdir/domains/$domain/vpasswd" - or die "Can't rename $exportdir/domains/$domain/vpasswd.tmp: $!"; - - flock(VPASSWD,LOCK_UN); - close(VPASSWD); - - vpopmail_sync( $exportdir, $machine, $dir, $uid, $gid ); - -} - -sub vpopmail_delete { #subroutine, not method - my( $exportdir, $machine, $dir, $uid, $gid ) = splice @_,0,5; - my( $username, $domain ) = @_; - - (open(VPASSWD, "$exportdir/domains/$domain/vpasswd") - and flock(VPASSWD,LOCK_EX) - ) or die "can't open $exportdir/domains/$domain/vpasswd: $!"; - - open(VPASSWDTMP, ">$exportdir/domains/$domain/vpasswd.tmp") - or die "Can't open $exportdir/domains/$domain/vpasswd.tmp: $!"; - - while () { - my ($mailbox, $rest) = split(':', $_); - print VPASSWDTMP $_ unless $username eq $mailbox; - } - - close(VPASSWDTMP); - - rename "$exportdir/domains/$domain/vpasswd.tmp", - "$exportdir/domains/$domain/vpasswd" - or die "Can't rename $exportdir/domains/$domain/vpasswd.tmp: $!"; - - flock(VPASSWD,LOCK_UN); - close(VPASSWD); - - rmtree "$exportdir/domains/$domain/$username" - or die "can't rmtree $exportdir/domains/$domain/$username: $!"; - - vpopmail_sync( $exportdir, $machine, $dir, $uid, $gid ); -} - -sub vpopmail_sync { - my( $exportdir, $machine, $dir, $uid, $gid ) = splice @_,0,5; - - chdir $exportdir; - my @args = ( $rsync, "-rlpt", "-e", $ssh, "domains/", - "vpopmail\@$machine:$dir/domains/" ); - system {$args[0]} @args; -} - - diff --git a/FS/FS/part_export/www_shellcommands.pm b/FS/FS/part_export/www_shellcommands.pm deleted file mode 100644 index 84c162761..000000000 --- a/FS/FS/part_export/www_shellcommands.pm +++ /dev/null @@ -1,112 +0,0 @@ -package FS::part_export::www_shellcommands; - -use strict; -use vars qw(@ISA); -use FS::part_export; - -@ISA = qw(FS::part_export); - -sub rebless { shift; } - -sub _export_insert { - my($self) = shift; - $self->_export_command('useradd', @_); -} - -sub _export_delete { - my($self) = shift; - $self->_export_command('userdel', @_); -} - -sub _export_command { - my ( $self, $action, $svc_www) = (shift, shift, shift); - my $command = $self->option($action); - - #set variable for the command - { - no strict 'refs'; - ${$_} = $svc_www->getfield($_) foreach $svc_www->fields; - } - my $domain_record = $svc_www->domain_record; # or die ? - my $zone = $domain_record->reczone; # or die ? - unless ( $zone =~ /\.$/ ) { - my $svc_domain = $domain_record->svc_domain; # or die ? - $zone .= '.'. $svc_domain->domain; - } - - my $svc_acct = $svc_www->svc_acct; # or die ? - my $username = $svc_acct->username; - my $homedir = $svc_acct->dir; # or die ? - - #done setting variables for the command - - $self->shellcommands_queue( $svc_www->svcnum, - user => $self->option('user')||'root', - host => $self->machine, - command => eval(qq("$command")), - ); -} - -sub _export_replace { - my($self, $new, $old ) = (shift, shift, shift); - my $command = $self->option('usermod'); - - #set variable for the command - { - no strict 'refs'; - ${"old_$_"} = $old->getfield($_) foreach $old->fields; - ${"new_$_"} = $new->getfield($_) foreach $new->fields; - } - my $old_domain_record = $old->domain_record; # or die ? - my $old_zone = $old_domain_record->reczone; # or die ? - unless ( $old_zone =~ /\.$/ ) { - my $old_svc_domain = $old_domain_record->svc_domain; # or die ? - $old_zone .= '.'. $old_svc_domain->domain; - } - - my $old_svc_acct = $old->svc_acct; # or die ? - my $old_username = $old_svc_acct->username; - my $old_homedir = $old_svc_acct->dir; # or die ? - - my $new_domain_record = $new->domain_record; # or die ? - my $new_zone = $new_domain_record->reczone; # or die ? - unless ( $new_zone =~ /\.$/ ) { - my $new_svc_domain = $new_domain_record->svc_domain; # or die ? - $new_zone .= '.'. $new_svc_domain->domain; - } - - my $new_svc_acct = $new->svc_acct; # or die ? - my $new_username = $new_svc_acct->username; - my $new_homedir = $new_svc_acct->dir; # or die ? - - #done setting variables for the command - - $self->shellcommands_queue( $new->svcnum, - user => $self->option('user')||'root', - host => $self->machine, - command => eval(qq("$command")), - ); -} - -#a good idea to queue anything that could fail or take any time -sub shellcommands_queue { - my( $self, $svcnum ) = (shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::www_shellcommands::ssh_cmd", - }; - $queue->insert( @_ ); -} - -sub ssh_cmd { #subroutine, not method - use Net::SSH '0.06'; - &Net::SSH::ssh_cmd( { @_ } ); -} - -#sub shellcommands_insert { #subroutine, not method -#} -#sub shellcommands_replace { #subroutine, not method -#} -#sub shellcommands_delete { #subroutine, not method -#} - diff --git a/FS/FS/part_export_option.pm b/FS/FS/part_export_option.pm deleted file mode 100644 index a0b19fde1..000000000 --- a/FS/FS/part_export_option.pm +++ /dev/null @@ -1,134 +0,0 @@ -package FS::part_export_option; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); -use FS::part_export; - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::part_export_option - Object methods for part_export_option records - -=head1 SYNOPSIS - - use FS::part_export_option; - - $record = new FS::part_export_option \%hash; - $record = new FS::part_export_option { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::part_export_option object represents an export option. -FS::part_export_option inherits from FS::Record. The following fields are -currently supported: - -=over 4 - -=item optionnum - primary key - -=item exportnum - export (see L) - -=item optionname - option name - -=item optionvalue - option value - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new export option. To add the export option to the database, see -L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'part_export_option'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=cut - -# the insert method can be inherited from FS::Record - -=item delete - -Delete this record from the database. - -=cut - -# the delete method can be inherited from FS::Record - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -# the replace method can be inherited from FS::Record - -=item check - -Checks all fields to make sure this is a valid export option. If there is -an error, returns the error, otherwise returns false. Called by the insert -and replace methods. - -=cut - -# the check method should currently be supplied - FS::Record contains some -# data checking routines - -sub check { - my $self = shift; - - my $error = - $self->ut_numbern('optionnum') - || $self->ut_number('exportnum') - || $self->ut_alpha('optionname') - || $self->ut_anything('optionvalue') - ; - return $error if $error; - - return "Unknown exportnum: ". $self->exportnum - unless qsearchs('part_export', { 'exportnum' => $self->exportnum } ); - - #check options & values? - - ''; #no error -} - -=back - -=head1 BUGS - -Possibly. - -=head1 SEE ALSO - -L, L, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm deleted file mode 100644 index e914636e4..000000000 --- a/FS/FS/part_pkg.pm +++ /dev/null @@ -1,317 +0,0 @@ -package FS::part_pkg; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch dbh ); -use FS::pkg_svc; -use FS::agent_type; -use FS::type_pkgs; -use FS::Conf; - -@ISA = qw( FS::Record ); - -=head1 NAME - -FS::part_pkg - Object methods for part_pkg objects - -=head1 SYNOPSIS - - use FS::part_pkg; - - $record = new FS::part_pkg \%hash - $record = new FS::part_pkg { 'column' => 'value' }; - - $custom_record = $template_record->clone; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - - @pkg_svc = $record->pkg_svc; - - $svcnum = $record->svcpart; - $svcnum = $record->svcpart( 'svc_acct' ); - -=head1 DESCRIPTION - -An FS::part_pkg object represents a billing item definition. FS::part_pkg -inherits from FS::Record. The following fields are currently supported: - -=over 4 - -=item pkgpart - primary key (assigned automatically for new billing item definitions) - -=item pkg - Text name of this billing item definition (customer-viewable) - -=item comment - Text name of this billing item definition (non-customer-viewable) - -=item setup - Setup fee expression - -=item freq - Frequency of recurring fee - -=item recur - Recurring fee expression - -=item setuptax - Setup fee tax exempt flag, empty or `Y' - -=item recurtax - Recurring fee tax exempt flag, empty or `Y' - -=item taxclass - Tax class flag - -=item plan - Price plan - -=item plandata - Price plan data - -=item disabled - Disabled flag, empty or `Y' - -=back - -setup and recur are evaluated as Safe perl expressions. You can use numbers -just as you would normally. More advanced semantics are not yet defined. - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new billing item definition. To add the billing item definition to -the database, see L<"insert">. - -=cut - -sub table { 'part_pkg'; } - -=item clone - -An alternate constructor. Creates a new billing item definition by duplicating -an existing definition. A new pkgpart is assigned and `(CUSTOM) ' is prepended -to the comment field. To add the billing item definition to the database, see -L<"insert">. - -=cut - -sub clone { - my $self = shift; - my $class = ref($self); - my %hash = $self->hash; - $hash{'pkgpart'} = ''; - $hash{'comment'} = "(CUSTOM) ". $hash{'comment'} - unless $hash{'comment'} =~ /^\(CUSTOM\) /; - #new FS::part_pkg ( \%hash ); # ? - new $class ( \%hash ); # ? -} - -=item insert - -Adds this billing item definition to the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -sub insert { - my $self = shift; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $error = $self->SUPER::insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - my $conf = new FS::Conf; - - if ( $conf->exists('agent_defaultpkg') ) { - foreach my $agent_type ( qsearch('agent_type', {} ) ) { - my $type_pkgs = new FS::type_pkgs({ - 'typenum' => $agent_type->typenum, - 'pkgpart' => $self->pkgpart, - }); - my $error = $type_pkgs->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; -} - -=item delete - -Currently unimplemented. - -=cut - -sub delete { - return "Can't (yet?) delete package definitions."; -# check & make sure the pkgpart isn't in cust_pkg or type_pkgs? -} - -=item replace OLD_RECORD - -Replaces OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=item check - -Checks all fields to make sure this is a valid billing item definition. If -there is an error, returns the error, otherwise returns false. Called by the -insert and replace methods. - -=cut - -sub check { - my $self = shift; - - my $conf = new FS::Conf; - if ( $conf->exists('safe-part_pkg') ) { - - my $error = $self->ut_anything('setup') - || $self->ut_anything('recur'); - return $error if $error; - - my $s = $self->setup; - - $s =~ /^\s*\d*\.?\d*\s*$/ - - or $s =~ /^my \$d = \$cust_pkg->bill || \$time; \$d += 86400 \* \s*\d+\s*; \$cust_pkg->bill\(\$d\); \$cust_pkg_mod_flag=1; \s*\d*\.?\d*\s*$/ - - or do { - #log! - return "illegal setup: $s"; - }; - - my $r = $self->recur; - - $r =~ /^\s*\d*\.?\d*\s*$/ - - #or $r =~ /^\$sdate += 86400 \* \s*\d+\s*; \s*\d*\.?\d*\s*$/ - - or $r =~ /^my \$mnow = \$sdate; my \(\$sec,\$min,\$hour,\$mday,\$mon,\$year\) = \(localtime\(\$sdate\) \)\[0,1,2,3,4,5\]; my \$mstart = timelocal\(0,0,0,1,\$mon,\$year\); my \$mend = timelocal\(0,0,0,1, \$mon == 11 \? 0 : \$mon\+1, \$year\+\(\$mon==11\)\); \$sdate = \$mstart; \( \$part_pkg->freq \- 1 \) \* \d*\.?\d* \/ \$part_pkg\-\>freq \+ \d*\.?\d* \/ \$part_pkg\-\>freq \* \(\$mend\-\$mnow\) \/ \(\$mend\-\$mstart\) ;\s*$/ - - or $r =~ /^my \$mnow = \$sdate; my \(\$sec,\$min,\$hour,\$mday,\$mon,\$year\) = \(localtime\(\$sdate\) \)\[0,1,2,3,4,5\]; \$sdate = timelocal\(0,0,0,1,\$mon,\$year\); \s*\d*\.?\d*\s*;\s*$/ - - or $r =~ /^my \$error = \$cust_pkg\->cust_main\->credit\( \s*\d*\.?\d*\s* \* scalar\(\$cust_pkg\->cust_main\->referral_cust_main_ncancelled\(\s*\d+\s*\)\), "commission" \); die \$error if \$error; \s*\d*\.?\d*\s*;\s*$/ - - or $r =~ /^my \$error = \$cust_pkg\->cust_main\->credit\( \s*\d*\.?\d*\s* \* scalar\(\$cust_pkg\->cust_main->referral_cust_pkg\(\s*\d+\s*\)\), "commission" \); die \$error if \$error; \s*\d*\.?\d*\s*;\s*$/ - - or $r =~ /^my \$error = \$cust_pkg\->cust_main\->credit\( \s*\d*\.?\d*\s* \* scalar\( grep \{ my \$pkgpart = \$_\->pkgpart; grep \{ \$_ == \$pkgpart \} \(\s*(\s*\d+,\s*)*\s*\) \} \$cust_pkg\->cust_main->referral_cust_pkg\(\s*\d+\s*\)\), "commission" \); die \$error if \$error; \s*\d*\.?\d*\s*;\s*$/ - - or $r =~ /^my \$hours = \$cust_pkg\->seconds_since\(\$cust_pkg\->bill \|\| 0\) \/ 3600 \- \s*\d*\.?\d*\s*; \$hours = 0 if \$hours < 0; \s*\d*\.?\d*\s* \+ \s*\d*\.?\d*\s* \* \$hours;\s*$/ - - or $r =~ /^my \$min = \$cust_pkg\->seconds_since\(\$cust_pkg\->bill \|\| 0\) \/ 60 \- \s*\d*\.?\d*\s*; \$min = 0 if \$min < 0; \s*\d*\.?\d*\s* \+ \s*\d*\.?\d*\s* \* \$min;\s*$/ - - or do { - #log! - return "illegal recur: $r"; - }; - - } - - $self->ut_numbern('pkgpart') - || $self->ut_text('pkg') - || $self->ut_text('comment') - || $self->ut_anything('setup') - || $self->ut_number('freq') - || $self->ut_anything('recur') - || $self->ut_alphan('plan') - || $self->ut_anything('plandata') - || $self->ut_enum('setuptax', [ '', 'Y' ] ) - || $self->ut_enum('recurtax', [ '', 'Y' ] ) - || $self->ut_textn('taxclass') - || $self->ut_enum('disabled', [ '', 'Y' ] ) - ; -} - -=item pkg_svc - -Returns all FS::pkg_svc objects (see L) for this package -definition (with non-zero quantity). - -=cut - -sub pkg_svc { - my $self = shift; - grep { $_->quantity } qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } ); -} - -=item svcpart [ SVCDB ] - -Returns the svcpart of a single service definition (see L) -associated with this billing item definition (see L). Returns -false if there not exactly one service definition with quantity 1, or if -SVCDB is specified and does not match the svcdb of the service definition, - -=cut - -sub svcpart { - my $self = shift; - my $svcdb = shift; - my @pkg_svc = $self->pkg_svc; - return '' if scalar(@pkg_svc) != 1 - || $pkg_svc[0]->quantity != 1 - || ( $svcdb && $pkg_svc[0]->part_svc->svcdb ne $svcdb ); - $pkg_svc[0]->svcpart; -} - -=item payby - -Returns a list of the acceptable payment types for this package. Eventually -this should come out of a database table and be editable, but currently has the -following logic instead; - -If the package has B<0> setup and B<0> recur, the single item B is -returned, otherwise, the single item B is returned. - -=cut - -sub payby { - my $self = shift; - #if ( $self->setup == 0 && $self->recur == 0 ) { - if ( $self->setup =~ /^\s*0+(\.0*)?\s*$/ - && $self->recur =~ /^\s*0+(\.0*)?\s*$/ ) { - ( 'BILL' ); - } else { - ( 'CARD' ); - } -} - -=back - -=head1 VERSION - -$Id: part_pkg.pm,v 1.16 2002-06-10 01:39:50 khoff Exp $ - -=head1 BUGS - -The delete method is unimplemented. - -setup and recur semantics are not yet defined (and are implemented in -FS::cust_bill. hmm.). - -=head1 SEE ALSO - -L, L, L, L, L. -schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/part_pop_local.pm b/FS/FS/part_pop_local.pm deleted file mode 100644 index 0b7cdf6c9..000000000 --- a/FS/FS/part_pop_local.pm +++ /dev/null @@ -1,116 +0,0 @@ -package FS::part_pop_local; - -use strict; -use vars qw( @ISA ); -use FS::Record; # qw( qsearchs ); - -@ISA = qw( FS::Record ); - -=head1 NAME - -FS::part_pop_local - Object methods for part_pop_local records - -=head1 SYNOPSIS - - use FS::part_pop_local; - - $record = new FS::part_pop_local \%hash; - $record = new FS::part_pop_local { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::part_pop_local object represents a local call area. Each -FS::part_pop_local record maps a NPA/NXX (area code and exchange) to the POP -(see L) which is a local call. FS::part_pop_local inherits -from FS::Record. The following fields are currently supported: - -=over 4 - -=item localnum - primary key (assigned automatically for new accounts) - -=item popnum - see L - -=item city - -=item state - -=item npa - area code - -=item nxx - exchange - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new point of presence (if only it were that easy!). To add the -point of presence to the database, see L<"insert">. - -=cut - -sub table { 'part_pop_local'; } - -=item insert - -Adds this point of presence to the database. If there is an error, returns the -error, otherwise returns false. - -=item delete - -Removes this point of presence from the database. - -=item replace OLD_RECORD - -Replaces OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=item check - -Checks all fields to make sure this is a valid point of presence. If there is -an error, returns the error, otherwise returns false. Called by the insert -and replace methods. - -=cut - -sub check { - my $self = shift; - - $self->ut_numbern('localnum') - or $self->ut_numbern('popnum') - or $self->ut_text('city') - or $self->ut_text('state') - or $self->ut_number('npa') - or $self->ut_number('nxx') - ; - -} - -=back - -=head1 VERSION - -$Id: part_pop_local.pm,v 1.1 2001-09-26 09:17:06 ivan Exp $ - -=head1 BUGS - -US/CA-centric. - -=head1 SEE ALSO - -L, L, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/part_referral.pm b/FS/FS/part_referral.pm deleted file mode 100644 index 23885dffd..000000000 --- a/FS/FS/part_referral.pm +++ /dev/null @@ -1,116 +0,0 @@ -package FS::part_referral; - -use strict; -use vars qw( @ISA ); -use FS::Record; - -@ISA = qw( FS::Record ); - -=head1 NAME - -FS::part_referral - Object methods for part_referral objects - -=head1 SYNOPSIS - - use FS::part_referral; - - $record = new FS::part_referral \%hash - $record = new FS::part_referral { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::part_referral represents a advertising source - where a customer heard -of your services. This can be used to track the effectiveness of a particular -piece of advertising, for example. FS::part_referral inherits from FS::Record. -The following fields are currently supported: - -=over 4 - -=item refnum - primary key (assigned automatically for new referrals) - -=item referral - Text name of this advertising source - -=back - -=head1 NOTE - -These were called B before version 1.4.0 - the name was changed -so as not to be confused with the new customer-to-customer referrals. - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new advertising source. To add the referral to the database, see -L<"insert">. - -=cut - -sub table { 'part_referral'; } - -=item insert - -Adds this advertising source to the database. If there is an error, returns -the error, otherwise returns false. - -=item delete - -Currently unimplemented. - -=cut - -sub delete { - my $self = shift; - return "Can't (yet?) delete part_referral records"; - #need to make sure no customers have this referral! -} - -=item replace OLD_RECORD - -Replaces OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=item check - -Checks all fields to make sure this is a valid advertising source. If there is -an error, returns the error, otherwise returns false. Called by the insert and -replace methods. - -=cut - -sub check { - my $self = shift; - - $self->ut_numbern('refnum') - || $self->ut_text('referral') - ; -} - -=back - -=head1 BUGS - -The delete method is unimplemented. - -`Advertising source'. Yes, it's a sucky name. The only other ones I could -come up with were "Marketing channel" and "Heard Abouts" and those are -definately both worse. - -=head1 SEE ALSO - -L, L, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/part_svc.pm b/FS/FS/part_svc.pm deleted file mode 100644 index 959a3f887..000000000 --- a/FS/FS/part_svc.pm +++ /dev/null @@ -1,348 +0,0 @@ -package FS::part_svc; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs fields dbh ); -use FS::part_svc_column; -use FS::part_export; -use FS::export_svc; - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::part_svc - Object methods for part_svc objects - -=head1 SYNOPSIS - - use FS::part_svc; - - $record = new FS::part_svc \%hash - $record = new FS::part_svc { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::part_svc represents a service definition. FS::part_svc inherits from -FS::Record. The following fields are currently supported: - -=over 4 - -=item svcpart - primary key (assigned automatically for new service definitions) - -=item svc - text name of this service definition - -=item svcdb - table used for this service. See L, -L, and L, among others. - -=item disabled - Disabled flag, empty or `Y' - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new service definition. To add the service definition to the -database, see L<"insert">. - -=cut - -sub table { 'part_svc'; } - -=item insert EXTRA_FIELDS_ARRAYREF - -Adds this service definition to the database. If there is an error, returns -the error, otherwise returns false. - -TODOC: - -=item I__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 - -TODOC: EXTRA_FIELDS_ARRAYREF - -=cut - -sub insert { - my $self = shift; - my @fields = (); - @fields = @{shift(@_)} if @_; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $error = $self->SUPER::insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - my $svcdb = $self->svcdb; -# my @rows = map { /^${svcdb}__(.*)$/; $1 } -# grep ! /_flag$/, -# grep /^${svcdb}__/, -# fields('part_svc'); - foreach my $field ( - grep { $_ ne 'svcnum' - && defined( $self->getfield($svcdb.'__'.$_.'_flag') ) - } (fields($svcdb), @fields) - ) { - my $part_svc_column = $self->part_svc_column($field); - my $previous = qsearchs('part_svc_column', { - 'svcpart' => $self->svcpart, - 'columnname' => $field, - } ); - - my $flag = $self->getfield($svcdb.'__'.$field.'_flag'); - if ( uc($flag) =~ /^([DF])$/ ) { - $part_svc_column->setfield('columnflag', $1); - $part_svc_column->setfield('columnvalue', - $self->getfield($svcdb.'__'.$field) - ); - if ( $previous ) { - $error = $part_svc_column->replace($previous); - } else { - $error = $part_svc_column->insert; - } - } else { - $error = $previous ? $previous->delete : ''; - } - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; -} - -=item delete - -Currently unimplemented. - -=cut - -sub delete { - return "Can't (yet?) delete service definitions."; -# check & make sure the svcpart isn't in cust_svc or pkg_svc (in any packages)? -} - -=item replace OLD_RECORD [ '1.3-COMPAT' [ , EXTRA_FIELDS_ARRAYREF ] ] - -Replaces OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -TODOC: 1.3-COMPAT - -TODOC: EXTRA_FIELDS_ARRAYREF - -=cut - -sub replace { - my ( $new, $old ) = ( shift, shift ); - - return "Can't change svcdb for an existing service definition!" - unless $old->svcdb eq $new->svcdb; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $error = $new->SUPER::replace( $old ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - if ( @_ && $_[0] eq '1.3-COMPAT' ) { - shift; - my @fields = (); - @fields = @{shift(@_)} if @_; - - my $svcdb = $new->svcdb; - foreach my $field ( - grep { $_ ne 'svcnum' - && defined( $new->getfield($svcdb.'__'.$_.'_flag') ) - } (fields($svcdb),@fields) - ) { - my $part_svc_column = $new->part_svc_column($field); - my $previous = qsearchs('part_svc_column', { - 'svcpart' => $new->svcpart, - 'columnname' => $field, - } ); - - my $flag = $new->getfield($svcdb.'__'.$field.'_flag'); - if ( uc($flag) =~ /^([DF])$/ ) { - $part_svc_column->setfield('columnflag', $1); - $part_svc_column->setfield('columnvalue', - $new->getfield($svcdb.'__'.$field) - ); - if ( $previous ) { - $error = $part_svc_column->replace($previous); - } else { - $error = $part_svc_column->insert; - } - } else { - $error = $previous ? $previous->delete : ''; - } - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - } else { - $dbh->rollback if $oldAutoCommit; - return 'non-1.3-COMPAT interface not yet written'; - #not yet implemented - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; -} - -=item check - -Checks all fields to make sure this is a valid service definition. If there is -an error, returns the error, otherwise returns false. Called by the insert -and replace methods. - -=cut - -sub check { - my $self = shift; - my $recref = $self->hashref; - - my $error; - $error= - $self->ut_numbern('svcpart') - || $self->ut_text('svc') - || $self->ut_alpha('svcdb') - || $self->ut_enum('disabled', [ '', 'Y' ] ) - ; - return $error if $error; - - my @fields = eval { fields( $recref->{svcdb} ) }; #might die - return "Unknown svcdb!" unless @fields; - -##REPLACED BY part_svc_column -# my $svcdb; -# foreach $svcdb ( qw( -# svc_acct svc_acct_sm svc_domain -# ) ) { -# my @rows = map { /^${svcdb}__(.*)$/; $1 } -# grep ! /_flag$/, -# grep /^${svcdb}__/, -# fields('part_svc'); -# foreach my $row (@rows) { -# unless ( $svcdb eq $recref->{svcdb} ) { -# $recref->{$svcdb.'__'.$row}=''; -# $recref->{$svcdb.'__'.$row.'_flag'}=''; -# next; -# } -# $recref->{$svcdb.'__'.$row.'_flag'} =~ /^([DF]?)$/ -# or return "Illegal flag for $svcdb $row"; -# $recref->{$svcdb.'__'.$row.'_flag'} = $1; -# -# my $error = $self->ut_anything($svcdb.'__'.$row); -# return $error if $error; -# -# } -# } - - ''; #no error -} - -=item part_svc_column COLUMNNAME - -Returns the part_svc_column object (see L) for the given -COLUMNNAME, or a new part_svc_column object if none exists. - -=cut - -sub part_svc_column { - my $self = shift; - my $columnname = shift; - qsearchs('part_svc_column', { - 'svcpart' => $self->svcpart, - 'columnname' => $columnname, - } - ) or new FS::part_svc_column { - 'svcpart' => $self->svcpart, - 'columnname' => $columnname, - }; -} - -=item all_part_svc_column - -=cut - -sub all_part_svc_column { - my $self = shift; - qsearch('part_svc_column', { 'svcpart' => $self->svcpart } ); -} - -=item part_export - -=cut - -sub part_export { - my $self = shift; - map { qsearchs('part_export', { 'exportnum' => $_->exportnum } ) } - qsearch('export_svc', { 'svcpart' => $self->svcpart } ); -} - -=back - -=head1 VERSION - -$Id: part_svc.pm,v 1.13 2002-04-11 22:05:31 ivan Exp $ - -=head1 BUGS - -Delete is unimplemented. - -The list of svc_* tables is hardcoded. When svc_acct_pop is renamed, this -should be fixed. - -all_part_svc_column and part_export methods should be documented - -=head1 SEE ALSO - -L, L, L, L, -L, L, L, L, -schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/part_svc_column.pm b/FS/FS/part_svc_column.pm deleted file mode 100644 index 37e841e87..000000000 --- a/FS/FS/part_svc_column.pm +++ /dev/null @@ -1,118 +0,0 @@ -package FS::part_svc_column; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( fields ); - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::part_svc_column - Object methods for part_svc_column objects - -=head1 SYNOPSIS - - use FS::part_svc_column; - - $record = new FS::part_svc_column \%hash - $record = new FS::part_svc_column { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::part_svc_column record represents a service definition column -constraint. FS::part_svc_column inherits from FS::Record. The following -fields are currently supported: - -=over 4 - -=item columnnum - primary key (assigned automatcially for new records) - -=item svcpart - service definition (see L) - -=item columnname - column name in part_svc.svcdb table - -=item columnvalue - default or fixed value for the column - -=item columnflag - null, D or F - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new column constraint. To add the column constraint to the database, see L<"insert">. - -=cut - -sub table { 'part_svc_column'; } - -=item insert - -Adds this service definition to the database. If there is an error, returns -the error, otherwise returns false. - -=item delete - -Deletes this record from the database. If there is an error, returns the -error, otherwise returns false. - -=item replace OLD_RECORD - -Replaces OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=item check - -Checks all fields to make sure this is a valid record. If there is an error, -returns the error, otherwise returns false. Called by the insert and replace -methods. - -=cut - -sub check { - my $self = shift; - - my $error = - $self->ut_numbern('columnnum') - || $self->ut_number('svcpart') - || $self->ut_alpha('columnname') - || $self->ut_anything('columnvalue') - ; - return $error if $error; - - $self->columnflag =~ /^([DF])$/ - or return "illegal columnflag ". $self->columnflag; - $self->columnflag(uc($1)); - - ''; #no error -} - -=back - -=head1 VERSION - -$Id: part_svc_column.pm,v 1.1 2001-09-07 20:49:15 ivan Exp $ - -=head1 BUGS - -=head1 SEE ALSO - -L, L, L, L, -L, L, L, L, -schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/pkg_svc.pm b/FS/FS/pkg_svc.pm deleted file mode 100644 index 3c544ffd8..000000000 --- a/FS/FS/pkg_svc.pm +++ /dev/null @@ -1,152 +0,0 @@ -package FS::pkg_svc; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearchs ); -use FS::part_pkg; -use FS::part_svc; - -@ISA = qw( FS::Record ); - -=head1 NAME - -FS::pkg_svc - Object methods for pkg_svc records - -=head1 SYNOPSIS - - use FS::pkg_svc; - - $record = new FS::pkg_svc \%hash; - $record = new FS::pkg_svc { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - - $part_pkg = $record->part_pkg; - - $part_svc = $record->part_svc; - -=head1 DESCRIPTION - -An FS::pkg_svc record links a billing item definition (see L) 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 new HASHREF - -Create a new record. To add the record to the database, see L<"insert">. - -=cut - -sub table { 'pkg_svc'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=item delete - -Deletes this record from the database. If there is an error, returns the -error, otherwise returns false. - -=item replace OLD_RECORD - -Replaces OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -sub replace { - my ( $new, $old ) = ( shift, shift ); - - return "Can't change pkgpart!" if $old->pkgpart != $new->pkgpart; - return "Can't change svcpart!" if $old->svcpart != $new->svcpart; - - $new->SUPER::replace($old); -} - -=item check - -Checks all fields to make sure this is a valid record. If there is an error, -returns the error, otherwise returns false. Called by the insert and replace -methods. - -=cut - -sub check { - my $self = shift; - - my $error; - $error = - $self->ut_number('pkgpart') - || $self->ut_number('svcpart') - || $self->ut_number('quantity') - ; - return $error if $error; - - return "Unknown pkgpart!" unless $self->part_pkg; - return "Unknown svcpart!" unless $self->part_svc; - - ''; #no error -} - -=item part_pkg - -Returns the FS::part_pkg object (see L). - -=cut - -sub part_pkg { - my $self = shift; - qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } ); -} - -=item part_svc - -Returns the FS::part_svc object (see L). - -=cut - -sub part_svc { - my $self = shift; - qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); -} - -=back - -=head1 VERSION - -$Id: pkg_svc.pm,v 1.3 2002-06-10 01:39:50 khoff Exp $ - -=head1 BUGS - -=head1 SEE ALSO - -L, L, L, schema.html from the base -documentation. - -=cut - -1; - diff --git a/FS/FS/port.pm b/FS/FS/port.pm deleted file mode 100644 index 13455ca89..000000000 --- a/FS/FS/port.pm +++ /dev/null @@ -1,160 +0,0 @@ -package FS::port; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearchs ); -use FS::nas; -use FS::session; - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::port - Object methods for port records - -=head1 SYNOPSIS - - use FS::port; - - $record = new FS::port \%hash; - $record = new FS::port { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - - $session = $port->session; - -=head1 DESCRIPTION - -An FS::port object represents an individual port on a NAS. FS::port inherits -from FS::Record. The following fields are currently supported: - -=over 4 - -=item portnum - primary key - -=item ip - IP address of this port - -=item nasport - port number on the NAS - -=item nasnum - NAS this port is on - see L - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new port. To add the example to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'port'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=cut - -# the insert method can be inherited from FS::Record - -=item delete - -Delete this record from the database. - -=cut - -# the delete method can be inherited from FS::Record - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -# the replace method can be inherited from FS::Record - -=item check - -Checks all fields to make sure this is a valid example. If there is -an error, returns the error, otherwise returns false. Called by the insert -and replace methods. - -=cut - -# the check method should currently be supplied - FS::Record contains some -# data checking routines - -sub check { - my $self = shift; - my $error = - $self->ut_numbern('portnum') - || $self->ut_ipn('ip') - || $self->ut_numbern('nasport') - || $self->ut_number('nasnum'); - ; - return $error if $error; - return "Either ip or nasport must be specified" - unless $self->ip || $self->nasport; - return "Unknown nasnum" - unless qsearchs('nas', { 'nasnum' => $self->nasnum } ); - ''; #no error -} - -=item session - -Returns the currently open session on this port, or if no session is currently -open, the most recent session. See L. - -=cut - -sub session { - my $self = shift; - qsearchs('session', { 'portnum' => $self->portnum }, '*', - 'ORDER BY login DESC LIMIT 1' ); -} - -=back - -=head1 VERSION - -$Id: port.pm,v 1.5 2001-02-14 04:33:06 ivan Exp $ - -=head1 BUGS - -The author forgot to customize this manpage. - -The session method won't deal well if you have multiple open sessions on a -port, for example if your RADIUS server drops B records. Suggestions for -how to deal with this sort of lossage welcome; should we close the session -when we get a new session on that port? Tag it as invalid somehow? Close it -one second after it was opened? *sigh* Maybe FS::session shouldn't let you -create overlapping sessions, at least folks will find out their logging is -dropping records. - -If you think the above refers multiple user logins you need to read the -manpages again. - -=head1 SEE ALSO - -L, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/prepay_credit.pm b/FS/FS/prepay_credit.pm deleted file mode 100644 index 7ed9b8344..000000000 --- a/FS/FS/prepay_credit.pm +++ /dev/null @@ -1,126 +0,0 @@ -package FS::prepay_credit; - -use strict; -use vars qw( @ISA ); -#use FS::Record qw( qsearch qsearchs ); -use FS::Record qw(); - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::prepay_credit - Object methods for prepay_credit records - -=head1 SYNOPSIS - - use FS::prepay_credit; - - $record = new FS::prepay_credit \%hash; - $record = new FS::prepay_credit { - 'identifier' => '4198123455512121' - 'amount' => '19.95', - }; - - $record = new FS::prepay_credit { - 'identifier' => '4198123455512121' - 'seconds' => '7200', - }; - - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::table_name object represents an pre--paid credit, such as a pre-paid -"calling card". FS::prepay_credit inherits from FS::Record. The following -fields are currently supported: - -=over 4 - -=item field - description - -=item identifier - identifier entered by the user to receive the credit - -=item amount - amount of the credit - -=item seconds - time amount of credit (see L) - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new pre-paid credit. To add the example to the database, see -L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I method. - -=cut - -sub table { 'prepay_credit'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=cut - -=item delete - -Delete this record from the database. - -=cut - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -=item check - -Checks all fields to make sure this is a valid pre-paid credit. If there is -an error, returns the error, otherwise returns false. Called by the insert -and replace methods. - -=cut - -sub check { - my $self = shift; - - my $identifier = $self->identifier; - $identifier =~ s/\W//g; #anything else would just confuse things - $self->identifier($identifier); - - $self->ut_numbern('prepaynum') - || $self->ut_alpha('identifier') - || $self->ut_money('amount') - || $self->utnumbern('seconds') - ; - -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L, L, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/queue.pm b/FS/FS/queue.pm deleted file mode 100644 index d35dc883f..000000000 --- a/FS/FS/queue.pm +++ /dev/null @@ -1,401 +0,0 @@ -package FS::queue; - -use strict; -use vars qw( @ISA @EXPORT_OK $conf $jobnums); -use Exporter; -use FS::UID; -use FS::Conf; -use FS::Record qw( qsearch qsearchs dbh ); -#use FS::queue; -use FS::queue_arg; -use FS::queue_depend; -use FS::cust_svc; - -@ISA = qw(FS::Record); -@EXPORT_OK = qw( joblisting ); - -$FS::UID::callback{'FS::queue'} = sub { - $conf = new FS::Conf; -}; - -$jobnums = ''; - -=head1 NAME - -FS::queue - Object methods for queue records - -=head1 SYNOPSIS - - use FS::queue; - - $record = new FS::queue \%hash; - $record = new FS::queue { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::queue object represents an queued job. FS::queue inherits from -FS::Record. The following fields are currently supported: - -=over 4 - -=item jobnum - primary key - -=item job - fully-qualified subroutine name - -=item status - job status - -=item statustext - freeform text status message - -=item _date - UNIX timestamp - -=item svcnum - optional link to service (see L) - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new job. To add the example to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'queue'; } - -=item insert [ ARGUMENT, ARGUMENT... ] - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -If any arguments are supplied, a queue_arg record for each argument is also -created (see L). - -=cut - -#false laziness w/part_export.pm -sub insert { - my $self = shift; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $error = $self->SUPER::insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - foreach my $arg ( @_ ) { - my $queue_arg = new FS::queue_arg ( { - 'jobnum' => $self->jobnum, - 'arg' => $arg, - } ); - $error = $queue_arg->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - push @$jobnums, $self->jobnum if $jobnums; - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; - -} - -=item delete - -Delete this record from the database. Any corresponding queue_arg records are -deleted as well - -=cut - -sub delete { - my $self = shift; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my @del = qsearch( 'queue_arg', { 'jobnum' => $self->jobnum } ); - push @del, qsearch( 'queue_depend', { 'depend_jobnum' => $self->jobnum } ); - - my $error = $self->SUPER::delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - foreach my $del ( @del ) { - $error = $del->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; - -} - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -# the replace method can be inherited from FS::Record - -=item check - -Checks all fields to make sure this is a valid job. If there is -an error, returns the error, otherwise returns false. Called by the insert -and replace methods. - -=cut - -sub check { - my $self = shift; - my $error = - $self->ut_numbern('jobnum') - || $self->ut_anything('job') - || $self->ut_numbern('_date') - || $self->ut_enum('status',['', qw( new locked failed )]) - || $self->ut_anything('statustext') - || $self->ut_numbern('svcnum') - ; - return $error if $error; - - $error = $self->ut_foreign_keyn('svcnum', 'cust_svc', 'svcnum'); - $self->svcnum('') if $error; - - $self->status('new') unless $self->status; - $self->_date(time) unless $self->_date; - - ''; #no error -} - -=item args - -Returns a list of the arguments associated with this job. - -=cut - -sub args { - my $self = shift; - map $_->arg, qsearch( 'queue_arg', - { 'jobnum' => $self->jobnum }, - '', - 'ORDER BY argnum' - ); -} - -=item cust_svc - -Returns the FS::cust_svc object associated with this job, if any. - -=cut - -sub cust_svc { - my $self = shift; - qsearchs('cust_svc', { 'svcnum' => $self->svcnum } ); -} - -=item queue_depend - -Returns the FS::queue_depend objects associated with this job, if any. - -=cut - -sub queue_depend { - my $self = shift; - qsearch('queue_depend', { 'jobnum' => $self->jobnum } ); -} - - -=item depend_insert OTHER_JOBNUM - -Inserts a dependancy for this job - it will not be run until the other job -specified completes. If there is an error, returns the error, otherwise -returns false. - -When using job dependancies, you should wrap the insertion of all relevant jobs -in a database transaction. - -=cut - -sub depend_insert { - my($self, $other_jobnum) = @_; - my $queue_depend = new FS::queue_depend ( { - 'jobnum' => $self->jobnum, - 'depend_jobnum' => $other_jobnum, - } ); - $queue_depend->insert; -} - -=back - -=head1 SUBROUTINES - -=over 4 - -=item joblisting HASHREF NOACTIONS - -=cut - -sub joblisting { - my($hashref, $noactions) = @_; - - use Date::Format; - use HTML::Entities; - use FS::CGI; - - my @queue = qsearch( 'queue', $hashref ); - return '' unless scalar(@queue); - - my $p = FS::CGI::popurl(2); - - my $html = qq!
!. - FS::CGI::table(). < - Job - Args - Date - Status -END - $html .= 'Account' unless $hashref->{svcnum}; - $html .= ''; - - my $dangerous = $conf->exists('queue_dangerous_controls'); - - my $areboxes = 0; - - foreach my $queue ( sort { - $a->getfield('jobnum') <=> $b->getfield('jobnum') - } @queue ) { - my $queue_hashref = $queue->hashref; - my $jobnum = $queue->jobnum; - - my $args; - if ( $dangerous || $queue->job !~ /^FS::part_export::/ || !$noactions ) { - $args = encode_entities( join(' ', - map { length($_)<54 ? $_ : substr($_,0,32)."..." } $queue->args #1&g - ) ); - } else { - $args = ''; - } - - my $date = time2str( "%a %b %e %T %Y", $queue->_date ); - my $status = $queue->status; - $status .= ': '. $queue->statustext if $queue->statustext; - my @queue_depend = $queue->queue_depend; - $status .= ' (waiting for '. - join(', ', map { $_->depend_jobnum } @queue_depend ). - ')' - if @queue_depend; - my $changable = $dangerous - || ( ! $noactions && $status =~ /^failed/ || $status =~ /^locked/ ); - if ( $changable ) { - $status .= - qq! ( retry |!. - qq! remove )!; - } - my $cust_svc = $queue->cust_svc; - - $html .= < - $jobnum - $queue_hashref->{job} - $args - $date - $status -END - - unless ( $hashref->{svcnum} ) { - my $account; - if ( $cust_svc ) { - my $table = $cust_svc->part_svc->svcdb; - my $label = ( $cust_svc->label )[1]; - $account = qq!$label!; - } else { - $account = ''; - } - $html .= "$account"; - } - - if ( $changable ) { - $areboxes=1; - $html .= - qq!!; - - } - - $html .= ''; - -} - - $html .= ''; - - if ( $areboxes ) { - $html .= '
'. - '
'; - } - - $html; - -} - -=back - -=head1 VERSION - -$Id: queue.pm,v 1.15 2002-07-02 06:48:59 ivan Exp $ - -=head1 BUGS - -$jobnums global - -=head1 SEE ALSO - -L, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/queue_arg.pm b/FS/FS/queue_arg.pm deleted file mode 100644 index 08fe47341..000000000 --- a/FS/FS/queue_arg.pm +++ /dev/null @@ -1,121 +0,0 @@ -package FS::queue_arg; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::queue_arg - Object methods for queue_arg records - -=head1 SYNOPSIS - - use FS::queue_arg; - - $record = new FS::queue_arg \%hash; - $record = new FS::queue_arg { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::queue_arg object represents job argument. FS::queue_arg inherits from -FS::Record. The following fields are currently supported: - -=over 4 - -=item argnum - primary key - -=item jobnum - see L - -=item arg - argument - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new argument. To add the example to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'queue_arg'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=cut - -# the insert method can be inherited from FS::Record - -=item delete - -Delete this record from the database. - -=cut - -# the delete method can be inherited from FS::Record - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -# the replace method can be inherited from FS::Record - -=item check - -Checks all fields to make sure this is a valid argument. If there is -an error, returns the error, otherwise returns false. Called by the insert -and replace methods. - -=cut - -sub check { - my $self = shift; - my $error = - $self->ut_numbern('argnum') - || $self->ut_numbern('jobnum') - || $self->ut_anything('arg') - ; - return $error if $error; - - ''; #no error -} - -=back - -=head1 VERSION - -$Id: queue_arg.pm,v 1.1 2001-09-11 00:08:18 ivan Exp $ - -=head1 BUGS - -=head1 SEE ALSO - -L, L, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/queue_depend.pm b/FS/FS/queue_depend.pm deleted file mode 100644 index 4a4e3c55c..000000000 --- a/FS/FS/queue_depend.pm +++ /dev/null @@ -1,120 +0,0 @@ -package FS::queue_depend; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); -use FS::queue; - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::queue_depend - Object methods for queue_depend records - -=head1 SYNOPSIS - - use FS::queue_depend; - - $record = new FS::queue_depend \%hash; - $record = new FS::queue_depend { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::queue_depend object represents an job dependancy. FS::queue_depend -inherits from FS::Record. The following fields are currently supported: - -=over 4 - -=item dependnum - primary key - -=item jobnum - source jobnum (see L). - -=item depend_jobnum - dependancy jobnum (see L) - -=back - -The job specified by B depends on the job specified B - -the B job will not be run until the B job has completed -sucessfully (or manually removed). - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new dependancy. To add the dependancy to the database, see -L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'queue_depend'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=cut - -# the insert method can be inherited from FS::Record - -=item delete - -Delete this record from the database. - -=cut - -# the delete method can be inherited from FS::Record - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -# the replace method can be inherited from FS::Record - -=item check - -Checks all fields to make sure this is a valid dependancy. If there is -an error, returns the error, otherwise returns false. Called by the insert -and replace methods. - -=cut - -sub check { - my $self = shift; - - $self->ut_numbern('dependnum') - || $self->ut_foreign_key('jobnum', 'queue', 'jobnum') - || $self->ut_foreign_key('depend_jobnum', 'queue', 'jobnum') - ; -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L, L, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/raddb.pm b/FS/FS/raddb.pm deleted file mode 100644 index 497d98450..000000000 --- a/FS/FS/raddb.pm +++ /dev/null @@ -1,1091 +0,0 @@ -package FS::raddb; -use vars qw(%attrib); - -%attrib = ( - 'ascend_bi_directional_au' => 'Ascend-Bi-Directional-Auth', - 'h323_connect_time' => 'h323-connect-time', - 'connect_rate' => 'Connect-Rate', - 'bind_auth_service_grp' => 'Bind_Auth_Service_Grp', - 'usr_callback_type' => 'USR-Callback-Type', - 'erx_primary_wins' => 'ERX-Primary-Wins', - 'ascend_x25_x121_address' => 'Ascend-X25-X121-Address', - 'usr_log_filter_packets' => 'USR-Log-Filter-Packets', - 'annex_addr_resolution_pr' => 'Annex-Addr-Resolution-Protocol', - 'usr_ip_rip_simple_auth_p' => 'USR-IP-RIP-Simple-Auth-Password', - 'dialback_name' => 'Dialback-Name', - 'x_ascend_fr_dce_n392' => 'X-Ascend-FR-DCE-N392', - 'usr_host_type' => 'USR-Host-Type', - 'le_modem_info' => 'LE-Modem-Info', - 'x_ascend_menu_selector' => 'X-Ascend-Menu-Selector', - 'x_ascend_fr_dce_n393' => 'X-Ascend-FR-DCE-N393', - 'ascend_ip_direct' => 'Ascend-IP-Direct', - 'x_ascend_pre_output_octe' => 'X-Ascend-Pre-Output-Octets', - 'x_ascend_ft1_caller' => 'X-Ascend-FT1-Caller', - 'usr_last_callers_number_' => 'USR-Last-Callers-Number-ANI', - 'usr_rmmie_product_code' => 'USR-RMMIE-Product-Code', - 'usr_igmp_robustness' => 'USR-IGMP-Robustness', - 'ms_chap2_success' => 'MS-CHAP2-Success', - 'ascend_home_agent_passwo' => 'Ascend-Home-Agent-Password', - 'acc_bridging_support' => 'Acc-Bridging-Support', - 'annex_transmit_speed' => 'Annex-Transmit-Speed', - 'old_password' => 'Old-Password', - 'x_ascend_metric' => 'X-Ascend-Metric', - 'acc_clearing_location' => 'Acc-Clearing-Location', - 'ascend_multilink_id' => 'Ascend-Multilink-ID', - 'ascend_egress_enabled' => 'Ascend-Egress-Enabled', - 'usr_bridging' => 'USR-Bridging', - 'ascend_assign_ip_server' => 'Ascend-Assign-IP-Server', - 'acc_dns_server_sec' => 'Acc-Dns-Server-Sec', - 'ascend_home_agent_ip_add' => 'Ascend-Home-Agent-IP-Addr', - 'usr_dnis_reauthenticatio' => 'USR-DNIS-ReAuthentication', - 'acc_modem_error_protocol' => 'Acc-Modem-Error-Protocol', - 'ascend_backup' => 'Ascend-Backup', - 'usr_connect_time' => 'USR-Connect-Time', - 'ascend_cbcp_mode' => 'Ascend-CBCP-Mode', - 'usr_rmmie_x2_status' => 'USR-RMMIE-x2-Status', - 'ascend_multicast_gleave_' => 'Ascend-Multicast-GLeave-Delay', - 'erx_ingress_statistics' => 'ERX-Ingress-Statistics', - 'cisco_nas_port' => 'Cisco-NAS-Port', - 'le_admin_group' => 'LE-Admin-Group', - 'annex_mrru' => 'Annex-MRRU', - 'x_ascend_add_seconds' => 'X-Ascend-Add-Seconds', - 'ascend_token_expiry' => 'Ascend-Token-Expiry', - 'usr_igmp_maximum_respons' => 'USR-IGMP-Maximum-Response-Time', - 'ascend_calling_id_presen' => 'Ascend-Calling-Id-Presentatn', - 'connect_info' => 'Connect-Info', - 'ascend_access_intercept_' => 'Ascend-Access-Intercept-LEA', - 'x_ascend_dba_monitor' => 'X-Ascend-DBA-Monitor', - 'client_dns_pri' => 'Client_DNS_Pri', - 'ip_host_addr' => 'Ip_Host_Addr', - 'callback_id' => 'Callback-Id', - 'acct_mcast_out_octets' => 'Acct_Mcast_Out_Octets', - 'acct_input_octets_64' => 'Acct_Input_Octets_64', - 'tunnel_function' => 'Tunnel_Function', - 'ascend_fr_direct_profile' => 'Ascend-FR-Direct-Profile', - 'h323_incoming_conf_id' => 'h323-incoming-conf-id', - 'ascend_ppp_vj_1172' => 'Ascend-PPP-VJ-1172', - 'ms_new_arap_password' => 'MS-New-ARAP-Password', - 'h323_voice_quality' => 'h323-voice-quality', - 'framed_appletalk_network' => 'Framed-AppleTalk-Network', - 'bind_int_interface_name' => 'Bind_Int_Interface_Name', - 'event_timestamp' => 'Event-Timestamp', - 'ascend_bir_enable' => 'Ascend-BIR-Enable', - 'usr_fallback_enabled' => 'USR-Fallback-Enabled', - 'ascend_dhcp_pool_number' => 'Ascend-DHCP-Pool-Number', - 'acct_session_id' => 'Acct-Session-Id', - 'ascend_private_route_req' => 'Ascend-Private-Route-Required', - 'usr_rmmie_pwrlvl_farecho' => 'USR-RMMIE-PwrLvl-FarEcho-Canc', - 'usr_at_input_filter' => 'USR-AT-Input-Filter', - 'erx_egress_statistics' => 'ERX-Egress-Statistics', - 'x_ascend_call_type' => 'X-Ascend-Call-Type', - 'acct_tunnel_client_endpo' => 'Acct-Tunnel-Client-Endpoint', - 'x_ascend_assign_ip_clien' => 'X-Ascend-Assign-IP-Client', - 'ascend_if_netmask' => 'Ascend-IF-Netmask', - 'ascend_dhcp_maximum_leas' => 'Ascend-DHCP-Maximum-Leases', - 'usr_at_output_filter' => 'USR-AT-Output-Filter', - 'usr_rad_dvmrp_metric' => 'USR-Rad-Dvmrp-Metric', - 'rate_limit_rate' => 'Rate_Limit_Rate', - 'prefix' => 'Prefix', - 'ascend_x25_pad_banner' => 'Ascend-X25-Pad-Banner', - 'usr_rmmie_rcv_pwrlvl_375' => 'USR-RMMIE-Rcv-PwrLvl-3750Hz', - 'x_ascend_user_acct_key' => 'X-Ascend-User-Acct-Key', - 'group_name' => 'Group-Name', - 'ascend_receive_secret' => 'Ascend-Receive-Secret', - 'reply_message' => 'Reply-Message', - 'le_nat_sess_dir_fail_act' => 'LE-NAT-Sess-Dir-Fail-Action', - 'framed_callback_id' => 'Framed-Callback-Id', - 'cisco_disconnect_cause' => 'Cisco-Disconnect-Cause', - 'stripped_user_name' => 'Stripped-User-Name', - 'annex_keypress_timeout' => 'Annex-Keypress-Timeout', - 'annex_receive_speed' => 'Annex-Receive-Speed', - 'ms_chap_domain' => 'MS-CHAP-Domain', - 'ascend_atm_connect_group' => 'Ascend-ATM-Connect-Group', - 'usr_send_name' => 'USR-Send-Name', - 'usr_local_framed_ip_addr' => 'USR-Local-Framed-IP-Addr', - 'erx_alternate_cli_vroute' => 'ERX-Alternate-Cli-Vrouter-Name', - 'usr_fallback_limit' => 'USR-Fallback-Limit', - 'ascend_pri_number_type' => 'Ascend-PRI-Number-Type', - 'x_ascend_minimum_channel' => 'X-Ascend-Minimum-Channels', - 'x_ascend_fr_direct_dlci' => 'X-Ascend-FR-Direct-DLCI', - 'ascend_fr_link_mgt' => 'Ascend-FR-Link-Mgt', - 'annex_host_allow' => 'Annex-Host-Allow', - 'x_ascend_force_56' => 'X-Ascend-Force-56', - 'police_burst' => 'Police_Burst', - 'pvc_profile_name' => 'PVC_Profile_Name', - 'ms_filter' => 'MS-Filter', - 'rate_limit_burst' => 'Rate_Limit_Burst', - 'ascend_number_sessions' => 'Ascend-Number-Sessions', - 'cisco_call_filter' => 'Cisco-Call-Filter', - 'erx_igmp_enable' => 'ERX-Igmp-Enable', - 'ascend_filter_required' => 'Ascend-Filter-Required', - 'erx_cli_allow_all_vr_acc' => 'ERX-Cli-Allow-All-VR-Access', - 'acc_callback_delay' => 'Acc-Callback-Delay', - 'usr_default_dte_data_rat' => 'USR-Default-DTE-Data-Rate', - 'le_ip_pool' => 'LE-IP-Pool', - 'cisco_pre_output_packets' => 'Cisco-Pre-Output-Packets', - 'x_ascend_group' => 'X-Ascend-Group', - 'usr_channel_connected_to' => 'USR-Channel-Connected-To', - 'usr_ipx_rip_output_filte' => 'USR-IPX-RIP-Output-Filter', - 'usr_esn' => 'USR-ESN', - 'annex_user_level' => 'Annex-User-Level', - 'x_ascend_primary_home_ag' => 'X-Ascend-Primary-Home-Agent', - 'no_such_attribute' => 'No-Such-Attribute', - 'x_ascend_pri_number_type' => 'X-Ascend-PRI-Number-Type', - 'ms_mppe_send_key' => 'MS-MPPE-Send-Key', - 'usr_actual_voltage' => 'USR-Actual-Voltage', - 'annex_acct_servers' => 'Annex-Acct-Servers', - 'ascend_handle_ipx' => 'Ascend-Handle-IPX', - 'cisco_xmit_rate' => 'Cisco-Xmit-Rate', - 'acc_service_profile' => 'Acc-Service-Profile', - 'x_ascend_ara_pw' => 'X-Ascend-Ara-PW', - 'ascend_ckt_type' => 'Ascend-Ckt-Type', - 'cisco_data_rate' => 'Cisco-Data-Rate', - 'group' => 'Group', - 'nas_port' => 'NAS-Port', - 'usr_ipx_call_output_filt' => 'USR-IPX-Call-Output-Filter', - 'tunnel_type' => 'Tunnel-Type', - 'usr_rmmie_manufacturer_i' => 'USR-RMMIE-Manufacturer-ID', - 'user_name_is_star' => 'User-Name-Is-Star', - 'usr_call_arrival_in_gmt' => 'USR-Call-Arrival-in-GMT', - 'x_ascend_number_sessions' => 'X-Ascend-Number-Sessions', - 'ascend_send_auth' => 'Ascend-Send-Auth', - 'user_service_type' => 'User-Service-Type', - 'annex_cli_filter' => 'Annex-CLI-Filter', - 'erx_cli_initial_access_l' => 'ERX-Cli-Initial-Access-Level', - 'ascend_call_direction' => 'Ascend-Call-Direction', - 'usr_chassis_temp_thresho' => 'USR-Chassis-Temp-Threshold', - 'usr_pw_usr_ofilter_ipx' => 'USR-PW_USR_OFilter_IPX', - 'tunnel_session_auth' => 'Tunnel_Session_Auth', - 'x_ascend_connect_progres' => 'X-Ascend-Connect-Progress', - 'ascend_atm_connect_vci' => 'Ascend-ATM-Connect-Vci', - 'x_ascend_maximum_call_du' => 'X-Ascend-Maximum-Call-Duration', - 'usr_rmmie_planned_discon' => 'USR-RMMIE-Planned-Disconnect', - 'x_ascend_fr_dte_n392' => 'X-Ascend-FR-DTE-N392', - 'login_host' => 'Login-Host', - 'ascend_user_acct_host' => 'Ascend-User-Acct-Host', - 'x_ascend_fr_dte_n393' => 'X-Ascend-FR-DTE-N393', - 'acc_tunnel_secret' => 'Acc-Tunnel-Secret', - 'usr_at_rtmp_input_filter' => 'USR-AT-RTMP-Input-Filter', - 'framed_protocol' => 'Framed-Protocol', - 'login_callback_number' => 'Login-Callback-Number', - 'ascend_dsl_rate_type' => 'Ascend-Dsl-Rate-Type', - 'ascend_pre_output_packet' => 'Ascend-Pre-Output-Packets', - 'proxy_state' => 'Proxy-State', - 'usr_pw_usr_ofilter_ip' => 'USR-PW_USR_OFilter_IP', - 'cisco_data_filter' => 'Cisco-Data-Filter', - 'cisco_target_util' => 'Cisco-Target-Util', - 'usr_ids0_call_type' => 'USR-IDS0-Call-Type', - 'usr_blocks_resent' => 'USR-Blocks-Resent', - 'usr_terminal_type' => 'USR-Terminal-Type', - 'ascend_history_weigh_typ' => 'Ascend-History-Weigh-Type', - 'framed_routing' => 'Framed-Routing', - 'ascend_client_assign_dns' => 'Ascend-Client-Assign-DNS', - 'ascend_atm_group' => 'Ascend-ATM-Group', - 'bind_bypass_bypass' => 'Bind_Bypass_Bypass', - 'le_ip_gateway' => 'LE-IP-Gateway', - 'cisco_ip_pool_definition' => 'Cisco-IP-Pool-Definition', - 'x_ascend_maximum_time' => 'X-Ascend-Maximum-Time', - 'usr_request_type' => 'USR-Request-Type', - 'usr_call_arrival_time' => 'USR-Call-Arrival-Time', - 'tunnel_domain' => 'Tunnel_Domain', - 'ms_chap_nt_enc_pw' => 'MS-CHAP-NT-Enc-PW', - 'shiva_calling_number' => 'Shiva-Calling-Number', - 'ip_address_pool_name' => 'Ip_Address_Pool_Name', - 'erx_secondary_dns' => 'ERX-Secondary-Dns', - 'x_ascend_pre_input_octet' => 'X-Ascend-Pre-Input-Octets', - 'ascend_home_agent_udp_po' => 'Ascend-Home-Agent-UDP-Port', - 'le_nat_outsource_inmap' => 'LE-NAT-Outsource-Inmap', - 'x_ascend_home_agent_pass' => 'X-Ascend-Home-Agent-Password', - 'tunnel_password' => 'Tunnel-Password', - 'usr_compression_type' => 'USR-Compression-Type', - 'usr_connect_speed' => 'USR-Connect-Speed', - 'usr_connect_time_limit' => 'USR-Connect-Time-Limit', - 'arap_challenge_response' => 'ARAP-Challenge-Response', - 'ms_link_utilization_thre' => 'MS-Link-Utilization-Threshold', - 'usr_mp_edo' => 'USR-MP-EDO', - 'usr_primary_nbns_server' => 'USR-Primary_NBNS_Server', - 'usr_imsi' => 'USR-IMSI', - 'ascend_fr_direct' => 'Ascend-FR-Direct', - 'ascend_vrouter_name' => 'Ascend-VRouter-Name', - 'ascend_preempt_limit' => 'Ascend-Preempt-Limit', - 'ascend_ip_pool_definitio' => 'Ascend-IP-Pool-Definition', - 'h323_gw_id' => 'h323-gw-id', - 'usr_framed_ipx_route' => 'USR-Framed-IPX-Route', - 'x_ascend_maximum_channel' => 'X-Ascend-Maximum-Channels', - 'login_lat_node' => 'Login-LAT-Node', - 'acct_session_time' => 'Acct-Session-Time', - 'ascend_disconnect_cause' => 'Ascend-Disconnect-Cause', - 'ms_mppe_encryption_polic' => 'MS-MPPE-Encryption-Policy', - 'ms_ras_version' => 'MS-RAS-Version', - 'class' => 'Class', - 'caller_id' => 'Caller-ID', - 'ascend_access_intercept_' => 'Ascend-Access-Intercept-Log', - 'ascend_service_type' => 'Ascend-Service-Type', - 'ascend_h323_dialed_time' => 'Ascend-H323-Dialed-Time', - 'exec_program_wait' => 'Exec-Program-Wait', - 'ascend_x25_nui_password_' => 'Ascend-X25-Nui-Password-Prompt', - 'ascend_appletalk_peer_mo' => 'Ascend-Appletalk-Peer-Mode', - 'login_lat_group' => 'Login-LAT-Group', - 'strip_user_name' => 'Strip-User-Name', - 'nas_ip_address' => 'NAS-IP-Address', - 'ascend_maximum_time' => 'Ascend-Maximum-Time', - 'erx_atm_pcr' => 'ERX-Atm-PCR', - 'ascend_client_primary_dn' => 'Ascend-Client-Primary-DNS', - 'auth_type' => 'Auth-Type', - 'ascend_secondary_home_ag' => 'Ascend-Secondary-Home-Agent', - 'x_ascend_idle_limit' => 'X-Ascend-Idle-Limit', - 'ms_ras_vendor' => 'MS-RAS-Vendor', - 'ascend_pre_input_packets' => 'Ascend-Pre-Input-Packets', - 'ascend_bridge' => 'Ascend-Bridge', - 'h323_redirect_number' => 'h323-redirect-number', - 'usr_simplified_mnp_level' => 'USR-Simplified-MNP-Levels', - 'annex_edo' => 'Annex-EDO', - 'acc_nbns_server_sec' => 'Acc-Nbns-Server-Sec', - 'ascend_cbcp_trunk_group' => 'Ascend-CBCP-Trunk-Group', - 'x_ascend_data_svc' => 'X-Ascend-Data-Svc', - 'le_terminate_detail' => 'LE-Terminate-Detail', - 'acct_output_octets' => 'Acct-Output-Octets', - 'usr_calling_party_number' => 'USR-Calling-Party-Number', - 'x_ascend_dhcp_maximum_le' => 'X-Ascend-DHCP-Maximum-Leases', - 'ascend_force_56' => 'Ascend-Force-56', - 'shiva_acct_serv_switch' => 'Shiva-Acct-Serv-Switch', - 'tunnel_algorithm' => 'Tunnel_Algorithm', - 'usr_max_channels' => 'USR-Max-Channels', - 'usr_port_tap_priority' => 'USR-Port-Tap-Priority', - 'le_nat_outmap' => 'LE-NAT-Outmap', - 'usr_call_connecting_time' => 'USR-Call-Connecting-Time', - 'usr_supports_tags' => 'USR-Supports-Tags', - 'idle_timeout' => 'Idle-Timeout', - 'usr_ip_rip_input_filter' => 'USR-IP-RIP-Input-Filter', - 'erx_ingress_policy_name' => 'ERX-Ingress-Policy-Name', - 'usr_pw_cutoff' => 'USR-PW_Cutoff', - 'usr_channel_expansion' => 'USR-Channel-Expansion', - 'x_ascend_send_secret' => 'X-Ascend-Send-Secret', - 'h323_call_origin' => 'h323-call-origin', - 'h323_preferred_lang' => 'h323-preferred-lang', - 'ascend_base_channel_coun' => 'Ascend-Base-Channel-Count', - 'bind_auth_context' => 'Bind_Auth_Context', - 'ascend_calling_id_number' => 'Ascend-Calling-Id-Number-Plan', - 'ascend_modem_shelfno' => 'Ascend-Modem-ShelfNo', - 'tunnel_police_burst' => 'Tunnel_Police_Burst', - 'pvc_circuit_padding' => 'PVC_Circuit_Padding', - 'acc_ml_call_threshold' => 'Acc-ML-Call-Threshold', - 'usr_end_time' => 'USR-End-Time', - 'usr_ipx' => 'USR-IPX', - 'ms_primary_dns_server' => 'MS-Primary-DNS-Server', - 'ascend_dsl_upstream_limi' => 'Ascend-Dsl-Upstream-Limit', - 'usr_blocks_sent' => 'USR-Blocks-Sent', - 'bind_dot1q_vlan_tag_id' => 'Bind_Dot1q_Vlan_Tag_Id', - 'ascend_private_route' => 'Ascend-Private-Route', - 'usr_back_channel_data_ra' => 'USR-Back-Channel-Data-Rate', - 'ascend_dropped_packets' => 'Ascend-Dropped-Packets', - 'cisco_route_ip' => 'Cisco-Route-IP', - 'nas_identifier' => 'NAS-Identifier', - 'ascend_presession_time' => 'Ascend-PreSession-Time', - 'usr_call_type' => 'USR-Call-Type', - 'usr_acct_reason_code' => 'USR-Acct-Reason-Code', - 'acc_dialout_auth_passwor' => 'Acc-Dialout-Auth-Password', - 'acc_connect_tx_speed' => 'Acc-Connect-Tx-Speed', - 'cisco_pre_input_octets' => 'Cisco-Pre-Input-Octets', - 'x_ascend_send_passwd' => 'X-Ascend-Send-Passwd', - 'ascend_bir_bridge_group' => 'Ascend-BIR-Bridge-Group', - 'ascend_fr_profile_name' => 'Ascend-FR-Profile-Name', - 'ascend_group' => 'Ascend-Group', - 'crypt_password' => 'Crypt-Password', - 'usr_port_tap_address' => 'USR-Port-Tap-Address', - 'le_nat_outsource_outmap' => 'LE-NAT-Outsource-Outmap', - 'usr_vpn_encrypter' => 'USR-VPN-Encrypter', - 'usr_blocks_received' => 'USR-Blocks-Received', - 'tunnel_group' => 'Tunnel_Group', - 'ascend_shared_profile_en' => 'Ascend-Shared-Profile-Enable', - 'replicate_to_realm' => 'Replicate-To-Realm', - 'usr_mobile_ip_address' => 'USR-Mobile-IP-Address', - 'x_ascend_authen_alias' => 'X-Ascend-Authen-Alias', - 'ascend_fr_linkup' => 'Ascend-FR-LinkUp', - 'tunnel_rate_limit_rate' => 'Tunnel_Rate_Limit_Rate', - 'acc_access_community' => 'Acc-Access-Community', - 'x_ascend_presession_time' => 'X-Ascend-PreSession-Time', - 'ms_chap_cpw_1' => 'MS-CHAP-CPW-1', - 'ms_chap_cpw_2' => 'MS-CHAP-CPW-2', - 'erx_primary_dns' => 'ERX-Primary-Dns', - 'ascend_fr_circuit_name' => 'Ascend-FR-Circuit-Name', - 'ascend_token_immediate' => 'Ascend-Token-Immediate', - 'cisco_idle_limit' => 'Cisco-Idle-Limit', - 'usr_speed_of_connection' => 'USR-Speed-Of-Connection', - 'shiva_links_in_bundle' => 'Shiva-Links-In-Bundle', - 'x_ascend_fr_profile_name' => 'X-Ascend-FR-Profile-Name', - 'cisco_multilink_id' => 'Cisco-Multilink-ID', - 'x_ascend_preempt_limit' => 'X-Ascend-Preempt-Limit', - 'ascend_assign_ip_client' => 'Ascend-Assign-IP-Client', - 'usr_iwf_ip_address' => 'USR-IWF-IP-Address', - 'acct_unique_session_id' => 'Acct-Unique-Session-Id', - 'framed_pool' => 'Framed-Pool', - 'usr_igmp_version' => 'USR-IGMP-Version', - 'tunnel_max_tunnels' => 'Tunnel_Max_Tunnels', - 'annex_unauthenticated_ti' => 'Annex-Unauthenticated-Time', - 'bg_path_cost' => 'BG_Path_Cost', - 'ascend_client_assign_win' => 'Ascend-Client-Assign-WINS', - 'x_ascend_dial_number' => 'X-Ascend-Dial-Number', - 'cisco_maximum_channels' => 'Cisco-Maximum-Channels', - 'usr_pw_framed_routing_v2' => 'USR-PW_Framed_Routing_V2', - 'usr_channel_decrement' => 'USR-Channel-Decrement', - 'x_ascend_route_ipx' => 'X-Ascend-Route-IPX', - 'port_limit' => 'Port-Limit', - 'ascend_dsl_downstream_li' => 'Ascend-Dsl-Downstream-Limit', - 'ascend_ip_tos_precedence' => 'Ascend-IP-TOS-Precedence', - 'usr_multicast_receive' => 'USR-Multicast-Receive', - 'usr_auth_mode' => 'USR-Auth-Mode', - 'expiration' => 'Expiration', - 'x_ascend_fr_circuit_name' => 'X-Ascend-FR-Circuit-Name', - 'x_ascend_token_immediate' => 'X-Ascend-Token-Immediate', - 'ascend_ft1_caller' => 'Ascend-FT1-Caller', - 'shiva_event_flags' => 'Shiva-Event-Flags', - 'framed_netmask' => 'Framed-Netmask', - 'ascend_minimum_channels' => 'Ascend-Minimum-Channels', - 'acc_ml_damping_factor' => 'Acc-ML-Damping-Factor', - 'bind_sub_password' => 'Bind_Sub_Password', - 'ascend_ip_tos_apply_to' => 'Ascend-IP-TOS-Apply-To', - 'x_ascend_home_agent_udp_' => 'X-Ascend-Home-Agent-UDP-Port', - 'x_ascend_menu_item' => 'X-Ascend-Menu-Item', - 'ascend_session_type' => 'Ascend-Session-Type', - 'usr_pw_packet' => 'USR-PW_Packet', - 'session' => 'Session', - 'usr_mic' => 'USR-MIC', - 'usr_line_reversals' => 'USR-Line-Reversals', - 'assigned_ip_address' => 'Assigned_IP_Address', - 'cisco_ip_direct' => 'Cisco-IP-Direct', - 'le_ipsec_log_options' => 'LE-IPSec-Log-Options', - 'tunnel_rate_limit_burst' => 'Tunnel_Rate_Limit_Burst', - 'x_ascend_assign_ip_globa' => 'X-Ascend-Assign-IP-Global-Pool', - 'x_ascend_inc_channel_cou' => 'X-Ascend-Inc-Channel-Count', - 'h323_return_code' => 'h323-return-code', - 'shiva_disconnect_reason' => 'Shiva-Disconnect-Reason', - 'filter_id' => 'Filter-Id', - 'usr_appletalk_network_ra' => 'USR-Appletalk-Network-Range', - 'ascend_temporary_rtes' => 'Ascend-Temporary-Rtes', - 'ascend_h323_conference_i' => 'Ascend-H323-Conference-Id', - 'h323_billing_model' => 'h323-billing-model', - 'usr_bearer_capabilities' => 'USR-Bearer-Capabilities', - 'framed_appletalk_zone' => 'Framed-AppleTalk-Zone', - 'usr_harc_disconnect_code' => 'USR-HARC-Disconnect-Code', - 'usr_ipx_rip_input_filter' => 'USR-IPX-RIP-Input-Filter', - 'usr_rad_multicast_routin' => 'USR-Rad-Multicast-Routing-Bound', - 'ascend_pw_lifetime' => 'Ascend-PW-Lifetime', - 'acc_dialout_auth_usernam' => 'Acc-Dialout-Auth-Username', - 'ascend_x25_pad_x3_parame' => 'Ascend-X25-Pad-X3-Parameters', - 'bind_dot1q_slot' => 'Bind_Dot1q_Slot', - 'usr_rad_multicast_routin' => 'USR-Rad-Multicast-Routing-RtLim', - 'x_ascend_multicast_clien' => 'X-Ascend-Multicast-Client', - 'ascend_authen_alias' => 'Ascend-Authen-Alias', - 'ascend_dec_channel_count' => 'Ascend-Dec-Channel-Count', - 'dhcp_max_leases' => 'DHCP_Max_Leases', - 'shiva_called_number' => 'Shiva-Called-Number', - 'annex_tunnel_authen_mode' => 'Annex-Tunnel-Authen-Mode', - 'usr_call_error_code' => 'USR-Call-Error-Code', - 'x_ascend_user_acct_type' => 'X-Ascend-User-Acct-Type', - 'ascend_atm_connect_vpi' => 'Ascend-ATM-Connect-Vpi', - 'ascend_x25_pad_x3_profil' => 'Ascend-X25-Pad-X3-Profile', - 'usr_mobileip_home_agent_' => 'USR-MobileIP-Home-Agent-Address', - 'suffix' => 'Suffix', - 'bind_tun_context' => 'Bind_Tun_Context', - 'x_ascend_ppp_address' => 'X-Ascend-PPP-Address', - 'usr_dtr_false_timeout' => 'USR-DTR-False-Timeout', - 'usr_final_rx_link_data_r' => 'USR-Final-Rx-Link-Data-Rate', - 'ms_chap_error' => 'MS-CHAP-Error', - 'x_ascend_home_agent_ip_a' => 'X-Ascend-Home-Agent-IP-Addr', - 'ascend_data_svc' => 'Ascend-Data-Svc', - 'usr_rmmie_pwrlvl_noise_l' => 'USR-RMMIE-PwrLvl-Noise-Lvl', - 'usr_dtr_true_timeout' => 'USR-DTR-True-Timeout', - 'context_name' => 'Context-Name', - 'usr_card_type' => 'USR-Card-Type', - 'ascend_fr_link_status_dl' => 'Ascend-FR-Link-Status-DLCI', - 'annex_sec_profile_index' => 'Annex-Sec-Profile-Index', - 'usr_pw_usr_ofilter_sap' => 'USR-PW_USR_OFilter_SAP', - 'tunnel_medium_type' => 'Tunnel-Medium-Type', - 'x_ascend_require_auth' => 'X-Ascend-Require-Auth', - 'ascend_connect_progress' => 'Ascend-Connect-Progress', - 'x_ascend_modem_shelfno' => 'X-Ascend-Modem-ShelfNo', - 'cisco_pre_input_packets' => 'Cisco-Pre-Input-Packets', - 'ascend_fr_dce_n392' => 'Ascend-FR-DCE-N392', - 'ascend_fr_dce_n393' => 'Ascend-FR-DCE-N393', - 'ascend_client_primary_wi' => 'Ascend-Client-Primary-WINS', - 'shiva_link_protocol' => 'Shiva-Link-Protocol', - 'bridge_group' => 'Bridge_Group', - 'client_port_dnis' => 'Client-Port-DNIS', - 'usr_mpip_tunnel_originat' => 'USR-MPIP-Tunnel-Originator', - 'le_nat_log_options' => 'LE-NAT-Log-Options', - 'usr_number_of_rings_limi' => 'USR-Number-of-Rings-Limit', - 'usr_retrains_granted' => 'USR-Retrains-Granted', - 'acc_ip_gateway_pri' => 'Acc-Ip-Gateway-Pri', - 'usr_number_of_fallbacks' => 'USR-Number-of-Fallbacks', - 'usr_tunnel_auth_hostname' => 'USR-Tunnel-Auth-Hostname', - 'annex_filter' => 'Annex-Filter', - 'ascend_mtu' => 'Ascend-MTU', - 'ms_arap_pw_change_reason' => 'MS-ARAP-PW-Change-Reason', - 'private_group_id' => 'Private-Group-Id', - 'ascend_cache_time' => 'Ascend-Cache-Time', - 'acc_ml_clear_threshold' => 'Acc-ML-Clear-Threshold', - 'x_ascend_dhcp_reply' => 'X-Ascend-DHCP-Reply', - 'ascend_h323_gatekeeper' => 'Ascend-H323-Gatekeeper', - 'x_ascend_xmit_rate' => 'X-Ascend-Xmit-Rate', - 'usr_last_number_dialed_o' => 'USR-Last-Number-Dialed-Out', - 'acc_connect_rx_speed' => 'Acc-Connect-Rx-Speed', - 'acc_clearing_cause' => 'Acc-Clearing-Cause', - 'ascend_call_attempt_limi' => 'Ascend-Call-Attempt-Limit', - 'x_ascend_data_rate' => 'X-Ascend-Data-Rate', - 'termination_action' => 'Termination-Action', - 'ascend_pre_input_octets' => 'Ascend-Pre-Input-Octets', - 'x_ascend_ipx_route' => 'X-Ascend-IPX-Route', - 'x_ascend_ts_idle_mode' => 'X-Ascend-TS-Idle-Mode', - 'client_ip_address' => 'Client-IP-Address', - 'ascend_add_seconds' => 'Ascend-Add-Seconds', - 'login_ip_host' => 'Login-IP-Host', - 'annex_sw_version' => 'Annex-SW-Version', - 'huntgroup_name' => 'Huntgroup-Name', - 'usr_pw_vpn_gateway' => 'USR-PW_VPN_Gateway', - 'ascend_x25_reverse_charg' => 'Ascend-X25-Reverse-Charging', - 'lac_real_port' => 'LAC_Real_Port', - 'ascend_dba_monitor' => 'Ascend-DBA-Monitor', - 'annex_user_server_locati' => 'Annex-User-Server-Location', - 'ascend_h323_fegw_address' => 'Ascend-H323-Fegw-Address', - 'acct_output_gigawords' => 'Acct-Output-Gigawords', - 'bind_l2tp_tunnel_name' => 'Bind_L2TP_Tunnel_Name', - 'x_ascend_token_idle' => 'X-Ascend-Token-Idle', - 'acc_apsm_oversubscribed' => 'Acc-Apsm-Oversubscribed', - 'ip_tos_field' => 'IP_TOS_Field', - 'ascend_dsl_cir_xmit_limi' => 'Ascend-Dsl-CIR-Xmit-Limit', - 'usr_number_of_link_naks' => 'USR-Number-of-Link-NAKs', - 'framed_address' => 'Framed-Address', - 'x_ascend_num_in_multilin' => 'X-Ascend-Num-In-Multilink', - 'hint' => 'Hint', - 'ascend_source_ip_check' => 'Ascend-Source-IP-Check', - 'arap_zone_access' => 'ARAP-Zone-Access', - 'x_ascend_fr_direct_profi' => 'X-Ascend-FR-Direct-Profile', - 'x_ascend_bridge_address' => 'X-Ascend-Bridge-Address', - 'usr_iwf_call_identifier' => 'USR-IWF-Call-Identifier', - 'ascend_home_network_name' => 'Ascend-Home-Network-Name', - 'ascend_require_auth' => 'Ascend-Require-Auth', - 'source_validation' => 'Source_Validation', - 'ms_primary_nbns_server' => 'MS-Primary-NBNS-Server', - 'h323_setup_time' => 'h323-setup-time', - 'tunnel_remote_name' => 'Tunnel_Remote_Name', - 'ascend_maximum_channels' => 'Ascend-Maximum-Channels', - 'ascend_tunneling_protoco' => 'Ascend-Tunneling-Protocol', - 'arap_security_data' => 'ARAP-Security-Data', - 'ascend_ipx_peer_mode' => 'Ascend-IPX-Peer-Mode', - 'ascend_cir_timer' => 'Ascend-CIR-Timer', - 'ascend_ts_idle_limit' => 'Ascend-TS-Idle-Limit', - 'ascend_cache_refresh' => 'Ascend-Cache-Refresh', - 'usr_rmmie_status' => 'USR-RMMIE-Status', - 'annex_callback_portlist' => 'Annex-Callback-Portlist', - 'usr_port_tap' => 'USR-Port-Tap', - 'ascend_client_secondary_' => 'Ascend-Client-Secondary-DNS', - 'x_ascend_first_dest' => 'X-Ascend-First-Dest', - 'lac_port' => 'LAC_Port', - 'acc_callback_cbcp_type' => 'Acc-Callback-CBCP-Type', - 'usr_call_reference_numbe' => 'USR-Call-Reference-Number', - 'mcast_receive' => 'Mcast_Receive', - 'x_ascend_link_compressio' => 'X-Ascend-Link-Compression', - 'ascend_inter_arrival_jit' => 'Ascend-Inter-Arrival-Jitter', - 'x_ascend_assign_ip_pool' => 'X-Ascend-Assign-IP-Pool', - 'usr_chassis_call_span' => 'USR-Chassis-Call-Span', - 'arap_password' => 'ARAP-Password', - 'usr_ip_default_route_opt' => 'USR-IP-Default-Route-Option', - 'ascend_endpoint_disc' => 'Ascend-Endpoint-Disc', - 'tunnel_dnis' => 'Tunnel_DNIS', - 'ms_acct_auth_type' => 'MS-Acct-Auth-Type', - 'ascend_ts_idle_mode' => 'Ascend-TS-Idle-Mode', - 'shasta_service_profile' => 'Shasta-Service-Profile', - 'usr_cdma_call_reference_' => 'USR-CDMA-Call-Reference-Number', - 'usr_at_zip_input_filter' => 'USR-AT-Zip-Input-Filter', - 'x_ascend_pw_warntime' => 'X-Ascend-PW-Warntime', - 'ascend_fr_direct_dlci' => 'Ascend-FR-Direct-DLCI', - 'usr_dte_ring_no_answer_l' => 'USR-DTE-Ring-No-Answer-Limit', - 'ascend_multicast_rate_li' => 'Ascend-Multicast-Rate-Limit', - 'usr_routing_protocol' => 'USR-Routing-Protocol', - 'pam_auth' => 'Pam-Auth', - 'client_dns_sec' => 'Client_DNS_Sec', - 'bg_trans_bpdu' => 'BG_Trans_BPDU', - 'police_rate' => 'Police_Rate', - 'calling_station_id' => 'Calling-Station-Id', - 'usr_called_party_number' => 'USR-Called-Party-Number', - 'shiva_network_protocols' => 'Shiva-Network-Protocols', - 'x_ascend_client_gateway' => 'X-Ascend-Client-Gateway', - 'acct_input_octets' => 'Acct-Input-Octets', - 'ascend_call_type' => 'Ascend-Call-Type', - 'annex_product_name' => 'Annex-Product-Name', - 'framed_compression' => 'Framed-Compression', - 'ascend_atm_direct' => 'Ascend-ATM-Direct', - 'x_ascend_remote_addr' => 'X-Ascend-Remote-Addr', - 'usr_tunneled_mlpp' => 'USR-Tunneled-MLPP', - 'le_ipsec_outsource_profi' => 'LE-IPSec-Outsource-Profile', - 'ascend_atm_vci' => 'Ascend-ATM-Vci', - 'usr_number_of_link_timeo' => 'USR-Number-of-Link-Timeouts', - 'usr_et_bridge_input_filt' => 'USR-ET-Bridge-Input-Filter', - 'x_ascend_fr_t391' => 'X-Ascend-FR-T391', - 'x_ascend_fr_t392' => 'X-Ascend-FR-T392', - 'h323_conf_id' => 'h323-conf-id', - 'usr_call_end_date_time' => 'USR-Call-End-Date-Time', - 'ascend_fr_t391' => 'Ascend-FR-T391', - 'bg_aging_time' => 'BG_Aging_Time', - 'x_ascend_pre_output_pack' => 'X-Ascend-Pre-Output-Packets', - 'acc_dialout_auth_mode' => 'Acc-Dialout-Auth-Mode', - 'ascend_calling_subaddres' => 'Ascend-Calling-Subaddress', - 'ascend_fr_t392' => 'Ascend-FR-T392', - 'acct_link_count' => 'Acct-Link-Count', - 'usr_chassis_call_slot' => 'USR-Chassis-Call-Slot', - 'h323_credit_time' => 'h323-credit-time', - 'nas_port_id' => 'NAS-Port-Id', - 'x_ascend_call_filter' => 'X-Ascend-Call-Filter', - 'ascend_destination_nas_p' => 'Ascend-Destination-Nas-Port', - 'arap_features' => 'ARAP-Features', - 'x_ascend_history_weigh_t' => 'X-Ascend-History-Weigh-Type', - 'annex_host_restrict' => 'Annex-Host-Restrict', - 'usr_compression_reset_mo' => 'USR-Compression-Reset-Mode', - 'cisco_maximum_time' => 'Cisco-Maximum-Time', - 'tunnel_max_sessions' => 'Tunnel_Max_Sessions', - 'bind_ses_context' => 'Bind_Ses_Context', - 'x_ascend_ppp_vj_slot_com' => 'X-Ascend-PPP-VJ-Slot-Comp', - 'usr_mobile_numbytes_rxed' => 'USR-Mobile-NumBytes-Rxed', - 'usr_rmmie_last_update_ti' => 'USR-RMMIE-Last-Update-Time', - 'ascend_atm_loopback_cell' => 'Ascend-ATM-Loopback-Cell-Loss', - 'ascend_bir_proxy' => 'Ascend-BIR-Proxy', - 'acct_mcast_in_packets' => 'Acct_Mcast_In_Packets', - 'shiva_type_of_service' => 'Shiva-Type-Of-Service', - 'ascend_fr_dte_n392' => 'Ascend-FR-DTE-N392', - 'usr_at_call_input_filter' => 'USR-AT-Call-Input-Filter', - 'ascend_fr_dte_n393' => 'Ascend-FR-DTE-N393', - 'x_ascend_backup' => 'X-Ascend-Backup', - 'char_noecho' => 'Char-Noecho', - 'usr_rmmie_last_update_ev' => 'USR-RMMIE-Last-Update-Event', - 'le_advice_of_charge' => 'LE-Advice-of-Charge', - 'ascend_calling_id_type_o' => 'Ascend-Calling-Id-Type-Of-Num', - 'ascend_pppoe_enable' => 'Ascend-PPPoE-Enable', - 'usr_sync_async_mode' => 'USR-Sync-Async-Mode', - 'state' => 'State', - 'x_ascend_user_acct_base' => 'X-Ascend-User-Acct-Base', - 'x_ascend_ipx_alias' => 'X-Ascend-IPX-Alias', - 'ascend_ip_tos' => 'Ascend-IP-TOS', - 'annex_secondary_dns_serv' => 'Annex-Secondary-DNS-Server', - 'tunnel_session_auth_ctx' => 'Tunnel_Session_Auth_Ctx', - 'usr_mbi_ct_pri_card_span' => 'USR-Mbi_Ct_PRI_Card_Span_Line', - 'usr_call_event_code' => 'USR-Call-Event-Code', - 'chap_password' => 'CHAP-Password', - 'le_nat_tcp_session_timeo' => 'LE-NAT-TCP-Session-Timeout', - 'usr_call_start_date_time' => 'USR-Call-Start-Date-Time', - 'usr_multicast_forwarding' => 'USR-Multicast-Forwarding', - 'client_id' => 'Client-Id', - 'sql_user_name' => 'SQL-User-Name', - 'x_ascend_billing_number' => 'X-Ascend-Billing-Number', - 'ms_secondary_nbns_server' => 'MS-Secondary-NBNS-Server', - 'cisco_num_in_multilink' => 'Cisco-Num-In-Multilink', - 'x_ascend_client_assign_d' => 'X-Ascend-Client-Assign-DNS', - 'x_ascend_user_acct_port' => 'X-Ascend-User-Acct-Port', - 'usr_local_ip_address' => 'USR-Local-IP-Address', - 'x_ascend_ip_pool_definit' => 'X-Ascend-IP-Pool-Definition', - 'ascend_metric' => 'Ascend-Metric', - 'x_ascend_bacp_enable' => 'X-Ascend-BACP-Enable', - 'x_ascend_user_acct_time' => 'X-Ascend-User-Acct-Time', - 'x_ascend_mpp_idle_percen' => 'X-Ascend-MPP-Idle-Percent', - 'annex_authen_servers' => 'Annex-Authen-Servers', - 'x_ascend_data_filter' => 'X-Ascend-Data-Filter', - 'ascend_idle_limit' => 'Ascend-Idle-Limit', - 'ldap_userdn' => 'Ldap-UserDn', - 'x_ascend_target_util' => 'X-Ascend-Target-Util', - 'shiva_connect_reason' => 'Shiva-Connect-Reason', - 'usr_ds0' => 'USR-DS0', - 'annex_re_chap_timeout' => 'Annex-Re-CHAP-Timeout', - 'shasta_vpn_name' => 'Shasta-VPN-Name', - 'acct_tunnel_connection_i' => 'Acct-Tunnel-Connection-Id', - 'h323_prompt_id' => 'h323-prompt-id', - 'x_ascend_ipx_peer_mode' => 'X-Ascend-IPX-Peer-Mode', - 'ascend_numbering_plan_id' => 'Ascend-Numbering-Plan-ID', - 'x_ascend_ts_idle_limit' => 'X-Ascend-TS-Idle-Limit', - 'ascend_atm_fault_managem' => 'Ascend-ATM-Fault-Management', - 'annex_primary_nbns_serve' => 'Annex-Primary-NBNS-Server', - 'lac_port_type' => 'LAC_Port_Type', - 'usr_initial_rx_link_data' => 'USR-Initial-Rx-Link-Data-Rate', - 'usr_interface_index' => 'USR-Interface-Index', - 'usr_expansion_algorithm' => 'USR-Expansion-Algorithm', - 'ascend_tunnel_vrouter_na' => 'Ascend-Tunnel-VRouter-Name', - 'usr_pw_vpn_neighbor' => 'USR-PW_VPN_Neighbor', - 'bind_type' => 'Bind_Type', - 'acc_ccp_option' => 'Acc-Ccp-Option', - 'ascend_route_appletalk' => 'Ascend-Route-Appletalk', - 'erx_alternate_cli_access' => 'ERX-Alternate-Cli-Access-Level', - 'usr_at_rtmp_output_filte' => 'USR-AT-RTMP-Output-Filter', - 'erx_atm_mbs' => 'ERX-Atm-MBS', - 'usr_at_call_output_filte' => 'USR-AT-Call-Output-Filter', - 'ms_old_arap_password' => 'MS-Old-ARAP-Password', - 'x_ascend_client_primary_' => 'X-Ascend-Client-Primary-DNS', - 'x_ascend_host_info' => 'X-Ascend-Host-Info', - 'bind_auth_protocol' => 'Bind_Auth_Protocol', - 'cisco_link_compression' => 'Cisco-Link-Compression', - 'annex_syslog_tap' => 'Annex-Syslog-Tap', - 'tunnel_window' => 'Tunnel_Window', - 'usr_gateway_ip_address' => 'USR-Gateway-IP-Address', - 'ascend_redirect_number' => 'Ascend-Redirect-Number', - 'x_ascend_secondary_home_' => 'X-Ascend-Secondary-Home-Agent', - 'usr_pw_index' => 'USR-PW_Index', - 'le_multicast_client' => 'LE-Multicast-Client', - 'annex_modem_disc_reason' => 'Annex-Modem-Disc-Reason', - 'annex_primary_dns_server' => 'Annex-Primary-DNS-Server', - 'erx_secondary_wins' => 'ERX-Secondary-Wins', - 'fall_through' => 'Fall-Through', - 'acct_mcast_out_packets' => 'Acct_Mcast_Out_Packets', - 'x_ascend_transit_number' => 'X-Ascend-Transit-Number', - 'usr_unauthenticated_time' => 'USR-Unauthenticated-Time', - 'le_ipsec_active_profile' => 'LE-IPSec-Active-Profile', - 'ascend_ip_pool_chaining' => 'Ascend-IP-Pool-Chaining', - 'usr_syslog_tap' => 'USR-Syslog-Tap', - 'ascend_multicast_client' => 'Ascend-Multicast-Client', - 'usr_device_connected_to' => 'USR-Device-Connected-To', - 'tunnel_l2f_second_passwo' => 'Tunnel_L2F_Second_Password', - 'add_prefix' => 'Add-Prefix', - 'tunnel_cmd_timeout' => 'Tunnel_Cmd_Timeout', - 'x_ascend_remove_seconds' => 'X-Ascend-Remove-Seconds', - 'acct_mcast_in_octets' => 'Acct_Mcast_In_Octets', - 'ascend_appletalk_route' => 'Ascend-Appletalk-Route', - 'ascend_fcp_parameter' => 'Ascend-FCP-Parameter', - 'acc_ip_compression' => 'Acc-Ip-Compression', - 'usr_modem_training_time' => 'USR-Modem-Training-Time', - 'usr_primary_dns_server' => 'USR-Primary_DNS_Server', - 'erx_egress_policy_name' => 'ERX-Egress-Policy-Name', - 'x_ascend_base_channel_co' => 'X-Ascend-Base-Channel-Count', - 'x_ascend_pre_input_packe' => 'X-Ascend-Pre-Input-Packets', - 'password_retry' => 'Password-Retry', - 'ascend_source_auth' => 'Ascend-Source-Auth', - 'cisco_pw_lifetime' => 'Cisco-PW-Lifetime', - 'acc_dns_server_pri' => 'Acc-Dns-Server-Pri', - 'ascend_netware_timeout' => 'Ascend-Netware-timeout', - 'ascend_ppp_async_map' => 'Ascend-PPP-Async-Map', - 'usr_rad_multicast_routin' => 'USR-Rad-Multicast-Routing-Ttl', - 'x_ascend_modem_slotno' => 'X-Ascend-Modem-SlotNo', - 'x_ascend_ip_direct' => 'X-Ascend-IP-Direct', - 'simultaneous_use' => 'Simultaneous-Use', - 'erx_virtual_router_name' => 'ERX-Virtual-Router-Name', - 'ascend_bridge_non_pppoe' => 'Ascend-Bridge-Non-PPPoE', - 'ascend_fr_08_mode' => 'Ascend-FR-08-Mode', - 'h323_call_type' => 'h323-call-type', - 'tunnel_context' => 'Tunnel_Context', - 'usr_transmit_acc_map' => 'USR-Transmit-Acc-Map', - 'usr_ipx_wan' => 'USR-IPX-WAN', - 'usr_ip_call_input_filter' => 'USR-IP-Call-Input-Filter', - 'usr_call_connect_in_gmt' => 'USR-Call-Connect-in-GMT', - 'acct_multi_session_id' => 'Acct-Multi-Session-Id', - 'usr_reply_script1' => 'USR-Reply-Script1', - 'cisco_ppp_vj_slot_comp' => 'Cisco-PPP-VJ-Slot-Comp', - 'usr_reply_script2' => 'USR-Reply-Script2', - 'usr_reply_script3' => 'USR-Reply-Script3', - 'usr_reply_script4' => 'USR-Reply-Script4', - 'usr_reply_script5' => 'USR-Reply-Script5', - 'usr_reply_script6' => 'USR-Reply-Script6', - 'user_category' => 'User-Category', - 'mcast_send' => 'Mcast_Send', - 'ascend_send_secret' => 'Ascend-Send-Secret', - 'usr_tunnel_switch_endpoi' => 'USR-Tunnel-Switch-Endpoint', - 'tunnel_retransmit' => 'Tunnel_Retransmit', - 'add_port_to_ip_address' => 'Add-Port-To-IP-Address', - 'ascend_ipx_node_addr' => 'Ascend-IPX-Node-Addr', - 'x_ascend_netware_timeout' => 'X-Ascend-Netware-timeout', - 'erx_sa_validate' => 'ERX-Sa-Validate', - 'le_ipsec_passive_profile' => 'LE-IPSec-Passive-Profile', - 'usr_chassis_slot' => 'USR-Chassis-Slot', - 'usr_final_tx_link_data_r' => 'USR-Final-Tx-Link-Data-Rate', - 'usr_nfas_id' => 'USR-NFAS-ID', - 'called_station_id' => 'Called-Station-Id', - 'login_lat_port' => 'Login-LAT-Port', - 'ascend_dialed_number' => 'Ascend-Dialed-Number', - 'h323_credit_amount' => 'h323-credit-amount', - 'tunnel_local_name' => 'Tunnel_Local_Name', - 'framed_ip_netmask' => 'Framed-IP-Netmask', - 'client_port_id' => 'Client-Port-Id', - 'bg_span_dis' => 'BG_Span_Dis', - 'multi_link_flag' => 'Multi-Link-Flag', - 'bind_sub_user_at_context' => 'Bind_Sub_User_At_Context', - 'usr_ipx_routing' => 'USR-IPX-Routing', - 'ascend_fr_nailed_grp' => 'Ascend-FR-Nailed-Grp', - 'ascend_pre_output_octets' => 'Ascend-Pre-Output-Octets', - 'pppoe_url' => 'PPPOE_URL', - 'ascend_ara_pw' => 'Ascend-Ara-PW', - 'acc_callback_mode' => 'Acc-Callback-Mode', - 'usr_server_time' => 'USR-Server-Time', - 'ascend_seconds_of_histor' => 'Ascend-Seconds-Of-History', - 'ns_mta_md5_password' => 'NS-MTA-MD5-Password', - 'tunnel_server_endpoint' => 'Tunnel-Server-Endpoint', - 'usr_channel' => 'USR-Channel', - 'ascend_dsl_cir_recv_limi' => 'Ascend-Dsl-CIR-Recv-Limit', - 'acct_session_start_time' => 'Acct-Session-Start-Time', - 'ascend_send_passwd' => 'Ascend-Send-Passwd', - 'ascend_num_in_multilink' => 'Ascend-Num-In-Multilink', - 'usr_ip_rip_policies' => 'USR-IP-RIP-Policies', - 'vendor_specific' => 'Vendor-Specific', - 'x_ascend_event_type' => 'X-Ascend-Event-Type', - 'lac_real_port_type' => 'LAC_Real_Port_Type', - 'x_ascend_modem_portno' => 'X-Ascend-Modem-PortNo', - 'usr_originate_answer_mod' => 'USR-Originate-Answer-Mode', - 'framed_ipx_network' => 'Framed-IPX-Network', - 'ascend_modem_slotno' => 'Ascend-Modem-SlotNo', - 'ms_mppe_encryption_type' => 'MS-MPPE-Encryption-Type', - 'annex_cli_command' => 'Annex-CLI-Command', - 'acct_status_type' => 'Acct-Status-Type', - 'usr_et_bridge_call_outpu' => 'USR-ET-Bridge-Call-Output-Filte', - 'usr_pw_vpn_id' => 'USR-PW_VPN_ID', - 'usr_sap_filter_in' => 'USR-SAP-Filter-In', - 'usr_rad_multicast_routin' => 'USR-Rad-Multicast-Routing-Proto', - 'annex_audit_level' => 'Annex-Audit-Level', - 'x_ascend_shared_profile_' => 'X-Ascend-Shared-Profile-Enable', - 'ascend_dial_number' => 'Ascend-Dial-Number', - 'ascend_link_compression' => 'Ascend-Link-Compression', - 'usr_event_date_time' => 'USR-Event-Date-Time', - 'usr_mp_edo_hiper' => 'USR-MP-EDO-HIPER', - 'usr_re_chap_timeout' => 'USR-Re-Chap-Timeout', - 'x_ascend_third_prompt' => 'X-Ascend-Third-Prompt', - 'x_ascend_ppp_vj_1172' => 'X-Ascend-PPP-VJ-1172', - 'annex_disconnect_reason' => 'Annex-Disconnect-Reason', - 'ascend_fr_svc_addr' => 'Ascend-FR-SVC-Addr', - 'nas_real_port' => 'NAS_Real_Port', - 'usr_power_supply_number' => 'USR-Power-Supply-Number', - 'ms_secondary_dns_server' => 'MS-Secondary-DNS-Server', - 'ascend_port_redir_server' => 'Ascend-Port-Redir-Server', - 'ascend_x25_pad_alias_1' => 'Ascend-X25-Pad-Alias-1', - 'x_ascend_fcp_parameter' => 'X-Ascend-FCP-Parameter', - 'ascend_x25_pad_alias_2' => 'Ascend-X25-Pad-Alias-2', - 'ascend_ipsec_profile' => 'Ascend-IPSEC-Profile', - 'ascend_x25_pad_alias_3' => 'Ascend-X25-Pad-Alias-3', - 'usr_mobile_numbytes_txed' => 'USR-Mobile-NumBytes-Txed', - 'ascend_atm_vpi' => 'Ascend-ATM-Vpi', - 'annex_input_filter' => 'Annex-Input-Filter', - 'menu' => 'Menu', - 'x_ascend_route_ip' => 'X-Ascend-Route-IP', - 'usr_rmmie_num_of_updates' => 'USR-RMMIE-Num-Of-Updates', - 'acc_request_type' => 'Acc-Request-Type', - 'ascend_dhcp_reply' => 'Ascend-DHCP-Reply', - 'usr_number_of_upshifts' => 'USR-Number-of-Upshifts', - 'usr_rmmie_firmware_versi' => 'USR-RMMIE-Firmware-Version', - 'bind_bypass_context' => 'Bind_Bypass_Context', - 'ascend_dialout_allowed' => 'Ascend-Dialout-Allowed', - 'annex_tunnel_authen_type' => 'Annex-Tunnel-Authen-Type', - 'x_ascend_bridge' => 'X-Ascend-Bridge', - 'ascend_client_secondary_' => 'Ascend-Client-Secondary-WINS', - 'erx_local_loopback_inter' => 'ERX-Local-Loopback-Interface', - 'acct_input_gigawords' => 'Acct-Input-Gigawords', - 'usr_equalization_type' => 'USR-Equalization-Type', - 'usr_port_tap_format' => 'USR-Port-Tap-Format', - 'x_ascend_ppp_async_map' => 'X-Ascend-PPP-Async-Map', - 'acc_ipx_compression' => 'Acc-Ipx-Compression', - 'ascend_nas_port_format' => 'Ascend-NAS-Port-Format', - 'acc_modem_modulation_typ' => 'Acc-Modem-Modulation-Type', - 'ascend_modem_portno' => 'Ascend-Modem-PortNo', - 'usr_et_bridge_output_fil' => 'USR-ET-Bridge-Output-Filter', - 'ascend_ipx_header_compre' => 'Ascend-IPX-Header-Compression', - 'framed_appletalk_link' => 'Framed-AppleTalk-Link', - 'x_ascend_receive_secret' => 'X-Ascend-Receive-Secret', - 'ascend_route_ipx' => 'Ascend-Route-IPX', - 'ascend_user_acct_type' => 'Ascend-User-Acct-Type', - 'ascend_token_idle' => 'Ascend-Token-Idle', - 'framed_ip_address' => 'Framed-IP-Address', - 'ascend_call_block_durati' => 'Ascend-Call-Block-Duration', - 'ascend_ppp_address' => 'Ascend-PPP-Address', - 'usr_mbi_ct_pri_card_slot' => 'USR-Mbi_Ct_PRI_Card_Slot', - 'x_ascend_dec_channel_cou' => 'X-Ascend-Dec-Channel-Count', - 'x_ascend_send_auth' => 'X-Ascend-Send-Auth', - 'usr_characters_received' => 'USR-Characters-Received', - 'usr_pw_tunnel_authentica' => 'USR-PW_Tunnel_Authentication', - 'usr_call_end_time' => 'USR-Call-End-Time', - 'x_ascend_dialout_allowed' => 'X-Ascend-Dialout-Allowed', - 'x_ascend_call_attempt_li' => 'X-Ascend-Call-Attempt-Limit', - 'initial_modulation_type' => 'Initial-Modulation-Type', - 'usr_packet_bus_session' => 'USR-Packet-Bus-Session', - 'x_ascend_ipx_node_addr' => 'X-Ascend-IPX-Node-Addr', - 'ascend_ppp_vj_slot_comp' => 'Ascend-PPP-VJ-Slot-Comp', - 'ascend_menu_item' => 'Ascend-Menu-Item', - 'x_ascend_fr_link_mgt' => 'X-Ascend-FR-Link-Mgt', - 'usr_rmmie_serial_number' => 'USR-RMMIE-Serial-Number', - 'message_authenticator' => 'Message-Authenticator', - 'usr_dte_data_idle_timout' => 'USR-DTE-Data-Idle-Timout', - 'usr_port_tap_facility' => 'USR-Port-Tap-Facility', - 'acc_ml_mlx_admin_state' => 'Acc-ML-MLX-Admin-State', - 'usr_modem_group' => 'USR-Modem-Group', - 'x_ascend_callback' => 'X-Ascend-Callback', - 'acct_input_packets_64' => 'Acct_Input_Packets_64', - 'ascend_third_prompt' => 'Ascend-Third-Prompt', - 'configuration_token' => 'Configuration-Token', - 'x_ascend_fr_nailed_grp' => 'X-Ascend-FR-Nailed-Grp', - 'acct_output_octets_64' => 'Acct_Output_Octets_64', - 'h323_time_and_day' => 'h323-time-and-day', - 'ascend_port_redir_portnu' => 'Ascend-Port-Redir-Portnum', - 'acct_interim_interval' => 'Acct-Interim-Interval', - 'ascend_uu_info' => 'Ascend-UU-Info', - 'usr_pw_vpn_name' => 'USR-PW_VPN_Name', - 'ascend_maximum_call_dura' => 'Ascend-Maximum-Call-Duration', - 'ascend_atm_direct_profil' => 'Ascend-ATM-Direct-Profile', - 'acc_input_errors' => 'Acc-Input-Errors', - 'bind_dot1q_port' => 'Bind_Dot1q_Port', - 'ascend_first_dest' => 'Ascend-First-Dest', - 'x_ascend_if_netmask' => 'X-Ascend-IF-Netmask', - 'tunnel_session_auth_serv' => 'Tunnel_Session_Auth_Service_Grp', - 'annex_local_ip_address' => 'Annex-Local-IP-Address', - 'termination_menu' => 'Termination-Menu', - 'ms_chap2_cpw' => 'MS-CHAP2-CPW', - 'ascend_mpp_idle_percent' => 'Ascend-MPP-Idle-Percent', - 'usr_characters_sent' => 'USR-Characters-Sent', - 'eap_message' => 'EAP-Message', - 'acct_delay_time' => 'Acct-Delay-Time', - 'ascend_remote_fw' => 'Ascend-Remote-FW', - 'x_ascend_tunneling_proto' => 'X-Ascend-Tunneling-Protocol', - 'shiva_session_id' => 'Shiva-Session-Id', - 'usr_igmp_query_interval' => 'USR-IGMP-Query-Interval', - 'usr_accm_type' => 'USR-ACCM-Type', - 'usr_call_terminate_in_gm' => 'USR-Call-Terminate-in-GMT', - 'usr_rad_location_type' => 'USR-Rad-Location-Type', - 'ascend_filter' => 'Ascend-Filter', - 'ascend_primary_home_agen' => 'Ascend-Primary-Home-Agent', - 'x_ascend_user_acct_host' => 'X-Ascend-User-Acct-Host', - 'chap_challenge' => 'CHAP-Challenge', - 'acct_output_packets_64' => 'Acct_Output_Packets_64', - 'bind_auth_max_sessions' => 'Bind_Auth_Max_Sessions', - 'cisco_pre_output_octets' => 'Cisco-Pre-Output-Octets', - 'x_ascend_fr_direct' => 'X-Ascend-FR-Direct', - 'x_ascend_client_secondar' => 'X-Ascend-Client-Secondary-DNS', - 'usr_rmmie_pwrlvl_nearech' => 'USR-RMMIE-PwrLvl-NearEcho-Canc', - 'ascend_bridge_address' => 'Ascend-Bridge-Address', - 'user_name' => 'User-Name', - 'usr_rmmie_firmware_build' => 'USR-RMMIE-Firmware-Build-Date', - 'ms_chap_mppe_keys' => 'MS-CHAP-MPPE-Keys', - 'usr_number_of_characters' => 'USR-Number-Of-Characters-Lost', - 'usr_physical_state' => 'USR-Physical-State', - 'x_ascend_assign_ip_serve' => 'X-Ascend-Assign-IP-Server', - 'bind_int_context' => 'Bind_Int_Context', - 'erx_tunnel_virtual_route' => 'ERX-Tunnel-Virtual-Router', - 'ascend_xmit_rate' => 'Ascend-Xmit-Rate', - 'usr_secondary_dns_server' => 'USR-Secondary_DNS_Server', - 'ascend_dsl_rate_mode' => 'Ascend-Dsl-Rate-Mode', - 'ascend_data_rate' => 'Ascend-Data-Rate', - 'realm' => 'Realm', - 'usr_ipx_call_input_filte' => 'USR-IPX-Call-Input-Filter', - 'ascend_ipx_route' => 'Ascend-IPX-Route', - 'usr_failure_to_connect_r' => 'USR-Failure-to-Connect-Reason', - 'x_ascend_home_network_na' => 'X-Ascend-Home-Network-Name', - 'acc_nbns_server_pri' => 'Acc-Nbns-Server-Pri', - 'usr_modulation_type' => 'USR-Modulation-Type', - 'service_type' => 'Service-Type', - 'ascend_callback_delay' => 'Ascend-Callback-Delay', - 'ascend_owner_ip_addr' => 'Ascend-Owner-IP-Addr', - 'x_ascend_handle_ipx' => 'X-Ascend-Handle-IPX', - 'usr_connect_term_reason' => 'USR-Connect-Term-Reason', - 'x_ascend_multicast_rate_' => 'X-Ascend-Multicast-Rate-Limit', - 'h323_disconnect_time' => 'h323-disconnect-time', - 'acc_ip_gateway_sec' => 'Acc-Ip-Gateway-Sec', - 'usr_number_of_blers' => 'USR-Number-of-Blers', - 'x_ascend_fr_type' => 'X-Ascend-FR-Type', - 'ascend_assign_ip_pool' => 'Ascend-Assign-IP-Pool', - 'ascend_qos_upstream' => 'Ascend-QOS-Upstream', - 'usr_nas_type' => 'USR-NAS-Type', - 'acc_dial_port_index' => 'Acc-Dial-Port-Index', - 'usr_initial_tx_link_data' => 'USR-Initial-Tx-Link-Data-Rate', - 'ascend_fr_type' => 'Ascend-FR-Type', - 'usr_mbi_ct_tdm_time_slot' => 'USR-Mbi_Ct_TDM_Time_Slot', - 'usr_rmmie_pwrlvl_xmit_lv' => 'USR-RMMIE-PwrLvl-Xmit-Lvl', - 'erx_atm_service_category' => 'ERX-Atm-Service-Category', - 'usr_appletalk' => 'USR-Appletalk', - 'usr_send_script1' => 'USR-Send-Script1', - 'usr_send_script2' => 'USR-Send-Script2', - 'usr_send_script3' => 'USR-Send-Script3', - 'usr_ospf_addressless_ind' => 'USR-OSPF-Addressless-Index', - 'acct_input_packets' => 'Acct-Input-Packets', - 'usr_send_script4' => 'USR-Send-Script4', - 'usr_send_script5' => 'USR-Send-Script5', - 'usr_send_script6' => 'USR-Send-Script6', - 'usr_service_option' => 'USR-Service-Option', - 'ascend_dropped_octets' => 'Ascend-Dropped-Octets', - 'usr_ip' => 'USR-IP', - 'usr_tunnel_security' => 'USR-Tunnel-Security', - 'acc_acct_on_off_reason' => 'Acc-Acct-On-Off-Reason', - 'shiva_compression_type' => 'Shiva-Compression-Type', - 'ascend_pw_warntime' => 'Ascend-PW-Warntime', - 'usr_security_resp_limit' => 'USR-Security-Resp-Limit', - 'ascend_x25_pad_prompt' => 'Ascend-X25-Pad-Prompt', - 'cisco_asing_ip_pool' => 'Cisco-Asing-IP-Pool', - 'acc_route_policy' => 'Acc-Route-Policy', - 'annex_local_username' => 'Annex-Local-Username', - 'x_ascend_call_by_call' => 'X-Ascend-Call-By-Call', - 'ascend_calling_id_screen' => 'Ascend-Calling-Id-Screening', - 'x_ascend_dhcp_pool_numbe' => 'X-Ascend-DHCP-Pool-Number', - 'nas_port_type' => 'NAS-Port-Type', - 'ascend_route_ip' => 'Ascend-Route-IP', - 'ascend_client_gateway' => 'Ascend-Client-Gateway', - 'ascend_qos_downstream' => 'Ascend-QOS-Downstream', - 'ms_bap_usage' => 'MS-BAP-Usage', - 'usr_vts_session_key' => 'USR-VTS-Session-Key', - 'usr_receive_acc_map' => 'USR-Receive-Acc-Map', - 'ascend_expect_callback' => 'Ascend-Expect-Callback', - 'password' => 'Password', - 'packet_type' => 'Packet-Type', - 'ascend_remote_addr' => 'Ascend-Remote-Addr', - 'ascend_recv_name' => 'Ascend-Recv-Name', - 'ms_acct_eap_type' => 'MS-Acct-EAP-Type', - 'usr_filter_zones' => 'USR-Filter-Zones', - 'annex_output_filter' => 'Annex-Output-Filter', - 'usr_rmmie_rcv_tot_pwrlvl' => 'USR-RMMIE-Rcv-Tot-PwrLvl', - 'usr_mp_mrru' => 'USR-MP-MRRU', - 'ascend_call_filter' => 'Ascend-Call-Filter', - 'usr_keypress_timeout' => 'USR-Keypress-Timeout', - 'usr_modem_setup_time' => 'USR-Modem-Setup-Time', - 'acct_authentic' => 'Acct-Authentic', - 'pppoe_motm' => 'PPPOE_MOTM', - 'x_ascend_expect_callback' => 'X-Ascend-Expect-Callback', - 'erx_atm_scr' => 'ERX-Atm-SCR', - 'erx_address_pool_name' => 'ERX-Address-Pool-Name', - 'challenge_state' => 'Challenge-State', - 'usr_multicast_proxy' => 'USR-Multicast-Proxy', - 'framed_filter_id' => 'Framed-Filter-Id', - 'add_suffix' => 'Add-Suffix', - 'ascend_auth_type' => 'Ascend-Auth-Type', - 'session_timeout' => 'Session-Timeout', - 'ascend_callback' => 'Ascend-Callback', - 'usr_chat_script_name' => 'USR-Chat-Script-Name', - 'port_message' => 'Port-Message', - 'acct_output_packets' => 'Acct-Output-Packets', - 'ascend_session_svr_key' => 'Ascend-Session-Svr-Key', - 'login_tcp_port' => 'Login-TCP-Port', - 'erx_tunnel_password' => 'ERX-Tunnel-Password', - 'shasta_user_privilege' => 'Shasta-User-Privilege', - 'usr_secondary_nbns_serve' => 'USR-Secondary_NBNS_Server', - 'usr_security_login_limit' => 'USR-Security-Login-Limit', - 'usr_start_time' => 'USR-Start-Time', - 'acc_access_partition' => 'Acc-Access-Partition', - 'versanet_termination_cau' => 'Versanet-Termination-Cause', - 'x_ascend_call_block_dura' => 'X-Ascend-Call-Block-Duration', - 'mcast_maxgroups' => 'Mcast_MaxGroups', - 'ascend_user_acct_base' => 'Ascend-User-Acct-Base', - 'usr_vpn_gw_location_id' => 'USR-VPN-GW-Location-Id', - 'usr_block_error_count_li' => 'USR-Block-Error-Count-Limit', - 'ascend_telnet_profile' => 'Ascend-Telnet-Profile', - 'ascend_port_redir_protoc' => 'Ascend-Port-Redir-Protocol', - 'ascend_call_by_call' => 'Ascend-Call-By-Call', - 'usr_disconnect_cause_ind' => 'USR-Disconnect-Cause-Indicator', - 'x_ascend_fr_linkup' => 'X-Ascend-FR-LinkUp', - 'ascend_billing_number' => 'Ascend-Billing-Number', - 'usr_ds0s' => 'USR-DS0s', - 'usr_at_zip_output_filter' => 'USR-AT-Zip-Output-Filter', - 'ascend_user_acct_port' => 'Ascend-User-Acct-Port', - 'login_port' => 'Login-Port', - 'arap_security' => 'ARAP-Security', - 'tunnel_deadtime' => 'Tunnel_Deadtime', - 'ascend_user_acct_time' => 'Ascend-User-Acct-Time', - 'ms_chap_challenge' => 'MS-CHAP-Challenge', - 'ascend_x25_rpoa' => 'Ascend-X25-Rpoa', - 'login_time' => 'Login-Time', - 'current_time' => 'Current-Time', - 'login_service' => 'Login-Service', - 'ascend_menu_selector' => 'Ascend-Menu-Selector', - 'ascend_bacp_enable' => 'Ascend-BACP-Enable', - 'shiva_link_speed' => 'Shiva-Link-Speed', - 'ascend_private_route_tab' => 'Ascend-Private-Route-Table-ID', - 'x_ascend_session_svr_key' => 'X-Ascend-Session-Svr-Key', - 'ascend_data_filter' => 'Ascend-Data-Filter', - 'ascend_target_util' => 'Ascend-Target-Util', - 'shiva_function' => 'Shiva-Function', - 'usr_pw_usr_ifilter_ip' => 'USR-PW_USR_IFilter_IP', - 'usr_igmp_routing' => 'USR-IGMP-Routing', - 'acc_tunnel_port' => 'Acc-Tunnel-Port', - 'x_ascend_fr_n391' => 'X-Ascend-FR-N391', - 'medium_type' => 'Medium_Type', - 'annex_domain_name' => 'Annex-Domain-Name', - 'ascend_fr_n391' => 'Ascend-FR-N391', - 'callback_number' => 'Callback-Number', - 'usr_chassis_temperature' => 'USR-Chassis-Temperature', - 'dialback_no' => 'Dialback-No', - 'ms_mppe_recv_key' => 'MS-MPPE-Recv-Key', - 'ascend_ipx_alias' => 'Ascend-IPX-Alias', - 'le_nat_inmap' => 'LE-NAT-Inmap', - 'tunnel_police_rate' => 'Tunnel_Police_Rate', - 'acct_terminate_cause' => 'Acct-Terminate-Cause', - 'le_nat_other_session_tim' => 'LE-NAT-Other-Session-Timeout', - 'usr_ip_rip_output_filter' => 'USR-IP-RIP-Output-Filter', - 'exec_program' => 'Exec-Program', - 'h323_disconnect_cause' => 'h323-disconnect-cause', - 'usr_chassis_call_channel' => 'USR-Chassis-Call-Channel', - 'x_ascend_fr_dlci' => 'X-Ascend-FR-DLCI', - 'ms_link_drop_time_limit' => 'MS-Link-Drop-Time-Limit', - 'acc_callback_num_valid' => 'Acc-Callback-Num-Valid', - 'cisco_presession_time' => 'Cisco-PreSession-Time', - 'ms_chap_response' => 'MS-CHAP-Response', - 'usr_spoofing' => 'USR-Spoofing', - 'usr_num_fax_pages_proces' => 'USR-Num-Fax-Pages-Processed', - 'ascend_x25_cug' => 'Ascend-X25-Cug', - 'ascend_fr_dlci' => 'Ascend-FR-DLCI', - 'shiva_user_attributes' => 'Shiva-User-Attributes', - 'ms_chap_lm_enc_pw' => 'MS-CHAP-LM-Enc-PW', - 'ascend_transit_number' => 'Ascend-Transit-Number', - 'usr_last_number_dialed_i' => 'USR-Last-Number-Dialed-In-DNIS', - 'usr_ip_saa_filter' => 'USR-IP-SAA-Filter', - 'usr_pw_usr_ifilter_ipx' => 'USR-PW_USR_IFilter_IPX', - 'ascend_remove_seconds' => 'Ascend-Remove-Seconds', - 'le_connect_detail' => 'LE-Connect-Detail', - 'ascend_assign_ip_global_' => 'Ascend-Assign-IP-Global-Pool', - 'proxy_to_realm' => 'Proxy-To-Realm', - 'usr_retrains_requested' => 'USR-Retrains-Requested', - 'h323_remote_address' => 'h323-remote-address', - 'ascend_x25_nui_prompt' => 'Ascend-X25-Nui-Prompt', - 'acc_customer_id' => 'Acc-Customer-Id', - 'ms_chap2_response' => 'MS-CHAP2-Response', - 'ascend_host_info' => 'Ascend-Host-Info', - 'annex_addr_resolution_se' => 'Annex-Addr-Resolution-Servers', - 'x_ascend_multilink_id' => 'X-Ascend-Multilink-ID', - 'login_lat_service' => 'Login-LAT-Service', - 'usr_rmmie_rcv_pwrlvl_330' => 'USR-RMMIE-Rcv-PwrLvl-3300Hz', - 'ascend_event_type' => 'Ascend-Event-Type', - 'ascend_inc_channel_count' => 'Ascend-Inc-Channel-Count', - 'cisco_ppp_async_map' => 'Cisco-PPP-Async-Map', - 'usr_min_compression_size' => 'USR-Min-Compression-Size', - 'ascend_traffic_shaper' => 'Ascend-Traffic-Shaper', - 'ascend_user_acct_key' => 'Ascend-User-Acct-Key', - 'usr_port_tap_output' => 'USR-Port-Tap-Output', - 'ascend_x25_nui' => 'Ascend-X25-Nui', - 'x_ascend_disconnect_caus' => 'X-Ascend-Disconnect-Cause', - 'ascend_cbcp_enable' => 'Ascend-CBCP-Enable', - 'usr_framed_ip_address_po' => 'USR-Framed_IP_Address_Pool_Name', - 'ascend_x25_profile_name' => 'Ascend-X25-Profile-Name', - 'usr_orig_nas_type' => 'USR-Orig-NAS-Type', - 'acc_output_errors' => 'Acc-Output-Errors', - 'h323_redirect_ip_address' => 'h323-redirect-ip-address', - 'usr_ip_call_output_filte' => 'USR-IP-Call-Output-Filter', - 'cisco_avpair' => 'Cisco-AVPair', - 'usr_slot_connected_to' => 'USR-Slot-Connected-To', - 'framed_route' => 'Framed-Route', - 'ascend_global_call_id' => 'Ascend-Global-Call-Id', - 'x_ascend_seconds_of_hist' => 'X-Ascend-Seconds-Of-History', - 'x_ascend_temporary_rtes' => 'X-Ascend-Temporary-Rtes', - 'h323_currency_type' => 'h323-currency-type', - 'x_ascend_token_expiry' => 'X-Ascend-Token-Expiry', - 'pvc_encapsulation_type' => 'PVC_Encapsulation_Type', - 'x_ascend_pw_lifetime' => 'X-Ascend-PW-Lifetime', - 'usr_expected_voltage' => 'USR-Expected-Voltage', - 'usr_simplified_v42bis_us' => 'USR-Simplified-V42bis-Usage', - 'shiva_customer_id' => 'Shiva-Customer-Id', - 'usr_compression_algorith' => 'USR-Compression-Algorithm', - 'annex_system_disc_reason' => 'Annex-System-Disc-Reason', - 'annex_secondary_nbns_ser' => 'Annex-Secondary-NBNS-Server', - 'usr_q931_call_reference_' => 'USR-Q931-Call-Reference-Value', - 'usr_send_password' => 'USR-Send-Password', - 'prompt' => 'Prompt', - 'usr_cusr_hat_script_rule' => 'USR-CUSR-hat-Script-Rules', - 'usr_event_id' => 'USR-Event-Id', - 'usr_ccp_algorithm' => 'USR-CCP-Algorithm', - 'usr_mbi_ct_bchannel_used' => 'USR-Mbi_Ct_BChannel_Used', - 'ascend_svc_enabled' => 'Ascend-SVC-Enabled', - 'framed_mtu' => 'Framed-MTU', - 'acc_reason_code' => 'Acc-Reason-Code', - 'bind_l2tp_flow_control' => 'Bind_L2TP_Flow_Control', - 'ascend_cbcp_delay' => 'Ascend-CBCP-Delay', - 'le_ipsec_deny_action' => 'LE-IPSec-Deny-Action', - - #NOMENT - 'nomadix_bw_down' => 'Nomadix-Bw-Down', - 'nomadix_bw_up' => 'Nomadix-Bw-Up', - 'nomadix_ip_upsell' => 'Nomadix-IP-Upsell', -); - -1; diff --git a/FS/FS/radius_usergroup.pm b/FS/FS/radius_usergroup.pm deleted file mode 100644 index 647621d28..000000000 --- a/FS/FS/radius_usergroup.pm +++ /dev/null @@ -1,130 +0,0 @@ -package FS::radius_usergroup; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); -use FS::svc_acct; - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::radius_usergroup - Object methods for radius_usergroup records - -=head1 SYNOPSIS - - use FS::radius_usergroup; - - $record = new FS::radius_usergroup \%hash; - $record = new FS::radius_usergroup { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::radius_usergroup object links an account (see L) with a -RADIUS group. FS::radius_usergroup inherits from FS::Record. The following -fields are currently supported: - -=over 4 - -=item usergroupnum - primary key - -=item svcnum - Account (see L). - -=item groupname - group name - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new record. To add the record to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'radius_usergroup'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=cut - -#inherited from FS::Record - -=item delete - -Delete this record from the database. - -=cut - -#inherited from FS::Record - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -#inherited from FS::Record - -=item check - -Checks all fields to make sure this is a valid record. If there is -an error, returns the error, otherwise returns false. Called by the insert -and replace methods. - -=cut - -sub check { - my $self = shift; - - $self->ut_numbern('usergroupnum') - || $self->ut_number('svcnum') - || $self->ut_foreign_key('svcnum','svc_acct','svcnum') - || $self->ut_text('groupname') - ; -} - -=item svc_acct - -Returns the account associated with this record (see L). - -=cut - -sub svc_acct { - my $self = shift; - qsearchs('svc_acct', { svcnum => $self->svcnum } ); -} - -=back - -=head1 BUGS - -Don't let 'em get you down. - -=head1 SEE ALSO - -L, L, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/session.pm b/FS/FS/session.pm deleted file mode 100644 index de0f2a76a..000000000 --- a/FS/FS/session.pm +++ /dev/null @@ -1,269 +0,0 @@ -package FS::session; - -use strict; -use vars qw( @ISA $conf $start $stop ); -use FS::UID qw( dbh ); -use FS::Record qw( qsearchs ); -use FS::svc_acct; -use FS::port; -use FS::nas; - -@ISA = qw(FS::Record); - -$FS::UID::callback{'FS::session'} = sub { - $conf = new FS::Conf; - $start = $conf->exists('session-start') ? $conf->config('session-start') : ''; - $stop = $conf->exists('session-stop') ? $conf->config('session-stop') : ''; -}; - -=head1 NAME - -FS::session - Object methods for session records - -=head1 SYNOPSIS - - use FS::session; - - $record = new FS::session \%hash; - $record = new FS::session { - 'portnum' => 1, - 'svcnum' => 2, - 'login' => $timestamp, - 'logout' => $timestamp, - }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - - $error = $record->nas_heartbeat($timestamp); - -=head1 DESCRIPTION - -An FS::session object represents an user login session. FS::session inherits -from FS::Record. The following fields are currently supported: - -=over 4 - -=item sessionnum - primary key - -=item portnum - NAS port for this session - see L - -=item svcnum - User for this session - see L - -=item login - timestamp indicating the beginning of this user session. - -=item logout - timestamp indicating the end of this user session. May be null, - which indicates a currently open session. - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new session. To add the session to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'session'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. If the `login' field is empty, it is replaced with -the current time. - -=cut - -sub insert { - my $self = shift; - my $error; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - $error = $self->check; - return $error if $error; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - if ( qsearchs('session', { 'portnum' => $self->portnum, 'logout' => '' } ) ) { - $dbh->rollback if $oldAutoCommit; - return "a session on that port is already open!"; - } - - $self->setfield('login', time()) unless $self->getfield('login'); - - $error = $self->SUPER::insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - $self->nas_heartbeat($self->getfield('login')); - - #session-starting callback - #redundant with heartbeat, yuck - my $port = qsearchs('port',{'portnum'=>$self->portnum}); - my $nas = qsearchs('nas',{'nasnum'=>$port->nasnum}); - #kcuy - my( $ip, $nasip, $nasfqdn ) = ( $port->ip, $nas->nasip, $nas->nasfqdn ); - system( eval qq("$start") ) if $start; - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - -} - -=item delete - -Delete this record from the database. - -=cut - -# the delete method can be inherited from FS::Record - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. If the `logout' field is empty, -it is replaced with the current time. - -=cut - -sub replace { - my($self, $old) = @_; - my $error; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - $error = $self->check; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - $self->setfield('logout', time()) unless $self->getfield('logout'); - - $error = $self->SUPER::replace($old); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - $self->nas_heartbeat($self->getfield('logout')); - - #session-ending callback - #redundant with heartbeat, yuck - my $port = qsearchs('port',{'portnum'=>$self->portnum}); - my $nas = qsearchs('nas',{'nasnum'=>$port->nasnum}); - #kcuy - my( $ip, $nasip, $nasfqdn ) = ( $port->ip, $nas->nasip, $nas->nasfqdn ); - system( eval qq("$stop") ) if $stop; - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; -} - -=item check - -Checks all fields to make sure this is a valid session. If there is -an error, returns the error, otherwise returns false. Called by the insert -and replace methods. - -=cut - -# the check method should currently be supplied - FS::Record contains some -# data checking routines - -sub check { - my $self = shift; - my $error = - $self->ut_numbern('sessionnum') - || $self->ut_number('portnum') - || $self->ut_number('svcnum') - || $self->ut_numbern('login') - || $self->ut_numbern('logout') - ; - return $error if $error; - return "Unknown svcnum" - unless qsearchs('svc_acct', { 'svcnum' => $self->svcnum } ); - ''; -} - -=item nas_heartbeat - -Heartbeats the nas associated with this session (see L). - -=cut - -sub nas_heartbeat { - my $self = shift; - my $port = qsearchs('port',{'portnum'=>$self->portnum}); - my $nas = qsearchs('nas',{'nasnum'=>$port->nasnum}); - $nas->heartbeat(shift); -} - -=item svc_acct - -Returns the svc_acct record associated with this session (see L). - -=cut - -sub svc_acct { - my $self = shift; - qsearchs('svc_acct', { 'svcnum' => $self->svcnum } ); -} - -=back - -=head1 VERSION - -$Id: session.pm,v 1.7 2001-04-15 13:35:12 ivan Exp $ - -=head1 BUGS - -Maybe you shouldn't be able to insert a session if there's currently an open -session on that port. Or maybe the open session on that port should be flagged -as problematic? autoclosed? *sigh* - -Hmm, sessions refer to current svc_acct records... probably need to constrain -deletions to svc_acct records such that no svc_acct records are deleted which -have a session (even if long-closed). - -=head1 SEE ALSO - -L, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/svc_Common.pm b/FS/FS/svc_Common.pm deleted file mode 100644 index 87b6097aa..000000000 --- a/FS/FS/svc_Common.pm +++ /dev/null @@ -1,381 +0,0 @@ -package FS::svc_Common; - -use strict; -use vars qw( @ISA $noexport_hack ); -use FS::Record qw( qsearchs fields dbh ); -use FS::cust_svc; -use FS::part_svc; -use FS::queue; - -@ISA = qw( FS::Record ); - -=head1 NAME - -FS::svc_Common - Object method for all svc_ records - -=head1 SYNOPSIS - -use FS::svc_Common; - -@ISA = qw( FS::svc_Common ); - -=head1 DESCRIPTION - -FS::svc_Common is intended as a base class for table-specific classes to -inherit from, i.e. FS::svc_acct. FS::svc_Common inherits from FS::Record. - -=head1 METHODS - -=over 4 - -=item insert [ JOBNUM_ARRAYREF ] - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -The additional fields pkgnum and svcpart (see L) should be -defined. An FS::cust_svc record will be created and inserted. - -If an arrayref is passed as parameter, the Bs of any export jobs will -be added to the array. - -=cut - -sub insert { - my $self = shift; - local $FS::queue::jobnums = shift if @_; - my $error; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - $error = $self->check; - return $error if $error; - - my $svcnum = $self->svcnum; - my $cust_svc; - unless ( $svcnum ) { - $cust_svc = new FS::cust_svc ( { - #hua?# 'svcnum' => $svcnum, - 'pkgnum' => $self->pkgnum, - 'svcpart' => $self->svcpart, - } ); - $error = $cust_svc->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - $svcnum = $self->svcnum($cust_svc->svcnum); - } else { - $cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum}); - unless ( $cust_svc ) { - $dbh->rollback if $oldAutoCommit; - return "no cust_svc record found for svcnum ". $self->svcnum; - } - $self->pkgnum($cust_svc->pkgnum); - $self->svcpart($cust_svc->svcpart); - } - - $error = $self->SUPER::insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - #new-style exports! - unless ( $noexport_hack ) { - foreach my $part_export ( $self->cust_svc->part_svc->part_export ) { - my $error = $part_export->export_insert($self); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "exporting to ". $part_export->exporttype. - " (transaction rolled back): $error"; - } - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; -} - -=item delete - -Deletes this account from the database. If there is an error, returns the -error, otherwise returns false. - -The corresponding FS::cust_svc record will be deleted as well. - -=cut - -sub delete { - my $self = shift; - my $error; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $svcnum = $self->svcnum; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - $error = $self->SUPER::delete; - return $error if $error; - - #new-style exports! - unless ( $noexport_hack ) { - foreach my $part_export ( $self->cust_svc->part_svc->part_export ) { - my $error = $part_export->export_delete($self); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "exporting to ". $part_export->exporttype. - " (transaction rolled back): $error"; - } - } - } - - return $error if $error; - - my $cust_svc = $self->cust_svc; - $error = $cust_svc->delete; - return $error if $error; - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; -} - -=item replace OLD_RECORD - -Replaces OLD_RECORD with this one. If there is an error, returns the error, -otherwise returns false. - -=cut - -sub replace { - my ($new, $old) = (shift, shift); - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $error = $new->SUPER::replace($old); - if ($error) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - #new-style exports! - unless ( $noexport_hack ) { - foreach my $part_export ( $new->cust_svc->part_svc->part_export ) { - my $error = $part_export->export_replace($new,$old); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error exporting to ". $part_export->exporttype. - " (transaction rolled back): $error"; - } - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; -} - - -=item setfixed - -Sets any fixed fields for this service (see L). If there is an -error, returns the error, otherwise returns the FS::part_svc object (use ref() -to test the return). Usually called by the check method. - -=cut - -sub setfixed { - my $self = shift; - $self->setx('F'); -} - -=item setdefault - -Sets all fields to their defaults (see L), overriding their -current values. If there is an error, returns the error, otherwise returns -the FS::part_svc object (use ref() to test the return). - -=cut - -sub setdefault { - my $self = shift; - $self->setx('D'); -} - -sub setx { - my $self = shift; - my $x = shift; - - my $error; - - $error = - $self->ut_numbern('svcnum') - ; - return $error if $error; - - #get part_svc - my $svcpart; - if ( $self->svcnum ) { - my $cust_svc = $self->cust_svc; - return "Unknown svcnum" unless $cust_svc; - $svcpart = $cust_svc->svcpart; - } else { - $svcpart = $self->getfield('svcpart'); - } - my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $svcpart } ); - return "Unkonwn svcpart" unless $part_svc; - - #set default/fixed/whatever fields from part_svc - my $table = $self->table; - foreach my $field ( grep { $_ ne 'svcnum' } fields($table) ) { - my $part_svc_column = $part_svc->part_svc_column($field); - if ( $part_svc_column->columnflag eq $x ) { - $self->setfield( $field, $part_svc_column->columnvalue ); - } - } - - $part_svc; - -} - -=item cust_svc - -Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc -object (see L). - -=cut - -sub cust_svc { - my $self = shift; - qsearchs('cust_svc', { 'svcnum' => $self->svcnum } ); -} - -=item suspend - -Runs export_suspend callbacks. - -=cut - -sub suspend { - my $self = shift; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - #new-style exports! - unless ( $noexport_hack ) { - foreach my $part_export ( $self->cust_svc->part_svc->part_export ) { - my $error = $part_export->export_suspend($self); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error exporting to ". $part_export->exporttype. - " (transaction rolled back): $error"; - } - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - -} - -=item unsuspend - -Runs export_unsuspend callbacks. - -=cut - -sub unsuspend { - my $self = shift; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - #new-style exports! - unless ( $noexport_hack ) { - foreach my $part_export ( $self->cust_svc->part_svc->part_export ) { - my $error = $part_export->export_unsuspend($self); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error exporting to ". $part_export->exporttype. - " (transaction rolled back): $error"; - } - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - -} - -=item cancel - -Stub - returns false (no error) so derived classes don't need to define these -methods. Called by the cancel method of FS::cust_pkg (see L). - -=cut - -sub cancel { ''; } - -=back - -=head1 VERSION - -$Id: svc_Common.pm,v 1.12 2002-06-14 11:22:53 ivan Exp $ - -=head1 BUGS - -The setfixed method return value. - -=head1 SEE ALSO - -L, L, L, L, schema.html -from the base documentation. - -=cut - -1; - diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm deleted file mode 100644 index c95df94cf..000000000 --- a/FS/FS/svc_acct.pm +++ /dev/null @@ -1,1150 +0,0 @@ -package FS::svc_acct; - -use strict; -use vars qw( @ISA $noexport_hack $conf - $dir_prefix @shells $usernamemin - $usernamemax $passwordmin $passwordmax - $username_ampersand $username_letter $username_letterfirst - $username_noperiod $username_nounderscore $username_nodash - $username_uppercase - $mydomain - $welcome_template $welcome_from $welcome_subject $welcome_mimetype - $smtpmachine - $dirhash - @saltset @pw_set ); -use Carp; -use Fcntl qw(:flock); -use FS::UID qw( datasrc ); -use FS::Conf; -use FS::Record qw( qsearch qsearchs fields dbh ); -use FS::svc_Common; -use Net::SSH; -use FS::cust_svc; -use FS::part_svc; -use FS::svc_acct_pop; -use FS::svc_acct_sm; -use FS::cust_main_invoice; -use FS::svc_domain; -use FS::raddb; -use FS::queue; -use FS::radius_usergroup; -use FS::export_svc; -use FS::part_export; -use FS::Msgcat qw(gettext); - -@ISA = qw( FS::svc_Common ); - -#ask FS::UID to run this stuff for us later -$FS::UID::callback{'FS::svc_acct'} = sub { - $conf = new FS::Conf; - $dir_prefix = $conf->config('home'); - @shells = $conf->config('shells'); - $usernamemin = $conf->config('usernamemin') || 2; - $usernamemax = $conf->config('usernamemax'); - $passwordmin = $conf->config('passwordmin') || 6; - $passwordmax = $conf->config('passwordmax') || 8; - $username_letter = $conf->exists('username-letter'); - $username_letterfirst = $conf->exists('username-letterfirst'); - $username_noperiod = $conf->exists('username-noperiod'); - $username_nounderscore = $conf->exists('username-nounderscore'); - $username_nodash = $conf->exists('username-nodash'); - $username_uppercase = $conf->exists('username-uppercase'); - $username_ampersand = $conf->exists('username-ampersand'); - $mydomain = $conf->config('domain'); - $dirhash = $conf->config('dirhash') || 0; - if ( $conf->exists('welcome_email') ) { - $welcome_template = new Text::Template ( - TYPE => 'ARRAY', - SOURCE => [ map "$_\n", $conf->config('welcome_email') ] - ) or warn "can't create welcome email template: $Text::Template::ERROR"; - $welcome_from = $conf->config('welcome_email-from'); # || 'your-isp-is-dum' - $welcome_subject = $conf->config('welcome_email-subject') || 'Welcome'; - $welcome_mimetype = $conf->config('welcome_email-mimetype') || 'text/plain'; - } else { - $welcome_template = ''; - } - $smtpmachine = $conf->config('smtpmachine'); -}; - -@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); -@pw_set = ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '!', '.', ',' ); - -sub _cache { - my $self = shift; - my ( $hashref, $cache ) = @_; - if ( $hashref->{'svc_acct_svcnum'} ) { - $self->{'_domsvc'} = FS::svc_domain->new( { - 'svcnum' => $hashref->{'domsvc'}, - 'domain' => $hashref->{'svc_acct_domain'}, - 'catchall' => $hashref->{'svc_acct_catchall'}, - } ); - } -} - -=head1 NAME - -FS::svc_acct - Object methods for svc_acct records - -=head1 SYNOPSIS - - use FS::svc_acct; - - $record = new FS::svc_acct \%hash; - $record = new FS::svc_acct { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - - $error = $record->suspend; - - $error = $record->unsuspend; - - $error = $record->cancel; - - %hash = $record->radius; - - %hash = $record->radius_reply; - - %hash = $record->radius_check; - - $domain = $record->domain; - - $svc_domain = $record->svc_domain; - - $email = $record->email; - - $seconds_since = $record->seconds_since($timestamp); - -=head1 DESCRIPTION - -An FS::svc_acct object represents an account. FS::svc_acct inherits from -FS::svc_Common. The following fields are currently supported: - -=over 4 - -=item svcnum - primary key (assigned automatcially for new accounts) - -=item username - -=item _password - generated if blank - -=item sec_phrase - security phrase - -=item popnum - Point of presence (see L) - -=item uid - -=item gid - -=item finger - GECOS - -=item dir - set automatically if blank (and uid is not) - -=item shell - -=item quota - (unimplementd) - -=item slipip - IP address - -=item seconds - - -=item domsvc - svcnum from svc_domain - -=item radius_I - I - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new account. To add the account to the database, see L<"insert">. - -=cut - -sub table { 'svc_acct'; } - -=item insert - -Adds this account to the database. If there is an error, returns the error, -otherwise returns false. - -The additional fields pkgnum and svcpart (see L) should be -defined. An FS::cust_svc record will be created and inserted. - -The additional field I can optionally be defined; if so it should -contain an arrayref of group names. See L. (used in -sqlradius export only) - -(TODOC: L and L) - -(TODOC: new exports! $noexport_hack) - -=cut - -sub insert { - my $self = shift; - my $error; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - $error = $self->check; - return $error if $error; - - #no, duplicate checking just got a whole lot more complicated - #(perhaps keep this check with a config option to turn on?) - - #return gettext('username_in_use'). ": ". $self->username - # if qsearchs( 'svc_acct', { 'username' => $self->username, - # 'domsvc' => $self->domsvc, - # } ); - - if ( $self->svcnum ) { - my $cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum}); - unless ( $cust_svc ) { - $dbh->rollback if $oldAutoCommit; - return "no cust_svc record found for svcnum ". $self->svcnum; - } - $self->pkgnum($cust_svc->pkgnum); - $self->svcpart($cust_svc->svcpart); - } - - #new duplicate username checking - - my $part_svc = qsearchs('part_svc', { 'svcpart' => $self->svcpart } ); - unless ( $part_svc ) { - $dbh->rollback if $oldAutoCommit; - return 'unknown svcpart '. $self->svcpart; - } - - my @dup_user = qsearch( 'svc_acct', { 'username' => $self->username } ); - my @dup_userdomain = qsearch( 'svc_acct', { 'username' => $self->username, - 'domsvc' => $self->domsvc } ); - my @dup_uid; - if ( $part_svc->part_svc_column('uid')->columnflag ne 'F' - && $self->username !~ /^(toor|(hyla)?fax)$/ ) { - @dup_uid = qsearch( 'svc_acct', { 'uid' => $self->uid } ); - } else { - @dup_uid = (); - } - - if ( @dup_user || @dup_userdomain || @dup_uid ) { - my $exports = FS::part_export::export_info('svc_acct'); - my( %conflict_user_svcpart, %conflict_userdomain_svcpart ); - - foreach my $part_export ( $part_svc->part_export ) { - - #this will catch to the same exact export - my @svcparts = map { $_->svcpart } - qsearch('export_svc', { 'exportnum' => $part_export->exportnum }); - - #this will catch to exports w/same exporthost+type ??? - #my @other_part_export = qsearch('part_export', { - # 'machine' => $part_export->machine, - # 'exporttype' => $part_export->exporttype, - #} ); - #foreach my $other_part_export ( @other_part_export ) { - # push @svcparts, map { $_->svcpart } - # qsearch('export_svc', { 'exportnum' => $part_export->exportnum }); - #} - - my $nodomain = $exports->{$part_export->exporttype}{'nodomain'}; - if ( $nodomain =~ /^Y/i ) { - $conflict_user_svcpart{$_} = $part_export->exportnum - foreach @svcparts; - } else { - $conflict_userdomain_svcpart{$_} = $part_export->exportnum - foreach @svcparts; - } - } - - foreach my $dup_user ( @dup_user ) { - my $dup_svcpart = $dup_user->cust_svc->svcpart; - if ( exists($conflict_user_svcpart{$dup_svcpart}) ) { - $dbh->rollback if $oldAutoCommit; - return "duplicate username: conflicts with svcnum ". $dup_user->svcnum. - " via exportnum ". $conflict_user_svcpart{$dup_svcpart}; - } - } - - foreach my $dup_userdomain ( @dup_userdomain ) { - my $dup_svcpart = $dup_userdomain->cust_svc->svcpart; - if ( exists($conflict_userdomain_svcpart{$dup_svcpart}) ) { - $dbh->rollback if $oldAutoCommit; - return "duplicate username\@domain: conflicts with svcnum ". - $dup_userdomain->svcnum. " via exportnum ". - $conflict_userdomain_svcpart{$dup_svcpart}; - } - } - - foreach my $dup_uid ( @dup_uid ) { - my $dup_svcpart = $dup_uid->cust_svc->svcpart; - if ( exists($conflict_user_svcpart{$dup_svcpart}) - || exists($conflict_userdomain_svcpart{$dup_svcpart}) ) { - $dbh->rollback if $oldAutoCommit; - return "duplicate uid: conflicts with svcnum". $dup_uid->svcnum. - "via exportnum ". $conflict_user_svcpart{$dup_svcpart} - || $conflict_userdomain_svcpart{$dup_svcpart}; - } - } - - } - - #see? i told you it was more complicated - - my @jobnums; - $error = $self->SUPER::insert(\@jobnums); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - if ( $self->usergroup ) { - foreach my $groupname ( @{$self->usergroup} ) { - my $radius_usergroup = new FS::radius_usergroup ( { - svcnum => $self->svcnum, - groupname => $groupname, - } ); - my $error = $radius_usergroup->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - } - - #false laziness with sub replace (and cust_main) - my $queue = new FS::queue { - 'svcnum' => $self->svcnum, - 'job' => 'FS::svc_acct::append_fuzzyfiles' - }; - $error = $queue->insert($self->username); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - - #welcome email - my $cust_pkg = $self->cust_svc->cust_pkg; - my( $cust_main, $to ) = ( '', '' ); - if ( $welcome_template && $cust_pkg ) { - my $cust_main = $cust_pkg->cust_main; - my $to = join(', ', grep { $_ ne 'POST' } $cust_main->invoicing_list ); - if ( $to ) { - my $wqueue = new FS::queue { - 'svcnum' => $self->svcnum, - 'job' => 'FS::svc_acct::send_email' - }; - warn "attempting to queue email to $to"; - my $error = $wqueue->insert( - 'to' => $to, - 'from' => $welcome_from, - 'subject' => $welcome_subject, - 'mimetype' => $welcome_mimetype, - 'body' => $welcome_template->fill_in( HASH => { - 'username' => $self->username, - 'password' => $self->_password, - 'first' => $cust_main->first, - 'last' => $cust_main->getfield('last'), - 'pkg' => $cust_pkg->part_pkg->pkg, - } ), - ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queuing welcome email: $error"; - } - - foreach my $jobnum ( @jobnums ) { - my $error = $wqueue->depend_insert($jobnum); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queuing welcome email job dependancy: $error"; - } - } - - } - - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; #no error -} - -=item delete - -Deletes this account from the database. If there is an error, returns the -error, otherwise returns false. - -The corresponding FS::cust_svc record will be deleted as well. - -(TODOC: new exports! $noexport_hack) - -=cut - -sub delete { - my $self = shift; - - if ( defined( $FS::Record::dbdef->table('svc_acct_sm') ) ) { - return "Can't delete an account which has (svc_acct_sm) mail aliases!" - if $self->uid && qsearch( 'svc_acct_sm', { 'domuid' => $self->uid } ); - } - - return "Can't delete an account which is a (svc_forward) source!" - if qsearch( 'svc_forward', { 'srcsvc' => $self->svcnum } ); - - return "Can't delete an account which is a (svc_forward) destination!" - if qsearch( 'svc_forward', { 'dstsvc' => $self->svcnum } ); - - return "Can't delete an account with (svc_www) web service!" - if qsearch( 'svc_www', { 'usersvc' => $self->usersvc } ); - - # what about records in session ? (they should refer to history table) - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - foreach my $cust_main_invoice ( - qsearch( 'cust_main_invoice', { 'dest' => $self->svcnum } ) - ) { - unless ( defined($cust_main_invoice) ) { - warn "WARNING: something's wrong with qsearch"; - next; - } - my %hash = $cust_main_invoice->hash; - $hash{'dest'} = $self->email; - my $new = new FS::cust_main_invoice \%hash; - my $error = $new->replace($cust_main_invoice); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - foreach my $svc_domain ( - qsearch( 'svc_domain', { 'catchall' => $self->svcnum } ) - ) { - my %hash = new FS::svc_domain->hash; - $hash{'catchall'} = ''; - my $new = new FS::svc_domain \%hash; - my $error = $new->replace($svc_domain); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - foreach my $radius_usergroup ( - qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } ) - ) { - my $error = $radius_usergroup->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - my $error = $self->SUPER::delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; -} - -=item replace OLD_RECORD - -Replaces OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -The additional field I can optionally be defined; if so it should -contain an arrayref of group names. See L. (used in -sqlradius export only) - -=cut - -sub replace { - my ( $new, $old ) = ( shift, shift ); - my $error; - - return "Username in use" - if $old->username ne $new->username && - qsearchs( 'svc_acct', { 'username' => $new->username, - 'domsvc' => $new->domsvc, - } ); - { - #no warnings 'numeric'; #alas, a 5.006-ism - local($^W) = 0; - return "Can't change uid!" if $old->uid != $new->uid; - } - - #change homdir when we change username - $new->setfield('dir', '') if $old->username ne $new->username; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - $old->usergroup( [ $old->radius_groups ] ); - if ( $new->usergroup ) { - #(sorta) false laziness with FS::part_export::sqlradius::_export_replace - my @newgroups = @{$new->usergroup}; - foreach my $oldgroup ( @{$old->usergroup} ) { - if ( grep { $oldgroup eq $_ } @newgroups ) { - @newgroups = grep { $oldgroup ne $_ } @newgroups; - next; - } - my $radius_usergroup = qsearchs('radius_usergroup', { - svcnum => $old->svcnum, - groupname => $oldgroup, - } ); - my $error = $radius_usergroup->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error deleting radius_usergroup $oldgroup: $error"; - } - } - - foreach my $newgroup ( @newgroups ) { - my $radius_usergroup = new FS::radius_usergroup ( { - svcnum => $new->svcnum, - groupname => $newgroup, - } ); - my $error = $radius_usergroup->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error adding radius_usergroup $newgroup: $error"; - } - } - - } - - $error = $new->SUPER::replace($old); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error if $error; - } - - #false laziness with sub insert (and cust_main) - my $queue = new FS::queue { - 'svcnum' => $new->svcnum, - 'job' => 'FS::svc_acct::append_fuzzyfiles' - }; - $error = $queue->insert($new->username); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; #no error -} - -=item suspend - -Suspends this account by prefixing *SUSPENDED* to the password. If there is an -error, returns the error, otherwise returns false. - -Called by the suspend method of FS::cust_pkg (see L). - -=cut - -sub suspend { - my $self = shift; - my %hash = $self->hash; - unless ( $hash{_password} =~ /^\*SUSPENDED\* / - || $hash{_password} eq '*' - ) { - $hash{_password} = '*SUSPENDED* '.$hash{_password}; - my $new = new FS::svc_acct ( \%hash ); - my $error = $new->replace($self); - return $error if $error; - } - - $self->SUPER::suspend; -} - -=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 $self = shift; - my %hash = $self->hash; - if ( $hash{_password} =~ /^\*SUSPENDED\* (.*)$/ ) { - $hash{_password} = $1; - my $new = new FS::svc_acct ( \%hash ); - my $error = $new->replace($self); - return $error if $error; - } - - $self->SUPER::unsuspend; -} - -=item cancel - -Just returns false (no error) for now. - -Called by the cancel method of FS::cust_pkg (see L). - -=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 = shift; - - my($recref) = $self->hashref; - - my $x = $self->setfixed; - return $x unless ref($x); - my $part_svc = $x; - - if ( $part_svc->part_svc_column('usergroup')->columnflag eq "F" ) { - $self->usergroup( - [ split(',', $part_svc->part_svc_column('usergroup')->columnvalue) ] ); - } - - my $error = $self->ut_numbern('svcnum') - || $self->ut_number('domsvc') - || $self->ut_textn('sec_phrase') - ; - return $error if $error; - - my $ulen = $usernamemax || $self->dbdef_table->column('username')->length; - if ( $username_uppercase ) { - $recref->{username} =~ /^([a-z0-9_\-\.\&]{$usernamemin,$ulen})$/i - or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username}; - $recref->{username} = $1; - } else { - $recref->{username} =~ /^([a-z0-9_\-\.\&]{$usernamemin,$ulen})$/ - or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username}; - $recref->{username} = $1; - } - - if ( $username_letterfirst ) { - $recref->{username} =~ /^[a-z]/ or return gettext('illegal_username'); - } elsif ( $username_letter ) { - $recref->{username} =~ /[a-z]/ or return gettext('illegal_username'); - } - if ( $username_noperiod ) { - $recref->{username} =~ /\./ and return gettext('illegal_username'); - } - if ( $username_nounderscore ) { - $recref->{username} =~ /_/ and return gettext('illegal_username'); - } - if ( $username_nodash ) { - $recref->{username} =~ /\-/ and return gettext('illegal_username'); - } - unless ( $username_ampersand ) { - $recref->{username} =~ /\&/ and return gettext('illegal_username'); - } - - $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum}; - $recref->{popnum} = $1; - return "Unknown popnum" unless - ! $recref->{popnum} || - qsearchs('svc_acct_pop',{'popnum'=> $recref->{popnum} } ); - - unless ( $part_svc->part_svc_column('uid')->columnflag eq 'F' ) { - - $recref->{uid} =~ /^(\d*)$/ or return "Illegal uid"; - $recref->{uid} = $1 eq '' ? $self->unique('uid') : $1; - - $recref->{gid} =~ /^(\d*)$/ or return "Illegal gid"; - $recref->{gid} = $1 eq '' ? $recref->{uid} : $1; - #not all systems use gid=uid - #you can set a fixed gid in part_svc - - return "Only root can have uid 0" - if $recref->{uid} == 0 - && $recref->{username} ne 'root' - && $recref->{username} ne 'toor'; - -# $error = $self->ut_textn('finger'); -# return $error if $error; - $self->getfield('finger') =~ - /^([\w \t\!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\*\<\>]*)$/ - or return "Illegal finger: ". $self->getfield('finger'); - $self->setfield('finger', $1); - - $recref->{dir} =~ /^([\/\w\-\.\&]*)$/ - or return "Illegal directory"; - $recref->{dir} = $1; - return "Illegal directory" - if $recref->{dir} =~ /(^|\/)\.+(\/|$)/; #no .. component - return "Illegal directory" - if $recref->{dir} =~ /\&/ && ! $username_ampersand; - unless ( $recref->{dir} ) { - $recref->{dir} = $dir_prefix . '/'; - if ( $dirhash > 0 ) { - for my $h ( 1 .. $dirhash ) { - $recref->{dir} .= substr($recref->{username}, $h-1, 1). '/'; - } - } elsif ( $dirhash < 0 ) { - for my $h ( reverse $dirhash .. -1 ) { - $recref->{dir} .= substr($recref->{username}, $h, 1). '/'; - } - } - $recref->{dir} .= $recref->{username}; - ; - } - - unless ( $recref->{username} eq 'sync' ) { - if ( grep $_ eq $recref->{shell}, @shells ) { - $recref->{shell} = (grep $_ eq $recref->{shell}, @shells)[0]; - } else { - return "Illegal shell \`". $self->shell. "\'; ". - $conf->dir. "/shells contains: @shells"; - } - } else { - $recref->{shell} = '/bin/sync'; - } - - $recref->{quota} =~ /^(\d*)$/ or return "Illegal quota (unimplemented)"; - $recref->{quota} = $1; - - } else { - $recref->{gid} ne '' ? - return "Can't have gid without uid" : ( $recref->{gid}='' ); - $recref->{finger} ne '' ? - return "Can't have finger-name without uid" : ( $recref->{finger}='' ); - $recref->{dir} ne '' ? - return "Can't have directory without uid" : ( $recref->{dir}='' ); - $recref->{shell} ne '' ? - return "Can't have shell without uid" : ( $recref->{shell}='' ); - $recref->{quota} ne '' ? - return "Can't have quota without uid" : ( $recref->{quota}='' ); - } - - unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) { - unless ( $recref->{slipip} eq '0e0' ) { - $recref->{slipip} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/ - or return "Illegal slipip". $self->slipip; - $recref->{slipip} = $1; - } else { - $recref->{slipip} = '0e0'; - } - - } - - #arbitrary RADIUS stuff; allow ut_textn for now - foreach ( grep /^radius_/, fields('svc_acct') ) { - $self->ut_textn($_); - } - - #generate a password if it is blank - $recref->{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) ) - unless ( $recref->{_password} ); - - #if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,16})$/ ) { - if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{$passwordmin,$passwordmax})$/ ) { - $recref->{_password} = $1.$3; - #uncomment this to encrypt password immediately upon entry, or run - #bin/crypt_pw in cron to give new users a window during which their - #password is available to techs, for faxing, etc. (also be aware of - #radius issues!) - #$recref->{password} = $1. - # crypt($3,$saltset[int(rand(64))].$saltset[int(rand(64))] - #; - } elsif ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([\w\.\/\$]{13,34})$/ ) { - $recref->{_password} = $1.$3; - } elsif ( $recref->{_password} eq '*' ) { - $recref->{_password} = '*'; - } elsif ( $recref->{_password} eq '!!' ) { - $recref->{_password} = '!!'; - } else { - #return "Illegal password"; - return gettext('illegal_password'). " $passwordmin-$passwordmax ". - FS::Msgcat::_gettext('illegal_password_characters'). - ": ". $recref->{_password}; - } - - ''; #no error -} - -=item radius - -Depriciated, use radius_reply instead. - -=cut - -sub radius { - carp "FS::svc_acct::radius depriciated, use radius_reply"; - $_[0]->radius_reply; -} - -=item radius_reply - -Returns key/value pairs, suitable for assigning to a hash, for any RADIUS -reply attributes of this record. - -Note that this is now the preferred method for reading RADIUS attributes - -accessing the columns directly is discouraged, as the column names are -expected to change in the future. - -=cut - -sub radius_reply { - my $self = shift; - my %reply = - map { - /^(radius_(.*))$/; - my($column, $attrib) = ($1, $2); - #$attrib =~ s/_/\-/g; - ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) ); - } grep { /^radius_/ && $self->getfield($_) } fields( $self->table ); - if ( $self->slipip && $self->slipip ne '0e0' ) { - $reply{'Framed-IP-Address'} = $self->slipip; - } - %reply; -} - -=item radius_check - -Returns key/value pairs, suitable for assigning to a hash, for any RADIUS -check attributes of this record. - -Note that this is now the preferred method for reading RADIUS attributes - -accessing the columns directly is discouraged, as the column names are -expected to change in the future. - -=cut - -sub radius_check { - my $self = shift; - ( 'Password' => $self->_password, - map { - /^(rc_(.*))$/; - my($column, $attrib) = ($1, $2); - #$attrib =~ s/_/\-/g; - ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) ); - } grep { /^rc_/ && $self->getfield($_) } fields( $self->table ) - ); -} - -=item domain - -Returns the domain associated with this account. - -=cut - -sub domain { - my $self = shift; - if ( $self->domsvc ) { - #$self->svc_domain->domain; - my $svc_domain = $self->svc_domain - or die "no svc_domain.svcnum for svc_acct.domsvc ". $self->domsvc; - $svc_domain->domain; - } else { - $mydomain or die "svc_acct.domsvc is null and no legacy domain config file"; - } -} - -=item svc_domain - -Returns the FS::svc_domain record for this account's domain (see -L). - -=cut - -sub svc_domain { - my $self = shift; - $self->{'_domsvc'} - ? $self->{'_domsvc'} - : qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } ); -} - -=item cust_svc - -Returns the FS::cust_svc record for this account (see L). - -sub cust_svc { - my $self = shift; - qsearchs( 'cust_svc', { 'svcnum' => $self->svcnum } ); -} - -=item email - -Returns an email address associated with the account. - -=cut - -sub email { - my $self = shift; - $self->username. '@'. $self->domain; -} - -=item seconds_since TIMESTAMP - -Returns the number of seconds this account has been online since TIMESTAMP. -See L - -TIMESTAMP is specified as a UNIX timestamp; see L. Also see -L and L for conversion functions. - -=cut - -#note: POD here, implementation in FS::cust_svc -sub seconds_since { - my $self = shift; - $self->cust_svc->seconds_since(@_); -} - -=item radius_groups - -Returns all RADIUS groups for this account (see L). - -=cut - -sub radius_groups { - my $self = shift; - if ( $self->usergroup ) { - #when provisioning records, export callback runs in svc_Common.pm before - #radius_usergroup records can be inserted... - @{$self->usergroup}; - } else { - map { $_->groupname } - qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } ); - } -} - -=back - -=head1 SUBROUTINES - -=over 4 - -=item send_email - -=cut - -sub send_email { - my %opt = @_; - - use Date::Format; - use Mail::Internet 1.44; - use Mail::Header; - - $opt{mimetype} ||= 'text/plain'; - $opt{mimetype} .= '; charset="iso-8859-1"' unless $opt{mimetype} =~ /charset/; - - $ENV{MAILADDRESS} = $opt{from}; - my $header = new Mail::Header ( [ - "From: $opt{from}", - "To: $opt{to}", - "Sender: $opt{from}", - "Reply-To: $opt{from}", - "Date: ". time2str("%a, %d %b %Y %X %z", time), - "Subject: $opt{subject}", - "Content-Type: $opt{mimetype}", - ] ); - my $message = new Mail::Internet ( - 'Header' => $header, - 'Body' => [ map "$_\n", split("\n", $opt{body}) ], - ); - $!=0; - $message->smtpsend( Host => $smtpmachine ) - or $message->smtpsend( Host => $smtpmachine, Debug => 1 ) - or die "can't send email to $opt{to} via $smtpmachine with SMTP: $!"; -} - -=item check_and_rebuild_fuzzyfiles - -=cut - -sub check_and_rebuild_fuzzyfiles { - my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; - -e "$dir/svc_acct.username" - or &rebuild_fuzzyfiles; -} - -=item rebuild_fuzzyfiles - -=cut - -sub rebuild_fuzzyfiles { - - use Fcntl qw(:flock); - - my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; - - #username - - open(USERNAMELOCK,">>$dir/svc_acct.username") - or die "can't open $dir/svc_acct.username: $!"; - flock(USERNAMELOCK,LOCK_EX) - or die "can't lock $dir/svc_acct.username: $!"; - - my @all_username = map $_->getfield('username'), qsearch('svc_acct', {}); - - open (USERNAMECACHE,">$dir/svc_acct.username.tmp") - or die "can't open $dir/svc_acct.username.tmp: $!"; - print USERNAMECACHE join("\n", @all_username), "\n"; - close USERNAMECACHE or die "can't close $dir/svc_acct.username.tmp: $!"; - - rename "$dir/svc_acct.username.tmp", "$dir/svc_acct.username"; - close USERNAMELOCK; - -} - -=item all_username - -=cut - -sub all_username { - my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; - open(USERNAMECACHE,"<$dir/svc_acct.username") - or die "can't open $dir/svc_acct.username: $!"; - my @array = map { chomp; $_; } ; - close USERNAMECACHE; - \@array; -} - -=item append_fuzzyfiles USERNAME - -=cut - -sub append_fuzzyfiles { - my $username = shift; - - &check_and_rebuild_fuzzyfiles; - - use Fcntl qw(:flock); - - my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; - - open(USERNAME,">>$dir/svc_acct.username") - or die "can't open $dir/svc_acct.username: $!"; - flock(USERNAME,LOCK_EX) - or die "can't lock $dir/svc_acct.username: $!"; - - print USERNAME "$username\n"; - - flock(USERNAME,LOCK_UN) - or die "can't unlock $dir/svc_acct.username: $!"; - close USERNAME; - - 1; -} - - - -=item radius_usergroup_selector GROUPS_ARRAYREF [ SELECTNAME ] - -=cut - -sub radius_usergroup_selector { - my $sel_groups = shift; - my %sel_groups = map { $_=>1 } @$sel_groups; - - my $selectname = shift || 'radius_usergroup'; - - my $dbh = dbh; - my $sth = $dbh->prepare( - 'SELECT DISTINCT(groupname) FROM radius_usergroup ORDER BY groupname' - ) or die $dbh->errstr; - $sth->execute() or die $sth->errstr; - my @all_groups = map { $_->[0] } @{$sth->fetchall_arrayref}; - - my $html = < - function ${selectname}_doadd(object) { - var myvalue = object.${selectname}_add.value; - var optionName = new Option(myvalue,myvalue,false,true); - var length = object.$selectname.length; - object.$selectname.options[length] = optionName; - object.${selectname}_add.value = ""; - } - - !. - qq!!; - - $html; -} - -=back - -=head1 BUGS - -The $recref stuff in sub check should be cleaned up. - -The suspend, unsuspend and cancel methods update the database, but not the -current object. This is probably a bug as it's unexpected and -counterintuitive. - -radius_usergroup_selector? putting web ui components in here? they should -probably live somewhere else... - -=head1 SEE ALSO - -L, edit/part_svc.cgi from an installed web interface, -export.html from the base documentation, L, L, -L, L, L, L, -L), L, L, L, -schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/svc_acct_pop.pm b/FS/FS/svc_acct_pop.pm deleted file mode 100644 index 3c9ea0130..000000000 --- a/FS/FS/svc_acct_pop.pm +++ /dev/null @@ -1,204 +0,0 @@ -package FS::svc_acct_pop; - -use strict; -use vars qw( @ISA @EXPORT_OK @svc_acct_pop %svc_acct_pop ); -use FS::Record qw( qsearch qsearchs ); - -@ISA = qw( FS::Record Exporter ); -@EXPORT_OK = qw( popselector ); - -=head1 NAME - -FS::svc_acct_pop - Object methods for svc_acct_pop records - -=head1 SYNOPSIS - - use FS::svc_acct_pop; - - $record = new FS::svc_acct_pop \%hash; - $record = new FS::svc_acct_pop { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - - $html = FS::svc_acct_pop::popselector( $popnum, $state ); - -=head1 DESCRIPTION - -An FS::svc_acct object represents an point of presence. FS::svc_acct_pop -inherits from FS::Record. The following fields are currently supported: - -=over 4 - -=item popnum - primary key (assigned automatically for new accounts) - -=item city - -=item state - -=item ac - area code - -=item exch - exchange - -=item loc - rest of number - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new point of presence (if only it were that easy!). To add the -point of presence to the database, see L<"insert">. - -=cut - -sub table { 'svc_acct_pop'; } - -=item insert - -Adds this point of presence to the database. If there is an error, returns the -error, otherwise returns false. - -=item delete - -Removes this point of presence from the database. - -=item replace OLD_RECORD - -Replaces OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=item check - -Checks all fields to make sure this is a valid point of presence. If there is -an error, returns the error, otherwise returns false. Called by the insert -and replace methods. - -=cut - -sub check { - my $self = shift; - - $self->ut_numbern('popnum') - or $self->ut_text('city') - or $self->ut_text('state') - or $self->ut_number('ac') - or $self->ut_number('exch') - or $self->ut_numbern('loc') - ; - -} - -=item text - -Returns: - -"$city, $state ($ac)/$exch" - -=cut - -sub text { - my $self = shift; - $self->city. ', '. $self->state. - ' ('. $self->ac. ')/'. $self->exch. '-'. $self->loc; -} - -=back - -=head1 SUBROUTINES - -=over 4 - -=item popselector [ POPNUM [ STATE ] ] - -=cut - -#horrible false laziness with signup.cgi (pull special-case for 0 & 1 -# pop code out from signup.cgi??) -sub popselector { - my( $popnum, $state ) = @_; - - unless ( @svc_acct_pop ) { #cache pop list - @svc_acct_pop = qsearch('svc_acct_pop', {} ); - %svc_acct_pop = (); - push @{$svc_acct_pop{$_->state}}, $_ foreach @svc_acct_pop; - } - - my $text = < - function opt(what,href,text) { - var optionName = new Option(text, href, false, false) - var length = what.length; - what.options[length] = optionName; - } - - function popstate_changed(what) { - state = what.options[what.selectedIndex].text; - for (var i = what.form.popnum.length;i > 0;i--) - what.form.popnum.options[i] = null; - what.form.popnum.options[0] = new Option("", "", false, true); -END - - foreach my $popstate ( sort { $a cmp $b } keys %svc_acct_pop ) { - $text .= "\nif ( state == \"$popstate\" ) {\n"; - - foreach my $pop ( @{$svc_acct_pop{$popstate}}) { - my $o_popnum = $pop->popnum; - my $poptext = $pop->text; - $text .= "opt(what.form.popnum, \"$o_popnum\", \"$poptext\");\n" - } - $text .= "}\n"; - } - - $text .= "}\n\n"; - - $text .= - qq!'; #callback? return 3 html pieces? #''; - - $text .= qq!'; - - $text; - -} - -=back - -=head1 VERSION - -$Id: svc_acct_pop.pm,v 1.7 2002-04-10 13:42:48 ivan Exp $ - -=head1 BUGS - -It should be renamed to part_pop. - -popselector? putting web ui components in here? they should probably live -somewhere else... - -popselector: pull special-case for 0 & 1 pop code out from signup.cgi - -=head1 SEE ALSO - -L, L, L, schema.html from the -base documentation. - -=cut - -1; - diff --git a/FS/FS/svc_acct_sm.pm b/FS/FS/svc_acct_sm.pm deleted file mode 100644 index c92f1421f..000000000 --- a/FS/FS/svc_acct_sm.pm +++ /dev/null @@ -1,260 +0,0 @@ -package FS::svc_acct_sm; - -use strict; -use vars qw( @ISA $nossh_hack $conf $shellmachine @qmailmachines ); -use FS::Record qw( fields qsearch qsearchs ); -use FS::svc_Common; -use FS::cust_svc; -use Net::SSH qw(ssh); -use FS::Conf; -use FS::svc_acct; -use FS::svc_domain; - -@ISA = qw( FS::svc_Common ); - -#ask FS::UID to run this stuff for us later -#$FS::UID::callback{'FS::svc_acct_sm'} = sub { -# $conf = new FS::Conf; -# $shellmachine = $conf->exists('qmailmachines') -# ? $conf->config('shellmachine') -# : ''; -#}; - -=head1 NAME - -FS::svc_acct_sm - Object methods for svc_acct_sm records - -=head1 SYNOPSIS - - use FS::svc_acct_sm; - - $record = new FS::svc_acct_sm \%hash; - $record = new FS::svc_acct_sm { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - - $error = $record->suspend; - - $error = $record->unsuspend; - - $error = $record->cancel; - -=head1 WARNING - -FS::svc_acct_sm is B. This class is only included for migration -purposes. See L. - -=head1 DESCRIPTION - -An FS::svc_acct_sm object represents a virtual mail alias. FS::svc_acct_sm -inherits from FS::Record. The following fields are currently supported: - -=over 4 - -=item svcnum - primary key (assigned automatcially for new accounts) - -=item domsvc - svcnum of the virtual domain (see L) - -=item domuid - uid of the target account (see L) - -=item domuser - virtual username - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new virtual mail alias. To add the virtual mail alias to the -database, see L<"insert">. - -=cut - -sub table { 'svc_acct_sm'; } - -=item insert - -Adds this virtual mail alias to the database. If there is an error, returns -the error, otherwise returns false. - -The additional fields pkgnum and svcpart (see L) 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 = shift; - my $error; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - $error=$self->check; - return $error if $error; - - return "Domain username (domuser) in use for this domain (domsvc)" - if qsearchs('svc_acct_sm',{ 'domuser'=> $self->domuser, - 'domsvc' => $self->domsvc, - } ); - - return "First domain username (domuser) for domain (domsvc) must be " . - qq='*' (catch-all)!= - if $self->domuser ne '*' - && ! qsearch('svc_acct_sm',{ 'domsvc' => $self->domsvc } ) - && ! $conf->exists('maildisablecatchall'); - - $error = $self->SUPER::insert; - return $error if $error; - - #my $svc_domain = qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } ); - #my $svc_acct = qsearchs( 'svc_acct', { 'uid' => $self->domuid } ); - #my ( $uid, $gid, $dir, $domain ) = ( - # $svc_acct->uid, - # $svc_acct->gid, - # $svc_acct->dir, - # $svc_domain->domain, - #); - #my $qdomain = $domain; - #$qdomain =~ s/\./:/g; #see manpage for 'dot-qmail': EXTENSION ADDRESSES - #ssh("root\@$shellmachine","[ -e $dir/.qmail-$qdomain-default ] || { touch $dir/.qmail-$qdomain-default; chown $uid:$gid $dir/.qmail-$qdomain-default; }") - # if ( ! $nossh_hack && $shellmachine && $dir && $self->domuser eq '*' ); - - ''; #no error - -} - -=item delete - -Deletes this virtual mail alias from the database. If there is an error, -returns the error, otherwise returns false. - -The corresponding FS::cust_svc record will be deleted as well. - -=item replace OLD_RECORD - -Replaces OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -sub replace { - my ( $new, $old ) = ( shift, shift ); - my $error; - - return "Domain username (domuser) in use for this domain (domsvc)" - if ( $old->domuser ne $new->domuser - || $old->domsvc != $new->domsvc - ) && qsearchs('svc_acct_sm',{ - 'domuser'=> $new->domuser, - 'domsvc' => $new->domsvc, - } ) - ; - - $new->SUPER::replace($old); - -} - -=item suspend - -Just returns false (no error) for now. - -Called by the suspend method of FS::cust_pkg (see L). - -=item unsuspend - -Just returns false (no error) for now. - -Called by the unsuspend method of FS::cust_pkg (see L). - -=item cancel - -Just returns false (no error) for now. - -Called by the cancel method of FS::cust_pkg (see L). - -=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 = shift; - my $error; - - my $x = $self->setfixed; - return $x unless ref($x); - #my $part_svc = $x; - - my($recref) = $self->hashref; - - $recref->{domuser} =~ /^(\*|[a-z0-9_\-]{2,32})$/ - or return "Illegal domain username (domuser)"; - $recref->{domuser} = $1; - - $recref->{domsvc} =~ /^(\d+)$/ or return "Illegal domsvc"; - $recref->{domsvc} = $1; - my($svc_domain); - return "Unknown domsvc" unless - $svc_domain=qsearchs('svc_domain',{'svcnum'=> $recref->{domsvc} } ); - - $recref->{domuid} =~ /^(\d+)$/ or return "Illegal uid"; - $recref->{domuid} = $1; - my($svc_acct); - return "Unknown uid" unless - $svc_acct=qsearchs('svc_acct',{'uid'=> $recref->{domuid} } ); - - ''; #no error -} - -=back - -=head1 VERSION - -$Id: svc_acct_sm.pm,v 1.5 2001-09-06 20:41:59 ivan Exp $ - -=head1 BUGS - -The remote commands should be configurable. - -The $recref stuff in sub check should be cleaned up. - -=head1 SEE ALSO - -L - -L, L, L, L, L, -L, L, L, L, L, -schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm deleted file mode 100644 index b06d03013..000000000 --- a/FS/FS/svc_domain.pm +++ /dev/null @@ -1,478 +0,0 @@ -package FS::svc_domain; - -use strict; -use vars qw( @ISA $whois_hack $conf $smtpmachine - @defaultrecords $soadefaultttl $soaemail $soaexpire $soamachine - $soarefresh $soaretry $qshellmachine $nossh_hack -); -use Carp; -use Mail::Internet 1.44; -use Mail::Header; -use Date::Format; -use Net::Whois 1.0; -use Net::SSH; -use FS::Record qw(fields qsearch qsearchs dbh); -use FS::Conf; -use FS::svc_Common; -use FS::cust_svc; -use FS::svc_acct; -use FS::cust_pkg; -use FS::cust_main; -use FS::domain_record; -use FS::queue; - -@ISA = qw( FS::svc_Common ); - -#ask FS::UID to run this stuff for us later -$FS::UID::callback{'FS::domain'} = sub { - $conf = new FS::Conf; - - $smtpmachine = $conf->config('smtpmachine'); - - @defaultrecords = $conf->config('defaultrecords'); - $soadefaultttl = $conf->config('soadefaultttl'); - $soaemail = $conf->config('soaemail'); - $soaexpire = $conf->config('soaexpire'); - $soamachine = $conf->config('soamachine'); - $soarefresh = $conf->config('soarefresh'); - $soaretry = $conf->config('soaretry'); - - $qshellmachine = $conf->exists('qmailmachines') - ? $conf->config('shellmachine') - : ''; -}; - -=head1 NAME - -FS::svc_domain - Object methods for svc_domain records - -=head1 SYNOPSIS - - use FS::svc_domain; - - $record = new FS::svc_domain \%hash; - $record = new FS::svc_domain { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - - $error = $record->suspend; - - $error = $record->unsuspend; - - $error = $record->cancel; - -=head1 DESCRIPTION - -An FS::svc_domain object represents a domain. FS::svc_domain inherits from -FS::svc_Common. The following fields are currently supported: - -=over 4 - -=item svcnum - primary key (assigned automatically for new accounts) - -=item domain - -=item catchall - optional svcnum of an svc_acct record, designating an email catchall account. - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new domain. To add the domain to the database, see L<"insert">. - -=cut - -sub table { 'svc_domain'; } - -=item insert - -Adds this domain to the database. If there is an error, returns the error, -otherwise returns false. - -The additional fields I and I (see L) should be -defined. An FS::cust_svc record will be created and inserted. - -The additional field I should be set to I for new domains or I -for transfers. - -A registration or transfer email will be submitted unless -$FS::svc_domain::whois_hack is true. - -The additional field I can be used to manually set the admin contact -email address on this email. Otherwise, the svc_acct records for this package -(see L) are searched. If there is exactly one svc_acct record -in the same package, it is automatically used. Otherwise an error is returned. - -If any I configuration file exists, an SOA record is added to -the domain_record table (see ). - -If any records are defined in the I configuration file, -appropriate records are added to the domain_record table (see -L). - -If a machine is defined in the I configuration value, the -I configuration file exists, and the I field points -to an an account with a home directory (see L), the command: - - [ -e $dir/.qmail-$qdomain-defualt ] || { - touch $dir/.qmail-$qdomain-default; - chown $uid:$gid $dir/.qmail-$qdomain-default; - } - -is executed on shellmachine via ssh (see L). -This behaviour can be supressed by setting $FS::svc_domain::nossh_hack true. - -a machine is defined -in the - -=cut - -sub insert { - my $self = shift; - my $error; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - $error = $self->check; - return $error if $error; - - return "Domain in use (here)" - if qsearchs( 'svc_domain', { 'domain' => $self->domain } ); - - my $whois = $self->whois; - if ( $self->action eq "N" && ! $whois_hack && $whois ) { - $dbh->rollback if $oldAutoCommit; - return "Domain in use (see whois)"; - } - if ( $self->action eq "M" && ! $whois ) { - $dbh->rollback if $oldAutoCommit; - return "Domain not found (see whois)"; - } - - $error = $self->SUPER::insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - $self->submit_internic unless $whois_hack; - - if ( $soamachine ) { - my $soa = new FS::domain_record { - 'svcnum' => $self->svcnum, - 'reczone' => '@', - 'recaf' => 'IN', - 'rectype' => 'SOA', - 'recdata' => "$soamachine $soaemail ( ". time2str("%Y%m%d", time). "00 ". - "$soarefresh $soaretry $soaexpire $soadefaultttl )" - }; - $error = $soa->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "couldn't insert SOA record for new domain: $error"; - } - - foreach my $record ( @defaultrecords ) { - my($zone,$af,$type,$data) = split(/\s+/,$record,4); - my $domain_record = new FS::domain_record { - 'svcnum' => $self->svcnum, - 'reczone' => $zone, - 'recaf' => $af, - 'rectype' => $type, - 'recdata' => $data, - }; - my $error = $domain_record->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "couldn't insert record for new domain: $error"; - } - } - - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - if ( $qshellmachine && $self->catchall && ! $nossh_hack ) { - - my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $self->catchall } ) - or warn "WARNING: inserted unknown catchall: ". $self->catchall; - if ( $svc_acct && $svc_acct->dir ) { - my $qdomain = $self->domain; - $qdomain =~ s/\./:/g; #see manpage for 'dot-qmail': EXTENSION ADDRESSES - my ( $uid, $gid, $dir ) = ( - $svc_acct->uid, - $svc_acct->gid, - $svc_acct->dir, - ); - - my $queue = new FS::queue { - 'svcnum' => $self->svcnum, - 'job' => 'Net::SSH::ssh_cmd', - }; - $error = $queue->insert("root\@$qshellmachine", "[ -e $dir/.qmail-$qdomain-default ] || { touch $dir/.qmail-$qdomain-default; chown $uid:$gid $dir/.qmail-$qdomain-default; }" ); - - } - } - - ''; #no error -} - -=item delete - -Deletes this domain from the database. If there is an error, returns the -error, otherwise returns false. - -The corresponding FS::cust_svc record will be deleted as well. - -=cut - -sub delete { - my $self = shift; - - return "Can't delete a domain which has accounts!" - if qsearch( 'svc_acct', { 'domsvc' => $self->svcnum } ); - - return "Can't delete a domain with (svc_acct_sm) mail aliases!" - if defined( $FS::Record::dbdef->table('svc_acct_sm') ) - && qsearch('svc_acct_sm', { 'domsvc' => $self->svcnum } ); - - #return "Can't delete a domain with (domain_record) zone entries!" - # if qsearch('domain_record', { 'svcnum' => $self->svcnum } ); - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $error = $self->SUPER::delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - foreach my $domain_record ( reverse $self->domain_record ) { - my $error = $domain_record->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - $dbh->commit or die $dbh->errstr if $oldAutoCommit; -} - -=item replace OLD_RECORD - -Replaces OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -sub replace { - my ( $new, $old ) = ( shift, shift ); - - return "Can't change domain - reorder." - if $old->getfield('domain') ne $new->getfield('domain'); - - my $error = $new->SUPER::replace($old); - return $error if $error; -} - -=item suspend - -Just returns false (no error) for now. - -Called by the suspend method of FS::cust_pkg (see L). - -=item unsuspend - -Just returns false (no error) for now. - -Called by the unsuspend method of FS::cust_pkg (see L). - -=item cancel - -Just returns false (no error) for now. - -Called by the cancel method of FS::cust_pkg (see L). - -=item check - -Checks all fields to make sure this is a valid domain. If there is an error, -returns the error, otherwise returns false. Called by the insert and replace -methods. - -Sets any fixed values; see L. - -=cut - -sub check { - my $self = shift; - - my $x = $self->setfixed; - return $x unless ref($x); - #my $part_svc = $x; - - my $error = $self->ut_numbern('svcnum') - || $self->ut_numbern('catchall') - ; - return $error if $error; - - #hmm - my $pkgnum; - if ( $self->svcnum ) { - my $cust_svc = qsearchs( 'cust_svc', { 'svcnum' => $self->svcnum } ); - $pkgnum = $cust_svc->pkgnum; - } else { - $pkgnum = $self->pkgnum; - } - - my($recref) = $self->hashref; - - unless ( $whois_hack ) { - unless ( $self->email ) { #find out an email address - my @svc_acct; - foreach ( qsearch( 'cust_svc', { 'pkgnum' => $pkgnum } ) ) { - my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $_->svcnum } ); - push @svc_acct, $svc_acct if $svc_acct; - } - - if ( scalar(@svc_acct) == 0 ) { - return "Must order an account in package ". $pkgnum. " first"; - } elsif ( scalar(@svc_acct) > 1 ) { - return "More than one account in package ". $pkgnum. ": specify admin contact email"; - } else { - $self->email($svc_acct[0]->email ); - } - } - } - - #if ( $recref->{domain} =~ /^([\w\-\.]{1,22})\.(com|net|org|edu)$/ ) { - if ( $recref->{domain} =~ /^([\w\-]{1,22})\.(com|net|org|edu)$/ ) { - $recref->{domain} = "$1.$2"; - # hmmmmmmmm. - } elsif ( $whois_hack && $recref->{domain} =~ /^([\w\-\.]+)$/ ) { - $recref->{domain} = $1; - } else { - return "Illegal domain ". $recref->{domain}. - " (or unknown registry - try \$whois_hack)"; - } - - $recref->{action} =~ /^(M|N)$/ or return "Illegal action"; - $recref->{action} = $1; - - my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $recref->{catchall} } ); - return "Unknown catchall" unless $svc_acct || ! $recref->{catchall}; - - $self->ut_textn('purpose'); - -} - -=item domain_record - -=cut - -sub domain_record { - my $self = shift; - - my %order = ( - SOA => 1, - NS => 2, - MX => 3, - CNAME => 4, - A => 5, - ); - - sort { $order{$a->rectype} <=> $order{$b->rectype} } - qsearch('domain_record', { svcnum => $self->svcnum } ); - -} - -=item whois - -Returns the Net::Whois::Domain object (see L) for this domain, or -undef if the domain is not found in whois. - -(If $FS::svc_domain::whois_hack is true, returns that in all cases instead.) - -=cut - -sub whois { - $whois_hack or new Net::Whois::Domain $_[0]->domain; -} - -=item _whois - -Depriciated. - -=cut - -sub _whois { - die "_whois depriciated"; -} - -=item submit_internic - -Submits a registration email for this domain. - -=cut - -sub submit_internic { - #my $self = shift; - carp "submit_internic depreciated"; -} - -=back - -=head1 VERSION - -$Id: svc_domain.pm,v 1.31 2002-06-10 02:52:48 ivan Exp $ - -=head1 BUGS - -All BIND/DNS fields should be included (and exported). - -Delete doesn't send a registration template. - -All registries should be supported. - -Should change action to a real field. - -The $recref stuff in sub check should be cleaned up. - -=head1 SEE ALSO - -L, L, L, L, -L, L, L, L, -L, schema.html from the base documentation, config.html from the -base documentation. - -=cut - -1; - - diff --git a/FS/FS/svc_forward.pm b/FS/FS/svc_forward.pm deleted file mode 100644 index 1c5b5c40d..000000000 --- a/FS/FS/svc_forward.pm +++ /dev/null @@ -1,470 +0,0 @@ -package FS::svc_forward; - -use strict; -use vars qw( @ISA $nossh_hack $conf $shellmachine @qmailmachines - @vpopmailmachines ); -use Net::SSH qw(ssh); -use FS::Conf; -use FS::Record qw( fields qsearch qsearchs dbh ); -use FS::svc_Common; -use FS::cust_svc; -use FS::svc_acct; -use FS::svc_domain; - -@ISA = qw( FS::svc_Common ); - -#ask FS::UID to run this stuff for us later -$FS::UID::callback{'FS::svc_forward'} = sub { - $conf = new FS::Conf; - if ( $conf->exists('qmailmachines') ) { - $shellmachine = $conf->config('shellmachine') - } else { - $shellmachine = ''; - } - if ( $conf->exists('vpopmailmachines') ) { - @vpopmailmachines = $conf->config('vpopmailmachines'); - } else { - @vpopmailmachines = (); - } -}; - -=head1 NAME - -FS::svc_forward - Object methods for svc_forward records - -=head1 SYNOPSIS - - use FS::svc_forward; - - $record = new FS::svc_forward \%hash; - $record = new FS::svc_forward { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - - $error = $record->suspend; - - $error = $record->unsuspend; - - $error = $record->cancel; - -=head1 DESCRIPTION - -An FS::svc_forward object represents a mail forwarding alias. FS::svc_forward -inherits from FS::Record. The following fields are currently supported: - -=over 4 - -=item svcnum - primary key (assigned automatcially for new accounts) - -=item srcsvc - svcnum of the source of the forward (see L) - -=item dstsvc - svcnum of the destination of the forward (see L) - -=item dst - foreign destination (email address) - forward not local to freeside - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new mail forwarding alias. To add the mail forwarding alias to the -database, see L<"insert">. - -=cut - -sub table { 'svc_forward'; } - -=item insert - -Adds this mail forwarding alias to the database. If there is an error, returns -the error, otherwise returns false. - -The additional fields pkgnum and svcpart (see L) should be -defined. An FS::cust_svc record will be created and inserted. - -If the configuration value (see L) vpopmailmachines exists, then -the command: - - [ -d $vpopdir/domains/$domain/$source ] && { - echo "$destination" >> $vpopdir/domains/$domain/$username/.$qmail - chown $vpopuid:$vpopgid $vpopdir/domains/$domain/$username/.$qmail - } - -is executed on each vpopmailmachine via ssh (see the vpopmail documentation). -This behaviour can be supressed by setting $FS::svc_forward::nossh_hack true. - -=cut - -sub insert { - my $self = shift; - my $error; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - $error = $self->check; - return $error if $error; - - $error = $self->SUPER::insert; - if ($error) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $self->srcsvc } ); - my $username = $svc_acct->username; - my $domain = $svc_acct->domain; - my $destination; - if ($self->dstsvc) { - $destination = $self->dstsvc_acct->email; - } else { - $destination = $self->dst; - } - - foreach my $vpopmailmachine ( @vpopmailmachines ) { - my($machine, $vpopdir, $vpopuid, $vpopgid) = split(/\s+/, $vpopmailmachine); - my $queue = new FS::queue { - 'svcnum' => $self->svcnum, - 'job' => 'Net::SSH::ssh_cmd', - }; - # should be neater - my $error = $queue->insert("root\@$machine","[ -d $vpopdir/domains/$domain/$username ] && { echo \"$destination\" >> $vpopdir/domains/$domain/$username/.qmail; chown $vpopuid:$vpopgid $vpopdir/domains/$domain/$username/.qmail; }") - unless $nossh_hack; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; #no error - -} - -=item delete - -Deletes this mail forwarding alias from the database. If there is an error, -returns the error, otherwise returns false. - -The corresponding FS::cust_svc record will be deleted as well. - -If the configuration value vpopmailmachines exists, then the command: - - { sed -e '/^$destination/d' < - $vpopdir/domains/$srcdomain/$srcusername/.qmail > - $vpopdir/domains/$srcdomain/$srcusername/.qmail.temp; - mv $vpopdir/domains/$srcdomain/$srcusername/.qmail.temp - $vpopdir/domains/$srcdomain/$srcusername/.qmail; - chown $vpopuid.$vpopgid $vpopdir/domains/$srcdomain/$srcusername/.qmail; } - - -is executed on each vpopmailmachine via ssh. This behaviour can be supressed -by setting $FS::svc_forward_nossh_hack true. - -=cut - -sub delete { - my $self = shift; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::Autocommit = 0; - my $dbh = dbh; - - my $error = $self->SUPER::delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - my $svc_acct = $self->srcsvc_acct; - my $username = $svc_acct->username; - my $domain = $svc_acct->domain; - my $destination; - if ($self->dstsvc) { - $destination = $self->dstsvc_acct->email; - } else { - $destination = $self->dst; - } - foreach my $vpopmailmachine ( @vpopmailmachines ) { - my($machine, $vpopdir, $vpopuid, $vpopgid) = - split(/\s+/, $vpopmailmachine); - my $queue = new FS::queue { 'job' => 'Net::SSH::ssh_cmd' }; - # should be neater - my $error = $queue->insert("root\@$machine", - "sed -e '/^$destination/d' " . - "< $vpopdir/domains/$domain/$username/.qmail" . - "> $vpopdir/domains/$domain/$username/.qmail.temp; " . - "mv $vpopdir/domains/$domain/$username/.qmail.temp " . - "$vpopdir/domains/$domain/$username/.qmail; " . - "chown $vpopuid.$vpopgid $vpopdir/domains/$domain/$username/.qmail;" - ) - unless $nossh_hack; - - if ($error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; -} - - -=item replace OLD_RECORD - -Replaces OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -If the configuration value vpopmailmachines exists, then the command: - - { sed -e '/^$destination/d' < - $vpopdir/domains/$srcdomain/$srcusername/.qmail > - $vpopdir/domains/$srcdomain/$srcusername/.qmail.temp; - mv $vpopdir/domains/$srcdomain/$srcusername/.qmail.temp - $vpopdir/domains/$srcdomain/$srcusername/.qmail; - chown $vpopuid.$vpopgid $vpopdir/domains/$srcdomain/$srcusername/.qmail; } - - -is executed on each vpopmailmachine via ssh. This behaviour can be supressed -by setting $FS::svc_forward_nossh_hack true. - -Also, if the configuration value vpopmailmachines exists, then the command: - - [ -d $vpopdir/domains/$domain/$source ] && { - echo "$destination" >> $vpopdir/domains/$domain/$username/.$qmail - chown $vpopuid:$vpopgid $vpopdir/domains/$domain/$username/.$qmail - } - -is executed on each vpopmailmachine via ssh. This behaviour can be supressed -by setting $FS::svc_forward_nossh_hack true. - -=cut - -sub replace { - my ( $new, $old ) = ( shift, shift ); - - if ( $new->srcsvc != $old->srcsvc - && ( $new->dstsvc != $old->dstsvc - || ! $new->dstsvc && $new->dst ne $old->dst - ) - ) { - return "Can't change both source and destination of a mail forward!" - } - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $error = $new->SUPER::replace($old); - if ($error) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - my $old_svc_acct = $old->srcsvc_acct; - my $old_username = $old_svc_acct->username; - my $old_domain = $old_svc_acct->domain; - my $destination; - if ($old->dstsvc) { - $destination = $old->dstsvc_acct->email; - } else { - $destination = $old->dst; - } - foreach my $vpopmailmachine ( @vpopmailmachines ) { - my($machine, $vpopdir, $vpopuid, $vpopgid) = - split(/\s+/, $vpopmailmachine); - my $queue = new FS::queue { - 'svcnum' => $new->svcnum, - 'job' => 'Net::SSH::ssh_cmd', - }; - # should be neater - my $error = $queue->insert("root\@$machine", - "sed -e '/^$destination/d' " . - "< $vpopdir/domains/$old_domain/$old_username/.qmail" . - "> $vpopdir/domains/$old_domain/$old_username/.qmail.temp; " . - "mv $vpopdir/domains/$old_domain/$old_username/.qmail.temp " . - "$vpopdir/domains/$old_domain/$old_username/.qmail; " . - "chown $vpopuid.$vpopgid " . - "$vpopdir/domains/$old_domain/$old_username/.qmail;" - ) - unless $nossh_hack; - - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - } - - #false laziness with stuff in insert, should subroutine - my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $new->srcsvc } ); - my $username = $svc_acct->username; - my $domain = $svc_acct->domain; - if ($new->dstsvc) { - $destination = $new->dstsvc_acct->email; - } else { - $destination = $new->dst; - } - - foreach my $vpopmailmachine ( @vpopmailmachines ) { - my($machine, $vpopdir, $vpopuid, $vpopgid) = split(/\s+/, $vpopmailmachine); - my $queue = new FS::queue { - 'svcnum' => $new->svcnum, - 'job' => 'Net::SSH::ssh_cmd', - }; - # should be neater - my $error = $queue->insert("root\@$machine","[ -d $vpopdir/domains/$domain/$username ] && { echo \"$destination\" >> $vpopdir/domains/$domain/$username/.qmail; chown $vpopuid:$vpopgid $vpopdir/domains/$domain/$username/.qmail; }") - unless $nossh_hack; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - } - #end subroutinable bits - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; -} - -=item suspend - -Just returns false (no error) for now. - -Called by the suspend method of FS::cust_pkg (see L). - -=item unsuspend - -Just returns false (no error) for now. - -Called by the unsuspend method of FS::cust_pkg (see L). - -=item cancel - -Just returns false (no error) for now. - -Called by the cancel method of FS::cust_pkg (see L). - -=item check - -Checks all fields to make sure this is a valid mail forwarding alias. If there -is an error, returns the error, otherwise returns false. Called by the insert -and replace methods. - -Sets any fixed values; see L. - -=cut - -sub check { - my $self = shift; - - my $x = $self->setfixed; - return $x unless ref($x); - #my $part_svc = $x; - - my $error = $self->ut_numbern('svcnum') - || $self->ut_number('srcsvc') - || $self->ut_numbern('dstsvc') - ; - return $error if $error; - - return "Unknown srcsvc" unless $self->srcsvc_acct; - - return "Both dstsvc and dst were defined; only one can be specified" - if $self->dstsvc && $self->dst; - - return "one of dstsvc or dst is required" - unless $self->dstsvc || $self->dst; - - #return "Unknown dstsvc: $dstsvc" unless $self->dstsvc_acct || ! $self->dstsvc; - return "Unknown dstsvc" - unless qsearchs('svc_acct', { 'svcnum' => $self->dstsvc } ) - || ! $self->dstsvc; - - - if ( $self->dst ) { - $self->dst =~ /^([\w\.\-]+)\@(([\w\-]+\.)+\w+)$/ - or return "Illegal dst: ". $self->dst; - $self->dst("$1\@$2"); - } else { - $self->dst(''); - } - - ''; #no error -} - -=item srcsvc_acct - -Returns the FS::svc_acct object referenced by the srcsvc column. - -=cut - -sub srcsvc_acct { - my $self = shift; - qsearchs('svc_acct', { 'svcnum' => $self->srcsvc } ); -} - -=item dstsvc_acct - -Returns the FS::svc_acct object referenced by the srcsvc column, or false for -forwards not local to freeside. - -=cut - -sub dstsvc_acct { - my $self = shift; - qsearchs('svc_acct', { 'svcnum' => $self->dstsvc } ); -} - -=back - -=head1 VERSION - -$Id: svc_forward.pm,v 1.12 2002-05-31 17:50:37 ivan Exp $ - -=head1 BUGS - -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. - -=cut - -1; - diff --git a/FS/FS/svc_www.pm b/FS/FS/svc_www.pm deleted file mode 100644 index d7a42c8ae..000000000 --- a/FS/FS/svc_www.pm +++ /dev/null @@ -1,276 +0,0 @@ -package FS::svc_www; - -use strict; -use vars qw(@ISA $conf $apacheip); -#use FS::Record qw( qsearch qsearchs ); -use FS::Record qw( qsearchs dbh ); -use FS::svc_Common; -use FS::cust_svc; -use FS::domain_record; -use FS::svc_acct; -use FS::svc_domain; - -@ISA = qw( FS::svc_Common ); - -#ask FS::UID to run this stuff for us later -$FS::UID::callback{'FS::svc_www'} = sub { - $conf = new FS::Conf; - $apacheip = $conf->config('apacheip'); -}; - -=head1 NAME - -FS::svc_www - Object methods for svc_www records - -=head1 SYNOPSIS - - use FS::svc_www; - - $record = new FS::svc_www \%hash; - $record = new FS::svc_www { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - - $error = $record->suspend; - - $error = $record->unsuspend; - - $error = $record->cancel; - -=head1 DESCRIPTION - -An FS::svc_www object represents an web virtual host. FS::svc_www inherits -from FS::svc_Common. The following fields are currently supported: - -=over 4 - -=item svcnum - primary key - -=item recnum - DNS `A' record corresponding to this web virtual host. (see L) - -=item usersvc - account (see L) corresponding to this web virtual host. - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new web virtual host. To add the record to the database, see -L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I method. - -=cut - -sub table { 'svc_www'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -The additional fields pkgnum and svcpart (see L) should be -defined. An FS::cust_svc record will be created and inserted. - -=cut - -sub insert { - my $self = shift; - - my $error = $self->check; - return $error if $error; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - #if ( $self->recnum =~ /^([\w\-]+|\@)\.(([\w\.\-]+\.)+\w+)$/ ) { - if ( $self->recnum =~ /^([\w\-]+|\@)\.(\d+)$/ ) { - my( $reczone, $domain_svcnum ) = ( $1, $2 ); - unless ( $apacheip ) { - $dbh->rollback if $oldAutoCommit; - return "Configuration option apacheip not set; can't autocreate A record"; - #"for $reczone". $svc_domain->domain; - } - my $domain_record = new FS::domain_record { - 'svcnum' => $domain_svcnum, - 'reczone' => $reczone, - 'recaf' => 'IN', - 'rectype' => 'A', - 'recdata' => $apacheip, - }; - $error = $domain_record->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - $self->recnum($domain_record->recnum); - } - - $error = $self->SUPER::insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; -} - -=item delete - -Delete this record from the database. - -=cut - -sub delete { - my $self = shift; - my $error; - - $error = $self->SUPER::delete; - return $error if $error; - - ''; -} - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -sub replace { - my ( $new, $old ) = ( shift, shift ); - my $error; - - $error = $new->SUPER::replace($old); - return $error if $error; - - ''; -} - -=item suspend - -Called by the suspend method of FS::cust_pkg (see L). - -=item unsuspend - -Called by the unsuspend method of FS::cust_pkg (see L). - -=item cancel - -Called by the cancel method of FS::cust_pkg (see L). - -=item check - -Checks all fields to make sure this is a valid web virtual host. If there is -an error, returns the error, otherwise returns false. Called by the insert -and repalce methods. - -=cut - -sub check { - my $self = shift; - - my $x = $self->setfixed; - return $x unless ref($x); - #my $part_svc = $x; - - my $error = - $self->ut_numbern('svcnum') -# || $self->ut_number('recnum') - || $self->ut_number('usersvc') - ; - return $error if $error; - - if ( $self->recnum =~ /^(\d+)$/ ) { - - $self->recnum($1); - return "Unknown recnum: ". $self->recnum - unless qsearchs('domain_record', { 'recnum' => $self->recnum } ); - - } elsif ( $self->recnum =~ /^([\w\-]+|\@)\.(([\w\.\-]+\.)+\w+)$/ ) { - - my( $reczone, $domain ) = ( $1, $2 ); - - my $svc_domain = qsearchs( 'svc_domain', { 'domain' => $domain } ) - or return "unknown domain $domain (recnum $1.$2)"; - - my $domain_record = qsearchs( 'domain_record', { - 'reczone' => $reczone, - 'svcnum' => $svc_domain->svcnum, - }); - - if ( $domain_record ) { - $self->recnum($domain_record->recnum); - } else { - #insert will create it - #$self->recnum("$reczone.$domain"); - $self->recnum("$reczone.". $svc_domain->svcnum); - } - - } else { - return "Illegal recnum: ". $self->recnum; - } - - return "Unknown usersvc (svc_acct.svcnum): ". $self->usersvc - unless qsearchs('svc_acct', { 'svcnum' => $self->usersvc } ); - - ''; #no error -} - -=item domain_record - -Returns the FS::domain_record record for this web virtual host's zone (see -L). - -=cut - -sub domain_record { - my $self = shift; - qsearchs('domain_record', { 'recnum' => $self->recnum } ); -} - -=item svc_acct - -Returns the FS::svc_acct record for this web virtual host's owner (see -L). - -=cut - -sub svc_acct { - my $self = shift; - qsearchs('svc_acct', { 'svcnum' => $self->usersvc } ); -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L, L, L, L, -L, L, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/type_pkgs.pm b/FS/FS/type_pkgs.pm deleted file mode 100644 index 8e0d4ef56..000000000 --- a/FS/FS/type_pkgs.pm +++ /dev/null @@ -1,113 +0,0 @@ -package FS::type_pkgs; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearchs ); -use FS::agent_type; -use FS::part_pkg; - -@ISA = qw( FS::Record ); - -=head1 NAME - -FS::type_pkgs - Object methods for type_pkgs records - -=head1 SYNOPSIS - - use FS::type_pkgs; - - $record = new FS::type_pkgs \%hash; - $record = new FS::type_pkgs { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::type_pkgs record links an agent type (see L) to a -billing item definition (see L). FS::type_pkgs inherits from -FS::Record. The following fields are currently supported: - -=over 4 - -=item typenum - Agent type, see L - -=item pkgpart - Billing item definition, see L - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Create a new record. To add the record to the database, see L<"insert">. - -=cut - -sub table { 'type_pkgs'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=item delete - -Deletes this record from the database. If there is an error, returns the -error, otherwise returns false. - -=item replace OLD_RECORD - -Replaces OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=item check - -Checks all fields to make sure this is a valid record. If there is an error, -returns the error, otherwise returns false. Called by the insert and replace -methods. - -=cut - -sub check { - my $self = shift; - - my $error = - $self->ut_number('typenum') - || $self->ut_number('pkgpart') - ; - return $error if $error; - - return "Unknown typenum" - unless qsearchs( 'agent_type', { 'typenum' => $self->typenum } ); - - return "Unknown pkgpart" - unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } ); - - ''; #no error -} - -=back - -=head1 VERSION - -$Id: type_pkgs.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ - -=head1 BUGS - -=head1 SEE ALSO - -L, L, L, schema.html from the base -documentation. - -=cut - -1; - diff --git a/FS/MANIFEST b/FS/MANIFEST deleted file mode 100644 index 8355e40fb..000000000 --- a/FS/MANIFEST +++ /dev/null @@ -1,168 +0,0 @@ -Changes -MANIFEST -MANIFEST.SKIP -Makefile.PL -README -bin/freeside-bill -bin/freeside-daily -bin/freeside-email -bin/freeside-queued -bin/freeside-apply-credits -bin/freeside-adduser -bin/freeside-setinvoice -bin/freeside-overdue -bin/freeside-receivables-report -bin/freeside-tax-report -bin/freeside-cc-receipts-report -bin/freeside-credit-report -bin/freeside-expiration-alerter -bin/freeside-reexport -FS.pm -FS/CGI.pm -FS/InitHandler.pm -FS/ClientAPI.pm -FS/ClientAPI/passwd.pm -FS/ClientAPI/MyAccount.pm -FS/Conf.pm -FS/ConfItem.pm -FS/Record.pm -FS/SearchCache.pm -FS/UI/Base.pm -FS/UI/CGI.pm -FS/UI/Gtk.pm -FS/UI/agent.pm -FS/UID.pm -FS/Msgcat.pm -FS/agent.pm -FS/agent_type.pm -FS/cust_bill.pm -FS/cust_bill_pkg.pm -FS/cust_credit.pm -FS/cust_credit_bill.pm -FS/cust_main.pm -FS/cust_main_county.pm -FS/cust_main_invoice.pm -FS/cust_pay.pm -FS/cust_bill_event.pm -FS/cust_bill_pay.pm -FS/cust_pay_batch.pm -FS/cust_pkg.pm -FS/cust_refund.pm -FS/cust_credit_refund.pm -FS/cust_svc.pm -FS/part_bill_event.pm -FS/export_svc.pm -FS/part_export.pm -FS/part_export_option.pm -FS/part_export/bind.pm -FS/part_export/bind_slave.pm -FS/part_export/bsdshell.pm -FS/part_export/cp.pm -FS/part_export/cyrus.pm -FS/part_export/http.pm -FS/part_export/infostreet.pm -FS/part_export/null.pm -FS/part_export/shellcommands.pm -FS/part_export/shellcommands_withdomain.pm -FS/part_export/sqlmail.pm -FS/part_export/sqlradius.pm -FS/part_export/sysvshell.pm -FS/part_export/textradius.pm -FS/part_export/vpopmail.pm -FS/part_export/www_shellcommands.pm -FS/part_pkg.pm -FS/part_pop_local.pm -FS/part_referral.pm -FS/part_svc.pm -FS/part_svc_column.pm -FS/pkg_svc.pm -FS/svc_Common.pm -FS/svc_acct.pm -FS/svc_acct_pop.pm -FS/svc_acct_sm.pm -FS/svc_domain.pm -FS/type_pkgs.pm -FS/nas.pm -FS/port.pm -FS/session.pm -FS/domain_record.pm -FS/prepay_credit.pm -FS/svc_www.pm -FS/svc_forward.pm -FS/raddb.pm -FS/radius_usergroup.pm -FS/queue.pm -FS/queue_arg.pm -FS/queue_depend.pm -FS/msgcat.pm -FS/cust_tax_exempt.pm -t/agent.t -t/agent_type.t -t/CGI.t -t/InitHandler.t -t/ClientAPI.t -t/Conf.t -t/ConfItem.t -t/Record.t -t/UID.t -t/Msgcat.t -t/cust_bill.t -t/cust_bill_event.t -t/cust_bill_pay.t -t/cust_bill_pkg.t -t/cust_credit.t -t/cust_credit_bill.t -t/cust_credit_refund.t -t/cust_main.t -t/cust_main_county.t -t/cust_main_invoice.t -t/cust_pay.t -t/cust_pay_batch.t -t/cust_pkg.t -t/cust_refund.t -t/cust_svc.t -t/domain_record.t -t/nas.t -t/part_bill_event.t -t/export_svc.t -t/part_export.t -t/part_export_option.t -t/part_export-bind.t -t/part_export-bind_slave.t -t/part_export-bsdshell.t -t/part_export-cp.t -t/part_export-cyrus.t -t/part_export-http.t -t/part_export-infostreet.t -t/part_export-null.t -t/part_export-shellcommands.t -t/part_export-shellcommands_withdomain.t -t/part_export-sqlmail.t -t/part_export-sqlradius.t -t/part_export-sysvshell.t -t/part_export-textradius.t -t/part_export-vpopmail.t -t/part_export-www_shellcommands.t -t/part_pkg.t -t/part_pop_local.t -t/part_referral.t -t/part_svc.t -t/part_svc_column.t -t/pkg_svc.t -t/port.t -t/prepay_credit.t -t/radius_usergroup.t -t/session.t -t/svc_acct.t -t/svc_acct_pop.t -t/svc_acct_sm.t -t/svc_Common.t -t/svc_domain.t -t/svc_forward.t -t/svc_www.t -t/type_pkgs.t -t/queue.t -t/queue_arg.t -t/msgcat.t -t/raddb.t -t/cust_tax_exempt.t diff --git a/FS/MANIFEST.SKIP b/FS/MANIFEST.SKIP deleted file mode 100644 index ae335e78a..000000000 --- a/FS/MANIFEST.SKIP +++ /dev/null @@ -1 +0,0 @@ -CVS/ diff --git a/FS/Makefile.PL b/FS/Makefile.PL deleted file mode 100644 index ab4c2281b..000000000 --- a/FS/Makefile.PL +++ /dev/null @@ -1,8 +0,0 @@ -use ExtUtils::MakeMaker; -# See lib/ExtUtils/MakeMaker.pm for details of how to influence -# the contents of the Makefile that is written. -WriteMakefile( - 'NAME' => 'FS', - 'VERSION_FROM' => 'FS.pm', # finds $VERSION - 'EXE_FILES' => [ glob 'bin/*' ], -); diff --git a/FS/README b/FS/README deleted file mode 100644 index d4c35acb4..000000000 --- a/FS/README +++ /dev/null @@ -1,6 +0,0 @@ -This is the Perl module section of Freeside. - -perl Makefile.PL -make -make test -make install diff --git a/FS/bin/freeside-adduser b/FS/bin/freeside-adduser deleted file mode 100644 index 9d424634b..000000000 --- a/FS/bin/freeside-adduser +++ /dev/null @@ -1,57 +0,0 @@ -#!/usr/bin/perl -w -# -# $Id: freeside-adduser,v 1.4 2002-02-06 14:58:05 ivan Exp $ - -use strict; -use vars qw($opt_h $opt_c $opt_s); -use Getopt::Std; - -my $FREESIDE_CONF = "/usr/local/etc/freeside"; - -getopts("ch:s:"); -die &usage if $opt_c && ! $opt_h; -my $user = shift or die &usage; - -if ( $opt_h ) { - my @args = ( 'htpasswd' ); - push @args, '-c' if $opt_c; - push @args, $opt_h, $user; - system(@args) == 0 or die "htpasswd failed: $?"; -} - -my $secretfile = $opt_s || 'secrets'; - -open(MAPSECRETS,">>$FREESIDE_CONF/mapsecrets") - or die "can't open $FREESIDE_CONF/mapsecrets: $!"; -print MAPSECRETS "$user $secretfile\n"; -close MAPSECRETS or die "can't close $FREESIDE_CONF/mapsecrets: $!"; - -sub usage { - die "Usage:\n\n freeside-adduser [ -h htpasswd_file [ -c ] ] [ -s secretfile ] username" -} - -=head1 NAME - -freeside-adduser - Command line interface to add (freeside) users. - -=head1 SYNOPSIS - - freeside-adduser [ -h htpasswd_file [ -c ] ] [ -s secretfile ] username - -=head1 DESCRIPTION - -Adds a user to the Freeside billing system. This is for adding users (internal -sales/tech folks) to the web interface, not for adding customer accounts. - - -h: Also call htpasswd for this user with the given filename - - -c: Passed to htpasswd - - -s: Specify an alternate secret file - -=head1 SEE ALSO - -L, base Freeside documentation - -=cut - diff --git a/FS/bin/freeside-apply-credits b/FS/bin/freeside-apply-credits deleted file mode 100755 index ea6a7bdd0..000000000 --- a/FS/bin/freeside-apply-credits +++ /dev/null @@ -1,21 +0,0 @@ -#!/usr/bin/perl -Tw - -use strict; -use vars qw( $user $cust_main @customers ); -use FS::UID qw(adminsuidsetup); -use FS::Record qw(qsearch); -use FS::cust_main; - -$user = shift or die &usage; -&adminsuidsetup( $user ); - -my @customers = qsearch('cust_main', {} ); -die "No customers" unless (scalar(@customers) > 0); - -foreach $cust_main (@customers) { - print "Applying credits for customer #". $cust_main->custnum; - $cust_main->apply_credits; -} - - - diff --git a/FS/bin/freeside-bill b/FS/bin/freeside-bill deleted file mode 100755 index 49ad4a768..000000000 --- a/FS/bin/freeside-bill +++ /dev/null @@ -1,128 +0,0 @@ -#!/usr/bin/perl -w -# don't take any world-facing input -#!/usr/bin/perl -Tw - -use strict; -use Fcntl qw(:flock); -use Date::Parse; -use Getopt::Std; -use FS::UID qw(adminsuidsetup); -use FS::Record qw(qsearch qsearchs); -use FS::cust_main; - -&untaint_argv; #what it sounds like (eww) -use vars qw($opt_a $opt_c $opt_d $opt_p); -getopts("acd:p"); -my $user = shift or die &usage; - -adminsuidsetup $user; - -my %bill_only = map { $_ => 1 } ( - @ARGV ? @ARGV : ( map $_->custnum, qsearch('cust_main', {} ) ) -); - -#we're at now now (and later). -my($time)= $opt_d ? str2time($opt_d) : $^T; - -# find packages w/ bill < time && cancel != '', and create corresponding -# customer objects - -my($cust_main,%saw); -foreach $cust_main ( - map { - unless ( exists $saw{ $_->custnum } && defined $saw{ $_->custnum} ) { - $saw{ $_->custnum } = 0; # to avoid 'use of uninitialized value' errors - } - if ( - ( $opt_a || ( ( $_->getfield('bill') || 0 ) <= $time ) ) - && $bill_only{ $_->custnum } - && !$saw{ $_->custnum }++ - ) { - qsearchs('cust_main',{'custnum'=> $_->custnum } ); - } else { - (); - } - } ( qsearch('cust_pkg', { 'cancel' => '' }), - qsearch('cust_pkg', { 'cancel' => 0 }), - ) -) { - - # and bill them - - print "Billing customer #" . $cust_main->getfield('custnum') . "\n"; - - my($error); - - $error=$cust_main->bill('time'=>$time); - warn "Error billing, customer #" . $cust_main->getfield('custnum') . - ":" . $error if $error; - - if ($opt_p) { - $cust_main->apply_payments; - $cust_main->apply_credits; - } - - if ($opt_c) { - $error=$cust_main->collect( 'invoice_time' => $time); - warn "Error collecting from customer #" . $cust_main->custnum. ":$error" - if $error; - - #sleep 1; - } - -} - -# subroutines - -sub untaint_argv { - foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV - #$ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal arguement \"$ARGV[$_]\""; - # Date::Parse - $ARGV[$_] =~ /^(.*)$/ || die "Illegal arguement \"$ARGV[$_]\""; - $ARGV[$_]=$1; - } -} - -sub usage { - die "Usage:\n\n freeside-bill [ -c [ -p ] ] [ -d 'date' ] user [ custnum custnum ... ]\n"; -} - -=head1 NAME - -freeside-bill - Command line (crontab, script) interface to customer billing. - -=head1 SYNOPSIS - - freeside-bill [ -c [ -p ] [ -a ] ] [ -d 'date' ] user [ custnum custnum ... ] - -=head1 DESCRIPTION - -This script is deprecated in 1.4.0. You should use freeside-daily instead. - -Bills customers. Searches for customers who are due for billing and calls -the bill and collect methods of a cust_main object. See L. - - -c: Turn on collecting (you probably want this). - - -p: Apply unapplied payments and credits before collecting (you probably want - this too) - - -a: Call collect even if there isn't a new invoice (probably a bad idea for - daily use) - - -d: Pretend it's 'date'. Date is in any format Date::Parse is happy with, - but be careful. - -user: From the mapsecrets file - see config.html from the base documentation - -custnum: if one or more customer numbers are specified, only bills those -customers. Otherwise, bills all customers. - -=head1 BUGS - -=head1 SEE ALSO - -L, L, config.html from the base documentation - -=cut - diff --git a/FS/bin/freeside-cc-receipts-report b/FS/bin/freeside-cc-receipts-report deleted file mode 100755 index 06e3aba81..000000000 --- a/FS/bin/freeside-cc-receipts-report +++ /dev/null @@ -1,270 +0,0 @@ -#!/usr/bin/perl -Tw - - -use strict; -use Date::Parse; -use Time::Local; -use Getopt::Std; -use Text::Template; -use Net::SMTP; -use Mail::Header; -use Mail::Internet; -use FS::Conf; -use FS::UID qw(adminsuidsetup); -use FS::Record qw(qsearch qsearchs); -use FS::cust_pay; -use FS::cust_pay_batch; - - -&untaint_argv; #what it sounds like (eww) -use vars qw($opt_v $opt_p $opt_m $opt_e $opt_t $opt_s $opt_f $report_lines $report_template @buf $header); -getopts("vpmef:s:"); #switches - -#we're at now now (and later). -my($_finishdate)= $opt_f ? str2time($main::opt_f) : $^T; -my($_startdate)= $opt_s ? str2time($main::opt_s) : $^T; - -# Get the current month -my ($ssec,$smin,$shour,$smday,$smon,$syear) = - (localtime($_startdate) )[0,1,2,3,4,5]; -$smon++; -$syear += 1900; - -# Get the current month -my ($fsec,$fmin,$fhour,$fmday,$fmon,$fyear) = - (localtime($_finishdate) )[0,1,2,3,4,5]; -$fmon++; -$fyear += 1900; - -# Login to the database -my $user = shift or die &usage; -adminsuidsetup $user; - -# Get the needed configuration files -my $conf = new FS::Conf; -my $lpr = $conf->config('lpr'); -my $email = $conf->config('email'); -my $smtpmachine = $conf->config('smtpmachine'); -my $mail_sender = $conf->exists('invoice_from') ? $conf->config('invoice_from') : - 'postmaster'; -my @report_template = $conf->config('report_template') - or die "cannot load config file report_template"; -$report_lines = 0; -foreach ( grep /report_lines\(\d+\)/, @report_template ) { #kludgy :/ - /report_lines\((\d+)\)/; - $report_lines += $1; -} -die "no report_lines() functions in template?" unless $report_lines; -$report_template = new Text::Template ( - TYPE => 'ARRAY', - SOURCE => [ map "$_\n", @report_template ], -) or die "can't create new Text::Template object: $Text::Template::ERROR"; - - -my(@cust_pays)=qsearch('cust_pay',{}); -if (scalar(@cust_pays) == 0) -{ - exit 1; -} - -# Open print and email pipes -# $lpr and opt_p for printing -# $email and opt_m for email - -if ($lpr && $main::opt_p) -{ - open(LPR, "|$lpr"); -} - -if ($email && $main::opt_m) -{ - $ENV{MAILADDRESS} = $mail_sender; - $header = new Mail::Header ( [ - "From: Account Processor", - "To: $email", - "Sender: $mail_sender", - "Reply-To: $mail_sender", - "Subject: Credit Card Receipts", - ] ); -} - -my $uninvoiced = 0; -my $total = 0; -my $taxed = 0; -my $untaxed = 0; -my $total_tax = 0; - -# Now I can start looping -foreach my $cust_pay (@cust_pays) -{ - my $_date = $cust_pay->getfield('_date'); - my $invnum = $cust_pay->getfield('invnum'); - my $paid = $cust_pay->getfield('paid'); - my $payby = $cust_pay->getfield('payby'); - - - if ($_date >= $_startdate && $_date <= $_finishdate && $payby =~ 'CARD') { - $total += $paid; - - $uninvoiced += $cust_pay->unapplied; - my @cust_bill_pays = $cust_pay->cust_bill_pay; - foreach my $cust_bill_pay (@cust_bill_pays) { - my $invoice_amt =0; - my $invoice_tax =0; - my(@cust_bill_pkgs)= $cust_bill_pay->cust_bill->cust_bill_pkg; - foreach my $cust_bill_pkg (@cust_bill_pkgs) { - - my $recur = $cust_bill_pkg->getfield('recur'); - my $setup = $cust_bill_pkg->getfield('setup'); - my $pkgnum = $cust_bill_pkg->getfield('pkgnum'); - - if ($pkgnum == 0) { - $invoice_tax += $recur; - $invoice_tax += $setup; - } else { - $invoice_amt += $recur; - $invoice_amt += $setup; - } - - } - - if ($invoice_tax > 0) { - if ($invoice_amt != $paid) { - # attempt to prorate partially paid invoices - $total_tax += $paid / ($invoice_amt + $invoice_tax) * $invoice_tax; - $taxed += $paid / ($invoice_amt + $invoice_tax) * $invoice_amt; - } else { - $total_tax += $invoice_tax; - $taxed += $invoice_amt; - } - } else { - $untaxed += $paid; - } - - } - - } - -} - -push @buf, sprintf(qq{\n%25s%14.2f\n}, "Uninvoiced", $uninvoiced); -push @buf, sprintf(qq{%25s%14.2f\n}, "Untaxed", $untaxed); -push @buf, sprintf(qq{%25s%14.2f\n}, "Taxed", $taxed); -push @buf, sprintf(qq{%25s%14.2f\n}, "Tax", $total_tax); -push @buf, sprintf(qq{\n%39s\n%39.2f\n}, "=========", $total); - -sub FS::cc_receipts_report::_template::report_lines { - my $lines = shift; - map { - scalar(@buf) ? shift @buf : '' ; - } - ( 1 .. $lines ); -} - -$FS::cc_receipts_report::_template::title = qq~CREDIT CARD RECEIPTS for period $smon/$smday/$syear through $fmon/$fmday/$fyear~; -$FS::cc_receipts_report::_template::title = $opt_t if $opt_t; -$FS::cc_receipts_report::_template::page = 1; -$FS::cc_receipts_report::_template::date = $^T; -$FS::cc_receipts_report::_template::date = $^T; -$FS::cc_receipts_report::_template::fdate = $_finishdate; -$FS::cc_receipts_report::_template::fdate = $_finishdate; -$FS::cc_receipts_report::_template::sdate = $_startdate; -$FS::cc_receipts_report::_template::sdate = $_startdate; -$FS::cc_receipts_report::_template::total_pages = - int( scalar(@buf) / $report_lines); -$FS::cc_receipts_report::_template::total_pages++ if scalar(@buf) % $report_lines; - -my @report; -while (@buf) { - push @report, split("\n", - $report_template->fill_in( PACKAGE => 'FS::cc_receipts_report::_template' ) - ); - $FS::cc_receipts_report::_template::page++; -} - -if ($opt_v) { - print map "$_\n", @report; -} -if($lpr && $opt_p) -{ - print LPR map "$_\n", @report; - print LPR "\f" if $opt_e; - close LPR || die "Could not close printer: $lpr\n"; -} -if($email && $opt_m) -{ - my $message = new Mail::Internet ( - 'Header' => $header, - 'Body' => [ (@report) ], - ); - $!=0; - $message->smtpsend( Host => "$smtpmachine" ) - or die "can't send report to $email via $smtpmachine: $!"; -} - - -# subroutines -sub untaint_argv { - foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV - $ARGV[$_] =~ /^([\w\-\/ :]*)$/ || die "Illegal argument \"$ARGV[$_]\""; - $ARGV[$_]=$1; - } -} - -sub usage { - die "Usage:\n\n freeside-cc-receipts-report [-v] [-p] [-e] user\n"; -} - -=head1 NAME - -freeside-cc-receipts-report - Prints or emails total credit card receipts in a given period. - -=head1 SYNOPSIS - - freeside-cc-receipts-report [-v] [-p] [-m] [-e] [-t "title"] [-s date] [-f date] user - -=head1 DESCRIPTION - -Prints or emails sales taxes invoiced in a given period. - --v: Verbose - Prints records to STDOUT. - --p: Print to printer lpr as found in the conf directory. - --m: Email output to user found in the Conf email file. - --e: Print a final form feed to the printer. - --t: supply a title for the top of each page. - --s: starting date for inclusion - --f: final date for inclusion - -user: From the mapsecrets file - see config.html from the base documentation - -=head1 VERSION - -$Id: freeside-cc-receipts-report,v 1.4 2002-03-07 19:50:23 jeff Exp $ - -=head1 BUGS - -Yes..... Use at your own risk. No guarantees or warrantees of any -kind apply to this program. Parts of this program are hacked from -other GNU licensed software created mainly by Ivan Kohler. - -This is released under the GNU Public License. See www.gnu.org -for more information regarding this license. - -=head1 SEE ALSO - -L, config.html from the base documentation - -=head1 AUTHOR - -Jeff Finucane - -based on print-batch by Joel Griffiths - -=cut - diff --git a/FS/bin/freeside-credit-report b/FS/bin/freeside-credit-report deleted file mode 100755 index 7699daf4d..000000000 --- a/FS/bin/freeside-credit-report +++ /dev/null @@ -1,224 +0,0 @@ -#!/usr/bin/perl -Tw - - -use strict; -use Date::Parse; -use Time::Local; -use Getopt::Std; -use Text::Template; -use Net::SMTP; -use Mail::Header; -use Mail::Internet; -use FS::Conf; -use FS::UID qw(adminsuidsetup); -use FS::Record qw(qsearch); -use FS::cust_credit; - - -&untaint_argv; #what it sounds like (eww) -use vars qw($opt_v $opt_p $opt_m $opt_e $opt_t $opt_s $opt_f $report_lines $report_template @buf $header); -getopts("vpmef:s:"); #switches - -#we're at now now (and later). -my($_finishdate)= $opt_f ? str2time($main::opt_f) : $^T; -my($_startdate)= $opt_s ? str2time($main::opt_s) : $^T; - -# Get the current month -my ($ssec,$smin,$shour,$smday,$smon,$syear) = - (localtime($_startdate) )[0,1,2,3,4,5]; -$smon++; -$syear += 1900; - -# Get the current month -my ($fsec,$fmin,$fhour,$fmday,$fmon,$fyear) = - (localtime($_finishdate) )[0,1,2,3,4,5]; -$fmon++; -$fyear += 1900; - -# Login to the database -my $user = shift or die &usage; -adminsuidsetup $user; - -# Get the needed configuration files -my $conf = new FS::Conf; -my $lpr = $conf->config('lpr'); -my $email = $conf->config('email'); -my $smtpmachine = $conf->config('smtpmachine'); -my $mail_sender = $conf->exists('invoice_from') ? $conf->config('invoice_from') : - 'postmaster'; -my @report_template = $conf->config('report_template') - or die "cannot load config file report_template"; -$report_lines = 0; -foreach ( grep /report_lines\(\d+\)/, @report_template ) { #kludgy :/ - /report_lines\((\d+)\)/; - $report_lines += $1; -} -die "no report_lines() functions in template?" unless $report_lines; -$report_template = new Text::Template ( - TYPE => 'ARRAY', - SOURCE => [ map "$_\n", @report_template ], -) or die "can't create new Text::Template object: $Text::Template::ERROR"; - - -my(@cust_credits)=qsearch('cust_credit',{}); -if (scalar(@cust_credits) == 0) -{ - exit 1; -} - -# Open print and email pipes -# $lpr and opt_p for printing -# $email and opt_m for email - -if ($lpr && $main::opt_p) -{ - open(LPR, "|$lpr"); -} - -if ($email && $main::opt_m) -{ - $ENV{MAILADDRESS} = $mail_sender; - $header = new Mail::Header ( [ - "From: Account Processor", - "To: $email", - "Sender: $mail_sender", - "Reply-To: $mail_sender", - "Subject: In House Credits", - ] ); -} - -my $uninvoiced = 0; -my $total = 0; -my $taxed = 0; -my $untaxed = 0; -my $total_tax = 0; - -# Now I can start looping -foreach my $cust_credit (@cust_credits) -{ - my $_date = $cust_credit->getfield('_date'); - my $amount = $cust_credit->getfield('amount'); - - if ($_date >= $_startdate && $_date <= $_finishdate) { - $total += $amount; - } -} - -push @buf, sprintf(qq{\n%25s%14.2f\n}, "Credits Offered", $total); -push @buf, sprintf(qq{\n%39s\n%39.2f\n}, "=========", $total); - -sub FS::credit_report::_template::report_lines { - my $lines = shift; - map { - scalar(@buf) ? shift @buf : '' ; - } - ( 1 .. $lines ); -} - -$FS::credit_report::_template::title = qq~IN HOUSE CREDITS for $smon/$smday/$syear through $fmon/$fmday/$fyear~; -$FS::credit_report::_template::title = $opt_t if $opt_t; -$FS::credit_report::_template::page = 1; -$FS::credit_report::_template::date = $^T; -$FS::credit_report::_template::date = $^T; -$FS::credit_report::_template::fdate = $_finishdate; -$FS::credit_report::_template::fdate = $_finishdate; -$FS::credit_report::_template::sdate = $_startdate; -$FS::credit_report::_template::sdate = $_startdate; -$FS::credit_report::_template::total_pages = - int( scalar(@buf) / $report_lines); -$FS::credit_report::_template::total_pages++ if scalar(@buf) % $report_lines; - -my @report; -while (@buf) { - push @report, split("\n", - $report_template->fill_in( PACKAGE => 'FS::credit_report::_template' ) - ); - $FS::credit_report::_template::page++; -} - -if ($opt_v) { - print map "$_\n", @report; -} -if($lpr && $opt_p) -{ - print LPR map "$_\n", @report; - print LPR "\f" if $opt_e; - close LPR || die "Could not close printer: $lpr\n"; -} -if($email && $opt_m) -{ - my $message = new Mail::Internet ( - 'Header' => $header, - 'Body' => [ (@report) ], - ); - $!=0; - $message->smtpsend( Host => "$smtpmachine" ) - or die "can't send report to $email via $smtpmachine: $!"; -} - - -# subroutines -sub untaint_argv { - foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV - $ARGV[$_] =~ /^([\w\-\/ :]*)$/ || die "Illegal argument \"$ARGV[$_]\""; - $ARGV[$_]=$1; - } -} - -sub usage { - die "Usage:\n\n freeside-credit-report [-v] [-p] [-e] user\n"; -} - -=head1 NAME - -freeside-credit-report - Prints or emails total credit memos in a given period. - -=head1 SYNOPSIS - - freeside-credit-report [-v] [-p] [-m] [-e] [-t "title"] [-s date] [-f date] user - -=head1 DESCRIPTION - -Prints or emails total credit memos in a given period. - --v: Verbose - Prints records to STDOUT. - --p: Print to printer lpr as found in the conf directory. - --m: Email output to user found in the Conf email file. - --e: Print a final form feed to the printer. - --t: supply a title for the top of each page. - --s: starting date for inclusion - --f: final date for inclusion - -user: From the mapsecrets file - see config.html from the base documentation - -=head1 VERSION - -$Id: freeside-credit-report,v 1.4 2002-03-07 19:50:24 jeff Exp $ - -=head1 BUGS - -Yes..... Use at your own risk. No guarantees or warrantees of any -kind apply to this program. Parts of this program are hacked from -other GNU licensed software created mainly by Ivan Kohler. - -This is released under the GNU Public License. See www.gnu.org -for more information regarding this license. - -=head1 SEE ALSO - -L, config.html from the base documentation - -=head1 AUTHOR - -Jeff Finucane - -based on print-batch by Joel Griffiths - -=cut - diff --git a/FS/bin/freeside-daily b/FS/bin/freeside-daily deleted file mode 100755 index 142b0c73a..000000000 --- a/FS/bin/freeside-daily +++ /dev/null @@ -1,99 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use Fcntl qw(:flock); -use Date::Parse; -use Getopt::Std; -use FS::UID qw(adminsuidsetup driver_name dbh); -use FS::Record qw(qsearch qsearchs); -use FS::cust_main; - -&untaint_argv; #what it sounds like (eww) -use vars qw($opt_d $opt_v); -getopts("d:v"); -my $user = shift or die &usage; - -adminsuidsetup $user; - -$FS::cust_main::Debug = 1 if $opt_v; - -my @cust_main = @ARGV - ? map { qsearchs('cust_main', { custnum => $_ } ) } @ARGV - : qsearch('cust_main', {} ) -; - -#we're at now now (and later). -my($time)= $opt_d ? str2time($opt_d) : $^T; - -my($cust_main,%saw); -foreach $cust_main ( @cust_main ) { - - my $error; - - $error = $cust_main->bill( 'time' => $time ); - warn "Error billing, custnum ". $cust_main->custnum. ": $error" if $error; - - $cust_main->apply_payments; - $cust_main->apply_credits; - - $error=$cust_main->collect( 'invoice_time' => $time ); - warn "Error collecting, custnum". $cust_main->custnum. ": $error" if $error; - -} - -if ( driver_name eq 'Pg' ) { - foreach my $statement ( 'vacuum', 'vacuum analyze' ) { - my $sth = dbh->prepare($statement) or die dbh->errstr; - $sth->execute or die $sth->errstr; - } -} - -# subroutines - -sub untaint_argv { - foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV - #$ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal arguement \"$ARGV[$_]\""; - # Date::Parse - $ARGV[$_] =~ /^(.*)$/ || die "Illegal arguement \"$ARGV[$_]\""; - $ARGV[$_]=$1; - } -} - -sub usage { - die "Usage:\n\n freeside-daily [ -d 'date' ] user [ custnum custnum ... ]\n"; -} - -=head1 NAME - -freeside-daily - Run daily billing and invoice collection events. - -=head1 SYNOPSIS - - freeside-daily [ -d 'date' ] user [ custnum custnum ... ] - -=head1 DESCRIPTION - -Bills customers and runs invoice collection events. Should be run from -crontab daily. - -This script replaces freeside-bill from 1.3.1. - -Bills customers. Searches for customers who are due for billing and calls -the bill and collect methods of a cust_main object. See L. - - -d: Pretend it's 'date'. Date is in any format Date::Parse is happy with, - but be careful. - -user: From the mapsecrets file - see config.html from the base documentation - -custnum: if one or more customer numbers are specified, only bills those -customers. Otherwise, bills all customers. - -=head1 BUGS - -=head1 SEE ALSO - -L, config.html from the base documentation - -=cut - diff --git a/FS/bin/freeside-email b/FS/bin/freeside-email deleted file mode 100755 index c7ff41114..000000000 --- a/FS/bin/freeside-email +++ /dev/null @@ -1,61 +0,0 @@ -#!/usr/bin/perl -Tw - -use strict; -use FS::UID qw(adminsuidsetup); -use FS::Conf; -use FS::Record qw(qsearch); -use FS::svc_acct; - -&untaint_argv; #what it sounds like (eww) -my $user = shift or die &usage; - -adminsuidsetup $user; - -my $conf = new FS::Conf; -my $domain = $conf->config('domain'); - -my @svc_acct = qsearch('svc_acct', {}); -my @usernames = map $_->username, @svc_acct; -my @emails = map "$_\@$domain", @usernames; - -print join("\n", @emails), "\n"; - -# subroutines - -sub untaint_argv { - foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV - #$ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal arguement \"$ARGV[$_]\""; - # Date::Parse - $ARGV[$_] =~ /^(.*)$/ || die "Illegal arguement \"$ARGV[$_]\""; - $ARGV[$_]=$1; - } -} - -sub usage { - die "Usage:\n\n freeside-email user\n"; -} - -=head1 NAME - -freeside-email - Prints email addresses of all users on STDOUT - -=head1 SYNOPSIS - - freeside-email user - -=head1 DESCRIPTION - -Prints the email addresses of all customers on STDOUT, separated by newlines. - -user: From the mapsecrets file - see config.html from the base documentation - -=head1 VERSION - -$Id: freeside-email,v 1.1 2001-05-15 07:52:34 ivan Exp $ - -=head1 BUGS - -=head1 SEE ALSO - -=cut - diff --git a/FS/bin/freeside-expiration-alerter b/FS/bin/freeside-expiration-alerter deleted file mode 100755 index ee3c1fb92..000000000 --- a/FS/bin/freeside-expiration-alerter +++ /dev/null @@ -1,224 +0,0 @@ -#!/usr/bin/perl -Tw - -use strict; -use Date::Format; -use Time::Local; -use Text::Template; -use Getopt::Std; -use Net::SMTP; -use Mail::Header; -use Mail::Internet; -use FS::Conf; -use FS::UID qw(adminsuidsetup); -use FS::Record qw(qsearch); -use FS::cust_main; - -use vars qw($smtpmachine @body); - -#hush, perl! -$FS::alerter::_template::first = ""; -$FS::alerter::_template::last = ""; -$FS::alerter::_template::company = ""; -$FS::alerter::_template::payby = ""; -$FS::alerter::_template::expdate = ""; - -# Set the mail program and other variables -my $mail_sender = "billing\@mydomain.tld"; # or invoice_from if available -my $failure_recipient = "postmaster"; # or invoice_from if available -my $warning_time = 30 * 24 * 60 * 60; -my $urgent_time = 15 * 24 * 60 * 60; -my $panic_time = 5 * 24 * 60 * 60; -my $window_time = 24 * 60 * 60; - -&untaint_argv; #what it sounds like (eww) - -#we're at now now (and later). -my($_date)= $^T; - -# Get the current month -my ($sec,$min,$hour,$mday,$mon,$year) = - (localtime($_date) )[0,1,2,3,4,5]; -$mon++; - -# Login to the database -my $user = shift or die &usage; -adminsuidsetup $user; - -# Get the needed configuration files -my $conf = new FS::Conf; -$smtpmachine = $conf->config('smtpmachine'); -$mail_sender = $conf->config('invoice_from') - if $conf->exists('invoice_from'); -$failure_recipient = $conf->config('invoice_from') - if $conf->exists('invoice_from'); - - -my(@customers)=qsearch('cust_main',{}); -if (scalar(@customers) == 0) -{ - exit 1; -} - -# Prepare for sending email - -$ENV{MAILADDRESS} = $mail_sender; -my $header = new Mail::Header ( [ - "From: Account Processor", - "To: $failure_recipient", - "Sender: $mail_sender", - "Reply-To: $mail_sender", - "Subject: Unnotified Billing Arrangement Expirations", -] ); - -my @alerter_template = $conf->config('alerter_template') - or die "cannot load config file alerter_template"; - -my $alerter = new Text::Template (TYPE => 'ARRAY', SOURCE => [ map "$_\n", @alerter_template ]) - or die "can't create new Text::Template object: Text::Template::ERROR"; -$alerter->compile() or die "can't compile template: Text::Template::ERROR"; - -# Now I can start looping -foreach my $customer (@customers) -{ - my $custnum = $customer->getfield('custnum'); - my $first = $customer->getfield('first'); - my $last = $customer->getfield('last'); - my $company = $customer->getfield('company'); - my $payby = $customer->getfield('payby'); - my $payinfo = $customer->getfield('payinfo'); - my $paydate = $customer->getfield('paydate'); - my $daytime = $customer->getfield('daytime'); - my $night = $customer->getfield('night'); - - my ($payyear,$paymonth,$payday) = split (/-/,$paydate); - - my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear); - - #credit cards expire at the end of the month/year of their exp date - if ($payby eq 'CARD') { - ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++); - $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear); - $expire_time--; - } - - if (($expire_time < $_date + $warning_time && - $expire_time > $_date + $warning_time - $window_time) || - ($expire_time < $_date + $urgent_time && - $expire_time > $_date + $urgent_time - $window_time) || - ($expire_time < $_date + $panic_time && - $expire_time > $_date + $panic_time - $window_time)) { - - - - my @packages = $customer->ncancelled_pkgs; - if (scalar(@packages) != 0) { - my @invoicing_list = $customer->invoicing_list; - if ( grep { $_ ne 'POST' } @invoicing_list ) { - my $header = new Mail::Header ( [ - "From: $mail_sender", - "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ), - "Sender: $mail_sender", - "Reply-To: $mail_sender", - "Date: ". time2str("%a, %d %b %Y %X %z", time), - "Subject: Billing Arrangement Expiration", - ] ); - $FS::alerter::_template::first = $first; - $FS::alerter::_template::last = $last; - $FS::alerter::_template::company = $company; - if ($payby eq 'CARD') { - $FS::alerter::_template::payby = "credit card (" . - substr($payinfo, 0, 2) . "xxxxxxxxxx" . - substr($payinfo, -4) . ")"; - }elsif ($payby eq 'COMP') { - $FS::alerter::_template::payby = "complimentary account"; - }else{ - $FS::alerter::_template::payby = "current method"; - } - $FS::alerter::_template::expdate = $expire_time; - - my $message = new Mail::Internet ( - 'Header' => $header, - 'Body' => [ $alerter->fill_in( PACKAGE => 'FS::alerter::_template' ) ], - ); - $!=0; - $message->smtpsend( Host => $smtpmachine ) - or $message->smtpsend( Host => $smtpmachine, Debug => 1 ) - or die "Can't send expiration email: $!"; - - } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) { - push @body, sprintf(qq{%5d %-32.32s %4s %10s %12s %12s}, - $custnum, - $first . " " . $last . " " . $company, - $payby, - $paydate, - $daytime, - $night); - } - } - } -} - -# Now I need to send EMAIL -if (scalar(@body)) { - my $message = new Mail::Internet ( - 'Header' => $header, - 'Body' => [ (@body) ], - ); - $!=0; - $message->smtpsend( Host => $smtpmachine ) - or $message->smtpsend( Host => $smtpmachine, Debug => 1 ) - or die "can't send alerter failure email to $failure_recipient". - " via server $smtpmachine with SMTP: $!"; -} - -# subroutines -sub untaint_argv { - foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV - $ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal argument \"$ARGV[$_]\""; - $ARGV[$_]=$1; - } -} - -sub usage { - die "Usage:\n\n freeside-expiration-alerter user\n"; -} - -=head1 NAME - -freeside-expiration-alerter - Emails notifications of credit card expirations. - -=head1 SYNOPSIS - - freeside-expiration-alerter user - -=head1 DESCRIPTION - -Emails customers notice that their credit card or other billing arrangement -is about to expire. Usually run as a cron job. - -user: From the mapsecrets file - see config.html from the base documentation - -=head1 VERSION - -$Id: freeside-expiration-alerter,v 1.3 2002-04-16 09:38:19 ivan Exp $ - -=head1 BUGS - -Yes..... Use at your own risk. No guarantees or warrantees of any -kind apply to this program. Parts of this program are hacked from -other GNU licensed software created mainly by Ivan Kohler. - -This is released under the GNU Public License. See www.gnu.org -for more information regarding this license. - -=head1 SEE ALSO - -L, config.html from the base documentation - -=head1 AUTHOR - -Jeff Finucane - -=cut - - diff --git a/FS/bin/freeside-overdue b/FS/bin/freeside-overdue deleted file mode 100755 index 116245f9c..000000000 --- a/FS/bin/freeside-overdue +++ /dev/null @@ -1,196 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use vars qw( $days_to_pay $cust_main $cust_pkg - $cust_svc $svc_acct ); -use Getopt::Std; -use FS::cust_main; -use FS::cust_pkg; -use FS::cust_svc; -use FS::svc_acct; -use FS::Record qw(qsearch qsearchs); -use FS::UID qw(adminsuidsetup); - -&untaint_argv; -my %opt; -getopts('ed:qpl:scbyoi', \%opt); -my $user = shift or die &usage; - -adminsuidsetup $user; - -my $now = time; #eventually take a time option like freeside-bill -my ($sec,$min,$hour,$mday,$mon,$year) = - (localtime($now) )[0,1,2,3,4,5]; -$mon++; -$year += 1900; - -foreach $cust_main ( qsearch('cust_main',{} ) ) { - - my ( $eyear, $emon, $eday ) = ( 2037, 12, 31 ); - if ( $cust_main->paydate =~ /^(\d{4})\-(\d{1,2})\-(\d{1,2})$/ - && $cust_main->payby eq 'BILL') { - ( $eyear, $emon, $eday ) = ( $1, $2, $3 ); - } - - if ( ( $opt{d} - && $cust_main->balance_date(time - $opt{d} * 86400) > 0 - && qsearchs( 'cust_pkg', { 'custnum' => $cust_main->custnum, - 'susp' => "" } ) ) - || ( $opt{e} - && $cust_main->payby eq 'BILL' - && ( $eyear < $year - || ( $eyear == $year && $emon < $mon ) ) ) - ) { - - unless ( $opt{q} ) { - print $cust_main->custnum, "\t", - $cust_main->last, "\t", $cust_main->first, "\t", - $cust_main->balance_date(time-$opt{d} * 86400); - } - - if ( $opt{p} && ! grep { $_ eq 'POST' } $cust_main->invoicing_list ) { - print "\n\tAdding postal invoicing" unless $opt{q}; - my @invoicing_list = $cust_main->invoicing_list; - push @invoicing_list, 'POST'; - $cust_main->invoicing_list(\@invoicing_list); - } - - if ( $opt{l} ) { - print "\n\tCharging late fee of \$$opt{l}" unless $opt{q}; - my $error = $cust_main->charge($opt{l}, 'Late fee'); - # comment or plandata with info so we don't redo the same late fee every - # day - } - - foreach $cust_pkg ( qsearch( 'cust_pkg', - { 'custnum' => $cust_main->custnum } ) ) { - - if ($opt{s}) { - print "\n\tSuspending pkgnum " . $cust_pkg->pkgnum unless $opt{q}; - $cust_pkg->suspend; - } - - if ($opt{c}) { - print "\n\tCancelling pkgnum " . $cust_pkg->pkgnum unless $opt{q}; - $cust_pkg->cancel; - } - - } - - if ( $opt{b} ) { - print "\n\tBilling" unless $opt{q}; - my $error = $cust_main->bill('time'=>$now); - warn "Error billing, customer #" . $cust_main->custnum . - ":" . $error if $error; - } - - if ( $opt{y} ) { - print "\n\tApplying outstanding payments and credits" unless $opt{q}; - $cust_main->apply_payments; - $cust_main->apply_credits; - } - - if ( $opt{o} ) { - print "\n\tCollecting" unless $opt{q}; - my $error = $cust_main->collect( - 'invoice_time' => $now, - 'batch_card' => $opt{i} ? 'no' : 'yes', - 'force_print' => 'yes', - ); - warn "Error collecting from customer #" . $cust_main->custnum. ":$error" - if $error; - } - - print "\n" unless $opt{q}; - - } - -} - -sub untaint_argv { - foreach $_ ( $[ .. $#ARGV ) { - $ARGV[$_] =~ /^([\w\-\/\.]*)$/ || die "Illegal arguement \"$ARGV[$_]\""; - $ARGV[$_]=$1; - } -} - -sub usage { - die "Usage:\n\n freeside-overdue [ -e ] [ -d days ] [ -q ] [ -p ] [ -l amount ] [ -s ] [ -c ] [ -b ] [ -y ] [ -o [ -i ] ] user\n"; -} - - -=head1 NAME - -freeside-overdue - Perform actions on overdue and/or expired accounts. - -=head1 SYNOPSIS - - freeside-overdue [ -e ] [ -d days ] [ -q ] [ -p ] [ -l amount ] [ -s ] [ -c ] [ -b ] [ -y ] [ -o [ -i ] ] user - -=head1 DESCRIPTION - -This script is deprecated in 1.4.0. You should use freeside-daily and invoice -events instead. - -Performs actions on overdue and/or expired accounts. - -Selection options (at least one selection option is required): - - -d: Customers with a balance due on invoices older than the supplied number - of days. Requires an integer argument. - - -e: Customers with a billing expiration date in the past. - -Action options: - - -q: Be quiet (by default, selected accounts are printed). - - -p: Add postal invoicing to the relevant customers. - - -l: Add a charge of the given amount to the relevant customers. - - -s: Suspend accounts. - - -c: Cancel accounts. - - -b: Bill customers (create invoices) - - -y: Apply unapplied payments and credits - - -o: Collect from customers (charge cards, print invoices) - - -i: real-time billing (as opposed to batch billing). only relevant - for credit cards. - - user: From the mapsecrets file - see config.html from the base documentation - -=head1 CRONTAB - -Example crontab entries: - -# suspend expired accounts -20 4 * * * freeside-overdue -e -s user - -# quietly add postal invoicing to customers over 30 days past due -20 4 * * * freeside-overdue -d 30 -p -q user - -# suspend accounts and charge a $10.23 fee for customers over 60 days past due -20 4 * * * freeside-overdue -d 60 -s -l 10.23 user - -# cancel accounts over 90 days past due -20 4 * * * freeside-overdue -d 90 -c user - -=head1 ORIGINAL AUTHORS - -Original disable-overdue version by mw/kwh: Mark W.? and Kristian Hoffmann ? - -Ivan seems to be turning it into the "do-everything" CLI. - -=head1 BUGS - -Hell now that this is the do-everything CLI it should have --longoptions - -=cut - -1; - diff --git a/FS/bin/freeside-queued b/FS/bin/freeside-queued deleted file mode 100644 index 83074b9e4..000000000 --- a/FS/bin/freeside-queued +++ /dev/null @@ -1,254 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use vars qw( $log_file $sigterm $sigint $kids $max_kids ); -use subs qw( _die _logmsg ); -use Fcntl qw(:flock); -use POSIX qw(setsid); -use Date::Format; -use IO::File; -use FS::UID qw(adminsuidsetup forksuidsetup driver_name dbh); -use FS::Record qw(qsearch qsearchs); -use FS::queue; -use FS::queue_depend; - -# no autoloading just yet -use FS::cust_main; -use FS::svc_acct; -use Net::SSH 0.06; -use FS::part_export; - -$max_kids = '10'; #guess it should be a config file... -$kids = 0; - -my $user = shift or die &usage; - -#my $pid_file = "/var/run/freeside-queued.$user.pid"; -my $pid_file = "/var/run/freeside-queued.pid"; - -&daemonize1; - -sub REAPER { my $pid = wait; $SIG{CHLD} = \&REAPER; $kids--; } -$SIG{CHLD} = \&REAPER; - -$sigterm = 0; -$sigint = 0; -$SIG{INT} = sub { warn "SIGINT received; shutting down\n"; $sigint++; }; -$SIG{TERM} = sub { warn "SIGTERM received; shutting down\n"; $sigterm++; }; - -my $freeside_gid = scalar(getgrnam('freeside')) - or die "can't setgid to freeside group\n"; -$) = $freeside_gid; -$( = $freeside_gid; -#if freebsd can't setuid(), presumably it can't setgid() either. grr fleabsd -($(,$)) = ($),$(); -$) = $freeside_gid; - -$> = $FS::UID::freeside_uid; -$< = $FS::UID::freeside_uid; -#freebsd is sofa king broken, won't setuid() -($<,$>) = ($>,$<); -$> = $FS::UID::freeside_uid; - -$ENV{HOME} = (getpwuid($>))[7]; #for ssh -adminsuidsetup $user; - -$log_file = "/usr/local/etc/freeside/queuelog.". $FS::UID::datasrc; - -&daemonize2; - -$SIG{__DIE__} = \&_die; -$SIG{__WARN__} = \&_logmsg; - -warn "freeside-queued starting\n"; - -my $warnkids=0; -while (1) { - - #prevent runaway forking - if ( $kids >= $max_kids ) { - warn "WARNING: maximum $kids children reached\n" unless $warnkids++; - sleep 1; #waiting for signals is cheap - next; - } - $warnkids=0; - - my $nodepend = driver_name eq 'mysql' - ? '' - : 'AND 0 = ( SELECT COUNT(*) FROM queue_depend'. - ' WHERE queue_depend.jobnum = queue.jobnum ) '; - - #my($job, $ljob); - #{ - # my $oldAutoCommit = $FS::UID::AutoCommit; - # local $FS::UID::AutoCommit = 0; - $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $job = qsearchs( - 'queue', - { 'status' => 'new' }, - '', - driver_name eq 'mysql' - ? "$nodepend ORDER BY jobnum LIMIT 1 FOR UPDATE" - : "$nodepend ORDER BY jobnum FOR UPDATE LIMIT 1" - ) or do { - $dbh->commit or die $dbh->errstr; #if $oldAutoCommit; - sleep 5; #connecting to db is expensive - next; - }; - - if ( driver_name eq 'mysql' - && qsearch('queue_depend', { 'jobnum' => $job->jobnum } ) ) { - $dbh->commit or die $dbh->errstr; #if $oldAutoCommit; - sleep 5; #would be better if mysql could do everything in query above - next; - } - - my %hash = $job->hash; - $hash{'status'} = 'locked'; - my $ljob = new FS::queue ( \%hash ); - my $error = $ljob->replace($job); - die $error if $error; - - $dbh->commit or die $dbh->errstr; #if $oldAutoCommit; - - $FS::UID::AutoCommit = 1; - #} - - my @args = $ljob->args; - - defined( my $pid = fork ) or do { - warn "WARNING: can't fork: $!\n"; - my %hash = $job->hash; - $hash{'status'} = 'failed'; - $hash{'statustext'} = "[freeside-queued] can't fork: $!"; - my $ljob = new FS::queue ( \%hash ); - my $error = $ljob->replace($job); - die $error if $error; - next; #don't increment the kid counter - }; - - if ( $pid ) { - $kids++; - } else { #kid time - - #get new db handle - $FS::UID::dbh->{InactiveDestroy} = 1; - - forksuidsetup($user); - - #auto-use export classes... - if ( $ljob->job =~ /(FS::part_export::\w+)::/ ) { - my $class = $1; - eval "use $class;"; - if ( $@ ) { - warn "job use $class failed"; - my %hash = $ljob->hash; - $hash{'status'} = 'failed'; - $hash{'statustext'} = $@; - my $fjob = new FS::queue( \%hash ); - my $error = $fjob->replace($ljob); - die $error if $error; - exit; #end-of-kid - }; - } - - my $eval = "&". $ljob->job. '(@args);'; - warn "running $eval"; - eval $eval; #throw away return value? suppose so - if ( $@ ) { - warn "job $eval failed"; - my %hash = $ljob->hash; - $hash{'status'} = 'failed'; - $hash{'statustext'} = $@; - my $fjob = new FS::queue( \%hash ); - my $error = $fjob->replace($ljob); - die $error if $error; - } else { - $ljob->delete; - } - - exit; - #end-of-kid - } - -} continue { - if ( $sigterm ) { - warn "received TERM signal; exiting\n"; - exit; - } - if ( $sigint ) { - warn "received INT signal; exiting\n"; - exit; - } -} - -sub usage { - die "Usage:\n\n freeside-queued user\n"; -} - -sub _die { - my $msg = shift; - unlink $pid_file if -e $pid_file; - _logmsg($msg); -} - -sub _logmsg { - chomp( my $msg = shift ); - my $log = new IO::File ">>$log_file"; - flock($log, LOCK_EX); - seek($log, 0, 2); - print $log "[". time2str("%a %b %e %T %Y",time). "] [$$] $msg\n"; - flock($log, LOCK_UN); - close $log; -} - -sub daemonize1 { - - chdir "/" or die "Can't chdir to /: $!"; - open STDIN, '/dev/null' or die "Can't read /dev/null: $!"; - defined(my $pid = fork) or die "Can't fork: $!"; - if ( $pid ) { - print "freeside-queued started with pid $pid\n"; #logging to $log_file\n"; - exit unless $pid_file; - my $pidfh = new IO::File ">$pid_file" or exit; - print $pidfh "$pid\n"; - exit; - } - #open STDOUT, '>/dev/null' - # or die "Can't write to /dev/null: $!"; - #setsid or die "Can't start a new session: $!"; - #open STDERR, '>&STDOUT' or die "Can't dup stdout: $!"; - -} - -sub daemonize2 { - open STDOUT, '>/dev/null' - or die "Can't write to /dev/null: $!"; - setsid or die "Can't start a new session: $!"; - open STDERR, '>&STDOUT' or die "Can't dup stdout: $!"; -} - -=head1 NAME - -freeside-queued - Job queue daemon - -=head1 SYNOPSIS - - freeside-queued user - -=head1 DESCRIPTION - -Job queue daemon. Should be running at all times. - -user: from the mapsecrets file - see config.html from the base documentation - -=head1 VERSION - -=head1 BUGS - -=head1 SEE ALSO - -=cut - diff --git a/FS/bin/freeside-receivables-report b/FS/bin/freeside-receivables-report deleted file mode 100755 index b5a49031e..000000000 --- a/FS/bin/freeside-receivables-report +++ /dev/null @@ -1,217 +0,0 @@ -#!/usr/bin/perl -Tw - -use strict; -use Date::Parse; -use Time::Local; -use Getopt::Std; -use Text::Template; -use Net::SMTP; -use Mail::Header; -use Mail::Internet; -use FS::Conf; -use FS::UID qw(adminsuidsetup); -use FS::Record qw(qsearch); -use FS::cust_main; - - -&untaint_argv; #what it sounds like (eww) -use vars qw($opt_v $opt_p $opt_m $opt_e $opt_t $report_lines $report_template @buf $header); -getopts("vpmet:"); #switches - -#we're at now now (and later). -my($_date)= $^T; - -# Get the current month -my ($sec,$min,$hour,$mday,$mon,$year) = - (localtime($_date) )[0,1,2,3,4,5]; -$mon++; -$year += 1900; - -# Login to the database -my $user = shift or die &usage; -adminsuidsetup $user; - -# Get the needed configuration files -my $conf = new FS::Conf; -my $lpr = $conf->config('lpr'); -my $email = $conf->config('email'); -my $smtpmachine = $conf->config('smtpmachine'); -my $mail_sender = $conf->exists('invoice_from') ? $conf->config('invoice_from') : - 'postmaster'; -my @report_template = $conf->config('report_template') - or die "cannot load config file report_template"; -$report_lines = 0; - foreach ( grep /report_lines\(\d+\)/, @report_template ) { #kludgy :/ - /report_lines\((\d+)\)/; - $report_lines += $1; -} -die "no report_lines() functions in template?" unless $report_lines; -$report_template = new Text::Template ( - TYPE => 'ARRAY', - SOURCE => [ map "$_\n", @report_template ], -) or die "can't create new Text::Template object: $Text::Template::ERROR"; - - -my(@customers)=qsearch('cust_main',{}); -if (scalar(@customers) == 0) -{ - exit 1; -} - -# Open print and email pipes -# $lpr and opt_p for printing -# $email and opt_m for email - -if ($lpr && $opt_p) -{ - open(LPR, "|$lpr"); -} - -if ($email && $opt_m) -{ - $ENV{MAILADDRESS} = $mail_sender; - $header = new Mail::Header ( [ - "From: Account Processor", - "To: $email", - "Sender: $mail_sender", - "Reply-To: $mail_sender", - "Subject: Receivables", - ] ); -} - -my $total = 0; - - -# Now I can start looping -foreach my $customer (@customers) -{ - my $custnum = $customer->getfield('custnum'); - my $first = $customer->getfield('first'); - my $last = $customer->getfield('last'); - my $company = $customer->getfield('company'); - my $daytime = $customer->getfield('daytime'); - my $balance = $customer->balance; - - - if ($balance != 0) { - $total += $balance; - push @buf, sprintf(qq{%8d %-32.32s %12s %9.2f}, - $custnum, - $first . " " . $last . " " . $company, - $daytime, - $balance); - - } - -} - -push @buf, ('', sprintf(qq{%61s}, "========="), sprintf(qq{%61.2f}, $total)); - -sub FS::receivables_report::_template::report_lines { - my $lines = shift; - map { - scalar(@buf) ? shift @buf : '' ; - } - ( 1 .. $lines ); -} - -$FS::receivables_report::_template::title = " R E C E I V A B L E S "; -$FS::receivables_report::_template::title = $opt_t if $opt_t; -$FS::receivables_report::_template::page = 1; -$FS::receivables_report::_template::date = $_date; -$FS::receivables_report::_template::date = $_date; -$FS::receivables_report::_template::total_pages = - int( scalar(@buf) / $report_lines); -$FS::receivables_report::_template::total_pages++ if scalar(@buf) % $report_lines; - -my @report; -while (@buf) { - push @report, split("\n", - $report_template->fill_in( PACKAGE => 'FS::receivables_report::_template' ) - ); - $FS::receivables_report::_template::page++; -} - -if ($opt_v) { - print map "$_\n", @report; -} -if($lpr && $opt_p) -{ - print LPR map "$_\n", @report; - print LPR "\f" if $opt_e; - close LPR || die "Could not close printer: $lpr\n"; -} -if($email && $opt_m) -{ - my $message = new Mail::Internet ( - 'Header' => $header, - 'Body' => [ (@report) ], - ); - $!=0; - $message->smtpsend( Host => "$smtpmachine" ) - or die "can't send report to $email via $smtpmachine: $!"; -} - - -# subroutines - -sub untaint_argv { - foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV - $ARGV[$_] =~ /^([\w\-\/ ]*)$/ || die "Illegal argument \"$ARGV[$_]\""; - $ARGV[$_]=$1; - } -} - -sub usage { - die "Usage:\n\n freeside-receivables-report [-v] [-p] [-e] user\n"; -} - -=head1 NAME - -freeside-receivables-report - Prints or emails outstanding receivables. - -=head1 SYNOPSIS - - freeside-receivables-report [-v] [-p] [-m] [-e] [-t "title"] user - -=head1 DESCRIPTION - -Prints or emails outstanding receivables - -B<-v>: Verbose - Prints records to STDOUT. - -B<-p>: Print to printer lpr as found in the conf directory. - -B<-m>: Mail output to user found in the Conf email file. - -B<-e>: Print a final form feed to the printer. - -B<-t>: supply a title for the top of each page. - -user: From the mapsecrets file - see config.html from the base documentation - -=head1 VERSION - -$Id: freeside-receivables-report,v 1.5 2002-03-07 19:50:24 jeff Exp $ - -=head1 BUGS - -Yes..... Use at your own risk. No guarantees or warrantees of any -kind apply to this program. Parts of this program are hacked from -other GNU licensed software created mainly by Ivan Kohler. - -This is released under the GNU Public License. See www.gnu.org -for more information regarding this license. - -=head1 SEE ALSO - -L, config.html from the base documentation - -=head1 AUTHOR - -Jeff Finucane - -based on print-batch by Joel Griffiths - -=cut - diff --git a/FS/bin/freeside-reexport b/FS/bin/freeside-reexport deleted file mode 100644 index b5c50a422..000000000 --- a/FS/bin/freeside-reexport +++ /dev/null @@ -1,62 +0,0 @@ -#!/usr/bin/perl -Tw - -use strict; -use FS::UID qw(adminsuidsetup); -use FS::Record qw(qsearch qsearchs); -use FS::part_export; -use FS::svc_acct; -use FS::cust_svc; - -my $user = shift or die &usage; -adminsuidsetup $user; - -my $export_x = shift or die &usage; -my @part_export; -if ( $export_x =~ /^(\d+)$/ ) { - @part_export = qsearchs('part_export', { exportnum=>$1 } ) - or die "exportnum $export_x not found\n"; -} else { - @part_export = qsearch('part_export', { exporttype=>$export_x } ) - or die "no exports of type $export_x found\n"; -} - -my $svc_something = shift or die &usage; -my $svc_x; -if ( $svc_something =~ /^(\d+)$/ ) { - my $cust_svc = qsearchs('cust_svc', { svcnum=>$1 } ) - or die "svcnum $svc_something not found\n"; - $svc_x = $cust_svc->svc_x; -} else { - $svc_x = qsearchs('svc_acct', { username=>$svc_something } ) - or die "username $svc_something not found\n"; -} - -foreach my $part_export ( @part_export ) { - my $error = $part_export->export_insert($svc_x); - die $error if $error; -} - - -sub usage { - die "Usage:\n\n freeside-reexport user exportnum|exporttype svcnum|username\n"; -} - -=head1 NAME - -freeside-reexport - Command line tool to re-trigger export jobs for existing services - -=head1 SYNOPSIS - - freeside-reexport user exportnum|exporttype svcnum|username - -=head1 DESCRIPTION - - Re-queues the export job for the specified exportnum or exporttype(s) and - specified service (selected by svcnum or username). - -=head1 SEE ALSO - -L, L - -=cut - diff --git a/FS/bin/freeside-setinvoice b/FS/bin/freeside-setinvoice deleted file mode 100644 index 708e2fa30..000000000 --- a/FS/bin/freeside-setinvoice +++ /dev/null @@ -1,42 +0,0 @@ -#!/usr/bin/perl - -use strict; -use FS::UID qw(adminsuidsetup); -use FS::Conf; -use FS::Record qw(qsearch qsearchs); -use FS::cust_main; -use FS::svc_acct; - -&untaint_argv; #what it sounds like (eww) -my $user = shift or die &usage; - -adminsuidsetup $user; - -foreach my $cust_main ( - grep { ! scalar($_->invoicing_list) } - qsearch( 'cust_main', {} ) -) { - my @dest; - my @cust_pkg = $cust_main->ncancelled_pkgs; - foreach my $cust_pkg ( @cust_pkg ) { - foreach my $cust_svc ( $cust_pkg->cust_svc ) { - my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $cust_svc->svcnum } ); - push @dest, $svc_acct->svcnum if $svc_acct; - } - } - push @dest, 'POST' unless @dest; - $cust_main->invoicing_list(\@dest); -} - -sub untaint_argv { - foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV - $ARGV[$_] =~ /^(.*)$/ || die "Illegal arguement \"$ARGV[$_]\""; - $ARGV[$_]=$1; - } -} - -sub usage { - die "Usage:\n\n freeside-setinvoice user\n"; -} - - diff --git a/FS/bin/freeside-sqlradius-reset b/FS/bin/freeside-sqlradius-reset deleted file mode 100755 index 9d3a6a700..000000000 --- a/FS/bin/freeside-sqlradius-reset +++ /dev/null @@ -1,74 +0,0 @@ -#!/usr/bin/perl -Tw - -use strict; -use FS::UID qw(adminsuidsetup); -use FS::Record qw(qsearch qsearchs); -use FS::part_export; -use FS::svc_acct; -use FS::cust_svc; - -my $user = shift or die &usage; -adminsuidsetup $user; - -#my $machine = shift or die &usage; - -my @exports = qsearch('part_export', { 'exporttype' => 'sqlradius' } ); - -foreach my $export ( @exports ) { - my $icradius_dbh = DBI->connect( - map { $export->option($_) } qw( datasrc username password ) - ) or die $DBI::errstr; - for my $table (qw( radcheck radreply usergroup )) { - my $sth = $icradius_dbh->prepare("DELETE FROM $table"); - $sth->execute or die "Can't reset $table table: ". $sth->errstr; - } - $icradius_dbh->disconnect; -} - -foreach my $export ( @exports ) { - - #my @svcparts = map { $_->svcpart } $export->export_svc; - - my @svc_acct = - map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) } - map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) } - grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) } - $export->export_svc; - - foreach my $svc_acct ( @svc_acct ) { - - #false laziness with FS::svc_acct::insert (like it matters) - my $error = $export->export_insert($svc_acct); - die $error if $error; - - } -} - -sub usage { - #die "Usage:\n\n sqlradius_reset user machine\n"; - die "Usage:\n\n freeside-sqlradius-reset user\n"; -} - -=head1 NAME - -freeside-sqlradius-reset - Command line interface to reset and recreate RADIUS SQL tables - -=head1 SYNOPSIS - - freeside-sqlradius-reset username - -=head1 DESCRIPTION - -Deletes the radcheck, radreply and usergroup tables and repopulates them from -the Freeside database, for all sqlradius exports. - -B is a username added by freeside-adduser. - -=head1 SEE ALSO - -L, L, L - -=cut - - - diff --git a/FS/bin/freeside-tax-report b/FS/bin/freeside-tax-report deleted file mode 100755 index 8d5021358..000000000 --- a/FS/bin/freeside-tax-report +++ /dev/null @@ -1,292 +0,0 @@ -#!/usr/bin/perl -Tw - - -use strict; -use Date::Parse; -use Time::Local; -use Getopt::Std; -use Text::Template; -use Net::SMTP; -use Mail::Header; -use Mail::Internet; -use FS::Conf; -use FS::UID qw(adminsuidsetup); -use FS::Record qw(qsearch); -use FS::cust_bill; -use FS::cust_bill_pay; -use FS::cust_pay; - - -&untaint_argv; #what it sounds like (eww) -use vars qw($opt_v $opt_p $opt_m $opt_e $opt_t $opt_s $opt_f $report_lines $report_template @buf $header); -getopts("vpmef:s:"); #switches - -#we're at now now (and later). -my($_finishdate)= $opt_f ? str2time($main::opt_f) : $^T; -my($_startdate)= $opt_s ? str2time($main::opt_s) : $^T; - -# Get the current month -my ($ssec,$smin,$shour,$smday,$smon,$syear) = - (localtime($_startdate) )[0,1,2,3,4,5]; -$smon++; -$syear += 1900; - -# Get the current month -my ($fsec,$fmin,$fhour,$fmday,$fmon,$fyear) = - (localtime($_finishdate) )[0,1,2,3,4,5]; -$fmon++; -$fyear += 1900; - -# Login to the database -my $user = shift or die &usage; -adminsuidsetup $user; - -# Get the needed configuration files -my $conf = new FS::Conf; -my $lpr = $conf->config('lpr'); -my $email = $conf->config('email'); -my $smtpmachine = $conf->config('smtpmachine'); -my $mail_sender = $conf->exists('invoice_from') ? $conf->config('invoice_from') : - 'postmaster'; -my @report_template = $conf->config('report_template') - or die "cannot load config file report_template"; -$report_lines = 0; -foreach ( grep /report_lines\(\d+\)/, @report_template ) { #kludgy :/ - /report_lines\((\d+)\)/; - $report_lines += $1; -} -die "no report_lines() functions in template?" unless $report_lines; -$report_template = new Text::Template ( - TYPE => 'ARRAY', - SOURCE => [ map "$_\n", @report_template ], -) or die "can't create new Text::Template object: $Text::Template::ERROR"; - - -my(@cust_bills)=qsearch('cust_bill',{}); -if (scalar(@cust_bills) == 0) -{ - exit 1; -} - -# Open print and email pipes -# $lpr and opt_p for printing -# $email and opt_m for email - -if ($lpr && $main::opt_p) -{ - open(LPR, "|$lpr"); -} - -if ($email && $main::opt_m) -{ - $ENV{MAILADDRESS} = $mail_sender; - $header = new Mail::Header ( [ - "From: Account Processor", - "To: $email", - "Sender: $mail_sender", - "Reply-To: $mail_sender", - "Subject: Sales Taxes Invoiced", - ] ); -} - -my $comped = 0; -my $comped_tax = 0; -my $other = 0; -my $other_tax = 0; -my $total = 0; -my $taxed = 0; -my $untaxed = 0; -my $total_tax = 0; - -# Now I can start looping -foreach my $cust_bill (@cust_bills) -{ - my $_date = $cust_bill->getfield('_date'); - my $invnum = $cust_bill->getfield('invnum'); - my $charged = $cust_bill->getfield('charged'); - - if ($_date >= $_startdate && $_date <= $_finishdate) { - $total += $charged; - - # The following lines were used to produce rather verbose reports - #my ($sec,$min,$hour,$mday,$mon,$year) = - # (localtime($_date) )[0,1,2,3,4,5]; - #$mon++; - #$year -= 100 if $year >= 100; - #$year = "0" . $year if $year < 10; - - my $invoice_amt =0; - my $invoice_tax =0; - my $invoice_comped =0; - my(@cust_bill_pkgs)= $cust_bill->cust_bill_pkg; - foreach my $cust_bill_pkg (@cust_bill_pkgs) { - - my $recur = $cust_bill_pkg->getfield('recur'); - my $setup = $cust_bill_pkg->getfield('setup'); - my $pkgnum = $cust_bill_pkg->getfield('pkgnum'); - - if ($pkgnum == 0) { - # The following line was used to produce rather verbose reports - # push @buf, ('', sprintf(qq{%10s%15s%14.2f}, "$mon/$mday/$year", "Tax $invnum", $recur+$setup)); - $invoice_tax += $recur; - $invoice_tax += $setup; - } else { - # The following line was used to produce rather verbose reports - # push @buf, ('', sprintf(qq{%10s%15s%14.2f}, "$mon/$mday/$year", "Inv $invnum", $recur+$setup)); - $invoice_amt += $recur; - $invoice_amt += $setup; - } - - } - - my(@cust_bill_pays)= $cust_bill->cust_bill_pay; - foreach my $cust_bill_pay (@cust_bill_pays) { - my $payby = $cust_bill_pay->cust_pay->payby; - my $paid = $cust_bill_pay->getfield('amount'); - if ($payby =~ 'COMP') { - $invoice_comped += $paid; - } - } - - if (abs($invoice_comped - ($invoice_amt + $invoice_tax)) < 0.0001){ - $comped += $invoice_amt; - $comped_tax += $invoice_tax; - } elsif ($invoice_comped > 0) { - push @buf, sprintf(qq{\nInvoice %10d has inexpliciable complimentary payments of %14.9f\n}, $invnum, $invoice_comped); - $other += $invoice_amt; - $other_tax += $invoice_tax; - } elsif ($invoice_tax > 0) { - $total_tax += $invoice_tax; - $taxed += $invoice_amt; - } else { - $untaxed += $invoice_amt; - } - - } - -} - -push @buf, ('', sprintf(qq{%25s%14.2f}, "Complimentary", $comped)); -push @buf, sprintf(qq{%25s%14.2f}, "Complimentary Tax", $comped_tax); -push @buf, sprintf(qq{%25s%14.2f}, "Other", $other); -push @buf, sprintf(qq{%25s%14.2f}, "Other Tax", $other_tax); -push @buf, sprintf(qq{%25s%14.2f}, "Untaxed", $untaxed); -push @buf, sprintf(qq{%25s%14.2f}, "Taxed", $taxed); -push @buf, sprintf(qq{%25s%14.2f}, "Tax", $total_tax); -push @buf, ('', sprintf(qq{%39s}, "========="), sprintf(qq{%39.2f}, $total)); - -sub FS::tax_report::_template::report_lines { - my $lines = shift; - map { - scalar(@buf) ? shift @buf : '' ; - } - ( 1 .. $lines ); -} - -$FS::tax_report::_template::title = qq~SALES TAXES INVOICED for $smon/$smday/$syear through $fmon/$fmday/$fyear~; -$FS::tax_report::_template::title = $opt_t if $opt_t; -$FS::tax_report::_template::page = 1; -$FS::tax_report::_template::date = $^T; -$FS::tax_report::_template::date = $^T; -$FS::tax_report::_template::fdate = $_finishdate; -$FS::tax_report::_template::fdate = $_finishdate; -$FS::tax_report::_template::sdate = $_startdate; -$FS::tax_report::_template::sdate = $_startdate; -$FS::tax_report::_template::total_pages = - int( scalar(@buf) / $report_lines); -$FS::tax_report::_template::total_pages++ if scalar(@buf) % $report_lines; - -my @report; -while (@buf) { - push @report, split("\n", - $report_template->fill_in( PACKAGE => 'FS::tax_report::_template' ) - ); - $FS::tax_report::_template::page++; -} - -if ($opt_v) { - print map "$_\n", @report; -} -if($lpr && $opt_p) -{ - print LPR map "$_\n", @report; - print LPR "\f" if $opt_e; - close LPR || die "Could not close printer: $lpr\n"; -} -if($email && $opt_m) -{ - my $message = new Mail::Internet ( - 'Header' => $header, - 'Body' => [ (@report) ], - ); - $!=0; - $message->smtpsend( Host => "$smtpmachine" ) - or die "can't send report to $email via $smtpmachine: $!"; -} - - -# subroutines -sub untaint_argv { - foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV - $ARGV[$_] =~ /^([\w\-\/ :]*)$/ || die "Illegal argument \"$ARGV[$_]\""; - $ARGV[$_]=$1; - } -} - -sub usage { - die "Usage:\n\n freeside-tax-report [-v] [-p] [-e] user\n"; -} - -=head1 NAME - -freeside-tax-report - Prints or emails sales taxes invoiced in a given period. - -=head1 SYNOPSIS - - freeside-tax-report [-v] [-p] [-m] [-e] [-t "title"] [-s date] [-f date] user - -=head1 DESCRIPTION - -Prints or emails sales taxes invoiced in a given period. - --v: Verbose - Prints records to STDOUT. - --p: Print to printer lpr as found in the conf directory. - --m: Email output to user found in the Conf email file. - --e: Print a final form feed to the printer. - --t: supply a title for the top of each page. - --s: starting date for inclusion - --f: final date for inclusion - -user: From the mapsecrets file - see config.html from the base documentation - -=head1 VERSION - -$Id: freeside-tax-report,v 1.4 2002-03-07 19:50:24 jeff Exp $ - -=head1 BUGS - -Yes..... Use at your own risk. No guarantees or warrantees of any -kind apply to this program. Parts of this program are hacked from -other GNU licensed software created mainly by Ivan Kohler. - -This is released under the GNU Public License. See www.gnu.org -for more information regarding this license. - -=head1 SEE ALSO - -L, config.html from the base documentation - -=head1 AUTHOR - -Jeff Finucane - -based on print-batch by Joel Griffiths - -=cut - diff --git a/FS/t/CGI.t b/FS/t/CGI.t deleted file mode 100644 index 1b4e238b6..000000000 --- a/FS/t/CGI.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::CGI; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/ClientAPI.t b/FS/t/ClientAPI.t deleted file mode 100644 index 973d8dada..000000000 --- a/FS/t/ClientAPI.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::ClientAPI; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/Conf.t b/FS/t/Conf.t deleted file mode 100644 index a9f7653b3..000000000 --- a/FS/t/Conf.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::Conf; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/ConfItem.t b/FS/t/ConfItem.t deleted file mode 100644 index c7932d7e3..000000000 --- a/FS/t/ConfItem.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::ConfItem; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/InitHandler.t b/FS/t/InitHandler.t deleted file mode 100644 index 0ce60c833..000000000 --- a/FS/t/InitHandler.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::InitHandler; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/Msgcat.t b/FS/t/Msgcat.t deleted file mode 100644 index 29e71b33c..000000000 --- a/FS/t/Msgcat.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::Msgcat; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/Record.t b/FS/t/Record.t deleted file mode 100644 index 00de1eda3..000000000 --- a/FS/t/Record.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::Record; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/SearchCache.t b/FS/t/SearchCache.t deleted file mode 100644 index 3c26f3528..000000000 --- a/FS/t/SearchCache.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::SearchCache; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/UID.t b/FS/t/UID.t deleted file mode 100644 index 9f7da4e89..000000000 --- a/FS/t/UID.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::UID; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/agent.t b/FS/t/agent.t deleted file mode 100644 index 769cce254..000000000 --- a/FS/t/agent.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::agent; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/agent_type.t b/FS/t/agent_type.t deleted file mode 100644 index 99c66a151..000000000 --- a/FS/t/agent_type.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::agent_type; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/cust_bill.t b/FS/t/cust_bill.t deleted file mode 100644 index b43f08ee2..000000000 --- a/FS/t/cust_bill.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::cust_bill; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/cust_bill_event.t b/FS/t/cust_bill_event.t deleted file mode 100644 index 0e2ca3e24..000000000 --- a/FS/t/cust_bill_event.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::cust_bill_event; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/cust_bill_pay.t b/FS/t/cust_bill_pay.t deleted file mode 100644 index 001eed01e..000000000 --- a/FS/t/cust_bill_pay.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::cust_bill_pay; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/cust_bill_pkg.t b/FS/t/cust_bill_pkg.t deleted file mode 100644 index 0e45bdb0c..000000000 --- a/FS/t/cust_bill_pkg.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::cust_bill_pkg; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/cust_credit.t b/FS/t/cust_credit.t deleted file mode 100644 index cddf75cff..000000000 --- a/FS/t/cust_credit.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::cust_credit; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/cust_credit_bill.t b/FS/t/cust_credit_bill.t deleted file mode 100644 index 0ef54c3f1..000000000 --- a/FS/t/cust_credit_bill.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::cust_credit_bill; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/cust_credit_refund.t b/FS/t/cust_credit_refund.t deleted file mode 100644 index 6b2b599f3..000000000 --- a/FS/t/cust_credit_refund.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::cust_credit_refund; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/cust_main.t b/FS/t/cust_main.t deleted file mode 100644 index b0ffbdb32..000000000 --- a/FS/t/cust_main.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::cust_main; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/cust_main_county.t b/FS/t/cust_main_county.t deleted file mode 100644 index dd6119911..000000000 --- a/FS/t/cust_main_county.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::cust_main_county; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/cust_main_invoice.t b/FS/t/cust_main_invoice.t deleted file mode 100644 index 9661620e0..000000000 --- a/FS/t/cust_main_invoice.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::cust_main_invoice; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/cust_pay.t b/FS/t/cust_pay.t deleted file mode 100644 index f6d0b7571..000000000 --- a/FS/t/cust_pay.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::cust_pay; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/cust_pay_batch.t b/FS/t/cust_pay_batch.t deleted file mode 100644 index 02b572c15..000000000 --- a/FS/t/cust_pay_batch.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::cust_pay_batch; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/cust_pkg.t b/FS/t/cust_pkg.t deleted file mode 100644 index c6a686061..000000000 --- a/FS/t/cust_pkg.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::cust_pkg; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/cust_refund.t b/FS/t/cust_refund.t deleted file mode 100644 index 91583da28..000000000 --- a/FS/t/cust_refund.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::cust_refund; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/cust_svc.t b/FS/t/cust_svc.t deleted file mode 100644 index 267d731db..000000000 --- a/FS/t/cust_svc.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::cust_svc; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/cust_tax_exempt.pm b/FS/t/cust_tax_exempt.pm deleted file mode 100644 index 8af13e3aa..000000000 --- a/FS/t/cust_tax_exempt.pm +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::cust_tax_exempt; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/cust_tax_exempt.t b/FS/t/cust_tax_exempt.t deleted file mode 100644 index 8af13e3aa..000000000 --- a/FS/t/cust_tax_exempt.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::cust_tax_exempt; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/domain_record.t b/FS/t/domain_record.t deleted file mode 100644 index 794518ccf..000000000 --- a/FS/t/domain_record.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::domain_record; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/export_svc.t b/FS/t/export_svc.t deleted file mode 100644 index 773c5dea7..000000000 --- a/FS/t/export_svc.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::export_svc; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/msgcat.t b/FS/t/msgcat.t deleted file mode 100644 index c38c63935..000000000 --- a/FS/t/msgcat.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::msgcat; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/nas.t b/FS/t/nas.t deleted file mode 100644 index 6f8ae36d2..000000000 --- a/FS/t/nas.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::nas; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_bill_event.t b/FS/t/part_bill_event.t deleted file mode 100644 index 5626a9f97..000000000 --- a/FS/t/part_bill_event.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::part_bill_event; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_export-bind.t b/FS/t/part_export-bind.t deleted file mode 100644 index d0c96be40..000000000 --- a/FS/t/part_export-bind.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::part_export::bind; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_export-bind_slave.t b/FS/t/part_export-bind_slave.t deleted file mode 100644 index c6a038610..000000000 --- a/FS/t/part_export-bind_slave.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::part_export::bind_slave; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_export-bsdshell.t b/FS/t/part_export-bsdshell.t deleted file mode 100644 index eaf417a70..000000000 --- a/FS/t/part_export-bsdshell.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::part_export::bsdshell; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_export-cp.t b/FS/t/part_export-cp.t deleted file mode 100644 index bbefa6c1b..000000000 --- a/FS/t/part_export-cp.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::part_export::cp; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_export-cyrus.t b/FS/t/part_export-cyrus.t deleted file mode 100644 index e0b3f350e..000000000 --- a/FS/t/part_export-cyrus.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::part_export::cyrus; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_export-http.t b/FS/t/part_export-http.t deleted file mode 100644 index ea41b939f..000000000 --- a/FS/t/part_export-http.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::part_export::http; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_export-infostreet.t b/FS/t/part_export-infostreet.t deleted file mode 100644 index 1b3341825..000000000 --- a/FS/t/part_export-infostreet.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::part_export::infostreet; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_export-null.t b/FS/t/part_export-null.t deleted file mode 100644 index 055cdcee6..000000000 --- a/FS/t/part_export-null.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::part_export::null; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_export-shellcommands.t b/FS/t/part_export-shellcommands.t deleted file mode 100644 index 7bb47d3f8..000000000 --- a/FS/t/part_export-shellcommands.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::part_export::shellcommands; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_export-shellcommands_withdomain.t b/FS/t/part_export-shellcommands_withdomain.t deleted file mode 100644 index c0bd1bbb0..000000000 --- a/FS/t/part_export-shellcommands_withdomain.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::part_export::shellcommands_withdomain; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_export-sqlmail.t b/FS/t/part_export-sqlmail.t deleted file mode 100644 index b048a75a5..000000000 --- a/FS/t/part_export-sqlmail.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::part_export::sqlmail; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_export-sqlradius.t b/FS/t/part_export-sqlradius.t deleted file mode 100644 index 5fb23a5a6..000000000 --- a/FS/t/part_export-sqlradius.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::part_export::sqlradius; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_export-sysvshell.t b/FS/t/part_export-sysvshell.t deleted file mode 100644 index 7fc24acb1..000000000 --- a/FS/t/part_export-sysvshell.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::part_export::sysvshell; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_export-textradius.t b/FS/t/part_export-textradius.t deleted file mode 100644 index d8a48a0c8..000000000 --- a/FS/t/part_export-textradius.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::part_export::textradius; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_export-vpopmail.t b/FS/t/part_export-vpopmail.t deleted file mode 100644 index 2e37114a2..000000000 --- a/FS/t/part_export-vpopmail.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::part_export::vpopmail; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_export-www_shellcommands.t b/FS/t/part_export-www_shellcommands.t deleted file mode 100644 index 2ea79cf97..000000000 --- a/FS/t/part_export-www_shellcommands.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::part_export::www_shellcommands; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_export.t b/FS/t/part_export.t deleted file mode 100644 index 26b398791..000000000 --- a/FS/t/part_export.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::part_export; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_export_option.t b/FS/t/part_export_option.t deleted file mode 100644 index 13200c213..000000000 --- a/FS/t/part_export_option.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::part_export_option; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_pkg.t b/FS/t/part_pkg.t deleted file mode 100644 index fd96073f9..000000000 --- a/FS/t/part_pkg.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::part_pkg; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_pop_local.t b/FS/t/part_pop_local.t deleted file mode 100644 index 4e4ad17f5..000000000 --- a/FS/t/part_pop_local.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::part_pop_local; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_referral.t b/FS/t/part_referral.t deleted file mode 100644 index d20b97930..000000000 --- a/FS/t/part_referral.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::part_referral; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_svc.t b/FS/t/part_svc.t deleted file mode 100644 index bdb2a7aca..000000000 --- a/FS/t/part_svc.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::part_svc; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_svc_column.t b/FS/t/part_svc_column.t deleted file mode 100644 index 467025c1e..000000000 --- a/FS/t/part_svc_column.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::part_svc_column; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/pkg_svc.t b/FS/t/pkg_svc.t deleted file mode 100644 index 77d34295a..000000000 --- a/FS/t/pkg_svc.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::pkg_svc; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/port.t b/FS/t/port.t deleted file mode 100644 index 46377aaf9..000000000 --- a/FS/t/port.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::port; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/prepay_credit.t b/FS/t/prepay_credit.t deleted file mode 100644 index e7626bdf1..000000000 --- a/FS/t/prepay_credit.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::prepay_credit; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/queue.t b/FS/t/queue.t deleted file mode 100644 index 43e33730e..000000000 --- a/FS/t/queue.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::queue; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/queue_arg.t b/FS/t/queue_arg.t deleted file mode 100644 index cf3f91dfe..000000000 --- a/FS/t/queue_arg.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::queue_arg; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/queue_depend.t b/FS/t/queue_depend.t deleted file mode 100644 index 8eaa2cdb3..000000000 --- a/FS/t/queue_depend.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::queue_depend; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/raddb.t b/FS/t/raddb.t deleted file mode 100644 index ac28d0798..000000000 --- a/FS/t/raddb.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::raddb; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/radius_usergroup.t b/FS/t/radius_usergroup.t deleted file mode 100644 index 325742cf5..000000000 --- a/FS/t/radius_usergroup.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::radius_usergroup; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/session.t b/FS/t/session.t deleted file mode 100644 index c4b714ea4..000000000 --- a/FS/t/session.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::session; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/svc_Common.t b/FS/t/svc_Common.t deleted file mode 100644 index ed49e1e49..000000000 --- a/FS/t/svc_Common.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::svc_Common; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/svc_acct.t b/FS/t/svc_acct.t deleted file mode 100644 index 9ca78c9d1..000000000 --- a/FS/t/svc_acct.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::svc_acct; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/svc_acct_pop.t b/FS/t/svc_acct_pop.t deleted file mode 100644 index e612c40af..000000000 --- a/FS/t/svc_acct_pop.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::svc_acct_pop; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/svc_acct_sm.t b/FS/t/svc_acct_sm.t deleted file mode 100644 index 1082f2cdb..000000000 --- a/FS/t/svc_acct_sm.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::svc_acct_sm; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/svc_domain.t b/FS/t/svc_domain.t deleted file mode 100644 index 4d91898ac..000000000 --- a/FS/t/svc_domain.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::svc_domain; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/svc_forward.t b/FS/t/svc_forward.t deleted file mode 100644 index d653d34ef..000000000 --- a/FS/t/svc_forward.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::svc_forward; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/svc_www.t b/FS/t/svc_www.t deleted file mode 100644 index eb4e83fbc..000000000 --- a/FS/t/svc_www.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::svc_www; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/type_pkgs.t b/FS/t/type_pkgs.t deleted file mode 100644 index 98401805c..000000000 --- a/FS/t/type_pkgs.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::type_pkgs; -$loaded=1; -print "ok 1\n"; -- cgit v1.2.1 From eb6cb474f653dc738b26c9f8ca9b43e9b6f1e546 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 23 Aug 2002 23:43:51 +0000 Subject: add domain_shellcommands export --- FS/FS/part_export.pm | 19 +++++ FS/FS/part_export/domain_shellcommands.pm | 113 ++++++++++++++++++++++++++++++ FS/MANIFEST | 2 + FS/t/part_export-domain_shellcommands.t | 5 ++ 4 files changed, 139 insertions(+) create mode 100644 FS/FS/part_export/domain_shellcommands.pm create mode 100644 FS/t/part_export-domain_shellcommands.t (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 4f45fbeec..67b3cade5 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -594,6 +594,19 @@ tie my %www_shellcommands_options, 'Tie::IxHash', }, ; +tie my %domain_shellcommands_options, 'Tie::IxHash', + 'user' => { lable=>'Remote username', default=>'root' }, + 'useradd' => { label=>'Insert command', + default=>'', + }, + 'userdel' => { label=>'Delete command', + default=>'', + }, + 'usermod' => { label=>'Modify command', + default=>'', + }, +; + tie my %textradius_options, 'Tie::IxHash', 'user' => { label=>'Remote username', default=>'root' }, 'users' => { label=>'users file location', default=>'/etc/raddb/users' }, @@ -797,6 +810,12 @@ tie my %sqlmail_options, 'Tie::IxHash', 'notes' => 'Database schema can be made to work with Courier IMAP and Exim. Others could work but are untested. (...extended description from pc-intouch?...)', }, + 'domain_shellcommands' => { + 'desc' => 'Run remote commands via SSH, for domains.', + 'options' => \%domain_shellcommands_options, + 'notes' => 'Run remote commands via SSH, for domains. You will need to setup SSH for unattended operation.', + }, + }, diff --git a/FS/FS/part_export/domain_shellcommands.pm b/FS/FS/part_export/domain_shellcommands.pm new file mode 100644 index 000000000..d2f55e5ad --- /dev/null +++ b/FS/FS/part_export/domain_shellcommands.pm @@ -0,0 +1,113 @@ +package FS::part_export::domain_shellcommands; + +use strict; +use vars qw(@ISA); +use FS::part_export; + +@ISA = qw(FS::part_export); + +sub rebless { shift; } + +sub _export_insert { + my($self) = shift; + $self->_export_command('useradd', @_); +} + +sub _export_delete { + my($self) = shift; + $self->_export_command('userdel', @_); +} + +sub _export_command { + my ( $self, $action, $svc_domain) = (shift, shift, shift); + my $command = $self->option($action); + + #set variable for the command + { + no strict 'refs'; + ${$_} = $svc_domain->getfield($_) foreach $svc_domain->fields; + } + +# my $domain_record = $svc_www->domain_record; # or die ? +# my $zone = $domain_record->reczone; # or die ? +# unless ( $zone =~ /\.$/ ) { +# my $svc_domain = $domain_record->svc_domain; # or die ? +# $zone .= '.'. $svc_domain->domain; +# } + +# my $svc_acct = $svc_www->svc_acct; # or die ? +# my $username = $svc_acct->username; +# my $homedir = $svc_acct->dir; # or die ? + + #done setting variables for the command + + $self->shellcommands_queue( $svc_domain->svcnum, + user => $self->option('user')||'root', + host => $self->machine, + command => eval(qq("$command")), + ); +} + +sub _export_replace { + my($self, $new, $old ) = (shift, shift, shift); + my $command = $self->option('usermod'); + + #set variable for the command + { + no strict 'refs'; + ${"old_$_"} = $old->getfield($_) foreach $old->fields; + ${"new_$_"} = $new->getfield($_) foreach $new->fields; + } +# my $old_domain_record = $old->domain_record; # or die ? +# my $old_zone = $old_domain_record->reczone; # or die ? +# unless ( $old_zone =~ /\.$/ ) { +# my $old_svc_domain = $old_domain_record->svc_domain; # or die ? +# $old_zone .= '.'. $old_svc_domain->domain; +# } +# +# my $old_svc_acct = $old->svc_acct; # or die ? +# my $old_username = $old_svc_acct->username; +# my $old_homedir = $old_svc_acct->dir; # or die ? +# +# my $new_domain_record = $new->domain_record; # or die ? +# my $new_zone = $new_domain_record->reczone; # or die ? +# unless ( $new_zone =~ /\.$/ ) { +# my $new_svc_domain = $new_domain_record->svc_domain; # or die ? +# $new_zone .= '.'. $new_svc_domain->domain; +# } + +# my $new_svc_acct = $new->svc_acct; # or die ? +# my $new_username = $new_svc_acct->username; +# my $new_homedir = $new_svc_acct->dir; # or die ? + + #done setting variables for the command + + $self->shellcommands_queue( $new->svcnum, + user => $self->option('user')||'root', + host => $self->machine, + command => eval(qq("$command")), + ); +} + +#a good idea to queue anything that could fail or take any time +sub shellcommands_queue { + my( $self, $svcnum ) = (shift, shift); + my $queue = new FS::queue { + 'svcnum' => $svcnum, + 'job' => "FS::part_export::domain_shellcommands::ssh_cmd", + }; + $queue->insert( @_ ); +} + +sub ssh_cmd { #subroutine, not method + use Net::SSH '0.06'; + &Net::SSH::ssh_cmd( { @_ } ); +} + +#sub shellcommands_insert { #subroutine, not method +#} +#sub shellcommands_replace { #subroutine, not method +#} +#sub shellcommands_delete { #subroutine, not method +#} + diff --git a/FS/MANIFEST b/FS/MANIFEST index 8355e40fb..5737d620f 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -59,6 +59,7 @@ FS/part_export/bind_slave.pm FS/part_export/bsdshell.pm FS/part_export/cp.pm FS/part_export/cyrus.pm +FS/part_export/domain_shellcommands.pm FS/part_export/http.pm FS/part_export/infostreet.pm FS/part_export/null.pm @@ -132,6 +133,7 @@ t/part_export-bind_slave.t t/part_export-bsdshell.t t/part_export-cp.t t/part_export-cyrus.t +t/part_export-domain_shellcommands.t t/part_export-http.t t/part_export-infostreet.t t/part_export-null.t diff --git a/FS/t/part_export-domain_shellcommands.t b/FS/t/part_export-domain_shellcommands.t new file mode 100644 index 000000000..a2a44fbfb --- /dev/null +++ b/FS/t/part_export-domain_shellcommands.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::domain_shellcommands; +$loaded=1; +print "ok 1\n"; -- cgit v1.2.1 From 5ba6bdd59b4a8a10c92e71b0519e87ca4ab99043 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 24 Aug 2002 00:16:26 +0000 Subject: Added Files: bin/freeside-addoutsource --- FS/MANIFEST | 1 + FS/bin/freeside-addoutsource | 24 ++++++++++++++++++++++++ 2 files changed, 25 insertions(+) create mode 100644 FS/bin/freeside-addoutsource (limited to 'FS') diff --git a/FS/MANIFEST b/FS/MANIFEST index 5737d620f..18842df23 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -7,6 +7,7 @@ bin/freeside-bill bin/freeside-daily bin/freeside-email bin/freeside-queued +bin/freeside-addoutsource bin/freeside-apply-credits bin/freeside-adduser bin/freeside-setinvoice diff --git a/FS/bin/freeside-addoutsource b/FS/bin/freeside-addoutsource new file mode 100644 index 000000000..39ecba6ad --- /dev/null +++ b/FS/bin/freeside-addoutsource @@ -0,0 +1,24 @@ +#!/bin/sh + +domain=$1 + +createdb $domain && \ +\ +mkdir /usr/local/etc/freeside/conf.DBI:Pg:host=localhost\;dbname=$domain && \ +\ +chown freeside /usr/local/etc/freeside/conf.DBI:Pg:host=localhost\;dbname=$domain && \ +\ +cp /home/ivan/freeside/conf[a-z]* /usr/local/etc/freeside/conf.DBI:Pg:host=localhost\;dbname=$domain && \ +\ +touch /usr/local/etc/freeside/conf.DBI:Pg:host=localhost\;dbname=$domain/secrets && \ +\ +chown freeside /usr/local/etc/freeside/conf.DBI:Pg:host=localhost\;dbname=$domain/secrets && \ +\ +chmod 600 /usr/local/etc/freeside/conf.DBI:Pg:host=localhost\;dbname=$domain/secrets && \ +\ +echo -e "DBI:Pg:host=localhost;dbname=$domain\nfreeside\n" >/usr/local/etc/freeside/conf.DBI:Pg:host=localhost\;dbname=$domain/secrets && \ +\ +mkdir /usr/local/etc/freeside/counters.DBI:Pg:host=localhost\;dbname=$domain && \ +mkdir /usr/local/etc/freeside/cache.DBI:Pg:host=localhost\;dbname=$domain && \ +mkdir /usr/local/etc/freeside/export.DBI:Pg:host=localhost\;dbname=$domain + -- cgit v1.2.1 From 748983cb2a2cd21a82950c5000088508a416d670 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 24 Aug 2002 01:53:55 +0000 Subject: depend on Net::SSH 0.07, for -T fix --- FS/bin/freeside-queued | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/bin/freeside-queued b/FS/bin/freeside-queued index 83074b9e4..311fe62f9 100644 --- a/FS/bin/freeside-queued +++ b/FS/bin/freeside-queued @@ -15,7 +15,7 @@ use FS::queue_depend; # no autoloading just yet use FS::cust_main; use FS::svc_acct; -use Net::SSH 0.06; +use Net::SSH 0.07; use FS::part_export; $max_kids = '10'; #guess it should be a config file... -- cgit v1.2.1 From e0729955b2ad10fba02399afafec68fe5ccab97a Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 24 Aug 2002 02:10:54 +0000 Subject: fix path --- FS/bin/freeside-addoutsource | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/bin/freeside-addoutsource b/FS/bin/freeside-addoutsource index 39ecba6ad..5cec17f46 100644 --- a/FS/bin/freeside-addoutsource +++ b/FS/bin/freeside-addoutsource @@ -8,7 +8,7 @@ mkdir /usr/local/etc/freeside/conf.DBI:Pg:host=localhost\;dbname=$domain && \ \ chown freeside /usr/local/etc/freeside/conf.DBI:Pg:host=localhost\;dbname=$domain && \ \ -cp /home/ivan/freeside/conf[a-z]* /usr/local/etc/freeside/conf.DBI:Pg:host=localhost\;dbname=$domain && \ +cp /home/ivan/freeside/conf/[a-z]* /usr/local/etc/freeside/conf.DBI:Pg:host=localhost\;dbname=$domain && \ \ touch /usr/local/etc/freeside/conf.DBI:Pg:host=localhost\;dbname=$domain/secrets && \ \ -- cgit v1.2.1 From 22abdc37d4ec5699b62d295dc7ec1e41a8daf23b Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 24 Aug 2002 06:41:50 +0000 Subject: - depend on Net::SSH 0.07, for OpenSSH -T fix - no strict 'vars'; when necessary --- FS/FS/part_export/domain_shellcommands.pm | 4 +++- FS/FS/part_export/shellcommands.pm | 4 +++- FS/FS/part_export/www_shellcommands.pm | 4 +++- 3 files changed, 9 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export/domain_shellcommands.pm b/FS/FS/part_export/domain_shellcommands.pm index d2f55e5ad..5b3cd5d79 100644 --- a/FS/FS/part_export/domain_shellcommands.pm +++ b/FS/FS/part_export/domain_shellcommands.pm @@ -23,6 +23,7 @@ sub _export_command { my $command = $self->option($action); #set variable for the command + no strict 'vars'; { no strict 'refs'; ${$_} = $svc_domain->getfield($_) foreach $svc_domain->fields; @@ -53,6 +54,7 @@ sub _export_replace { my $command = $self->option('usermod'); #set variable for the command + no strict 'vars'; { no strict 'refs'; ${"old_$_"} = $old->getfield($_) foreach $old->fields; @@ -100,7 +102,7 @@ sub shellcommands_queue { } sub ssh_cmd { #subroutine, not method - use Net::SSH '0.06'; + use Net::SSH '0.07'; &Net::SSH::ssh_cmd( { @_ } ); } diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm index e4005761b..869544da5 100644 --- a/FS/FS/part_export/shellcommands.pm +++ b/FS/FS/part_export/shellcommands.pm @@ -24,6 +24,7 @@ sub _export_command { my ( $self, $action, $svc_acct) = (shift, shift, shift); my $command = $self->option($action); my $stdin = $self->option($action."_stdin"); + no strict 'vars'; { no strict 'refs'; ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields; @@ -44,6 +45,7 @@ sub _export_replace { my($self, $new, $old ) = (shift, shift, shift); my $command = $self->option('usermod'); my $stdin = $self->option('usermod_stdin'); + no strict 'vars'; { no strict 'refs'; ${"old_$_"} = $old->getfield($_) foreach $old->fields; @@ -72,7 +74,7 @@ sub shellcommands_queue { } sub ssh_cmd { #subroutine, not method - use Net::SSH '0.06'; + use Net::SSH '0.07'; &Net::SSH::ssh_cmd( { @_ } ); } diff --git a/FS/FS/part_export/www_shellcommands.pm b/FS/FS/part_export/www_shellcommands.pm index 84c162761..e5b95dc1f 100644 --- a/FS/FS/part_export/www_shellcommands.pm +++ b/FS/FS/part_export/www_shellcommands.pm @@ -23,6 +23,7 @@ sub _export_command { my $command = $self->option($action); #set variable for the command + no strict 'vars'; { no strict 'refs'; ${$_} = $svc_www->getfield($_) foreach $svc_www->fields; @@ -52,6 +53,7 @@ sub _export_replace { my $command = $self->option('usermod'); #set variable for the command + no strict 'vars'; { no strict 'refs'; ${"old_$_"} = $old->getfield($_) foreach $old->fields; @@ -99,7 +101,7 @@ sub shellcommands_queue { } sub ssh_cmd { #subroutine, not method - use Net::SSH '0.06'; + use Net::SSH '0.07'; &Net::SSH::ssh_cmd( { @_ } ); } -- cgit v1.2.1 From 04b8684b43afb358a77fe1af8dea18519111ef54 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 24 Aug 2002 07:43:18 +0000 Subject: allow $domain as a variable in commands --- FS/FS/part_export/shellcommands.pm | 2 ++ 1 file changed, 2 insertions(+) (limited to 'FS') diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm index 869544da5..d69848f22 100644 --- a/FS/FS/part_export/shellcommands.pm +++ b/FS/FS/part_export/shellcommands.pm @@ -30,6 +30,7 @@ sub _export_command { ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields; } $finger = shell_quote $finger; + $domain = $svc_acct->domain; $crypt_password = ''; #surpress "used only once" warnings $crypt_password = crypt( $svc_acct->_password, $saltset[int(rand(64))].$saltset[int(rand(64))] ); @@ -52,6 +53,7 @@ sub _export_replace { ${"new_$_"} = $new->getfield($_) foreach $new->fields; } $new_finger = shell_quote $new_finger; + $new_domain = $new->domain; $new_crypt_password = ''; #surpress "used only once" warnings $new_crypt_password = crypt( $new->_password, $saltset[int(rand(64))].$saltset[int(rand(64))]); -- cgit v1.2.1 From 621e56df7cb76802799f7939424e0d0c8bab40fd Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 24 Aug 2002 08:13:25 +0000 Subject: also do -b flag --- FS/bin/freeside-adduser | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-adduser b/FS/bin/freeside-adduser index 9d424634b..3ac3cffa1 100644 --- a/FS/bin/freeside-adduser +++ b/FS/bin/freeside-adduser @@ -1,21 +1,23 @@ #!/usr/bin/perl -w # -# $Id: freeside-adduser,v 1.4 2002-02-06 14:58:05 ivan Exp $ +# $Id: freeside-adduser,v 1.5 2002-08-24 08:13:25 ivan Exp $ use strict; -use vars qw($opt_h $opt_c $opt_s); +use vars qw($opt_h $opt_b $opt_c $opt_s); use Getopt::Std; my $FREESIDE_CONF = "/usr/local/etc/freeside"; -getopts("ch:s:"); +getopts("bch:s:"); die &usage if $opt_c && ! $opt_h; my $user = shift or die &usage; if ( $opt_h ) { my @args = ( 'htpasswd' ); + push @args, '-b' if $opt_b; push @args, '-c' if $opt_c; push @args, $opt_h, $user; + push @args, shift if $opt_b; system(@args) == 0 or die "htpasswd failed: $?"; } -- cgit v1.2.1 From 8675d7f9367456118663ddc28907bcd69d6dae94 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 25 Aug 2002 01:09:50 +0000 Subject: doc --- FS/bin/freeside-adduser | 8 +- FS/bin/freeside-setup | 1031 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 1036 insertions(+), 3 deletions(-) create mode 100755 FS/bin/freeside-setup (limited to 'FS') diff --git a/FS/bin/freeside-adduser b/FS/bin/freeside-adduser index 3ac3cffa1..e9b300823 100644 --- a/FS/bin/freeside-adduser +++ b/FS/bin/freeside-adduser @@ -1,6 +1,6 @@ #!/usr/bin/perl -w # -# $Id: freeside-adduser,v 1.5 2002-08-24 08:13:25 ivan Exp $ +# $Id: freeside-adduser,v 1.6 2002-08-25 01:09:50 ivan Exp $ use strict; use vars qw($opt_h $opt_b $opt_c $opt_s); @@ -47,13 +47,15 @@ sales/tech folks) to the web interface, not for adding customer accounts. -h: Also call htpasswd for this user with the given filename - -c: Passed to htpasswd + -c: Passed to htpasswd(1) -s: Specify an alternate secret file + -b: same as htpasswd(1), probably insecure, not recommended + =head1 SEE ALSO -L, base Freeside documentation +L(1), base Freeside documentation =cut diff --git a/FS/bin/freeside-setup b/FS/bin/freeside-setup new file mode 100755 index 000000000..21defa6e5 --- /dev/null +++ b/FS/bin/freeside-setup @@ -0,0 +1,1031 @@ +#!/usr/bin/perl -Tw + +#to delay loading dbdef until we're ready +BEGIN { $FS::Record::setup_hack = 1; } + +use strict; +use DBI; +use DBIx::DBSchema 0.20; +use DBIx::DBSchema::Table; +use DBIx::DBSchema::Column; +use DBIx::DBSchema::ColGroup::Unique; +use DBIx::DBSchema::ColGroup::Index; +use FS::UID qw(adminsuidsetup datasrc checkeuid getsecrets); +use FS::Record; +use FS::cust_main_county; +use FS::raddb; +use FS::part_bill_event; + +die "Not running uid freeside!" unless checkeuid(); + +my %attrib2db = + map { lc($FS::raddb::attrib{$_}) => $_ } keys %FS::raddb::attrib; + +my $user = shift or die &usage; +getsecrets($user); + +#needs to match FS::Record +my($dbdef_file) = "/usr/local/etc/freeside/dbdef.". datasrc; + +### + +#print "\nEnter the maximum username length: "; +#my($username_len)=&getvalue; +my $username_len = 32; #usernamemax config file + +print "\n\n", <); + chop $x; + $x; +} + +sub _yesno { + print " [y/N]:"; + my $x = scalar(); + $x =~ /^y/i; +} + +### + +my($char_d) = 80; #default maxlength for text fields + +#my(@date_type) = ( 'timestamp', '', '' ); +my(@date_type) = ( 'int', 'NULL', '' ); +my(@perl_type) = ( 'text', 'NULL', '' ); +my @money_type = ( 'decimal', '', '10,2' ); + +### +# create a dbdef object from the old data structure +### + +my(%tables)=&tables_hash_hack; + +#turn it into objects +my($dbdef) = new DBIx::DBSchema ( map { + my(@columns); + while (@{$tables{$_}{'columns'}}) { + my($name,$type,$null,$length)=splice @{$tables{$_}{'columns'}}, 0, 4; + push @columns, new DBIx::DBSchema::Column ( $name,$type,$null,$length ); + } + DBIx::DBSchema::Table->new( + $_, + $tables{$_}{'primary_key'}, + DBIx::DBSchema::ColGroup::Unique->new($tables{$_}{'unique'}), + DBIx::DBSchema::ColGroup::Index->new($tables{$_}{'index'}), + @columns, + ); +} (keys %tables) ); + +my $cust_main = $dbdef->table('cust_main'); +unless ($ship) { #remove ship_ from cust_main + $cust_main->delcolumn($_) foreach ( grep /^ship_/, $cust_main->columns ); +} else { #add indices on ship_last and ship_company + push @{$cust_main->index->lol_ref}, ( ['ship_last'], ['ship_company'] ) +} + +#add radius attributes to svc_acct + +my($svc_acct)=$dbdef->table('svc_acct'); + +my($attribute); +foreach $attribute (@attributes) { + $svc_acct->addcolumn ( new DBIx::DBSchema::Column ( + 'radius_'. $attribute, + 'varchar', + 'NULL', + $char_d, + )); +} + +foreach $attribute (@check_attributes) { + $svc_acct->addcolumn( new DBIx::DBSchema::Column ( + 'rc_'. $attribute, + 'varchar', + 'NULL', + $char_d, + )); +} + +##make part_svc table (but now as object) +# +#my($part_svc)=$dbdef->table('part_svc'); +# +##because of svc_acct_pop +##foreach (grep /^svc_/, $dbdef->tables) { +##foreach (qw(svc_acct svc_acct_sm svc_charge svc_domain svc_wo)) { +#foreach (qw(svc_acct svc_domain svc_forward svc_www)) { +# my($table)=$dbdef->table($_); +# my($col); +# foreach $col ( $table->columns ) { +# next if $col =~ /^svcnum$/; +# $part_svc->addcolumn( new DBIx::DBSchema::Column ( +# $table->name. '__' . $table->column($col)->name, +# 'varchar', #$table->column($col)->type, +# 'NULL', +# $char_d, #$table->column($col)->length, +# )); +# $part_svc->addcolumn ( new DBIx::DBSchema::Column ( +# $table->name. '__'. $table->column($col)->name . "_flag", +# 'char', +# 'NULL', +# 1, +# )); +# } +#} + +#create history tables (false laziness w/create-history-tables) +foreach my $table ( grep { ! /^h_/ } $dbdef->tables ) { + my $tableobj = $dbdef->table($table) + or die "unknown table $table"; + + die "unique->lol_ref undefined for $table" + unless defined $tableobj->unique->lol_ref; + die "index->lol_ref undefined for $table" + unless defined $tableobj->index->lol_ref; + + my $h_tableobj = DBIx::DBSchema::Table->new( { + name => "h_$table", + primary_key => 'historynum', + unique => DBIx::DBSchema::ColGroup::Unique->new( [] ), + 'index' => DBIx::DBSchema::ColGroup::Index->new( [ + @{$tableobj->unique->lol_ref}, + @{$tableobj->index->lol_ref} + ] ), + columns => [ + DBIx::DBSchema::Column->new( { + 'name' => 'historynum', + 'type' => 'serial', + 'null' => 'NOT NULL', + 'length' => '', + 'default' => '', + 'local' => '', + } ), + DBIx::DBSchema::Column->new( { + 'name' => 'history_date', + 'type' => 'int', + 'null' => 'NULL', + 'length' => '', + 'default' => '', + 'local' => '', + } ), + DBIx::DBSchema::Column->new( { + 'name' => 'history_user', + 'type' => 'varchar', + 'null' => 'NOT NULL', + 'length' => '80', + 'default' => '', + 'local' => '', + } ), + DBIx::DBSchema::Column->new( { + 'name' => 'history_action', + 'type' => 'varchar', + 'null' => 'NOT NULL', + 'length' => '80', + 'default' => '', + 'local' => '', + } ), + map { $tableobj->column($_) } $tableobj->columns + ], + } ); + $dbdef->addtable($h_tableobj); +} + +#important +$dbdef->save($dbdef_file); +&FS::Record::reload_dbdef($dbdef_file); + +### +# create 'em +### + +my($dbh)=adminsuidsetup $user; + +#create tables +$|=1; + +foreach my $statement ( $dbdef->sql($dbh) ) { + $dbh->do( $statement ) + or die "CREATE error: ". $dbh->errstr. "\ndoing statement: $statement"; +} + +#not really sample data (and shouldn't default to US) + +#cust_main_county + +#USPS state codes +foreach ( qw( +AL AK AS AZ AR CA CO CT DC DE FM FL GA GU HI ID IL IN IA KS KY LA +ME MH MD MA MI MN MS MO MT NC ND NE NH NJ NM NV NY MP OH OK OR PA PW PR RI +SC SD TN TX UT VT VI VA WA WV WI WY AE AA AP +) ) { + my($cust_main_county)=new FS::cust_main_county({ + 'state' => $_, + 'tax' => 0, + 'country' => 'US', + }); + my($error); + $error=$cust_main_county->insert; + die $error if $error; +} + +#AU "offical" state codes ala mark.williamson@ebbs.com.au (Mark Williamson) +foreach ( qw( +VIC NSW NT QLD TAS ACT WA SA +) ) { + my($cust_main_county)=new FS::cust_main_county({ + 'state' => $_, + 'tax' => 0, + 'country' => 'AU', + }); + my($error); + $error=$cust_main_county->insert; + die $error if $error; +} + +#ISO 2-letter country codes (same as country TLDs) except US and AU +foreach ( qw( +AF AL DZ AS AD AO AI AQ AG AR AM AW AT AZ BS BH BD BB BY BE BZ BJ BM BT BO +BA BW BV BR IO BN BG BF BI KH CM CA CV KY CF TD CL CN CX CC CO KM CG CK CR CI +HR CU CY CZ DK DJ DM DO TP EC EG SV GQ ER EE ET FK FO FJ FI FR FX GF PF TF GA +GM GE DE GH GI GR GL GD GP GU GT GN GW GY HT HM HN HK HU IS IN ID IR IQ IE IL +IT JM JP JO KZ KE KI KP KR KW KG LA LV LB LS LR LY LI LT LU MO MK MG MW MY MV +ML MT MH MQ MR MU YT MX FM MD MC MN MS MA MZ MM NA NR NP NL AN NC NZ NI NE NG +NU NF MP NO OM PK PW PA PG PY PE PH PN PL PT PR QA RE RO RU RW KN LC VC WS SM +ST SA SN SC SL SG SK SI SB SO ZA GS ES LK SH PM SD SR SJ SZ SE CH SY TW TJ TZ +TH TG TK TO TT TN TR TM TC TV UG UA AE GB UM UY UZ VU VA VE VN VG VI WF EH +YE YU ZR ZM ZW +) ) { + my($cust_main_county)=new FS::cust_main_county({ + 'tax' => 0, + 'country' => $_, + }); + my($error); + $error=$cust_main_county->insert; + die $error if $error; +} + +#billing events +foreach my $aref ( + [ 'COMP', 'Comp invoice', '$cust_bill->comp();', 30, 'comp' ], + [ 'CARD', 'Batch card', '$cust_bill->batch_card();', 40, 'batch-card' ], + [ 'BILL', 'Send invoice', '$cust_bill->send();', 50, 'send' ], +) { + + my $part_bill_event = new FS::part_bill_event({ + 'payby' => $aref->[0], + 'event' => $aref->[1], + 'eventcode' => $aref->[2], + 'seconds' => 0, + 'weight' => $aref->[3], + 'plan' => $aref->[4], + }); + my($error); + $error=$part_bill_event->insert; + die $error if $error; + +} + +$dbh->commit or die $dbh->errstr; +$dbh->disconnect or die $dbh->errstr; + +print "Freeside database initialized sucessfully\n"; + +sub usage { + die "Usage:\n fs-setup user\n"; +} + +### +# Now it becomes an object. much better. +### +sub tables_hash_hack { + + #note that s/(date|change)/_$1/; to avoid keyword conflict. + #put a kludge in FS::Record to catch this or? (pry need some date-handling + #stuff anyway also) + + my(%tables)=( #yech.} + + 'agent' => { + 'columns' => [ + 'agentnum', 'int', '', '', + 'agent', 'varchar', '', $char_d, + 'typenum', 'int', '', '', + 'freq', 'int', 'NULL', '', + 'prog', @perl_type, + ], + 'primary_key' => 'agentnum', + 'unique' => [], + 'index' => [ ['typenum'] ], + }, + + 'agent_type' => { + 'columns' => [ + 'typenum', 'int', '', '', + 'atype', 'varchar', '', $char_d, + ], + 'primary_key' => 'typenum', + 'unique' => [], + 'index' => [], + }, + + 'type_pkgs' => { + 'columns' => [ + 'typenum', 'int', '', '', + 'pkgpart', 'int', '', '', + ], + 'primary_key' => '', + 'unique' => [ ['typenum', 'pkgpart'] ], + 'index' => [ ['typenum'] ], + }, + + 'cust_bill' => { + 'columns' => [ + 'invnum', 'int', '', '', + 'custnum', 'int', '', '', + '_date', @date_type, + 'charged', @money_type, + 'printed', 'int', '', '', + 'closed', 'char', 'NULL', 1, + ], + 'primary_key' => 'invnum', + 'unique' => [], + 'index' => [ ['custnum'] ], + }, + + 'cust_bill_event' => { + 'columns' => [ + 'eventnum', 'int', '', '', + 'invnum', 'int', '', '', + 'eventpart', 'int', '', '', + '_date', @date_type, + 'status', 'varchar', '', $char_d, + 'statustext', 'text', 'NULL', '', + ], + 'primary_key' => 'eventnum', + #no... there are retries now #'unique' => [ [ 'eventpart', 'invnum' ] ], + 'unique' => [], + 'index' => [ ['invnum'], ['status'] ], + }, + + 'part_bill_event' => { + 'columns' => [ + 'eventpart', 'int', '', '', + 'payby', 'char', '', 4, + 'event', 'varchar', '', $char_d, + 'eventcode', @perl_type, + 'seconds', 'int', 'NULL', '', + 'weight', 'int', '', '', + 'plan', 'varchar', 'NULL', $char_d, + 'plandata', 'text', 'NULL', '', + 'disabled', 'char', 'NULL', 1, + ], + 'primary_key' => 'eventpart', + 'unique' => [], + 'index' => [ ['payby'] ], + }, + + 'cust_bill_pkg' => { + 'columns' => [ + 'pkgnum', 'int', '', '', + 'invnum', 'int', '', '', + 'setup', @money_type, + 'recur', @money_type, + 'sdate', @date_type, + 'edate', @date_type, + ], + 'primary_key' => '', + 'unique' => [ ['pkgnum', 'invnum'] ], + 'index' => [ ['invnum'] ], + }, + + 'cust_credit' => { + 'columns' => [ + 'crednum', 'int', '', '', + 'custnum', 'int', '', '', + '_date', @date_type, + 'amount', @money_type, + 'otaker', 'varchar', '', 8, + 'reason', 'text', 'NULL', '', + 'closed', 'char', 'NULL', 1, + ], + 'primary_key' => 'crednum', + 'unique' => [], + 'index' => [ ['custnum'] ], + }, + + 'cust_credit_bill' => { + 'columns' => [ + 'creditbillnum', 'int', '', '', + 'crednum', 'int', '', '', + 'invnum', 'int', '', '', + '_date', @date_type, + 'amount', @money_type, + ], + 'primary_key' => 'creditbillnum', + 'unique' => [], + 'index' => [ ['crednum'], ['invnum'] ], + }, + + 'cust_main' => { + 'columns' => [ + 'custnum', 'int', '', '', + 'agentnum', 'int', '', '', +# 'titlenum', 'int', 'NULL', '', + 'last', 'varchar', '', $char_d, +# 'middle', 'varchar', 'NULL', $char_d, + 'first', 'varchar', '', $char_d, + 'ss', 'char', 'NULL', 11, + 'company', 'varchar', 'NULL', $char_d, + 'address1', 'varchar', '', $char_d, + 'address2', 'varchar', 'NULL', $char_d, + 'city', 'varchar', '', $char_d, + 'county', 'varchar', 'NULL', $char_d, + 'state', 'varchar', 'NULL', $char_d, + 'zip', 'varchar', '', 10, + 'country', 'char', '', 2, + 'daytime', 'varchar', 'NULL', 20, + 'night', 'varchar', 'NULL', 20, + 'fax', 'varchar', 'NULL', 12, + 'ship_last', 'varchar', 'NULL', $char_d, +# 'ship_middle', 'varchar', 'NULL', $char_d, + 'ship_first', 'varchar', 'NULL', $char_d, + 'ship_company', 'varchar', 'NULL', $char_d, + 'ship_address1', 'varchar', 'NULL', $char_d, + 'ship_address2', 'varchar', 'NULL', $char_d, + 'ship_city', 'varchar', 'NULL', $char_d, + 'ship_county', 'varchar', 'NULL', $char_d, + 'ship_state', 'varchar', 'NULL', $char_d, + 'ship_zip', 'varchar', 'NULL', 10, + 'ship_country', 'char', 'NULL', 2, + 'ship_daytime', 'varchar', 'NULL', 20, + 'ship_night', 'varchar', 'NULL', 20, + 'ship_fax', 'varchar', 'NULL', 12, + 'payby', 'char', '', 4, + 'payinfo', 'varchar', 'NULL', $char_d, + #'paydate', @date_type, + 'paydate', 'varchar', 'NULL', 10, + 'payname', 'varchar', 'NULL', $char_d, + 'tax', 'char', 'NULL', 1, + 'otaker', 'varchar', '', 8, + 'refnum', 'int', '', '', + 'referral_custnum', 'int', 'NULL', '', + 'comments', 'text', 'NULL', '', + ], + 'primary_key' => 'custnum', + 'unique' => [], + #'index' => [ ['last'], ['company'] ], + 'index' => [ ['last'], [ 'company' ], [ 'referral_custnum' ] ], + }, + + 'cust_main_invoice' => { + 'columns' => [ + 'destnum', 'int', '', '', + 'custnum', 'int', '', '', + 'dest', 'varchar', '', $char_d, + ], + 'primary_key' => 'destnum', + 'unique' => [], + 'index' => [ ['custnum'], ], + }, + + 'cust_main_county' => { #county+state+country are checked off the + #cust_main_county for validation and to provide + # a tax rate. + 'columns' => [ + 'taxnum', 'int', '', '', + 'state', 'varchar', 'NULL', $char_d, + 'county', 'varchar', 'NULL', $char_d, + 'country', 'char', '', 2, + 'taxclass', 'varchar', 'NULL', $char_d, + 'exempt_amount', @money_type, + 'tax', 'real', '', '', #tax % + ], + 'primary_key' => 'taxnum', + 'unique' => [], + # 'unique' => [ ['taxnum'], ['state', 'county'] ], + 'index' => [], + }, + + 'cust_pay' => { + 'columns' => [ + 'paynum', 'int', '', '', + #now cust_bill_pay #'invnum', 'int', '', '', + 'custnum', 'int', '', '', + 'paid', @money_type, + '_date', @date_type, + 'payby', 'char', '', 4, # CARD/BILL/COMP, should be index into + # payment type table. + 'payinfo', 'varchar', 'NULL', 16, #see cust_main above + 'paybatch', 'varchar', 'NULL', $char_d, #for auditing purposes. + 'closed', 'char', 'NULL', 1, + ], + 'primary_key' => 'paynum', + 'unique' => [], + 'index' => [ [ 'custnum' ], [ 'paybatch' ] ], + }, + + 'cust_bill_pay' => { + 'columns' => [ + 'billpaynum', 'int', '', '', + 'invnum', 'int', '', '', + 'paynum', 'int', '', '', + 'amount', @money_type, + '_date', @date_type + ], + 'primary_key' => 'billpaynum', + 'unique' => [], + 'index' => [ [ 'paynum' ], [ 'invnum' ] ], + }, + + 'cust_pay_batch' => { #what's this used for again? list of customers + #in current CARD batch? (necessarily CARD?) + 'columns' => [ + 'paybatchnum', 'int', '', '', + 'invnum', 'int', '', '', + 'custnum', 'int', '', '', + 'last', 'varchar', '', $char_d, + 'first', 'varchar', '', $char_d, + 'address1', 'varchar', '', $char_d, + 'address2', 'varchar', 'NULL', $char_d, + 'city', 'varchar', '', $char_d, + 'state', 'varchar', 'NULL', $char_d, + 'zip', 'varchar', '', 10, + 'country', 'char', '', 2, +# 'trancode', 'int', '', '', + 'cardnum', 'varchar', '', 16, + #'exp', @date_type, + 'exp', 'varchar', '', 11, + 'payname', 'varchar', 'NULL', $char_d, + 'amount', @money_type, + ], + 'primary_key' => 'paybatchnum', + 'unique' => [], + 'index' => [ ['invnum'], ['custnum'] ], + }, + + 'cust_pkg' => { + 'columns' => [ + 'pkgnum', 'int', '', '', + 'custnum', 'int', '', '', + 'pkgpart', 'int', '', '', + 'otaker', 'varchar', '', 8, + 'setup', @date_type, + 'bill', @date_type, + 'susp', @date_type, + 'cancel', @date_type, + 'expire', @date_type, + 'manual_flag', 'char', 'NULL', 1, + ], + 'primary_key' => 'pkgnum', + 'unique' => [], + 'index' => [ ['custnum'] ], + }, + + 'cust_refund' => { + 'columns' => [ + 'refundnum', 'int', '', '', + #now cust_credit_refund #'crednum', 'int', '', '', + 'custnum', 'int', '', '', + '_date', @date_type, + 'refund', @money_type, + 'otaker', 'varchar', '', 8, + 'reason', 'varchar', '', $char_d, + 'payby', 'char', '', 4, # CARD/BILL/COMP, should be index + # into payment type table. + 'payinfo', 'varchar', 'NULL', 16, #see cust_main above + 'paybatch', 'varchar', 'NULL', $char_d, + 'closed', 'char', 'NULL', 1, + ], + 'primary_key' => 'refundnum', + 'unique' => [], + 'index' => [], + }, + + 'cust_credit_refund' => { + 'columns' => [ + 'creditrefundnum', 'int', '', '', + 'crednum', 'int', '', '', + 'refundnum', 'int', '', '', + 'amount', @money_type, + '_date', @date_type + ], + 'primary_key' => 'creditrefundnum', + 'unique' => [], + 'index' => [ [ 'crednum', 'refundnum' ] ], + }, + + + 'cust_svc' => { + 'columns' => [ + 'svcnum', 'int', '', '', + 'pkgnum', 'int', 'NULL', '', + 'svcpart', 'int', '', '', + ], + 'primary_key' => 'svcnum', + 'unique' => [], + 'index' => [ ['svcnum'], ['pkgnum'], ['svcpart'] ], + }, + + 'part_pkg' => { + 'columns' => [ + 'pkgpart', 'int', '', '', + 'pkg', 'varchar', '', $char_d, + 'comment', 'varchar', '', $char_d, + 'setup', @perl_type, + 'freq', 'int', '', '', #billing frequency (months) + 'recur', @perl_type, + 'setuptax', 'char', 'NULL', 1, + 'recurtax', 'char', 'NULL', 1, + 'plan', 'varchar', 'NULL', $char_d, + 'plandata', 'text', 'NULL', '', + 'disabled', 'char', 'NULL', 1, + 'taxclass', 'varchar', 'NULL', $char_d, + ], + 'primary_key' => 'pkgpart', + 'unique' => [], + 'index' => [], + }, + +# 'part_title' => { +# 'columns' => [ +# 'titlenum', 'int', '', '', +# 'title', 'varchar', '', $char_d, +# ], +# 'primary_key' => 'titlenum', +# 'unique' => [ [] ], +# 'index' => [ [] ], +# }, + + 'pkg_svc' => { + 'columns' => [ + 'pkgpart', 'int', '', '', + 'svcpart', 'int', '', '', + 'quantity', 'int', '', '', + ], + 'primary_key' => '', + 'unique' => [ ['pkgpart', 'svcpart'] ], + 'index' => [ ['pkgpart'] ], + }, + + 'part_referral' => { + 'columns' => [ + 'refnum', 'int', '', '', + 'referral', 'varchar', '', $char_d, + ], + 'primary_key' => 'refnum', + 'unique' => [], + 'index' => [], + }, + + 'part_svc' => { + 'columns' => [ + 'svcpart', 'int', '', '', + 'svc', 'varchar', '', $char_d, + 'svcdb', 'varchar', '', $char_d, + 'disabled', 'char', 'NULL', 1, + ], + 'primary_key' => 'svcpart', + 'unique' => [], + 'index' => [], + }, + + 'part_svc_column' => { + 'columns' => [ + 'columnnum', 'int', '', '', + 'svcpart', 'int', '', '', + 'columnname', 'varchar', '', 64, + 'columnvalue', 'varchar', 'NULL', $char_d, + 'columnflag', 'char', 'NULL', 1, + ], + 'primary_key' => 'columnnum', + 'unique' => [ [ 'svcpart', 'columnname' ] ], + 'index' => [ [ 'svcpart' ] ], + }, + + #(this should be renamed to part_pop) + 'svc_acct_pop' => { + 'columns' => [ + 'popnum', 'int', '', '', + 'city', 'varchar', '', $char_d, + 'state', 'varchar', '', $char_d, + 'ac', 'char', '', 3, + 'exch', 'char', '', 3, + 'loc', 'char', 'NULL', 4, #NULL for legacy purposes + ], + 'primary_key' => 'popnum', + 'unique' => [], + 'index' => [ [ 'state' ] ], + }, + + 'part_pop_local' => { + 'columns' => [ + 'localnum', 'int', '', '', + 'popnum', 'int', '', '', + 'city', 'varchar', 'NULL', $char_d, + 'state', 'char', 'NULL', 2, + 'npa', 'char', '', 3, + 'nxx', 'char', '', 3, + ], + 'primary_key' => 'localnum', + 'unique' => [], + 'index' => [ [ 'npa', 'nxx' ], [ 'popnum' ] ], + }, + + 'svc_acct' => { + 'columns' => [ + 'svcnum', 'int', '', '', + 'username', 'varchar', '', $username_len, #unique (& remove dup code) + '_password', 'varchar', '', 50, #13 for encryped pw's plus ' *SUSPENDED* (mp5 passwords can be 34) + 'sec_phrase', 'varchar', 'NULL', $char_d, + 'popnum', 'int', 'NULL', '', + 'uid', 'int', 'NULL', '', + 'gid', 'int', 'NULL', '', + 'finger', 'varchar', 'NULL', $char_d, + 'dir', 'varchar', 'NULL', $char_d, + 'shell', 'varchar', 'NULL', $char_d, + 'quota', 'varchar', 'NULL', $char_d, + 'slipip', 'varchar', 'NULL', 15, #four TINYINTs, bah. + 'seconds', 'int', 'NULL', '', #uhhhh + 'domsvc', 'int', '', '', + ], + 'primary_key' => 'svcnum', + #'unique' => [ [ 'username', 'domsvc' ] ], + 'unique' => [], + 'index' => [ ['username'], ['domsvc'] ], + }, + +# 'svc_acct_sm' => { +# 'columns' => [ +# 'svcnum', 'int', '', '', +# 'domsvc', 'int', '', '', +# 'domuid', 'int', '', '', +# 'domuser', 'varchar', '', $char_d, +# ], +# 'primary_key' => 'svcnum', +# 'unique' => [ [] ], +# 'index' => [ ['domsvc'], ['domuid'] ], +# }, + + #'svc_charge' => { + # 'columns' => [ + # 'svcnum', 'int', '', '', + # 'amount', @money_type, + # ], + # 'primary_key' => 'svcnum', + # 'unique' => [ [] ], + # 'index' => [ [] ], + #}, + + 'svc_domain' => { + 'columns' => [ + 'svcnum', 'int', '', '', + 'domain', 'varchar', '', $char_d, + 'catchall', 'int', 'NULL', '', + ], + 'primary_key' => 'svcnum', + 'unique' => [ ['domain'] ], + 'index' => [], + }, + + 'domain_record' => { + 'columns' => [ + 'recnum', 'int', '', '', + 'svcnum', 'int', '', '', + 'reczone', 'varchar', '', $char_d, + 'recaf', 'char', '', 2, + 'rectype', 'char', '', 5, + 'recdata', 'varchar', '', $char_d, + ], + 'primary_key' => 'recnum', + 'unique' => [], + 'index' => [ ['svcnum'] ], + }, + + 'svc_forward' => { + 'columns' => [ + 'svcnum', 'int', '', '', + 'srcsvc', 'int', '', '', + 'dstsvc', 'int', '', '', + 'dst', 'varchar', 'NULL', $char_d, + ], + 'primary_key' => 'svcnum', + 'unique' => [], + 'index' => [ ['srcsvc'], ['dstsvc'] ], + }, + + 'svc_www' => { + 'columns' => [ + 'svcnum', 'int', '', '', + 'recnum', 'int', '', '', + 'usersvc', 'int', '', '', + ], + 'primary_key' => 'svcnum', + 'unique' => [], + 'index' => [], + }, + + #'svc_wo' => { + # 'columns' => [ + # 'svcnum', 'int', '', '', + # 'svcnum', 'int', '', '', + # 'svcnum', 'int', '', '', + # 'worker', 'varchar', '', $char_d, + # '_date', @date_type, + # ], + # 'primary_key' => 'svcnum', + # 'unique' => [ [] ], + # 'index' => [ [] ], + #}, + + 'prepay_credit' => { + 'columns' => [ + 'prepaynum', 'int', '', '', + 'identifier', 'varchar', '', $char_d, + 'amount', @money_type, + 'seconds', 'int', 'NULL', '', + ], + 'primary_key' => 'prepaynum', + 'unique' => [ ['identifier'] ], + 'index' => [], + }, + + 'port' => { + 'columns' => [ + 'portnum', 'int', '', '', + 'ip', 'varchar', 'NULL', 15, + 'nasport', 'int', 'NULL', '', + 'nasnum', 'int', '', '', + ], + 'primary_key' => 'portnum', + 'unique' => [], + 'index' => [], + }, + + 'nas' => { + 'columns' => [ + 'nasnum', 'int', '', '', + 'nas', 'varchar', '', $char_d, + 'nasip', 'varchar', '', 15, + 'nasfqdn', 'varchar', '', $char_d, + 'last', 'int', '', '', + ], + 'primary_key' => 'nasnum', + 'unique' => [ [ 'nas' ], [ 'nasip' ] ], + 'index' => [ [ 'last' ] ], + }, + + 'session' => { + 'columns' => [ + 'sessionnum', 'int', '', '', + 'portnum', 'int', '', '', + 'svcnum', 'int', '', '', + 'login', @date_type, + 'logout', @date_type, + ], + 'primary_key' => 'sessionnum', + 'unique' => [], + 'index' => [ [ 'portnum' ] ], + }, + + 'queue' => { + 'columns' => [ + 'jobnum', 'int', '', '', + 'job', 'text', '', '', + '_date', 'int', '', '', + 'status', 'varchar', '', $char_d, + 'statustext', 'text', 'NULL', '', + 'svcnum', 'int', 'NULL', '', + ], + 'primary_key' => 'jobnum', + 'unique' => [], + 'index' => [ [ 'svcnum' ], [ 'status' ] ], + }, + + 'queue_arg' => { + 'columns' => [ + 'argnum', 'int', '', '', + 'jobnum', 'int', '', '', + 'arg', 'text', 'NULL', '', + ], + 'primary_key' => 'argnum', + 'unique' => [], + 'index' => [ [ 'jobnum' ] ], + }, + + 'queue_depend' => { + 'columns' => [ + 'dependnum', 'int', '', '', + 'jobnum', 'int', '', '', + 'depend_jobnum', 'int', '', '', + ], + 'primary_key' => 'dependnum', + 'unique' => [], + 'index' => [ [ 'jobnum' ], [ 'depend_jobnum' ] ], + }, + + 'export_svc' => { + 'columns' => [ + 'exportsvcnum' => 'int', '', '', + 'exportnum' => 'int', '', '', + 'svcpart' => 'int', '', '', + ], + 'primary_key' => 'exportsvcnum', + 'unique' => [ [ 'exportnum', 'svcpart' ] ], + 'index' => [ [ 'exportnum' ], [ 'svcpart' ] ], + }, + + 'part_export' => { + 'columns' => [ + 'exportnum', 'int', '', '', + #'svcpart', 'int', '', '', + 'machine', 'varchar', '', $char_d, + 'exporttype', 'varchar', '', $char_d, + 'nodomain', 'char', 'NULL', 1, + ], + 'primary_key' => 'exportnum', + 'unique' => [], + 'index' => [ [ 'machine' ], [ 'exporttype' ] ], + }, + + 'part_export_option' => { + 'columns' => [ + 'optionnum', 'int', '', '', + 'exportnum', 'int', '', '', + 'optionname', 'varchar', '', $char_d, + 'optionvalue', 'text', 'NULL', '', + ], + 'primary_key' => 'optionnum', + 'unique' => [], + 'index' => [ [ 'exportnum' ], [ 'optionname' ] ], + }, + + 'radius_usergroup' => { + 'columns' => [ + 'usergroupnum', 'int', '', '', + 'svcnum', 'int', '', '', + 'groupname', 'varchar', '', $char_d, + ], + 'primary_key' => 'usergroupnum', + 'unique' => [], + 'index' => [ [ 'svcnum' ], [ 'groupname' ] ], + }, + + 'msgcat' => { + 'columns' => [ + 'msgnum', 'int', '', '', + 'msgcode', 'varchar', '', $char_d, + 'locale', 'varchar', '', 16, + 'msg', 'text', '', '', + ], + 'primary_key' => 'msgnum', + 'unique' => [ [ 'msgcode', 'locale' ] ], + 'index' => [], + }, + + 'cust_tax_exempt' => { + 'columns' => [ + 'exemptnum', 'int', '', '', + 'custnum', 'int', '', '', + 'taxnum', 'int', '', '', + 'year', 'int', '', '', + 'month', 'int', '', '', + 'amount', @money_type, + ], + 'primary_key' => 'exemptnum', + 'unique' => [ [ 'custnum', 'taxnum', 'year', 'month' ] ], + 'index' => [], + }, + + + + ); + + %tables; + +} + -- cgit v1.2.1 From ef92d87d1980598a4f786905ac7aff1af0ead2b8 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 25 Aug 2002 01:14:16 +0000 Subject: noninteractive freeside-setup --- FS/bin/freeside-setup | 77 ++++++++++++++++++++++++++++----------------------- 1 file changed, 42 insertions(+), 35 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-setup b/FS/bin/freeside-setup index 21defa6e5..a14f0e12b 100755 --- a/FS/bin/freeside-setup +++ b/FS/bin/freeside-setup @@ -4,6 +4,8 @@ BEGIN { $FS::Record::setup_hack = 1; } use strict; +use vars qw($opt_s); +use Getopt::Std; use DBI; use DBIx::DBSchema 0.20; use DBIx::DBSchema::Table; @@ -21,6 +23,7 @@ die "Not running uid freeside!" unless checkeuid(); my %attrib2db = map { lc($FS::raddb::attrib{$_}) => $_ } keys %FS::raddb::attrib; +getopts("s"); my $user = shift or die &usage; getsecrets($user); @@ -33,42 +36,46 @@ my($dbdef_file) = "/usr/local/etc/freeside/dbdef.". datasrc; #my($username_len)=&getvalue; my $username_len = 32; #usernamemax config file -print "\n\n", <); - chop $x; - $x; -} +#print "\n\n", <); +# chop $x; +# $x; +#} +# +#sub _yesno { +# print " [y/N]:"; +# my $x = scalar(); +# $x =~ /^y/i; +#} -sub _yesno { - print " [y/N]:"; - my $x = scalar(); - $x =~ /^y/i; -} +my @check_attributes = (); #add later +my @attributes = (); #add later +my $ship = $opt_s; ### -- cgit v1.2.1 From 3dc9eeed220e7f7adbf08526f109a190deb3f552 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 25 Aug 2002 01:16:30 +0000 Subject: doc --- FS/bin/freeside-adduser | 4 ++-- FS/bin/freeside-setup | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-adduser b/FS/bin/freeside-adduser index e9b300823..424123226 100644 --- a/FS/bin/freeside-adduser +++ b/FS/bin/freeside-adduser @@ -1,6 +1,6 @@ #!/usr/bin/perl -w # -# $Id: freeside-adduser,v 1.6 2002-08-25 01:09:50 ivan Exp $ +# $Id: freeside-adduser,v 1.7 2002-08-25 01:16:30 ivan Exp $ use strict; use vars qw($opt_h $opt_b $opt_c $opt_s); @@ -29,7 +29,7 @@ print MAPSECRETS "$user $secretfile\n"; close MAPSECRETS or die "can't close $FREESIDE_CONF/mapsecrets: $!"; sub usage { - die "Usage:\n\n freeside-adduser [ -h htpasswd_file [ -c ] ] [ -s secretfile ] username" + die "Usage:\n\n freeside-adduser [ -h htpasswd_file [ -c ] [ -b ] ] [ -s secretfile ] username" } =head1 NAME diff --git a/FS/bin/freeside-setup b/FS/bin/freeside-setup index a14f0e12b..78a03385c 100755 --- a/FS/bin/freeside-setup +++ b/FS/bin/freeside-setup @@ -320,10 +320,10 @@ foreach my $aref ( $dbh->commit or die $dbh->errstr; $dbh->disconnect or die $dbh->errstr; -print "Freeside database initialized sucessfully\n"; +#print "Freeside database initialized sucessfully\n"; sub usage { - die "Usage:\n fs-setup user\n"; + die "Usage:\n freeside-setup [ -s ] user\n"; } ### -- cgit v1.2.1 From f8a3854cc6186ae9dc2bfafd3a756224ed999cd7 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 25 Aug 2002 01:48:06 +0000 Subject: Added Files: bin/freeside-addoutsourceuser --- FS/MANIFEST | 2 ++ FS/bin/freeside-addoutsourceuser | 14 ++++++++++++++ 2 files changed, 16 insertions(+) create mode 100644 FS/bin/freeside-addoutsourceuser (limited to 'FS') diff --git a/FS/MANIFEST b/FS/MANIFEST index 18842df23..fff95c8c8 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -8,8 +8,10 @@ bin/freeside-daily bin/freeside-email bin/freeside-queued bin/freeside-addoutsource +bin/freeside-addoutsourceuser bin/freeside-apply-credits bin/freeside-adduser +bin/freeside-setup bin/freeside-setinvoice bin/freeside-overdue bin/freeside-receivables-report diff --git a/FS/bin/freeside-addoutsourceuser b/FS/bin/freeside-addoutsourceuser new file mode 100644 index 000000000..f76f39808 --- /dev/null +++ b/FS/bin/freeside-addoutsourceuser @@ -0,0 +1,14 @@ +#!/bin/sh + +username=$1 +domain=$2 + +freeside-adduser -h /usr/local/etc/freeside/htpasswd \ + -s /usr/local/etc/freeside/conf.DBI:Pg:host=localhost\;dbname=$domain/secrets \ + -b \ + $username $password + +[ -e /usr/local/etc/freeside/dbdef.DBI:Pg:host=localhost\;dbname=$domain ] \ + || ( freeside-setup $username; \ + /home/ivan/freeside/bin/populate-msgcat $username ) + -- cgit v1.2.1 From b181fa835716ef11055281416d685ef1f9242b0d Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 25 Aug 2002 01:48:38 +0000 Subject: password --- FS/bin/freeside-addoutsourceuser | 1 + 1 file changed, 1 insertion(+) (limited to 'FS') diff --git a/FS/bin/freeside-addoutsourceuser b/FS/bin/freeside-addoutsourceuser index f76f39808..5f18bdfac 100644 --- a/FS/bin/freeside-addoutsourceuser +++ b/FS/bin/freeside-addoutsourceuser @@ -2,6 +2,7 @@ username=$1 domain=$2 +password=$3 freeside-adduser -h /usr/local/etc/freeside/htpasswd \ -s /usr/local/etc/freeside/conf.DBI:Pg:host=localhost\;dbname=$domain/secrets \ -- cgit v1.2.1 From 8c90a85bd16e7d2aa1afeb1fdd38662d60645869 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 25 Aug 2002 02:26:30 +0000 Subject: properly quote password as well as finger --- FS/FS/part_export/shellcommands.pm | 3 +++ 1 file changed, 3 insertions(+) (limited to 'FS') diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm index d69848f22..3e9ac4a08 100644 --- a/FS/FS/part_export/shellcommands.pm +++ b/FS/FS/part_export/shellcommands.pm @@ -30,6 +30,7 @@ sub _export_command { ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields; } $finger = shell_quote $finger; + $_password = shell_quote $_password; $domain = $svc_acct->domain; $crypt_password = ''; #surpress "used only once" warnings $crypt_password = crypt( $svc_acct->_password, @@ -52,7 +53,9 @@ sub _export_replace { ${"old_$_"} = $old->getfield($_) foreach $old->fields; ${"new_$_"} = $new->getfield($_) foreach $new->fields; } + $old__password = shell_quote $old__password; $new_finger = shell_quote $new_finger; + $new__password = shell_quote $new__password; $new_domain = $new->domain; $new_crypt_password = ''; #surpress "used only once" warnings $new_crypt_password = crypt( $new->_password, -- cgit v1.2.1 From 77d08ccf7db6719dc7ad0e58eec8a8ca41f4115a Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 25 Aug 2002 02:35:05 +0000 Subject: separate vars for quoted passwords --- FS/FS/part_export/shellcommands.pm | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm index 3e9ac4a08..a514f9375 100644 --- a/FS/FS/part_export/shellcommands.pm +++ b/FS/FS/part_export/shellcommands.pm @@ -30,7 +30,7 @@ sub _export_command { ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields; } $finger = shell_quote $finger; - $_password = shell_quote $_password; + $quoted_password = shell_quote $_password; $domain = $svc_acct->domain; $crypt_password = ''; #surpress "used only once" warnings $crypt_password = crypt( $svc_acct->_password, @@ -53,9 +53,8 @@ sub _export_replace { ${"old_$_"} = $old->getfield($_) foreach $old->fields; ${"new_$_"} = $new->getfield($_) foreach $new->fields; } - $old__password = shell_quote $old__password; $new_finger = shell_quote $new_finger; - $new__password = shell_quote $new__password; + $quoted_new__password = shell_quote $new__password; $new_domain = $new->domain; $new_crypt_password = ''; #surpress "used only once" warnings $new_crypt_password = crypt( $new->_password, -- cgit v1.2.1 From 84eacf59708f768adb4161c5d3e250663d7f53dd Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 25 Aug 2002 03:42:25 +0000 Subject: correct secrets file path --- FS/bin/freeside-addoutsourceuser | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-addoutsourceuser b/FS/bin/freeside-addoutsourceuser index 5f18bdfac..ab8734042 100644 --- a/FS/bin/freeside-addoutsourceuser +++ b/FS/bin/freeside-addoutsourceuser @@ -5,9 +5,9 @@ domain=$2 password=$3 freeside-adduser -h /usr/local/etc/freeside/htpasswd \ - -s /usr/local/etc/freeside/conf.DBI:Pg:host=localhost\;dbname=$domain/secrets \ - -b \ - $username $password + -s conf.DBI:Pg:host=localhost\;dbname=$domain/secrets \ + -b \ + $username $password [ -e /usr/local/etc/freeside/dbdef.DBI:Pg:host=localhost\;dbname=$domain ] \ || ( freeside-setup $username; \ -- cgit v1.2.1 From 47b1210b68864ad65b157170d5a21544b6dc3dde Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 25 Aug 2002 03:54:45 +0000 Subject: ? --- FS/bin/freeside-addoutsourceuser | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-addoutsourceuser b/FS/bin/freeside-addoutsourceuser index ab8734042..bbad8aa3f 100644 --- a/FS/bin/freeside-addoutsourceuser +++ b/FS/bin/freeside-addoutsourceuser @@ -7,9 +7,9 @@ password=$3 freeside-adduser -h /usr/local/etc/freeside/htpasswd \ -s conf.DBI:Pg:host=localhost\;dbname=$domain/secrets \ -b \ - $username $password + $username $password 2>/dev/null [ -e /usr/local/etc/freeside/dbdef.DBI:Pg:host=localhost\;dbname=$domain ] \ - || ( freeside-setup $username; \ - /home/ivan/freeside/bin/populate-msgcat $username ) + || ( freeside-setup $username 2>/dev/null; \ + /home/ivan/freeside/bin/populate-msgcat $username; 2>/dev/null ) -- cgit v1.2.1 From b9e48e4f10f9ae0657d22385a48c628abd16ce5c Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 26 Aug 2002 20:40:55 +0000 Subject: allow . and - in otaker usernames --- FS/FS/cust_pkg.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 8b65ac4bd..12508e1aa 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -229,7 +229,7 @@ sub check { unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } ); $self->otaker(getotaker) unless $self->otaker; - $self->otaker =~ /^(\w{0,16})$/ or return "Illegal otaker"; + $self->otaker =~ /^([\w\.\-]{0,16})$/ or return "Illegal otaker"; $self->otaker($1); if ( $self->dbdef_table->column('manual_flag') ) { @@ -679,7 +679,7 @@ sub order { =head1 VERSION -$Id: cust_pkg.pm,v 1.22 2002-05-22 12:17:06 ivan Exp $ +$Id: cust_pkg.pm,v 1.23 2002-08-26 20:40:55 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From fea7f83baf7d460a00ca2d79fde71ce5f07884b3 Mon Sep 17 00:00:00 2001 From: khoff Date: Tue, 27 Aug 2002 07:26:10 +0000 Subject: Yip yip, I sprained my brain --- FS/FS/Record.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index e6126a13b..c247ed2db 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -930,7 +930,7 @@ sub ut_ip { $self->getfield($field) =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/ or return "Illegal (IP address) $field: ". $self->getfield($field); for ( $1, $2, $3, $4 ) { return "Illegal (IP address) $field" if $_ > 255; } - $self->setfield($field, "$1.$2.$3.$3"); + $self->setfield($field, "$1.$2.$3.$4"); ''; } -- cgit v1.2.1 From 63e5dad29d03b3cfabc3c71a11c24eea593860ac Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 29 Aug 2002 06:02:52 +0000 Subject: stupid kludge until schema otakers are not 8 chars --- FS/FS/UID.pm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm index 0b10612c5..8934d49fc 100644 --- a/FS/FS/UID.pm +++ b/FS/FS/UID.pm @@ -171,7 +171,9 @@ Returns the current Freeside user. =cut sub getotaker { - $user; + #$user; + #stupid kludge until schema otaker fields are not 8 chars + substr($user,0,8); } =item cgisetotaker @@ -256,7 +258,7 @@ coderef into the hash %FS::UID::callback : =head1 VERSION -$Id: UID.pm,v 1.18 2002-07-03 11:23:25 ivan Exp $ +$Id: UID.pm,v 1.19 2002-08-29 06:02:52 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From f97fd1dc04ae1bc8a130aecff0038a0e52cef82b Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 29 Aug 2002 07:50:46 +0000 Subject: vpopmail updates --- FS/FS/part_export.pm | 2 +- FS/FS/part_export/vpopmail.pm | 53 ++++++++++++++++++++++++++++++++++--------- 2 files changed, 43 insertions(+), 12 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 67b3cade5..9645feb98 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -778,7 +778,7 @@ tie my %sqlmail_options, 'Tie::IxHash', 'vpopmail' => { 'desc' => 'Real-time export to vpopmail text files', 'options' => \%vpopmail_options, - 'notes' => 'Real time export to vpopmail text files (...extended description from jeff?...)', + 'notes' => 'Real time export to vpopmail text files (...extended description from jeff?...) File::Rsync must be installed.', }, }, diff --git a/FS/FS/part_export/vpopmail.pm b/FS/FS/part_export/vpopmail.pm index 6a486faa1..c0105c045 100644 --- a/FS/FS/part_export/vpopmail.pm +++ b/FS/FS/part_export/vpopmail.pm @@ -20,6 +20,7 @@ sub _export_insert { $svc_acct->username, crypt($svc_acct->_password,$saltset[int(rand(64))].$saltset[int(rand(64))]), $svc_acct->domain, + $svc_acct->quota, ); } @@ -47,7 +48,7 @@ sub _export_replace { return '' unless $old->_password ne $new->_password; $self->vpopmail_queue( $new->svcnum, 'replace', - $new->username, $cpassword, $new->domain ); + $new->username, $cpassword, $new->domain, $new->quota ); } sub _export_delete { @@ -76,7 +77,7 @@ sub vpopmail_queue { sub vpopmail_insert { #subroutine, not method my( $exportdir, $machine, $dir, $uid, $gid ) = splice @_,0,5; - my( $username, $password, $domain ) = @_; + my( $username, $password, $domain, $quota ) = @_; (open(VPASSWD, ">>$exportdir/domains/$domain/vpasswd") and flock(VPASSWD,LOCK_EX) @@ -87,9 +88,9 @@ sub vpopmail_insert { #subroutine, not method $password, '1', '0', - $username, + $finger, "$dir/domains/$domain/$username", - 'NOQUOTA', + $quota ? $quota.'S' : 'NOQUOTA', ), "\n"; flock(VPASSWD,LOCK_UN); @@ -118,10 +119,21 @@ sub vpopmail_replace { #subroutine, not method or die "Can't open $exportdir/domains/$domain/vpasswd.tmp: $!"; while () { - my ($mailbox, $pw, @rest) = split(':', $_); - print VPASSWDTMP $_ unless $username eq $mailbox; - print VPASSWDTMP join (':', ($mailbox, $password, @rest)) - if $username eq $mailbox; + my ($mailbox, $pw, $vuid, $vgid, $vfinger, $vdir, $vquota, @rest) = + split(':', $_); + if ( $username ne $mailbox ) { + print VPASSWDTMP $_; + next + } + print VPASSWDTMP join (':', + $mailbox, + $password, + '1', + '0', + $finger, + $dir, + $quota ? $quota.'S' : 'NOQUOTA', + ), "\n"; } close(VPASSWDTMP); @@ -171,9 +183,28 @@ sub vpopmail_sync { my( $exportdir, $machine, $dir, $uid, $gid ) = splice @_,0,5; chdir $exportdir; - my @args = ( $rsync, "-rlpt", "-e", $ssh, "domains/", - "vpopmail\@$machine:$dir/domains/" ); - system {$args[0]} @args; +# my @args = ( $rsync, "-rlpt", "-e", $ssh, "domains/", +# "vpopmail\@$machine:$dir/domains/" ); +# system {$args[0]} @args; + + eval "use File::Rsync;"; + die $@ if $@; + + my $rsync = File::Rsync->new({ rsh => 'ssh' }); + + $rsync->exec( { + recursive => 1, + perms => 1, + times => 1, + src => "$exportdir/domains/", + dest => "vpopmail\@$machine:$dir/domains/", + } ); # true/false return value from exec is not working, alas + if ( $rsync->err ) { + die "error uploading to vpopmail\@$machine:$dir/domains/ : ". + 'exit status: '. $rsync->status. ', '. + 'STDERR: '. join(" / ", $rsync->err). ', '. + 'STDOUT: '. join(" / ", $rsync->out); + } } -- cgit v1.2.1 From 7171a6086a6ba39c73d45ea6aae37c63cdfe5713 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 29 Aug 2002 09:11:28 +0000 Subject: dont require uid for finger and quota, fix md5 import, make username/password for unexported services conflict at least with self --- FS/FS/svc_acct.pm | 28 +++++++++++++--------------- 1 file changed, 13 insertions(+), 15 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index c95df94cf..6fe26c8d5 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -246,7 +246,8 @@ sub insert { if ( @dup_user || @dup_userdomain || @dup_uid ) { my $exports = FS::part_export::export_info('svc_acct'); - my( %conflict_user_svcpart, %conflict_userdomain_svcpart ); + my %conflict_user_svcpart; + my %conflict_userdomain_svcpart = ( $self->svcpart => 'SELF', ); foreach my $part_export ( $part_svc->part_export ) { @@ -705,12 +706,6 @@ sub check { && $recref->{username} ne 'root' && $recref->{username} ne 'toor'; -# $error = $self->ut_textn('finger'); -# return $error if $error; - $self->getfield('finger') =~ - /^([\w \t\!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\*\<\>]*)$/ - or return "Illegal finger: ". $self->getfield('finger'); - $self->setfield('finger', $1); $recref->{dir} =~ /^([\/\w\-\.\&]*)$/ or return "Illegal directory"; @@ -745,22 +740,25 @@ sub check { $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}='' ); } + # $error = $self->ut_textn('finger'); + # return $error if $error; + $self->getfield('finger') =~ + /^([\w \t\!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\*\<\>]*)$/ + or return "Illegal finger: ". $self->getfield('finger'); + $self->setfield('finger', $1); + + $recref->{quota} =~ /^(\d*)$/ or return "Illegal quota"; + $recref->{quota} = $1; + unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) { unless ( $recref->{slipip} eq '0e0' ) { $recref->{slipip} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/ @@ -791,7 +789,7 @@ sub check { #$recref->{password} = $1. # crypt($3,$saltset[int(rand(64))].$saltset[int(rand(64))] #; - } elsif ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([\w\.\/\$]{13,34})$/ ) { + } elsif ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([\w\.\/\$\;]{13,34})$/ ) { $recref->{_password} = $1.$3; } elsif ( $recref->{_password} eq '*' ) { $recref->{_password} = '*'; -- cgit v1.2.1 From 04af7174c8f52ff484af7851f687e98f4d88670c Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 30 Aug 2002 17:34:06 +0000 Subject: working CSV import for crcmn --- FS/FS/cust_main.pm | 91 +++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 90 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index eb468d981..eae760bd3 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -713,7 +713,8 @@ sub check { my $y = length($2) == 4 ? $2 : "20$2"; $self->paydate("$y-$1-01"); my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900; - return gettext('expired_card') if $y<$nowy || ( $y==$nowy && $1<$nowm ); + return gettext('expired_card') + if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) ); } if ( $self->payname eq '' && @@ -1964,6 +1965,94 @@ sub append_fuzzyfiles { 1; } +=item batch_import + +=cut + +sub batch_import { + my $param = shift; + #warn join('-',keys %$param); + my $fh = $param->{filehandle}; + my $agentnum = $param->{agentnum}; + my $refnum = $param->{refnum}; + my $pkgpart = $param->{pkgpart}; + my @fields = @{$param->{fields}}; + + eval "use Date::Parse;"; + die $@ if $@; + eval "use Text::CSV_XS;"; + die $@ if $@; + + my $csv = new Text::CSV_XS; + #warn $csv; + #warn $fh; + + my $imported = 0; + #my $columns; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + #while ( $columns = $csv->getline($fh) ) { + my $line; + while ( defined($line=<$fh>) ) { + + $csv->parse($line) or do { + $dbh->rollback if $oldAutoCommit; + return "can't parse: ". $csv->error_input(); + }; + + my @columns = $csv->fields(); + #warn join('-',@columns); + + my %cust_main = ( + agentnum => $agentnum, + refnum => $refnum, + country => 'US', #default + payby => 'BILL', #default + paydate => '12/2037', #default + ); + my %cust_pkg = ( pkgpart => $pkgpart ); + foreach my $field ( @fields ) { + if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) { + #$cust_pkg{$1} = str2time( shift @$columns ); + $cust_pkg{$1} = str2time( shift @columns ); + } else { + #$cust_main{$field} = shift @$columns; + $cust_main{$field} = shift @columns; + } + } + + my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart; + my $cust_main = new FS::cust_main ( \%cust_main ); + use Tie::RefHash; + tie my %hash, 'Tie::RefHash'; #this part is important + $hash{$cust_pkg} = [] if $pkgpart; + my $error = $cust_main->insert( \%hash ); + + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "can't insert customer for $line: $error"; + } + $imported++; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + return "Empty file!" unless $imported; + + ''; #no error + +} + =back =head1 BUGS -- cgit v1.2.1 From 971a48bc316c52aa1471d195d75ba0137c286040 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 30 Aug 2002 23:17:31 +0000 Subject: bill batch imported customers immediately (as of their cust_pkg.bill date) - setting cust_pkg.bill date directly bypasses setup fee --- FS/FS/cust_main.pm | 24 +++++++++++++++++++++++- 1 file changed, 23 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index eae760bd3..8e47f23d5 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -2020,11 +2020,16 @@ sub batch_import { payby => 'BILL', #default paydate => '12/2037', #default ); + my $billtime = time; my %cust_pkg = ( pkgpart => $pkgpart ); foreach my $field ( @fields ) { if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) { #$cust_pkg{$1} = str2time( shift @$columns ); - $cust_pkg{$1} = str2time( shift @columns ); + if ( $1 eq 'setup' ) { + $billtime = str2time(shift @columns); + } else { + $cust_pkg{$1} = str2time( shift @columns ); + } } else { #$cust_main{$field} = shift @$columns; $cust_main{$field} = shift @columns; @@ -2042,6 +2047,23 @@ sub batch_import { $dbh->rollback if $oldAutoCommit; return "can't insert customer for $line: $error"; } + + #false laziness w/bill.cgi + $error = $cust_main->bill( 'time' => $billtime ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "can't bill customer for $line: $error"; + } + + $cust_main->apply_payments; + $cust_main->apply_credits; + + $error = $cust_main->collect(); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "can't collect customer for $line: $error"; + } + $imported++; } -- cgit v1.2.1 From 10adfb99055cc684f96cf446da34a7423cac3459 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 30 Aug 2002 23:42:47 +0000 Subject: new invoice event: upload a CSV file --- FS/FS/cust_bill.pm | 150 ++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 149 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 5a9fdd09b..a10a6c41a 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -11,6 +11,7 @@ use Date::Format; use Mail::Internet 1.44; use Mail::Header; use Text::Template; +use FS::UID qw( datasrc ); use FS::Record qw( qsearch qsearchs ); use FS::cust_main; use FS::cust_bill_pkg; @@ -410,6 +411,153 @@ sub send { } +=item send_csv OPTIONS + +Sends invoice as a CSV data-file to a remote host with the specified protocol. + +Options are: + +protocol - currently only "ftp" +server +username +password +dir + +The file will be named "N-YYYYMMDDHHMMSS.csv" where N is the invoice number +and YYMMDDHHMMSS is a timestamp. + +The fields of the CSV file is as follows: + +record_type, invnum, custnum, _date, charged, first, last, company, address1, address2, city, state, zip, country, pkg, setup, recur, sdate, edate + +=over 4 + +=item record type - B is either C or C + +If B is C, this is a primary invoice record. The +last five fields (B through B) are irrelevant, and all other +fields are filled in. + +If B is C, this is a line item record. Only the +first two fields (B and B) and the last five fields +(B through B) are filled in. + +=item invnum - invoice number +=item custnum - customer number +=item _date - invoice date +=item charged - total invoice amount +=item first - customer first name +=item last - customer first name +=item company - company name +=item address1 - address line 1 +=item address2 - address line 1 +=item city +=item state +=item zip +=item country + +=item pkg - line item description +=item setup - line item setup fee (only or both of B and B will be defined) +=item recur - line item recurring fee (only or both of B and B will be defined) +=item sdate - start date for recurring fee +=item edate - end date for recurring fee + +=back + +=cut + +sub send_csv { + my($self, %opt) = @_; + + #part one: create file + + my $spooldir = "/usr/local/etc/freeside/export.". datasrc. "/cust_bill"; + mkdir $spooldir, 0700 unless -d $spooldir; + + my $file = $spooldir. '/'. $self->invnum. time2str('-%Y%m%d%H%M%S.csv', time); + + open(CSV, ">$file") or die "can't open $file: $!"; + + eval "use Text::CSV_XS"; + die $@ if $@; + + my $csv = Text::CSV_XS->new({'always_quote'=>1}); + + my $cust_main = $self->cust_main; + + $csv->combine( + 'cust_bill', + $self->invnum, + $self->custnum, + time2str("%x", $self->_date), + ( map { $cust_main->getfield($_) } + qw( first last company address1 address2 city state zip country ) ), + map { '' } (1..5), + ) or die "can't create csv"; + print CSV $csv->string. "\n"; + + #new charges (false laziness w/print_text) + foreach my $cust_bill_pkg ( $self->cust_bill_pkg ) { + + my($pkg, $setup, $recur, $sdate, $edate); + if ( $cust_bill_pkg->pkgnum ) { + + ($pkg, $setup, $recur, $sdate, $edate) = ( + $cust_bill_pkg->cust_pkg->part_pkg->pkg, + ( $cust_bill_pkg->setup != 0 + ? sprintf("%.2f", $cust_bill_pkg->setup ) + : '' ), + ( $cust_bill_pkg->recur != 0 + ? sprintf("%.2f", $cust_bill_pkg->recur ) + : '' ), + time2str("%x", $cust_bill_pkg->sdate), + time2str("%x", $cust_bill_pkg->edate), + ); + + } else { #pkgnum Tax + next unless $cust_bill_pkg->setup != 0; + ($pkg, $setup, $recur, $sdate, $edate) = + ( 'Tax', sprintf("%10.2f",$cust_bill_pkg->setup), '', '', '' ); + } + + $csv->combine( + 'cust_bill_pkg', + $self->invnum, + ( map { '' } (1..11) ), + ($pkg, $setup, $recur, $sdate, $edate) + ) or die "can't create csv"; + print CSV $csv->string. "\n"; + + } + + close CSV or die "can't close CSV: $!"; + + #part two: upload it + + my $net; + if ( $opt{protocol} eq 'ftp' ) { + eval "use Net::FTP;"; + die $@ if $@; + $net = Net::FTP->new($opt{server}) or die @$; + } else { + die "unknown protocol: $opt{protocol}"; + } + + $net->login( $opt{username}, $opt{password} ) + or die "can't FTP to $opt{username}\@$opt{server}: login error: $@"; + + $net->binary or die "can't set binary mode"; + + $net->cwd($opt{dir}) or die "can't cwd to $opt{dir}"; + + $net->put($file) or die "can't put $file: $!"; + + $net->quit; + + unlink $file; + +} + =item comp Pays this invoice with a compliemntary payment. If there is an error, @@ -952,7 +1100,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.38 2002-06-26 02:37:48 ivan Exp $ +$Id: cust_bill.pm,v 1.39 2002-08-30 23:42:47 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 249c7b31d464d2f3fe436623cd3ae84f2ce12915 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 30 Aug 2002 23:48:43 +0000 Subject: oops, missing charged column in csv exports --- FS/FS/cust_bill.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index a10a6c41a..fd79f238c 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -490,6 +490,7 @@ sub send_csv { $self->invnum, $self->custnum, time2str("%x", $self->_date), + sprintf("%.2f", $self->charged), ( map { $cust_main->getfield($_) } qw( first last company address1 address2 city state zip country ) ), map { '' } (1..5), @@ -1100,7 +1101,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.39 2002-08-30 23:42:47 ivan Exp $ +$Id: cust_bill.pm,v 1.40 2002-08-30 23:48:43 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 535b26281b31fc784923db3aabbde7766ca35a59 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 5 Sep 2002 09:10:55 +0000 Subject: get rid of extraneous `vpopmail machine' field --- FS/FS/part_export.pm | 2 +- FS/FS/part_export/vpopmail.pm | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 9645feb98..251184371 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -641,7 +641,7 @@ tie my %infostreet_options, 'Tie::IxHash', ; tie my %vpopmail_options, 'Tie::IxHash', - 'machine' => { label=>'vpopmail machine', }, + #'machine' => { label=>'vpopmail machine', }, 'dir' => { label=>'directory', }, # ?more info? default? 'uid' => { label=>'vpopmail uid' }, 'gid' => { label=>'vpopmail gid' }, diff --git a/FS/FS/part_export/vpopmail.pm b/FS/FS/part_export/vpopmail.pm index c0105c045..cc8136e25 100644 --- a/FS/FS/part_export/vpopmail.pm +++ b/FS/FS/part_export/vpopmail.pm @@ -67,7 +67,7 @@ sub vpopmail_queue { }; $queue->insert( $exportdir, - $self->option('machine'), + $self->machine, $self->option('dir'), $self->option('uid'), $self->option('gid'), -- cgit v1.2.1 From 9a665a351155da6130b0669dbd99f28a40bc5bc5 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 5 Sep 2002 13:01:03 +0000 Subject: show illegal dir in error msg --- FS/FS/svc_acct.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 6fe26c8d5..e62cdd7bb 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -708,7 +708,7 @@ sub check { $recref->{dir} =~ /^([\/\w\-\.\&]*)$/ - or return "Illegal directory"; + or return "Illegal directory: ". $recref->{dir}; $recref->{dir} = $1; return "Illegal directory" if $recref->{dir} =~ /(^|\/)\.+(\/|$)/; #no .. component -- cgit v1.2.1 From 10ffb6447a6e045b379f38bb78a7cb154076c2fd Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 5 Sep 2002 13:28:00 +0000 Subject: batch charge/credit import --- FS/FS/cust_main.pm | 85 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 85 insertions(+) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 8e47f23d5..cfa6b8bb6 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -2075,6 +2075,91 @@ sub batch_import { } +=item batch_charge + +=cut + +sub batch_charge { + my $param = shift; + #warn join('-',keys %$param); + my $fh = $param->{filehandle}; + my @fields = @{$param->{fields}}; + + eval "use Date::Parse;"; + die $@ if $@; + eval "use Text::CSV_XS;"; + die $@ if $@; + + my $csv = new Text::CSV_XS; + #warn $csv; + #warn $fh; + + my $imported = 0; + #my $columns; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + #while ( $columns = $csv->getline($fh) ) { + my $line; + while ( defined($line=<$fh>) ) { + + $csv->parse($line) or do { + $dbh->rollback if $oldAutoCommit; + return "can't parse: ". $csv->error_input(); + }; + + my @columns = $csv->fields(); + #warn join('-',@columns); + + my %row = (); + foreach my $field ( @fields ) { + $row{$field} = shift @columns; + } + + my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } ); + unless ( $cust_main ) { + $dbh->rollback if $oldAutoCommit; + return "unknown custnum $row{'custnum'}"; + } + + if ( $row{'amount'} > 0 ) { + my $error = $cust_main->charge($row{'amount'}, $row{'pkg'}); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + $imported++; + } elsif ( $row{'amount'} < 0 ) { + my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ), + $row{'pkg'} ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + $imported++; + } else { + #hmm? + } + + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + return "Empty file!" unless $imported; + + ''; #no error + +} + =back =head1 BUGS -- cgit v1.2.1 From e1cfff0375b46aaf2b5fef7fb2f9e62d7567f41f Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 5 Sep 2002 16:51:49 +0000 Subject: Business::OnlinePayment::VitualNet compatibility --- FS/FS/cust_bill.pm | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index fd79f238c..5e041ea59 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -681,7 +681,8 @@ sub realtime_card { my $capture = new Business::OnlinePayment( $bop_processor, @bop_options ); - $capture->content( + my %capture = ( + type => 'CC', action => $action2, login => $bop_login, password => $bop_password, @@ -689,8 +690,18 @@ sub realtime_card { amount => $amount, authorization => $auth, description => $description, + card_number => $cust_main->payinfo, + expiration => $exp, ); + foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code + transaction_sequence_num local_transaction_date + local_transaction_time AVS_result_code )) { + $capture{$field} = $transaction->$field() if $transaction->can($field); + } + + $capture->content( %capture ); + $capture->submit(); unless ( $capture->is_success ) { @@ -1101,7 +1112,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.40 2002-08-30 23:48:43 ivan Exp $ +$Id: cust_bill.pm,v 1.41 2002-09-05 16:51:49 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 03fad632a9f62a63486bf69c9a663fc800764f58 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 5 Sep 2002 18:51:01 +0000 Subject: clear up directory silliness ick --- FS/FS/part_export/vpopmail.pm | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export/vpopmail.pm b/FS/FS/part_export/vpopmail.pm index cc8136e25..4ec6dd0e4 100644 --- a/FS/FS/part_export/vpopmail.pm +++ b/FS/FS/part_export/vpopmail.pm @@ -1,6 +1,6 @@ package FS::part_export::vpopmail; -use vars qw(@ISA @saltset $exportdir $rsync $ssh); +use vars qw(@ISA @saltset $exportdir); use File::Path; use FS::UID qw( datasrc ); use FS::part_export; @@ -9,9 +9,6 @@ use FS::part_export; @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); -$rsync = "rsync"; -$ssh = "ssh"; - sub rebless { shift; } sub _export_insert { @@ -60,7 +57,15 @@ sub _export_delete { #a good idea to queue anything that could fail or take any time sub vpopmail_queue { my( $self, $svcnum, $method ) = (shift, shift, shift); + my $exportdir = "/usr/local/etc/freeside/export." . datasrc; + mkdir $exportdir, 0700 or die $! unless -d $exportdir; + $exportdir .= "/vpopmail"; + mkdir $exportdir, 0700 or die $! unless -d $exportdir; + $exportdir .= '/'. $self->machine; + mkdir $exportdir, 0700 or die $! unless -d $exportdir; + mkdir "$exportdir/domains", 0700 or die $! unless -d "$exportdir/domains"; + my $queue = new FS::queue { 'svcnum' => $svcnum, 'job' => "FS::part_export::vpopmail::vpopmail_$method", @@ -78,7 +83,10 @@ sub vpopmail_queue { sub vpopmail_insert { #subroutine, not method my( $exportdir, $machine, $dir, $uid, $gid ) = splice @_,0,5; my( $username, $password, $domain, $quota ) = @_; - + + mkdir "$exportdir/domains/$domain", 0700 or die $! + unless -d "$exportdir/domains/$domain"; + (open(VPASSWD, ">>$exportdir/domains/$domain/vpasswd") and flock(VPASSWD,LOCK_EX) ) or die "can't open vpasswd file for $username\@$domain: ". -- cgit v1.2.1 From fa6635340ee1841271ba70594aeb2353e3793105 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 7 Sep 2002 02:19:21 +0000 Subject: import flocking constants --- FS/FS/part_export/vpopmail.pm | 1 + 1 file changed, 1 insertion(+) (limited to 'FS') diff --git a/FS/FS/part_export/vpopmail.pm b/FS/FS/part_export/vpopmail.pm index 4ec6dd0e4..561e2742a 100644 --- a/FS/FS/part_export/vpopmail.pm +++ b/FS/FS/part_export/vpopmail.pm @@ -1,6 +1,7 @@ package FS::part_export::vpopmail; use vars qw(@ISA @saltset $exportdir); +use Fcntl qw(:flock); use File::Path; use FS::UID qw( datasrc ); use FS::part_export; -- cgit v1.2.1 From 2e0e79ccc2d4a3612b47d323a53120611cb24ce0 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 7 Sep 2002 14:20:06 +0000 Subject: mention docs/ssh.html in vpopmail description, give up hoping for a better description of the export from jeff --- FS/FS/part_export.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 251184371..3c1a3de8e 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -778,7 +778,7 @@ tie my %sqlmail_options, 'Tie::IxHash', 'vpopmail' => { 'desc' => 'Real-time export to vpopmail text files', 'options' => \%vpopmail_options, - 'notes' => 'Real time export to vpopmail text files (...extended description from jeff?...) File::Rsync must be installed.', + 'notes' => 'Real time export to vpopmail text files. File::Rsync must be installed, and you will need to setup SSH for unattended operation', }, }, -- cgit v1.2.1 From 49006303c63cc2a6fffb5df5d1d3f8947f700b02 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 8 Sep 2002 12:58:00 +0000 Subject: ordering fix on delete: domain_record records first, then svc_domain --- FS/FS/svc_domain.pm | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm index b06d03013..637d0493c 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -269,12 +269,6 @@ sub delete { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $error = $self->SUPER::delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - foreach my $domain_record ( reverse $self->domain_record ) { my $error = $domain_record->delete; if ( $error ) { @@ -282,6 +276,13 @@ sub delete { return $error; } } + + my $error = $self->SUPER::delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; } @@ -448,10 +449,6 @@ sub submit_internic { =back -=head1 VERSION - -$Id: svc_domain.pm,v 1.31 2002-06-10 02:52:48 ivan Exp $ - =head1 BUGS All BIND/DNS fields should be included (and exported). -- cgit v1.2.1 From a7013a87b67301d8b43c7847b84e06be4802d948 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 9 Sep 2002 12:34:55 +0000 Subject: : is not legal in GECOS --- FS/FS/ClientAPI.pm | 4 ++-- FS/FS/ClientAPI/passwd.pm | 9 +++++---- FS/FS/InitHandler.pm | 4 ++++ FS/FS/svc_acct.pm | 2 +- 4 files changed, 12 insertions(+), 7 deletions(-) (limited to 'FS') diff --git a/FS/FS/ClientAPI.pm b/FS/FS/ClientAPI.pm index f7b8eb028..7cbbdbf67 100644 --- a/FS/FS/ClientAPI.pm +++ b/FS/FS/ClientAPI.pm @@ -1,13 +1,13 @@ package FS::ClientAPI; use strict; -use vars qw(%handler); +use vars qw(%handler $domain); %handler = (); #find modules foreach my $INC ( @INC ) { - foreach my $file ( glob("$INC/FS/ClientAPI/*") ) { + foreach my $file ( glob("$INC/FS/ClientAPI/*.pm") ) { $file =~ /\/(\w+)\.pm$/ or do { warn "unrecognized ClientAPI file: $file"; next diff --git a/FS/FS/ClientAPI/passwd.pm b/FS/FS/ClientAPI/passwd.pm index 29606227d..016ebff79 100644 --- a/FS/FS/ClientAPI/passwd.pm +++ b/FS/FS/ClientAPI/passwd.pm @@ -15,8 +15,9 @@ FS::ClientAPI->register_handlers( sub passwd { my $packet = shift; - #my $domain = qsearchs('svc_domain', { 'domain' => $packet->{'domain'} } ) - # or return { error => "Domain $domain not found" }; + my $domain = $FS::ClientAPI::domain || $packet->{'domain'}; + my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } ) + or return { error => "Domain $domain not found" }; my $old_password = $packet->{'old_password'}; my $new_password = $packet->{'new_password'}; @@ -27,11 +28,11 @@ sub passwd { my $svc_acct = ( length($old_password) < 13 && qsearchs( 'svc_acct', { 'username' => $packet->{'username'}, - #'domsvc' => $svc_domain->svcnum, + 'domsvc' => $svc_domain->svcnum, '_password' => $old_password } ) ) || qsearchs( 'svc_acct', { 'username' => $packet->{'username'}, - #'domsvc' => $svc_domain->svcnum, + 'domsvc' => $svc_domain->svcnum, '_password' => $old_password } ); unless ( $svc_acct ) { return { error => 'Incorrect password.' } } diff --git a/FS/FS/InitHandler.pm b/FS/FS/InitHandler.pm index 87f507c22..0216615da 100644 --- a/FS/FS/InitHandler.pm +++ b/FS/FS/InitHandler.pm @@ -1,5 +1,9 @@ package FS::InitHandler; +# this leaks memory under graceful restarts and i wouldn't use it on any +# modern server. useful for very slow machines with memory to spare, just +# always do a full restart + use strict; use vars qw($DEBUG); use FS::UID qw(adminsuidsetup); diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index e62cdd7bb..9032e20c1 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -752,7 +752,7 @@ sub check { # $error = $self->ut_textn('finger'); # return $error if $error; $self->getfield('finger') =~ - /^([\w \t\!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\*\<\>]*)$/ + /^([\w \t\!\@\#\$\%\&\(\)\-\+\;\'\"\,\.\?\/\*\<\>]*)$/ or return "Illegal finger: ". $self->getfield('finger'); $self->setfield('finger', $1); -- cgit v1.2.1 From bcd23d236c4846bee6285c1ff862e7e3c3f59cd9 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 9 Sep 2002 19:56:06 +0000 Subject: vpopmail export doc clarification: ssh as vpopmail user --- FS/FS/part_export.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 3c1a3de8e..bc6a4d735 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -778,7 +778,7 @@ tie my %sqlmail_options, 'Tie::IxHash', 'vpopmail' => { 'desc' => 'Real-time export to vpopmail text files', 'options' => \%vpopmail_options, - 'notes' => 'Real time export to vpopmail text files. File::Rsync must be installed, and you will need to setup SSH for unattended operation', + 'notes' => 'Real time export to vpopmail text files. File::Rsync must be installed, and you will need to setup SSH for unattended operation to vpopmail@export.host.', }, }, -- cgit v1.2.1 From eb46cd3822674cecdc474b175b1e6f3ede8cc49b Mon Sep 17 00:00:00 2001 From: khoff Date: Mon, 9 Sep 2002 22:56:14 +0000 Subject: svc_broadband merge --- FS/MANIFEST | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'FS') diff --git a/FS/MANIFEST b/FS/MANIFEST index fff95c8c8..4a250d77b 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -36,6 +36,9 @@ FS/UI/Gtk.pm FS/UI/agent.pm FS/UID.pm FS/Msgcat.pm +FS/ac.pm +FS/ac_block.pm +FS/ac_type.pm FS/agent.pm FS/agent_type.pm FS/cust_bill.pm @@ -54,6 +57,7 @@ FS/cust_refund.pm FS/cust_credit_refund.pm FS/cust_svc.pm FS/part_bill_event.pm +FS/part_ac_field.pm FS/export_svc.pm FS/part_export.pm FS/part_export_option.pm @@ -84,6 +88,7 @@ FS/svc_Common.pm FS/svc_acct.pm FS/svc_acct_pop.pm FS/svc_acct_sm.pm +FS/svc_broadband.pm FS/svc_domain.pm FS/type_pkgs.pm FS/nas.pm -- cgit v1.2.1 From 91292eadb6254740a9b72e5dc95f575593f6a35d Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 9 Sep 2002 22:57:34 +0000 Subject: allow . in untaint_argv, for usernames --- FS/bin/freeside-cc-receipts-report | 4 ++-- FS/bin/freeside-credit-report | 4 ++-- FS/bin/freeside-receivables-report | 4 ++-- FS/bin/freeside-tax-report | 4 ++-- 4 files changed, 8 insertions(+), 8 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-cc-receipts-report b/FS/bin/freeside-cc-receipts-report index 06e3aba81..136851aec 100755 --- a/FS/bin/freeside-cc-receipts-report +++ b/FS/bin/freeside-cc-receipts-report @@ -206,7 +206,7 @@ if($email && $opt_m) # subroutines sub untaint_argv { foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV - $ARGV[$_] =~ /^([\w\-\/ :]*)$/ || die "Illegal argument \"$ARGV[$_]\""; + $ARGV[$_] =~ /^([\w\-\/ :\.]*)$/ || die "Illegal argument \"$ARGV[$_]\""; $ARGV[$_]=$1; } } @@ -245,7 +245,7 @@ user: From the mapsecrets file - see config.html from the base documentation =head1 VERSION -$Id: freeside-cc-receipts-report,v 1.4 2002-03-07 19:50:23 jeff Exp $ +$Id: freeside-cc-receipts-report,v 1.5 2002-09-09 22:57:34 ivan Exp $ =head1 BUGS diff --git a/FS/bin/freeside-credit-report b/FS/bin/freeside-credit-report index 7699daf4d..410dabe8f 100755 --- a/FS/bin/freeside-credit-report +++ b/FS/bin/freeside-credit-report @@ -160,7 +160,7 @@ if($email && $opt_m) # subroutines sub untaint_argv { foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV - $ARGV[$_] =~ /^([\w\-\/ :]*)$/ || die "Illegal argument \"$ARGV[$_]\""; + $ARGV[$_] =~ /^([\w\-\/ :\.]*)$/ || die "Illegal argument \"$ARGV[$_]\""; $ARGV[$_]=$1; } } @@ -199,7 +199,7 @@ user: From the mapsecrets file - see config.html from the base documentation =head1 VERSION -$Id: freeside-credit-report,v 1.4 2002-03-07 19:50:24 jeff Exp $ +$Id: freeside-credit-report,v 1.5 2002-09-09 22:57:34 ivan Exp $ =head1 BUGS diff --git a/FS/bin/freeside-receivables-report b/FS/bin/freeside-receivables-report index b5a49031e..f3ad2a1a6 100755 --- a/FS/bin/freeside-receivables-report +++ b/FS/bin/freeside-receivables-report @@ -157,7 +157,7 @@ if($email && $opt_m) sub untaint_argv { foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV - $ARGV[$_] =~ /^([\w\-\/ ]*)$/ || die "Illegal argument \"$ARGV[$_]\""; + $ARGV[$_] =~ /^([\w\-\/ \.]*)$/ || die "Illegal argument \"$ARGV[$_]\""; $ARGV[$_]=$1; } } @@ -192,7 +192,7 @@ user: From the mapsecrets file - see config.html from the base documentation =head1 VERSION -$Id: freeside-receivables-report,v 1.5 2002-03-07 19:50:24 jeff Exp $ +$Id: freeside-receivables-report,v 1.6 2002-09-09 22:57:34 ivan Exp $ =head1 BUGS diff --git a/FS/bin/freeside-tax-report b/FS/bin/freeside-tax-report index 8d5021358..240f3ad37 100755 --- a/FS/bin/freeside-tax-report +++ b/FS/bin/freeside-tax-report @@ -228,7 +228,7 @@ if($email && $opt_m) # subroutines sub untaint_argv { foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV - $ARGV[$_] =~ /^([\w\-\/ :]*)$/ || die "Illegal argument \"$ARGV[$_]\""; + $ARGV[$_] =~ /^([\w\-\/ :\.]*)$/ || die "Illegal argument \"$ARGV[$_]\""; $ARGV[$_]=$1; } } @@ -267,7 +267,7 @@ user: From the mapsecrets file - see config.html from the base documentation =head1 VERSION -$Id: freeside-tax-report,v 1.4 2002-03-07 19:50:24 jeff Exp $ +$Id: freeside-tax-report,v 1.5 2002-09-09 22:57:34 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 44398c83f25bf4e43838df9f39331c29fdeff19d Mon Sep 17 00:00:00 2001 From: khoff Date: Mon, 9 Sep 2002 23:05:30 +0000 Subject: svc_broadband merge --- FS/FS/ac.pm | 148 +++++++++++++++++++++++++ FS/FS/ac_block.pm | 148 +++++++++++++++++++++++++ FS/FS/ac_field.pm | 138 +++++++++++++++++++++++ FS/FS/ac_type.pm | 128 +++++++++++++++++++++ FS/FS/cust_svc.pm | 4 +- FS/FS/part_ac_field.pm | 102 +++++++++++++++++ FS/FS/part_export.pm | 3 + FS/FS/svc_broadband.pm | 295 +++++++++++++++++++++++++++++++++++++++++++++++++ 8 files changed, 965 insertions(+), 1 deletion(-) create mode 100644 FS/FS/ac.pm create mode 100755 FS/FS/ac_block.pm create mode 100755 FS/FS/ac_field.pm create mode 100755 FS/FS/ac_type.pm create mode 100755 FS/FS/part_ac_field.pm create mode 100755 FS/FS/svc_broadband.pm (limited to 'FS') diff --git a/FS/FS/ac.pm b/FS/FS/ac.pm new file mode 100644 index 000000000..5a2b36079 --- /dev/null +++ b/FS/FS/ac.pm @@ -0,0 +1,148 @@ +package FS::ac; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearchs qsearch ); +use FS::ac_type; +use FS::ac_block; + +@ISA = qw( FS::Record ); + +=head1 NAME + +FS::ac - Object methods for ac records + +=head1 SYNOPSIS + + use FS::ac; + + $record = new FS::ac \%hash; + $record = new FS::ac { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::ac record describes a broadband Access Concentrator, such as a DSLAM +or a wireless access point. FS::ac inherits from FS::Record. The following +fields are currently supported: + +narf + +=over 4 + +=item acnum - primary key + +=item actypenum - AC type, see L + +=item acname - descriptive name for the AC + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Create a new record. To add the record to the database, see L<"insert">. + +=cut + +sub table { 'ac'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete + +Deletes this record from the database. If there is an error, returns the +error, otherwise returns false. + +=item replace OLD_RECORD + +Replaces OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=item check + +Checks all fields to make sure this is a valid record. If there is an error, +returns the error, otherwise returns false. Called by the insert and replace +methods. + +=cut + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('acnum') + || $self->ut_number('actypenum') + || $self->ut_text('acname'); + return $error if $error; + + return "Unknown actypenum" + unless $self->ac_type; + ''; +} + +=item ac_type + +Returns the L object corresponding to this object. + +=cut + +sub ac_type { + my $self = shift; + return qsearchs('ac_type', { actypenum => $self->actypenum }); +} + +=item ac_block + +Returns a list of L objects (address blocks) associated +with this object. + +=cut + +sub ac_block { + my $self = shift; + return qsearch('ac_block', { acnum => $self->acnum }); +} + +=item ac_field + +Returns a hash of L objects assigned to this object. + +=cut + +sub ac_field { + my $self = shift; + + return qsearch('ac_field', { acnum => $self->acnum }); +} + +=back + +=head1 VERSION + +$Id: + +=head1 BUGS + +=head1 SEE ALSO + +L, L, L, L, schema.html +from the base documentation. + +=cut + +1; + diff --git a/FS/FS/ac_block.pm b/FS/FS/ac_block.pm new file mode 100755 index 000000000..09de6a4d8 --- /dev/null +++ b/FS/FS/ac_block.pm @@ -0,0 +1,148 @@ +package FS::ac_block; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearchs qsearch ); +use FS::ac_type; +use FS::ac; +use FS::svc_broadband; +use NetAddr::IP; + +@ISA = qw( FS::Record ); + +=head1 NAME + +FS::ac - Object methods for ac records + +=head1 SYNOPSIS + + use FS::ac_block; + + $record = new FS::ac_block \%hash; + $record = new FS::ac_block { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::ac_block record describes an address block assigned for broadband +access. FS::ac_block inherits from FS::Record. The following fields are +currently supported: + +=over 4 + +=item acnum - the access concentrator (see L) to which this +block is assigned. + +=item ip_gateway - the gateway address used by customers within this block. +This functions as the primary key. + +=item ip_netmask - the netmask of the block, expressed as an integer. + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Create a new record. To add the record to the database, see L<"insert">. + +=cut + +sub table { 'ac_block'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete + +Deletes this record from the database. If there is an error, returns the +error, otherwise returns false. + +=item replace OLD_RECORD + +Replaces OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=item check + +Checks all fields to make sure this is a valid record. If there is an error, +returns the error, otherwise returns false. Called by the insert and replace +methods. + +=cut + +sub check { + my $self = shift; + + my $error = + $self->ut_number('acnum') + || $self->ut_ip('ip_gateway') + || $self->ut_number('ip_netmask') + ; + return $error if $error; + + return "Unknown acnum" + unless $self->ac; + + my $self_addr = new NetAddr::IP ($self->ip_gateway, $self->ip_netmask); + return "Cannot parse address: ". $self->ip_gateway . '/' . $self->ip_netmask + unless $self_addr; + + my @block = grep { + my $block_addr = new NetAddr::IP ($_->ip_gateway, $_->ip_netmask); + if($block_addr->contains($self_addr) + or $self_addr->contains($block_addr)) { $_; }; + } qsearch( 'ac_block', {}); + + foreach(@block) { + return "Block intersects existing block ".$_->ip_gateway."/".$_->ip_netmask; + } + + ''; +} + + +=item ac + +Returns the L object corresponding to this object. + +=cut + +sub ac { + my $self = shift; + return qsearchs('ac', { acnum => $self->acnum }); +} + +=item svc_broadband + +Returns a list of L objects associated +with this object. + +=cut + +#sub svc_broadband { +# my $self = shift; +# my @svc = qsearch('svc_broadband', { actypenum => $self->ac->ac_type->actypenum }); +# return grep { +# my $svc_addr = new NetAddr::IP($_->ip_addr, $_->ip_netmask); +# $self_addr->contains($svc_addr); +# } @svc; +#} + +=back + +=cut + +1; + diff --git a/FS/FS/ac_field.pm b/FS/FS/ac_field.pm new file mode 100755 index 000000000..f6011192f --- /dev/null +++ b/FS/FS/ac_field.pm @@ -0,0 +1,138 @@ +package FS::ac_field; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearchs ); +use FS::part_ac_field; +use FS::ac; + +use UNIVERSAL qw( can ); + +@ISA = qw( FS::Record ); + +=head1 NAME + +FS::ac_field - Object methods for ac_field records + +=head1 SYNOPSIS + + use FS::ac_field; + + $record = new FS::ac_field \%hash; + $record = new FS::ac_field { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +L contains values of fields defined by L +for an L. Values must be of the data type defined by ut_type in +L. +Supported fields as follows: + +=over 4 + +=item acfieldpart - Type of ac_field as defined by L + +=item acnum - The L to which this value belongs. + +=item value - The contents of the field. + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Create a new record. To add the record to the database, see L<"insert">. + +=cut + +sub table { 'ac_field'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete + +Deletes this record from the database. If there is an error, returns the +error, otherwise returns false. + +=item replace OLD_RECORD + +Replaces OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=item check + +Checks all fields to make sure this is a valid record. If there is an error, +returns the error, otherwise returns false. Called by the insert and replace +methods. + +=cut + +sub check { + my $self = shift; + + return "acnum must be defined" unless $self->acnum; + return "acfieldpart must be defined" unless $self->acfieldpart; + + my $ut_func = $self->can("ut_" . $self->part_ac_field->ut_type); + my $error = $self->$ut_func('value'); + + return $error if $error; + + ''; #no error +} + +=item part_ac_field + +Returns a reference to the L that defines this L + +=cut + +sub part_ac_field { + my $self = shift; + + return qsearchs('part_ac_field', { acfieldpart => $self->acfieldpart }); +} + +=item ac + +Returns a reference to the L to which this L belongs. + +=cut + +sub ac { + my $self = shift; + + return qsearchs('ac', { acnum => $self->acnum }); +} + +=back + +=head1 VERSION + +$Id: + +=head1 BUGS + +=head1 SEE ALSO + +L, L, L, L, schema.html +from the base documentation. + +=cut + +1; + diff --git a/FS/FS/ac_type.pm b/FS/FS/ac_type.pm new file mode 100755 index 000000000..e83c5c5f0 --- /dev/null +++ b/FS/FS/ac_type.pm @@ -0,0 +1,128 @@ +package FS::ac_type; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearchs ); +use FS::ac; + +@ISA = qw( FS::Record ); + +=head1 NAME + +FS::ac_type - Object methods for ac_type records + +=head1 SYNOPSIS + + use FS::ac_type; + + $record = new FS::ac_type \%hash; + $record = new FS::ac_type { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +L refers to a type of access concentrator. L +records refer to a specific L limiting the choice of access +concentrator to one of the chosen type. This should be set as a fixed +default in part_svc to prevent provisioning the wrong type of service for +a given package or service type. Supported fields as follows: + +=over 4 + +=item actypenum - Primary key. see L + +=item actypename - Text identifier for access concentrator type. + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Create a new record. To add the record to the database, see L<"insert">. + +=cut + +sub table { 'ac_type'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete + +Deletes this record from the database. If there is an error, returns the +error, otherwise returns false. + +=item replace OLD_RECORD + +Replaces OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=item check + +Checks all fields to make sure this is a valid record. If there is an error, +returns the error, otherwise returns false. Called by the insert and replace +methods. + +=cut + +sub check { + my $self = shift; + + # What do we check? + + ''; #no error +} + +=item ac + +Returns a list of all L records of this type. + +=cut + +sub ac { + my $self = shift; + + return qsearch('ac', { actypenum => $self->actypenum }); +} + +=item part_ac_field + +Returns a list of all L records of this type. + +=cut + +sub part_ac_field { + my $self = shift; + + return qsearch('part_ac_field', { actypenum => $self->actypenum }); +} + +=back + +=head1 VERSION + +$Id: + +=head1 BUGS + +=head1 SEE ALSO + +L, L, L, L, schema.html +from the base documentation. + +=cut + +1; + diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index c7cc4b322..d54fb2d40 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -295,6 +295,8 @@ sub label { } elsif ( $svcdb eq 'svc_www' ) { my $domain = qsearchs( 'domain_record', { 'recnum' => $svc_x->recnum } ); $tag = $domain->reczone; + } elsif ( $svcdb eq 'svc_broadband' ) { + $tag = $svc_x->ip_addr . '/' . $svc_x->ip_netmask; } else { cluck "warning: asked for label of unsupported svcdb; using svcnum"; $tag = $svc_x->getfield('svcnum'); @@ -344,7 +346,7 @@ sub seconds_since { =head1 VERSION -$Id: cust_svc.pm,v 1.15 2002-05-22 12:17:06 ivan Exp $ +$Id: cust_svc.pm,v 1.16 2002-09-09 23:01:35 khoff Exp $ =head1 BUGS diff --git a/FS/FS/part_ac_field.pm b/FS/FS/part_ac_field.pm new file mode 100755 index 000000000..dcb445253 --- /dev/null +++ b/FS/FS/part_ac_field.pm @@ -0,0 +1,102 @@ +package FS::part_ac_field; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearchs ); +use FS::ac_field; +use FS::ac; + + +@ISA = qw( FS::Record ); + +=head1 NAME + +FS::part_ac_field - Object methods for part_ac_field records + +=head1 SYNOPSIS + + use FS::part_ac_field; + + $record = new FS::part_ac_field \%hash; + $record = new FS::part_ac_field { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + + +=over 4 + +=item blank + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Create a new record. To add the record to the database, see L<"insert">. + +=cut + +sub table { 'part_ac_field'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete + +Deletes this record from the database. If there is an error, returns the +error, otherwise returns false. + +=item replace OLD_RECORD + +Replaces OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=item check + +Checks all fields to make sure this is a valid record. If there is an error, +returns the error, otherwise returns false. Called by the insert and replace +methods. + +=cut + +sub check { + my $self = shift; + my $error = ''; + + $self->name =~ /^([a-z0-9_\-\.]{1,15})$/i + or return "Invalid field name for part_ac_field"; + + ''; #no error +} + + +=back + +=head1 VERSION + +$Id: + +=head1 BUGS + +=head1 SEE ALSO + +L, L, L, L, schema.html +from the base documentation. + +=cut + +1; + diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index bc6a4d735..69cd8058b 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -839,6 +839,9 @@ tie my %sqlmail_options, 'Tie::IxHash', }, + 'svc_broadband' => { + }, + ); =back diff --git a/FS/FS/svc_broadband.pm b/FS/FS/svc_broadband.pm new file mode 100755 index 000000000..ab92fb3d7 --- /dev/null +++ b/FS/FS/svc_broadband.pm @@ -0,0 +1,295 @@ +package FS::svc_broadband; + +use strict; +use vars qw(@ISA $conf); +#use FS::Record qw( qsearch qsearchs ); +use FS::Record qw( qsearchs qsearch dbh ); +use FS::svc_Common; +use FS::cust_svc; +use NetAddr::IP; + +@ISA = qw( FS::svc_Common ); + +$FS::UID::callback{'FS::svc_broadband'} = sub { + $conf = new FS::Conf; +}; + +=head1 NAME + +FS::svc_broadband - Object methods for svc_broadband records + +=head1 SYNOPSIS + + use FS::svc_broadband; + + $record = new FS::svc_broadband \%hash; + $record = new FS::svc_broadband { '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_broadband object represents a 'broadband' Internet connection, such +as a DSL, cable modem, or fixed wireless link. These services are assumed to +have the following properties: + +=over 2 + +=item +The network consists of one or more 'Access Concentrators' (ACs), such as +DSLAMs or wireless access points. (See L.) + +=item +Each AC provides connectivity to one or more contiguous blocks of IP addresses, +each described by a gateway address and a netmask. (See L.) + +=item +Each connection has one or more static IP addresses within one of these blocks. + +=item +The details of configuring routers and other devices are to be handled by a +site-specific L subclass. + +=back + +FS::svc_broadband inherits from FS::svc_Common. The following fields are +currently supported: + +=over 4 + +=item svcnum - primary key + +=item +actypenum - access concentrator type; see L. This is included here +so that a part_svc can specifically be a 'wireless' or 'DSL' service by +designating actypenum as a fixed field. It does create a redundant functional +dependency between this table and ac_type, in that the matching ac_type could +be found by looking up the IP address in ac_block and then finding the block's +AC, but part_svc can't do that, and we don't feel like hacking it so that it +can. + +=item +speed_up - maximum upload speed, in bits per second. If set to zero, upload +speed will be unlimited. Exports that do traffic shaping should handle this +correctly, and not blindly set the upload speed to zero and kill the customer's +connection. + +=item +speed_down - maximum download speed, as above + +=item +ip_addr - the customer's IP address. If the customer needs more than one IP +address, set this to the address of the customer's router. As a result, the +customer's router will have the same address for both it's internal and external +interfaces thus saving address space. This has been found to work on most NAT +routers available. + +=item +ip_netmask - the customer's netmask, as a single integer in the range 0-32. +(E.g. '24', not '255.255.255.0'. We assume that address blocks are contiguous.) +This should be 32 unless the customer has multiple IP addresses. + +=item +mac_addr - the MAC address of the customer's router or other device directly +connected to the network, if needed. Some systems (e.g. DHCP, MAC address-based +access control) may need this. If not, you may leave it blank. + +=item +location - a human-readable description of the location of the connected site, +such as its address. This should not be used for billing or contact purposes; +that information is stored in L. + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new svc_broadband. To add the record to the database, see +L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I method. + +=cut + +sub table { 'svc_broadband'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +The additional fields pkgnum and svcpart (see L) should be +defined. An FS::cust_svc record will be created and inserted. + +=cut + +# sub insert {} +# Standard FS::svc_Common::insert +# (any necessary Deep Magic is handled by exports) + +=item delete + +Delete this record from the database. + +=cut + +# Standard FS::svc_Common::delete + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +# Standard FS::svc_Common::replace +# Notice a pattern here? + +=item suspend + +Called by the suspend method of FS::cust_pkg (see L). + +=item unsuspend + +Called by the unsuspend method of FS::cust_pkg (see L). + +=item cancel + +Called by the cancel method of FS::cust_pkg (see L). + +=item check + +Checks all fields to make sure this is a valid broadband service. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +sub check { + my $self = shift; + my $x = $self->setfixed; + + return $x unless ref($x); + + my $error = + $self->ut_numbern('svcnum') + || $self->ut_foreign_key('actypenum', 'ac_type', 'actypenum') + || $self->ut_number('speed_up') + || $self->ut_number('speed_down') + || $self->ut_ip('ip_addr') + || $self->ut_numbern('ip_netmask') + || $self->ut_textn('mac_addr') + || $self->ut_textn('location') + ; + return $error if $error; + + if($self->speed_up < 0) { return 'speed_up must be positive'; } + if($self->speed_down < 0) { return 'speed_down must be positive'; } + + # This should catch errors in the ip_addr and ip_netmask. If it doesn't, + # they'll almost certainly not map into a valid block anyway. + my $self_addr = new NetAddr::IP ($self->ip_addr, $self->ip_netmask); + return 'Cannot parse address: ' . $self->ip_addr . '/' . $self->ip_netmask unless $self_addr; + + my @block = grep { + my $block_addr = new NetAddr::IP ($_->ip_gateway, $_->ip_netmask); + if ($block_addr->contains($self_addr)) { $_ }; + } qsearch( 'ac_block', { acnum => $self->acnum }); + + if(scalar @block == 0) { + return 'Block not found for address '.$self->ip_addr.' in actype '.$self->actypenum; + } elsif(scalar @block > 1) { + return 'ERROR: Intersecting blocks found for address '.$self->ip_addr.' :'. + join ', ', map {$_->ip_addr . '/' . $_->ip_netmask} @block; + } + # OK, we've found a valid block. We don't actually _do_ anything with it, though; we + # just take comfort in the knowledge that it exists. + + # A simple qsearchs won't work here. Since we can assign blocks to customers, + # we have to make sure the new address doesn't fall within someone else's + # block. Ugh. + + my @conflicts = grep { + my $cust_addr = new NetAddr::IP($_->ip_addr, $_->ip_netmask); + if (($cust_addr->contains($self_addr)) and + ($_->svcnum ne $self->svcnum)) { $_; }; + } qsearch('svc_broadband', {}); + + if (scalar @conflicts > 0) { + return 'Address in use by existing service'; + } + + # Are we trying to use a network, broadcast, or the AC's address? + foreach (qsearch('ac_block', { acnum => $self->acnum })) { + my $block_addr = new NetAddr::IP($_->ip_gateway, $_->ip_netmask); + if ($block_addr->network->addr eq $self_addr->addr) { + return 'Address is network address for block '. $block_addr->network; + } + if ($block_addr->broadcast->addr eq $self_addr->addr) { + return 'Address is broadcast address for block '. $block_addr->network; + } + if ($block_addr->addr eq $self_addr->addr) { + return 'Address belongs to the access concentrator: '. $block_addr->addr; + } + } + + ''; #no error +} + +=item ac_block + +Returns the FS::ac_block record (i.e. the address block) for this broadband service. + +=cut + +sub ac_block { + my $self = shift; + my $self_addr = new NetAddr::IP ($self->ip_addr, $self->ip_netmask); + + foreach my $block (qsearch( 'ac_block', {} )) { + my $block_addr = new NetAddr::IP ($block->ip_addr, $block->ip_netmask); + if($block_addr->contains($self_addr)) { return $block; } + } + return ''; +} + +=item ac_type + +Returns the FS::ac_type record for this broadband service. + +=cut + +sub ac_type { + my $self = shift; + return qsearchs('ac_type', { actypenum => $self->actypenum }); +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, L, L, L, +L, schema.html from the base documentation. + +=cut + +1; + -- cgit v1.2.1 From 27b1e8e41b7d4ace60b286ec02a171009aee83f2 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 10 Sep 2002 03:31:00 +0000 Subject: Business::OnlinePaymet fix for processors w/o order numbers, like VirtualNet --- FS/FS/cust_bill.pm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 5e041ea59..d49657e2e 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -674,7 +674,9 @@ sub realtime_card { if ( $transaction->is_success() && $action2 ) { my $auth = $transaction->authorization; - my $ordernum = $transaction->order_number; + my $ordernum = $transaction->can('order_number') + ? $transaction->order_number + : ''; #warn "********* $auth ***********\n"; #warn "********* $ordernum ***********\n"; @@ -1112,7 +1114,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.41 2002-09-05 16:51:49 ivan Exp $ +$Id: cust_bill.pm,v 1.42 2002-09-10 03:31:00 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 3548c2951a51ece84687e3bfb5e435008191a713 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 16 Sep 2002 09:27:14 +0000 Subject: skip empty expiration dates --- FS/bin/freeside-expiration-alerter | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-expiration-alerter b/FS/bin/freeside-expiration-alerter index ee3c1fb92..5399f6d22 100755 --- a/FS/bin/freeside-expiration-alerter +++ b/FS/bin/freeside-expiration-alerter @@ -80,16 +80,18 @@ $alerter->compile() or die "can't compile template: Text::Template::ERROR"; # Now I can start looping foreach my $customer (@customers) { + my $paydate = $customer->getfield('paydate'); + next if $paydate =~ /^\s*$/; #skip empty expiration dates + my $custnum = $customer->getfield('custnum'); my $first = $customer->getfield('first'); my $last = $customer->getfield('last'); my $company = $customer->getfield('company'); my $payby = $customer->getfield('payby'); my $payinfo = $customer->getfield('payinfo'); - my $paydate = $customer->getfield('paydate'); my $daytime = $customer->getfield('daytime'); my $night = $customer->getfield('night'); - + my ($payyear,$paymonth,$payday) = split (/-/,$paydate); my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear); @@ -200,7 +202,7 @@ user: From the mapsecrets file - see config.html from the base documentation =head1 VERSION -$Id: freeside-expiration-alerter,v 1.3 2002-04-16 09:38:19 ivan Exp $ +$Id: freeside-expiration-alerter,v 1.4 2002-09-16 09:27:14 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From bc7312f2a83c76674aa3478ba989d6f9fb7a5cb3 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 17 Sep 2002 00:33:17 +0000 Subject: - "emailinvoiceauto" implementation rewritten to work properly, stop overwriting existing invoice destinations --- FS/FS/Conf.pm | 2 +- FS/FS/cust_bill.pm | 4 ++-- FS/FS/cust_main.pm | 25 ++++++++++++++++++------- FS/FS/svc_acct.pm | 15 ++++++++++++--- 4 files changed, 33 insertions(+), 13 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index e93eaf3fc..e50cb29b9 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -369,7 +369,7 @@ httemplate/docs/config.html { 'key' => 'emailinvoiceauto', 'section' => 'billing', - 'description' => 'Automatically adds new accounts to the email invoice list upon customer creation', + 'description' => 'Automatically adds new accounts to the email invoice list', 'type' => 'checkbox', }, diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index d49657e2e..65c41d5c9 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -623,7 +623,7 @@ sub realtime_card { my @invoicing_list = grep { $_ ne 'POST' } $cust_main->invoicing_list; if ( $conf->exists('emailinvoiceauto') || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) { - push @invoicing_list, $cust_main->default_invoicing_list; + push @invoicing_list, $cust_main->all_emails; } my $email = $invoicing_list[0]; @@ -1114,7 +1114,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.42 2002-09-10 03:31:00 ivan Exp $ +$Id: cust_bill.pm,v 1.43 2002-09-17 00:33:17 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index cfa6b8bb6..84fd3d150 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1584,7 +1584,6 @@ sub invoicing_list { } my %seen = map { $_->address => 1 } @cust_main_invoice; foreach my $address ( @{$arrayref} ) { - #unless ( grep { $address eq $_->address } @cust_main_invoice ) { next if exists $seen{$address} && $seen{$address}; $seen{$address} = 1; my $cust_main_invoice = new FS::cust_main_invoice ( { @@ -1626,24 +1625,36 @@ sub check_invoicing_list { ''; } -=item default_invoicing_list +=item set_default_invoicing_list -Sets the invoicing list to all accounts associated with this customer. +Sets the invoicing list to all accounts associated with this customer, +overwriting any previous invoicing list. =cut -sub default_invoicing_list { +sub set_default_invoicing_list { my $self = shift; - my @list = (); + $self->invoicing_list($self->all_emails); +} + +=item all_emails + +Returns the email addresses of all accounts provisioned for this customer. + +=cut + +sub all_emails { + my $self = shift; + my %list; foreach my $cust_pkg ( $self->all_pkgs ) { my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } ); my @svc_acct = map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) } grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) } @cust_svc; - push @list, map { $_->email } @svc_acct; + $list{$_}=1 foreach map { $_->email } @svc_acct; } - $self->invoicing_list(\@list); + keys %list; } =item invoicing_list_addpost diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 9032e20c1..f73ab82da 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -341,11 +341,20 @@ sub insert { return "queueing job (transaction rolled back): $error"; } - #welcome email my $cust_pkg = $self->cust_svc->cust_pkg; - my( $cust_main, $to ) = ( '', '' ); + my $cust_main = $cust_pkg->cust_main; + + my $cust_pkg = $self->cust_svc->cust_pkg; + + if ( $conf->exists('emailinvoiceauto') ) { + my @invoicing_list = $cust_main->invoicing_list; + push @invoicing_list, $self->email; + $cust_main->invoicing_list(@invoicing_list); + } + + #welcome email + my $to = ''; if ( $welcome_template && $cust_pkg ) { - my $cust_main = $cust_pkg->cust_main; my $to = join(', ', grep { $_ ne 'POST' } $cust_main->invoicing_list ); if ( $to ) { my $wqueue = new FS::queue { -- cgit v1.2.1 From 3999cc30d219a7ebf6db985d0904ffe42b79860e Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 17 Sep 2002 00:40:07 +0000 Subject: send_ftp doc fix --- FS/FS/cust_bill.pm | 22 +++++++++++++++++++--- 1 file changed, 19 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 65c41d5c9..52fc94235 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -443,23 +443,39 @@ first two fields (B and B) and the last five fields (B through B) are filled in. =item invnum - invoice number + =item custnum - customer number + =item _date - invoice date + =item charged - total invoice amount + =item first - customer first name + =item last - customer first name + =item company - company name + =item address1 - address line 1 + =item address2 - address line 1 + =item city + =item state + =item zip + =item country =item pkg - line item description -=item setup - line item setup fee (only or both of B and B will be defined) -=item recur - line item recurring fee (only or both of B and B will be defined) + +=item setup - line item setup fee (one or both of B and B will be defined) + +=item recur - line item recurring fee (one or both of B and B will be defined) + =item sdate - start date for recurring fee + =item edate - end date for recurring fee =back @@ -1114,7 +1130,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.43 2002-09-17 00:33:17 ivan Exp $ +$Id: cust_bill.pm,v 1.44 2002-09-17 00:40:07 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 3595c874f8e476e58b98b7ab6d86918d4dbb1d5c Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 17 Sep 2002 09:19:42 +0000 Subject: remove svc_acct_sm --- FS/FS.pm | 2 - FS/FS/InitHandler.pm | 1 - FS/FS/cust_pkg.pm | 14 +-- FS/FS/part_export.pm | 2 - FS/FS/part_svc.pm | 27 +----- FS/FS/svc_acct.pm | 9 +- FS/FS/svc_acct_sm.pm | 260 --------------------------------------------------- FS/MANIFEST | 2 - FS/t/svc_acct_sm.t | 5 - 9 files changed, 9 insertions(+), 313 deletions(-) delete mode 100644 FS/FS/svc_acct_sm.pm delete mode 100644 FS/t/svc_acct_sm.t (limited to 'FS') diff --git a/FS/FS.pm b/FS/FS.pm index 963c73548..c22557a2d 100644 --- a/FS/FS.pm +++ b/FS/FS.pm @@ -62,8 +62,6 @@ L - DNS zone entries L - Mail forwarding class -L - (Depreciated) Vitual mail alias class - L - Web virtual host class. L - Service definition class diff --git a/FS/FS/InitHandler.pm b/FS/FS/InitHandler.pm index 0216615da..5038cf352 100644 --- a/FS/FS/InitHandler.pm +++ b/FS/FS/InitHandler.pm @@ -52,7 +52,6 @@ sub handler { use FS::session; use FS::svc_acct; use FS::svc_acct_pop; - use FS::svc_acct_sm; use FS::svc_domain; use FS::svc_forward; use FS::svc_www; diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 12508e1aa..0c71435e1 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -14,7 +14,6 @@ use FS::pkg_svc; # setup } # because they load configuraion by setting FS::UID::callback (see TODO) use FS::svc_acct; -use FS::svc_acct_sm; use FS::svc_domain; use FS::svc_www; use FS::svc_forward; @@ -679,7 +678,7 @@ sub order { =head1 VERSION -$Id: cust_pkg.pm,v 1.23 2002-08-26 20:40:55 ivan Exp $ +$Id: cust_pkg.pm,v 1.24 2002-09-17 09:19:06 ivan Exp $ =head1 BUGS @@ -690,11 +689,12 @@ 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. +FS::svc_acct, FS::svc_domain, FS::svc_www and FS::svc_forward are loaded via +'use' at compile time, rather than via 'require' in sub +{ setup, suspend, unsuspend, cancel } because they use %FS::UID::callback to +load configuration values. Probably need a subroutine which decides what to +do based on whether or not we've fetched the user yet, rather than a hash. +See FS::UID and the TODO. Now that things are transactional should the check in the insert method be moved to check ? diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 69cd8058b..647666b86 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -819,8 +819,6 @@ tie my %sqlmail_options, 'Tie::IxHash', }, - 'svc_acct_sm' => {}, - 'svc_forward' => { 'sqlmail' => { 'desc' => 'Real-time export to SQL-backed mail server', diff --git a/FS/FS/part_svc.pm b/FS/FS/part_svc.pm index 959a3f887..7c6acdbcd 100644 --- a/FS/FS/part_svc.pm +++ b/FS/FS/part_svc.pm @@ -254,31 +254,6 @@ sub check { my @fields = eval { fields( $recref->{svcdb} ) }; #might die return "Unknown svcdb!" unless @fields; -##REPLACED BY part_svc_column -# my $svcdb; -# foreach $svcdb ( qw( -# svc_acct svc_acct_sm svc_domain -# ) ) { -# my @rows = map { /^${svcdb}__(.*)$/; $1 } -# grep ! /_flag$/, -# grep /^${svcdb}__/, -# fields('part_svc'); -# foreach my $row (@rows) { -# unless ( $svcdb eq $recref->{svcdb} ) { -# $recref->{$svcdb.'__'.$row}=''; -# $recref->{$svcdb.'__'.$row.'_flag'}=''; -# next; -# } -# $recref->{$svcdb.'__'.$row.'_flag'} =~ /^([DF]?)$/ -# or return "Illegal flag for $svcdb $row"; -# $recref->{$svcdb.'__'.$row.'_flag'} = $1; -# -# my $error = $self->ut_anything($svcdb.'__'.$row); -# return $error if $error; -# -# } -# } - ''; #no error } @@ -325,7 +300,7 @@ sub part_export { =head1 VERSION -$Id: part_svc.pm,v 1.13 2002-04-11 22:05:31 ivan Exp $ +$Id: part_svc.pm,v 1.14 2002-09-17 09:19:06 ivan Exp $ =head1 BUGS diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index f73ab82da..bd348f8ed 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -18,11 +18,9 @@ use FS::UID qw( datasrc ); use FS::Conf; use FS::Record qw( qsearch qsearchs fields dbh ); use FS::svc_Common; -use Net::SSH; use FS::cust_svc; use FS::part_svc; use FS::svc_acct_pop; -use FS::svc_acct_sm; use FS::cust_main_invoice; use FS::svc_domain; use FS::raddb; @@ -410,11 +408,6 @@ The corresponding FS::cust_svc record will be deleted as well. sub delete { my $self = shift; - if ( defined( $FS::Record::dbdef->table('svc_acct_sm') ) ) { - return "Can't delete an account which has (svc_acct_sm) mail aliases!" - if $self->uid && qsearch( 'svc_acct_sm', { 'domuid' => $self->uid } ); - } - return "Can't delete an account which is a (svc_forward) source!" if qsearch( 'svc_forward', { 'srcsvc' => $self->svcnum } ); @@ -1148,7 +1141,7 @@ probably live somewhere else... L, edit/part_svc.cgi from an installed web interface, export.html from the base documentation, L, L, L, L, L, L, -L), L, L, L, +L), L, schema.html from the base documentation. =cut diff --git a/FS/FS/svc_acct_sm.pm b/FS/FS/svc_acct_sm.pm deleted file mode 100644 index c92f1421f..000000000 --- a/FS/FS/svc_acct_sm.pm +++ /dev/null @@ -1,260 +0,0 @@ -package FS::svc_acct_sm; - -use strict; -use vars qw( @ISA $nossh_hack $conf $shellmachine @qmailmachines ); -use FS::Record qw( fields qsearch qsearchs ); -use FS::svc_Common; -use FS::cust_svc; -use Net::SSH qw(ssh); -use FS::Conf; -use FS::svc_acct; -use FS::svc_domain; - -@ISA = qw( FS::svc_Common ); - -#ask FS::UID to run this stuff for us later -#$FS::UID::callback{'FS::svc_acct_sm'} = sub { -# $conf = new FS::Conf; -# $shellmachine = $conf->exists('qmailmachines') -# ? $conf->config('shellmachine') -# : ''; -#}; - -=head1 NAME - -FS::svc_acct_sm - Object methods for svc_acct_sm records - -=head1 SYNOPSIS - - use FS::svc_acct_sm; - - $record = new FS::svc_acct_sm \%hash; - $record = new FS::svc_acct_sm { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - - $error = $record->suspend; - - $error = $record->unsuspend; - - $error = $record->cancel; - -=head1 WARNING - -FS::svc_acct_sm is B. This class is only included for migration -purposes. See L. - -=head1 DESCRIPTION - -An FS::svc_acct_sm object represents a virtual mail alias. FS::svc_acct_sm -inherits from FS::Record. The following fields are currently supported: - -=over 4 - -=item svcnum - primary key (assigned automatcially for new accounts) - -=item domsvc - svcnum of the virtual domain (see L) - -=item domuid - uid of the target account (see L) - -=item domuser - virtual username - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new virtual mail alias. To add the virtual mail alias to the -database, see L<"insert">. - -=cut - -sub table { 'svc_acct_sm'; } - -=item insert - -Adds this virtual mail alias to the database. If there is an error, returns -the error, otherwise returns false. - -The additional fields pkgnum and svcpart (see L) 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 = shift; - my $error; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - $error=$self->check; - return $error if $error; - - return "Domain username (domuser) in use for this domain (domsvc)" - if qsearchs('svc_acct_sm',{ 'domuser'=> $self->domuser, - 'domsvc' => $self->domsvc, - } ); - - return "First domain username (domuser) for domain (domsvc) must be " . - qq='*' (catch-all)!= - if $self->domuser ne '*' - && ! qsearch('svc_acct_sm',{ 'domsvc' => $self->domsvc } ) - && ! $conf->exists('maildisablecatchall'); - - $error = $self->SUPER::insert; - return $error if $error; - - #my $svc_domain = qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } ); - #my $svc_acct = qsearchs( 'svc_acct', { 'uid' => $self->domuid } ); - #my ( $uid, $gid, $dir, $domain ) = ( - # $svc_acct->uid, - # $svc_acct->gid, - # $svc_acct->dir, - # $svc_domain->domain, - #); - #my $qdomain = $domain; - #$qdomain =~ s/\./:/g; #see manpage for 'dot-qmail': EXTENSION ADDRESSES - #ssh("root\@$shellmachine","[ -e $dir/.qmail-$qdomain-default ] || { touch $dir/.qmail-$qdomain-default; chown $uid:$gid $dir/.qmail-$qdomain-default; }") - # if ( ! $nossh_hack && $shellmachine && $dir && $self->domuser eq '*' ); - - ''; #no error - -} - -=item delete - -Deletes this virtual mail alias from the database. If there is an error, -returns the error, otherwise returns false. - -The corresponding FS::cust_svc record will be deleted as well. - -=item replace OLD_RECORD - -Replaces OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -sub replace { - my ( $new, $old ) = ( shift, shift ); - my $error; - - return "Domain username (domuser) in use for this domain (domsvc)" - if ( $old->domuser ne $new->domuser - || $old->domsvc != $new->domsvc - ) && qsearchs('svc_acct_sm',{ - 'domuser'=> $new->domuser, - 'domsvc' => $new->domsvc, - } ) - ; - - $new->SUPER::replace($old); - -} - -=item suspend - -Just returns false (no error) for now. - -Called by the suspend method of FS::cust_pkg (see L). - -=item unsuspend - -Just returns false (no error) for now. - -Called by the unsuspend method of FS::cust_pkg (see L). - -=item cancel - -Just returns false (no error) for now. - -Called by the cancel method of FS::cust_pkg (see L). - -=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 = shift; - my $error; - - my $x = $self->setfixed; - return $x unless ref($x); - #my $part_svc = $x; - - my($recref) = $self->hashref; - - $recref->{domuser} =~ /^(\*|[a-z0-9_\-]{2,32})$/ - or return "Illegal domain username (domuser)"; - $recref->{domuser} = $1; - - $recref->{domsvc} =~ /^(\d+)$/ or return "Illegal domsvc"; - $recref->{domsvc} = $1; - my($svc_domain); - return "Unknown domsvc" unless - $svc_domain=qsearchs('svc_domain',{'svcnum'=> $recref->{domsvc} } ); - - $recref->{domuid} =~ /^(\d+)$/ or return "Illegal uid"; - $recref->{domuid} = $1; - my($svc_acct); - return "Unknown uid" unless - $svc_acct=qsearchs('svc_acct',{'uid'=> $recref->{domuid} } ); - - ''; #no error -} - -=back - -=head1 VERSION - -$Id: svc_acct_sm.pm,v 1.5 2001-09-06 20:41:59 ivan Exp $ - -=head1 BUGS - -The remote commands should be configurable. - -The $recref stuff in sub check should be cleaned up. - -=head1 SEE ALSO - -L - -L, L, L, L, L, -L, L, L, L, L, -schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/MANIFEST b/FS/MANIFEST index 4a250d77b..3cf4c2ba3 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -87,7 +87,6 @@ FS/pkg_svc.pm FS/svc_Common.pm FS/svc_acct.pm FS/svc_acct_pop.pm -FS/svc_acct_sm.pm FS/svc_broadband.pm FS/svc_domain.pm FS/type_pkgs.pm @@ -165,7 +164,6 @@ t/radius_usergroup.t t/session.t t/svc_acct.t t/svc_acct_pop.t -t/svc_acct_sm.t t/svc_Common.t t/svc_domain.t t/svc_forward.t diff --git a/FS/t/svc_acct_sm.t b/FS/t/svc_acct_sm.t deleted file mode 100644 index 1082f2cdb..000000000 --- a/FS/t/svc_acct_sm.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::svc_acct_sm; -$loaded=1; -print "ok 1\n"; -- cgit v1.2.1 From 0c9f7a9f0e0cb21407051b7804f8454e85421f14 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 17 Sep 2002 10:21:47 +0000 Subject: remove obsolete cybercash support --- FS/FS/Conf.pm | 7 ---- FS/FS/cust_bill.pm | 103 ++--------------------------------------------------- 2 files changed, 2 insertions(+), 108 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index e50cb29b9..36ee69a36 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -289,13 +289,6 @@ httemplate/docs/config.html 'type' => 'text', }, - { - 'key' => 'cybercash3.2', - 'section' => 'billing', - 'description' => 'CyberCash Cashregister v3.2 support. Two lines: the full path and name of your merchant_conf file, and the transaction type (`mauthonly\' or `mauthcapture\').', - 'type' => 'textarea', - }, - { 'key' => 'cyrus', 'section' => 'deprecated', diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 52fc94235..258b32e15 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -35,28 +35,7 @@ $FS::UID::callback{'FS::cust_bill'} = sub { $invoice_from = $conf->config('invoice_from'); $smtpmachine = $conf->config('smtpmachine'); - if ( $conf->exists('cybercash3.2') ) { - require CCMckLib3_2; - #qw($MCKversion %Config InitConfig CCError CCDebug CCDebug2); - require CCMckDirectLib3_2; - #qw(SendCC2_1Server); - require CCMckErrno3_2; - #qw(MCKGetErrorMessage $E_NoErr); - import CCMckErrno3_2 qw($E_NoErr); - - my $merchant_conf; - ($merchant_conf,$xaction)= $conf->config('cybercash3.2'); - my $status = &CCMckLib3_2::InitConfig($merchant_conf); - if ( $status != $E_NoErr ) { - warn "CCMckLib3_2::InitConfig error:\n"; - foreach my $key (keys %CCMckLib3_2::Config) { - warn " $key => $CCMckLib3_2::Config{$key}\n" - } - my($errmsg) = &CCMckErrno3_2::MCKGetErrorMessage($status); - die "CCMckLib3_2::InitConfig fatal error: $errmsg\n"; - } - $processor='cybercash3.2'; - } elsif ( $conf->exists('business-onlinepayment') ) { + if ( $conf->exists('business-onlinepayment') ) { ( $bop_processor, $bop_login, $bop_password, @@ -800,84 +779,6 @@ sub realtime_card { } -=item realtime_card_cybercash - -Attempts to pay this invoice with the CyberCash CashRegister realtime gateway. - -=cut - -sub realtime_card_cybercash { - my $self = shift; - my $cust_main = $self->cust_main; - my $amount = $self->owed; - - return "CyberCash CashRegister real-time card processing not enabled!" - unless $processor eq 'cybercash3.2'; - - my $address = $cust_main->address1; - $address .= ", ". $cust_main->address2 if $cust_main->address2; - - #fix exp. date - #$cust_main->paydate =~ /^(\d+)\/\d*(\d{2})$/; - $cust_main->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; - my $exp = "$2/$1"; - - # - - my $paybatch = $self->invnum. - '-' . time2str("%y%m%d%H%M%S", time); - - my $payname = $cust_main->payname || - $cust_main->getfield('first').' '.$cust_main->getfield('last'); - - my $country = $cust_main->country eq 'US' ? 'USA' : $cust_main->country; - - my @full_xaction = ( $xaction, - 'Order-ID' => $paybatch, - 'Amount' => "usd $amount", - 'Card-Number' => $cust_main->getfield('payinfo'), - 'Card-Name' => $payname, - 'Card-Address' => $address, - 'Card-City' => $cust_main->getfield('city'), - 'Card-State' => $cust_main->getfield('state'), - 'Card-Zip' => $cust_main->getfield('zip'), - 'Card-Country' => $country, - 'Card-Exp' => $exp, - ); - - my %result; - %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction); - - if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3 - my $cust_pay = new FS::cust_pay ( { - 'invnum' => $self->invnum, - 'paid' => $amount, - '_date' => '', - 'payby' => 'CARD', - 'payinfo' => $cust_main->payinfo, - 'paybatch' => "$processor:$paybatch", - } ); - my $error = $cust_pay->insert; - if ( $error ) { - # gah, even with transactions. - my $e = 'WARNING: Card debited but database not updated - '. - 'error applying payment, invnum #' . $self->invnum. - " (CyberCash Order-ID $paybatch): $error"; - warn $e; - return $e; - } else { - return ''; - } -# } elsif ( $result{'Mstatus'} ne 'failure-bad-money' -# || $options{'report_badcard'} -# ) { - } else { - return 'Cybercash error, invnum #' . - $self->invnum. ':'. $result{'MErrMsg'}; - } - -} - =item batch_card Adds a payment for this invoice to the pending credit card batch (see @@ -1130,7 +1031,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.44 2002-09-17 00:40:07 ivan Exp $ +$Id: cust_bill.pm,v 1.45 2002-09-17 10:21:47 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 89d15555270a63ab09116107f3dc327e86d831c5 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 18 Sep 2002 22:39:01 +0000 Subject: removing svc_acct_sm --- FS/FS/cust_svc.pm | 8 +------- FS/FS/svc_domain.pm | 4 ---- 2 files changed, 1 insertion(+), 11 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index d54fb2d40..9d510b38a 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -9,7 +9,6 @@ use FS::part_pkg; use FS::part_svc; use FS::pkg_svc; use FS::svc_acct; -use FS::svc_acct_sm; use FS::svc_domain; use FS::svc_forward; use FS::domain_record; @@ -276,11 +275,6 @@ sub label { my $tag; if ( $svcdb eq 'svc_acct' ) { $tag = $svc_x->email; - } elsif ( $svcdb eq 'svc_acct_sm' ) { - my $domuser = $svc_x->domuser eq '*' ? '(anything)' : $svc_x->domuser; - my $svc_domain = qsearchs ( 'svc_domain', { 'svcnum' => $svc_x->domsvc } ); - my $domain = $svc_domain->domain; - $tag = "$domuser\@$domain"; } elsif ( $svcdb eq 'svc_forward' ) { my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_x->srcsvc } ); $tag = $svc_acct->email. '->'; @@ -346,7 +340,7 @@ sub seconds_since { =head1 VERSION -$Id: cust_svc.pm,v 1.16 2002-09-09 23:01:35 khoff Exp $ +$Id: cust_svc.pm,v 1.17 2002-09-18 22:39:01 ivan Exp $ =head1 BUGS diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm index 637d0493c..0d71b2775 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -251,10 +251,6 @@ sub delete { return "Can't delete a domain which has accounts!" if qsearch( 'svc_acct', { 'domsvc' => $self->svcnum } ); - return "Can't delete a domain with (svc_acct_sm) mail aliases!" - if defined( $FS::Record::dbdef->table('svc_acct_sm') ) - && qsearch('svc_acct_sm', { 'domsvc' => $self->svcnum } ); - #return "Can't delete a domain with (domain_record) zone entries!" # if qsearch('domain_record', { 'svcnum' => $self->svcnum } ); -- cgit v1.2.1 From c1e33a61324f4e06157c522af7882a97a021830f Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 18 Sep 2002 22:50:44 +0000 Subject: remove domain config file, closes: Bug#269 --- FS/FS/Conf.pm | 7 ------- FS/FS/cust_main_invoice.pm | 9 +-------- FS/FS/svc_acct.pm | 14 ++++---------- FS/bin/freeside-email | 6 ++---- 4 files changed, 7 insertions(+), 29 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 36ee69a36..e9defdafd 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -331,13 +331,6 @@ httemplate/docs/config.html 'type' => 'checkbox', }, - { - 'key' => 'domain', - 'section' => 'deprecated', - 'description' => 'Your domain name.', - 'type' => 'text', - }, - { 'key' => 'editreferrals', 'section' => 'UI', diff --git a/FS/FS/cust_main_invoice.pm b/FS/FS/cust_main_invoice.pm index a5533a088..bcb1437af 100644 --- a/FS/FS/cust_main_invoice.pm +++ b/FS/FS/cust_main_invoice.pm @@ -134,13 +134,6 @@ sub checkdest { unless qsearchs( 'svc_acct', { 'svcnum' => $self->dest } ); } elsif ( $self->dest =~ /^([\w\.\-\&\+]+)\@(([\w\.\-]+\.)+\w+)$/ ) { my($user, $domain) = ($1, $2); -# if ( $domain eq $mydomain ) { -# my $svc_acct = qsearchs( 'svc_acct', { 'username' => $user } ); -# return "Unknown local account: $user\@$domain (specified literally)" -# unless $svc_acct; -# $svc_acct->svcnum =~ /^(\d+)$/ or die "Non-numeric svcnum?!"; -# $self->dest($1); -# } $self->dest("$1\@$2"); } else { return gettext("illegal_email_invoice_address"); @@ -170,7 +163,7 @@ sub address { =head1 VERSION -$Id: cust_main_invoice.pm,v 1.12 2002-04-12 13:22:02 ivan Exp $ +$Id: cust_main_invoice.pm,v 1.13 2002-09-18 22:50:44 ivan Exp $ =head1 BUGS diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index bd348f8ed..420c6f422 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -7,7 +7,6 @@ use vars qw( @ISA $noexport_hack $conf $username_ampersand $username_letter $username_letterfirst $username_noperiod $username_nounderscore $username_nodash $username_uppercase - $mydomain $welcome_template $welcome_from $welcome_subject $welcome_mimetype $smtpmachine $dirhash @@ -48,7 +47,6 @@ $FS::UID::callback{'FS::svc_acct'} = sub { $username_nodash = $conf->exists('username-nodash'); $username_uppercase = $conf->exists('username-uppercase'); $username_ampersand = $conf->exists('username-ampersand'); - $mydomain = $conf->config('domain'); $dirhash = $conf->config('dirhash') || 0; if ( $conf->exists('welcome_email') ) { $welcome_template = new Text::Template ( @@ -875,14 +873,10 @@ Returns the domain associated with this account. sub domain { my $self = shift; - if ( $self->domsvc ) { - #$self->svc_domain->domain; - my $svc_domain = $self->svc_domain - or die "no svc_domain.svcnum for svc_acct.domsvc ". $self->domsvc; - $svc_domain->domain; - } else { - $mydomain or die "svc_acct.domsvc is null and no legacy domain config file"; - } + die "svc_acct.domsvc is null for svcnum ". $self->svcnum unless $self->domsvc; + my $svc_domain = $self->svc_domain + or die "no svc_domain.svcnum for svc_acct.domsvc ". $self->domsvc; + $svc_domain->domain; } =item svc_domain diff --git a/FS/bin/freeside-email b/FS/bin/freeside-email index c7ff41114..400dc2ac7 100755 --- a/FS/bin/freeside-email +++ b/FS/bin/freeside-email @@ -12,11 +12,9 @@ my $user = shift or die &usage; adminsuidsetup $user; my $conf = new FS::Conf; -my $domain = $conf->config('domain'); my @svc_acct = qsearch('svc_acct', {}); -my @usernames = map $_->username, @svc_acct; -my @emails = map "$_\@$domain", @usernames; +my @emails = map $_->email, @svc_acct; print join("\n", @emails), "\n"; @@ -51,7 +49,7 @@ user: From the mapsecrets file - see config.html from the base documentation =head1 VERSION -$Id: freeside-email,v 1.1 2001-05-15 07:52:34 ivan Exp $ +$Id: freeside-email,v 1.2 2002-09-18 22:50:44 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From cf730711a39c28c720d475cc9e3a94d712c2b798 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 19 Sep 2002 08:34:41 +0000 Subject: remove extra definition of $cust_pkg --- FS/FS/svc_acct.pm | 2 -- 1 file changed, 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 420c6f422..991bbef48 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -340,8 +340,6 @@ sub insert { my $cust_pkg = $self->cust_svc->cust_pkg; my $cust_main = $cust_pkg->cust_main; - my $cust_pkg = $self->cust_svc->cust_pkg; - if ( $conf->exists('emailinvoiceauto') ) { my @invoicing_list = $cust_main->invoicing_list; push @invoicing_list, $self->email; -- cgit v1.2.1 From 0f5ad6c181cccbbdec6c48ea74e41d92ef5e3a26 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 19 Sep 2002 08:43:03 +0000 Subject: package expiration --- FS/bin/freeside-daily | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-daily b/FS/bin/freeside-daily index 142b0c73a..22bf2c963 100755 --- a/FS/bin/freeside-daily +++ b/FS/bin/freeside-daily @@ -28,15 +28,23 @@ my($time)= $opt_d ? str2time($opt_d) : $^T; my($cust_main,%saw); foreach $cust_main ( @cust_main ) { - my $error; + # $^T not $time because -d is for pre-printing invoices + foreach my $cust_pkg ( + grep { $_->expire && $_->expire >= $^T } $cust_main->ncancelled_pkgs + ) { + my $error = $cust_pkg->cancel; + warn "Error cancelling expired pkg ". $cust_pkg->pkgnum. " for custnum ". + $cust_main->custnum. ": $error" + if $error; + } - $error = $cust_main->bill( 'time' => $time ); + my $error = $cust_main->bill( 'time' => $time ); warn "Error billing, custnum ". $cust_main->custnum. ": $error" if $error; $cust_main->apply_payments; $cust_main->apply_credits; - $error=$cust_main->collect( 'invoice_time' => $time ); + $error = $cust_main->collect( 'invoice_time' => $time ); warn "Error collecting, custnum". $cust_main->custnum. ": $error" if $error; } -- cgit v1.2.1 From 4c5b1b08168b20da1a87e9b82ee87ad18cb3ddd6 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 19 Sep 2002 13:34:52 +0000 Subject: use database SERIAL or AUTO_INCREMENT for primary keys, finally, yay! closes: bug#69 --- FS/FS/Record.pm | 142 +++++++++++++++++++++++++++++++++++++++----------------- 1 file changed, 99 insertions(+), 43 deletions(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index c247ed2db..8778dee79 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -9,8 +9,8 @@ use Carp qw(carp cluck croak confess); use File::CounterFile; use Locale::Country; use DBI qw(:sql_types); -use DBIx::DBSchema 0.19; -use FS::UID qw(dbh checkruid getotaker datasrc driver_name); +use DBIx::DBSchema 0.21; +use FS::UID qw(dbh getotaker datasrc driver_name); use FS::SearchCache; use FS::Msgcat qw(gettext); @@ -60,14 +60,12 @@ FS::Record - Database record objects $hashref = $record->hashref; $error = $record->insert; - #$error = $record->add; #deprecated $error = $record->delete; - #$error = $record->del; #deprecated $error = $new_record->replace($old_record); - #$error = $new_record->rep($old_record); #deprecated + # external use deprecated - handled by the database (at least for Pg, mysql) $value = $record->unique('column'); $error = $record->ut_float('column'); @@ -88,7 +86,7 @@ FS::Record - Database record objects $quoted_value = _quote($value,'table','field'); - #depriciated + #deprecated $fields = hfields('table'); if ( $fields->{Field} ) { # etc. @@ -167,7 +165,7 @@ sub create { my $self = {}; bless ($self, $class); if ( defined $self->table ) { - cluck "create constructor is depriciated, use new!"; + cluck "create constructor is deprecated, use new!"; $self->new(@_); } else { croak "FS::Record::create called (not from a subclass)!"; @@ -212,25 +210,25 @@ sub qsearch { my $op = '='; if ( ref($record->{$_}) ) { $op = $record->{$_}{'op'} if $record->{$_}{'op'}; - $op = 'LIKE' if $op =~ /^ILIKE$/i && driver_name !~ /^Pg$/i; + $op = 'LIKE' if $op =~ /^ILIKE$/i && driver_name ne 'Pg'; $record->{$_} = $record->{$_}{'value'} } if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) { if ( $op eq '=' ) { - if ( driver_name =~ /^Pg$/i ) { + if ( driver_name eq 'Pg' ) { qq-( $_ IS NULL OR $_ = '' )-; } else { qq-( $_ IS NULL OR $_ = "" )-; } } elsif ( $op eq '!=' ) { - if ( driver_name =~ /^Pg$/i ) { + if ( driver_name eq 'Pg' ) { qq-( $_ IS NOT NULL AND $_ != '' )-; } else { qq-( $_ IS NOT NULL AND $_ != "" )-; } } else { - if ( driver_name =~ /^Pg$/i ) { + if ( driver_name eq 'Pg' ) { qq-( $_ $op '' )-; } else { qq-( $_ $op "" )-; @@ -345,7 +343,7 @@ Returns the table name. =cut sub table { -# cluck "warning: FS::Record::table depriciated; supply one in subclass!"; +# cluck "warning: FS::Record::table deprecated; supply one in subclass!"; my $self = shift; $self -> {'Table'}; } @@ -472,24 +470,33 @@ sub insert { return $error if $error; #single-field unique keys are given a value if false - #(like MySQL's AUTO_INCREMENT) + #(like MySQL's AUTO_INCREMENT or Pg SERIAL) foreach ( $self->dbdef_table->unique->singles ) { $self->unique($_) unless $self->getfield($_); } - #and also the primary key + + #and also the primary key, if the database isn't going to my $primary_key = $self->dbdef_table->primary_key; - $self->unique($primary_key) - if $primary_key && ! $self->getfield($primary_key); + my $db_seq = 0; + if ( $primary_key ) { + my $col = $self->dbdef_table->column($primary_key); + my $db_seq = + uc($col->type) eq 'SERIAL' + || ( driver_name eq 'Pg' && $col->default =~ /^nextval\(/i ) + || ( driver_name eq 'mysql' && $col->local =~ /AUTO_INCREMENT/i ); + $self->unique($primary_key) unless $self->getfield($primary_key) || $db_seq; + } + my $table = $self->table; #false laziness w/delete my @fields = grep defined($self->getfield($_)) && $self->getfield($_) ne "", $self->fields ; - my @values = map { _quote( $self->getfield($_), $self->table, $_) } @fields; + my @values = map { _quote( $self->getfield($_), $table, $_) } @fields; #eslaf - my $statement = "INSERT INTO ". $self->table. " ( ". + my $statement = "INSERT INTO $table ( ". join( ', ', @fields ). ") VALUES (". join( ', ', @values ). @@ -498,15 +505,6 @@ sub insert { warn "[debug]$me $statement\n" if $DEBUG > 1; my $sth = dbh->prepare($statement) or return dbh->errstr; - my $h_sth; - if ( defined $dbdef->table('h_'. $self->table) ) { - my $h_statement = $self->_h_statement('insert'); - warn "[debug]$me $h_statement\n" if $DEBUG > 2; - $h_sth = dbh->prepare($h_statement) or return dbh->errstr; - } else { - $h_sth = ''; - } - local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -515,7 +513,63 @@ sub insert { local $SIG{PIPE} = 'IGNORE'; $sth->execute or return $sth->errstr; + + if ( $db_seq ) { # get inserted id from the database, if applicable + my $insertid = ''; + if ( driver_name eq 'Pg' ) { + + my $oid = $sth->{'pg_oid_status'}; + my $i_sql = "SELECT id FROM $table WHERE oid = ?"; + my $i_sth = dbh->prepare($i_sql) or do { + dbh->rollback if $FS::UID::AutoCommit; + return dbh->errstr; + }; + $i_sth->execute($oid) or do { + dbh->rollback if $FS::UID::AutoCommit; + return $i_sth->errstr; + }; + $insertid = $i_sth->fetchrow_arrayref->[0]; + + } elsif ( driver_name eq 'mysql' ) { + + $insertid = dbh->{'mysql_insertid'}; + # work around mysql_insertid being null some of the time, ala RT :/ + unless ( $insertid ) { + warn "WARNING: DBD::mysql didn't return mysql_insertid; ". + "using SELECT LAST_INSERT_ID();"; + my $i_sql = "SELECT LAST_INSERT_ID()"; + my $i_sth = dbh->prepare($i_sql) or do { + dbh->rollback if $FS::UID::AutoCommit; + return dbh->errstr; + }; + $i_sth->execute or do { + dbh->rollback if $FS::UID::AutoCommit; + return $i_sth->errstr; + }; + $insertid = $i_sth->fetchrow_arrayref->[0]; + } + + } else { + dbh->rollback if $FS::UID::AutoCommit; + return "don't know how to retreive inserted ids from ". driver_name. + ", try using counterfiles (maybe run dbdef-create?)"; + } + $self->setfield($primary_key, $insertid); + } + + my $h_sth; + if ( defined $dbdef->table('h_'. $table) ) { + my $h_statement = $self->_h_statement('insert'); + warn "[debug]$me $h_statement\n" if $DEBUG > 2; + $h_sth = dbh->prepare($h_statement) or do { + dbh->rollback if $FS::UID::AutoCommit; + return dbh->errstr; + }; + } else { + $h_sth = ''; + } $h_sth->execute or return $h_sth->errstr if $h_sth; + dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit; ''; @@ -528,7 +582,7 @@ Depriciated (use insert instead). =cut sub add { - cluck "warning: FS::Record::add depriciated!"; + cluck "warning: FS::Record::add deprecated!"; insert @_; #call method in this scope } @@ -546,7 +600,7 @@ sub delete { map { $self->getfield($_) eq '' #? "( $_ IS NULL OR $_ = \"\" )" - ? ( driver_name =~ /^Pg$/i + ? ( driver_name eq 'Pg' ? "$_ IS NULL" : "( $_ IS NULL OR $_ = \"\" )" ) @@ -592,7 +646,7 @@ Depriciated (use delete instead). =cut sub del { - cluck "warning: FS::Record::del depriciated!"; + cluck "warning: FS::Record::del deprecated!"; &delete(@_); #call method in this scope } @@ -632,7 +686,7 @@ sub replace { map { $old->getfield($_) eq '' #? "( $_ IS NULL OR $_ = \"\" )" - ? ( driver_name =~ /^Pg$/i + ? ( driver_name eq 'Pg' ? "$_ IS NULL" : "( $_ IS NULL OR $_ = \"\" )" ) @@ -685,7 +739,7 @@ Depriciated (use replace instead). =cut sub rep { - cluck "warning: FS::Record::rep depriciated!"; + cluck "warning: FS::Record::rep deprecated!"; replace @_; #call method in this scope } @@ -718,8 +772,13 @@ sub _h_statement { =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). +B: External use is B. + +Replaces COLUMN in record with a unique number, using counters in the +filesystem. Used by the B method on single-field unique columns +(see L) and also as a fallback for primary keys +that aren't SERIAL (Pg) or AUTO_INCREMENT (mysql). + Returns the new value. =cut @@ -728,8 +787,6 @@ 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!" @@ -745,9 +802,8 @@ sub unique { # 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 + my $index = $counter->inc; + $index = $counter->inc while qsearchs($table, { $field=>$index } ); $index =~ /^(\d*)$/; $index=$1; @@ -1165,14 +1221,14 @@ sub _quote { =item hfields TABLE -This is depriciated. Don't use it. +This is deprecated. Don't use it. It returns a hash-type list with the fields of this record's table set true. =cut sub hfields { - carp "warning: hfields is depriciated"; + carp "warning: hfields is deprecated"; my($table)=@_; my(%hash); foreach (fields($table)) { @@ -1208,7 +1264,7 @@ sub DESTROY { return; } 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 +Exported qsearch and qsearchs should be deprecated in favor of method calls (against an FS::Record object like the old search and searchs that qsearch and qsearchs were on top of.) @@ -1216,7 +1272,7 @@ The whole fields / hfields mess should be removed. The various WHERE clauses should be subroutined. -table string should be depriciated in favor of DBIx::DBSchema::Table. +table string should be deprecated in favor of DBIx::DBSchema::Table. No doubt we could benefit from a Tied hash. Documenting how exists / defined true maps to the database (and WHERE clauses) would also help. -- cgit v1.2.1 From 0ff15e0670be23954e18d9abbf992993a0fe1b3e Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 20 Sep 2002 10:16:28 +0000 Subject: change otaker fields to 32 chars --- FS/FS/UID.pm | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm index 8934d49fc..6962b2768 100644 --- a/FS/FS/UID.pm +++ b/FS/FS/UID.pm @@ -171,9 +171,7 @@ Returns the current Freeside user. =cut sub getotaker { - #$user; - #stupid kludge until schema otaker fields are not 8 chars - substr($user,0,8); + $user; } =item cgisetotaker @@ -258,7 +256,7 @@ coderef into the hash %FS::UID::callback : =head1 VERSION -$Id: UID.pm,v 1.19 2002-08-29 06:02:52 ivan Exp $ +$Id: UID.pm,v 1.20 2002-09-20 10:16:28 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From eb0d04842631ae16247c6246cc6a1d8896169ff9 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 20 Sep 2002 12:50:30 +0000 Subject: move from bin/fs-setup to FS/bin/freeside-setup --- FS/bin/freeside-setup | 191 +++++++++++++++++++++++++++++--------------------- 1 file changed, 111 insertions(+), 80 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-setup b/FS/bin/freeside-setup index 78a03385c..cb74e64c8 100755 --- a/FS/bin/freeside-setup +++ b/FS/bin/freeside-setup @@ -138,33 +138,6 @@ foreach $attribute (@check_attributes) { )); } -##make part_svc table (but now as object) -# -#my($part_svc)=$dbdef->table('part_svc'); -# -##because of svc_acct_pop -##foreach (grep /^svc_/, $dbdef->tables) { -##foreach (qw(svc_acct svc_acct_sm svc_charge svc_domain svc_wo)) { -#foreach (qw(svc_acct svc_domain svc_forward svc_www)) { -# my($table)=$dbdef->table($_); -# my($col); -# foreach $col ( $table->columns ) { -# next if $col =~ /^svcnum$/; -# $part_svc->addcolumn( new DBIx::DBSchema::Column ( -# $table->name. '__' . $table->column($col)->name, -# 'varchar', #$table->column($col)->type, -# 'NULL', -# $char_d, #$table->column($col)->length, -# )); -# $part_svc->addcolumn ( new DBIx::DBSchema::Column ( -# $table->name. '__'. $table->column($col)->name . "_flag", -# 'char', -# 'NULL', -# 1, -# )); -# } -#} - #create history tables (false laziness w/create-history-tables) foreach my $table ( grep { ! /^h_/ } $dbdef->tables ) { my $tableobj = $dbdef->table($table) @@ -339,7 +312,7 @@ sub tables_hash_hack { 'agent' => { 'columns' => [ - 'agentnum', 'int', '', '', + 'agentnum', 'serial', '', '', 'agent', 'varchar', '', $char_d, 'typenum', 'int', '', '', 'freq', 'int', 'NULL', '', @@ -352,7 +325,7 @@ sub tables_hash_hack { 'agent_type' => { 'columns' => [ - 'typenum', 'int', '', '', + 'typenum', 'serial', '', '', 'atype', 'varchar', '', $char_d, ], 'primary_key' => 'typenum', @@ -372,7 +345,7 @@ sub tables_hash_hack { 'cust_bill' => { 'columns' => [ - 'invnum', 'int', '', '', + 'invnum', 'serial', '', '', 'custnum', 'int', '', '', '_date', @date_type, 'charged', @money_type, @@ -386,7 +359,7 @@ sub tables_hash_hack { 'cust_bill_event' => { 'columns' => [ - 'eventnum', 'int', '', '', + 'eventnum', 'serial', '', '', 'invnum', 'int', '', '', 'eventpart', 'int', '', '', '_date', @date_type, @@ -401,7 +374,7 @@ sub tables_hash_hack { 'part_bill_event' => { 'columns' => [ - 'eventpart', 'int', '', '', + 'eventpart', 'serial', '', '', 'payby', 'char', '', 4, 'event', 'varchar', '', $char_d, 'eventcode', @perl_type, @@ -432,11 +405,11 @@ sub tables_hash_hack { 'cust_credit' => { 'columns' => [ - 'crednum', 'int', '', '', + 'crednum', 'serial', '', '', 'custnum', 'int', '', '', '_date', @date_type, 'amount', @money_type, - 'otaker', 'varchar', '', 8, + 'otaker', 'varchar', '', 32, 'reason', 'text', 'NULL', '', 'closed', 'char', 'NULL', 1, ], @@ -447,7 +420,7 @@ sub tables_hash_hack { 'cust_credit_bill' => { 'columns' => [ - 'creditbillnum', 'int', '', '', + 'creditbillnum', 'serial', '', '', 'crednum', 'int', '', '', 'invnum', 'int', '', '', '_date', @date_type, @@ -460,7 +433,7 @@ sub tables_hash_hack { 'cust_main' => { 'columns' => [ - 'custnum', 'int', '', '', + 'custnum', 'serial', '', '', 'agentnum', 'int', '', '', # 'titlenum', 'int', 'NULL', '', 'last', 'varchar', '', $char_d, @@ -498,7 +471,7 @@ sub tables_hash_hack { 'paydate', 'varchar', 'NULL', 10, 'payname', 'varchar', 'NULL', $char_d, 'tax', 'char', 'NULL', 1, - 'otaker', 'varchar', '', 8, + 'otaker', 'varchar', '', 32, 'refnum', 'int', '', '', 'referral_custnum', 'int', 'NULL', '', 'comments', 'text', 'NULL', '', @@ -511,7 +484,7 @@ sub tables_hash_hack { 'cust_main_invoice' => { 'columns' => [ - 'destnum', 'int', '', '', + 'destnum', 'serial', '', '', 'custnum', 'int', '', '', 'dest', 'varchar', '', $char_d, ], @@ -524,7 +497,7 @@ sub tables_hash_hack { #cust_main_county for validation and to provide # a tax rate. 'columns' => [ - 'taxnum', 'int', '', '', + 'taxnum', 'serial', '', '', 'state', 'varchar', 'NULL', $char_d, 'county', 'varchar', 'NULL', $char_d, 'country', 'char', '', 2, @@ -540,7 +513,7 @@ sub tables_hash_hack { 'cust_pay' => { 'columns' => [ - 'paynum', 'int', '', '', + 'paynum', 'serial', '', '', #now cust_bill_pay #'invnum', 'int', '', '', 'custnum', 'int', '', '', 'paid', @money_type, @@ -558,7 +531,7 @@ sub tables_hash_hack { 'cust_bill_pay' => { 'columns' => [ - 'billpaynum', 'int', '', '', + 'billpaynum', 'serial', '', '', 'invnum', 'int', '', '', 'paynum', 'int', '', '', 'amount', @money_type, @@ -572,7 +545,7 @@ sub tables_hash_hack { 'cust_pay_batch' => { #what's this used for again? list of customers #in current CARD batch? (necessarily CARD?) 'columns' => [ - 'paybatchnum', 'int', '', '', + 'paybatchnum', 'serial', '', '', 'invnum', 'int', '', '', 'custnum', 'int', '', '', 'last', 'varchar', '', $char_d, @@ -597,10 +570,10 @@ sub tables_hash_hack { 'cust_pkg' => { 'columns' => [ - 'pkgnum', 'int', '', '', + 'pkgnum', 'serial', '', '', 'custnum', 'int', '', '', 'pkgpart', 'int', '', '', - 'otaker', 'varchar', '', 8, + 'otaker', 'varchar', '', 32, 'setup', @date_type, 'bill', @date_type, 'susp', @date_type, @@ -615,12 +588,12 @@ sub tables_hash_hack { 'cust_refund' => { 'columns' => [ - 'refundnum', 'int', '', '', + 'refundnum', 'serial', '', '', #now cust_credit_refund #'crednum', 'int', '', '', 'custnum', 'int', '', '', '_date', @date_type, 'refund', @money_type, - 'otaker', 'varchar', '', 8, + 'otaker', 'varchar', '', 32, 'reason', 'varchar', '', $char_d, 'payby', 'char', '', 4, # CARD/BILL/COMP, should be index # into payment type table. @@ -635,7 +608,7 @@ sub tables_hash_hack { 'cust_credit_refund' => { 'columns' => [ - 'creditrefundnum', 'int', '', '', + 'creditrefundnum', 'serial', '', '', 'crednum', 'int', '', '', 'refundnum', 'int', '', '', 'amount', @money_type, @@ -649,7 +622,7 @@ sub tables_hash_hack { 'cust_svc' => { 'columns' => [ - 'svcnum', 'int', '', '', + 'svcnum', 'serial', '', '', 'pkgnum', 'int', 'NULL', '', 'svcpart', 'int', '', '', ], @@ -660,7 +633,7 @@ sub tables_hash_hack { 'part_pkg' => { 'columns' => [ - 'pkgpart', 'int', '', '', + 'pkgpart', 'serial', '', '', 'pkg', 'varchar', '', $char_d, 'comment', 'varchar', '', $char_d, 'setup', @perl_type, @@ -701,7 +674,7 @@ sub tables_hash_hack { 'part_referral' => { 'columns' => [ - 'refnum', 'int', '', '', + 'refnum', 'serial', '', '', 'referral', 'varchar', '', $char_d, ], 'primary_key' => 'refnum', @@ -711,7 +684,7 @@ sub tables_hash_hack { 'part_svc' => { 'columns' => [ - 'svcpart', 'int', '', '', + 'svcpart', 'serial', '', '', 'svc', 'varchar', '', $char_d, 'svcdb', 'varchar', '', $char_d, 'disabled', 'char', 'NULL', 1, @@ -723,7 +696,7 @@ sub tables_hash_hack { 'part_svc_column' => { 'columns' => [ - 'columnnum', 'int', '', '', + 'columnnum', 'serial', '', '', 'svcpart', 'int', '', '', 'columnname', 'varchar', '', 64, 'columnvalue', 'varchar', 'NULL', $char_d, @@ -737,7 +710,7 @@ sub tables_hash_hack { #(this should be renamed to part_pop) 'svc_acct_pop' => { 'columns' => [ - 'popnum', 'int', '', '', + 'popnum', 'serial', '', '', 'city', 'varchar', '', $char_d, 'state', 'varchar', '', $char_d, 'ac', 'char', '', 3, @@ -751,7 +724,7 @@ sub tables_hash_hack { 'part_pop_local' => { 'columns' => [ - 'localnum', 'int', '', '', + 'localnum', 'serial', '', '', 'popnum', 'int', '', '', 'city', 'varchar', 'NULL', $char_d, 'state', 'char', 'NULL', 2, @@ -786,18 +759,6 @@ sub tables_hash_hack { 'index' => [ ['username'], ['domsvc'] ], }, -# 'svc_acct_sm' => { -# 'columns' => [ -# 'svcnum', 'int', '', '', -# 'domsvc', 'int', '', '', -# 'domuid', 'int', '', '', -# 'domuser', 'varchar', '', $char_d, -# ], -# 'primary_key' => 'svcnum', -# 'unique' => [ [] ], -# 'index' => [ ['domsvc'], ['domuid'] ], -# }, - #'svc_charge' => { # 'columns' => [ # 'svcnum', 'int', '', '', @@ -821,7 +782,7 @@ sub tables_hash_hack { 'domain_record' => { 'columns' => [ - 'recnum', 'int', '', '', + 'recnum', 'serial', '', '', 'svcnum', 'int', '', '', 'reczone', 'varchar', '', $char_d, 'recaf', 'char', '', 2, @@ -871,7 +832,7 @@ sub tables_hash_hack { 'prepay_credit' => { 'columns' => [ - 'prepaynum', 'int', '', '', + 'prepaynum', 'serial', '', '', 'identifier', 'varchar', '', $char_d, 'amount', @money_type, 'seconds', 'int', 'NULL', '', @@ -883,7 +844,7 @@ sub tables_hash_hack { 'port' => { 'columns' => [ - 'portnum', 'int', '', '', + 'portnum', 'serial', '', '', 'ip', 'varchar', 'NULL', 15, 'nasport', 'int', 'NULL', '', 'nasnum', 'int', '', '', @@ -895,7 +856,7 @@ sub tables_hash_hack { 'nas' => { 'columns' => [ - 'nasnum', 'int', '', '', + 'nasnum', 'serial', '', '', 'nas', 'varchar', '', $char_d, 'nasip', 'varchar', '', 15, 'nasfqdn', 'varchar', '', $char_d, @@ -908,7 +869,7 @@ sub tables_hash_hack { 'session' => { 'columns' => [ - 'sessionnum', 'int', '', '', + 'sessionnum', 'serial', '', '', 'portnum', 'int', '', '', 'svcnum', 'int', '', '', 'login', @date_type, @@ -921,7 +882,7 @@ sub tables_hash_hack { 'queue' => { 'columns' => [ - 'jobnum', 'int', '', '', + 'jobnum', 'serial', '', '', 'job', 'text', '', '', '_date', 'int', '', '', 'status', 'varchar', '', $char_d, @@ -935,7 +896,7 @@ sub tables_hash_hack { 'queue_arg' => { 'columns' => [ - 'argnum', 'int', '', '', + 'argnum', 'serial', '', '', 'jobnum', 'int', '', '', 'arg', 'text', 'NULL', '', ], @@ -946,7 +907,7 @@ sub tables_hash_hack { 'queue_depend' => { 'columns' => [ - 'dependnum', 'int', '', '', + 'dependnum', 'serial', '', '', 'jobnum', 'int', '', '', 'depend_jobnum', 'int', '', '', ], @@ -957,7 +918,7 @@ sub tables_hash_hack { 'export_svc' => { 'columns' => [ - 'exportsvcnum' => 'int', '', '', + 'exportsvcnum' => 'serial', '', '', 'exportnum' => 'int', '', '', 'svcpart' => 'int', '', '', ], @@ -968,7 +929,7 @@ sub tables_hash_hack { 'part_export' => { 'columns' => [ - 'exportnum', 'int', '', '', + 'exportnum', 'serial', '', '', #'svcpart', 'int', '', '', 'machine', 'varchar', '', $char_d, 'exporttype', 'varchar', '', $char_d, @@ -981,7 +942,7 @@ sub tables_hash_hack { 'part_export_option' => { 'columns' => [ - 'optionnum', 'int', '', '', + 'optionnum', 'serial', '', '', 'exportnum', 'int', '', '', 'optionname', 'varchar', '', $char_d, 'optionvalue', 'text', 'NULL', '', @@ -993,7 +954,7 @@ sub tables_hash_hack { 'radius_usergroup' => { 'columns' => [ - 'usergroupnum', 'int', '', '', + 'usergroupnum', 'serial', '', '', 'svcnum', 'int', '', '', 'groupname', 'varchar', '', $char_d, ], @@ -1004,7 +965,7 @@ sub tables_hash_hack { 'msgcat' => { 'columns' => [ - 'msgnum', 'int', '', '', + 'msgnum', 'serial', '', '', 'msgcode', 'varchar', '', $char_d, 'locale', 'varchar', '', 16, 'msg', 'text', '', '', @@ -1016,7 +977,7 @@ sub tables_hash_hack { 'cust_tax_exempt' => { 'columns' => [ - 'exemptnum', 'int', '', '', + 'exemptnum', 'serial', '', '', 'custnum', 'int', '', '', 'taxnum', 'int', '', '', 'year', 'int', '', '', @@ -1028,7 +989,77 @@ sub tables_hash_hack { 'index' => [], }, + 'ac_type' => { + 'columns' => [ + 'actypenum', 'serial', '', '', + 'actypename', 'varchar', '', $char_d, + ], + 'primary_key' => 'actypenum', + 'unique' => [], + 'index' => [], + }, + + 'ac' => { + 'columns' => [ + 'acnum', 'serial', '', '', + 'actypenum', 'int', '', '', + 'acname', 'varchar', '', $char_d, + ], + 'primary_key' => 'acnum', + 'unique' => [], + 'index' => [ [ 'actypenum' ] ], + }, + + 'part_ac_field' => { + 'columns' => [ + 'acfieldpart', 'serial', '', '', + 'actypenum', 'int', '', '', + 'name', 'varchar', '', $char_d, + 'ut_type', 'varchar', '', $char_d, + ], + 'primary_key' => 'acfieldpart', + 'unique' => [], + 'index' => [ [ 'actypenum' ] ], + }, + + 'ac_field' => { + 'columns' => [ + 'acfieldpart', 'int', '', '', + 'acnum', 'int', '', '', + 'value', 'text', '', '', + ], + 'primary_key' => '', + 'unique' => [ [ 'acfieldpart', 'acnum' ] ], + 'index' => [ [ 'acnum' ] ], + }, + + 'ac_block' => { + 'columns' => [ + 'acnum', 'int', '', '', + 'ip_gateway', 'varchar', '', 15, + 'ip_netmask', 'int', '', '', + ], + 'primary_key' => '', + 'unique' => [], + 'index' => [ [ 'acnum' ] ], + }, + 'svc_broadband' => { + 'columns' => [ + 'svcnum', 'int', '', '', + 'actypenum', 'int', '', '', + 'speed_up', 'int', '', '', + 'speed_down', 'int', '', '', + 'acnum', 'int', '', '', + 'ip_addr', 'varchar', '', 15, + 'ip_netmask', 'int', '', '', + 'mac_addr', 'char', '', 17, + 'location', 'varchar', '', $char_d, + ], + 'primary_key' => 'svcnum', + 'unique' => [], + 'index' => [ [ 'actypenum' ] ], + }, ); -- cgit v1.2.1 From 9c3fb2a84c655cbbaafed99586f1431e08c218d5 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 20 Sep 2002 14:48:35 +0000 Subject: extraneous warn --- FS/FS/part_export.pm | 2 -- 1 file changed, 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 647666b86..1b402e014 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -274,8 +274,6 @@ sub check { ; return $error if $error; - warn $self->machine. "!!!\n"; - $self->machine =~ /^([\w\-\.]*)$/ or return "Illegal machine: ". $self->machine; $self->machine($1); -- cgit v1.2.1 From b59cf43f0814ea4d484d4b09833dd3c2d493455f Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 20 Sep 2002 15:46:29 +0000 Subject: fix database sequence code, closes: Bug#69 --- FS/FS/Record.pm | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 8778dee79..a23f37a62 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -480,10 +480,17 @@ sub insert { my $db_seq = 0; if ( $primary_key ) { my $col = $self->dbdef_table->column($primary_key); - my $db_seq = + + $db_seq = uc($col->type) eq 'SERIAL' - || ( driver_name eq 'Pg' && $col->default =~ /^nextval\(/i ) - || ( driver_name eq 'mysql' && $col->local =~ /AUTO_INCREMENT/i ); + || ( driver_name eq 'Pg' + && defined($col->default) + && $col->default =~ /^nextval\(/i + ) + || ( driver_name eq 'mysql' + && defined($col->local) + && $col->local =~ /AUTO_INCREMENT/i + ); $self->unique($primary_key) unless $self->getfield($primary_key) || $db_seq; } @@ -515,11 +522,12 @@ sub insert { $sth->execute or return $sth->errstr; if ( $db_seq ) { # get inserted id from the database, if applicable + warn "[debug]$me retreiving sequence from database\n" if $DEBUG; my $insertid = ''; if ( driver_name eq 'Pg' ) { my $oid = $sth->{'pg_oid_status'}; - my $i_sql = "SELECT id FROM $table WHERE oid = ?"; + my $i_sql = "SELECT $primary_key FROM $table WHERE oid = ?"; my $i_sth = dbh->prepare($i_sql) or do { dbh->rollback if $FS::UID::AutoCommit; return dbh->errstr; -- cgit v1.2.1 From 70a4b5227943108ce91c68e1c4e7509a9a6c33f9 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 20 Sep 2002 15:47:58 +0000 Subject: add freeside-deluser, freeside-deloutsource and freeside-deloutsourceuser --- FS/MANIFEST | 3 ++ FS/bin/freeside-addoutsourceuser | 2 +- FS/bin/freeside-deloutsource | 11 +++++++ FS/bin/freeside-deloutsourceuser | 6 ++++ FS/bin/freeside-deluser | 64 ++++++++++++++++++++++++++++++++++++++++ FS/bin/freeside-setup | 2 +- 6 files changed, 86 insertions(+), 2 deletions(-) create mode 100644 FS/bin/freeside-deloutsource create mode 100644 FS/bin/freeside-deloutsourceuser create mode 100644 FS/bin/freeside-deluser (limited to 'FS') diff --git a/FS/MANIFEST b/FS/MANIFEST index 3cf4c2ba3..24fef1748 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -9,8 +9,11 @@ bin/freeside-email bin/freeside-queued bin/freeside-addoutsource bin/freeside-addoutsourceuser +bin/freeside-deloutsource +bin/freeside-deloutsourceuser bin/freeside-apply-credits bin/freeside-adduser +bin/freeside-deluser bin/freeside-setup bin/freeside-setinvoice bin/freeside-overdue diff --git a/FS/bin/freeside-addoutsourceuser b/FS/bin/freeside-addoutsourceuser index bbad8aa3f..180cd9399 100644 --- a/FS/bin/freeside-addoutsourceuser +++ b/FS/bin/freeside-addoutsourceuser @@ -11,5 +11,5 @@ freeside-adduser -h /usr/local/etc/freeside/htpasswd \ [ -e /usr/local/etc/freeside/dbdef.DBI:Pg:host=localhost\;dbname=$domain ] \ || ( freeside-setup $username 2>/dev/null; \ - /home/ivan/freeside/bin/populate-msgcat $username; 2>/dev/null ) + /home/ivan/freeside/bin/populate-msgcat $username ) diff --git a/FS/bin/freeside-deloutsource b/FS/bin/freeside-deloutsource new file mode 100644 index 000000000..561853539 --- /dev/null +++ b/FS/bin/freeside-deloutsource @@ -0,0 +1,11 @@ +#!/bin/sh + +domain=$1 + +dropdb $domain && \ +rm -rf /usr/local/etc/freeside/conf.DBI:Pg:host=localhost\;dbname=$domain && \ +rm -rf /usr/local/etc/freeside/counters.DBI:Pg:host=localhost\;dbname=$domain && \ +rm -rf /usr/local/etc/freeside/cache.DBI:Pg:host=localhost\;dbname=$domain && \ +rm -rf /usr/local/etc/freeside/export.DBI:Pg:host=localhost\;dbname=$domain && \ +rm /usr/local/etc/freeside/dbdef.DBI:Pg:host=localhost\;dbname=$domain + diff --git a/FS/bin/freeside-deloutsourceuser b/FS/bin/freeside-deloutsourceuser new file mode 100644 index 000000000..96871e50c --- /dev/null +++ b/FS/bin/freeside-deloutsourceuser @@ -0,0 +1,6 @@ +#!/bin/sh + +username=$1 + +freeside-deluser -h /usr/local/etc/freeside/htpasswd $username 2>/dev/null + diff --git a/FS/bin/freeside-deluser b/FS/bin/freeside-deluser new file mode 100644 index 000000000..57d6ce165 --- /dev/null +++ b/FS/bin/freeside-deluser @@ -0,0 +1,64 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw($opt_h); +use Fcntl qw(:flock); +use Getopt::Std; + +my $FREESIDE_CONF = "/usr/local/etc/freeside"; + +getopts("h:"); +my $user = shift or die &usage; + +if ( $opt_h ) { + open(HTPASSWD,"<$opt_h") + and flock(HTPASSWD,LOCK_EX) + or die "can't open $opt_h: $!"; + open(HTPASSWD_TMP,">$opt_h.tmp") or die "can't open $opt_h.tmp: $!"; + while () { + print HTPASSWD_TMP $_ unless /^$user:/; + } + close HTPASSWD_TMP; + rename "$opt_h.tmp", "$opt_h" or die $!; + flock(HTPASSWD,LOCK_UN); + close HTPASSWD; +} + +open(MAPSECRETS,"<$FREESIDE_CONF/mapsecrets") + and flock(MAPSECRETS,LOCK_EX) + or die "can't open $FREESIDE_CONF/mapsecrets: $!"; +open(MAPSECRETS_TMP,">>$FREESIDE_CONF/mapsecrets.tmp") + or die "can't open $FREESIDE_CONF/mapsecrets.tmp: $!"; +while () { + print MAPSECRETS_TMP $_ unless /^$user\s/; +} +close MAPSECRETS_TMP; +rename "$FREESIDE_CONF/mapsecrets.tmp", "$FREESIDE_CONF/mapsecrets" or die $!; +flock(MAPSECRETS,LOCK_UN); +close MAPSECRETS; + +sub usage { + die "Usage:\n\n freeside-deluser [ -h htpasswd_file ] username" +} + +=head1 NAME + +freeside-deluser - Command line interface to add (freeside) users. + +=head1 SYNOPSIS + + freeside-deluser [ -h htpasswd_file ] username + +=head1 DESCRIPTION + +Adds a user to the Freeside billing system. This is for adding users (internal +sales/tech folks) to the web interface, not for adding customer accounts. + + -h: Also delete from the given htpasswd filename + +=head1 SEE ALSO + +L, L(1), base Freeside documentation + +=cut + diff --git a/FS/bin/freeside-setup b/FS/bin/freeside-setup index cb74e64c8..e8bb7ec62 100755 --- a/FS/bin/freeside-setup +++ b/FS/bin/freeside-setup @@ -7,7 +7,7 @@ use strict; use vars qw($opt_s); use Getopt::Std; use DBI; -use DBIx::DBSchema 0.20; +use DBIx::DBSchema 0.21; use DBIx::DBSchema::Table; use DBIx::DBSchema::Column; use DBIx::DBSchema::ColGroup::Unique; -- cgit v1.2.1 From 2488e8c0b94101a8015369e10e37de660f662f5f Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 20 Sep 2002 15:48:52 +0000 Subject: doc --- FS/FS.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS.pm b/FS/FS.pm index c22557a2d..a2df6f175 100644 --- a/FS/FS.pm +++ b/FS/FS.pm @@ -185,7 +185,7 @@ first time, the suggested order will tend to reduce the number of forward references." If you've never used OO modules before, -http://www.cpan.org/doc/FMTEYEWTK/easy_objects.html might help you out. +http://www.perl.com/doc/FMTEYEWTK/easy_objects.html might help you out. =head1 DESCRIPTION -- cgit v1.2.1 From e2a6a581a52e61521cc86140cb4ef57a3af84f48 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 20 Sep 2002 15:49:10 +0000 Subject: installing into /usr/bin, bah --- FS/Makefile.PL | 2 ++ 1 file changed, 2 insertions(+) (limited to 'FS') diff --git a/FS/Makefile.PL b/FS/Makefile.PL index ab4c2281b..1647f8eef 100644 --- a/FS/Makefile.PL +++ b/FS/Makefile.PL @@ -5,4 +5,6 @@ WriteMakefile( 'NAME' => 'FS', 'VERSION_FROM' => 'FS.pm', # finds $VERSION 'EXE_FILES' => [ glob 'bin/*' ], + 'INSTALLSCRIPT' => '/usr/local/bin', + 'INSTALLSITEBIN' => '/usr/local/bin', ); -- cgit v1.2.1 From 8965012fa53fd05d851d2f5abed4e056ab758797 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 21 Sep 2002 11:17:39 +0000 Subject: all taxes now have names. closes: Bug#15 --- FS/FS/cust_bill.pm | 20 ++++++++++++++------ FS/FS/cust_bill_pkg.pm | 5 ++++- FS/FS/cust_main.pm | 24 +++++++++++++++--------- FS/FS/cust_main_county.pm | 3 +++ FS/bin/freeside-setup | 22 ++++++++++++++++++++-- 5 files changed, 56 insertions(+), 18 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 258b32e15..f0667258c 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -510,10 +510,13 @@ sub send_csv { time2str("%x", $cust_bill_pkg->edate), ); - } else { #pkgnum Tax + } else { #pkgnum tax next unless $cust_bill_pkg->setup != 0; + my $itemdesc = defined $cust_bill_pkg->dbdef_table->column('itemdesc') + ? ( $cust_bill_pkg->itemdesc || 'Tax' ) + : 'Tax'; ($pkg, $setup, $recur, $sdate, $edate) = - ( 'Tax', sprintf("%10.2f",$cust_bill_pkg->setup), '', '', '' ); + ( $itemdesc, sprintf("%10.2f",$cust_bill_pkg->setup), '', '', '' ); } $csv->combine( @@ -858,7 +861,9 @@ sub print_text { } #new charges - foreach ( $self->cust_bill_pkg ) { + foreach ( ( grep { $_->pkgnum } $self->cust_bill_pkg ), #packages first + ( grep { ! $_->pkgnum } $self->cust_bill_pkg ), #then taxes + ) { if ( $_->pkgnum ) { @@ -882,8 +887,11 @@ sub print_text { map { [ " ". $_->[0]. ": ". $_->[1], '' ] } $cust_pkg->labels; } - } else { #pkgnum Tax - push @buf,["Tax", $money_char. sprintf("%10.2f",$_->setup) ] + } else { #pkgnum tax + my $itemdesc = defined $_->dbdef_table->column('itemdesc') + ? ( $_->itemdesc || 'Tax' ) + : 'Tax'; + push @buf,[$itemdesc, $money_char. sprintf("%10.2f",$_->setup) ] if $_->setup != 0; } } @@ -1031,7 +1039,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.45 2002-09-17 10:21:47 ivan Exp $ +$Id: cust_bill.pm,v 1.46 2002-09-21 11:17:39 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_bill_pkg.pm b/FS/FS/cust_bill_pkg.pm index 72f9ce4a9..5a1dcd2aa 100644 --- a/FS/FS/cust_bill_pkg.pm +++ b/FS/FS/cust_bill_pkg.pm @@ -47,6 +47,8 @@ supported: =item edate - ending date of recurring fee +=item itemdesc - Line item description (currentlty used only when pkgnum is 0) + =back sdate and edate are specified as UNIX timestamps; see L. Also @@ -111,6 +113,7 @@ sub check { || $self->ut_money('recur') || $self->ut_numbern('sdate') || $self->ut_numbern('edate') + || $self->ut_textn('itemdesc') ; return $error if $error; @@ -140,7 +143,7 @@ sub cust_pkg { =head1 VERSION -$Id: cust_bill_pkg.pm,v 1.3 2002-04-06 22:32:43 ivan Exp $ +$Id: cust_bill_pkg.pm,v 1.4 2002-09-21 11:17:39 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 84fd3d150..2701ac35d 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -904,10 +904,12 @@ sub bill { my( $total_setup, $total_recur ) = ( 0, 0 ); #my( $taxable_setup, $taxable_recur ) = ( 0, 0 ); my @cust_bill_pkg = (); - my $tax = 0;## + #my $tax = 0;## #my $taxable_charged = 0;## #my $charged = 0;## + my %tax; + foreach my $cust_pkg ( qsearch('cust_pkg', { 'custnum' => $self->custnum } ) ) { @@ -1101,7 +1103,10 @@ sub bill { } #if $cust_main_county->exempt_amount $taxable_charged = sprintf( "%.2f", $taxable_charged); - $tax += $taxable_charged * $cust_main_county->tax / 100 + + #$tax += $taxable_charged * $cust_main_county->tax / 100 + $tax{ $cust_main_county->taxname || 'Tax' } += + $taxable_charged * $cust_main_county->tax / 100 } #unless $self->tax =~ /Y/i # || $self->payby eq 'COMP' @@ -1134,16 +1139,17 @@ sub bill { # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 ) # ); - $tax = sprintf("%.2f", $tax); - if ( $tax > 0 ) { + foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) { + my $tax = sprintf("%.2f", $tax{$taxname} ); $charged = sprintf( "%.2f", $charged+$tax ); my $cust_bill_pkg = new FS::cust_bill_pkg ({ - 'pkgnum' => 0, - 'setup' => $tax, - 'recur' => 0, - 'sdate' => '', - 'edate' => '', + 'pkgnum' => 0, + 'setup' => $tax, + 'recur' => 0, + 'sdate' => '', + 'edate' => '', + 'itemdesc' => $taxname, }); push @cust_bill_pkg, $cust_bill_pkg; } diff --git a/FS/FS/cust_main_county.pm b/FS/FS/cust_main_county.pm index e41564d21..d8796e451 100644 --- a/FS/FS/cust_main_county.pm +++ b/FS/FS/cust_main_county.pm @@ -61,6 +61,8 @@ currently supported: =item exempt_amount +=item taxname - if defined, printed on invoices instead of "Tax" + =back =head1 METHODS @@ -110,6 +112,7 @@ sub check { || $self->ut_float('tax') || $self->ut_textn('taxclass') # ... || $self->ut_money('exempt_amount') + || $self->ut_textn('taxname') ; } diff --git a/FS/bin/freeside-setup b/FS/bin/freeside-setup index e8bb7ec62..f6a543fc8 100755 --- a/FS/bin/freeside-setup +++ b/FS/bin/freeside-setup @@ -189,7 +189,23 @@ foreach my $table ( grep { ! /^h_/ } $dbdef->tables ) { 'default' => '', 'local' => '', } ), - map { $tableobj->column($_) } $tableobj->columns + map { + my $column = $tableobj->column($_); + + #clone so as to not disturb the original + $column = DBIx::DBSchema::Column->new( { + map { $_ => $column->$_() } + qw( name type null length default local ) + } ); + + $column->type('int') + if $column->type eq 'serial'; + #$column->default('') + # if $column->default =~ /^nextval\(/i; + #( my $local = $column->local ) =~ s/AUTO_INCREMENT//i; + #$column->local($local); + $column; + } $tableobj->columns ], } ); $dbdef->addtable($h_tableobj); @@ -397,9 +413,10 @@ sub tables_hash_hack { 'recur', @money_type, 'sdate', @date_type, 'edate', @date_type, + 'itemdesc', 'varchar', 'NULL', $char_d, ], 'primary_key' => '', - 'unique' => [ ['pkgnum', 'invnum'] ], + 'unique' => [], 'index' => [ ['invnum'] ], }, @@ -504,6 +521,7 @@ sub tables_hash_hack { 'taxclass', 'varchar', 'NULL', $char_d, 'exempt_amount', @money_type, 'tax', 'real', '', '', #tax % + 'taxname', 'varchar', 'NULL', $char_d, ], 'primary_key' => 'taxnum', 'unique' => [], -- cgit v1.2.1 From 536d684c3e17375d45a5d62bc5d748fec0224860 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 23 Sep 2002 14:27:28 +0000 Subject: global.asa changes for profiling redirects header-handling changes necessary for chart .cgis --- FS/FS/CGI.pm | 34 +++++++++++++++++++++++++++++++++- 1 file changed, 33 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/CGI.pm b/FS/FS/CGI.pm index e44ebcc0a..d69aad2fc 100644 --- a/FS/FS/CGI.pm +++ b/FS/FS/CGI.pm @@ -10,7 +10,7 @@ use FS::UID; @ISA = qw(Exporter); @EXPORT_OK = qw(header menubar idiot eidiot popurl table itable ntable - small_custview myexit); + small_custview myexit http_header); =head1 NAME @@ -68,6 +68,38 @@ END $x; } +=item http_header + +Sets an http header. + +=cut + +sub http_header { + my ( $header, $value ) = @_; + if (exists $ENV{MOD_PERL}) { + if ( defined $main::Response + && $main::Response->isa('Apache::ASP::Response') ) { #Apache::ASP + if ( $header =~ /^Content-Type$/ ) { + $main::Response->{ContentType} = $value; + } else { + $main::Response->AddHeader( $header => $value ); + } + } elsif ( defined $HTML::Mason::Commands::r ) { #Mason + ## is this the correct pacakge for $r ??? for 1.0x and 1.1x ? + if ( $header =~ /^Content-Type$/ ) { + $HTML::Mason::Commands::r->content_type($value); + } else { + $HTML::Mason::Commands::r->header_out( $header => $value ); + } + } else { + die "http_header called in unknown environment"; + } + } else { + die "http_header called not running under mod_perl"; + } + +} + =item menubar ITEM, URL, ... Returns an HTML menubar. -- cgit v1.2.1 From c7c842f3767e8f11914d3b76c31de591854c9654 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 24 Sep 2002 08:31:25 +0000 Subject: deprecate vpopmailrestart config value --- FS/FS/Conf.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index e9defdafd..788127a7f 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -803,8 +803,8 @@ httemplate/docs/config.html { 'key' => 'vpopmailrestart', - 'section' => 'mail', - 'description' => 'If defined, the shell commands to run on vpopmail machines after files are copied. An example can be found in eg/vpopmailrestart of the source distribution.', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, add a vpopmail export instead. This option used to define the shell commands to run on vpopmail machines after files are copied. An example can be found in eg/vpopmailrestart of the source distribution.', 'type' => 'textarea', }, -- cgit v1.2.1 From 7445e66a13a90015eb100d22aab90d0bc1c92ccd Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 25 Sep 2002 09:09:26 +0000 Subject: regenerate raddb.pm from freeradius-0.4 dicts add "Authentication-Type" for netc.net.au (radiator?) --- FS/FS/raddb.pm | 2081 ++++++++++++++++++++++++++++---------------------------- 1 file changed, 1048 insertions(+), 1033 deletions(-) (limited to 'FS') diff --git a/FS/FS/raddb.pm b/FS/FS/raddb.pm index 497d98450..a35a757f5 100644 --- a/FS/FS/raddb.pm +++ b/FS/FS/raddb.pm @@ -2,1090 +2,1105 @@ package FS::raddb; use vars qw(%attrib); %attrib = ( - 'ascend_bi_directional_au' => 'Ascend-Bi-Directional-Auth', - 'h323_connect_time' => 'h323-connect-time', - 'connect_rate' => 'Connect-Rate', - 'bind_auth_service_grp' => 'Bind_Auth_Service_Grp', - 'usr_callback_type' => 'USR-Callback-Type', - 'erx_primary_wins' => 'ERX-Primary-Wins', - 'ascend_x25_x121_address' => 'Ascend-X25-X121-Address', - 'usr_log_filter_packets' => 'USR-Log-Filter-Packets', - 'annex_addr_resolution_pr' => 'Annex-Addr-Resolution-Protocol', - 'usr_ip_rip_simple_auth_p' => 'USR-IP-RIP-Simple-Auth-Password', - 'dialback_name' => 'Dialback-Name', - 'x_ascend_fr_dce_n392' => 'X-Ascend-FR-DCE-N392', - 'usr_host_type' => 'USR-Host-Type', - 'le_modem_info' => 'LE-Modem-Info', - 'x_ascend_menu_selector' => 'X-Ascend-Menu-Selector', - 'x_ascend_fr_dce_n393' => 'X-Ascend-FR-DCE-N393', - 'ascend_ip_direct' => 'Ascend-IP-Direct', - 'x_ascend_pre_output_octe' => 'X-Ascend-Pre-Output-Octets', - 'x_ascend_ft1_caller' => 'X-Ascend-FT1-Caller', - 'usr_last_callers_number_' => 'USR-Last-Callers-Number-ANI', - 'usr_rmmie_product_code' => 'USR-RMMIE-Product-Code', - 'usr_igmp_robustness' => 'USR-IGMP-Robustness', - 'ms_chap2_success' => 'MS-CHAP2-Success', - 'ascend_home_agent_passwo' => 'Ascend-Home-Agent-Password', - 'acc_bridging_support' => 'Acc-Bridging-Support', - 'annex_transmit_speed' => 'Annex-Transmit-Speed', - 'old_password' => 'Old-Password', - 'x_ascend_metric' => 'X-Ascend-Metric', - 'acc_clearing_location' => 'Acc-Clearing-Location', - 'ascend_multilink_id' => 'Ascend-Multilink-ID', - 'ascend_egress_enabled' => 'Ascend-Egress-Enabled', - 'usr_bridging' => 'USR-Bridging', - 'ascend_assign_ip_server' => 'Ascend-Assign-IP-Server', - 'acc_dns_server_sec' => 'Acc-Dns-Server-Sec', - 'ascend_home_agent_ip_add' => 'Ascend-Home-Agent-IP-Addr', - 'usr_dnis_reauthenticatio' => 'USR-DNIS-ReAuthentication', - 'acc_modem_error_protocol' => 'Acc-Modem-Error-Protocol', - 'ascend_backup' => 'Ascend-Backup', - 'usr_connect_time' => 'USR-Connect-Time', - 'ascend_cbcp_mode' => 'Ascend-CBCP-Mode', - 'usr_rmmie_x2_status' => 'USR-RMMIE-x2-Status', - 'ascend_multicast_gleave_' => 'Ascend-Multicast-GLeave-Delay', - 'erx_ingress_statistics' => 'ERX-Ingress-Statistics', - 'cisco_nas_port' => 'Cisco-NAS-Port', - 'le_admin_group' => 'LE-Admin-Group', - 'annex_mrru' => 'Annex-MRRU', - 'x_ascend_add_seconds' => 'X-Ascend-Add-Seconds', - 'ascend_token_expiry' => 'Ascend-Token-Expiry', - 'usr_igmp_maximum_respons' => 'USR-IGMP-Maximum-Response-Time', - 'ascend_calling_id_presen' => 'Ascend-Calling-Id-Presentatn', - 'connect_info' => 'Connect-Info', - 'ascend_access_intercept_' => 'Ascend-Access-Intercept-LEA', - 'x_ascend_dba_monitor' => 'X-Ascend-DBA-Monitor', - 'client_dns_pri' => 'Client_DNS_Pri', - 'ip_host_addr' => 'Ip_Host_Addr', - 'callback_id' => 'Callback-Id', - 'acct_mcast_out_octets' => 'Acct_Mcast_Out_Octets', - 'acct_input_octets_64' => 'Acct_Input_Octets_64', - 'tunnel_function' => 'Tunnel_Function', - 'ascend_fr_direct_profile' => 'Ascend-FR-Direct-Profile', - 'h323_incoming_conf_id' => 'h323-incoming-conf-id', - 'ascend_ppp_vj_1172' => 'Ascend-PPP-VJ-1172', - 'ms_new_arap_password' => 'MS-New-ARAP-Password', - 'h323_voice_quality' => 'h323-voice-quality', - 'framed_appletalk_network' => 'Framed-AppleTalk-Network', - 'bind_int_interface_name' => 'Bind_Int_Interface_Name', - 'event_timestamp' => 'Event-Timestamp', - 'ascend_bir_enable' => 'Ascend-BIR-Enable', - 'usr_fallback_enabled' => 'USR-Fallback-Enabled', - 'ascend_dhcp_pool_number' => 'Ascend-DHCP-Pool-Number', - 'acct_session_id' => 'Acct-Session-Id', - 'ascend_private_route_req' => 'Ascend-Private-Route-Required', - 'usr_rmmie_pwrlvl_farecho' => 'USR-RMMIE-PwrLvl-FarEcho-Canc', - 'usr_at_input_filter' => 'USR-AT-Input-Filter', - 'erx_egress_statistics' => 'ERX-Egress-Statistics', - 'x_ascend_call_type' => 'X-Ascend-Call-Type', - 'acct_tunnel_client_endpo' => 'Acct-Tunnel-Client-Endpoint', - 'x_ascend_assign_ip_clien' => 'X-Ascend-Assign-IP-Client', - 'ascend_if_netmask' => 'Ascend-IF-Netmask', - 'ascend_dhcp_maximum_leas' => 'Ascend-DHCP-Maximum-Leases', - 'usr_at_output_filter' => 'USR-AT-Output-Filter', - 'usr_rad_dvmrp_metric' => 'USR-Rad-Dvmrp-Metric', - 'rate_limit_rate' => 'Rate_Limit_Rate', - 'prefix' => 'Prefix', - 'ascend_x25_pad_banner' => 'Ascend-X25-Pad-Banner', - 'usr_rmmie_rcv_pwrlvl_375' => 'USR-RMMIE-Rcv-PwrLvl-3750Hz', - 'x_ascend_user_acct_key' => 'X-Ascend-User-Acct-Key', - 'group_name' => 'Group-Name', - 'ascend_receive_secret' => 'Ascend-Receive-Secret', - 'reply_message' => 'Reply-Message', - 'le_nat_sess_dir_fail_act' => 'LE-NAT-Sess-Dir-Fail-Action', - 'framed_callback_id' => 'Framed-Callback-Id', - 'cisco_disconnect_cause' => 'Cisco-Disconnect-Cause', - 'stripped_user_name' => 'Stripped-User-Name', - 'annex_keypress_timeout' => 'Annex-Keypress-Timeout', - 'annex_receive_speed' => 'Annex-Receive-Speed', - 'ms_chap_domain' => 'MS-CHAP-Domain', - 'ascend_atm_connect_group' => 'Ascend-ATM-Connect-Group', - 'usr_send_name' => 'USR-Send-Name', - 'usr_local_framed_ip_addr' => 'USR-Local-Framed-IP-Addr', - 'erx_alternate_cli_vroute' => 'ERX-Alternate-Cli-Vrouter-Name', - 'usr_fallback_limit' => 'USR-Fallback-Limit', - 'ascend_pri_number_type' => 'Ascend-PRI-Number-Type', - 'x_ascend_minimum_channel' => 'X-Ascend-Minimum-Channels', - 'x_ascend_fr_direct_dlci' => 'X-Ascend-FR-Direct-DLCI', - 'ascend_fr_link_mgt' => 'Ascend-FR-Link-Mgt', - 'annex_host_allow' => 'Annex-Host-Allow', - 'x_ascend_force_56' => 'X-Ascend-Force-56', - 'police_burst' => 'Police_Burst', - 'pvc_profile_name' => 'PVC_Profile_Name', - 'ms_filter' => 'MS-Filter', - 'rate_limit_burst' => 'Rate_Limit_Burst', - 'ascend_number_sessions' => 'Ascend-Number-Sessions', - 'cisco_call_filter' => 'Cisco-Call-Filter', - 'erx_igmp_enable' => 'ERX-Igmp-Enable', - 'ascend_filter_required' => 'Ascend-Filter-Required', - 'erx_cli_allow_all_vr_acc' => 'ERX-Cli-Allow-All-VR-Access', - 'acc_callback_delay' => 'Acc-Callback-Delay', - 'usr_default_dte_data_rat' => 'USR-Default-DTE-Data-Rate', - 'le_ip_pool' => 'LE-IP-Pool', - 'cisco_pre_output_packets' => 'Cisco-Pre-Output-Packets', - 'x_ascend_group' => 'X-Ascend-Group', - 'usr_channel_connected_to' => 'USR-Channel-Connected-To', - 'usr_ipx_rip_output_filte' => 'USR-IPX-RIP-Output-Filter', - 'usr_esn' => 'USR-ESN', - 'annex_user_level' => 'Annex-User-Level', - 'x_ascend_primary_home_ag' => 'X-Ascend-Primary-Home-Agent', - 'no_such_attribute' => 'No-Such-Attribute', - 'x_ascend_pri_number_type' => 'X-Ascend-PRI-Number-Type', - 'ms_mppe_send_key' => 'MS-MPPE-Send-Key', - 'usr_actual_voltage' => 'USR-Actual-Voltage', - 'annex_acct_servers' => 'Annex-Acct-Servers', - 'ascend_handle_ipx' => 'Ascend-Handle-IPX', - 'cisco_xmit_rate' => 'Cisco-Xmit-Rate', - 'acc_service_profile' => 'Acc-Service-Profile', - 'x_ascend_ara_pw' => 'X-Ascend-Ara-PW', - 'ascend_ckt_type' => 'Ascend-Ckt-Type', - 'cisco_data_rate' => 'Cisco-Data-Rate', - 'group' => 'Group', - 'nas_port' => 'NAS-Port', - 'usr_ipx_call_output_filt' => 'USR-IPX-Call-Output-Filter', - 'tunnel_type' => 'Tunnel-Type', - 'usr_rmmie_manufacturer_i' => 'USR-RMMIE-Manufacturer-ID', - 'user_name_is_star' => 'User-Name-Is-Star', - 'usr_call_arrival_in_gmt' => 'USR-Call-Arrival-in-GMT', - 'x_ascend_number_sessions' => 'X-Ascend-Number-Sessions', - 'ascend_send_auth' => 'Ascend-Send-Auth', - 'user_service_type' => 'User-Service-Type', - 'annex_cli_filter' => 'Annex-CLI-Filter', - 'erx_cli_initial_access_l' => 'ERX-Cli-Initial-Access-Level', - 'ascend_call_direction' => 'Ascend-Call-Direction', - 'usr_chassis_temp_thresho' => 'USR-Chassis-Temp-Threshold', - 'usr_pw_usr_ofilter_ipx' => 'USR-PW_USR_OFilter_IPX', - 'tunnel_session_auth' => 'Tunnel_Session_Auth', - 'x_ascend_connect_progres' => 'X-Ascend-Connect-Progress', - 'ascend_atm_connect_vci' => 'Ascend-ATM-Connect-Vci', - 'x_ascend_maximum_call_du' => 'X-Ascend-Maximum-Call-Duration', - 'usr_rmmie_planned_discon' => 'USR-RMMIE-Planned-Disconnect', - 'x_ascend_fr_dte_n392' => 'X-Ascend-FR-DTE-N392', - 'login_host' => 'Login-Host', - 'ascend_user_acct_host' => 'Ascend-User-Acct-Host', - 'x_ascend_fr_dte_n393' => 'X-Ascend-FR-DTE-N393', - 'acc_tunnel_secret' => 'Acc-Tunnel-Secret', - 'usr_at_rtmp_input_filter' => 'USR-AT-RTMP-Input-Filter', - 'framed_protocol' => 'Framed-Protocol', - 'login_callback_number' => 'Login-Callback-Number', - 'ascend_dsl_rate_type' => 'Ascend-Dsl-Rate-Type', - 'ascend_pre_output_packet' => 'Ascend-Pre-Output-Packets', - 'proxy_state' => 'Proxy-State', - 'usr_pw_usr_ofilter_ip' => 'USR-PW_USR_OFilter_IP', - 'cisco_data_filter' => 'Cisco-Data-Filter', - 'cisco_target_util' => 'Cisco-Target-Util', - 'usr_ids0_call_type' => 'USR-IDS0-Call-Type', - 'usr_blocks_resent' => 'USR-Blocks-Resent', - 'usr_terminal_type' => 'USR-Terminal-Type', - 'ascend_history_weigh_typ' => 'Ascend-History-Weigh-Type', - 'framed_routing' => 'Framed-Routing', - 'ascend_client_assign_dns' => 'Ascend-Client-Assign-DNS', - 'ascend_atm_group' => 'Ascend-ATM-Group', - 'bind_bypass_bypass' => 'Bind_Bypass_Bypass', - 'le_ip_gateway' => 'LE-IP-Gateway', - 'cisco_ip_pool_definition' => 'Cisco-IP-Pool-Definition', - 'x_ascend_maximum_time' => 'X-Ascend-Maximum-Time', - 'usr_request_type' => 'USR-Request-Type', - 'usr_call_arrival_time' => 'USR-Call-Arrival-Time', - 'tunnel_domain' => 'Tunnel_Domain', - 'ms_chap_nt_enc_pw' => 'MS-CHAP-NT-Enc-PW', - 'shiva_calling_number' => 'Shiva-Calling-Number', - 'ip_address_pool_name' => 'Ip_Address_Pool_Name', - 'erx_secondary_dns' => 'ERX-Secondary-Dns', - 'x_ascend_pre_input_octet' => 'X-Ascend-Pre-Input-Octets', - 'ascend_home_agent_udp_po' => 'Ascend-Home-Agent-UDP-Port', - 'le_nat_outsource_inmap' => 'LE-NAT-Outsource-Inmap', - 'x_ascend_home_agent_pass' => 'X-Ascend-Home-Agent-Password', - 'tunnel_password' => 'Tunnel-Password', - 'usr_compression_type' => 'USR-Compression-Type', - 'usr_connect_speed' => 'USR-Connect-Speed', - 'usr_connect_time_limit' => 'USR-Connect-Time-Limit', - 'arap_challenge_response' => 'ARAP-Challenge-Response', - 'ms_link_utilization_thre' => 'MS-Link-Utilization-Threshold', - 'usr_mp_edo' => 'USR-MP-EDO', - 'usr_primary_nbns_server' => 'USR-Primary_NBNS_Server', - 'usr_imsi' => 'USR-IMSI', - 'ascend_fr_direct' => 'Ascend-FR-Direct', - 'ascend_vrouter_name' => 'Ascend-VRouter-Name', - 'ascend_preempt_limit' => 'Ascend-Preempt-Limit', - 'ascend_ip_pool_definitio' => 'Ascend-IP-Pool-Definition', - 'h323_gw_id' => 'h323-gw-id', - 'usr_framed_ipx_route' => 'USR-Framed-IPX-Route', - 'x_ascend_maximum_channel' => 'X-Ascend-Maximum-Channels', - 'login_lat_node' => 'Login-LAT-Node', - 'acct_session_time' => 'Acct-Session-Time', - 'ascend_disconnect_cause' => 'Ascend-Disconnect-Cause', - 'ms_mppe_encryption_polic' => 'MS-MPPE-Encryption-Policy', - 'ms_ras_version' => 'MS-RAS-Version', - 'class' => 'Class', - 'caller_id' => 'Caller-ID', - 'ascend_access_intercept_' => 'Ascend-Access-Intercept-Log', - 'ascend_service_type' => 'Ascend-Service-Type', - 'ascend_h323_dialed_time' => 'Ascend-H323-Dialed-Time', - 'exec_program_wait' => 'Exec-Program-Wait', - 'ascend_x25_nui_password_' => 'Ascend-X25-Nui-Password-Prompt', - 'ascend_appletalk_peer_mo' => 'Ascend-Appletalk-Peer-Mode', - 'login_lat_group' => 'Login-LAT-Group', - 'strip_user_name' => 'Strip-User-Name', - 'nas_ip_address' => 'NAS-IP-Address', - 'ascend_maximum_time' => 'Ascend-Maximum-Time', - 'erx_atm_pcr' => 'ERX-Atm-PCR', - 'ascend_client_primary_dn' => 'Ascend-Client-Primary-DNS', - 'auth_type' => 'Auth-Type', - 'ascend_secondary_home_ag' => 'Ascend-Secondary-Home-Agent', - 'x_ascend_idle_limit' => 'X-Ascend-Idle-Limit', - 'ms_ras_vendor' => 'MS-RAS-Vendor', - 'ascend_pre_input_packets' => 'Ascend-Pre-Input-Packets', - 'ascend_bridge' => 'Ascend-Bridge', - 'h323_redirect_number' => 'h323-redirect-number', - 'usr_simplified_mnp_level' => 'USR-Simplified-MNP-Levels', - 'annex_edo' => 'Annex-EDO', - 'acc_nbns_server_sec' => 'Acc-Nbns-Server-Sec', - 'ascend_cbcp_trunk_group' => 'Ascend-CBCP-Trunk-Group', - 'x_ascend_data_svc' => 'X-Ascend-Data-Svc', - 'le_terminate_detail' => 'LE-Terminate-Detail', - 'acct_output_octets' => 'Acct-Output-Octets', - 'usr_calling_party_number' => 'USR-Calling-Party-Number', - 'x_ascend_dhcp_maximum_le' => 'X-Ascend-DHCP-Maximum-Leases', - 'ascend_force_56' => 'Ascend-Force-56', - 'shiva_acct_serv_switch' => 'Shiva-Acct-Serv-Switch', - 'tunnel_algorithm' => 'Tunnel_Algorithm', - 'usr_max_channels' => 'USR-Max-Channels', - 'usr_port_tap_priority' => 'USR-Port-Tap-Priority', - 'le_nat_outmap' => 'LE-NAT-Outmap', - 'usr_call_connecting_time' => 'USR-Call-Connecting-Time', - 'usr_supports_tags' => 'USR-Supports-Tags', - 'idle_timeout' => 'Idle-Timeout', - 'usr_ip_rip_input_filter' => 'USR-IP-RIP-Input-Filter', - 'erx_ingress_policy_name' => 'ERX-Ingress-Policy-Name', - 'usr_pw_cutoff' => 'USR-PW_Cutoff', - 'usr_channel_expansion' => 'USR-Channel-Expansion', - 'x_ascend_send_secret' => 'X-Ascend-Send-Secret', - 'h323_call_origin' => 'h323-call-origin', - 'h323_preferred_lang' => 'h323-preferred-lang', - 'ascend_base_channel_coun' => 'Ascend-Base-Channel-Count', - 'bind_auth_context' => 'Bind_Auth_Context', - 'ascend_calling_id_number' => 'Ascend-Calling-Id-Number-Plan', - 'ascend_modem_shelfno' => 'Ascend-Modem-ShelfNo', - 'tunnel_police_burst' => 'Tunnel_Police_Burst', - 'pvc_circuit_padding' => 'PVC_Circuit_Padding', - 'acc_ml_call_threshold' => 'Acc-ML-Call-Threshold', - 'usr_end_time' => 'USR-End-Time', - 'usr_ipx' => 'USR-IPX', - 'ms_primary_dns_server' => 'MS-Primary-DNS-Server', - 'ascend_dsl_upstream_limi' => 'Ascend-Dsl-Upstream-Limit', - 'usr_blocks_sent' => 'USR-Blocks-Sent', - 'bind_dot1q_vlan_tag_id' => 'Bind_Dot1q_Vlan_Tag_Id', - 'ascend_private_route' => 'Ascend-Private-Route', - 'usr_back_channel_data_ra' => 'USR-Back-Channel-Data-Rate', - 'ascend_dropped_packets' => 'Ascend-Dropped-Packets', - 'cisco_route_ip' => 'Cisco-Route-IP', - 'nas_identifier' => 'NAS-Identifier', - 'ascend_presession_time' => 'Ascend-PreSession-Time', - 'usr_call_type' => 'USR-Call-Type', - 'usr_acct_reason_code' => 'USR-Acct-Reason-Code', - 'acc_dialout_auth_passwor' => 'Acc-Dialout-Auth-Password', - 'acc_connect_tx_speed' => 'Acc-Connect-Tx-Speed', - 'cisco_pre_input_octets' => 'Cisco-Pre-Input-Octets', - 'x_ascend_send_passwd' => 'X-Ascend-Send-Passwd', - 'ascend_bir_bridge_group' => 'Ascend-BIR-Bridge-Group', - 'ascend_fr_profile_name' => 'Ascend-FR-Profile-Name', - 'ascend_group' => 'Ascend-Group', - 'crypt_password' => 'Crypt-Password', - 'usr_port_tap_address' => 'USR-Port-Tap-Address', - 'le_nat_outsource_outmap' => 'LE-NAT-Outsource-Outmap', - 'usr_vpn_encrypter' => 'USR-VPN-Encrypter', + 'usr_at_zip_output_filter' => 'USR-AT-Zip-Output-Filter', + 'ms_filter' => 'MS-Filter', 'usr_blocks_received' => 'USR-Blocks-Received', - 'tunnel_group' => 'Tunnel_Group', - 'ascend_shared_profile_en' => 'Ascend-Shared-Profile-Enable', - 'replicate_to_realm' => 'Replicate-To-Realm', - 'usr_mobile_ip_address' => 'USR-Mobile-IP-Address', - 'x_ascend_authen_alias' => 'X-Ascend-Authen-Alias', - 'ascend_fr_linkup' => 'Ascend-FR-LinkUp', - 'tunnel_rate_limit_rate' => 'Tunnel_Rate_Limit_Rate', - 'acc_access_community' => 'Acc-Access-Community', - 'x_ascend_presession_time' => 'X-Ascend-PreSession-Time', - 'ms_chap_cpw_1' => 'MS-CHAP-CPW-1', - 'ms_chap_cpw_2' => 'MS-CHAP-CPW-2', - 'erx_primary_dns' => 'ERX-Primary-Dns', - 'ascend_fr_circuit_name' => 'Ascend-FR-Circuit-Name', - 'ascend_token_immediate' => 'Ascend-Token-Immediate', - 'cisco_idle_limit' => 'Cisco-Idle-Limit', - 'usr_speed_of_connection' => 'USR-Speed-Of-Connection', - 'shiva_links_in_bundle' => 'Shiva-Links-In-Bundle', - 'x_ascend_fr_profile_name' => 'X-Ascend-FR-Profile-Name', - 'cisco_multilink_id' => 'Cisco-Multilink-ID', - 'x_ascend_preempt_limit' => 'X-Ascend-Preempt-Limit', - 'ascend_assign_ip_client' => 'Ascend-Assign-IP-Client', - 'usr_iwf_ip_address' => 'USR-IWF-IP-Address', - 'acct_unique_session_id' => 'Acct-Unique-Session-Id', - 'framed_pool' => 'Framed-Pool', - 'usr_igmp_version' => 'USR-IGMP-Version', - 'tunnel_max_tunnels' => 'Tunnel_Max_Tunnels', - 'annex_unauthenticated_ti' => 'Annex-Unauthenticated-Time', - 'bg_path_cost' => 'BG_Path_Cost', - 'ascend_client_assign_win' => 'Ascend-Client-Assign-WINS', - 'x_ascend_dial_number' => 'X-Ascend-Dial-Number', - 'cisco_maximum_channels' => 'Cisco-Maximum-Channels', - 'usr_pw_framed_routing_v2' => 'USR-PW_Framed_Routing_V2', - 'usr_channel_decrement' => 'USR-Channel-Decrement', - 'x_ascend_route_ipx' => 'X-Ascend-Route-IPX', - 'port_limit' => 'Port-Limit', - 'ascend_dsl_downstream_li' => 'Ascend-Dsl-Downstream-Limit', - 'ascend_ip_tos_precedence' => 'Ascend-IP-TOS-Precedence', - 'usr_multicast_receive' => 'USR-Multicast-Receive', - 'usr_auth_mode' => 'USR-Auth-Mode', - 'expiration' => 'Expiration', - 'x_ascend_fr_circuit_name' => 'X-Ascend-FR-Circuit-Name', - 'x_ascend_token_immediate' => 'X-Ascend-Token-Immediate', - 'ascend_ft1_caller' => 'Ascend-FT1-Caller', - 'shiva_event_flags' => 'Shiva-Event-Flags', - 'framed_netmask' => 'Framed-Netmask', - 'ascend_minimum_channels' => 'Ascend-Minimum-Channels', - 'acc_ml_damping_factor' => 'Acc-ML-Damping-Factor', - 'bind_sub_password' => 'Bind_Sub_Password', - 'ascend_ip_tos_apply_to' => 'Ascend-IP-TOS-Apply-To', - 'x_ascend_home_agent_udp_' => 'X-Ascend-Home-Agent-UDP-Port', - 'x_ascend_menu_item' => 'X-Ascend-Menu-Item', - 'ascend_session_type' => 'Ascend-Session-Type', - 'usr_pw_packet' => 'USR-PW_Packet', - 'session' => 'Session', - 'usr_mic' => 'USR-MIC', - 'usr_line_reversals' => 'USR-Line-Reversals', - 'assigned_ip_address' => 'Assigned_IP_Address', - 'cisco_ip_direct' => 'Cisco-IP-Direct', - 'le_ipsec_log_options' => 'LE-IPSec-Log-Options', - 'tunnel_rate_limit_burst' => 'Tunnel_Rate_Limit_Burst', - 'x_ascend_assign_ip_globa' => 'X-Ascend-Assign-IP-Global-Pool', - 'x_ascend_inc_channel_cou' => 'X-Ascend-Inc-Channel-Count', - 'h323_return_code' => 'h323-return-code', - 'shiva_disconnect_reason' => 'Shiva-Disconnect-Reason', - 'filter_id' => 'Filter-Id', - 'usr_appletalk_network_ra' => 'USR-Appletalk-Network-Range', - 'ascend_temporary_rtes' => 'Ascend-Temporary-Rtes', - 'ascend_h323_conference_i' => 'Ascend-H323-Conference-Id', - 'h323_billing_model' => 'h323-billing-model', - 'usr_bearer_capabilities' => 'USR-Bearer-Capabilities', - 'framed_appletalk_zone' => 'Framed-AppleTalk-Zone', - 'usr_harc_disconnect_code' => 'USR-HARC-Disconnect-Code', - 'usr_ipx_rip_input_filter' => 'USR-IPX-RIP-Input-Filter', - 'usr_rad_multicast_routin' => 'USR-Rad-Multicast-Routing-Bound', - 'ascend_pw_lifetime' => 'Ascend-PW-Lifetime', - 'acc_dialout_auth_usernam' => 'Acc-Dialout-Auth-Username', - 'ascend_x25_pad_x3_parame' => 'Ascend-X25-Pad-X3-Parameters', - 'bind_dot1q_slot' => 'Bind_Dot1q_Slot', - 'usr_rad_multicast_routin' => 'USR-Rad-Multicast-Routing-RtLim', - 'x_ascend_multicast_clien' => 'X-Ascend-Multicast-Client', - 'ascend_authen_alias' => 'Ascend-Authen-Alias', - 'ascend_dec_channel_count' => 'Ascend-Dec-Channel-Count', - 'dhcp_max_leases' => 'DHCP_Max_Leases', 'shiva_called_number' => 'Shiva-Called-Number', - 'annex_tunnel_authen_mode' => 'Annex-Tunnel-Authen-Mode', - 'usr_call_error_code' => 'USR-Call-Error-Code', - 'x_ascend_user_acct_type' => 'X-Ascend-User-Acct-Type', - 'ascend_atm_connect_vpi' => 'Ascend-ATM-Connect-Vpi', - 'ascend_x25_pad_x3_profil' => 'Ascend-X25-Pad-X3-Profile', - 'usr_mobileip_home_agent_' => 'USR-MobileIP-Home-Agent-Address', - 'suffix' => 'Suffix', - 'bind_tun_context' => 'Bind_Tun_Context', - 'x_ascend_ppp_address' => 'X-Ascend-PPP-Address', - 'usr_dtr_false_timeout' => 'USR-DTR-False-Timeout', - 'usr_final_rx_link_data_r' => 'USR-Final-Rx-Link-Data-Rate', - 'ms_chap_error' => 'MS-CHAP-Error', - 'x_ascend_home_agent_ip_a' => 'X-Ascend-Home-Agent-IP-Addr', - 'ascend_data_svc' => 'Ascend-Data-Svc', - 'usr_rmmie_pwrlvl_noise_l' => 'USR-RMMIE-PwrLvl-Noise-Lvl', - 'usr_dtr_true_timeout' => 'USR-DTR-True-Timeout', - 'context_name' => 'Context-Name', - 'usr_card_type' => 'USR-Card-Type', - 'ascend_fr_link_status_dl' => 'Ascend-FR-Link-Status-DLCI', - 'annex_sec_profile_index' => 'Annex-Sec-Profile-Index', - 'usr_pw_usr_ofilter_sap' => 'USR-PW_USR_OFilter_SAP', - 'tunnel_medium_type' => 'Tunnel-Medium-Type', - 'x_ascend_require_auth' => 'X-Ascend-Require-Auth', - 'ascend_connect_progress' => 'Ascend-Connect-Progress', - 'x_ascend_modem_shelfno' => 'X-Ascend-Modem-ShelfNo', - 'cisco_pre_input_packets' => 'Cisco-Pre-Input-Packets', - 'ascend_fr_dce_n392' => 'Ascend-FR-DCE-N392', - 'ascend_fr_dce_n393' => 'Ascend-FR-DCE-N393', - 'ascend_client_primary_wi' => 'Ascend-Client-Primary-WINS', - 'shiva_link_protocol' => 'Shiva-Link-Protocol', - 'bridge_group' => 'Bridge_Group', - 'client_port_dnis' => 'Client-Port-DNIS', - 'usr_mpip_tunnel_originat' => 'USR-MPIP-Tunnel-Originator', - 'le_nat_log_options' => 'LE-NAT-Log-Options', - 'usr_number_of_rings_limi' => 'USR-Number-of-Rings-Limit', - 'usr_retrains_granted' => 'USR-Retrains-Granted', - 'acc_ip_gateway_pri' => 'Acc-Ip-Gateway-Pri', - 'usr_number_of_fallbacks' => 'USR-Number-of-Fallbacks', - 'usr_tunnel_auth_hostname' => 'USR-Tunnel-Auth-Hostname', 'annex_filter' => 'Annex-Filter', - 'ascend_mtu' => 'Ascend-MTU', - 'ms_arap_pw_change_reason' => 'MS-ARAP-PW-Change-Reason', - 'private_group_id' => 'Private-Group-Id', - 'ascend_cache_time' => 'Ascend-Cache-Time', - 'acc_ml_clear_threshold' => 'Acc-ML-Clear-Threshold', - 'x_ascend_dhcp_reply' => 'X-Ascend-DHCP-Reply', - 'ascend_h323_gatekeeper' => 'Ascend-H323-Gatekeeper', - 'x_ascend_xmit_rate' => 'X-Ascend-Xmit-Rate', - 'usr_last_number_dialed_o' => 'USR-Last-Number-Dialed-Out', - 'acc_connect_rx_speed' => 'Acc-Connect-Rx-Speed', - 'acc_clearing_cause' => 'Acc-Clearing-Cause', - 'ascend_call_attempt_limi' => 'Ascend-Call-Attempt-Limit', - 'x_ascend_data_rate' => 'X-Ascend-Data-Rate', - 'termination_action' => 'Termination-Action', - 'ascend_pre_input_octets' => 'Ascend-Pre-Input-Octets', - 'x_ascend_ipx_route' => 'X-Ascend-IPX-Route', - 'x_ascend_ts_idle_mode' => 'X-Ascend-TS-Idle-Mode', - 'client_ip_address' => 'Client-IP-Address', - 'ascend_add_seconds' => 'Ascend-Add-Seconds', - 'login_ip_host' => 'Login-IP-Host', - 'annex_sw_version' => 'Annex-SW-Version', - 'huntgroup_name' => 'Huntgroup-Name', - 'usr_pw_vpn_gateway' => 'USR-PW_VPN_Gateway', - 'ascend_x25_reverse_charg' => 'Ascend-X25-Reverse-Charging', - 'lac_real_port' => 'LAC_Real_Port', - 'ascend_dba_monitor' => 'Ascend-DBA-Monitor', + 'usr_channel_expansion' => 'USR-Channel-Expansion', + 'session_timeout' => 'Session-Timeout', + 'usr_simplified_mnp_level' => 'USR-Simplified-MNP-Levels', + 'ascend_route_ipx' => 'Ascend-Route-IPX', 'annex_user_server_locati' => 'Annex-User-Server-Location', - 'ascend_h323_fegw_address' => 'Ascend-H323-Fegw-Address', - 'acct_output_gigawords' => 'Acct-Output-Gigawords', - 'bind_l2tp_tunnel_name' => 'Bind_L2TP_Tunnel_Name', - 'x_ascend_token_idle' => 'X-Ascend-Token-Idle', - 'acc_apsm_oversubscribed' => 'Acc-Apsm-Oversubscribed', - 'ip_tos_field' => 'IP_TOS_Field', - 'ascend_dsl_cir_xmit_limi' => 'Ascend-Dsl-CIR-Xmit-Limit', - 'usr_number_of_link_naks' => 'USR-Number-of-Link-NAKs', - 'framed_address' => 'Framed-Address', - 'x_ascend_num_in_multilin' => 'X-Ascend-Num-In-Multilink', - 'hint' => 'Hint', - 'ascend_source_ip_check' => 'Ascend-Source-IP-Check', - 'arap_zone_access' => 'ARAP-Zone-Access', - 'x_ascend_fr_direct_profi' => 'X-Ascend-FR-Direct-Profile', + 'acc_callback_mode' => 'Acc-Callback-Mode', + 'usr_filter_zones' => 'USR-Filter-Zones', + 'ascend_session_svr_key' => 'Ascend-Session-Svr-Key', + 'le_nat_tcp_session_timeo' => 'LE-NAT-TCP-Session-Timeout', + 'ascend_ts_idle_limit' => 'Ascend-TS-Idle-Limit', + 'usr_port_tap_priority' => 'USR-Port-Tap-Priority', + 'ascend_private_route' => 'Ascend-Private-Route', + 'prompt' => 'Prompt', + 'acct_link_count' => 'Acct-Link-Count', + 'login_lat_node' => 'Login-LAT-Node', + 'usr_mbi_ct_pri_card_slot' => 'USR-Mbi_Ct_PRI_Card_Slot', + 'erx_ingress_statistics' => 'ERX-Ingress-Statistics', + 'annex_system_disc_reason' => 'Annex-System-Disc-Reason', + 'usr_call_arrival_time' => 'USR-Call-Arrival-Time', + 'ascend_disconnect_cause' => 'Ascend-Disconnect-Cause', + 'ascend_user_acct_time' => 'Ascend-User-Acct-Time', + 'ascend_appletalk_peer_mo' => 'Ascend-Appletalk-Peer-Mode', + 'chap_challenge' => 'CHAP-Challenge', + 'ascend_mpp_idle_percent' => 'Ascend-MPP-Idle-Percent', + 'ascend_user_acct_port' => 'Ascend-User-Acct-Port', + 'ascend_numbering_plan_id' => 'Ascend-Numbering-Plan-ID', + 'ascend_access_intercept_' => 'Ascend-Access-Intercept-LEA', + 'pvc_encapsulation_type' => 'PVC_Encapsulation_Type', + 'ascend_bir_bridge_group' => 'Ascend-BIR-Bridge-Group', + 'ascend_atm_group' => 'Ascend-ATM-Group', + 'ascend_fr_svc_addr' => 'Ascend-FR-SVC-Addr', + 'x_ascend_send_auth' => 'X-Ascend-Send-Auth', + 'le_ip_pool' => 'LE-IP-Pool', + 'annex_addr_resolution_se' => 'Annex-Addr-Resolution-Servers', + 'usr_last_callers_number_' => 'USR-Last-Callers-Number-ANI', + 'login_port' => 'Login-Port', + 'ms_chap2_response' => 'MS-CHAP2-Response', + 'annex_secondary_dns_serv' => 'Annex-Secondary-DNS-Server', + 'ascend_ipsec_profile' => 'Ascend-IPSEC-Profile', + 'usr_accm_type' => 'USR-ACCM-Type', + 'simultaneous_use' => 'Simultaneous-Use', + 'framed_protocol' => 'Framed-Protocol', + 'ascend_recv_name' => 'Ascend-Recv-Name', + 'usr_call_connecting_time' => 'USR-Call-Connecting-Time', + 'tunnel_remote_name' => 'Tunnel_Remote_Name', + 'usr_vts_session_key' => 'USR-VTS-Session-Key', + 'ascend_fr_dce_n393' => 'Ascend-FR-DCE-N393', + 'login_host' => 'Login-Host', + 'usr_reply_script3' => 'USR-Reply-Script3', + 'ascend_pppoe_enable' => 'Ascend-PPPoE-Enable', + 'annex_primary_dns_server' => 'Annex-Primary-DNS-Server', 'x_ascend_bridge_address' => 'X-Ascend-Bridge-Address', - 'usr_iwf_call_identifier' => 'USR-IWF-Call-Identifier', + 'usr_number_of_link_naks' => 'USR-Number-of-Link-NAKs', + 'annex_cli_command' => 'Annex-CLI-Command', + 'usr_pw_framed_routing_v2' => 'USR-PW_Framed_Routing_V2', + 'usr_tunnel_switch_endpoi' => 'USR-Tunnel-Switch-Endpoint', + 'ascend_call_by_call' => 'Ascend-Call-By-Call', + 'ascend_first_dest' => 'Ascend-First-Dest', + 'usr_appletalk_network_ra' => 'USR-Appletalk-Network-Range', + 'annex_tunnel_authen_type' => 'Annex-Tunnel-Authen-Type', + 'sql_user_name' => 'SQL-User-Name', + 'erx_secondary_dns' => 'ERX-Secondary-Dns', + 'h323_return_code' => 'h323-return-code', + 'annex_host_allow' => 'Annex-Host-Allow', + 'x_ascend_require_auth' => 'X-Ascend-Require-Auth', + 'le_ipsec_deny_action' => 'LE-IPSec-Deny-Action', + 'annex_edo' => 'Annex-EDO', + 'acct_delay_time' => 'Acct-Delay-Time', + 'ascend_call_block_durati' => 'Ascend-Call-Block-Duration', + 'login_tcp_port' => 'Login-TCP-Port', + 'ascend_temporary_rtes' => 'Ascend-Temporary-Rtes', + 'ascend_dialed_number' => 'Ascend-Dialed-Number', + 'x_ascend_dec_channel_cou' => 'X-Ascend-Dec-Channel-Count', + 'ascend_fr_dlci' => 'Ascend-FR-DLCI', + 'annex_modem_disc_reason' => 'Annex-Modem-Disc-Reason', + 'x_ascend_receive_secret' => 'X-Ascend-Receive-Secret', + 'char_noecho' => 'Char-Noecho', + 'ascend_pri_number_type' => 'Ascend-PRI-Number-Type', + 'ascend_dsl_upstream_limi' => 'Ascend-Dsl-Upstream-Limit', + 'x_ascend_modem_shelfno' => 'X-Ascend-Modem-ShelfNo', + 'prefix' => 'Prefix', + 'usr_rad_dvmrp_metric' => 'USR-Rad-Dvmrp-Metric', + 'usr_ip_saa_filter' => 'USR-IP-SAA-Filter', + 'ms_link_utilization_thre' => 'MS-Link-Utilization-Threshold', 'ascend_home_network_name' => 'Ascend-Home-Network-Name', + 'acc_customer_id' => 'Acc-Customer-Id', + 'message_authenticator' => 'Message-Authenticator', + 'ascend_secondary_home_ag' => 'Ascend-Secondary-Home-Agent', + 'x_ascend_pre_output_octe' => 'X-Ascend-Pre-Output-Octets', + 'usr_multicast_forwarding' => 'USR-Multicast-Forwarding', + 'ascend_call_direction' => 'Ascend-Call-Direction', + 'acc_connect_rx_speed' => 'Acc-Connect-Rx-Speed', + 'ascend_force_56' => 'Ascend-Force-56', + 'usr_harc_disconnect_code' => 'USR-HARC-Disconnect-Code', + 'shasta_service_profile' => 'Shasta-Service-Profile', + 'cisco_maximum_time' => 'Cisco-Maximum-Time', + 'usr_tunnel_auth_hostname' => 'USR-Tunnel-Auth-Hostname', + 'ascend_client_assign_win' => 'Ascend-Client-Assign-WINS', + 'acc_modem_modulation_typ' => 'Acc-Modem-Modulation-Type', + 'acc_ip_gateway_pri' => 'Acc-Ip-Gateway-Pri', + 'ascend_bridge_address' => 'Ascend-Bridge-Address', + 'x_ascend_fr_link_mgt' => 'X-Ascend-FR-Link-Mgt', + 'ascend_handle_ipx' => 'Ascend-Handle-IPX', + 'ascend_x25_pad_alias_2' => 'Ascend-X25-Pad-Alias-2', + 'ascend_group' => 'Ascend-Group', + 'ascend_dsl_rate_type' => 'Ascend-Dsl-Rate-Type', 'ascend_require_auth' => 'Ascend-Require-Auth', - 'source_validation' => 'Source_Validation', - 'ms_primary_nbns_server' => 'MS-Primary-NBNS-Server', - 'h323_setup_time' => 'h323-setup-time', - 'tunnel_remote_name' => 'Tunnel_Remote_Name', - 'ascend_maximum_channels' => 'Ascend-Maximum-Channels', + 'x_ascend_billing_number' => 'X-Ascend-Billing-Number', + 'usr_orig_nas_type' => 'USR-Orig-NAS-Type', + 'ascend_remote_fw' => 'Ascend-Remote-FW', + 'acct_output_packets' => 'Acct-Output-Packets', + 'lm_password' => 'LM-Password', + 'tunnel_window' => 'Tunnel_Window', + 'x_ascend_link_compressio' => 'X-Ascend-Link-Compression', + 'x_ascend_base_channel_co' => 'X-Ascend-Base-Channel-Count', + 'cisco_avpair' => 'Cisco-AVPair', + 'shiva_event_flags' => 'Shiva-Event-Flags', + 'usr_number_of_rings_limi' => 'USR-Number-of-Rings-Limit', + 'ascend_ts_idle_mode' => 'Ascend-TS-Idle-Mode', + 'ascend_bi_directional_au' => 'Ascend-Bi-Directional-Auth', + 'state' => 'State', + 'usr_keypress_timeout' => 'USR-Keypress-Timeout', + 'usr_pw_vpn_neighbor' => 'USR-PW_VPN_Neighbor', + 'ldap_userdn' => 'Ldap-UserDn', + 'x_ascend_fr_n391' => 'X-Ascend-FR-N391', 'ascend_tunneling_protoco' => 'Ascend-Tunneling-Protocol', - 'arap_security_data' => 'ARAP-Security-Data', - 'ascend_ipx_peer_mode' => 'Ascend-IPX-Peer-Mode', - 'ascend_cir_timer' => 'Ascend-CIR-Timer', - 'ascend_ts_idle_limit' => 'Ascend-TS-Idle-Limit', - 'ascend_cache_refresh' => 'Ascend-Cache-Refresh', - 'usr_rmmie_status' => 'USR-RMMIE-Status', - 'annex_callback_portlist' => 'Annex-Callback-Portlist', - 'usr_port_tap' => 'USR-Port-Tap', - 'ascend_client_secondary_' => 'Ascend-Client-Secondary-DNS', + 'x_ascend_fr_direct' => 'X-Ascend-FR-Direct', + 'nas_ip_address' => 'NAS-IP-Address', + 'usr_call_end_time' => 'USR-Call-End-Time', + 'tunnel_algorithm' => 'Tunnel_Algorithm', + 'usr_vpn_encrypter' => 'USR-VPN-Encrypter', + 'ascend_atm_connect_group' => 'Ascend-ATM-Connect-Group', + 'x_ascend_ft1_caller' => 'X-Ascend-FT1-Caller', + 'login_callback_number' => 'Login-Callback-Number', + 'usr_ip_rip_input_filter' => 'USR-IP-RIP-Input-Filter', + 'usr_rmmie_last_update_ev' => 'USR-RMMIE-Last-Update-Event', + 'h323_disconnect_cause' => 'h323-disconnect-cause', + 'x_ascend_handle_ipx' => 'X-Ascend-Handle-IPX', + 'usr_igmp_version' => 'USR-IGMP-Version', + 'usr_imsi' => 'USR-IMSI', + 'group_name' => 'Group-Name', + 'usr_nas_type' => 'USR-NAS-Type', + 'ascend_ip_tos' => 'Ascend-IP-TOS', + 'x_ascend_token_immediate' => 'X-Ascend-Token-Immediate', + 'ascend_private_route_tab' => 'Ascend-Private-Route-Table-ID', + 'ms_chap2_cpw' => 'MS-CHAP2-CPW', + 'tunnel_session_auth_ctx' => 'Tunnel_Session_Auth_Ctx', + 'usr_mobile_numbytes_rxed' => 'USR-Mobile-NumBytes-Rxed', + 'usr_mbi_ct_tdm_time_slot' => 'USR-Mbi_Ct_TDM_Time_Slot', + 'ascend_x25_nui' => 'Ascend-X25-Nui', 'x_ascend_first_dest' => 'X-Ascend-First-Dest', - 'lac_port' => 'LAC_Port', - 'acc_callback_cbcp_type' => 'Acc-Callback-CBCP-Type', - 'usr_call_reference_numbe' => 'USR-Call-Reference-Number', - 'mcast_receive' => 'Mcast_Receive', - 'x_ascend_link_compressio' => 'X-Ascend-Link-Compression', - 'ascend_inter_arrival_jit' => 'Ascend-Inter-Arrival-Jitter', - 'x_ascend_assign_ip_pool' => 'X-Ascend-Assign-IP-Pool', - 'usr_chassis_call_span' => 'USR-Chassis-Call-Span', - 'arap_password' => 'ARAP-Password', - 'usr_ip_default_route_opt' => 'USR-IP-Default-Route-Option', - 'ascend_endpoint_disc' => 'Ascend-Endpoint-Disc', - 'tunnel_dnis' => 'Tunnel_DNIS', + 'x_ascend_num_in_multilin' => 'X-Ascend-Num-In-Multilink', + 'usr_send_password' => 'USR-Send-Password', + 'x_ascend_fr_t391' => 'X-Ascend-FR-T391', + 'acct_input_octets' => 'Acct-Input-Octets', + 'bridge_group' => 'Bridge_Group', + 'annex_sec_profile_index' => 'Annex-Sec-Profile-Index', + 'acc_dns_server_pri' => 'Acc-Dns-Server-Pri', 'ms_acct_auth_type' => 'MS-Acct-Auth-Type', - 'ascend_ts_idle_mode' => 'Ascend-TS-Idle-Mode', - 'shasta_service_profile' => 'Shasta-Service-Profile', - 'usr_cdma_call_reference_' => 'USR-CDMA-Call-Reference-Number', - 'usr_at_zip_input_filter' => 'USR-AT-Zip-Input-Filter', - 'x_ascend_pw_warntime' => 'X-Ascend-PW-Warntime', - 'ascend_fr_direct_dlci' => 'Ascend-FR-Direct-DLCI', - 'usr_dte_ring_no_answer_l' => 'USR-DTE-Ring-No-Answer-Limit', - 'ascend_multicast_rate_li' => 'Ascend-Multicast-Rate-Limit', - 'usr_routing_protocol' => 'USR-Routing-Protocol', - 'pam_auth' => 'Pam-Auth', - 'client_dns_sec' => 'Client_DNS_Sec', - 'bg_trans_bpdu' => 'BG_Trans_BPDU', - 'police_rate' => 'Police_Rate', + 'tunnel_password' => 'Tunnel-Password', + 'usr_reply_script5' => 'USR-Reply-Script5', + 'shiva_links_in_bundle' => 'Shiva-Links-In-Bundle', + 'ascend_fr_profile_name' => 'Ascend-FR-Profile-Name', + 'ascend_mtu' => 'Ascend-MTU', + 'cisco_ppp_async_map' => 'Cisco-PPP-Async-Map', + 'cisco_num_in_multilink' => 'Cisco-Num-In-Multilink', + 'usr_mobile_ip_address' => 'USR-Mobile-IP-Address', + 'ascend_bridge' => 'Ascend-Bridge', + 'x_ascend_presession_time' => 'X-Ascend-PreSession-Time', + 'tunnel_cmd_timeout' => 'Tunnel_Cmd_Timeout', + 'ascend_multicast_client' => 'Ascend-Multicast-Client', + 'tunnel_private_group_id' => 'Tunnel-Private-Group-Id', + 'usr_rmmie_rcv_tot_pwrlvl' => 'USR-RMMIE-Rcv-Tot-PwrLvl', 'calling_station_id' => 'Calling-Station-Id', + 'tunnel_rate_limit_burst' => 'Tunnel_Rate_Limit_Burst', + 'usr_device_connected_to' => 'USR-Device-Connected-To', + 'login_lat_service' => 'Login-LAT-Service', + 'x_ascend_home_network_na' => 'X-Ascend-Home-Network-Name', + 'ascend_h323_fegw_address' => 'Ascend-H323-Fegw-Address', 'usr_called_party_number' => 'USR-Called-Party-Number', - 'shiva_network_protocols' => 'Shiva-Network-Protocols', + 'ascend_remove_seconds' => 'Ascend-Remove-Seconds', + 'shiva_user_attributes' => 'Shiva-User-Attributes', + 'x_ascend_route_ipx' => 'X-Ascend-Route-IPX', + 'acc_route_policy' => 'Acc-Route-Policy', 'x_ascend_client_gateway' => 'X-Ascend-Client-Gateway', - 'acct_input_octets' => 'Acct-Input-Octets', - 'ascend_call_type' => 'Ascend-Call-Type', - 'annex_product_name' => 'Annex-Product-Name', - 'framed_compression' => 'Framed-Compression', + 'ms_mppe_encryption_polic' => 'MS-MPPE-Encryption-Policy', + 'x_ascend_data_filter' => 'X-Ascend-Data-Filter', 'ascend_atm_direct' => 'Ascend-ATM-Direct', - 'x_ascend_remote_addr' => 'X-Ascend-Remote-Addr', - 'usr_tunneled_mlpp' => 'USR-Tunneled-MLPP', - 'le_ipsec_outsource_profi' => 'LE-IPSec-Outsource-Profile', - 'ascend_atm_vci' => 'Ascend-ATM-Vci', - 'usr_number_of_link_timeo' => 'USR-Number-of-Link-Timeouts', - 'usr_et_bridge_input_filt' => 'USR-ET-Bridge-Input-Filter', - 'x_ascend_fr_t391' => 'X-Ascend-FR-T391', - 'x_ascend_fr_t392' => 'X-Ascend-FR-T392', - 'h323_conf_id' => 'h323-conf-id', - 'usr_call_end_date_time' => 'USR-Call-End-Date-Time', - 'ascend_fr_t391' => 'Ascend-FR-T391', - 'bg_aging_time' => 'BG_Aging_Time', - 'x_ascend_pre_output_pack' => 'X-Ascend-Pre-Output-Packets', - 'acc_dialout_auth_mode' => 'Acc-Dialout-Auth-Mode', - 'ascend_calling_subaddres' => 'Ascend-Calling-Subaddress', - 'ascend_fr_t392' => 'Ascend-FR-T392', - 'acct_link_count' => 'Acct-Link-Count', - 'usr_chassis_call_slot' => 'USR-Chassis-Call-Slot', - 'h323_credit_time' => 'h323-credit-time', - 'nas_port_id' => 'NAS-Port-Id', - 'x_ascend_call_filter' => 'X-Ascend-Call-Filter', - 'ascend_destination_nas_p' => 'Ascend-Destination-Nas-Port', - 'arap_features' => 'ARAP-Features', - 'x_ascend_history_weigh_t' => 'X-Ascend-History-Weigh-Type', - 'annex_host_restrict' => 'Annex-Host-Restrict', - 'usr_compression_reset_mo' => 'USR-Compression-Reset-Mode', - 'cisco_maximum_time' => 'Cisco-Maximum-Time', + 'ascend_session_type' => 'Ascend-Session-Type', + 'x_ascend_fr_linkup' => 'X-Ascend-FR-LinkUp', + 'ascend_metric' => 'Ascend-Metric', + 'usr_speed_of_connection' => 'USR-Speed-Of-Connection', + 'le_nat_outsource_outmap' => 'LE-NAT-Outsource-Outmap', + 'pppoe_url' => 'PPPOE_URL', + 'acct_mcast_out_octets' => 'Acct_Mcast_Out_Octets', + 'ascend_callback' => 'Ascend-Callback', + 'tunnel_client_auth_id' => 'Tunnel-Client-Auth-Id', + 'acct_unique_session_id' => 'Acct-Unique-Session-Id', + 'usr_port_tap_format' => 'USR-Port-Tap-Format', + 'ascend_ckt_type' => 'Ascend-Ckt-Type', + 'ascend_ppp_async_map' => 'Ascend-PPP-Async-Map', + 'usr_acct_reason_code' => 'USR-Acct-Reason-Code', + 'ascend_filter' => 'Ascend-Filter', + 'h323_redirect_number' => 'h323-redirect-number', + 'port_limit' => 'Port-Limit', + 'x_ascend_shared_profile_' => 'X-Ascend-Shared-Profile-Enable', + 'tunnel_police_rate' => 'Tunnel_Police_Rate', + 'ascend_calling_id_screen' => 'Ascend-Calling-Id-Screening', + 'usr_multicast_proxy' => 'USR-Multicast-Proxy', + 'usr_bridging' => 'USR-Bridging', + 'usr_originate_answer_mod' => 'USR-Originate-Answer-Mode', + 'x_ascend_fr_dlci' => 'X-Ascend-FR-DLCI', + 'usr_request_type' => 'USR-Request-Type', + 'acc_dialout_auth_usernam' => 'Acc-Dialout-Auth-Username', + 'ascend_host_info' => 'Ascend-Host-Info', + 'usr_rmmie_num_of_updates' => 'USR-RMMIE-Num-Of-Updates', + 'x_ascend_fr_profile_name' => 'X-Ascend-FR-Profile-Name', + 'ascend_fr_direct_profile' => 'Ascend-FR-Direct-Profile', + 'x_ascend_bridge' => 'X-Ascend-Bridge', + 'tunnel_deadtime' => 'Tunnel_Deadtime', + 'ms_chap_error' => 'MS-CHAP-Error', + 'framed_route' => 'Framed-Route', + 'expiration' => 'Expiration', + 'ascend_backup' => 'Ascend-Backup', + 'ascend_pre_output_octets' => 'Ascend-Pre-Output-Octets', + 'framed_appletalk_zone' => 'Framed-AppleTalk-Zone', + 'annex_audit_level' => 'Annex-Audit-Level', + 'bind_auth_context' => 'Bind_Auth_Context', + 'cisco_asing_ip_pool' => 'Cisco-Asing-IP-Pool', + 'ascend_user_acct_base' => 'Ascend-User-Acct-Base', + 'mcast_receive' => 'Mcast_Receive', + 'usr_ds0' => 'USR-DS0', + 'ms_ras_vendor' => 'MS-RAS-Vendor', + 'tunnel_domain' => 'Tunnel_Domain', + 'usr_secondary_nbns_serve' => 'USR-Secondary_NBNS_Server', 'tunnel_max_sessions' => 'Tunnel_Max_Sessions', - 'bind_ses_context' => 'Bind_Ses_Context', - 'x_ascend_ppp_vj_slot_com' => 'X-Ascend-PPP-VJ-Slot-Comp', - 'usr_mobile_numbytes_rxed' => 'USR-Mobile-NumBytes-Rxed', - 'usr_rmmie_last_update_ti' => 'USR-RMMIE-Last-Update-Time', - 'ascend_atm_loopback_cell' => 'Ascend-ATM-Loopback-Cell-Loss', - 'ascend_bir_proxy' => 'Ascend-BIR-Proxy', - 'acct_mcast_in_packets' => 'Acct_Mcast_In_Packets', - 'shiva_type_of_service' => 'Shiva-Type-Of-Service', + 'ascend_ip_direct' => 'Ascend-IP-Direct', + 'idle_timeout' => 'Idle-Timeout', + 'tunnel_server_auth_id' => 'Tunnel-Server-Auth-Id', + 'usr_start_time' => 'USR-Start-Time', + 'usr_ip' => 'USR-IP', + 'usr_gateway_ip_address' => 'USR-Gateway-IP-Address', + 'usr_number_of_characters' => 'USR-Number-Of-Characters-Lost', + 'ascend_dba_monitor' => 'Ascend-DBA-Monitor', + 'ms_chap_domain' => 'MS-CHAP-Domain', + 'cisco_pre_input_octets' => 'Cisco-Pre-Input-Octets', + 'acct_session_time' => 'Acct-Session-Time', + 'framed_ip_address' => 'Framed-IP-Address', + 'x_ascend_ip_pool_definit' => 'X-Ascend-IP-Pool-Definition', + 'erx_alternate_cli_access' => 'ERX-Alternate-Cli-Access-Level', + 'medium_type' => 'Medium_Type', + 'acct_output_octets_64' => 'Acct_Output_Octets_64', + 'ascend_cir_timer' => 'Ascend-CIR-Timer', + 'police_rate' => 'Police_Rate', + 'ms_mppe_send_key' => 'MS-MPPE-Send-Key', + 'ascend_multicast_gleave_' => 'Ascend-Multicast-GLeave-Delay', + 'x_ascend_host_info' => 'X-Ascend-Host-Info', + 'erx_egress_policy_name' => 'ERX-Egress-Policy-Name', + 'user_name' => 'User-Name', + 'bind_bypass_bypass' => 'Bind_Bypass_Bypass', + 'annex_acct_servers' => 'Annex-Acct-Servers', + 'usr_chassis_call_channel' => 'USR-Chassis-Call-Channel', + 'annex_input_filter' => 'Annex-Input-Filter', + 'ascend_home_agent_passwo' => 'Ascend-Home-Agent-Password', + 'nas_port_type' => 'NAS-Port-Type', + 'ascend_endpoint_disc' => 'Ascend-Endpoint-Disc', + 'tunnel_police_burst' => 'Tunnel_Police_Burst', + 'bind_auth_max_sessions' => 'Bind_Auth_Max_Sessions', + 'x_ascend_fr_dce_n392' => 'X-Ascend-FR-DCE-N392', + 'usr_connect_term_reason' => 'USR-Connect-Term-Reason', + 'usr_mbi_ct_pri_card_span' => 'USR-Mbi_Ct_PRI_Card_Span_Line', + 'erx_egress_statistics' => 'ERX-Egress-Statistics', 'ascend_fr_dte_n392' => 'Ascend-FR-DTE-N392', - 'usr_at_call_input_filter' => 'USR-AT-Call-Input-Filter', - 'ascend_fr_dte_n393' => 'Ascend-FR-DTE-N393', - 'x_ascend_backup' => 'X-Ascend-Backup', - 'char_noecho' => 'Char-Noecho', - 'usr_rmmie_last_update_ev' => 'USR-RMMIE-Last-Update-Event', - 'le_advice_of_charge' => 'LE-Advice-of-Charge', - 'ascend_calling_id_type_o' => 'Ascend-Calling-Id-Type-Of-Num', - 'ascend_pppoe_enable' => 'Ascend-PPPoE-Enable', + 'usr_esn' => 'USR-ESN', + 'x_ascend_fr_dte_n392' => 'X-Ascend-FR-DTE-N392', + 'x_ascend_fr_nailed_grp' => 'X-Ascend-FR-Nailed-Grp', + 'ascend_bridge_non_pppoe' => 'Ascend-Bridge-Non-PPPoE', + 'ascend_ipx_alias' => 'Ascend-IPX-Alias', + 'acc_tunnel_port' => 'Acc-Tunnel-Port', + 'acct_input_gigawords' => 'Acct-Input-Gigawords', + 'ascend_maximum_channels' => 'Ascend-Maximum-Channels', + 'x_ascend_ppp_async_map' => 'X-Ascend-PPP-Async-Map', + 'usr_retrains_requested' => 'USR-Retrains-Requested', + 'x_ascend_metric' => 'X-Ascend-Metric', + 'acc_apsm_oversubscribed' => 'Acc-Apsm-Oversubscribed', + 'erx_atm_pcr' => 'ERX-Atm-PCR', + 'usr_ipx_routing' => 'USR-IPX-Routing', + 'usr_tunneled_mlpp' => 'USR-Tunneled-MLPP', + 'usr_send_script5' => 'USR-Send-Script5', + 'ascend_traffic_shaper' => 'Ascend-Traffic-Shaper', + 'ascend_bacp_enable' => 'Ascend-BACP-Enable', + 'login_time' => 'Login-Time', + 'ascend_call_type' => 'Ascend-Call-Type', + 'erx_address_pool_name' => 'ERX-Address-Pool-Name', + 'h323_incoming_conf_id' => 'h323-incoming-conf-id', + 'packet_type' => 'Packet-Type', + 'usr_security_resp_limit' => 'USR-Security-Resp-Limit', + 'ip_address_pool_name' => 'Ip_Address_Pool_Name', + 'ascend_cbcp_trunk_group' => 'Ascend-CBCP-Trunk-Group', + 'ascend_ipx_node_addr' => 'Ascend-IPX-Node-Addr', + 'ascend_menu_selector' => 'Ascend-Menu-Selector', + 'usr_ds0s' => 'USR-DS0s', + 'usr_actual_voltage' => 'USR-Actual-Voltage', + 'annex_sw_version' => 'Annex-SW-Version', + 'ascend_history_weigh_typ' => 'Ascend-History-Weigh-Type', + 'ascend_receive_secret' => 'Ascend-Receive-Secret', + 'usr_ip_rip_policies' => 'USR-IP-RIP-Policies', + 'ascend_pw_warntime' => 'Ascend-PW-Warntime', + 'x_ascend_assign_ip_serve' => 'X-Ascend-Assign-IP-Server', + 'tunnel_session_auth_serv' => 'Tunnel_Session_Auth_Service_Grp', + 'usr_blocks_resent' => 'USR-Blocks-Resent', + 'usr_fallback_enabled' => 'USR-Fallback-Enabled', + 'arap_challenge_response' => 'ARAP-Challenge-Response', + 'tunnel_session_auth' => 'Tunnel_Session_Auth', 'usr_sync_async_mode' => 'USR-Sync-Async-Mode', - 'state' => 'State', - 'x_ascend_user_acct_base' => 'X-Ascend-User-Acct-Base', - 'x_ascend_ipx_alias' => 'X-Ascend-IPX-Alias', - 'ascend_ip_tos' => 'Ascend-IP-TOS', - 'annex_secondary_dns_serv' => 'Annex-Secondary-DNS-Server', - 'tunnel_session_auth_ctx' => 'Tunnel_Session_Auth_Ctx', - 'usr_mbi_ct_pri_card_span' => 'USR-Mbi_Ct_PRI_Card_Span_Line', + 'client_port_dnis' => 'Client-Port-DNIS', + 'ascend_ppp_vj_1172' => 'Ascend-PPP-VJ-1172', + 'ascend_remote_addr' => 'Ascend-Remote-Addr', + 'ascend_fr_n391' => 'Ascend-FR-N391', + 'client_port_id' => 'Client-Port-Id', + 'usr_num_fax_pages_proces' => 'USR-Num-Fax-Pages-Processed', + 'le_ipsec_active_profile' => 'LE-IPSec-Active-Profile', + 'usr_port_tap_facility' => 'USR-Port-Tap-Facility', + 'usr_callback_type' => 'USR-Callback-Type', + 'login_lat_group' => 'Login-LAT-Group', + 'x_ascend_call_type' => 'X-Ascend-Call-Type', + 'ascend_route_ip' => 'Ascend-Route-IP', + 'usr_pw_vpn_id' => 'USR-PW_VPN_ID', + 'le_nat_sess_dir_fail_act' => 'LE-NAT-Sess-Dir-Fail-Action', + 'cisco_pre_output_octets' => 'Cisco-Pre-Output-Octets', + 'h323_billing_model' => 'h323-billing-model', + 'usr_equalization_type' => 'USR-Equalization-Type', + 'acc_clearing_cause' => 'Acc-Clearing-Cause', + 'x_ascend_menu_selector' => 'X-Ascend-Menu-Selector', + 'x_ascend_netware_timeout' => 'X-Ascend-Netware-timeout', + 'ascend_fr_linkup' => 'Ascend-FR-LinkUp', + 'police_burst' => 'Police_Burst', + 'ascend_filter_required' => 'Ascend-Filter-Required', + 'usr_compression_algorith' => 'USR-Compression-Algorithm', + 'le_ipsec_outsource_profi' => 'LE-IPSec-Outsource-Profile', + 'x_ascend_idle_limit' => 'X-Ascend-Idle-Limit', + 'usr_call_terminate_in_gm' => 'USR-Call-Terminate-in-GMT', + 'usr_ipx_call_output_filt' => 'USR-IPX-Call-Output-Filter', + 'ip_tos_field' => 'IP_TOS_Field', + 'ascend_ip_tos_apply_to' => 'Ascend-IP-TOS-Apply-To', + 'tunnel_l2f_second_passwo' => 'Tunnel_L2F_Second_Password', 'usr_call_event_code' => 'USR-Call-Event-Code', - 'chap_password' => 'CHAP-Password', - 'le_nat_tcp_session_timeo' => 'LE-NAT-TCP-Session-Timeout', - 'usr_call_start_date_time' => 'USR-Call-Start-Date-Time', - 'usr_multicast_forwarding' => 'USR-Multicast-Forwarding', - 'client_id' => 'Client-Id', - 'sql_user_name' => 'SQL-User-Name', - 'x_ascend_billing_number' => 'X-Ascend-Billing-Number', - 'ms_secondary_nbns_server' => 'MS-Secondary-NBNS-Server', - 'cisco_num_in_multilink' => 'Cisco-Num-In-Multilink', - 'x_ascend_client_assign_d' => 'X-Ascend-Client-Assign-DNS', + 'usr_rmmie_product_code' => 'USR-RMMIE-Product-Code', + 'usr_host_type' => 'USR-Host-Type', + 'ascend_send_auth' => 'Ascend-Send-Auth', + 'shiva_compression_type' => 'Shiva-Compression-Type', + 'filter_id' => 'Filter-Id', + 'ascend_ft1_caller' => 'Ascend-FT1-Caller', + 'erx_cli_initial_access_l' => 'ERX-Cli-Initial-Access-Level', + 'usr_log_filter_packets' => 'USR-Log-Filter-Packets', + 'ascend_fr_nailed_grp' => 'Ascend-FR-Nailed-Grp', + 'usr_initial_tx_link_data' => 'USR-Initial-Tx-Link-Data-Rate', + 'acc_input_errors' => 'Acc-Input-Errors', 'x_ascend_user_acct_port' => 'X-Ascend-User-Acct-Port', - 'usr_local_ip_address' => 'USR-Local-IP-Address', - 'x_ascend_ip_pool_definit' => 'X-Ascend-IP-Pool-Definition', - 'ascend_metric' => 'Ascend-Metric', - 'x_ascend_bacp_enable' => 'X-Ascend-BACP-Enable', - 'x_ascend_user_acct_time' => 'X-Ascend-User-Acct-Time', - 'x_ascend_mpp_idle_percen' => 'X-Ascend-MPP-Idle-Percent', - 'annex_authen_servers' => 'Annex-Authen-Servers', - 'x_ascend_data_filter' => 'X-Ascend-Data-Filter', - 'ascend_idle_limit' => 'Ascend-Idle-Limit', - 'ldap_userdn' => 'Ldap-UserDn', - 'x_ascend_target_util' => 'X-Ascend-Target-Util', - 'shiva_connect_reason' => 'Shiva-Connect-Reason', - 'usr_ds0' => 'USR-DS0', - 'annex_re_chap_timeout' => 'Annex-Re-CHAP-Timeout', - 'shasta_vpn_name' => 'Shasta-VPN-Name', - 'acct_tunnel_connection_i' => 'Acct-Tunnel-Connection-Id', - 'h323_prompt_id' => 'h323-prompt-id', - 'x_ascend_ipx_peer_mode' => 'X-Ascend-IPX-Peer-Mode', - 'ascend_numbering_plan_id' => 'Ascend-Numbering-Plan-ID', - 'x_ascend_ts_idle_limit' => 'X-Ascend-TS-Idle-Limit', - 'ascend_atm_fault_managem' => 'Ascend-ATM-Fault-Management', - 'annex_primary_nbns_serve' => 'Annex-Primary-NBNS-Server', - 'lac_port_type' => 'LAC_Port_Type', - 'usr_initial_rx_link_data' => 'USR-Initial-Rx-Link-Data-Rate', - 'usr_interface_index' => 'USR-Interface-Index', - 'usr_expansion_algorithm' => 'USR-Expansion-Algorithm', - 'ascend_tunnel_vrouter_na' => 'Ascend-Tunnel-VRouter-Name', - 'usr_pw_vpn_neighbor' => 'USR-PW_VPN_Neighbor', + 'erx_secondary_wins' => 'ERX-Secondary-Wins', + 'usr_rmmie_serial_number' => 'USR-RMMIE-Serial-Number', + 'ascend_client_primary_dn' => 'Ascend-Client-Primary-DNS', + 'usr_slot_connected_to' => 'USR-Slot-Connected-To', + 'shiva_disconnect_reason' => 'Shiva-Disconnect-Reason', + 'usr_receive_acc_map' => 'USR-Receive-Acc-Map', + 'usr_compression_reset_mo' => 'USR-Compression-Reset-Mode', + 'usr_rmmie_planned_discon' => 'USR-RMMIE-Planned-Disconnect', + 'ascend_client_assign_dns' => 'Ascend-Client-Assign-DNS', + 'ascend_fr_type' => 'Ascend-FR-Type', + 'tunnel_client_endpoint' => 'Tunnel-Client-Endpoint', + 'x_ascend_send_secret' => 'X-Ascend-Send-Secret', + 'x_ascend_call_filter' => 'X-Ascend-Call-Filter', + 'usr_ipx_rip_input_filter' => 'USR-IPX-RIP-Input-Filter', + 'x_ascend_maximum_time' => 'X-Ascend-Maximum-Time', + 'ascend_x25_pad_x3_profil' => 'Ascend-X25-Pad-X3-Profile', + 'pvc_profile_name' => 'PVC_Profile_Name', + 'ascend_global_call_id' => 'Ascend-Global-Call-Id', + 'tunnel_local_name' => 'Tunnel_Local_Name', + 'ascend_fr_t392' => 'Ascend-FR-T392', + 'usr_dnis_reauthenticatio' => 'USR-DNIS-ReAuthentication', + 'ascend_pre_output_packet' => 'Ascend-Pre-Output-Packets', + 'ascend_token_immediate' => 'Ascend-Token-Immediate', + 'usr_chassis_call_slot' => 'USR-Chassis-Call-Slot', + 'rate_limit_burst' => 'Rate_Limit_Burst', + 'cisco_route_ip' => 'Cisco-Route-IP', + 'dhcp_max_leases' => 'DHCP_Max_Leases', + 'user_category' => 'User-Category', + 'x_ascend_maximum_call_du' => 'X-Ascend-Maximum-Call-Duration', 'bind_type' => 'Bind_Type', - 'acc_ccp_option' => 'Acc-Ccp-Option', + 'usr_framed_ipx_route' => 'USR-Framed-IPX-Route', + 'rate_limit_rate' => 'Rate_Limit_Rate', + 'ascend_atm_connect_vpi' => 'Ascend-ATM-Connect-Vpi', + 'x_ascend_inc_channel_cou' => 'X-Ascend-Inc-Channel-Count', + 'connect_info' => 'Connect-Info', + 'x_ascend_pre_input_packe' => 'X-Ascend-Pre-Input-Packets', + 'usr_port_tap_address' => 'USR-Port-Tap-Address', + 'ascend_home_agent_udp_po' => 'Ascend-Home-Agent-UDP-Port', + 'usr_final_rx_link_data_r' => 'USR-Final-Rx-Link-Data-Rate', + 'usr_pw_usr_ifilter_ip' => 'USR-PW_USR_IFilter_IP', 'ascend_route_appletalk' => 'Ascend-Route-Appletalk', - 'erx_alternate_cli_access' => 'ERX-Alternate-Cli-Access-Level', - 'usr_at_rtmp_output_filte' => 'USR-AT-RTMP-Output-Filter', - 'erx_atm_mbs' => 'ERX-Atm-MBS', - 'usr_at_call_output_filte' => 'USR-AT-Call-Output-Filter', - 'ms_old_arap_password' => 'MS-Old-ARAP-Password', - 'x_ascend_client_primary_' => 'X-Ascend-Client-Primary-DNS', - 'x_ascend_host_info' => 'X-Ascend-Host-Info', - 'bind_auth_protocol' => 'Bind_Auth_Protocol', - 'cisco_link_compression' => 'Cisco-Link-Compression', - 'annex_syslog_tap' => 'Annex-Syslog-Tap', - 'tunnel_window' => 'Tunnel_Window', - 'usr_gateway_ip_address' => 'USR-Gateway-IP-Address', - 'ascend_redirect_number' => 'Ascend-Redirect-Number', + 'ms_chap_lm_enc_pw' => 'MS-CHAP-LM-Enc-PW', + 'ascend_callback_delay' => 'Ascend-Callback-Delay', + 'x_ascend_bacp_enable' => 'X-Ascend-BACP-Enable', + 'bg_trans_bpdu' => 'BG_Trans_BPDU', + 'huntgroup_name' => 'Huntgroup-Name', + 'x_ascend_ipx_alias' => 'X-Ascend-IPX-Alias', 'x_ascend_secondary_home_' => 'X-Ascend-Secondary-Home-Agent', - 'usr_pw_index' => 'USR-PW_Index', - 'le_multicast_client' => 'LE-Multicast-Client', - 'annex_modem_disc_reason' => 'Annex-Modem-Disc-Reason', - 'annex_primary_dns_server' => 'Annex-Primary-DNS-Server', - 'erx_secondary_wins' => 'ERX-Secondary-Wins', - 'fall_through' => 'Fall-Through', - 'acct_mcast_out_packets' => 'Acct_Mcast_Out_Packets', - 'x_ascend_transit_number' => 'X-Ascend-Transit-Number', - 'usr_unauthenticated_time' => 'USR-Unauthenticated-Time', - 'le_ipsec_active_profile' => 'LE-IPSec-Active-Profile', - 'ascend_ip_pool_chaining' => 'Ascend-IP-Pool-Chaining', - 'usr_syslog_tap' => 'USR-Syslog-Tap', - 'ascend_multicast_client' => 'Ascend-Multicast-Client', - 'usr_device_connected_to' => 'USR-Device-Connected-To', - 'tunnel_l2f_second_passwo' => 'Tunnel_L2F_Second_Password', - 'add_prefix' => 'Add-Prefix', - 'tunnel_cmd_timeout' => 'Tunnel_Cmd_Timeout', - 'x_ascend_remove_seconds' => 'X-Ascend-Remove-Seconds', - 'acct_mcast_in_octets' => 'Acct_Mcast_In_Octets', - 'ascend_appletalk_route' => 'Ascend-Appletalk-Route', - 'ascend_fcp_parameter' => 'Ascend-FCP-Parameter', - 'acc_ip_compression' => 'Acc-Ip-Compression', - 'usr_modem_training_time' => 'USR-Modem-Training-Time', - 'usr_primary_dns_server' => 'USR-Primary_DNS_Server', - 'erx_egress_policy_name' => 'ERX-Egress-Policy-Name', - 'x_ascend_base_channel_co' => 'X-Ascend-Base-Channel-Count', - 'x_ascend_pre_input_packe' => 'X-Ascend-Pre-Input-Packets', - 'password_retry' => 'Password-Retry', - 'ascend_source_auth' => 'Ascend-Source-Auth', - 'cisco_pw_lifetime' => 'Cisco-PW-Lifetime', - 'acc_dns_server_pri' => 'Acc-Dns-Server-Pri', - 'ascend_netware_timeout' => 'Ascend-Netware-timeout', - 'ascend_ppp_async_map' => 'Ascend-PPP-Async-Map', - 'usr_rad_multicast_routin' => 'USR-Rad-Multicast-Routing-Ttl', - 'x_ascend_modem_slotno' => 'X-Ascend-Modem-SlotNo', - 'x_ascend_ip_direct' => 'X-Ascend-IP-Direct', - 'simultaneous_use' => 'Simultaneous-Use', - 'erx_virtual_router_name' => 'ERX-Virtual-Router-Name', - 'ascend_bridge_non_pppoe' => 'Ascend-Bridge-Non-PPPoE', - 'ascend_fr_08_mode' => 'Ascend-FR-08-Mode', - 'h323_call_type' => 'h323-call-type', - 'tunnel_context' => 'Tunnel_Context', - 'usr_transmit_acc_map' => 'USR-Transmit-Acc-Map', 'usr_ipx_wan' => 'USR-IPX-WAN', - 'usr_ip_call_input_filter' => 'USR-IP-Call-Input-Filter', + 'menu' => 'Menu', + 'x_ascend_fr_direct_dlci' => 'X-Ascend-FR-Direct-DLCI', + 'acct_status_type' => 'Acct-Status-Type', + 'ascend_port_redir_server' => 'Ascend-Port-Redir-Server', + 'acc_dns_server_sec' => 'Acc-Dns-Server-Sec', + 'ascend_minimum_channels' => 'Ascend-Minimum-Channels', + 'ascend_telnet_profile' => 'Ascend-Telnet-Profile', + 'ascend_ipx_route' => 'Ascend-IPX-Route', 'usr_call_connect_in_gmt' => 'USR-Call-Connect-in-GMT', - 'acct_multi_session_id' => 'Acct-Multi-Session-Id', - 'usr_reply_script1' => 'USR-Reply-Script1', + 'x_ascend_dba_monitor' => 'X-Ascend-DBA-Monitor', + 'usr_event_id' => 'USR-Event-Id', + 'ascend_inc_channel_count' => 'Ascend-Inc-Channel-Count', + 'usr_send_script3' => 'USR-Send-Script3', + 'framed_callback_id' => 'Framed-Callback-Id', + 'arap_zone_access' => 'ARAP-Zone-Access', + 'service_type' => 'Service-Type', + 'usr_nfas_id' => 'USR-NFAS-ID', + 'shiva_calling_number' => 'Shiva-Calling-Number', + 'ascend_user_acct_host' => 'Ascend-User-Acct-Host', + 'ascend_fr_link_mgt' => 'Ascend-FR-Link-Mgt', + 'ms_primary_nbns_server' => 'MS-Primary-NBNS-Server', + 'quintum_avpair' => 'Quintum-AVPair', + 'x_ascend_home_agent_pass' => 'X-Ascend-Home-Agent-Password', + 'ascend_transit_number' => 'Ascend-Transit-Number', + 'ascend_cache_refresh' => 'Ascend-Cache-Refresh', + 'versanet_termination_cau' => 'Versanet-Termination-Cause', + 'ascend_user_acct_type' => 'Ascend-User-Acct-Type', + 'usr_mic' => 'USR-MIC', + 'ascend_base_channel_coun' => 'Ascend-Base-Channel-Count', + 'x_ascend_dhcp_pool_numbe' => 'X-Ascend-DHCP-Pool-Number', + 'ms_chap2_success' => 'MS-CHAP2-Success', + 'cisco_idle_limit' => 'Cisco-Idle-Limit', + 'ascend_pw_lifetime' => 'Ascend-PW-Lifetime', + 'usr_packet_bus_session' => 'USR-Packet-Bus-Session', + 'ascend_atm_loopback_cell' => 'Ascend-ATM-Loopback-Cell-Loss', + 'acct_input_packets_64' => 'Acct_Input_Packets_64', + 'ascend_modem_slotno' => 'Ascend-Modem-SlotNo', + 'usr_characters_received' => 'USR-Characters-Received', + 'ms_bap_usage' => 'MS-BAP-Usage', + 'cisco_data_filter' => 'Cisco-Data-Filter', + 'ascend_seconds_of_histor' => 'Ascend-Seconds-Of-History', + 'h323_setup_time' => 'h323-setup-time', + 'acc_dialout_auth_passwor' => 'Acc-Dialout-Auth-Password', + 'le_nat_outsource_inmap' => 'LE-NAT-Outsource-Inmap', + 'usr_sap_filter_in' => 'USR-SAP-Filter-In', + 'framed_appletalk_link' => 'Framed-AppleTalk-Link', + 'usr_initial_rx_link_data' => 'USR-Initial-Rx-Link-Data-Rate', + 'usr_ospf_addressless_ind' => 'USR-OSPF-Addressless-Index', + 'usr_ipx' => 'USR-IPX', + 'shiva_connect_reason' => 'Shiva-Connect-Reason', 'cisco_ppp_vj_slot_comp' => 'Cisco-PPP-VJ-Slot-Comp', + 'ascend_atm_vpi' => 'Ascend-ATM-Vpi', + 'acc_ml_mlx_admin_state' => 'Acc-ML-MLX-Admin-State', + 'usr_igmp_robustness' => 'USR-IGMP-Robustness', + 'add_prefix' => 'Add-Prefix', + 'x_ascend_call_by_call' => 'X-Ascend-Call-By-Call', + 'x_ascend_connect_progres' => 'X-Ascend-Connect-Progress', + 'usr_at_rtmp_input_filter' => 'USR-AT-RTMP-Input-Filter', + 'erx_igmp_enable' => 'ERX-Igmp-Enable', + 'usr_rmmie_rcv_pwrlvl_375' => 'USR-RMMIE-Rcv-PwrLvl-3750Hz', + 'usr_pw_packet' => 'USR-PW_Packet', + 'dialback_no' => 'Dialback-No', + 'ascend_ip_tos_precedence' => 'Ascend-IP-TOS-Precedence', + 'annex_cli_filter' => 'Annex-CLI-Filter', + 'x_ascend_dial_number' => 'X-Ascend-Dial-Number', + 'usr_iwf_call_identifier' => 'USR-IWF-Call-Identifier', + 'ms_secondary_dns_server' => 'MS-Secondary-DNS-Server', + 'ascend_client_secondary_' => 'Ascend-Client-Secondary-WINS', + 'shiva_type_of_service' => 'Shiva-Type-Of-Service', + 'usr_framed_ip_address_po' => 'USR-Framed_IP_Address_Pool_Name', + 'bind_ses_context' => 'Bind_Ses_Context', + 'acc_reason_code' => 'Acc-Reason-Code', + 'ms_chap_cpw_1' => 'MS-CHAP-CPW-1', + 'h323_call_type' => 'h323-call-type', + 'ascend_fr_08_mode' => 'Ascend-FR-08-Mode', + 'usr_calling_party_number' => 'USR-Calling-Party-Number', + 'usr_rad_multicast_routin' => 'USR-Rad-Multicast-Routing-RtLim', 'usr_reply_script2' => 'USR-Reply-Script2', - 'usr_reply_script3' => 'USR-Reply-Script3', - 'usr_reply_script4' => 'USR-Reply-Script4', - 'usr_reply_script5' => 'USR-Reply-Script5', - 'usr_reply_script6' => 'USR-Reply-Script6', - 'user_category' => 'User-Category', - 'mcast_send' => 'Mcast_Send', - 'ascend_send_secret' => 'Ascend-Send-Secret', - 'usr_tunnel_switch_endpoi' => 'USR-Tunnel-Switch-Endpoint', - 'tunnel_retransmit' => 'Tunnel_Retransmit', - 'add_port_to_ip_address' => 'Add-Port-To-IP-Address', - 'ascend_ipx_node_addr' => 'Ascend-IPX-Node-Addr', - 'x_ascend_netware_timeout' => 'X-Ascend-Netware-timeout', - 'erx_sa_validate' => 'ERX-Sa-Validate', - 'le_ipsec_passive_profile' => 'LE-IPSec-Passive-Profile', - 'usr_chassis_slot' => 'USR-Chassis-Slot', - 'usr_final_tx_link_data_r' => 'USR-Final-Tx-Link-Data-Rate', - 'usr_nfas_id' => 'USR-NFAS-ID', - 'called_station_id' => 'Called-Station-Id', - 'login_lat_port' => 'Login-LAT-Port', - 'ascend_dialed_number' => 'Ascend-Dialed-Number', - 'h323_credit_amount' => 'h323-credit-amount', - 'tunnel_local_name' => 'Tunnel_Local_Name', - 'framed_ip_netmask' => 'Framed-IP-Netmask', - 'client_port_id' => 'Client-Port-Id', - 'bg_span_dis' => 'BG_Span_Dis', + 'usr_security_login_limit' => 'USR-Security-Login-Limit', + 'cisco_link_compression' => 'Cisco-Link-Compression', + 'usr_et_bridge_output_fil' => 'USR-ET-Bridge-Output-Filter', + 'ascend_vrouter_name' => 'Ascend-VRouter-Name', + 'usr_modem_setup_time' => 'USR-Modem-Setup-Time', + 'cisco_ip_direct' => 'Cisco-IP-Direct', + 'x_ascend_temporary_rtes' => 'X-Ascend-Temporary-Rtes', + 'ascend_x25_pad_alias_3' => 'Ascend-X25-Pad-Alias-3', + 'usr_rmmie_pwrlvl_xmit_lv' => 'USR-RMMIE-PwrLvl-Xmit-Lvl', + 'configuration_token' => 'Configuration-Token', + 'usr_at_rtmp_output_filte' => 'USR-AT-RTMP-Output-Filter', + 'usr_ip_default_route_opt' => 'USR-IP-Default-Route-Option', + 'ascend_calling_subaddres' => 'Ascend-Calling-Subaddress', + 'stripped_user_name' => 'Stripped-User-Name', + 'cisco_call_filter' => 'Cisco-Call-Filter', + 'termination_menu' => 'Termination-Menu', + 'port_message' => 'Port-Message', + 'usr_igmp_maximum_respons' => 'USR-IGMP-Maximum-Response-Time', + 'erx_ingress_policy_name' => 'ERX-Ingress-Policy-Name', + 'ascend_call_attempt_limi' => 'Ascend-Call-Attempt-Limit', + 'acc_service_profile' => 'Acc-Service-Profile', + 'ascend_bir_proxy' => 'Ascend-BIR-Proxy', + 'ascend_x25_nui_prompt' => 'Ascend-X25-Nui-Prompt', + 'usr_rmmie_pwrlvl_noise_l' => 'USR-RMMIE-PwrLvl-Noise-Lvl', + 'usr_rmmie_pwrlvl_nearech' => 'USR-RMMIE-PwrLvl-NearEcho-Canc', + 'x_ascend_multicast_clien' => 'X-Ascend-Multicast-Client', + 'usr_unauthenticated_time' => 'USR-Unauthenticated-Time', + 'acc_callback_cbcp_type' => 'Acc-Callback-CBCP-Type', + 'login_service' => 'Login-Service', + 'usr_rad_multicast_routin' => 'USR-Rad-Multicast-Routing-Bound', + 'ascend_dial_number' => 'Ascend-Dial-Number', + 'x_ascend_remote_addr' => 'X-Ascend-Remote-Addr', + 'usr_rmmie_rcv_pwrlvl_330' => 'USR-RMMIE-Rcv-PwrLvl-3300Hz', + 'usr_call_end_date_time' => 'USR-Call-End-Date-Time', + 'bind_dot1q_slot' => 'Bind_Dot1q_Slot', + 'le_connect_detail' => 'LE-Connect-Detail', + 'annex_user_level' => 'Annex-User-Level', + 'tunnel_dnis' => 'Tunnel_DNIS', + 'assigned_ip_address' => 'Assigned_IP_Address', + 'acc_bridging_support' => 'Acc-Bridging-Support', + 'usr_channel' => 'USR-Channel', + 'arap_security_data' => 'ARAP-Security-Data', + 'bind_auth_service_grp' => 'Bind_Auth_Service_Grp', + 'x_ascend_pre_output_pack' => 'X-Ascend-Pre-Output-Packets', + 'x_ascend_seconds_of_hist' => 'X-Ascend-Seconds-Of-History', + 'h323_voice_quality' => 'h323-voice-quality', + 'usr_rmmie_last_update_ti' => 'USR-RMMIE-Last-Update-Time', + 'usr_disconnect_cause_ind' => 'USR-Disconnect-Cause-Indicator', + 'usr_channel_connected_to' => 'USR-Channel-Connected-To', + 'ascend_calling_id_number' => 'Ascend-Calling-Id-Number-Plan', + 'usr_number_of_fallbacks' => 'USR-Number-of-Fallbacks', + 'usr_ip_call_output_filte' => 'USR-IP-Call-Output-Filter', + 'ascend_bir_enable' => 'Ascend-BIR-Enable', + 'usr_connect_time_limit' => 'USR-Connect-Time-Limit', + 'ascend_presession_time' => 'Ascend-PreSession-Time', + 'ascend_private_route_req' => 'Ascend-Private-Route-Required', + 'ascend_dsl_cir_xmit_limi' => 'Ascend-Dsl-CIR-Xmit-Limit', + 'framed_compression' => 'Framed-Compression', + 'ascend_svc_enabled' => 'Ascend-SVC-Enabled', + 'proxy_state' => 'Proxy-State', + 'ascend_tunnel_vrouter_na' => 'Ascend-Tunnel-VRouter-Name', + 'usr_ipx_call_input_filte' => 'USR-IPX-Call-Input-Filter', + 'x_ascend_assign_ip_globa' => 'X-Ascend-Assign-IP-Global-Pool', + 'erx_alternate_cli_vroute' => 'ERX-Alternate-Cli-Vrouter-Name', + 'ascend_dhcp_maximum_leas' => 'Ascend-DHCP-Maximum-Leases', + 'ascend_modem_shelfno' => 'Ascend-Modem-ShelfNo', + 'bind_auth_protocol' => 'Bind_Auth_Protocol', + 'shasta_user_privilege' => 'Shasta-User-Privilege', + 'acct_interim_interval' => 'Acct-Interim-Interval', + 'hint' => 'Hint', + 'x_ascend_target_util' => 'X-Ascend-Target-Util', + 'ms_link_drop_time_limit' => 'MS-Link-Drop-Time-Limit', + 'acc_access_partition' => 'Acc-Access-Partition', + 'x_ascend_multilink_id' => 'X-Ascend-Multilink-ID', + 'usr_power_supply_number' => 'USR-Power-Supply-Number', + 'acc_ipx_compression' => 'Acc-Ipx-Compression', + 'nomadix_bw_down' => 'Nomadix-Bw-Down', + 'usr_call_reference_numbe' => 'USR-Call-Reference-Number', + 'cisco_target_util' => 'Cisco-Target-Util', + 'usr_back_channel_data_ra' => 'USR-Back-Channel-Data-Rate', + 'acc_ip_gateway_sec' => 'Acc-Ip-Gateway-Sec', + 'usr_dte_ring_no_answer_l' => 'USR-DTE-Ring-No-Answer-Limit', + 'usr_connect_time' => 'USR-Connect-Time', + 'ascend_ip_pool_definitio' => 'Ascend-IP-Pool-Definition', + 'usr_call_start_date_time' => 'USR-Call-Start-Date-Time', + 'dialback_name' => 'Dialback-Name', + 'bind_tun_context' => 'Bind_Tun_Context', + 'h323_redirect_ip_address' => 'h323-redirect-ip-address', + 'annex_keypress_timeout' => 'Annex-Keypress-Timeout', + 'ascend_x25_pad_alias_1' => 'Ascend-X25-Pad-Alias-1', + 'ms_chap_response' => 'MS-CHAP-Response', + 'usr_max_channels' => 'USR-Max-Channels', + 'ascend_fr_dte_n393' => 'Ascend-FR-DTE-N393', + 'ascend_pre_input_octets' => 'Ascend-Pre-Input-Octets', + 'erx_atm_mbs' => 'ERX-Atm-MBS', + 'usr_line_reversals' => 'USR-Line-Reversals', + 'x_ascend_third_prompt' => 'X-Ascend-Third-Prompt', + 'x_ascend_pw_warntime' => 'X-Ascend-PW-Warntime', + 'ascend_data_filter' => 'Ascend-Data-Filter', + 'framed_address' => 'Framed-Address', + 'context_name' => 'Context-Name', + 'usr_send_script2' => 'USR-Send-Script2', + 'ms_arap_pw_change_reason' => 'MS-ARAP-PW-Change-Reason', + 'acct_session_id' => 'Acct-Session-Id', + 'initial_modulation_type' => 'Initial-Modulation-Type', + 'ascend_h323_gatekeeper' => 'Ascend-H323-Gatekeeper', + 'x_ascend_fcp_parameter' => 'X-Ascend-FCP-Parameter', + 'tunnel_type' => 'Tunnel-Type', 'multi_link_flag' => 'Multi-Link-Flag', - 'bind_sub_user_at_context' => 'Bind_Sub_User_At_Context', - 'usr_ipx_routing' => 'USR-IPX-Routing', - 'ascend_fr_nailed_grp' => 'Ascend-FR-Nailed-Grp', - 'ascend_pre_output_octets' => 'Ascend-Pre-Output-Octets', - 'pppoe_url' => 'PPPOE_URL', - 'ascend_ara_pw' => 'Ascend-Ara-PW', - 'acc_callback_mode' => 'Acc-Callback-Mode', - 'usr_server_time' => 'USR-Server-Time', - 'ascend_seconds_of_histor' => 'Ascend-Seconds-Of-History', + 'ascend_idle_limit' => 'Ascend-Idle-Limit', + 'password_retry' => 'Password-Retry', + 'h323_remote_address' => 'h323-remote-address', + 'erx_atm_service_category' => 'ERX-Atm-Service-Category', + 'acct_input_packets' => 'Acct-Input-Packets', + 'h323_disconnect_time' => 'h323-disconnect-time', + 'ascend_billing_number' => 'Ascend-Billing-Number', + 'usr_syslog_tap' => 'USR-Syslog-Tap', + 'ms_mppe_encryption_type' => 'MS-MPPE-Encryption-Type', + 'ascend_assign_ip_pool' => 'Ascend-Assign-IP-Pool', + 'usr_routing_protocol' => 'USR-Routing-Protocol', + 'usr_rad_location_type' => 'USR-Rad-Location-Type', + 'usr_characters_sent' => 'USR-Characters-Sent', + 'usr_mp_edo_hiper' => 'USR-MP-EDO-HIPER', + 'annex_host_restrict' => 'Annex-Host-Restrict', + 'user_service_type' => 'User-Service-Type', + 'acct_multi_session_id' => 'Acct-Multi-Session-Id', + 'ms_chap_cpw_2' => 'MS-CHAP-CPW-2', + 'x_ascend_primary_home_ag' => 'X-Ascend-Primary-Home-Agent', + 'x_ascend_dialout_allowed' => 'X-Ascend-Dialout-Allowed', + 'ascend_connect_progress' => 'Ascend-Connect-Progress', + 'x_ascend_ara_pw' => 'X-Ascend-Ara-PW', 'ns_mta_md5_password' => 'NS-MTA-MD5-Password', - 'tunnel_server_endpoint' => 'Tunnel-Server-Endpoint', - 'usr_channel' => 'USR-Channel', + 'callback_number' => 'Callback-Number', + 'acct_output_packets_64' => 'Acct_Output_Packets_64', + 'x_ascend_user_acct_key' => 'X-Ascend-User-Acct-Key', + 'ascend_modem_portno' => 'Ascend-Modem-PortNo', + 'ascend_assign_ip_server' => 'Ascend-Assign-IP-Server', + 'ascend_fcp_parameter' => 'Ascend-FCP-Parameter', + 'ascend_inter_arrival_jit' => 'Ascend-Inter-Arrival-Jitter', + 'client_ip_address' => 'Client-IP-Address', + 'usr_number_of_link_timeo' => 'USR-Number-of-Link-Timeouts', 'ascend_dsl_cir_recv_limi' => 'Ascend-Dsl-CIR-Recv-Limit', - 'acct_session_start_time' => 'Acct-Session-Start-Time', - 'ascend_send_passwd' => 'Ascend-Send-Passwd', - 'ascend_num_in_multilink' => 'Ascend-Num-In-Multilink', - 'usr_ip_rip_policies' => 'USR-IP-RIP-Policies', - 'vendor_specific' => 'Vendor-Specific', + 'ms_acct_eap_type' => 'MS-Acct-EAP-Type', + 'x_ascend_user_acct_type' => 'X-Ascend-User-Acct-Type', + 'usr_rmmie_x2_status' => 'USR-RMMIE-x2-Status', + 'ascend_dsl_downstream_li' => 'Ascend-Dsl-Downstream-Limit', + 'shiva_customer_id' => 'Shiva-Customer-Id', + 'lac_real_port' => 'LAC_Real_Port', + 'h323_connect_time' => 'h323-connect-time', + 'old_password' => 'Old-Password', + 'usr_vpn_gw_location_id' => 'USR-VPN-GW-Location-Id', + 'x_ascend_if_netmask' => 'X-Ascend-IF-Netmask', + 'add_suffix' => 'Add-Suffix', + 'x_ascend_client_assign_d' => 'X-Ascend-Client-Assign-DNS', + 'usr_q931_call_reference_' => 'USR-Q931-Call-Reference-Value', + 'usr_terminal_type' => 'USR-Terminal-Type', + 'usr_spoofing' => 'USR-Spoofing', + 'erx_tunnel_password' => 'ERX-Tunnel-Password', + 'ascend_assign_ip_client' => 'Ascend-Assign-IP-Client', + 'usr_server_time' => 'USR-Server-Time', + 'ascend_data_svc' => 'Ascend-Data-Svc', + 'annex_authen_servers' => 'Annex-Authen-Servers', + 'nomadix_bw_up' => 'Nomadix-Bw-Up', + 'shiva_link_speed' => 'Shiva-Link-Speed', + 'usr_reply_script6' => 'USR-Reply-Script6', + 'usr_expansion_algorithm' => 'USR-Expansion-Algorithm', + 'x_ascend_mpp_idle_percen' => 'X-Ascend-MPP-Idle-Percent', + 'cisco_data_rate' => 'Cisco-Data-Rate', + 'usr_primary_dns_server' => 'USR-Primary_DNS_Server', + 'erx_local_loopback_inter' => 'ERX-Local-Loopback-Interface', + 'ascend_target_util' => 'Ascend-Target-Util', + 'usr_default_dte_data_rat' => 'USR-Default-DTE-Data-Rate', 'x_ascend_event_type' => 'X-Ascend-Event-Type', - 'lac_real_port_type' => 'LAC_Real_Port_Type', - 'x_ascend_modem_portno' => 'X-Ascend-Modem-PortNo', - 'usr_originate_answer_mod' => 'USR-Originate-Answer-Mode', - 'framed_ipx_network' => 'Framed-IPX-Network', - 'ascend_modem_slotno' => 'Ascend-Modem-SlotNo', - 'ms_mppe_encryption_type' => 'MS-MPPE-Encryption-Type', - 'annex_cli_command' => 'Annex-CLI-Command', - 'acct_status_type' => 'Acct-Status-Type', - 'usr_et_bridge_call_outpu' => 'USR-ET-Bridge-Call-Output-Filte', - 'usr_pw_vpn_id' => 'USR-PW_VPN_ID', - 'usr_sap_filter_in' => 'USR-SAP-Filter-In', - 'usr_rad_multicast_routin' => 'USR-Rad-Multicast-Routing-Proto', - 'annex_audit_level' => 'Annex-Audit-Level', - 'x_ascend_shared_profile_' => 'X-Ascend-Shared-Profile-Enable', - 'ascend_dial_number' => 'Ascend-Dial-Number', - 'ascend_link_compression' => 'Ascend-Link-Compression', - 'usr_event_date_time' => 'USR-Event-Date-Time', - 'usr_mp_edo_hiper' => 'USR-MP-EDO-HIPER', - 'usr_re_chap_timeout' => 'USR-Re-Chap-Timeout', - 'x_ascend_third_prompt' => 'X-Ascend-Third-Prompt', - 'x_ascend_ppp_vj_1172' => 'X-Ascend-PPP-VJ-1172', - 'annex_disconnect_reason' => 'Annex-Disconnect-Reason', - 'ascend_fr_svc_addr' => 'Ascend-FR-SVC-Addr', - 'nas_real_port' => 'NAS_Real_Port', - 'usr_power_supply_number' => 'USR-Power-Supply-Number', - 'ms_secondary_dns_server' => 'MS-Secondary-DNS-Server', - 'ascend_port_redir_server' => 'Ascend-Port-Redir-Server', - 'ascend_x25_pad_alias_1' => 'Ascend-X25-Pad-Alias-1', - 'x_ascend_fcp_parameter' => 'X-Ascend-FCP-Parameter', - 'ascend_x25_pad_alias_2' => 'Ascend-X25-Pad-Alias-2', - 'ascend_ipsec_profile' => 'Ascend-IPSEC-Profile', - 'ascend_x25_pad_alias_3' => 'Ascend-X25-Pad-Alias-3', - 'usr_mobile_numbytes_txed' => 'USR-Mobile-NumBytes-Txed', - 'ascend_atm_vpi' => 'Ascend-ATM-Vpi', - 'annex_input_filter' => 'Annex-Input-Filter', - 'menu' => 'Menu', - 'x_ascend_route_ip' => 'X-Ascend-Route-IP', - 'usr_rmmie_num_of_updates' => 'USR-RMMIE-Num-Of-Updates', - 'acc_request_type' => 'Acc-Request-Type', - 'ascend_dhcp_reply' => 'Ascend-DHCP-Reply', - 'usr_number_of_upshifts' => 'USR-Number-of-Upshifts', - 'usr_rmmie_firmware_versi' => 'USR-RMMIE-Firmware-Version', + 'usr_mp_mrru' => 'USR-MP-MRRU', 'bind_bypass_context' => 'Bind_Bypass_Context', - 'ascend_dialout_allowed' => 'Ascend-Dialout-Allowed', - 'annex_tunnel_authen_type' => 'Annex-Tunnel-Authen-Type', - 'x_ascend_bridge' => 'X-Ascend-Bridge', - 'ascend_client_secondary_' => 'Ascend-Client-Secondary-WINS', - 'erx_local_loopback_inter' => 'ERX-Local-Loopback-Interface', - 'acct_input_gigawords' => 'Acct-Input-Gigawords', - 'usr_equalization_type' => 'USR-Equalization-Type', - 'usr_port_tap_format' => 'USR-Port-Tap-Format', - 'x_ascend_ppp_async_map' => 'X-Ascend-PPP-Async-Map', - 'acc_ipx_compression' => 'Acc-Ipx-Compression', - 'ascend_nas_port_format' => 'Ascend-NAS-Port-Format', - 'acc_modem_modulation_typ' => 'Acc-Modem-Modulation-Type', - 'ascend_modem_portno' => 'Ascend-Modem-PortNo', - 'usr_et_bridge_output_fil' => 'USR-ET-Bridge-Output-Filter', - 'ascend_ipx_header_compre' => 'Ascend-IPX-Header-Compression', - 'framed_appletalk_link' => 'Framed-AppleTalk-Link', - 'x_ascend_receive_secret' => 'X-Ascend-Receive-Secret', - 'ascend_route_ipx' => 'Ascend-Route-IPX', - 'ascend_user_acct_type' => 'Ascend-User-Acct-Type', - 'ascend_token_idle' => 'Ascend-Token-Idle', - 'framed_ip_address' => 'Framed-IP-Address', - 'ascend_call_block_durati' => 'Ascend-Call-Block-Duration', - 'ascend_ppp_address' => 'Ascend-PPP-Address', - 'usr_mbi_ct_pri_card_slot' => 'USR-Mbi_Ct_PRI_Card_Slot', - 'x_ascend_dec_channel_cou' => 'X-Ascend-Dec-Channel-Count', - 'x_ascend_send_auth' => 'X-Ascend-Send-Auth', - 'usr_characters_received' => 'USR-Characters-Received', + 'no_such_attribute' => 'No-Such-Attribute', + 'acct_mcast_out_packets' => 'Acct_Mcast_Out_Packets', + 'tunnel_medium_type' => 'Tunnel-Medium-Type', + 'acc_callback_delay' => 'Acc-Callback-Delay', + 'x_ascend_home_agent_udp_' => 'X-Ascend-Home-Agent-UDP-Port', + 'acct_input_octets_64' => 'Acct_Input_Octets_64', + 'ascend_atm_connect_vci' => 'Ascend-ATM-Connect-Vci', + 'erx_primary_dns' => 'ERX-Primary-Dns', + 'ascend_xmit_rate' => 'Ascend-Xmit-Rate', + 'ms_new_arap_password' => 'MS-New-ARAP-Password', + 'usr_call_error_code' => 'USR-Call-Error-Code', + 'acct_output_octets' => 'Acct-Output-Octets', + 'usr_failure_to_connect_r' => 'USR-Failure-to-Connect-Reason', + 'ascend_num_in_multilink' => 'Ascend-Num-In-Multilink', + 'x_ascend_number_sessions' => 'X-Ascend-Number-Sessions', + 'usr_ip_rip_output_filter' => 'USR-IP-RIP-Output-Filter', + 'usr_chassis_temp_thresho' => 'USR-Chassis-Temp-Threshold', + 'usr_blocks_sent' => 'USR-Blocks-Sent', + 'usr_ids0_call_type' => 'USR-IDS0-Call-Type', + 'acc_ccp_option' => 'Acc-Ccp-Option', + 'ascend_client_gateway' => 'Ascend-Client-Gateway', + 'x_ascend_multicast_rate_' => 'X-Ascend-Multicast-Rate-Limit', + 'le_ipsec_passive_profile' => 'LE-IPSec-Passive-Profile', + 'usr_chassis_call_span' => 'USR-Chassis-Call-Span', + 'usr_mobileip_home_agent_' => 'USR-MobileIP-Home-Agent-Address', + 'password' => 'Password', + 'le_nat_log_options' => 'LE-NAT-Log-Options', + 'x_ascend_ppp_address' => 'X-Ascend-PPP-Address', + 'usr_fallback_limit' => 'USR-Fallback-Limit', + 'suffix' => 'Suffix', + 'usr_multicast_receive' => 'USR-Multicast-Receive', + 'client_dns_sec' => 'Client_DNS_Sec', + 'annex_product_name' => 'Annex-Product-Name', + 'cisco_pw_lifetime' => 'Cisco-PW-Lifetime', + 'x_ascend_fr_dce_n393' => 'X-Ascend-FR-DCE-N393', + 'x_ascend_ts_idle_limit' => 'X-Ascend-TS-Idle-Limit', + 'usr_last_number_dialed_o' => 'USR-Last-Number-Dialed-Out', + 'mcast_send' => 'Mcast_Send', + 'pppoe_motm' => 'PPPOE_MOTM', + 'usr_pw_usr_ifilter_ipx' => 'USR-PW_USR_IFilter_IPX', 'usr_pw_tunnel_authentica' => 'USR-PW_Tunnel_Authentication', - 'usr_call_end_time' => 'USR-Call-End-Time', - 'x_ascend_dialout_allowed' => 'X-Ascend-Dialout-Allowed', - 'x_ascend_call_attempt_li' => 'X-Ascend-Call-Attempt-Limit', - 'initial_modulation_type' => 'Initial-Modulation-Type', - 'usr_packet_bus_session' => 'USR-Packet-Bus-Session', - 'x_ascend_ipx_node_addr' => 'X-Ascend-IPX-Node-Addr', - 'ascend_ppp_vj_slot_comp' => 'Ascend-PPP-VJ-Slot-Comp', + 'ascend_source_ip_check' => 'Ascend-Source-IP-Check', + 'ascend_assign_ip_global_' => 'Ascend-Assign-IP-Global-Pool', + 'ms_ras_version' => 'MS-RAS-Version', + 'usr_rad_multicast_routin' => 'USR-Rad-Multicast-Routing-Ttl', + 'x_ascend_modem_slotno' => 'X-Ascend-Modem-SlotNo', + 'acc_ml_call_threshold' => 'Acc-ML-Call-Threshold', 'ascend_menu_item' => 'Ascend-Menu-Item', - 'x_ascend_fr_link_mgt' => 'X-Ascend-FR-Link-Mgt', - 'usr_rmmie_serial_number' => 'USR-RMMIE-Serial-Number', - 'message_authenticator' => 'Message-Authenticator', - 'usr_dte_data_idle_timout' => 'USR-DTE-Data-Idle-Timout', - 'usr_port_tap_facility' => 'USR-Port-Tap-Facility', - 'acc_ml_mlx_admin_state' => 'Acc-ML-MLX-Admin-State', - 'usr_modem_group' => 'USR-Modem-Group', - 'x_ascend_callback' => 'X-Ascend-Callback', - 'acct_input_packets_64' => 'Acct_Input_Packets_64', - 'ascend_third_prompt' => 'Ascend-Third-Prompt', - 'configuration_token' => 'Configuration-Token', - 'x_ascend_fr_nailed_grp' => 'X-Ascend-FR-Nailed-Grp', - 'acct_output_octets_64' => 'Acct_Output_Octets_64', - 'h323_time_and_day' => 'h323-time-and-day', - 'ascend_port_redir_portnu' => 'Ascend-Port-Redir-Portnum', - 'acct_interim_interval' => 'Acct-Interim-Interval', - 'ascend_uu_info' => 'Ascend-UU-Info', - 'usr_pw_vpn_name' => 'USR-PW_VPN_Name', + 'usr_cdma_call_reference_' => 'USR-CDMA-Call-Reference-Number', + 'callback_id' => 'Callback-Id', + 'framed_ipx_network' => 'Framed-IPX-Network', + 'x_ascend_disconnect_caus' => 'X-Ascend-Disconnect-Cause', + 'ascend_user_acct_key' => 'Ascend-User-Acct-Key', + 'x_ascend_pw_lifetime' => 'X-Ascend-PW-Lifetime', + 'user_name_is_star' => 'User-Name-Is-Star', + 'x_ascend_authen_alias' => 'X-Ascend-Authen-Alias', + 'framed_pool' => 'Framed-Pool', + 'ms_primary_dns_server' => 'MS-Primary-DNS-Server', + 'realm' => 'Realm', + 'arap_features' => 'ARAP-Features', + 'acc_connect_tx_speed' => 'Acc-Connect-Tx-Speed', + 'usr_last_number_dialed_i' => 'USR-Last-Number-Dialed-In-DNIS', + 'usr_chassis_temperature' => 'USR-Chassis-Temperature', + 'x_ascend_xmit_rate' => 'X-Ascend-Xmit-Rate', + 'x_ascend_send_passwd' => 'X-Ascend-Send-Passwd', + 'le_modem_info' => 'LE-Modem-Info', + 'ascend_ipx_peer_mode' => 'Ascend-IPX-Peer-Mode', + 'le_nat_other_session_tim' => 'LE-NAT-Other-Session-Timeout', + 'tunnel_rate_limit_rate' => 'Tunnel_Rate_Limit_Rate', 'ascend_maximum_call_dura' => 'Ascend-Maximum-Call-Duration', - 'ascend_atm_direct_profil' => 'Ascend-ATM-Direct-Profile', - 'acc_input_errors' => 'Acc-Input-Errors', - 'bind_dot1q_port' => 'Bind_Dot1q_Port', - 'ascend_first_dest' => 'Ascend-First-Dest', - 'x_ascend_if_netmask' => 'X-Ascend-IF-Netmask', - 'tunnel_session_auth_serv' => 'Tunnel_Session_Auth_Service_Grp', - 'annex_local_ip_address' => 'Annex-Local-IP-Address', - 'termination_menu' => 'Termination-Menu', - 'ms_chap2_cpw' => 'MS-CHAP2-CPW', - 'ascend_mpp_idle_percent' => 'Ascend-MPP-Idle-Percent', - 'usr_characters_sent' => 'USR-Characters-Sent', - 'eap_message' => 'EAP-Message', - 'acct_delay_time' => 'Acct-Delay-Time', - 'ascend_remote_fw' => 'Ascend-Remote-FW', - 'x_ascend_tunneling_proto' => 'X-Ascend-Tunneling-Protocol', - 'shiva_session_id' => 'Shiva-Session-Id', - 'usr_igmp_query_interval' => 'USR-IGMP-Query-Interval', - 'usr_accm_type' => 'USR-ACCM-Type', - 'usr_call_terminate_in_gm' => 'USR-Call-Terminate-in-GMT', - 'usr_rad_location_type' => 'USR-Rad-Location-Type', - 'ascend_filter' => 'Ascend-Filter', - 'ascend_primary_home_agen' => 'Ascend-Primary-Home-Agent', - 'x_ascend_user_acct_host' => 'X-Ascend-User-Acct-Host', - 'chap_challenge' => 'CHAP-Challenge', - 'acct_output_packets_64' => 'Acct_Output_Packets_64', - 'bind_auth_max_sessions' => 'Bind_Auth_Max_Sessions', - 'cisco_pre_output_octets' => 'Cisco-Pre-Output-Octets', - 'x_ascend_fr_direct' => 'X-Ascend-FR-Direct', - 'x_ascend_client_secondar' => 'X-Ascend-Client-Secondary-DNS', - 'usr_rmmie_pwrlvl_nearech' => 'USR-RMMIE-PwrLvl-NearEcho-Canc', - 'ascend_bridge_address' => 'Ascend-Bridge-Address', - 'user_name' => 'User-Name', - 'usr_rmmie_firmware_build' => 'USR-RMMIE-Firmware-Build-Date', - 'ms_chap_mppe_keys' => 'MS-CHAP-MPPE-Keys', - 'usr_number_of_characters' => 'USR-Number-Of-Characters-Lost', - 'usr_physical_state' => 'USR-Physical-State', - 'x_ascend_assign_ip_serve' => 'X-Ascend-Assign-IP-Server', - 'bind_int_context' => 'Bind_Int_Context', - 'erx_tunnel_virtual_route' => 'ERX-Tunnel-Virtual-Router', - 'ascend_xmit_rate' => 'Ascend-Xmit-Rate', - 'usr_secondary_dns_server' => 'USR-Secondary_DNS_Server', + 'ascend_dhcp_pool_number' => 'Ascend-DHCP-Pool-Number', + 'x_ascend_callback' => 'X-Ascend-Callback', + 'ascend_access_intercept_' => 'Ascend-Access-Intercept-Log', + 'usr_iwf_ip_address' => 'USR-IWF-IP-Address', + 'nas_port_id' => 'NAS-Port-Id', + 'le_advice_of_charge' => 'LE-Advice-of-Charge', + 'ascend_add_seconds' => 'Ascend-Add-Seconds', + 'annex_transmit_speed' => 'Annex-Transmit-Speed', + 'usr_port_tap' => 'USR-Port-Tap', + 'usr_at_call_input_filter' => 'USR-AT-Call-Input-Filter', + 'ascend_qos_downstream' => 'Ascend-QOS-Downstream', + 'ascend_x25_reverse_charg' => 'Ascend-X25-Reverse-Charging', + 'lac_port' => 'LAC_Port', + 'tunnel_assignment_id' => 'Tunnel-Assignment-Id', + 'fall_through' => 'Fall-Through', + 'cisco_disconnect_cause' => 'Cisco-Disconnect-Cause', + 'module_message' => 'Module-Message', + 'framed_ip_netmask' => 'Framed-IP-Netmask', + 'ascend_egress_enabled' => 'Ascend-Egress-Enabled', 'ascend_dsl_rate_mode' => 'Ascend-Dsl-Rate-Mode', - 'ascend_data_rate' => 'Ascend-Data-Rate', - 'realm' => 'Realm', - 'usr_ipx_call_input_filte' => 'USR-IPX-Call-Input-Filter', - 'ascend_ipx_route' => 'Ascend-IPX-Route', - 'usr_failure_to_connect_r' => 'USR-Failure-to-Connect-Reason', - 'x_ascend_home_network_na' => 'X-Ascend-Home-Network-Name', - 'acc_nbns_server_pri' => 'Acc-Nbns-Server-Pri', + 'x_ascend_client_primary_' => 'X-Ascend-Client-Primary-DNS', + 'usr_pw_usr_ofilter_sap' => 'USR-PW_USR_OFilter_SAP', + 'acct_terminate_cause' => 'Acct-Terminate-Cause', + 'x_ascend_fr_dte_n393' => 'X-Ascend-FR-DTE-N393', + 'x_ascend_call_block_dura' => 'X-Ascend-Call-Block-Duration', + 'ascend_ppp_address' => 'Ascend-PPP-Address', + 'caller_id' => 'Caller-ID', + 'bind_int_interface_name' => 'Bind_Int_Interface_Name', + 'x_ascend_ppp_vj_slot_com' => 'X-Ascend-PPP-VJ-Slot-Comp', + 'usr_modem_group' => 'USR-Modem-Group', + 'cisco_maximum_channels' => 'Cisco-Maximum-Channels', + 'ascend_link_compression' => 'Ascend-Link-Compression', + 'usr_retrains_granted' => 'USR-Retrains-Granted', + 'ascend_dropped_packets' => 'Ascend-Dropped-Packets', + 'usr_pw_usr_ofilter_ip' => 'USR-PW_USR_OFilter_IP', + 'quintum_nas_port' => 'Quintum-NAS-Port', + 'annex_tunnel_authen_mode' => 'Annex-Tunnel-Authen-Mode', + 'tunnel_function' => 'Tunnel_Function', + 'usr_mp_edo' => 'USR-MP-EDO', + 'le_nat_outmap' => 'LE-NAT-Outmap', 'usr_modulation_type' => 'USR-Modulation-Type', - 'service_type' => 'Service-Type', - 'ascend_callback_delay' => 'Ascend-Callback-Delay', - 'ascend_owner_ip_addr' => 'Ascend-Owner-IP-Addr', - 'x_ascend_handle_ipx' => 'X-Ascend-Handle-IPX', - 'usr_connect_term_reason' => 'USR-Connect-Term-Reason', - 'x_ascend_multicast_rate_' => 'X-Ascend-Multicast-Rate-Limit', - 'h323_disconnect_time' => 'h323-disconnect-time', - 'acc_ip_gateway_sec' => 'Acc-Ip-Gateway-Sec', - 'usr_number_of_blers' => 'USR-Number-of-Blers', - 'x_ascend_fr_type' => 'X-Ascend-FR-Type', - 'ascend_assign_ip_pool' => 'Ascend-Assign-IP-Pool', - 'ascend_qos_upstream' => 'Ascend-QOS-Upstream', - 'usr_nas_type' => 'USR-NAS-Type', - 'acc_dial_port_index' => 'Acc-Dial-Port-Index', - 'usr_initial_tx_link_data' => 'USR-Initial-Tx-Link-Data-Rate', - 'ascend_fr_type' => 'Ascend-FR-Type', - 'usr_mbi_ct_tdm_time_slot' => 'USR-Mbi_Ct_TDM_Time_Slot', - 'usr_rmmie_pwrlvl_xmit_lv' => 'USR-RMMIE-PwrLvl-Xmit-Lvl', - 'erx_atm_service_category' => 'ERX-Atm-Service-Category', - 'usr_appletalk' => 'USR-Appletalk', - 'usr_send_script1' => 'USR-Send-Script1', - 'usr_send_script2' => 'USR-Send-Script2', - 'usr_send_script3' => 'USR-Send-Script3', - 'usr_ospf_addressless_ind' => 'USR-OSPF-Addressless-Index', - 'acct_input_packets' => 'Acct-Input-Packets', - 'usr_send_script4' => 'USR-Send-Script4', - 'usr_send_script5' => 'USR-Send-Script5', + 'ascend_maximum_time' => 'Ascend-Maximum-Time', + 'annex_callback_portlist' => 'Annex-Callback-Portlist', + 'x_ascend_remove_seconds' => 'X-Ascend-Remove-Seconds', + 'tunnel_server_endpoint' => 'Tunnel-Server-Endpoint', + 'arap_password' => 'ARAP-Password', + 'ms_chap_mppe_keys' => 'MS-CHAP-MPPE-Keys', + 'ascend_source_auth' => 'Ascend-Source-Auth', + 'group' => 'Group', 'usr_send_script6' => 'USR-Send-Script6', - 'usr_service_option' => 'USR-Service-Option', - 'ascend_dropped_octets' => 'Ascend-Dropped-Octets', - 'usr_ip' => 'USR-IP', - 'usr_tunnel_security' => 'USR-Tunnel-Security', + 'le_nat_inmap' => 'LE-NAT-Inmap', + 'chap_password' => 'CHAP-Password', + 'annex_primary_nbns_serve' => 'Annex-Primary-NBNS-Server', + 'annex_receive_speed' => 'Annex-Receive-Speed', + 'usr_rmmie_manufacturer_i' => 'USR-RMMIE-Manufacturer-ID', + 'bind_l2tp_flow_control' => 'Bind_L2TP_Flow_Control', + 'smb_account_ctrl' => 'SMB-Account-CTRL', + 'ascend_calling_id_presen' => 'Ascend-Calling-Id-Presentatn', + 'ascend_ip_pool_chaining' => 'Ascend-IP-Pool-Chaining', + 'le_admin_group' => 'LE-Admin-Group', + 'nas_identifier' => 'NAS-Identifier', + 'x_ascend_history_weigh_t' => 'X-Ascend-History-Weigh-Type', + 'tunnel_connection_id' => 'Tunnel-Connection-Id', + 'nas_real_port' => 'NAS_Real_Port', + 'ms_old_arap_password' => 'MS-Old-ARAP-Password', + 'usr_ip_rip_simple_auth_p' => 'USR-IP-RIP-Simple-Auth-Password', + 'erx_primary_wins' => 'ERX-Primary-Wins', + 'usr_pw_index' => 'USR-PW_Index', + 'erx_cli_allow_all_vr_acc' => 'ERX-Cli-Allow-All-VR-Access', + 'le_ipsec_log_options' => 'LE-IPSec-Log-Options', + 'ascend_home_agent_ip_add' => 'Ascend-Home-Agent-IP-Addr', + 'annex_re_chap_timeout' => 'Annex-Re-CHAP-Timeout', + 'usr_final_tx_link_data_r' => 'USR-Final-Tx-Link-Data-Rate', + 'client_dns_pri' => 'Client_DNS_Pri', + 'usr_primary_nbns_server' => 'USR-Primary_NBNS_Server', + 'usr_cusr_hat_script_rule' => 'USR-CUSR-hat-Script-Rules', + 'ascend_multicast_rate_li' => 'Ascend-Multicast-Rate-Limit', + 'usr_rmmie_pwrlvl_farecho' => 'USR-RMMIE-PwrLvl-FarEcho-Canc', 'acc_acct_on_off_reason' => 'Acc-Acct-On-Off-Reason', - 'shiva_compression_type' => 'Shiva-Compression-Type', - 'ascend_pw_warntime' => 'Ascend-PW-Warntime', - 'usr_security_resp_limit' => 'USR-Security-Resp-Limit', - 'ascend_x25_pad_prompt' => 'Ascend-X25-Pad-Prompt', - 'cisco_asing_ip_pool' => 'Cisco-Asing-IP-Pool', - 'acc_route_policy' => 'Acc-Route-Policy', - 'annex_local_username' => 'Annex-Local-Username', - 'x_ascend_call_by_call' => 'X-Ascend-Call-By-Call', - 'ascend_calling_id_screen' => 'Ascend-Calling-Id-Screening', - 'x_ascend_dhcp_pool_numbe' => 'X-Ascend-DHCP-Pool-Number', - 'nas_port_type' => 'NAS-Port-Type', - 'ascend_route_ip' => 'Ascend-Route-IP', - 'ascend_client_gateway' => 'Ascend-Client-Gateway', - 'ascend_qos_downstream' => 'Ascend-QOS-Downstream', - 'ms_bap_usage' => 'MS-BAP-Usage', - 'usr_vts_session_key' => 'USR-VTS-Session-Key', - 'usr_receive_acc_map' => 'USR-Receive-Acc-Map', - 'ascend_expect_callback' => 'Ascend-Expect-Callback', - 'password' => 'Password', - 'packet_type' => 'Packet-Type', - 'ascend_remote_addr' => 'Ascend-Remote-Addr', - 'ascend_recv_name' => 'Ascend-Recv-Name', - 'ms_acct_eap_type' => 'MS-Acct-EAP-Type', - 'usr_filter_zones' => 'USR-Filter-Zones', - 'annex_output_filter' => 'Annex-Output-Filter', - 'usr_rmmie_rcv_tot_pwrlvl' => 'USR-RMMIE-Rcv-Tot-PwrLvl', - 'usr_mp_mrru' => 'USR-MP-MRRU', - 'ascend_call_filter' => 'Ascend-Call-Filter', - 'usr_keypress_timeout' => 'USR-Keypress-Timeout', - 'usr_modem_setup_time' => 'USR-Modem-Setup-Time', - 'acct_authentic' => 'Acct-Authentic', - 'pppoe_motm' => 'PPPOE_MOTM', - 'x_ascend_expect_callback' => 'X-Ascend-Expect-Callback', - 'erx_atm_scr' => 'ERX-Atm-SCR', - 'erx_address_pool_name' => 'ERX-Address-Pool-Name', - 'challenge_state' => 'Challenge-State', - 'usr_multicast_proxy' => 'USR-Multicast-Proxy', - 'framed_filter_id' => 'Framed-Filter-Id', - 'add_suffix' => 'Add-Suffix', - 'ascend_auth_type' => 'Ascend-Auth-Type', - 'session_timeout' => 'Session-Timeout', - 'ascend_callback' => 'Ascend-Callback', - 'usr_chat_script_name' => 'USR-Chat-Script-Name', - 'port_message' => 'Port-Message', - 'acct_output_packets' => 'Acct-Output-Packets', - 'ascend_session_svr_key' => 'Ascend-Session-Svr-Key', - 'login_tcp_port' => 'Login-TCP-Port', - 'erx_tunnel_password' => 'ERX-Tunnel-Password', - 'shasta_user_privilege' => 'Shasta-User-Privilege', - 'usr_secondary_nbns_serve' => 'USR-Secondary_NBNS_Server', - 'usr_security_login_limit' => 'USR-Security-Login-Limit', - 'usr_start_time' => 'USR-Start-Time', - 'acc_access_partition' => 'Acc-Access-Partition', - 'versanet_termination_cau' => 'Versanet-Termination-Cause', - 'x_ascend_call_block_dura' => 'X-Ascend-Call-Block-Duration', - 'mcast_maxgroups' => 'Mcast_MaxGroups', - 'ascend_user_acct_base' => 'Ascend-User-Acct-Base', - 'usr_vpn_gw_location_id' => 'USR-VPN-GW-Location-Id', - 'usr_block_error_count_li' => 'USR-Block-Error-Count-Limit', - 'ascend_telnet_profile' => 'Ascend-Telnet-Profile', - 'ascend_port_redir_protoc' => 'Ascend-Port-Redir-Protocol', - 'ascend_call_by_call' => 'Ascend-Call-By-Call', - 'usr_disconnect_cause_ind' => 'USR-Disconnect-Cause-Indicator', - 'x_ascend_fr_linkup' => 'X-Ascend-FR-LinkUp', - 'ascend_billing_number' => 'Ascend-Billing-Number', - 'usr_ds0s' => 'USR-DS0s', - 'usr_at_zip_output_filter' => 'USR-AT-Zip-Output-Filter', - 'ascend_user_acct_port' => 'Ascend-User-Acct-Port', - 'login_port' => 'Login-Port', - 'arap_security' => 'ARAP-Security', - 'tunnel_deadtime' => 'Tunnel_Deadtime', - 'ascend_user_acct_time' => 'Ascend-User-Acct-Time', + 'le_multicast_client' => 'LE-Multicast-Client', + 'ascend_send_passwd' => 'Ascend-Send-Passwd', + 'annex_unauthenticated_ti' => 'Annex-Unauthenticated-Time', + 'tunnel_context' => 'Tunnel_Context', + 'acc_nbns_server_sec' => 'Acc-Nbns-Server-Sec', + 'usr_channel_decrement' => 'USR-Channel-Decrement', + 'usr_rmmie_firmware_versi' => 'USR-RMMIE-Firmware-Version', 'ms_chap_challenge' => 'MS-CHAP-Challenge', + 'x_ascend_client_secondar' => 'X-Ascend-Client-Secondary-DNS', + 'ascend_cbcp_mode' => 'Ascend-CBCP-Mode', 'ascend_x25_rpoa' => 'Ascend-X25-Rpoa', - 'login_time' => 'Login-Time', - 'current_time' => 'Current-Time', - 'login_service' => 'Login-Service', - 'ascend_menu_selector' => 'Ascend-Menu-Selector', - 'ascend_bacp_enable' => 'Ascend-BACP-Enable', - 'shiva_link_speed' => 'Shiva-Link-Speed', - 'ascend_private_route_tab' => 'Ascend-Private-Route-Table-ID', - 'x_ascend_session_svr_key' => 'X-Ascend-Session-Svr-Key', - 'ascend_data_filter' => 'Ascend-Data-Filter', - 'ascend_target_util' => 'Ascend-Target-Util', + 'usr_dtr_false_timeout' => 'USR-DTR-False-Timeout', + 'usr_rad_multicast_routin' => 'USR-Rad-Multicast-Routing-Proto', + 'ascend_x25_pad_x3_parame' => 'Ascend-X25-Pad-X3-Parameters', + 'usr_physical_state' => 'USR-Physical-State', + 'ascend_fr_t391' => 'Ascend-FR-T391', + 'bind_dot1q_port' => 'Bind_Dot1q_Port', + 'lac_port_type' => 'LAC_Port_Type', + 'bg_aging_time' => 'BG_Aging_Time', + 'erx_atm_scr' => 'ERX-Atm-SCR', + 'x_ascend_menu_item' => 'X-Ascend-Menu-Item', + 'ascend_x25_pad_banner' => 'Ascend-X25-Pad-Banner', + 'h323_gw_id' => 'h323-gw-id', + 'h323_preferred_lang' => 'h323-preferred-lang', + 'usr_min_compression_size' => 'USR-Min-Compression-Size', + 'usr_compression_type' => 'USR-Compression-Type', + 'x_ascend_call_attempt_li' => 'X-Ascend-Call-Attempt-Limit', + 'ascend_dialout_allowed' => 'Ascend-Dialout-Allowed', + 'annex_local_username' => 'Annex-Local-Username', + 'cisco_pre_input_packets' => 'Cisco-Pre-Input-Packets', + 'ascend_send_secret' => 'Ascend-Send-Secret', 'shiva_function' => 'Shiva-Function', - 'usr_pw_usr_ifilter_ip' => 'USR-PW_USR_IFilter_IP', - 'usr_igmp_routing' => 'USR-IGMP-Routing', - 'acc_tunnel_port' => 'Acc-Tunnel-Port', - 'x_ascend_fr_n391' => 'X-Ascend-FR-N391', - 'medium_type' => 'Medium_Type', - 'annex_domain_name' => 'Annex-Domain-Name', - 'ascend_fr_n391' => 'Ascend-FR-N391', - 'callback_number' => 'Callback-Number', - 'usr_chassis_temperature' => 'USR-Chassis-Temperature', - 'dialback_no' => 'Dialback-No', - 'ms_mppe_recv_key' => 'MS-MPPE-Recv-Key', - 'ascend_ipx_alias' => 'Ascend-IPX-Alias', - 'le_nat_inmap' => 'LE-NAT-Inmap', - 'tunnel_police_rate' => 'Tunnel_Police_Rate', - 'acct_terminate_cause' => 'Acct-Terminate-Cause', - 'le_nat_other_session_tim' => 'LE-NAT-Other-Session-Timeout', - 'usr_ip_rip_output_filter' => 'USR-IP-RIP-Output-Filter', + 'usr_dte_data_idle_timout' => 'USR-DTE-Data-Idle-Timout', + 'usr_number_of_blers' => 'USR-Number-of-Blers', + 'usr_card_type' => 'USR-Card-Type', + 'ascend_token_idle' => 'Ascend-Token-Idle', + 'x_ascend_group' => 'X-Ascend-Group', + 'nt_password' => 'NT-Password', + 'acct_mcast_in_packets' => 'Acct_Mcast_In_Packets', + 'usr_supports_tags' => 'USR-Supports-Tags', + 'ascend_number_sessions' => 'Ascend-Number-Sessions', + 'x_ascend_add_seconds' => 'X-Ascend-Add-Seconds', + 'usr_number_of_upshifts' => 'USR-Number-of-Upshifts', + 'proxy_to_realm' => 'Proxy-To-Realm', + 'acc_callback_num_valid' => 'Acc-Callback-Num-Valid', + 'x_ascend_maximum_channel' => 'X-Ascend-Maximum-Channels', + 'acc_access_community' => 'Acc-Access-Community', + 'x_ascend_fr_direct_profi' => 'X-Ascend-FR-Direct-Profile', + 'usr_send_name' => 'USR-Send-Name', + 'usr_chassis_slot' => 'USR-Chassis-Slot', + 'login_ip_host' => 'Login-IP-Host', + 'ascend_netware_timeout' => 'Ascend-Netware-timeout', + 'vendor_specific' => 'Vendor-Specific', + 'bind_sub_user_at_context' => 'Bind_Sub_User_At_Context', + 'ascend_fr_direct_dlci' => 'Ascend-FR-Direct-DLCI', + 'ascend_atm_fault_managem' => 'Ascend-ATM-Fault-Management', + 'ascend_qos_upstream' => 'Ascend-QOS-Upstream', + 'source_validation' => 'Source_Validation', + 'x_ascend_token_expiry' => 'X-Ascend-Token-Expiry', + 'ascend_dec_channel_count' => 'Ascend-Dec-Channel-Count', + 'usr_local_framed_ip_addr' => 'USR-Local-Framed-IP-Addr', + 'usr_service_option' => 'USR-Service-Option', + 'usr_transmit_acc_map' => 'USR-Transmit-Acc-Map', + 'ascend_fr_direct' => 'Ascend-FR-Direct', + 'x_ascend_expect_callback' => 'X-Ascend-Expect-Callback', + 'acc_ml_damping_factor' => 'Acc-ML-Damping-Factor', + 'framed_netmask' => 'Framed-Netmask', + 'usr_connect_speed' => 'USR-Connect-Speed', + 'ascend_client_primary_wi' => 'Ascend-Client-Primary-WINS', + 'cisco_multilink_id' => 'Cisco-Multilink-ID', + 'bg_span_dis' => 'BG_Span_Dis', + 'ascend_multilink_id' => 'Ascend-Multilink-ID', + 'tunnel_max_tunnels' => 'Tunnel_Max_Tunnels', + 'ascend_dhcp_reply' => 'Ascend-DHCP-Reply', + 'ascend_x25_cug' => 'Ascend-X25-Cug', + 'shiva_network_protocols' => 'Shiva-Network-Protocols', + 'ascend_ara_pw' => 'Ascend-Ara-PW', + 'ip_host_addr' => 'Ip_Host_Addr', + 'le_ip_gateway' => 'LE-IP-Gateway', + 'usr_mobile_numbytes_txed' => 'USR-Mobile-NumBytes-Txed', + 'x_ascend_fr_t392' => 'X-Ascend-FR-T392', + 'cisco_pre_output_packets' => 'Cisco-Pre-Output-Packets', + 'tunnel_group' => 'Tunnel_Group', + 'bind_sub_password' => 'Bind_Sub_Password', + 'eap_message' => 'EAP-Message', 'exec_program' => 'Exec-Program', - 'h323_disconnect_cause' => 'h323-disconnect-cause', - 'usr_chassis_call_channel' => 'USR-Chassis-Call-Channel', - 'x_ascend_fr_dlci' => 'X-Ascend-FR-DLCI', - 'ms_link_drop_time_limit' => 'MS-Link-Drop-Time-Limit', - 'acc_callback_num_valid' => 'Acc-Callback-Num-Valid', - 'cisco_presession_time' => 'Cisco-PreSession-Time', - 'ms_chap_response' => 'MS-CHAP-Response', - 'usr_spoofing' => 'USR-Spoofing', - 'usr_num_fax_pages_proces' => 'USR-Num-Fax-Pages-Processed', - 'ascend_x25_cug' => 'Ascend-X25-Cug', - 'ascend_fr_dlci' => 'Ascend-FR-DLCI', - 'shiva_user_attributes' => 'Shiva-User-Attributes', - 'ms_chap_lm_enc_pw' => 'MS-CHAP-LM-Enc-PW', - 'ascend_transit_number' => 'Ascend-Transit-Number', - 'usr_last_number_dialed_i' => 'USR-Last-Number-Dialed-In-DNIS', - 'usr_ip_saa_filter' => 'USR-IP-SAA-Filter', - 'usr_pw_usr_ifilter_ipx' => 'USR-PW_USR_IFilter_IPX', - 'ascend_remove_seconds' => 'Ascend-Remove-Seconds', - 'le_connect_detail' => 'LE-Connect-Detail', - 'ascend_assign_ip_global_' => 'Ascend-Assign-IP-Global-Pool', - 'proxy_to_realm' => 'Proxy-To-Realm', - 'usr_retrains_requested' => 'USR-Retrains-Requested', - 'h323_remote_address' => 'h323-remote-address', - 'ascend_x25_nui_prompt' => 'Ascend-X25-Nui-Prompt', - 'acc_customer_id' => 'Acc-Customer-Id', - 'ms_chap2_response' => 'MS-CHAP2-Response', - 'ascend_host_info' => 'Ascend-Host-Info', - 'annex_addr_resolution_se' => 'Annex-Addr-Resolution-Servers', - 'x_ascend_multilink_id' => 'X-Ascend-Multilink-ID', - 'login_lat_service' => 'Login-LAT-Service', - 'usr_rmmie_rcv_pwrlvl_330' => 'USR-RMMIE-Rcv-PwrLvl-3300Hz', - 'ascend_event_type' => 'Ascend-Event-Type', - 'ascend_inc_channel_count' => 'Ascend-Inc-Channel-Count', - 'cisco_ppp_async_map' => 'Cisco-PPP-Async-Map', - 'usr_min_compression_size' => 'USR-Min-Compression-Size', - 'ascend_traffic_shaper' => 'Ascend-Traffic-Shaper', - 'ascend_user_acct_key' => 'Ascend-User-Acct-Key', - 'usr_port_tap_output' => 'USR-Port-Tap-Output', - 'ascend_x25_nui' => 'Ascend-X25-Nui', - 'x_ascend_disconnect_caus' => 'X-Ascend-Disconnect-Cause', + 'bg_path_cost' => 'BG_Path_Cost', + 'auth_type' => 'Auth-Type', + 'usr_modem_training_time' => 'USR-Modem-Training-Time', 'ascend_cbcp_enable' => 'Ascend-CBCP-Enable', - 'usr_framed_ip_address_po' => 'USR-Framed_IP_Address_Pool_Name', + 'x_ascend_ipx_route' => 'X-Ascend-IPX-Route', + 'ascend_redirect_number' => 'Ascend-Redirect-Number', + 'h323_credit_time' => 'h323-credit-time', + 'ascend_appletalk_route' => 'Ascend-Appletalk-Route', + 'shiva_link_protocol' => 'Shiva-Link-Protocol', + 'x_ascend_fr_circuit_name' => 'X-Ascend-FR-Circuit-Name', + 'client_id' => 'Client-Id', + 'usr_appletalk' => 'USR-Appletalk', + 'usr_mpip_tunnel_originat' => 'USR-MPIP-Tunnel-Originator', + 'annex_output_filter' => 'Annex-Output-Filter', + 'pvc_circuit_padding' => 'PVC_Circuit_Padding', + 'x_ascend_minimum_channel' => 'X-Ascend-Minimum-Channels', + 'h323_time_and_day' => 'h323-time-and-day', + 'ascend_ipx_header_compre' => 'Ascend-IPX-Header-Compression', + 'termination_action' => 'Termination-Action', + 'x_ascend_modem_portno' => 'X-Ascend-Modem-PortNo', + 'acct_tunnel_packets_lost' => 'Acct-Tunnel-Packets-Lost', + 'framed_filter_id' => 'Framed-Filter-Id', + 'usr_ccp_algorithm' => 'USR-CCP-Algorithm', + 'ascend_token_expiry' => 'Ascend-Token-Expiry', + 'annex_secondary_nbns_ser' => 'Annex-Secondary-NBNS-Server', + 'usr_et_bridge_call_outpu' => 'USR-ET-Bridge-Call-Output-Filte', + 'acc_modem_error_protocol' => 'Acc-Modem-Error-Protocol', + 'acc_request_type' => 'Acc-Request-Type', + 'x_ascend_ipx_peer_mode' => 'X-Ascend-IPX-Peer-Mode', + 'ascend_ppp_vj_slot_comp' => 'Ascend-PPP-VJ-Slot-Comp', + 'cisco_presession_time' => 'Cisco-PreSession-Time', + 'usr_chat_script_name' => 'USR-Chat-Script-Name', + 'ascend_fr_circuit_name' => 'Ascend-FR-Circuit-Name', + 'ascend_expect_callback' => 'Ascend-Expect-Callback', + 'framed_mtu' => 'Framed-MTU', + 'ascend_port_redir_protoc' => 'Ascend-Port-Redir-Protocol', + 'usr_pw_vpn_name' => 'USR-PW_VPN_Name', + 'ascend_nas_port_format' => 'Ascend-NAS-Port-Format', + 'shasta_vpn_name' => 'Shasta-VPN-Name', + 'usr_dtr_true_timeout' => 'USR-DTR-True-Timeout', + 'ascend_third_prompt' => 'Ascend-Third-Prompt', + 'connect_rate' => 'Connect-Rate', + 'usr_block_error_count_li' => 'USR-Block-Error-Count-Limit', + 'called_station_id' => 'Called-Station-Id', + 'usr_pw_cutoff' => 'USR-PW_Cutoff', + 'ascend_data_rate' => 'Ascend-Data-Rate', + 'x_ascend_ts_idle_mode' => 'X-Ascend-TS-Idle-Mode', + 'ascend_x25_pad_prompt' => 'Ascend-X25-Pad-Prompt', + 'x_ascend_dhcp_reply' => 'X-Ascend-DHCP-Reply', + 'acc_nbns_server_pri' => 'Acc-Nbns-Server-Pri', + 'ascend_call_filter' => 'Ascend-Call-Filter', + 'acc_tunnel_secret' => 'Acc-Tunnel-Secret', + 'usr_simplified_v42bis_us' => 'USR-Simplified-V42bis-Usage', + 'bind_int_context' => 'Bind_Int_Context', + 'erx_virtual_router_name' => 'ERX-Virtual-Router-Name', + 'crypt_password' => 'Crypt-Password', + 'challenge_state' => 'Challenge-State', + 'ascend_client_secondary_' => 'Ascend-Client-Secondary-DNS', + 'strip_user_name' => 'Strip-User-Name', + 'x_ascend_user_acct_host' => 'X-Ascend-User-Acct-Host', + 'x_ascend_route_ip' => 'X-Ascend-Route-IP', + 'x_ascend_assign_ip_clien' => 'X-Ascend-Assign-IP-Client', + 'usr_mbi_ct_bchannel_used' => 'USR-Mbi_Ct_BChannel_Used', 'ascend_x25_profile_name' => 'Ascend-X25-Profile-Name', - 'usr_orig_nas_type' => 'USR-Orig-NAS-Type', + 'usr_call_type' => 'USR-Call-Type', + 'x_ascend_user_acct_base' => 'X-Ascend-User-Acct-Base', + 'acct_output_gigawords' => 'Acct-Output-Gigawords', + 'usr_rmmie_firmware_build' => 'USR-RMMIE-Firmware-Build-Date', + 'ascend_fr_link_status_dl' => 'Ascend-FR-Link-Status-DLCI', + 'login_lat_port' => 'Login-LAT-Port', + 'usr_call_arrival_in_gmt' => 'USR-Call-Arrival-in-GMT', + 'acct_mcast_in_octets' => 'Acct_Mcast_In_Octets', + 'erx_sa_validate' => 'ERX-Sa-Validate', + 'ascend_service_type' => 'Ascend-Service-Type', + 'ascend_x25_nui_password_' => 'Ascend-X25-Nui-Password-Prompt', + 'usr_pw_vpn_gateway' => 'USR-PW_VPN_Gateway', + 'ascend_fr_dce_n392' => 'Ascend-FR-DCE-N392', + 'acc_ip_compression' => 'Acc-Ip-Compression', + 'lac_real_port_type' => 'LAC_Real_Port_Type', + 'ascend_if_netmask' => 'Ascend-IF-Netmask', + 'acct_session_start_time' => 'Acct-Session-Start-Time', + 'ms_chap_nt_enc_pw' => 'MS-CHAP-NT-Enc-PW', + 'ascend_port_redir_portnu' => 'Ascend-Port-Redir-Portnum', + 'mcast_maxgroups' => 'Mcast_MaxGroups', + 'x_ascend_home_agent_ip_a' => 'X-Ascend-Home-Agent-IP-Addr', + 'ascend_cache_time' => 'Ascend-Cache-Time', + 'x_ascend_data_svc' => 'X-Ascend-Data-Svc', + 'erx_tunnel_virtual_route' => 'ERX-Tunnel-Virtual-Router', + 'usr_re_chap_timeout' => 'USR-Re-Chap-Timeout', + 'x_ascend_ppp_vj_1172' => 'X-Ascend-PPP-VJ-1172', + 'usr_igmp_routing' => 'USR-IGMP-Routing', + 'h323_prompt_id' => 'h323-prompt-id', + 'le_terminate_detail' => 'LE-Terminate-Detail', + 'acc_ml_clear_threshold' => 'Acc-ML-Clear-Threshold', + 'x_ascend_ip_direct' => 'X-Ascend-IP-Direct', + 'nas_port' => 'NAS-Port', + 'x_ascend_data_rate' => 'X-Ascend-Data-Rate', + 'usr_ip_call_input_filter' => 'USR-IP-Call-Input-Filter', + 'ascend_auth_type' => 'Ascend-Auth-Type', + 'x_ascend_preempt_limit' => 'X-Ascend-Preempt-Limit', + 'h323_credit_amount' => 'h323-credit-amount', + 'usr_reply_script1' => 'USR-Reply-Script1', + 'usr_et_bridge_input_filt' => 'USR-ET-Bridge-Input-Filter', + 'current_time' => 'Current-Time', + 'cisco_xmit_rate' => 'Cisco-Xmit-Rate', + 'ascend_authen_alias' => 'Ascend-Authen-Alias', + 'x_ascend_session_svr_key' => 'X-Ascend-Session-Svr-Key', + 'acc_dialout_auth_mode' => 'Acc-Dialout-Auth-Mode', + 'usr_event_date_time' => 'USR-Event-Date-Time', + 'x_ascend_ipx_node_addr' => 'X-Ascend-IPX-Node-Addr', + 'ascend_primary_home_agen' => 'Ascend-Primary-Home-Agent', + 'x_ascend_user_acct_time' => 'X-Ascend-User-Acct-Time', + 'usr_at_call_output_filte' => 'USR-AT-Call-Output-Filter', 'acc_output_errors' => 'Acc-Output-Errors', - 'h323_redirect_ip_address' => 'h323-redirect-ip-address', - 'usr_ip_call_output_filte' => 'USR-IP-Call-Output-Filter', - 'cisco_avpair' => 'Cisco-AVPair', - 'usr_slot_connected_to' => 'USR-Slot-Connected-To', - 'framed_route' => 'Framed-Route', - 'ascend_global_call_id' => 'Ascend-Global-Call-Id', - 'x_ascend_seconds_of_hist' => 'X-Ascend-Seconds-Of-History', - 'x_ascend_temporary_rtes' => 'X-Ascend-Temporary-Rtes', + 'usr_ipx_rip_output_filte' => 'USR-IPX-RIP-Output-Filter', + 'x_ascend_pri_number_type' => 'X-Ascend-PRI-Number-Type', + 'bind_l2tp_tunnel_name' => 'Bind_L2TP_Tunnel_Name', + 'replicate_to_realm' => 'Replicate-To-Realm', + 'usr_at_zip_input_filter' => 'USR-AT-Zip-Input-Filter', + 'annex_mrru' => 'Annex-MRRU', + 'event_timestamp' => 'Event-Timestamp', + 'ascend_pre_input_packets' => 'Ascend-Pre-Input-Packets', + 'h323_call_origin' => 'h323-call-origin', + 'x_ascend_fr_type' => 'X-Ascend-FR-Type', + 'x_ascend_token_idle' => 'X-Ascend-Token-Idle', + 'usr_igmp_query_interval' => 'USR-IGMP-Query-Interval', + 'ascend_atm_vci' => 'Ascend-ATM-Vci', + 'usr_port_tap_output' => 'USR-Port-Tap-Output', + 'session' => 'Session', + 'ascend_uu_info' => 'Ascend-UU-Info', + 'ms_mppe_recv_key' => 'MS-MPPE-Recv-Key', + 'usr_secondary_dns_server' => 'USR-Secondary_DNS_Server', + 'x_ascend_tunneling_proto' => 'X-Ascend-Tunneling-Protocol', + 'acc_dial_port_index' => 'Acc-Dial-Port-Index', + 'cisco_nas_port' => 'Cisco-NAS-Port', + 'usr_send_script1' => 'USR-Send-Script1', + 'usr_tunnel_security' => 'USR-Tunnel-Security', + 'arap_security' => 'ARAP-Security', + 'tunnel_preference' => 'Tunnel-Preference', + 'usr_reply_script4' => 'USR-Reply-Script4', 'h323_currency_type' => 'h323-currency-type', - 'x_ascend_token_expiry' => 'X-Ascend-Token-Expiry', - 'pvc_encapsulation_type' => 'PVC_Encapsulation_Type', - 'x_ascend_pw_lifetime' => 'X-Ascend-PW-Lifetime', + 'usr_rmmie_status' => 'USR-RMMIE-Status', + 'ascend_shared_profile_en' => 'Ascend-Shared-Profile-Enable', + 'annex_syslog_tap' => 'Annex-Syslog-Tap', + 'usr_send_script4' => 'USR-Send-Script4', + 'acc_clearing_location' => 'Acc-Clearing-Location', + 'annex_disconnect_reason' => 'Annex-Disconnect-Reason', + 'x_ascend_dhcp_maximum_le' => 'X-Ascend-DHCP-Maximum-Leases', + 'usr_at_input_filter' => 'USR-AT-Input-Filter', + 'usr_auth_mode' => 'USR-Auth-Mode', + 'shiva_session_id' => 'Shiva-Session-Id', 'usr_expected_voltage' => 'USR-Expected-Voltage', - 'usr_simplified_v42bis_us' => 'USR-Simplified-V42bis-Usage', - 'shiva_customer_id' => 'Shiva-Customer-Id', - 'usr_compression_algorith' => 'USR-Compression-Algorithm', - 'annex_system_disc_reason' => 'Annex-System-Disc-Reason', - 'annex_secondary_nbns_ser' => 'Annex-Secondary-NBNS-Server', - 'usr_q931_call_reference_' => 'USR-Q931-Call-Reference-Value', - 'usr_send_password' => 'USR-Send-Password', - 'prompt' => 'Prompt', - 'usr_cusr_hat_script_rule' => 'USR-CUSR-hat-Script-Rules', - 'usr_event_id' => 'USR-Event-Id', - 'usr_ccp_algorithm' => 'USR-CCP-Algorithm', - 'usr_mbi_ct_bchannel_used' => 'USR-Mbi_Ct_BChannel_Used', - 'ascend_svc_enabled' => 'Ascend-SVC-Enabled', - 'framed_mtu' => 'Framed-MTU', - 'acc_reason_code' => 'Acc-Reason-Code', - 'bind_l2tp_flow_control' => 'Bind_L2TP_Flow_Control', + 'ascend_owner_ip_addr' => 'Ascend-Owner-IP-Addr', + 'ascend_atm_direct_profil' => 'Ascend-ATM-Direct-Profile', + 'usr_pw_usr_ofilter_ipx' => 'USR-PW_USR_OFilter_IPX', + 'framed_routing' => 'Framed-Routing', + 'pam_auth' => 'Pam-Auth', + 'usr_interface_index' => 'USR-Interface-Index', + 'x_ascend_transit_number' => 'X-Ascend-Transit-Number', + 'usr_end_time' => 'USR-End-Time', + 'x_ascend_assign_ip_pool' => 'X-Ascend-Assign-IP-Pool', + 'ms_secondary_nbns_server' => 'MS-Secondary-NBNS-Server', + 'bind_dot1q_vlan_tag_id' => 'Bind_Dot1q_Vlan_Tag_Id', + 'acct_tunnel_connection' => 'Acct-Tunnel-Connection', + 'tunnel_retransmit' => 'Tunnel_Retransmit', + 'x_ascend_backup' => 'X-Ascend-Backup', + 'usr_bearer_capabilities' => 'USR-Bearer-Capabilities', + 'ascend_calling_id_type_o' => 'Ascend-Calling-Id-Type-Of-Num', + 'shiva_acct_serv_switch' => 'Shiva-Acct-Serv-Switch', + 'ascend_h323_conference_i' => 'Ascend-H323-Conference-Id', + 'acct_authentic' => 'Acct-Authentic', + 'x_ascend_force_56' => 'X-Ascend-Force-56', + 'framed_appletalk_network' => 'Framed-AppleTalk-Network', + 'reply_message' => 'Reply-Message', + 'annex_addr_resolution_pr' => 'Annex-Addr-Resolution-Protocol', + 'class' => 'Class', + 'h323_conf_id' => 'h323-conf-id', 'ascend_cbcp_delay' => 'Ascend-CBCP-Delay', - 'le_ipsec_deny_action' => 'LE-IPSec-Deny-Action', + 'ascend_dropped_octets' => 'Ascend-Dropped-Octets', + 'ascend_h323_dialed_time' => 'Ascend-H323-Dialed-Time', + 'usr_local_ip_address' => 'USR-Local-IP-Address', + 'ascend_x25_x121_address' => 'Ascend-X25-X121-Address', + 'ascend_destination_nas_p' => 'Ascend-Destination-Nas-Port', + 'annex_local_ip_address' => 'Annex-Local-IP-Address', + 'usr_at_output_filter' => 'USR-AT-Output-Filter', + 'cisco_ip_pool_definition' => 'Cisco-IP-Pool-Definition', + 'annex_domain_name' => 'Annex-Domain-Name', + 'ascend_preempt_limit' => 'Ascend-Preempt-Limit', + 'ascend_event_type' => 'Ascend-Event-Type', + 'x_ascend_pre_input_octet' => 'X-Ascend-Pre-Input-Octets', + 'exec_program_wait' => 'Exec-Program-Wait', #NOMENT - 'nomadix_bw_down' => 'Nomadix-Bw-Down', - 'nomadix_bw_up' => 'Nomadix-Bw-Up', 'nomadix_ip_upsell' => 'Nomadix-IP-Upsell', + + #NETC.NET.AU (RADIATOR?) + 'authentication_type' => 'Authentication-Type', + ); 1; -- cgit v1.2.1 From c7b4ef5e2731387e15d369d6561db679ad070cfa Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 26 Sep 2002 05:26:05 +0000 Subject: fix for inserting un-audited accounts --- FS/FS/svc_acct.pm | 84 +++++++++++++++++++++++++++++-------------------------- 1 file changed, 44 insertions(+), 40 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 991bbef48..04a86a8e0 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -338,53 +338,57 @@ sub insert { } my $cust_pkg = $self->cust_svc->cust_pkg; - my $cust_main = $cust_pkg->cust_main; - if ( $conf->exists('emailinvoiceauto') ) { - my @invoicing_list = $cust_main->invoicing_list; - push @invoicing_list, $self->email; - $cust_main->invoicing_list(@invoicing_list); - } + if ( $cust_pkg ) { + my $cust_main = $cust_pkg->cust_main; - #welcome email - my $to = ''; - if ( $welcome_template && $cust_pkg ) { - my $to = join(', ', grep { $_ ne 'POST' } $cust_main->invoicing_list ); - if ( $to ) { - my $wqueue = new FS::queue { - 'svcnum' => $self->svcnum, - 'job' => 'FS::svc_acct::send_email' - }; - warn "attempting to queue email to $to"; - my $error = $wqueue->insert( - 'to' => $to, - 'from' => $welcome_from, - 'subject' => $welcome_subject, - 'mimetype' => $welcome_mimetype, - 'body' => $welcome_template->fill_in( HASH => { - 'username' => $self->username, - 'password' => $self->_password, - 'first' => $cust_main->first, - 'last' => $cust_main->getfield('last'), - 'pkg' => $cust_pkg->part_pkg->pkg, - } ), - ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queuing welcome email: $error"; - } - - foreach my $jobnum ( @jobnums ) { - my $error = $wqueue->depend_insert($jobnum); + if ( $conf->exists('emailinvoiceauto') ) { + my @invoicing_list = $cust_main->invoicing_list; + push @invoicing_list, $self->email; + $cust_main->invoicing_list(\@invoicing_list); + } + + #welcome email + my $to = ''; + if ( $welcome_template && $cust_pkg ) { + my $to = join(', ', grep { $_ ne 'POST' } $cust_main->invoicing_list ); + if ( $to ) { + my $wqueue = new FS::queue { + 'svcnum' => $self->svcnum, + 'job' => 'FS::svc_acct::send_email' + }; + warn "attempting to queue email to $to"; + my $error = $wqueue->insert( + 'to' => $to, + 'from' => $welcome_from, + 'subject' => $welcome_subject, + 'mimetype' => $welcome_mimetype, + 'body' => $welcome_template->fill_in( HASH => { + 'username' => $self->username, + 'password' => $self->_password, + 'first' => $cust_main->first, + 'last' => $cust_main->getfield('last'), + 'pkg' => $cust_pkg->part_pkg->pkg, + } ), + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "queuing welcome email job dependancy: $error"; + return "queuing welcome email: $error"; } + + foreach my $jobnum ( @jobnums ) { + my $error = $wqueue->depend_insert($jobnum); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queuing welcome email job dependancy: $error"; + } + } + } } - - } + + } # if ( $cust_pkg ) $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error @@ -760,7 +764,7 @@ sub check { unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) { unless ( $recref->{slipip} eq '0e0' ) { $recref->{slipip} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/ - or return "Illegal slipip". $self->slipip; + or return "Illegal slipip: ". $self->slipip; $recref->{slipip} = $1; } else { $recref->{slipip} = '0e0'; -- cgit v1.2.1 From e88050711de04bdd33f298d84a35c943bc6dec24 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 27 Sep 2002 05:36:29 +0000 Subject: lock mapsecrets file --- FS/bin/freeside-adduser | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-adduser b/FS/bin/freeside-adduser index 424123226..c3ee05b9b 100644 --- a/FS/bin/freeside-adduser +++ b/FS/bin/freeside-adduser @@ -1,9 +1,10 @@ #!/usr/bin/perl -w # -# $Id: freeside-adduser,v 1.7 2002-08-25 01:16:30 ivan Exp $ +# $Id: freeside-adduser,v 1.8 2002-09-27 05:36:29 ivan Exp $ use strict; use vars qw($opt_h $opt_b $opt_c $opt_s); +use Fcntl qw(:flock); use Getopt::Std; my $FREESIDE_CONF = "/usr/local/etc/freeside"; @@ -24,7 +25,8 @@ if ( $opt_h ) { my $secretfile = $opt_s || 'secrets'; open(MAPSECRETS,">>$FREESIDE_CONF/mapsecrets") - or die "can't open $FREESIDE_CONF/mapsecrets: $!"; + and flock(MAPSECRETS,LOCK_EX) + or die "can't open $FREESIDE_CONF/mapsecrets: $!"; print MAPSECRETS "$user $secretfile\n"; close MAPSECRETS or die "can't close $FREESIDE_CONF/mapsecrets: $!"; -- cgit v1.2.1 From bbcf7a70f3e87872b991cef23fc15ae27a4c6bec Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 27 Sep 2002 12:14:12 +0000 Subject: don't chop blanks --- FS/FS/UID.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm index 6962b2768..ebf9b96e5 100644 --- a/FS/FS/UID.pm +++ b/FS/FS/UID.pm @@ -87,7 +87,7 @@ sub forksuidsetup { getsecrets; $dbh = DBI->connect($datasrc,$db_user,$db_pass, { 'AutoCommit' => 0, - 'ChopBlanks' => 1, + #'ChopBlanks' => 1, } ) or die "DBI->connect error: $DBI::errstr\n"; foreach ( keys %callback ) { @@ -256,7 +256,7 @@ coderef into the hash %FS::UID::callback : =head1 VERSION -$Id: UID.pm,v 1.20 2002-09-20 10:16:28 ivan Exp $ +$Id: UID.pm,v 1.21 2002-09-27 12:14:12 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 70353b6415b4a9b07a78b3f108bc26272d603847 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 27 Sep 2002 12:14:32 +0000 Subject: allow + in md5 encrypted passwords --- FS/FS/svc_acct.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 04a86a8e0..44f3ef45f 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -791,7 +791,7 @@ sub check { #$recref->{password} = $1. # crypt($3,$saltset[int(rand(64))].$saltset[int(rand(64))] #; - } elsif ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([\w\.\/\$\;]{13,34})$/ ) { + } elsif ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([\w\.\/\$\;\+]{13,34})$/ ) { $recref->{_password} = $1.$3; } elsif ( $recref->{_password} eq '*' ) { $recref->{_password} = '*'; -- cgit v1.2.1 From b3c55b5f123b1b5c8ebedfa1826cbf19a0dcc013 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 3 Oct 2002 15:29:14 +0000 Subject: fix implicit RADIUS password attribute to be Crypt-Password for encrypted pw's --- FS/FS/svc_acct.pm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 44f3ef45f..6c0807df2 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -857,7 +857,9 @@ expected to change in the future. sub radius_check { my $self = shift; - ( 'Password' => $self->_password, + my $password = $self->_password; + my $pw_attrib = length($password) <= 12 ? 'Password' : 'Crypt-Password'; + ( $pw_attrib => $password, map { /^(rc_(.*))$/; my($column, $attrib) = ($1, $2); -- cgit v1.2.1 From a47374ae5aba9530e999f630ca5a21eb758cc0b5 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 4 Oct 2002 12:09:21 +0000 Subject: default for customers with no invoices was: print is now: send email to invoice from address --- FS/FS/cust_bill.pm | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index f0667258c..296c8b6a6 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -352,7 +352,11 @@ sub send { my @print_text = $self->print_text('', $template); my @invoicing_list = $self->cust_main->invoicing_list; - if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice + if ( grep { $_ ne 'POST' } @invoicing_list or !@invoicing_list ) { #email + + #better to notify this person than silence + @invoicing_list = ($invoice_from) unless @invoicing_list; + #false laziness w/FS::cust_pay::delete & fs_signup_server && ::realtime_card #$ENV{SMTPHOSTS} = $smtpmachine; $ENV{MAILADDRESS} = $invoice_from; @@ -377,7 +381,7 @@ sub send { } - if ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) { #postal + if ( grep { $_ eq 'POST' } @invoicing_list ) { #postal open(LPR, "|$lpr") or return "Can't open pipe to $lpr: $!"; print LPR @print_text; @@ -1039,7 +1043,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.46 2002-09-21 11:17:39 ivan Exp $ +$Id: cust_bill.pm,v 1.47 2002-10-04 12:09:21 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 2f742fce69ed1d168f95478f36a5e70b381d64a9 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 4 Oct 2002 12:30:19 +0000 Subject: adding --- FS/bin/freeside-count-active-customers | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) create mode 100755 FS/bin/freeside-count-active-customers (limited to 'FS') diff --git a/FS/bin/freeside-count-active-customers b/FS/bin/freeside-count-active-customers new file mode 100755 index 000000000..759085a73 --- /dev/null +++ b/FS/bin/freeside-count-active-customers @@ -0,0 +1,17 @@ +#!/bin/sh + +domain=$1 + +echo "\t +select count(*) from cust_main where + 0 < ( SELECT COUNT(*) FROM cust_pkg + WHERE cust_pkg.custnum = cust_main.custnum + AND ( cust_pkg.cancel IS NULL + OR cust_pkg.cancel = 0 + ) + ) + OR 0 = ( SELECT COUNT(*) FROM cust_pkg + WHERE cust_pkg.custnum = cust_main.custnum + ); +" | psql -U freeside -q $domain | head -1 + -- cgit v1.2.1 From 54a27b35957baddb725e2b7544d9f134989bfd99 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 4 Oct 2002 12:39:29 +0000 Subject: turn on AutoCommit when vacuuming --- FS/bin/freeside-daily | 1 + 1 file changed, 1 insertion(+) (limited to 'FS') diff --git a/FS/bin/freeside-daily b/FS/bin/freeside-daily index 22bf2c963..52028b773 100755 --- a/FS/bin/freeside-daily +++ b/FS/bin/freeside-daily @@ -50,6 +50,7 @@ foreach $cust_main ( @cust_main ) { } if ( driver_name eq 'Pg' ) { + dbh->{AutoCommit} = 1; #so we can vacuum foreach my $statement ( 'vacuum', 'vacuum analyze' ) { my $sth = dbh->prepare($statement) or die dbh->errstr; $sth->execute or die $sth->errstr; -- cgit v1.2.1 From c4d2226e0cc4bdd6d9f689b061b5f4f5b9609b0b Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 4 Oct 2002 12:57:06 +0000 Subject: working on the road: - easier "change package" link for changing one package to another - sqlradius export now compatible with Pg - indices on phone numbers - install instructions specify Pg 7.1 (at least until ILIKE thing is changed) - searching on phone number fragments --- FS/FS/part_export/sqlradius.pm | 8 ++++---- FS/FS/type_pkgs.pm | 15 ++++++++++++++- FS/bin/freeside-setup | 9 ++++++--- 3 files changed, 24 insertions(+), 8 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm index 3c781c043..0f93703ae 100644 --- a/FS/FS/part_export/sqlradius.pm +++ b/FS/FS/part_export/sqlradius.pm @@ -187,10 +187,10 @@ sub sqlradius_insert { #subroutine, not method } else { my $i_sth = $dbh->prepare( - "INSERT INTO rad$table ( id, UserName, Attribute, Value ) ". - "VALUES ( ?, ?, ?, ? )" + "INSERT INTO rad$table ( UserName, Attribute, Value ) ". + "VALUES ( ?, ?, ? )" ) or die $dbh->errstr; - $i_sth->execute( '', $username, $attribute, $attributes{$attribute} ) + $i_sth->execute( $username, $attribute, $attributes{$attribute} ) or die $i_sth->errstr; } @@ -204,7 +204,7 @@ sub sqlradius_usergroup_insert { #subroutine, not method my( $username, @groups ) = @_; my $sth = $dbh->prepare( - "INSERT INTO usergroup ( id, UserName, GroupName ) VALUES ( ?, ?, ? )" + "INSERT INTO usergroup ( UserName, GroupName ) VALUES ( ?, ? )" ) or die $dbh->errstr; foreach my $group ( @groups ) { $sth->execute( '', $username, $group ) diff --git a/FS/FS/type_pkgs.pm b/FS/FS/type_pkgs.pm index 8e0d4ef56..efba60dbd 100644 --- a/FS/FS/type_pkgs.pm +++ b/FS/FS/type_pkgs.pm @@ -94,11 +94,24 @@ sub check { ''; #no error } +=item part_pkg + +Returns the FS::part_pkg object associated with this record. + +=cut + +sub part_pkg { + my $self = shift; + qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } ); +} + +=cut + =back =head1 VERSION -$Id: type_pkgs.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ +$Id: type_pkgs.pm,v 1.2 2002-10-04 12:57:06 ivan Exp $ =head1 BUGS diff --git a/FS/bin/freeside-setup b/FS/bin/freeside-setup index f6a543fc8..d61e8b0bf 100755 --- a/FS/bin/freeside-setup +++ b/FS/bin/freeside-setup @@ -111,8 +111,9 @@ my($dbdef) = new DBIx::DBSchema ( map { my $cust_main = $dbdef->table('cust_main'); unless ($ship) { #remove ship_ from cust_main $cust_main->delcolumn($_) foreach ( grep /^ship_/, $cust_main->columns ); -} else { #add indices on ship_last and ship_company - push @{$cust_main->index->lol_ref}, ( ['ship_last'], ['ship_company'] ) +} else { #add indices + push @{$cust_main->index->lol_ref}, + map { [ "ship_$_" ] } qw( last company daytime night fax ); } #add radius attributes to svc_acct @@ -496,7 +497,9 @@ sub tables_hash_hack { 'primary_key' => 'custnum', 'unique' => [], #'index' => [ ['last'], ['company'] ], - 'index' => [ ['last'], [ 'company' ], [ 'referral_custnum' ] ], + 'index' => [ ['last'], [ 'company' ], [ 'referral_custnum' ], + [ 'daytime' ], [ 'night' ], [ 'fax' ], + ], }, 'cust_main_invoice' => { -- cgit v1.2.1 From 5c0de69821c0145e89403e173986b4d8b5b52725 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 5 Oct 2002 11:14:08 +0000 Subject: fix sqlradius export to not set blank id fields --- FS/FS/part_export/sqlradius.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm index 0f93703ae..ccf9a7687 100644 --- a/FS/FS/part_export/sqlradius.pm +++ b/FS/FS/part_export/sqlradius.pm @@ -207,7 +207,7 @@ sub sqlradius_usergroup_insert { #subroutine, not method "INSERT INTO usergroup ( UserName, GroupName ) VALUES ( ?, ? )" ) or die $dbh->errstr; foreach my $group ( @groups ) { - $sth->execute( '', $username, $group ) + $sth->execute( $username, $group ) or die "can't insert into groupname table: ". $sth->errstr; } $dbh->disconnect; -- cgit v1.2.1 From 656b802d26a8eb0dfd6fd71dbcdebfab156041e9 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 7 Oct 2002 08:47:10 +0000 Subject: cancel when it is *after* expiration date, not when it is *before* --- FS/bin/freeside-daily | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/bin/freeside-daily b/FS/bin/freeside-daily index 52028b773..17ee798ff 100755 --- a/FS/bin/freeside-daily +++ b/FS/bin/freeside-daily @@ -30,7 +30,7 @@ foreach $cust_main ( @cust_main ) { # $^T not $time because -d is for pre-printing invoices foreach my $cust_pkg ( - grep { $_->expire && $_->expire >= $^T } $cust_main->ncancelled_pkgs + grep { $_->expire && $_->expire <= $^T } $cust_main->ncancelled_pkgs ) { my $error = $cust_pkg->cancel; warn "Error cancelling expired pkg ". $cust_pkg->pkgnum. " for custnum ". -- cgit v1.2.1 From b97ccb2b958567490841cfc93d2c4a401d98cdb0 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 8 Oct 2002 04:46:40 +0000 Subject: payby-default config option, with special "HIDE" option to disable billing information in the web interface (closes: Bug#468) --- FS/FS/Conf.pm | 9 +++++++++ 1 file changed, 9 insertions(+) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 788127a7f..1c4ad04a3 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -952,6 +952,15 @@ httemplate/docs/config.html 'select_enum' => [ 'text/plain', 'text/html' ], }, + { + 'key' => 'payby-default', + 'section' => 'UI', + 'description' => 'Default payment type. HIDE disables display of billing information and sets customers to BILL.', + 'type' => 'select', + 'select_enum' => [ '', 'CARD', 'BILL', 'COMP', 'HIDE' ], + }, + + ); 1; -- cgit v1.2.1 From 69f92e8567d1952bc4cbf29d944b97051467bd11 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 8 Oct 2002 08:33:27 +0000 Subject: svc_acct-notes displays static HTML on account view (closes: Bug#465) --- FS/FS/Conf.pm | 6 ++++++ 1 file changed, 6 insertions(+) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 1c4ad04a3..3fdaf218a 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -960,6 +960,12 @@ httemplate/docs/config.html 'select_enum' => [ '', 'CARD', 'BILL', 'COMP', 'HIDE' ], }, + { + 'key' => 'svc_acct-notes', + 'section' => 'UI', + 'description' => 'Extra HTML to be displayed on the Account View screen.', + 'type' => 'textarea', + }, ); -- cgit v1.2.1 From 3fcc6847417cbda9fd027a4286db5e59aea6d901 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 9 Oct 2002 13:07:54 +0000 Subject: radius-password config value to set the attribute used for plaintext pw's --- FS/FS/Conf.pm | 8 ++++++++ FS/FS/svc_acct.pm | 4 +++- 2 files changed, 11 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 3fdaf218a..4dd80c121 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -967,6 +967,14 @@ httemplate/docs/config.html 'type' => 'textarea', }, + { + 'key' => 'raidus-password', + 'section' => 'unclassified', + 'description' => 'RADIUS attribute for plain-text passwords.', + 'type' => 'select', + 'select_enum' => [ 'Password', 'User-Password' ], + }, + ); 1; diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 6c0807df2..b5ade6fac 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -9,6 +9,7 @@ use vars qw( @ISA $noexport_hack $conf $username_uppercase $welcome_template $welcome_from $welcome_subject $welcome_mimetype $smtpmachine + $radius_password $dirhash @saltset @pw_set ); use Carp; @@ -60,6 +61,7 @@ $FS::UID::callback{'FS::svc_acct'} = sub { $welcome_template = ''; } $smtpmachine = $conf->config('smtpmachine'); + $radius_password = $conf->config('radius-password') || 'Password'; }; @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); @@ -858,7 +860,7 @@ expected to change in the future. sub radius_check { my $self = shift; my $password = $self->_password; - my $pw_attrib = length($password) <= 12 ? 'Password' : 'Crypt-Password'; + my $pw_attrib = length($password) <= 12 ? $radius_password : 'Crypt-Password'; ( $pw_attrib => $password, map { /^(rc_(.*))$/; -- cgit v1.2.1 From 229c7bbe00221452e62e81f2e34d8f126fb4b47e Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 9 Oct 2002 13:43:07 +0000 Subject: don't error out trying to create existing directories in vpopmail export --- FS/FS/part_export/vpopmail.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export/vpopmail.pm b/FS/FS/part_export/vpopmail.pm index 561e2742a..2ca44016a 100644 --- a/FS/FS/part_export/vpopmail.pm +++ b/FS/FS/part_export/vpopmail.pm @@ -106,8 +106,8 @@ sub vpopmail_insert { #subroutine, not method close(VPASSWD); for my $mkdir ( - map { "$exportdir/domains/$domain/$username$_" } - ( '', qw( /Maildir /Maildir/cur /Maildir/new /Maildir/tmp ) ) + grep { ! -d $_ } map { "$exportdir/domains/$domain/$username$_" } + ( '', qw( /Maildir /Maildir/cur /Maildir/new /Maildir/tmp ) ) ) { mkdir $mkdir, 0700 or die "can't mkdir $mkdir: $!"; } -- cgit v1.2.1 From e34a817fc92eda8b6f9596b3a925c40bfb7e3887 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 9 Oct 2002 13:59:44 +0000 Subject: don't explicitly specify unclassified config section --- FS/FS/Conf.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 4dd80c121..6d21802c8 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -969,7 +969,7 @@ httemplate/docs/config.html { 'key' => 'raidus-password', - 'section' => 'unclassified', + 'section' => '', 'description' => 'RADIUS attribute for plain-text passwords.', 'type' => 'select', 'select_enum' => [ 'Password', 'User-Password' ], -- cgit v1.2.1 From 0288a8d21086022a4b867aa5a8853bec47171ec2 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 9 Oct 2002 14:30:02 +0000 Subject: nasty typo --- FS/FS/Conf.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 6d21802c8..20e42183b 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -968,7 +968,7 @@ httemplate/docs/config.html }, { - 'key' => 'raidus-password', + 'key' => 'radius-password', 'section' => '', 'description' => 'RADIUS attribute for plain-text passwords.', 'type' => 'select', -- cgit v1.2.1 From eb9d5b215af1fbe867b75c12328126f650f9fb06 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 12 Oct 2002 10:15:55 +0000 Subject: ACH support --- FS/FS/Conf.pm | 4 +-- FS/FS/cust_bill.pm | 73 ++++++++++++++++++++++++++++++++++-------------- FS/FS/cust_main.pm | 20 +++++++++---- FS/FS/cust_pay.pm | 7 +++-- FS/FS/cust_refund.pm | 7 +++-- FS/FS/part_bill_event.pm | 2 +- 6 files changed, 77 insertions(+), 36 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 20e42183b..204d26af3 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -870,7 +870,7 @@ httemplate/docs/config.html 'section' => '', 'description' => 'Acceptable payment types for the signup server', 'type' => 'selectmultiple', - 'select_enum' => [ qw(CARD PREPAY BILL COMP) ], + 'select_enum' => [ qw(CARD CHEK PREPAY BILL COMP) ], }, { @@ -957,7 +957,7 @@ httemplate/docs/config.html 'section' => 'UI', 'description' => 'Default payment type. HIDE disables display of billing information and sets customers to BILL.', 'type' => 'select', - 'select_enum' => [ '', 'CARD', 'BILL', 'COMP', 'HIDE' ], + 'select_enum' => [ '', qw(CARD CHEK BILL COMP HIDE) ], }, { diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 296c8b6a6..e875f5229 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -583,32 +583,48 @@ sub comp { =item realtime_card -Attempts to pay this invoice with a Business::OnlinePayment realtime gateway. -See http://search.cpan.org/search?mode=module&query=Business%3A%3AOnlinePayment -for supproted processors. +Attempts to pay this invoice with a credit card payment via a +Business::OnlinePayment realtime gateway. See +http://search.cpan.org/search?mode=module&query=Business%3A%3AOnlinePayment +for supported processors. =cut sub realtime_card { my $self = shift; + $self->realtime_bop('CC', @_); +} + +=item realtime_ach + +Attempts to pay this invoice with an electronic check (ACH) payment via a +Business::OnlinePayment realtime gateway. See +http://search.cpan.org/search?mode=module&query=Business%3A%3AOnlinePayment +for supported processors. + +=cut + +sub realtime_ach { + my $self = shift; + $self->realtime_bop('ECHECK', @_); +} + +sub realtime_bop { + my $self = shift; + my $method = shift; my $cust_main = $self->cust_main; my $amount = $self->owed; unless ( $processor =~ /^Business::OnlinePayment::(.*)$/ ) { - return "Real-time card processing not enabled (processor $processor)"; + return "Real-time card/ACH processing not enabled (processor $processor)"; } my $bop_processor = $1; #hmm? my $address = $cust_main->address1; $address .= ", ". $cust_main->address2 if $cust_main->address2; - #fix exp. date - #$cust_main->paydate =~ /^(\d+)\/\d*(\d{2})$/; - $cust_main->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; - my $exp = "$2/$1"; - my($payname, $payfirst, $paylast); - if ( $cust_main->payname ) { + if ( $cust_main->payname && $method ne 'ECHECK' ) { $payname = $cust_main->payname; $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/ or do { @@ -646,11 +662,24 @@ sub realtime_card { $description = eval qq("$dtempl"); } + + my %content; + if ( $method eq 'CC' ) { + $content{card_number} = $cust_main->payinfo; + $cust_main->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; + $content{expiration} = "$2/$1"; + } elsif ( $method eq 'ECHECK' ) { + my($account_number,$routing_code) = $cust_main->payinfo + ( $content{account_number}, $content{routing_code} ) = + split('@', $cust_main->payinfo); + $content{bank_name} = $cust_main->payname; + } my $transaction = new Business::OnlinePayment( $bop_processor, @bop_options ); $transaction->content( - 'type' => 'CC', + %content, + 'type' => $method, 'login' => $bop_login, 'password' => $bop_password, 'action' => $action1, @@ -666,8 +695,6 @@ sub realtime_card { 'state' => $cust_main->state, 'zip' => $cust_main->zip, 'country' => $cust_main->country, - 'card_number' => $cust_main->payinfo, - 'expiration' => $exp, 'referer' => 'http://cleanwhisker.420.am/', 'email' => $email, 'phone' => $cust_main->daytime || $cust_main->night, @@ -686,7 +713,8 @@ sub realtime_card { new Business::OnlinePayment( $bop_processor, @bop_options ); my %capture = ( - type => 'CC', + %content, + type => $method, action => $action2, login => $bop_login, password => $bop_password, @@ -694,8 +722,6 @@ sub realtime_card { amount => $amount, authorization => $auth, description => $description, - card_number => $cust_main->payinfo, - expiration => $exp, ); foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code @@ -720,18 +746,23 @@ sub realtime_card { if ( $transaction->is_success() ) { + my %method2payby = ( + 'CC' => 'CARD', + 'ECHECK' => 'CHEK', + ); + my $cust_pay = new FS::cust_pay ( { 'invnum' => $self->invnum, 'paid' => $amount, '_date' => '', - 'payby' => 'CARD', + 'payby' => method2payby{$method}, 'payinfo' => $cust_main->payinfo, 'paybatch' => "$processor:". $transaction->authorization, } ); my $error = $cust_pay->insert; if ( $error ) { # gah, even with transactions. - my $e = 'WARNING: Card debited but database not updated - '. + my $e = 'WARNING: Card/ACH debited but database not updated - '. 'error applying payment, invnum #' . $self->invnum. " ($processor): $error"; warn $e; @@ -766,7 +797,7 @@ sub realtime_card { "Sender: $invoice_from", "Reply-To: $invoice_from", "Date: ". time2str("%a, %d %b %Y %X %z", time), - "Subject: Your credit card could not be processed", + "Subject: Your payment could not be processed", ] ); my $message = new Mail::Internet ( 'Header' => $header, @@ -838,7 +869,7 @@ sub print_text { # my $invnum = $self->invnum; my $cust_main = qsearchs('cust_main', { 'custnum', $self->custnum } ); $cust_main->payname( $cust_main->first. ' '. $cust_main->getfield('last') ) - unless $cust_main->payname; + unless $cust_main->payname && $cust_main->payby ne 'CHEK'; my( $pr_total, @pr_cust_bill ) = $self->previous; #previous balance # my( $cr_total, @cr_cust_credit ) = $self->cust_credit; #credits @@ -1043,7 +1074,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.47 2002-10-04 12:09:21 ivan Exp $ +$Id: cust_bill.pm,v 1.48 2002-10-12 10:15:55 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 2701ac35d..d6e4bc1e3 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -158,7 +158,7 @@ FS::Record. The following fields are currently supported: =item ship_fax - phone (optional) -=item payby - `CARD' (credit cards), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see L and sets billing type to BILL) +=item payby - `CARD' (credit cards), `CHEK' (electronic check), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see L and sets billing type to BILL) =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L) @@ -482,9 +482,9 @@ sub replace { $self->invoicing_list( $invoicing_list ); } - if ( $self->payby eq 'CARD' && + if ( $self->payby =~ /^(CARD|CHEK)$/ && grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) { - # card info has changed, want to retry realtime_card invoice events + # card/check info has changed, want to retry realtime_card invoice events #false laziness w/collect foreach my $cust_bill_event ( grep { @@ -664,7 +664,7 @@ sub check { } } - $self->payby =~ /^(CARD|BILL|COMP|PREPAY)$/ + $self->payby =~ /^(CARD|CHEK|BILL|COMP|PREPAY)$/ or return "Illegal payby: ". $self->payby; $self->payby($1); @@ -681,6 +681,14 @@ sub check { return gettext('unknown_card_type') if cardtype($self->payinfo) eq "Unknown"; + } elsif ( $self->payby eq 'CHEK' ) { + + my $payinfo = $self->payinfo; + $payinfo =~ s/[\D\@]//g; + $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba'; + $payinfo = "$1\@$2"; + $self->payinfo($payinfo); + } elsif ( $self->payby eq 'BILL' ) { $error = $self->ut_textn('payinfo'); @@ -705,7 +713,7 @@ sub check { if ( $self->paydate eq '' || $self->paydate eq '-' ) { return "Expriation date required" - unless $self->payby eq 'BILL' || $self->payby eq 'PREPAY'; + unless $self->payby =~ /^(BILL|PREPAY|CHEK)$/; $self->paydate(''); } else { $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ @@ -717,7 +725,7 @@ sub check { if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) ); } - if ( $self->payname eq '' && + if ( $self->payname eq '' && $self->payby ne 'CHEK' && ( ! $conf->exists('require_cardname') || $self->payby ne 'CARD' ) ) { $self->payname( $self->first. " ". $self->getfield('last') ); } else { diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index 98eba704b..222691408 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -60,7 +60,8 @@ currently supported: =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 payby - `CARD' (credit cards), `CHEK' (electronic check/ACH), +`BILL' (billing), or `COMP' (free) =item payinfo - card number, check #, or comp issuer (4-8 lowercase alphanumerics; think username), respectively @@ -346,7 +347,7 @@ sub check { $self->_date(time) unless $self->_date; - $self->payby =~ /^(CARD|BILL|COMP)$/ or return "Illegal payby"; + $self->payby =~ /^(CARD|CHEK|BILL|COMP)$/ or return "Illegal payby"; $self->payby($1); #false laziness with cust_refund::check @@ -405,7 +406,7 @@ sub unapplied { =head1 VERSION -$Id: cust_pay.pm,v 1.21 2002-06-04 14:35:52 ivan Exp $ +$Id: cust_pay.pm,v 1.22 2002-10-12 10:15:55 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_refund.pm b/FS/FS/cust_refund.pm index 8fe6876d3..aac320e61 100644 --- a/FS/FS/cust_refund.pm +++ b/FS/FS/cust_refund.pm @@ -47,7 +47,8 @@ inherits from FS::Record. The following fields are currently supported: =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 payby - `CARD' (credit cards), `CHEK' (electronic check/ACH), +`BILL' (billing), or `COMP' (free) =item payinfo - card number, P.O.#, or comp issuer (4-8 lowercase alphanumerics; think username) @@ -234,7 +235,7 @@ sub check { unless $self->crednum || qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); - $self->payby =~ /^(CARD|BILL|COMP)$/ or return "Illegal payby"; + $self->payby =~ /^(CARD|CHEK|BILL|COMP)$/ or return "Illegal payby"; $self->payby($1); #false laziness with cust_pay::check @@ -266,7 +267,7 @@ sub check { =head1 VERSION -$Id: cust_refund.pm,v 1.18 2002-02-19 03:22:39 jeff Exp $ +$Id: cust_refund.pm,v 1.19 2002-10-12 10:15:55 ivan Exp $ =head1 BUGS diff --git a/FS/FS/part_bill_event.pm b/FS/FS/part_bill_event.pm index a31b09b36..991616bb8 100644 --- a/FS/FS/part_bill_event.pm +++ b/FS/FS/part_bill_event.pm @@ -124,7 +124,7 @@ sub check { $c =~ /^\s*\$cust_main\->(suspend|cancel|invoicing_list_addpost|bill|collect)\(\);\s*("";)?\s*$/ - or $c =~ /^\s*\$cust_bill\->(comp|realtime_card|realtime_card_cybercash|batch_card|send)\(\);\s*$/ + or $c =~ /^\s*\$cust_bill\->(comp|realtime_card|realtime_ach|realtime_card_cybercash|batch_card|send)\(\);\s*$/ or $c =~ /^\s*\$cust_bill\->send\(\'\w+\'\);\s*$/ -- cgit v1.2.1 From 6f8a6c416174bcf8095c959085d14ba820425aad Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 12 Oct 2002 13:26:46 +0000 Subject: sqlradacct_hour price plan to charge per-hour against an external radacct table --- FS/FS/cust_pkg.pm | 41 ++++++++++++++++++++++++-- FS/FS/cust_svc.pm | 87 ++++++++++++++++++++++++++++++++++++++++++++++++++++++- FS/FS/svc_acct.pm | 27 +++++++++++++++-- 3 files changed, 150 insertions(+), 5 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 0c71435e1..b16d08137 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -475,7 +475,7 @@ sub cust_main { =item seconds_since TIMESTAMP Returns the number of seconds all accounts (see L) in this -package have been online since TIMESTAMP. +package have been online since TIMESTAMP, according to the session monitor. TIMESTAMP is specified as a UNIX timestamp; see L. Also see L and L for conversion functions. @@ -496,6 +496,43 @@ sub seconds_since { } +=item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END DATASRC DB_USERNAME DB_PASSWORD + +Returns the numbers of seconds all accounts (see L) in this +package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END +(exclusive), according to an external SQL radacct table, such as those +generated by ICRADIUS or FreeRADIUS. Sessions which started in the specified +range but are still open are counted from session start to the end of the +range. Also, sessions which end in the range but started earlier are counted +from the start of the range to session end. Finally, sessions which start +before the range but end after (or are still open) are counted for the entire +range. + +TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see +L. Also see L and L for conversion +functions. + + +=cut + +sub seconds_since_sqlradacct { + my($self, $start, $end, $datasrc, $db_user, $db_pass) = @_; + + my $dbh = DBI->connect($datasrc, $db_user, $db_pass) + or die "can't connect to $datasrc: ". $DBI::errstr; + + my $seconds = 0; + + foreach my $cust_svc ( + grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc + ) { + $seconds += $cust_svc->seconds_since_sqlradacct($start, $end, $dbh); + } + + $seconds; + +} + =back =head1 SUBROUTINES @@ -678,7 +715,7 @@ sub order { =head1 VERSION -$Id: cust_pkg.pm,v 1.24 2002-09-17 09:19:06 ivan Exp $ +$Id: cust_pkg.pm,v 1.25 2002-10-12 13:26:45 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index 9d510b38a..4fc663450 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -336,11 +336,93 @@ sub seconds_since { $sth->fetchrow_arrayref->[0]; } +=item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ( DBI_DATABASE_HANDLE | DATASRC DB_USERNAME DB_PASSWORD ) + +See L. Equivalent to +$cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records +where B is not "svc_acct". + +NOTE: specifying a DATASRC/USERNAME/PASSWORD instead of a DBI database handle +is not yet implemented. + +=cut + +#note: implementation here, POD in FS::svc_acct +sub seconds_since_sqlradacct { + my($self, $start, $end, $dbh) = @_; + + my $username = $self->svc_x->username; + + #select a unix time conversion function based on database type + my $str2time; + if ( $dbh->{Driver}->{Name} eq 'mysql' ) { + $str2time = 'UNIX_TIMESTAMP('; + } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) { + $str2time = 'EXTRACT( EPOCH FROM '; + } else { + warn "warning: unknown database type ". $dbh->{Driver}->{Name}. + "; guessing how to convert to UNIX timestamps"; + $str2time = 'extract(epoch from '; + } + + #find sessions completely within the given range + my $sth = $dbh->prepare("SELECT SUM(acctsessiontime) + FROM radacct + WHERE UserName = ? + AND $str2time AcctStartTime) >= ? + AND $str2time AcctStopTime ) < ? + AND AcctStopTime =! 0 + AND AcctStopTime IS NOT NULL" + ) or die $dbh->errstr; + $sth->execute($username, $start, $end) or die $sth->errstr; + my $regular = $sth->fetchrow_arrayref->[0]; + + #find open sessions which start in the range, count session start->range end + $sth = $dbh->prepare("SELECT SUM( ? - $str2time AcctStartTime ) ) + FROM radacct + WHERE UserName = ? + AND AcctStartTime >= ? + AND ( AcctStopTime = 0 + OR AcctStopTime IS NULL )" + ) or die $dbh->errstr; + $sth->execute($end, $username, $start) or die $sth->errstr; + my $start_during = $sth->fetchrow_arrayref->[0]; + + #find closed sessions which start before the range but stop during, + #count range start->session end + $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? ) + FROM radacct + WHERE UserName = ? + AND AcctStartTime < ? + AND AcctStopTime >= ? + AND AcctStopTime < ? + AND AcctStopTime != 0 + AND AcctStopTime IS NOT NULL" + ) or die $dbh->errstr; + $sth->execute($start, $username, $start, $start, $end ) or die $sth->errstr; + my $end_during = $sth->fetchrow_arrayref->[0]; + + #find closed or open sessions which start before the range but stop + # after, or are still open, count range start->range end + $sth = $dbh->prepare("SELECT COUNT(*) + FROM radacct + WHERE UserName = ? + AND AcctStartTime < ? + AND ( AcctStopTime >= ? + OR AcctStopTime = 0 + OR AcctStopTime IS NULL )" + ) or die $dbh->errstr; + $sth->execute($username, $start, $end ) or die $sth->errstr; + my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0]; + + $regular + $end_during + $start_during + $entire_range; +} + =back =head1 VERSION -$Id: cust_svc.pm,v 1.17 2002-09-18 22:39:01 ivan Exp $ +$Id: cust_svc.pm,v 1.18 2002-10-12 13:26:45 ivan Exp $ =head1 BUGS @@ -352,6 +434,9 @@ pkg_svc records are not checked in general (here). Deleting this record doesn't check or delete the svc_* record associated with this record. +In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of +a DBI database handle is not yet implemented. + =head1 SEE ALSO L, L, L, L, diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index b5ade6fac..3afee7f64 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -921,8 +921,8 @@ sub email { =item seconds_since TIMESTAMP -Returns the number of seconds this account has been online since TIMESTAMP. -See L +Returns the number of seconds this account has been online since TIMESTAMP, +according to the session monitor (see L). TIMESTAMP is specified as a UNIX timestamp; see L. Also see L and L for conversion functions. @@ -935,6 +935,29 @@ sub seconds_since { $self->cust_svc->seconds_since(@_); } +=item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END DATASRC DB_USERNAME DB_PASSWORD + +Returns the numbers of seconds this account has been online between +TIMESTAMP_START (inclusive) and TIMESTAMP_END (exclusive), according to an +external SQL radacct table, such as those generated by ICRADIUS or FreeRADIUS. +Sessions which started in the specified range but are still open are counted +from session start to the end of the range. Also, sessions which end in the +range but started earlier are counted from the start of the range to session +end. Finally, sessions which start before the range but end after (or are +still open) are counted for the entire range. + +TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see +L. Also see L and L for conversion +functions. + +=cut + +#note: POD here, implementation in FS::cust_svc +sub seconds_since_sqlradacct { + my $self = shift; + $self->cust_svc->seconds_since_sqlradacct(@_); +} + =item radius_groups Returns all RADIUS groups for this account (see L). -- cgit v1.2.1 From ec8b028d52fea91a4f970c0be377eaccde682997 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 13 Oct 2002 01:05:29 +0000 Subject: bug fix in new ACH code --- FS/FS/cust_bill.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index e875f5229..bdd60dbe0 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -669,7 +669,7 @@ sub realtime_bop { $cust_main->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; $content{expiration} = "$2/$1"; } elsif ( $method eq 'ECHECK' ) { - my($account_number,$routing_code) = $cust_main->payinfo + my($account_number,$routing_code) = $cust_main->payinfo; ( $content{account_number}, $content{routing_code} ) = split('@', $cust_main->payinfo); $content{bank_name} = $cust_main->payname; @@ -1074,7 +1074,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.48 2002-10-12 10:15:55 ivan Exp $ +$Id: cust_bill.pm,v 1.49 2002-10-13 01:05:29 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 80b9d734807f0358403c47dfa3d86fb80f75cdd0 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 13 Oct 2002 01:14:34 +0000 Subject: change ILIKE into LOWER() for compatibility with non-Pg and Pg before 7.1 --- FS/FS/Record.pm | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index a23f37a62..ebcbbb497 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -208,34 +208,40 @@ sub qsearch { $statement .= ' WHERE '. join(' AND ', map { my $op = '='; + my $column = $_; if ( ref($record->{$_}) ) { $op = $record->{$_}{'op'} if $record->{$_}{'op'}; - $op = 'LIKE' if $op =~ /^ILIKE$/i && driver_name ne 'Pg'; + #$op = 'LIKE' if $op =~ /^ILIKE$/i && driver_name ne 'Pg'; + if ( uc($op) eq 'ILIKE' ) { + $op = 'LIKE'; + $record->{$_}{'value'} = lc($record->{$_}{'value'}); + $column = "LOWER($_)"; + } $record->{$_} = $record->{$_}{'value'} } if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) { if ( $op eq '=' ) { if ( driver_name eq 'Pg' ) { - qq-( $_ IS NULL OR $_ = '' )-; + qq-( $column IS NULL OR $column = '' )-; } else { - qq-( $_ IS NULL OR $_ = "" )-; + qq-( $column IS NULL OR $column = "" )-; } } elsif ( $op eq '!=' ) { if ( driver_name eq 'Pg' ) { - qq-( $_ IS NOT NULL AND $_ != '' )-; + qq-( $column IS NOT NULL AND $column != '' )-; } else { - qq-( $_ IS NOT NULL AND $_ != "" )-; + qq-( $column IS NOT NULL AND $column != "" )-; } } else { if ( driver_name eq 'Pg' ) { - qq-( $_ $op '' )-; + qq-( $column $op '' )-; } else { - qq-( $_ $op "" )-; + qq-( $column $op "" )-; } } } else { - "$_ $op ?"; + "$column $op ?"; } } @fields ); } -- cgit v1.2.1 From 7bb23c47594c1111aecb5fe8fdb2042e509cca86 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 14 Oct 2002 06:17:14 +0000 Subject: fix sql radacct billing --- FS/FS/cust_pkg.pm | 19 +++++++++++++++++-- 1 file changed, 17 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index b16d08137..803fa3c16 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -9,6 +9,7 @@ use FS::part_pkg; use FS::cust_main; use FS::type_pkgs; use FS::pkg_svc; +use FS::cust_bill_pkg; # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend, # setup } @@ -90,7 +91,7 @@ inherits from FS::Record. The following fields are currently supported: =item setup - date -=item bill - date +=item bill - date (next bill date) =item susp - date @@ -418,6 +419,20 @@ sub unsuspend { ''; #no errors } +=item last_bill + +Returns the last bill date, or if there is no last bill date, the setup date. +Useful for billing metered services. + +=cut + +sub last_bill { + my $self = shift; + my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum, + 'edate' => $self->bill, } ); + $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0; +} + =item part_pkg Returns the definition for this billing item, as an FS::part_pkg object (see @@ -715,7 +730,7 @@ sub order { =head1 VERSION -$Id: cust_pkg.pm,v 1.25 2002-10-12 13:26:45 ivan Exp $ +$Id: cust_pkg.pm,v 1.26 2002-10-14 06:17:14 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From ab6a6774557598dc7cdfc57c941a4bf48f3bb64a Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 14 Oct 2002 07:30:30 +0000 Subject: svc-acct-alldomains config file allows selection of accounts from any domain --- FS/FS/Conf.pm | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 204d26af3..c4d1a39d2 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -975,6 +975,13 @@ httemplate/docs/config.html 'select_enum' => [ 'Password', 'User-Password' ], }, + { + 'key' => 'svc_acct-alldomains', + 'section' => '', + 'description' => 'Allow accounts to select any domain in the database. Normally accounts can only select from the domain set in the service definition and those purchased by the customer.', + 'type' => 'bool', + }, + ); 1; -- cgit v1.2.1 From 196f70d25dc9dda5c765ab534734c307644dee0c Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 14 Oct 2002 07:44:50 +0000 Subject: s/bool/checkbox/ --- FS/FS/Conf.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index c4d1a39d2..cf874aa35 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -979,7 +979,7 @@ httemplate/docs/config.html 'key' => 'svc_acct-alldomains', 'section' => '', 'description' => 'Allow accounts to select any domain in the database. Normally accounts can only select from the domain set in the service definition and those purchased by the customer.', - 'type' => 'bool', + 'type' => 'checkbox', }, ); -- cgit v1.2.1 From 88d237b8fe396b4e85a16e20eccfeb4e22e94e24 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 15 Oct 2002 09:54:24 +0000 Subject: ach fix s/ECHECK/CHECK/ --- FS/FS/cust_bill.pm | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index bdd60dbe0..54641ee35 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -606,7 +606,7 @@ for supported processors. sub realtime_ach { my $self = shift; - $self->realtime_bop('ECHECK', @_); + $self->realtime_bop('CHECK', @_); } sub realtime_bop { @@ -624,7 +624,7 @@ sub realtime_bop { $address .= ", ". $cust_main->address2 if $cust_main->address2; my($payname, $payfirst, $paylast); - if ( $cust_main->payname && $method ne 'ECHECK' ) { + if ( $cust_main->payname && $method ne 'CHECK' ) { $payname = $cust_main->payname; $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/ or do { @@ -668,7 +668,7 @@ sub realtime_bop { $content{card_number} = $cust_main->payinfo; $cust_main->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; $content{expiration} = "$2/$1"; - } elsif ( $method eq 'ECHECK' ) { + } elsif ( $method eq 'CHECK' ) { my($account_number,$routing_code) = $cust_main->payinfo; ( $content{account_number}, $content{routing_code} ) = split('@', $cust_main->payinfo); @@ -747,8 +747,8 @@ sub realtime_bop { if ( $transaction->is_success() ) { my %method2payby = ( - 'CC' => 'CARD', - 'ECHECK' => 'CHEK', + 'CC' => 'CARD', + 'CHECK' => 'CHEK', ); my $cust_pay = new FS::cust_pay ( { @@ -1074,7 +1074,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.49 2002-10-13 01:05:29 ivan Exp $ +$Id: cust_bill.pm,v 1.50 2002-10-15 09:54:24 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From acfb0f48c226a5cba64fbe391677391128a6cbf7 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 17 Oct 2002 14:16:17 +0000 Subject: radacct update: use sqlradius for datasrc, not plandata options (whew) --- FS/FS/cust_pkg.pm | 19 ++----- FS/FS/cust_svc.pm | 150 ++++++++++++++++++++++++++++++------------------------ FS/FS/part_svc.pm | 15 +++--- FS/FS/svc_acct.pm | 15 +++--- 4 files changed, 105 insertions(+), 94 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 803fa3c16..55ee37d9d 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -511,17 +511,11 @@ sub seconds_since { } -=item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END DATASRC DB_USERNAME DB_PASSWORD +=item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END Returns the numbers of seconds all accounts (see L) in this package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END -(exclusive), according to an external SQL radacct table, such as those -generated by ICRADIUS or FreeRADIUS. Sessions which started in the specified -range but are still open are counted from session start to the end of the -range. Also, sessions which end in the range but started earlier are counted -from the start of the range to session end. Finally, sessions which start -before the range but end after (or are still open) are counted for the entire -range. +(exclusive). TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see L. Also see L and L for conversion @@ -531,17 +525,14 @@ functions. =cut sub seconds_since_sqlradacct { - my($self, $start, $end, $datasrc, $db_user, $db_pass) = @_; - - my $dbh = DBI->connect($datasrc, $db_user, $db_pass) - or die "can't connect to $datasrc: ". $DBI::errstr; + my($self, $start, $end) = @_; my $seconds = 0; foreach my $cust_svc ( grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc ) { - $seconds += $cust_svc->seconds_since_sqlradacct($start, $end, $dbh); + $seconds += $cust_svc->seconds_since_sqlradacct($start, $end); } $seconds; @@ -730,7 +721,7 @@ sub order { =head1 VERSION -$Id: cust_pkg.pm,v 1.26 2002-10-14 06:17:14 ivan Exp $ +$Id: cust_pkg.pm,v 1.27 2002-10-17 14:16:17 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index 4fc663450..50d94452a 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -12,6 +12,7 @@ use FS::svc_acct; use FS::svc_domain; use FS::svc_forward; use FS::domain_record; +use FS::part_export; @ISA = qw( FS::Record ); @@ -336,93 +337,110 @@ sub seconds_since { $sth->fetchrow_arrayref->[0]; } -=item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ( DBI_DATABASE_HANDLE | DATASRC DB_USERNAME DB_PASSWORD ) +=item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END See L. Equivalent to $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records where B is not "svc_acct". -NOTE: specifying a DATASRC/USERNAME/PASSWORD instead of a DBI database handle -is not yet implemented. - =cut #note: implementation here, POD in FS::svc_acct sub seconds_since_sqlradacct { - my($self, $start, $end, $dbh) = @_; + my($self, $start, $end) = @_; my $username = $self->svc_x->username; - #select a unix time conversion function based on database type - my $str2time; - if ( $dbh->{Driver}->{Name} eq 'mysql' ) { - $str2time = 'UNIX_TIMESTAMP('; - } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) { - $str2time = 'EXTRACT( EPOCH FROM '; - } else { - warn "warning: unknown database type ". $dbh->{Driver}->{Name}. - "; guessing how to convert to UNIX timestamps"; - $str2time = 'extract(epoch from '; + my @part_export = $self->part_svc->part_export('sqlradius') + or die "no sqlradius export configured for this service type"; + #or return undef; + + my $seconds = 0; + foreach my $part_export ( @part_export ) { + + my $dbh = DBI->connect( map { $part_export->option($_) } + qw(datasrc username password) ) + or die "can't connect to sqlradius database: ". $DBI::errstr; + + #select a unix time conversion function based on database type + my $str2time; + if ( $dbh->{Driver}->{Name} eq 'mysql' ) { + $str2time = 'UNIX_TIMESTAMP('; + } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) { + $str2time = 'EXTRACT( EPOCH FROM '; + } else { + warn "warning: unknown database type ". $dbh->{Driver}->{Name}. + "; guessing how to convert to UNIX timestamps"; + $str2time = 'extract(epoch from '; + } + + #find closed sessions completely within the given range + my $sth = $dbh->prepare("SELECT SUM(acctsessiontime) + FROM radacct + WHERE UserName = ? + AND $str2time AcctStartTime) >= ? + AND $str2time AcctStopTime ) < ? + AND AcctStopTime =! 0 + AND AcctStopTime IS NOT NULL" + ) or die $dbh->errstr; + $sth->execute($username, $start, $end) or die $sth->errstr; + my $regular = $sth->fetchrow_arrayref->[0]; + + #find open sessions which start in the range, count session start->range end + # don't count them if they are over 1 day old (probably missing stop record) + $sth = $dbh->prepare("SELECT SUM( ? - $str2time AcctStartTime ) ) + FROM radacct + WHERE UserName = ? + AND $str2time AcctStartTime ) >= ? + AND ( ? - $str2time AcctStartTime ) < 86400 + AND ( AcctStopTime = 0 + OR AcctStopTime IS NULL )" + ) or die $dbh->errstr; + $sth->execute($end, $username, $start, $end) or die $sth->errstr; + my $start_during = $sth->fetchrow_arrayref->[0]; + + #find closed sessions which start before the range but stop during, + #count range start->session end + $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? ) + FROM radacct + WHERE UserName = ? + AND $str2time AcctStartTime ) < ? + AND $str2time AcctStopTime ) >= ? + AND $str2time AcctStopTime ) < ? + AND AcctStopTime != 0 + AND AcctStopTime IS NOT NULL" + ) or die $dbh->errstr; + $sth->execute($start, $username, $start, $start, $end ) or die $sth->errstr; + my $end_during = $sth->fetchrow_arrayref->[0]; + + #find closed (not anymore - or open) sessions which start before the range + # but stop # after, or are still open, count range start->range end + # don't count open sessions (probably missing stop record) + $sth = $dbh->prepare("SELECT COUNT(*) + FROM radacct + WHERE UserName = ? + AND $str2time AcctStartTime ) < ? + AND ( $str2time AcctStopTime ) >= ? + )" + # OR AcctStopTime = 0 + # OR AcctStopTime IS NULL )" + ) or die $dbh->errstr; + $sth->execute($username, $start, $end ) or die $sth->errstr; + my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0]; + + $seconds += $regular + $end_during + $start_during + $entire_range; + } - #find sessions completely within the given range - my $sth = $dbh->prepare("SELECT SUM(acctsessiontime) - FROM radacct - WHERE UserName = ? - AND $str2time AcctStartTime) >= ? - AND $str2time AcctStopTime ) < ? - AND AcctStopTime =! 0 - AND AcctStopTime IS NOT NULL" - ) or die $dbh->errstr; - $sth->execute($username, $start, $end) or die $sth->errstr; - my $regular = $sth->fetchrow_arrayref->[0]; - - #find open sessions which start in the range, count session start->range end - $sth = $dbh->prepare("SELECT SUM( ? - $str2time AcctStartTime ) ) - FROM radacct - WHERE UserName = ? - AND AcctStartTime >= ? - AND ( AcctStopTime = 0 - OR AcctStopTime IS NULL )" - ) or die $dbh->errstr; - $sth->execute($end, $username, $start) or die $sth->errstr; - my $start_during = $sth->fetchrow_arrayref->[0]; - - #find closed sessions which start before the range but stop during, - #count range start->session end - $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? ) - FROM radacct - WHERE UserName = ? - AND AcctStartTime < ? - AND AcctStopTime >= ? - AND AcctStopTime < ? - AND AcctStopTime != 0 - AND AcctStopTime IS NOT NULL" - ) or die $dbh->errstr; - $sth->execute($start, $username, $start, $start, $end ) or die $sth->errstr; - my $end_during = $sth->fetchrow_arrayref->[0]; - - #find closed or open sessions which start before the range but stop - # after, or are still open, count range start->range end - $sth = $dbh->prepare("SELECT COUNT(*) - FROM radacct - WHERE UserName = ? - AND AcctStartTime < ? - AND ( AcctStopTime >= ? - OR AcctStopTime = 0 - OR AcctStopTime IS NULL )" - ) or die $dbh->errstr; - $sth->execute($username, $start, $end ) or die $sth->errstr; - my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0]; + $seconds; - $regular + $end_during + $start_during + $entire_range; } =back =head1 VERSION -$Id: cust_svc.pm,v 1.18 2002-10-12 13:26:45 ivan Exp $ +$Id: cust_svc.pm,v 1.19 2002-10-17 14:16:17 ivan Exp $ =head1 BUGS diff --git a/FS/FS/part_svc.pm b/FS/FS/part_svc.pm index 7c6acdbcd..06c15ed2a 100644 --- a/FS/FS/part_svc.pm +++ b/FS/FS/part_svc.pm @@ -286,22 +286,23 @@ sub all_part_svc_column { qsearch('part_svc_column', { 'svcpart' => $self->svcpart } ); } -=item part_export +=item part_export [ EXPORTTYPE ] + +Returns all exports (see L) for this service, or, if an +export type is specified, only returns exports of the given type. =cut sub part_export { my $self = shift; - map { qsearchs('part_export', { 'exportnum' => $_->exportnum } ) } + my %search; + $search{'exporttype'} = shift if @_; + map { qsearchs('part_export', { 'exportnum' => $_->exportnum, %search } ) } qsearch('export_svc', { 'svcpart' => $self->svcpart } ); } =back -=head1 VERSION - -$Id: part_svc.pm,v 1.14 2002-09-17 09:19:06 ivan Exp $ - =head1 BUGS Delete is unimplemented. @@ -309,7 +310,7 @@ Delete is unimplemented. The list of svc_* tables is hardcoded. When svc_acct_pop is renamed, this should be fixed. -all_part_svc_column and part_export methods should be documented +all_part_svc_column method should be documented =head1 SEE ALSO diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 3afee7f64..c41c30602 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -935,16 +935,17 @@ sub seconds_since { $self->cust_svc->seconds_since(@_); } -=item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END DATASRC DB_USERNAME DB_PASSWORD +=item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END Returns the numbers of seconds this account has been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END (exclusive), according to an -external SQL radacct table, such as those generated by ICRADIUS or FreeRADIUS. -Sessions which started in the specified range but are still open are counted -from session start to the end of the range. Also, sessions which end in the -range but started earlier are counted from the start of the range to session -end. Finally, sessions which start before the range but end after (or are -still open) are counted for the entire range. +external SQL radacct table, specified via sqlradius export. Sessions which +started in the specified range but are still open are counted from session +start to the end of the range (unless they are over 1 day old, in which case +they are presumed missing their stop record and not counted). Also, sessions +which end in therange but started earlier are counted from the start of the +range to session end. Finally, sessions which start before the range but end +after are counted for the entire range. TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see L. Also see L and L for conversion -- cgit v1.2.1 From dbcf3603c7929de3a0f2011d6516b996541e93fa Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 17 Oct 2002 14:37:58 +0000 Subject: fix sqlradacct calculations for old Pg --- FS/FS/cust_svc.pm | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index 50d94452a..bed6a0ab3 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -380,7 +380,7 @@ sub seconds_since_sqlradacct { WHERE UserName = ? AND $str2time AcctStartTime) >= ? AND $str2time AcctStopTime ) < ? - AND AcctStopTime =! 0 + AND $str2time AcctStopTime ) =! 0 AND AcctStopTime IS NOT NULL" ) or die $dbh->errstr; $sth->execute($username, $start, $end) or die $sth->errstr; @@ -393,7 +393,7 @@ sub seconds_since_sqlradacct { WHERE UserName = ? AND $str2time AcctStartTime ) >= ? AND ( ? - $str2time AcctStartTime ) < 86400 - AND ( AcctStopTime = 0 + AND ( $str2time AcctStopTime ) = 0 OR AcctStopTime IS NULL )" ) or die $dbh->errstr; $sth->execute($end, $username, $start, $end) or die $sth->errstr; @@ -407,7 +407,7 @@ sub seconds_since_sqlradacct { AND $str2time AcctStartTime ) < ? AND $str2time AcctStopTime ) >= ? AND $str2time AcctStopTime ) < ? - AND AcctStopTime != 0 + AND $str2time AcctStopTime ) != 0 AND AcctStopTime IS NOT NULL" ) or die $dbh->errstr; $sth->execute($start, $username, $start, $start, $end ) or die $sth->errstr; @@ -438,10 +438,6 @@ sub seconds_since_sqlradacct { =back -=head1 VERSION - -$Id: cust_svc.pm,v 1.19 2002-10-17 14:16:17 ivan Exp $ - =head1 BUGS Behaviour of changing the svcpart of cust_svc records is undefined and should -- cgit v1.2.1 From ee083facc9f4e18f27df07f829b224366483a56e Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 17 Oct 2002 14:46:04 +0000 Subject: really fix sqlradacct for old Pg --- FS/FS/cust_svc.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index bed6a0ab3..6ce12cbe9 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -380,7 +380,7 @@ sub seconds_since_sqlradacct { WHERE UserName = ? AND $str2time AcctStartTime) >= ? AND $str2time AcctStopTime ) < ? - AND $str2time AcctStopTime ) =! 0 + AND $str2time AcctStopTime ) > 0 AND AcctStopTime IS NOT NULL" ) or die $dbh->errstr; $sth->execute($username, $start, $end) or die $sth->errstr; @@ -407,7 +407,7 @@ sub seconds_since_sqlradacct { AND $str2time AcctStartTime ) < ? AND $str2time AcctStopTime ) >= ? AND $str2time AcctStopTime ) < ? - AND $str2time AcctStopTime ) != 0 + AND $str2time AcctStopTime ) > 0 AND AcctStopTime IS NOT NULL" ) or die $dbh->errstr; $sth->execute($start, $username, $start, $start, $end ) or die $sth->errstr; -- cgit v1.2.1 From 23bc7fbb197d8dc58ddab651c49f825324044614 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 17 Oct 2002 14:50:11 +0000 Subject: *sigh* better debugging --- FS/FS/cust_svc.pm | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index 6ce12cbe9..d6ed7ee6b 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -373,6 +373,8 @@ sub seconds_since_sqlradacct { "; guessing how to convert to UNIX timestamps"; $str2time = 'extract(epoch from '; } + + my $query; #find closed sessions completely within the given range my $sth = $dbh->prepare("SELECT SUM(acctsessiontime) @@ -387,16 +389,16 @@ sub seconds_since_sqlradacct { my $regular = $sth->fetchrow_arrayref->[0]; #find open sessions which start in the range, count session start->range end - # don't count them if they are over 1 day old (probably missing stop record) - $sth = $dbh->prepare("SELECT SUM( ? - $str2time AcctStartTime ) ) - FROM radacct - WHERE UserName = ? - AND $str2time AcctStartTime ) >= ? - AND ( ? - $str2time AcctStartTime ) < 86400 - AND ( $str2time AcctStopTime ) = 0 - OR AcctStopTime IS NULL )" - ) or die $dbh->errstr; - $sth->execute($end, $username, $start, $end) or die $sth->errstr; + $query = "SELECT SUM( ? - $str2time AcctStartTime ) ) + FROM radacct + WHERE UserName = ? + AND $str2time AcctStartTime ) >= ? + AND ( ? - $str2time AcctStartTime ) < 86400 + AND ( $str2time AcctStopTime ) = 0 + OR AcctStopTime IS NULL )"; + $sth = $dbh->prepare($query) or die $dbh->errstr; + $sth->execute($end, $username, $start, $end) + or die $sth->errstr. " executing query $query"; my $start_during = $sth->fetchrow_arrayref->[0]; #find closed sessions which start before the range but stop during, -- cgit v1.2.1 From d6ebf4c35d7c7b7d559828bfac3744c770dbf3eb Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 17 Oct 2002 14:59:29 +0000 Subject: yay missing paren --- FS/FS/cust_svc.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index d6ed7ee6b..211b0ad23 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -393,7 +393,7 @@ sub seconds_since_sqlradacct { FROM radacct WHERE UserName = ? AND $str2time AcctStartTime ) >= ? - AND ( ? - $str2time AcctStartTime ) < 86400 + AND ( ? - $str2time AcctStartTime ) ) < 86400 AND ( $str2time AcctStopTime ) = 0 OR AcctStopTime IS NULL )"; $sth = $dbh->prepare($query) or die $dbh->errstr; -- cgit v1.2.1 From 94fb4aafeae9abf099a8a4ee87b72de86c812ce0 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 18 Oct 2002 10:28:46 +0000 Subject: adding --- FS/MANIFEST | 3 ++ FS/bin/freeside-radgroup | 76 ++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 79 insertions(+) create mode 100644 FS/bin/freeside-radgroup (limited to 'FS') diff --git a/FS/MANIFEST b/FS/MANIFEST index 24fef1748..e37216e19 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -17,7 +17,10 @@ bin/freeside-deluser bin/freeside-setup bin/freeside-setinvoice bin/freeside-overdue +bin/freeside-radgroup bin/freeside-receivables-report +bin/freeside-sqlradius-radacctd +bin/freeside-sqlradius-reset bin/freeside-tax-report bin/freeside-cc-receipts-report bin/freeside-credit-report diff --git a/FS/bin/freeside-radgroup b/FS/bin/freeside-radgroup new file mode 100644 index 000000000..e1a819788 --- /dev/null +++ b/FS/bin/freeside-radgroup @@ -0,0 +1,76 @@ +#!/usr/bin/perl -w + +use strict; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch); +use FS::cust_svc; +use FS::svc_acct; + +&untaint_argv; #what it sounds like (eww) + +my($user, $action, $groupname, $svcpart) = @ARGV; + +adminsuidsetup $user; + +my @svc_acct = map { $_->svc_x } qsearch('cust_svc', { svcpart => $svcpart } ); + +if ( lc($action) eq 'add' ) { + foreach my $svc_acct ( @svc_acct ) { + my @groups = $svc_acct->radius_groups; + next if grep { $_ eq $groupname } @groups; + push @groups, $groupname; + my %hash = $svc_acct->hash; + $hash{radius_groups} = \@groups; + my $new = new FS::svc_acct \%hash; + my $error = $new->replace($svc_acct); + die $error if $error; + } +} else { + die &usage; +} + +# subroutines + +sub untaint_argv { + foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV + $ARGV[$_] =~ /^(.*)$/ || die "Illegal arguement \"$ARGV[$_]\""; + $ARGV[$_]=$1; + } +} + +sub usage { + die "Usage:\n\n freeside-radgroup user action groupname svcpart\n"; +} + +=head1 NAME + +freeside-radgroup - Command line utility to manipulate radius groups + +=head1 SYNOPSIS + + freeside-addgroup user action groupname svcpart + +=head1 DESCRIPTION + + B is a freeside user as added with freeside-adduser. + + B is the action to take. Available actions are: I + + B is the group to add (or remove, etc.) + + B specifies which accounts will be updated. + +=head1 EXAMPLES + +freeside-radgroup freesideuser add groupname 3 + +Adds I to all accounts with service definition 3. + +=head1 BUGS + +=head1 SEE ALSO + +L, L, L + +=cut + -- cgit v1.2.1 From b75341fcfedbdcb2d39c6616690a1d59e4b233fc Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 18 Oct 2002 13:23:27 +0000 Subject: don't re-insert non-changed usernames to fuzzy cache --- FS/FS/svc_acct.pm | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index c41c30602..b33f3ae29 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -562,18 +562,19 @@ sub replace { return $error if $error; } - #false laziness with sub insert (and cust_main) - my $queue = new FS::queue { - 'svcnum' => $new->svcnum, - 'job' => 'FS::svc_acct::append_fuzzyfiles' - }; - $error = $queue->insert($new->username); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; + if ( $new->username ne $old->username ) { + #false laziness with sub insert (and cust_main) + my $queue = new FS::queue { + 'svcnum' => $new->svcnum, + 'job' => 'FS::svc_acct::append_fuzzyfiles' + }; + $error = $queue->insert($new->username); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } } - $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error } -- cgit v1.2.1 From 9b1a8ec900ec1f5cd7d1f622f49066510c8f547c Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 18 Oct 2002 13:28:03 +0000 Subject: argh --- FS/bin/freeside-radgroup | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/bin/freeside-radgroup b/FS/bin/freeside-radgroup index e1a819788..ed85626d2 100644 --- a/FS/bin/freeside-radgroup +++ b/FS/bin/freeside-radgroup @@ -20,7 +20,7 @@ if ( lc($action) eq 'add' ) { next if grep { $_ eq $groupname } @groups; push @groups, $groupname; my %hash = $svc_acct->hash; - $hash{radius_groups} = \@groups; + $hash{usergroup} = \@groups; my $new = new FS::svc_acct \%hash; my $error = $new->replace($svc_acct); die $error if $error; -- cgit v1.2.1 From e6f6f496883b8e8be42f4d92f01b61dbc2c590be Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 20 Oct 2002 03:28:23 +0000 Subject: vpopmail restart export option --- FS/FS/part_export.pm | 3 +++ FS/FS/part_export/vpopmail.pm | 29 ++++++++++++++++++----------- 2 files changed, 21 insertions(+), 11 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 1b402e014..c9ae41fc1 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -643,6 +643,9 @@ tie my %vpopmail_options, 'Tie::IxHash', 'dir' => { label=>'directory', }, # ?more info? default? 'uid' => { label=>'vpopmail uid' }, 'gid' => { label=>'vpopmail gid' }, + 'restart' => { label=> 'vpopmail restart command', + default=> 'cd /home/vpopmail/domains; for domain in *; do /home/vpopmail/bin/vmkpasswd $domain; done; /var/qmail/bin/qmail-newu; killall -HUP qmail-send', + }, ; tie my %bind_options, 'Tie::IxHash', diff --git a/FS/FS/part_export/vpopmail.pm b/FS/FS/part_export/vpopmail.pm index 2ca44016a..bddf175ee 100644 --- a/FS/FS/part_export/vpopmail.pm +++ b/FS/FS/part_export/vpopmail.pm @@ -19,6 +19,7 @@ sub _export_insert { crypt($svc_acct->_password,$saltset[int(rand(64))].$saltset[int(rand(64))]), $svc_acct->domain, $svc_acct->quota, + $svc_acct->finger, ); } @@ -46,7 +47,7 @@ sub _export_replace { return '' unless $old->_password ne $new->_password; $self->vpopmail_queue( $new->svcnum, 'replace', - $new->username, $cpassword, $new->domain, $new->quota ); + $new->username, $cpassword, $new->domain, $new->quota, $new->finger ); } sub _export_delete { @@ -77,13 +78,14 @@ sub vpopmail_queue { $self->option('dir'), $self->option('uid'), $self->option('gid'), + $self->option('restart'), @_ ); } sub vpopmail_insert { #subroutine, not method - my( $exportdir, $machine, $dir, $uid, $gid ) = splice @_,0,5; - my( $username, $password, $domain, $quota ) = @_; + my( $exportdir, $machine, $dir, $uid, $gid, $restart ) = splice @_,0,6; + my( $username, $password, $domain, $quota, $finger ) = @_; mkdir "$exportdir/domains/$domain", 0700 or die $! unless -d "$exportdir/domains/$domain"; @@ -112,13 +114,13 @@ sub vpopmail_insert { #subroutine, not method mkdir $mkdir, 0700 or die "can't mkdir $mkdir: $!"; } - vpopmail_sync( $exportdir, $machine, $dir, $uid, $gid ); + vpopmail_sync( $exportdir, $machine, $dir, $uid, $gid, $restart ); } sub vpopmail_replace { #subroutine, not method - my( $exportdir, $machine, $dir, $uid, $gid ) = splice @_,0,5; - my( $username, $password, $domain ) = @_; + my( $exportdir, $machine, $dir, $uid, $gid, $restart ) = splice @_,0,6; + my( $username, $password, $domain, $quota, $finger ) = @_; (open(VPASSWD, "$exportdir/domains/$domain/vpasswd") and flock(VPASSWD,LOCK_EX) @@ -140,7 +142,7 @@ sub vpopmail_replace { #subroutine, not method '1', '0', $finger, - $dir, + "$dir/domains/$domain/$username", #$vdir $quota ? $quota.'S' : 'NOQUOTA', ), "\n"; } @@ -153,12 +155,12 @@ sub vpopmail_replace { #subroutine, not method flock(VPASSWD,LOCK_UN); close(VPASSWD); - vpopmail_sync( $exportdir, $machine, $dir, $uid, $gid ); + vpopmail_sync( $exportdir, $machine, $dir, $uid, $gid, $restart ); } sub vpopmail_delete { #subroutine, not method - my( $exportdir, $machine, $dir, $uid, $gid ) = splice @_,0,5; + my( $exportdir, $machine, $dir, $uid, $gid, $restart ) = splice @_,0,6; my( $username, $domain ) = @_; (open(VPASSWD, "$exportdir/domains/$domain/vpasswd") @@ -185,11 +187,11 @@ sub vpopmail_delete { #subroutine, not method rmtree "$exportdir/domains/$domain/$username" or die "can't rmtree $exportdir/domains/$domain/$username: $!"; - vpopmail_sync( $exportdir, $machine, $dir, $uid, $gid ); + vpopmail_sync( $exportdir, $machine, $dir, $uid, $gid, $restart ); } sub vpopmail_sync { - my( $exportdir, $machine, $dir, $uid, $gid ) = splice @_,0,5; + my( $exportdir, $machine, $dir, $uid, $gid, $restart ) = splice @_,0,6; chdir $exportdir; # my @args = ( $rsync, "-rlpt", "-e", $ssh, "domains/", @@ -214,6 +216,11 @@ sub vpopmail_sync { 'STDERR: '. join(" / ", $rsync->err). ', '. 'STDOUT: '. join(" / ", $rsync->out); } + + eval "use Net::SSH;"; + die $@ if $@; + + ssh("vpopmail\@$machine", $restart); } -- cgit v1.2.1 From e31feacedbd07e333183b83360d20d21bcb611bd Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 20 Oct 2002 07:26:54 +0000 Subject: don't run restart command unless there is one --- FS/FS/part_export/vpopmail.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export/vpopmail.pm b/FS/FS/part_export/vpopmail.pm index bddf175ee..646af44cd 100644 --- a/FS/FS/part_export/vpopmail.pm +++ b/FS/FS/part_export/vpopmail.pm @@ -220,7 +220,7 @@ sub vpopmail_sync { eval "use Net::SSH;"; die $@ if $@; - ssh("vpopmail\@$machine", $restart); + ssh("vpopmail\@$machine", $restart) if $restart; } -- cgit v1.2.1 From d927a8b53105cb9b715f6d6f430e3bfee3fcfd95 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 20 Oct 2002 08:27:52 +0000 Subject: enable shellcommands suspension/unsuspension hooks --- FS/FS/part_export.pm | 24 ++++++++++++++++++++++++ FS/FS/part_export/shellcommands.pm | 10 ++++++++++ 2 files changed, 34 insertions(+) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index c9ae41fc1..5d725ab22 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -552,6 +552,18 @@ tie my %shellcommands_options, 'Tie::IxHash', type =>'textarea', default=>'', }, + 'suspend' => { label=>'Suspension command', + default=>'', + }, + 'suspend_stdin' => { label=>'Suspension command STDIN', + default=>'', + }, + 'unsuspend' => { label=>'Unsuspension command', + default=>'', + }, + 'unsuspend_stdin' => { label=>'Unsuspension command STDIN', + default=>'', + }, ; tie my %shellcommands_withdomain_options, 'Tie::IxHash', @@ -577,6 +589,18 @@ tie my %shellcommands_withdomain_options, 'Tie::IxHash', type =>'textarea', #default=>"$_password\n$_password\n", }, + 'suspend' => { label=>'Suspension command', + default=>'', + }, + 'suspend_stdin' => { label=>'Suspension command STDIN', + default=>'', + }, + 'unsuspend' => { label=>'Unsuspension command', + default=>'', + }, + 'unsuspend_stdin' => { label=>'Unsuspension command STDIN', + default=>'', + }, ; tie my %www_shellcommands_options, 'Tie::IxHash', diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm index a514f9375..da6f4c46c 100644 --- a/FS/FS/part_export/shellcommands.pm +++ b/FS/FS/part_export/shellcommands.pm @@ -20,6 +20,16 @@ sub _export_delete { $self->_export_command('userdel', @_); } +sub _export_suspend { + my($self) = shift; + $self->_export_command('suspend', @_); +} + +sub _export_unsuspend { + my($self) = shift; + $self->_export_command('unsuspend', @_); +} + sub _export_command { my ( $self, $action, $svc_acct) = (shift, shift, shift); my $command = $self->option($action); -- cgit v1.2.1 From 28a584bc4a0ea3e868871cf1e2471e6412bfb3f3 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 22 Oct 2002 08:13:06 +0000 Subject: ACH fixes from s5 --- FS/FS/part_bill_event.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_bill_event.pm b/FS/FS/part_bill_event.pm index 991616bb8..e86b5c1fb 100644 --- a/FS/FS/part_bill_event.pm +++ b/FS/FS/part_bill_event.pm @@ -37,7 +37,7 @@ FS::Record. The following fields are currently supported: =item eventpart - primary key -=item payby - CARD, BILL, or COMP +=item payby - CARD, CHEK, BILL, or COMP =item event - event name @@ -140,7 +140,7 @@ sub check { } my $error = $self->ut_numbern('eventpart') - || $self->ut_enum('payby', [qw( CARD BILL COMP )] ) + || $self->ut_enum('payby', [qw( CARD CHEK BILL COMP )] ) || $self->ut_text('event') || $self->ut_anything('eventcode') || $self->ut_number('seconds') -- cgit v1.2.1 From b7440710b9bca319aba4d2782b8fdcf076abe2b7 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 22 Oct 2002 09:15:59 +0000 Subject: bugfix in vpopmail restart --- FS/FS/part_export/vpopmail.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export/vpopmail.pm b/FS/FS/part_export/vpopmail.pm index 646af44cd..a505a0f47 100644 --- a/FS/FS/part_export/vpopmail.pm +++ b/FS/FS/part_export/vpopmail.pm @@ -217,7 +217,7 @@ sub vpopmail_sync { 'STDOUT: '. join(" / ", $rsync->out); } - eval "use Net::SSH;"; + eval "use Net::SSH qw(ssh);"; die $@ if $@; ssh("vpopmail\@$machine", $restart) if $restart; -- cgit v1.2.1 From 9f96bd19b87cb0084dda17da070f3bb5dadd4823 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 23 Oct 2002 15:49:44 +0000 Subject: add option to unapply payments --- FS/FS/Conf.pm | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index cf874aa35..b3fffe327 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -317,6 +317,13 @@ httemplate/docs/config.html 'type' => [qw( checkbox text )], }, + { + 'key' => 'unapplypayments', + 'section' => 'UI', + 'description' => 'Enable "unapplication" of unclosed payments.', + 'type' => 'checkbox', + }, + { 'key' => 'dirhash', 'section' => 'shell', -- cgit v1.2.1 From 1583472a6afefb1ad33e05656fd206674f37d9df Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 23 Oct 2002 17:07:59 +0000 Subject: database dump & scp support --- FS/FS/Conf.pm | 7 +++++++ FS/bin/freeside-daily | 19 ++++++++++++++++++- 2 files changed, 25 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index b3fffe327..c007a501a 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -989,6 +989,13 @@ httemplate/docs/config.html 'type' => 'checkbox', }, + { + 'key' => 'dump-scpdest', + 'section' => '', + 'description' => 'destination for scp database dumps: user@host:/path', + 'type' => 'text', + }, + ); 1; diff --git a/FS/bin/freeside-daily b/FS/bin/freeside-daily index 17ee798ff..1db786120 100755 --- a/FS/bin/freeside-daily +++ b/FS/bin/freeside-daily @@ -4,8 +4,9 @@ use strict; use Fcntl qw(:flock); use Date::Parse; use Getopt::Std; -use FS::UID qw(adminsuidsetup driver_name dbh); +use FS::UID qw(adminsuidsetup driver_name dbh datasrc); use FS::Record qw(qsearch qsearchs); +use FS::Conf; use FS::cust_main; &untaint_argv; #what it sounds like (eww) @@ -57,6 +58,22 @@ if ( driver_name eq 'Pg' ) { } } +#local hack +my $conf = new FS::Conf; +my $dest = $conf->config('dump-scpdest'); +if ( $dest ) { + datasrc =~ /dbname=([\w\.]+)$/ or die "unparsable datasrc ". datasrc; + my $database = $1; + eval "use Net::SCP qw(scp);"; + if ( driver_name eq 'Pg' ) { + system("pg_dump $database >/var/tmp/$database.sql") + } else { + die "database dumps not yet supported for ". driver_name; + } + scp("/var/tmp/$database.sql", $dest); + unlink "/var/tmp/$database.sql" or die $!; +} + # subroutines sub untaint_argv { -- cgit v1.2.1 From 3702269ee9f6a63572f6e915ace56d70b5080033 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 25 Oct 2002 21:24:55 +0000 Subject: make $old_domain available too --- FS/FS/part_export/shellcommands.pm | 1 + 1 file changed, 1 insertion(+) (limited to 'FS') diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm index da6f4c46c..04e5041c3 100644 --- a/FS/FS/part_export/shellcommands.pm +++ b/FS/FS/part_export/shellcommands.pm @@ -65,6 +65,7 @@ sub _export_replace { } $new_finger = shell_quote $new_finger; $quoted_new__password = shell_quote $new__password; + $old_domain = $old->domain; $new_domain = $new->domain; $new_crypt_password = ''; #surpress "used only once" warnings $new_crypt_password = crypt( $new->_password, -- cgit v1.2.1 From 749cce349c6801e6d75834065197c3aceddda599 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 28 Oct 2002 13:22:45 +0000 Subject: signal-less queued child handling (closes: Bug#477) --- FS/bin/freeside-queued | 21 +++++++++++++++++---- 1 file changed, 17 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-queued b/FS/bin/freeside-queued index 311fe62f9..6ea27c05f 100644 --- a/FS/bin/freeside-queued +++ b/FS/bin/freeside-queued @@ -1,10 +1,10 @@ #!/usr/bin/perl -w use strict; -use vars qw( $log_file $sigterm $sigint $kids $max_kids ); +use vars qw( $log_file $sigterm $sigint $kids $max_kids %kids ); use subs qw( _die _logmsg ); use Fcntl qw(:flock); -use POSIX qw(setsid); +use POSIX qw(:sys_wait_h setsid); use Date::Format; use IO::File; use FS::UID qw(adminsuidsetup forksuidsetup driver_name dbh); @@ -28,8 +28,8 @@ my $pid_file = "/var/run/freeside-queued.pid"; &daemonize1; -sub REAPER { my $pid = wait; $SIG{CHLD} = \&REAPER; $kids--; } -$SIG{CHLD} = \&REAPER; +#sub REAPER { my $pid = wait; $SIG{CHLD} = \&REAPER; $kids--; } +#$SIG{CHLD} = \&REAPER; $sigterm = 0; $sigint = 0; @@ -65,9 +65,11 @@ warn "freeside-queued starting\n"; my $warnkids=0; while (1) { + &reap_kids; #prevent runaway forking if ( $kids >= $max_kids ) { warn "WARNING: maximum $kids children reached\n" unless $warnkids++; + &reap_kids; sleep 1; #waiting for signals is cheap next; } @@ -131,6 +133,7 @@ while (1) { if ( $pid ) { $kids++; + $kids{$pid} = 1; } else { #kid time #get new db handle @@ -230,6 +233,16 @@ sub daemonize2 { open STDERR, '>&STDOUT' or die "Can't dup stdout: $!"; } +sub reap_kids { + foreach my $pid ( keys %kids ) { + my $kid = waitpid($pid, WNOHANG); + if ( $kid > 0 ) { + $kids--; + delete $kids{$kid}; + } + } +} + =head1 NAME freeside-queued - Job queue daemon -- cgit v1.2.1 From baaa14867224a536143b843ff33787f74d1c5032 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 4 Nov 2002 23:40:55 +0000 Subject: balance on small_custview --- FS/FS/CGI.pm | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'FS') diff --git a/FS/FS/CGI.pm b/FS/FS/CGI.pm index d69aad2fc..86d20f6cb 100644 --- a/FS/FS/CGI.pm +++ b/FS/FS/CGI.pm @@ -322,6 +322,10 @@ sub small_custview { $html .= ''; + $html .= '
Balance: $'. $cust_main->balance. '
'; + + # last payment might be good here too? + $html; } -- cgit v1.2.1 From fc3b6024fcf0bf0394e6239639cbe31786b0cad8 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 5 Nov 2002 20:29:57 +0000 Subject: lost? --- FS/bin/freeside-sqlradius-radacctd | 180 +++++++++++++++++++++++++++++++++++++ 1 file changed, 180 insertions(+) create mode 100644 FS/bin/freeside-sqlradius-radacctd (limited to 'FS') diff --git a/FS/bin/freeside-sqlradius-radacctd b/FS/bin/freeside-sqlradius-radacctd new file mode 100644 index 000000000..4e8d57c51 --- /dev/null +++ b/FS/bin/freeside-sqlradius-radacctd @@ -0,0 +1,180 @@ +#!/usr/bin/perl -Tw + +use strict; +use vars qw( $log_file $sigterm $sigint ); +use subs qw( _die _logmsg ); +use Fcntl qw(:flock); +use POSIX qw(setsid); +use Date::Format; +use IO::File; +use FS::UID qw(adminsuidsetup); +#use FS::Record qw(qsearch qsearchs); +#use FS::part_export; +#use FS::svc_acct; +#use FS::cust_svc; + +#lots of false laziness w/freeside-queued + +my $user = shift or die &usage; + +#my $pid_file = "/var/run/freeside-sqlradius-radacctd.$user.pid"; +my $pid_file = "/var/run/freeside-sqlradius-radacctd.pid"; + +&daemonize1; + +#sub REAPER { my $pid = wait; $SIG{CHLD} = \&REAPER; $kids--; } +#$SIG{CHLD} = \&REAPER; + +$sigterm = 0; +$sigint = 0; +$SIG{INT} = sub { warn "SIGINT received; shutting down\n"; $sigint++; }; +$SIG{TERM} = sub { warn "SIGTERM received; shutting down\n"; $sigterm++; }; + +my $freeside_gid = scalar(getgrnam('freeside')) + or die "can't setgid to freeside group\n"; +$) = $freeside_gid; +$( = $freeside_gid; +#if freebsd can't setuid(), presumably it can't setgid() either. grr fleabsd +($(,$)) = ($),$(); +$) = $freeside_gid; + +$> = $FS::UID::freeside_uid; +$< = $FS::UID::freeside_uid; +#freebsd is sofa king broken, won't setuid() +($<,$>) = ($>,$<); +$> = $FS::UID::freeside_uid; + +#$ENV{HOME} = (getpwuid($>))[7]; #for ssh +adminsuidsetup $user; + +$log_file= "/usr/local/etc/freeside/sqlradius-radacctd-log.". $FS::UID::datasrc; + +&daemonize2; + +$SIG{__DIE__} = \&_die; +$SIG{__WARN__} = \&_logmsg; + +warn "freeside-sqlradius-radacctd starting\n"; + +#eslaf + +#my $machine = shift or die &usage; #would need to be up higher for real +my @exports = qsearch('part_export', { 'exporttype' => 'sqlradius' } ); + +while (1) { + + my %seen = (); + foreach my $export ( @exports ) { + next if $seen{$export->option('datasrc')}++; + my $dbh = DBI->connect( + map { $export->option($_) } qw( datasrc username password ) + ) or do { + warn "can't connect to ". $export->option('datasrc'). ": ". $DBI::errstr; + next; + } + + # find old radacct position + #$lastid = 0; + + # get new radacct records + my $sth = $dbh->prepare('SELECT * FROM radacct WHERE radacctid > ?') or do { + warn "can't select in radacct table from ". $export->option('datasrc'). + ": ". $dbh->errstr; + next; + }; + + while ( my $radacct = $sth->fetchrow_arrayref({}) ) { + + my $session = new FS::session { + portnum => + svcnum => + login => + #logout => + }; + + } + + # look for updated radacct records & replace them + + } + + sleep 5; + +} + +#more false laziness w/freeside-queued + +sub usage { + die "Usage:\n\n freeside-sqlradius-radacctd user\n"; +} + +sub _die { + my $msg = shift; + unlink $pid_file if -e $pid_file; + _logmsg($msg); +} + +sub _logmsg { + chomp( my $msg = shift ); + my $log = new IO::File ">>$log_file"; + flock($log, LOCK_EX); + seek($log, 0, 2); + print $log "[". time2str("%a %b %e %T %Y",time). "] [$$] $msg\n"; + flock($log, LOCK_UN); + close $log; +} + +sub daemonize1 { + + chdir "/" or die "Can't chdir to /: $!"; + open STDIN, '/dev/null' or die "Can't read /dev/null: $!"; + defined(my $pid = fork) or die "Can't fork: $!"; + if ( $pid ) { + print "freeside-sqlradius-radacctd started with pid $pid\n"; + #logging to $log_file\n"; + exit unless $pid_file; + my $pidfh = new IO::File ">$pid_file" or exit; + print $pidfh "$pid\n"; + exit; + } + #open STDOUT, '>/dev/null' + # or die "Can't write to /dev/null: $!"; + #setsid or die "Can't start a new session: $!"; + #open STDERR, '>&STDOUT' or die "Can't dup stdout: $!"; + +} + +sub daemonize2 { + open STDOUT, '>/dev/null' + or die "Can't write to /dev/null: $!"; + setsid or die "Can't start a new session: $!"; + open STDERR, '>&STDOUT' or die "Can't dup stdout: $!"; +} + + +#eslaf + +=head1 NAME + +freeside-sqlradius-radacctd - Real-time radacct import daemon + +=head1 SYNOPSIS + + freeside-sqlradius-radacctd username + +=head1 DESCRIPTION + +Imports records from an SQL radacct table in real-time into the session +monitor. + +This enables per-minute or per-hour charges as well as the +"View active NAS ports" function. + +B is a username added by freeside-adduser. + +=head1 SEE ALSO + +session.html from the base documentation. + +=cut + -- cgit v1.2.1 From 548a47b0ec1040320e56f17cfac71f716785cb95 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 5 Nov 2002 23:29:38 +0000 Subject: bandwidth charges from sqlradius --- FS/FS/cust_pkg.pm | 54 ++++++++++++++++++++++++++++++++--------- FS/FS/cust_svc.pm | 72 ++++++++++++++++++++++++++++++++++++++++++++++++------- FS/FS/svc_acct.pm | 18 ++++++++++++++ 3 files changed, 125 insertions(+), 19 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 55ee37d9d..e83b95156 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -530,7 +530,11 @@ sub seconds_since_sqlradacct { my $seconds = 0; foreach my $cust_svc ( - grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc + grep { + my $part_svc = $_->part_svc; + $part_svc->svcdb eq 'svc_acct' + && scalar($part_svc->part_export('sqlradius')); + } $self->cust_svc ) { $seconds += $cust_svc->seconds_since_sqlradacct($start, $end); } @@ -539,6 +543,38 @@ sub seconds_since_sqlradacct { } +=item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE + +Returns the sum of the given attribute for all accounts (see L) +in this package for sessions ending between TIMESTAMP_START (inclusive) and +TIMESTAMP_END +(exclusive). + +TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see +L. Also see L and L for conversion +functions. + +=cut + +sub attribute_since_sqlradacct { + my($self, $start, $end, $attrib) = @_; + + my $sum = 0; + + foreach my $cust_svc ( + grep { + my $part_svc = $_->part_svc; + $part_svc->svcdb eq 'svc_acct' + && scalar($part_svc->part_export('sqlradius')); + } $self->cust_svc + ) { + $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib); + } + + $sum; + +} + =back =head1 SUBROUTINES @@ -719,10 +755,6 @@ sub order { =back -=head1 VERSION - -$Id: cust_pkg.pm,v 1.27 2002-10-17 14:16:17 ivan Exp $ - =head1 BUGS sub order is not OO. Perhaps it should be moved to FS::cust_main and made so? @@ -732,12 +764,12 @@ 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_domain, FS::svc_www and FS::svc_forward 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. +FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are +loaded via 'use' at compile time, rather than via 'require' in sub { setup, +suspend, unsuspend, cancel } because they use %FS::UID::callback to load +configuration values. Probably need a subroutine which decides what to do +based on whether or not we've fetched the user yet, rather than a hash. See +FS::UID and the TODO. Now that things are transactional should the check in the insert method be moved to check ? diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index 211b0ad23..e0d582b51 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -337,11 +337,11 @@ sub seconds_since { $sth->fetchrow_arrayref->[0]; } -=item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END +=item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END See L. Equivalent to -$cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records -where B is not "svc_acct". +$cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless +for records where B is not "svc_acct". =cut @@ -361,7 +361,7 @@ sub seconds_since_sqlradacct { my $dbh = DBI->connect( map { $part_export->option($_) } qw(datasrc username password) ) or die "can't connect to sqlradius database: ". $DBI::errstr; - + #select a unix time conversion function based on database type my $str2time; if ( $dbh->{Driver}->{Name} eq 'mysql' ) { @@ -416,20 +416,20 @@ sub seconds_since_sqlradacct { my $end_during = $sth->fetchrow_arrayref->[0]; #find closed (not anymore - or open) sessions which start before the range - # but stop # after, or are still open, count range start->range end + # but stop after, or are still open, count range start->range end # don't count open sessions (probably missing stop record) $sth = $dbh->prepare("SELECT COUNT(*) FROM radacct WHERE UserName = ? AND $str2time AcctStartTime ) < ? AND ( $str2time AcctStopTime ) >= ? - )" + )" # OR AcctStopTime = 0 - # OR AcctStopTime IS NULL )" + # OR AcctStopTime IS NULL )" ) or die $dbh->errstr; $sth->execute($username, $start, $end ) or die $sth->errstr; my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0]; - + $seconds += $regular + $end_during + $start_during + $entire_range; } @@ -438,6 +438,62 @@ sub seconds_since_sqlradacct { } +=item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE + +See L. Equivalent to +$cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless +for records where B is not "svc_acct". + +=cut + +#note: implementation here, POD in FS::svc_acct +#(false laziness w/seconds_since_sqlradacct above) +sub attribute_since_sqlradacct { + my($self, $start, $end, $attrib) = @_; + + my $username = $self->svc_x->username; + + my @part_export = $self->part_svc->part_export('sqlradius') + or die "no sqlradius export configured for this service type"; + #or return undef; + + my $sum = 0; + + foreach my $part_export ( @part_export ) { + + my $dbh = DBI->connect( map { $part_export->option($_) } + qw(datasrc username password) ) + or die "can't connect to sqlradius database: ". $DBI::errstr; + + #select a unix time conversion function based on database type + my $str2time; + if ( $dbh->{Driver}->{Name} eq 'mysql' ) { + $str2time = 'UNIX_TIMESTAMP('; + } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) { + $str2time = 'EXTRACT( EPOCH FROM '; + } else { + warn "warning: unknown database type ". $dbh->{Driver}->{Name}. + "; guessing how to convert to UNIX timestamps"; + $str2time = 'extract(epoch from '; + } + + my $sth = $dbh->prepare("SELECT SUM(?) + FROM radacct + WHERE UserName = ? + AND $str2time AcctStopTime ) >= ? + AND $str2time AcctStopTime ) < ? + AND AcctStopTime IS NOT NULL" + ) or die $dbh->errstr; + $sth->execute($attrib, $username, $start, $end) or die $sth->errstr; + + $sum += $sth->fetchrow_arrayref->[0]; + + } + + $sum; + +} + =back =head1 BUGS diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index b33f3ae29..c808aeea4 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -960,6 +960,24 @@ sub seconds_since_sqlradacct { $self->cust_svc->seconds_since_sqlradacct(@_); } +=item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE + +Returns the sum of the given attribute for all accounts (see L) +in this package for sessions ending between TIMESTAMP_START (inclusive) and +TIMESTAMP_END (exclusive). + +TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see +L. Also see L and L for conversion +functions. + +=cut + +#note: POD here, implementation in FS::cust_svc +sub attribute_since_sqlradacct { + my $self = shift; + $self->cust_svc->attribute_since_sqlradacct(@_); +} + =item radius_groups Returns all RADIUS groups for this account (see L). -- cgit v1.2.1 From d32ae4e36b14a3418979856e3ee3f662c5290d65 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 5 Nov 2002 23:34:11 +0000 Subject: can't use placeholders in SELECT SUM(?) --- FS/FS/cust_svc.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index e0d582b51..7516be599 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -477,14 +477,14 @@ sub attribute_since_sqlradacct { $str2time = 'extract(epoch from '; } - my $sth = $dbh->prepare("SELECT SUM(?) + my $sth = $dbh->prepare("SELECT SUM($attrib) FROM radacct WHERE UserName = ? AND $str2time AcctStopTime ) >= ? AND $str2time AcctStopTime ) < ? AND AcctStopTime IS NOT NULL" ) or die $dbh->errstr; - $sth->execute($attrib, $username, $start, $end) or die $sth->errstr; + $sth->execute($username, $start, $end) or die $sth->errstr; $sum += $sth->fetchrow_arrayref->[0]; -- cgit v1.2.1 From 4014161f196408567c02ce3fe5a0cd3c27f633c7 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 6 Nov 2002 04:23:22 +0000 Subject: safe regex for sqlradius hour/data billing, closes: Bug#474 --- FS/FS/part_pkg.pm | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index e914636e4..f290420df 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -218,6 +218,8 @@ sub check { or $r =~ /^my \$min = \$cust_pkg\->seconds_since\(\$cust_pkg\->bill \|\| 0\) \/ 60 \- \s*\d*\.?\d*\s*; \$min = 0 if \$min < 0; \s*\d*\.?\d*\s* \+ \s*\d*\.?\d*\s* \* \$min;\s*$/ + or $r =~ /^my \$last_bill = \$cust_pkg\->last_bill; my \$hours = \$cust_pkg\->seconds_since_sqlradacct\(\$last_bill, \$sdate \) \/ 3600 - \s*\d\.?\d*\s*; \$hours = 0 if \$hours < 0; my \$input = \$cust_pkg\->attribute_since_sqlradacct\(\$last_bill, \$sdate, "AcctInputOctets" \) \/ 1048576; my \$output = \$cust_pkg\->attribute_since_sqlradacct\(\$last_bill, \$sdate, "AcctOutputOctets" \) \/ 1048576; my \$total = \$input \+ \$output \- \s*\d\.?\d*\s*; \$total = 0 if \$total < 0; my \$input = \$input - \s*\d\.?\d*\s*; \$input = 0 if \$input < 0; my \$output = \$output - \s*\d\.?\d*\s*; \$output = 0 if \$output < 0; \s*\d\.?\d*\s* \+ \s*\d\.?\d*\s* \* \$hours \+ \s*\d\.?\d*\s* \* \$input \+ \s*\d\.?\d*\s* \* \$output \+ \s*\d\.?\d*\s* \* \$total *;\s*$/ + or do { #log! return "illegal recur: $r"; @@ -295,10 +297,6 @@ sub payby { =back -=head1 VERSION - -$Id: part_pkg.pm,v 1.16 2002-06-10 01:39:50 khoff Exp $ - =head1 BUGS The delete method is unimplemented. -- cgit v1.2.1 From 825c291369542af6f66fa6e08d1762374b5388a1 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 7 Nov 2002 22:53:53 +0000 Subject: doc --- FS/FS/cust_main.pm | 2 ++ 1 file changed, 2 insertions(+) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index d6e4bc1e3..f9f473db9 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -172,6 +172,8 @@ FS::Record. The following fields are currently supported: =item comments - comments (optional) +=item referral_custnum - referring customer number + =back =head1 METHODS -- cgit v1.2.1 From 9efddfba948a749413d11970e6106651b9a41d2d Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 16 Nov 2002 10:33:16 +0000 Subject: separate ACH processor support --- FS/FS/Conf.pm | 11 ++++++++-- FS/FS/cust_bill.pm | 60 +++++++++++++++++++++++++++++++++++++----------------- 2 files changed, 50 insertions(+), 21 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index c007a501a..e76ea3873 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -268,6 +268,13 @@ httemplate/docs/config.html 'type' => 'textarea', }, + { + 'key' => 'business-onlinepayment-ach', + 'section' => 'billing', + 'description' => 'Alternate Business::OnlinePayment support for ACH transactions (defaults to regular business-onlinepayment). At least three lines: processor, login, and password. An optional fourth line specifies the action or actions (multiple actions are separated with `,\': for example: `Authorization Only, Post Authorization\'). Optional additional lines are passed to Business::OnlinePayment as %processor_options.', + 'type' => 'textarea', + }, + { 'key' => 'business-onlinepayment-description', 'section' => 'billing', @@ -877,7 +884,7 @@ httemplate/docs/config.html 'section' => '', 'description' => 'Acceptable payment types for the signup server', 'type' => 'selectmultiple', - 'select_enum' => [ qw(CARD CHEK PREPAY BILL COMP) ], + 'select_enum' => [ qw(CARD CHEK LECB PREPAY BILL COMP) ], }, { @@ -964,7 +971,7 @@ httemplate/docs/config.html 'section' => 'UI', 'description' => 'Default payment type. HIDE disables display of billing information and sets customers to BILL.', 'type' => 'select', - 'select_enum' => [ '', qw(CARD CHEK BILL COMP HIDE) ], + 'select_enum' => [ '', qw(CARD CHEK LECB BILL COMP HIDE) ], }, { diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 54641ee35..708b99746 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -3,9 +3,9 @@ package FS::cust_bill; use strict; use vars qw( @ISA $conf $money_char ); use vars qw( $lpr $invoice_from $smtpmachine ); -use vars qw( $processor ); use vars qw( $xaction $E_NoErr ); use vars qw( $bop_processor $bop_login $bop_password $bop_action @bop_options ); +use vars qw( $ach_processor $ach_login $ach_password $ach_action @ach_options ); use vars qw( $invoice_lines @buf ); #yuck use Date::Format; use Mail::Internet 1.44; @@ -43,8 +43,20 @@ $FS::UID::callback{'FS::cust_bill'} = sub { @bop_options ) = $conf->config('business-onlinepayment'); $bop_action ||= 'normal authorization'; + ( $ach_processor, $ach_login, $ach_password, $ach_action, @ach_options ) = + ( $bop_processor, $bop_login, $bop_password, $bop_action, @bop_options ); + eval "use Business::OnlinePayment"; + } + + if ( $conf->exists('business-onlinepayment-ach') ) { + ( $ach_processor, + $ach_login, + $ach_password, + $ach_action, + @ach_options + ) = $conf->config('business-onlinepayment-ach'); + $ach_action ||= 'normal authorization'; eval "use Business::OnlinePayment"; - $processor="Business::OnlinePayment::$bop_processor"; } }; @@ -592,7 +604,15 @@ for supported processors. sub realtime_card { my $self = shift; - $self->realtime_bop('CC', @_); + $self->realtime_bop( + 'CC', + $bop_processor, + $bop_login, + $bop_password, + $bop_action, + \@bop_options, + @_ + ); } =item realtime_ach @@ -606,20 +626,22 @@ for supported processors. sub realtime_ach { my $self = shift; - $self->realtime_bop('CHECK', @_); + $self->realtime_bop( + 'CHECK', + $ach_processor, + $ach_login, + $ach_password, + $ach_action, + \@ach_options, + @_ + ); } sub realtime_bop { - my $self = shift; - my $method = shift; + my( $self, $method, $processor, $login, $password, $action, $options ) = @_; my $cust_main = $self->cust_main; my $amount = $self->owed; - unless ( $processor =~ /^Business::OnlinePayment::(.*)$/ ) { - return "Real-time card/ACH processing not enabled (processor $processor)"; - } - my $bop_processor = $1; #hmm? - my $address = $cust_main->address1; $address .= ", ". $cust_main->address2 if $cust_main->address2; @@ -645,7 +667,7 @@ sub realtime_bop { } my $email = $invoicing_list[0]; - my( $action1, $action2 ) = split(/\s*\,\s*/, $bop_action ); + my( $action1, $action2 ) = split(/\s*\,\s*/, $action ); my $description = 'Internet Services'; if ( $conf->exists('business-onlinepayment-description') ) { @@ -676,12 +698,12 @@ sub realtime_bop { } my $transaction = - new Business::OnlinePayment( $bop_processor, @bop_options ); + new Business::OnlinePayment( $processor, @$options ); $transaction->content( %content, 'type' => $method, - 'login' => $bop_login, - 'password' => $bop_password, + 'login' => $login, + 'password' => $password, 'action' => $action1, 'description' => $description, 'amount' => $amount, @@ -710,14 +732,14 @@ sub realtime_bop { #warn "********* $auth ***********\n"; #warn "********* $ordernum ***********\n"; my $capture = - new Business::OnlinePayment( $bop_processor, @bop_options ); + new Business::OnlinePayment( $processor, @$options ); my %capture = ( %content, type => $method, action => $action2, - login => $bop_login, - password => $bop_password, + login => $login, + password => $password, order_number => $ordernum, amount => $amount, authorization => $auth, @@ -1074,7 +1096,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.50 2002-10-15 09:54:24 ivan Exp $ +$Id: cust_bill.pm,v 1.51 2002-11-16 10:33:16 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From b0995f6ec4eeaad9c72be4963970f1d69fe1ef02 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 18 Nov 2002 10:15:37 +0000 Subject: preliminary ldap export --- FS/FS/part_export.pm | 32 +++++++ FS/FS/part_export/ldap.pm | 238 ++++++++++++++++++++++++++++++++++++++++++++++ FS/MANIFEST | 2 + FS/t/part_export-ldap.t | 5 + 4 files changed, 277 insertions(+) create mode 100644 FS/FS/part_export/ldap.pm create mode 100644 FS/t/part_export-ldap.t (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 5d725ab22..79fe91396 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -724,6 +724,32 @@ tie my %sqlmail_options, 'Tie::IxHash', 'password' => { label=>'Database password' }, ; +tie my %ldap_options, 'Tie::IxHash', + 'dn' => { label=>'DN' }, + 'password' => { label=>'Optional DN password' }, + 'attributes' => { label=>'Attributes', + type=>'textarea', + default=>join("\n", + 'uid $username', + 'mail $username\@$domain', + 'uidno $uid', + 'gidno $gid', + 'cn $first', + 'sn $last', + 'mailquota $quota', + 'vmail', + 'location', + 'mailtag', + 'mailhost', + 'mailmessagestore $dir', + 'userpassword $crypt_password', + 'hint', + 'answer $sec_phrase', + ), + }, + 'radius' => { label=>'Export RADIUS attributes', type=>'checkbox', }, +; + #export names cannot have dashes... %exports = ( @@ -766,6 +792,12 @@ tie my %sqlmail_options, 'Tie::IxHash', 'notes' => 'Run remote commands via SSH. username@domain (rather than just usernames) are considered unique (also see shellcommands). You probably want this if the commands you are running will accept a domain as a parameter, and will allow the same username with different domains. You will need to setup SSH for unattended operation.', }, + 'ldap' => { + 'desc' => 'Real-time export to LDAP', + 'options' => \%ldap_options, + 'notes' => 'Real-time export to arbitrary LDAP attributes. Requires installation of Net::LDAP from CPAN.', + }, + 'sqlradius' => { 'desc' => 'Real-time export to SQL-backed RADIUS (ICRADIUS, FreeRADIUS)', 'options' => \%sqlradius_options, diff --git a/FS/FS/part_export/ldap.pm b/FS/FS/part_export/ldap.pm new file mode 100644 index 000000000..40f27d695 --- /dev/null +++ b/FS/FS/part_export/ldap.pm @@ -0,0 +1,238 @@ +package FS::part_export::ldap; + +use vars qw(@ISA); +use FS::Record qw( dbh ); +use FS::part_export; + +@ISA = qw(FS::part_export); + +sub rebless { shift; } + +sub _export_insert { + my($self, $svc_acct) = (shift, shift); + + #false laziness w/shellcommands.pm + { + no strict 'refs'; + ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields; + ${$_} = $svc_acct->$_() foreach qw( domain ); + my $cust_pkg = $svc_acct->cust_svc->cust_pkg; + if ( $cust_pkg ) { + my $cust_main = $cust_pkg->cust_main; + ${$_} = $cust_main->getfield($_) foreach qw(first last); + } + } + $crypt_password = ''; #surpress "used only once" warnings + $crypt_password = crypt( $svc_acct->_password, + $saltset[int(rand(64))].$saltset[int(rand(64))] ); + + + my %attrib = map { /^\s*(\w+)\s+(.*\S)\s*$/; ( $1 => eval(qq("$2")) ); } + grep { /^\s*(\w+)\s+(.*\S)\s*$/ } + split("\n", $self->option('attributes')); + + if ( $self->option('radius') { + foreach my $table (qw(reply check)) { + my $method = "radius_$table"; + my %radius = $svc_acct->$method(); + foreach my $radius ( keys %radius ) { + ( my $ldap = $radius ) =~ s/\-//g; + $attrib{$ldap} = $radius{$radius}; + } + } + } + + my $err_or_queue = $self->ldap_queue( $svc_acct->svcnum, 'insert', + #$svc_acct->username, + %attrib ); + return $err_or_queue unless ref($err_or_queue); + + #groups with LDAP? + #my @groups = $svc_acct->radius_groups; + #if ( @groups ) { + # my $err_or_queue = $self->ldap_queue( + # $svc_acct->svcnum, 'usergroup_insert', + # $svc_acct->username, @groups ); + # return $err_or_queue unless ref($err_or_queue); + #} + + ''; +} + +sub _export_replace { + my( $self, $new, $old ) = (shift, shift, shift); + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + return "can't (yet?) change username with ldap" + if $old->username ne $new->username; + + return "ldap replace unimplemented"; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $jobnum = ''; + #if ( $old->username ne $new->username ) { + # my $err_or_queue = $self->ldap_queue( $new->svcnum, 'rename', + # $new->username, $old->username ); + # unless ( ref($err_or_queue) ) { + # $dbh->rollback if $oldAutoCommit; + # return $err_or_queue; + # } + # $jobnum = $err_or_queue->jobnum; + #} + + foreach my $table (qw(reply check)) { + my $method = "radius_$table"; + my %new = $new->$method(); + my %old = $old->$method(); + if ( grep { !exists $old{$_} #new attributes + || $new{$_} ne $old{$_} #changed + } keys %new + ) { + my $err_or_queue = $self->ldap_queue( $new->svcnum, 'insert', + $table, $new->username, %new ); + unless ( ref($err_or_queue) ) { + $dbh->rollback if $oldAutoCommit; + return $err_or_queue; + } + if ( $jobnum ) { + my $error = $err_or_queue->depend_insert( $jobnum ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + } + + my @del = grep { !exists $new{$_} } keys %old; + if ( @del ) { + my $err_or_queue = $self->ldap_queue( $new->svcnum, 'attrib_delete', + $table, $new->username, @del ); + unless ( ref($err_or_queue) ) { + $dbh->rollback if $oldAutoCommit; + return $err_or_queue; + } + if ( $jobnum ) { + my $error = $err_or_queue->depend_insert( $jobnum ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + } + } + + # (sorta) false laziness with FS::svc_acct::replace + my @oldgroups = @{$old->usergroup}; #uuuh + my @newgroups = $new->radius_groups; + my @delgroups = (); + foreach my $oldgroup ( @oldgroups ) { + if ( grep { $oldgroup eq $_ } @newgroups ) { + @newgroups = grep { $oldgroup ne $_ } @newgroups; + next; + } + push @delgroups, $oldgroup; + } + + if ( @delgroups ) { + my $err_or_queue = $self->ldap_queue( $new->svcnum, 'usergroup_delete', + $new->username, @delgroups ); + unless ( ref($err_or_queue) ) { + $dbh->rollback if $oldAutoCommit; + return $err_or_queue; + } + if ( $jobnum ) { + my $error = $err_or_queue->depend_insert( $jobnum ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + } + + if ( @newgroups ) { + my $err_or_queue = $self->ldap_queue( $new->svcnum, 'usergroup_insert', + $new->username, @newgroups ); + unless ( ref($err_or_queue) ) { + $dbh->rollback if $oldAutoCommit; + return $err_or_queue; + } + if ( $jobnum ) { + my $error = $err_or_queue->depend_insert( $jobnum ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; +} + +sub _export_delete { + my( $self, $svc_acct ) = (shift, shift); + return "ldap delete unimplemented"; + my $err_or_queue = $self->ldap_queue( $svc_acct->svcnum, 'delete', + $svc_acct->username ); + ref($err_or_queue) ? '' : $err_or_queue; +} + +sub ldap_queue { + my( $self, $svcnum, $method ) = (shift, shift, shift); + my $queue = new FS::queue { + 'svcnum' => $svcnum, + 'job' => "FS::part_export::ldap::ldap_$method", + }; + $queue->insert( + $self->machine, + $self->option('dn'), + $self->option('password'), + @_, + ) or $queue; +} + +sub ldap_insert { #subroutine, not method + my $dn = ldap_connect(shift, shift, shift); + my %attrib = @_; + + my $status = $ldap->add( $dn, attrs => [ %attrib ] ); + die $status->error if $status->is_error; + + $ldap->unbind; +} + +#sub ldap_delete { #subroutine, not method +# my $dbh = ldap_connect(shift, shift, shift); +# my $username = shift; +# +# foreach my $table (qw( radcheck radreply usergroup )) { +# my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" ); +# $sth->execute($username) +# or die "can't delete from $table table: ". $sth->errstr; +# } +# $dbh->disconnect; +#} + +sub ldap_connect { + my( $machine, $dn, $password ) = @_; + + eval "use Net::LDAP"; + die $@ if $@; + + my $ldap = Net::LDAP->net($machine) or die $@; + my $status = $ldap->bind( $dn, password=>$password ); + die $status->error if $status->is_error; + + $dn; +} + diff --git a/FS/MANIFEST b/FS/MANIFEST index e37216e19..47c3bf206 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -75,6 +75,7 @@ FS/part_export/cyrus.pm FS/part_export/domain_shellcommands.pm FS/part_export/http.pm FS/part_export/infostreet.pm +FS/part_export/ldap.pm FS/part_export/null.pm FS/part_export/shellcommands.pm FS/part_export/shellcommands_withdomain.pm @@ -149,6 +150,7 @@ t/part_export-cyrus.t t/part_export-domain_shellcommands.t t/part_export-http.t t/part_export-infostreet.t +t/part_export-ldap.t t/part_export-null.t t/part_export-shellcommands.t t/part_export-shellcommands_withdomain.t diff --git a/FS/t/part_export-ldap.t b/FS/t/part_export-ldap.t new file mode 100644 index 000000000..826c3418d --- /dev/null +++ b/FS/t/part_export-ldap.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::ldap; +$loaded=1; +print "ok 1\n"; -- cgit v1.2.1 From 789c34c5251f4b831a7cb27bd2a9af700ccf2ced Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 19 Nov 2002 09:51:59 +0000 Subject: add LEC billing --- FS/FS/cust_bill.pm | 29 +++++++++++++++++++++++++++-- FS/FS/cust_main.pm | 17 +++++++++++++---- FS/FS/cust_pay.pm | 6 +++--- FS/FS/cust_refund.pm | 6 +++--- FS/FS/part_bill_event.pm | 4 ++-- FS/FS/part_export/ldap.pm | 2 +- FS/FS/part_pkg.pm | 2 ++ 7 files changed, 51 insertions(+), 15 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 708b99746..a682c5958 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -637,6 +637,28 @@ sub realtime_ach { ); } +=item realtime_lec + +Attempts to pay this invoice with phone bill (LEC) payment via a +Business::OnlinePayment realtime gateway. See +http://search.cpan.org/search?mode=module&query=Business%3A%3AOnlinePayment +for supported processors. + +=cut + +sub realtime_ach { + my $self = shift; + $self->realtime_bop( + 'LEC', + $bop_processor, + $bop_login, + $bop_password, + $bop_action, + \@bop_options, + @_ + ); +} + sub realtime_bop { my( $self, $method, $processor, $login, $password, $action, $options ) = @_; my $cust_main = $self->cust_main; @@ -695,12 +717,13 @@ sub realtime_bop { ( $content{account_number}, $content{routing_code} ) = split('@', $cust_main->payinfo); $content{bank_name} = $cust_main->payname; + } elsif ( $method eq 'LEC' ) { + $content{phone} = $cust_main->payinfo; } my $transaction = new Business::OnlinePayment( $processor, @$options ); $transaction->content( - %content, 'type' => $method, 'login' => $login, 'password' => $password, @@ -720,6 +743,7 @@ sub realtime_bop { 'referer' => 'http://cleanwhisker.420.am/', 'email' => $email, 'phone' => $cust_main->daytime || $cust_main->night, + %content, #after ); $transaction->submit(); @@ -771,6 +795,7 @@ sub realtime_bop { my %method2payby = ( 'CC' => 'CARD', 'CHECK' => 'CHEK', + 'LEC' => 'LECB', ); my $cust_pay = new FS::cust_pay ( { @@ -1096,7 +1121,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.51 2002-11-16 10:33:16 ivan Exp $ +$Id: cust_bill.pm,v 1.52 2002-11-19 09:51:58 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index f9f473db9..4a5cff2fc 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -158,7 +158,7 @@ FS::Record. The following fields are currently supported: =item ship_fax - phone (optional) -=item payby - `CARD' (credit cards), `CHEK' (electronic check), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see L and sets billing type to BILL) +=item payby - `CARD' (credit cards), `CHEK' (electronic check), `LECB' (Phone bill billing), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see L and sets billing type to BILL) =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L) @@ -484,14 +484,15 @@ sub replace { $self->invoicing_list( $invoicing_list ); } - if ( $self->payby =~ /^(CARD|CHEK)$/ && + if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ && grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) { # card/check info has changed, want to retry realtime_card invoice events #false laziness w/collect foreach my $cust_bill_event ( grep { #$_->part_bill_event->plan eq 'realtime-card' - $_->part_bill_event->eventcode eq '$cust_bill->realtime_card();' + $_->part_bill_event->eventcode =~ + /^\$cust_bill\->realtime_(card|ach|lec)\(\);$/ && $_->status eq 'done' && $_->statustext } @@ -691,6 +692,14 @@ sub check { $payinfo = "$1\@$2"; $self->payinfo($payinfo); + } elsif ( $self->payby eq 'LECB' ) { + + my $payinfo = $self->payinfo; + $payinfo =~ s/\D//g; + $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number'; + $payinfo = $1; + $self->payinfo($payinfo); + } elsif ( $self->payby eq 'BILL' ) { $error = $self->ut_textn('payinfo'); @@ -715,7 +724,7 @@ sub check { if ( $self->paydate eq '' || $self->paydate eq '-' ) { return "Expriation date required" - unless $self->payby =~ /^(BILL|PREPAY|CHEK)$/; + unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/; $self->paydate(''); } else { $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index 222691408..79cf82755 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -61,7 +61,7 @@ currently supported: L and L for conversion functions. =item payby - `CARD' (credit cards), `CHEK' (electronic check/ACH), -`BILL' (billing), or `COMP' (free) +`LECB' (phone bill billing), `BILL' (billing), or `COMP' (free) =item payinfo - card number, check #, or comp issuer (4-8 lowercase alphanumerics; think username), respectively @@ -347,7 +347,7 @@ sub check { $self->_date(time) unless $self->_date; - $self->payby =~ /^(CARD|CHEK|BILL|COMP)$/ or return "Illegal payby"; + $self->payby =~ /^(CARD|CHEK|LECB|BILL|COMP)$/ or return "Illegal payby"; $self->payby($1); #false laziness with cust_refund::check @@ -406,7 +406,7 @@ sub unapplied { =head1 VERSION -$Id: cust_pay.pm,v 1.22 2002-10-12 10:15:55 ivan Exp $ +$Id: cust_pay.pm,v 1.23 2002-11-19 09:51:58 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_refund.pm b/FS/FS/cust_refund.pm index aac320e61..763671736 100644 --- a/FS/FS/cust_refund.pm +++ b/FS/FS/cust_refund.pm @@ -48,7 +48,7 @@ inherits from FS::Record. The following fields are currently supported: L and L for conversion functions. =item payby - `CARD' (credit cards), `CHEK' (electronic check/ACH), -`BILL' (billing), or `COMP' (free) +`LECB' (Phone bill billing), `BILL' (billing), or `COMP' (free) =item payinfo - card number, P.O.#, or comp issuer (4-8 lowercase alphanumerics; think username) @@ -235,7 +235,7 @@ sub check { unless $self->crednum || qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); - $self->payby =~ /^(CARD|CHEK|BILL|COMP)$/ or return "Illegal payby"; + $self->payby =~ /^(CARD|CHEK|LECB|BILL|COMP)$/ or return "Illegal payby"; $self->payby($1); #false laziness with cust_pay::check @@ -267,7 +267,7 @@ sub check { =head1 VERSION -$Id: cust_refund.pm,v 1.19 2002-10-12 10:15:55 ivan Exp $ +$Id: cust_refund.pm,v 1.20 2002-11-19 09:51:58 ivan Exp $ =head1 BUGS diff --git a/FS/FS/part_bill_event.pm b/FS/FS/part_bill_event.pm index e86b5c1fb..dc10be879 100644 --- a/FS/FS/part_bill_event.pm +++ b/FS/FS/part_bill_event.pm @@ -37,7 +37,7 @@ FS::Record. The following fields are currently supported: =item eventpart - primary key -=item payby - CARD, CHEK, BILL, or COMP +=item payby - CARD, CHEK, LECB, BILL, or COMP =item event - event name @@ -140,7 +140,7 @@ sub check { } my $error = $self->ut_numbern('eventpart') - || $self->ut_enum('payby', [qw( CARD CHEK BILL COMP )] ) + || $self->ut_enum('payby', [qw( CARD CHEK LECB BILL COMP )] ) || $self->ut_text('event') || $self->ut_anything('eventcode') || $self->ut_number('seconds') diff --git a/FS/FS/part_export/ldap.pm b/FS/FS/part_export/ldap.pm index 40f27d695..ec1d37fd5 100644 --- a/FS/FS/part_export/ldap.pm +++ b/FS/FS/part_export/ldap.pm @@ -31,7 +31,7 @@ sub _export_insert { grep { /^\s*(\w+)\s+(.*\S)\s*$/ } split("\n", $self->option('attributes')); - if ( $self->option('radius') { + if ( $self->option('radius') ) { foreach my $table (qw(reply check)) { my $method = "radius_$table"; my %radius = $svc_acct->$method(); diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index f290420df..99d88d56a 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -282,6 +282,8 @@ following logic instead; If the package has B<0> setup and B<0> recur, the single item B is returned, otherwise, the single item B is returned. +(CHEK? LEC? Probably shouldn't accept those by default, prone to abuse) + =cut sub payby { -- cgit v1.2.1 From ec28c4e3c2a08f0057020b81907174e84a654d25 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 19 Nov 2002 10:02:19 +0000 Subject: silly regex bug parsing echeck info --- FS/FS/cust_main.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 4a5cff2fc..a8b1dc291 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -687,7 +687,7 @@ sub check { } elsif ( $self->payby eq 'CHEK' ) { my $payinfo = $self->payinfo; - $payinfo =~ s/[\D\@]//g; + $payinfo =~ s/[^\d\@]//g; $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba'; $payinfo = "$1\@$2"; $self->payinfo($payinfo); -- cgit v1.2.1 From 103cdcd9ea5630d3b1ce263345c48cd8d261e34c Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 19 Nov 2002 10:09:34 +0000 Subject: typo adding lec transactions --- FS/FS/cust_bill.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index a682c5958..3e9377802 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -646,7 +646,7 @@ for supported processors. =cut -sub realtime_ach { +sub realtime_lec { my $self = shift; $self->realtime_bop( 'LEC', @@ -1121,7 +1121,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.52 2002-11-19 09:51:58 ivan Exp $ +$Id: cust_bill.pm,v 1.53 2002-11-19 10:09:34 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 55bfcaa26d8cc7729a8fbaa3a5325e4372588e8b Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 19 Nov 2002 20:36:43 +0000 Subject: increase length of reczone and recdata fields in domain_record --- FS/bin/freeside-setup | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-setup b/FS/bin/freeside-setup index d61e8b0bf..587f0158b 100755 --- a/FS/bin/freeside-setup +++ b/FS/bin/freeside-setup @@ -805,10 +805,12 @@ sub tables_hash_hack { 'columns' => [ 'recnum', 'serial', '', '', 'svcnum', 'int', '', '', - 'reczone', 'varchar', '', $char_d, + #'reczone', 'varchar', '', $char_d, + 'reczone', 'varchar', '', 255, 'recaf', 'char', '', 2, 'rectype', 'char', '', 5, - 'recdata', 'varchar', '', $char_d, + #'recdata', 'varchar', '', $char_d, + 'recdata', 'varchar', '', 255, ], 'primary_key' => 'recnum', 'unique' => [], -- cgit v1.2.1 From f5be6be6a52ee4461243eeaadcf769c14571b82f Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 19 Nov 2002 20:56:12 +0000 Subject: ldap export update --- FS/FS/part_export/ldap.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export/ldap.pm b/FS/FS/part_export/ldap.pm index ec1d37fd5..6077b7418 100644 --- a/FS/FS/part_export/ldap.pm +++ b/FS/FS/part_export/ldap.pm @@ -229,7 +229,7 @@ sub ldap_connect { eval "use Net::LDAP"; die $@ if $@; - my $ldap = Net::LDAP->net($machine) or die $@; + my $ldap = Net::LDAP->new($machine) or die $@; my $status = $ldap->bind( $dn, password=>$password ); die $status->error if $status->is_error; -- cgit v1.2.1 From bf79e1879f8f6b309391a71c9d563d9ee8782e36 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 19 Nov 2002 21:20:03 +0000 Subject: ldap export: don't use password if not given --- FS/FS/part_export/ldap.pm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export/ldap.pm b/FS/FS/part_export/ldap.pm index 6077b7418..776814c59 100644 --- a/FS/FS/part_export/ldap.pm +++ b/FS/FS/part_export/ldap.pm @@ -225,12 +225,14 @@ sub ldap_insert { #subroutine, not method sub ldap_connect { my( $machine, $dn, $password ) = @_; + my %bind_options; + $bind_options{password} = $password if length($password); eval "use Net::LDAP"; die $@ if $@; my $ldap = Net::LDAP->new($machine) or die $@; - my $status = $ldap->bind( $dn, password=>$password ); + my $status = $ldap->bind( $dn, %bind_options ); die $status->error if $status->is_error; $dn; -- cgit v1.2.1 From 34928158d52fb8456aa665c4bacd1f915b9cae0d Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 19 Nov 2002 22:48:02 +0000 Subject: Business::OnlinePayment type is ECHECK not CHECK --- FS/FS/cust_bill.pm | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 3e9377802..75e2b1718 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -627,7 +627,7 @@ for supported processors. sub realtime_ach { my $self = shift; $self->realtime_bop( - 'CHECK', + 'ECHECK', $ach_processor, $ach_login, $ach_password, @@ -668,7 +668,7 @@ sub realtime_bop { $address .= ", ". $cust_main->address2 if $cust_main->address2; my($payname, $payfirst, $paylast); - if ( $cust_main->payname && $method ne 'CHECK' ) { + if ( $cust_main->payname && $method ne 'ECHECK' ) { $payname = $cust_main->payname; $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/ or do { @@ -712,7 +712,7 @@ sub realtime_bop { $content{card_number} = $cust_main->payinfo; $cust_main->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; $content{expiration} = "$2/$1"; - } elsif ( $method eq 'CHECK' ) { + } elsif ( $method eq 'ECHECK' ) { my($account_number,$routing_code) = $cust_main->payinfo; ( $content{account_number}, $content{routing_code} ) = split('@', $cust_main->payinfo); @@ -793,9 +793,9 @@ sub realtime_bop { if ( $transaction->is_success() ) { my %method2payby = ( - 'CC' => 'CARD', - 'CHECK' => 'CHEK', - 'LEC' => 'LECB', + ' CC' => 'CARD', + 'ECHECK' => 'CHEK', + 'LEC' => 'LECB', ); my $cust_pay = new FS::cust_pay ( { @@ -1121,7 +1121,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.53 2002-11-19 10:09:34 ivan Exp $ +$Id: cust_bill.pm,v 1.54 2002-11-19 22:48:02 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 26da8f3994e58ca5cf80ac62f034b3ad64539e47 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 19 Nov 2002 22:55:06 +0000 Subject: give better error message on bad invnum, also 'use FS::cust_bill' here --- FS/FS/cust_bill_event.pm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill_event.pm b/FS/FS/cust_bill_event.pm index f631987aa..44e4d4797 100644 --- a/FS/FS/cust_bill_event.pm +++ b/FS/FS/cust_bill_event.pm @@ -3,6 +3,7 @@ package FS::cust_bill_event; use strict; use vars qw( @ISA ); use FS::Record qw( qsearch qsearchs ); +use FS::cust_bill; use FS::part_bill_event; @ISA = qw(FS::Record); @@ -111,10 +112,10 @@ sub check { || $self->ut_textn('statustext') ; - return "Unknown invnum" + return "Unknown invnum ". $self->invnum unless qsearchs( 'cust_bill' ,{ 'invnum' => $self->invnum } ); - return "Unknown eventpart" + return "Unknown eventpart ". $self->eventpart unless qsearchs( 'part_bill_event' ,{ 'eventpart' => $self->eventpart } ); ''; #no error -- cgit v1.2.1 From cfd4d4d5fd2c64f0f0512905a465aeb4abce484c Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 20 Nov 2002 09:07:27 +0000 Subject: ugh... need to increase length of payinfo field in cust_pay and cust_refund for ACH --- FS/bin/freeside-setup | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-setup b/FS/bin/freeside-setup index 587f0158b..8f3d99fd5 100755 --- a/FS/bin/freeside-setup +++ b/FS/bin/freeside-setup @@ -541,7 +541,7 @@ sub tables_hash_hack { '_date', @date_type, 'payby', 'char', '', 4, # CARD/BILL/COMP, should be index into # payment type table. - 'payinfo', 'varchar', 'NULL', 16, #see cust_main above + 'payinfo', 'varchar', 'NULL', $char_d, #see cust_main above 'paybatch', 'varchar', 'NULL', $char_d, #for auditing purposes. 'closed', 'char', 'NULL', 1, ], @@ -618,7 +618,7 @@ sub tables_hash_hack { 'reason', 'varchar', '', $char_d, 'payby', 'char', '', 4, # CARD/BILL/COMP, should be index # into payment type table. - 'payinfo', 'varchar', 'NULL', 16, #see cust_main above + 'payinfo', 'varchar', 'NULL', $char_d, #see cust_main above 'paybatch', 'varchar', 'NULL', $char_d, 'closed', 'char', 'NULL', 1, ], -- cgit v1.2.1 From 4631154982b0607405c2cabc8f1a718445307f4d Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 20 Nov 2002 09:10:02 +0000 Subject: fix silly bug in ldap export --- FS/FS/part_export/ldap.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export/ldap.pm b/FS/FS/part_export/ldap.pm index 776814c59..57d213af0 100644 --- a/FS/FS/part_export/ldap.pm +++ b/FS/FS/part_export/ldap.pm @@ -202,7 +202,7 @@ sub ldap_queue { } sub ldap_insert { #subroutine, not method - my $dn = ldap_connect(shift, shift, shift); + my $ldap = ldap_connect(shift, (my $dn = shift), shift); my %attrib = @_; my $status = $ldap->add( $dn, attrs => [ %attrib ] ); @@ -235,6 +235,6 @@ sub ldap_connect { my $status = $ldap->bind( $dn, %bind_options ); die $status->error if $status->is_error; - $dn; + $ldap; } -- cgit v1.2.1 From eb694678cbb835267b44c5eb9ff574ee1d7ce115 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 20 Nov 2002 10:09:19 +0000 Subject: hmm, so you add the username to the DN for the add call...? i don't get LDAP --- FS/FS/part_export/ldap.pm | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export/ldap.pm b/FS/FS/part_export/ldap.pm index 57d213af0..6ff9abe12 100644 --- a/FS/FS/part_export/ldap.pm +++ b/FS/FS/part_export/ldap.pm @@ -27,7 +27,10 @@ sub _export_insert { $saltset[int(rand(64))].$saltset[int(rand(64))] ); - my %attrib = map { /^\s*(\w+)\s+(.*\S)\s*$/; ( $1 => eval(qq("$2")) ); } + my $username_attrib; + my %attrib = map { /^\s*(\w+)\s+(.*\S)\s*$/; + $username_attrib = $1 if $2 eq '$username'; + ( $1 => eval(qq("$2")) ); } grep { /^\s*(\w+)\s+(.*\S)\s*$/ } split("\n", $self->option('attributes')); @@ -44,6 +47,7 @@ sub _export_insert { my $err_or_queue = $self->ldap_queue( $svc_acct->svcnum, 'insert', #$svc_acct->username, + $username_attrib, %attrib ); return $err_or_queue unless ref($err_or_queue); @@ -203,7 +207,8 @@ sub ldap_queue { sub ldap_insert { #subroutine, not method my $ldap = ldap_connect(shift, (my $dn = shift), shift); - my %attrib = @_; + my( $username_attrib, %attrib ) = @_; + $dn = "$username_attrib=$attrib{$username_attrib}, $dn" if $username_attrib; my $status = $ldap->add( $dn, attrs => [ %attrib ] ); die $status->error if $status->is_error; -- cgit v1.2.1 From 96c1150cabe382dbafbdc8f4e89a2719fe24d605 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 20 Nov 2002 21:13:52 +0000 Subject: add objectclass and ability to have multiple comma-separated values to LDAP export --- FS/FS/part_export.pm | 1 + FS/FS/part_export/ldap.pm | 5 +++++ 2 files changed, 6 insertions(+) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 79fe91396..86bd4240e 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -745,6 +745,7 @@ tie my %ldap_options, 'Tie::IxHash', 'userpassword $crypt_password', 'hint', 'answer $sec_phrase', + 'objectclass top,person,inetOrgPerson', ), }, 'radius' => { label=>'Export RADIUS attributes', type=>'checkbox', }, diff --git a/FS/FS/part_export/ldap.pm b/FS/FS/part_export/ldap.pm index 6ff9abe12..a28504313 100644 --- a/FS/FS/part_export/ldap.pm +++ b/FS/FS/part_export/ldap.pm @@ -208,7 +208,12 @@ sub ldap_queue { sub ldap_insert { #subroutine, not method my $ldap = ldap_connect(shift, (my $dn = shift), shift); my( $username_attrib, %attrib ) = @_; + $dn = "$username_attrib=$attrib{$username_attrib}, $dn" if $username_attrib; + #icky hack, but should be unsurprising to the LDAPers + foreach my $key ( grep { $attrib{$_} =~ /,/ } keys %attrib ) { + $attrib{$key} = [ split(/,/, $attrib{$key}) ]; + } my $status = $ldap->add( $dn, attrs => [ %attrib ] ); die $status->error if $status->is_error; -- cgit v1.2.1 From 4d04b87cf2223bea7c913f587a248c111862f070 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 21 Nov 2002 20:44:45 +0000 Subject: change DN labeling for those obtuse blockheads at netmagic --- FS/FS/part_export.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 86bd4240e..8e8a828e7 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -725,7 +725,7 @@ tie my %sqlmail_options, 'Tie::IxHash', ; tie my %ldap_options, 'Tie::IxHash', - 'dn' => { label=>'DN' }, + 'dn' => { label=>'Root DN' }, 'password' => { label=>'Optional DN password' }, 'attributes' => { label=>'Attributes', type=>'textarea', -- cgit v1.2.1 From 7a94fd2dd84ccb204e97e8cbd9ce4162e93fd12e Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 22 Nov 2002 07:50:23 +0000 Subject: separate root and user dn in ldap export --- FS/FS/part_export.pm | 3 ++- FS/FS/part_export/ldap.pm | 10 ++++++---- 2 files changed, 8 insertions(+), 5 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 8e8a828e7..4b15f44ca 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -726,7 +726,8 @@ tie my %sqlmail_options, 'Tie::IxHash', tie my %ldap_options, 'Tie::IxHash', 'dn' => { label=>'Root DN' }, - 'password' => { label=>'Optional DN password' }, + 'password' => { label=>'Root DN password' }, + 'userdn' => { label=>'User DN' }, 'attributes' => { label=>'Attributes', type=>'textarea', default=>join("\n", diff --git a/FS/FS/part_export/ldap.pm b/FS/FS/part_export/ldap.pm index a28504313..68a63528e 100644 --- a/FS/FS/part_export/ldap.pm +++ b/FS/FS/part_export/ldap.pm @@ -201,21 +201,23 @@ sub ldap_queue { $self->machine, $self->option('dn'), $self->option('password'), + $self->option('userdn'), @_, ) or $queue; } sub ldap_insert { #subroutine, not method - my $ldap = ldap_connect(shift, (my $dn = shift), shift); - my( $username_attrib, %attrib ) = @_; + my $ldap = ldap_connect(shift, shift, shift); + my( $userdn, $username_attrib, %attrib ) = @_; - $dn = "$username_attrib=$attrib{$username_attrib}, $dn" if $username_attrib; + $userdn = "$username_attrib=$attrib{$username_attrib}, $userdn" + if $username_attrib; #icky hack, but should be unsurprising to the LDAPers foreach my $key ( grep { $attrib{$_} =~ /,/ } keys %attrib ) { $attrib{$key} = [ split(/,/, $attrib{$key}) ]; } - my $status = $ldap->add( $dn, attrs => [ %attrib ] ); + my $status = $ldap->add( $userdn, attrs => [ %attrib ] ); die $status->error if $status->is_error; $ldap->unbind; -- cgit v1.2.1 From 071c5ee7dfb91ff3106310cedd002cff0554b9aa Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 22 Nov 2002 10:48:34 +0000 Subject: oops, one last LECB change --- FS/FS/cust_main.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index a8b1dc291..237abcddb 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -667,7 +667,7 @@ sub check { } } - $self->payby =~ /^(CARD|CHEK|BILL|COMP|PREPAY)$/ + $self->payby =~ /^(CARD|CHEK|LECB|BILL|COMP|PREPAY)$/ or return "Illegal payby: ". $self->payby; $self->payby($1); -- cgit v1.2.1 From 37dc3ebec42104e6ba77dae9a4d8dbdf31364678 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 22 Nov 2002 11:14:04 +0000 Subject: add lec billing event --- FS/FS/part_bill_event.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_bill_event.pm b/FS/FS/part_bill_event.pm index dc10be879..a75a011b0 100644 --- a/FS/FS/part_bill_event.pm +++ b/FS/FS/part_bill_event.pm @@ -124,7 +124,7 @@ sub check { $c =~ /^\s*\$cust_main\->(suspend|cancel|invoicing_list_addpost|bill|collect)\(\);\s*("";)?\s*$/ - or $c =~ /^\s*\$cust_bill\->(comp|realtime_card|realtime_ach|realtime_card_cybercash|batch_card|send)\(\);\s*$/ + or $c =~ /^\s*\$cust_bill\->(comp|realtime_(card|ach|lec)|realtime_card_cybercash|batch_card|send)\(\);\s*$/ or $c =~ /^\s*\$cust_bill\->send\(\'\w+\'\);\s*$/ -- cgit v1.2.1 From edb6a2341e74b303ea6278a294be9162ddc46c01 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 22 Nov 2002 12:19:15 +0000 Subject: fix nasty typo which would affect credit card payments --- FS/FS/cust_bill.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 75e2b1718..3481a9a86 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -793,7 +793,7 @@ sub realtime_bop { if ( $transaction->is_success() ) { my %method2payby = ( - ' CC' => 'CARD', + 'CC' => 'CARD', 'ECHECK' => 'CHEK', 'LEC' => 'LECB', ); @@ -1121,7 +1121,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.54 2002-11-19 22:48:02 ivan Exp $ +$Id: cust_bill.pm,v 1.55 2002-11-22 12:19:15 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From f4ea75e514763082b64e1b3654cfbbba2ddf1c01 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 25 Nov 2002 10:46:55 +0000 Subject: fix disappearing radius group bug, whew --- FS/FS/svc_acct.pm | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index c808aeea4..141133403 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -1,7 +1,7 @@ package FS::svc_acct; use strict; -use vars qw( @ISA $noexport_hack $conf +use vars qw( @ISA $DEBUG $me $noexport_hack $conf $dir_prefix @shells $usernamemin $usernamemax $passwordmin $passwordmax $username_ampersand $username_letter $username_letterfirst @@ -32,6 +32,9 @@ use FS::Msgcat qw(gettext); @ISA = qw( FS::svc_Common ); +$DEBUG = 0; +$me = '[FS::svc_acct]'; + #ask FS::UID to run this stuff for us later $FS::UID::callback{'FS::svc_acct'} = sub { $conf = new FS::Conf; @@ -496,6 +499,7 @@ sqlradius export only) sub replace { my ( $new, $old ) = ( shift, shift ); my $error; + warn "$me replacing $old with $new\n" if $DEBUG; return "Username in use" if $old->username ne $new->username && @@ -522,7 +526,13 @@ sub replace { local $FS::UID::AutoCommit = 0; my $dbh = dbh; + # redundant, but so $new->usergroup gets set + my $error = $new->check; + return $error if $error; + $old->usergroup( [ $old->radius_groups ] ); + warn "old groups: ". join(' ',@{$old->usergroup}). "\n" if $DEBUG; + warn "new groups: ". join(' ',@{$new->usergroup}). "\n" if $DEBUG; if ( $new->usergroup ) { #(sorta) false laziness with FS::part_export::sqlradius::_export_replace my @newgroups = @{$new->usergroup}; -- cgit v1.2.1 From 1caff2f971082d5ccce9928726b4b2e88678ee7a Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 26 Nov 2002 05:42:19 +0000 Subject: remove harmless re-my to silence warning --- FS/FS/svc_acct.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 141133403..388b8dd88 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -527,7 +527,7 @@ sub replace { my $dbh = dbh; # redundant, but so $new->usergroup gets set - my $error = $new->check; + $error = $new->check; return $error if $error; $old->usergroup( [ $old->radius_groups ] ); -- cgit v1.2.1 From 3ac3bd76d4716016ba3a51f51a83a02732d9d2de Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 26 Nov 2002 10:25:55 +0000 Subject: ldap export: fix $crypt_password --- FS/FS/part_export/ldap.pm | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export/ldap.pm b/FS/FS/part_export/ldap.pm index 68a63528e..fd7f11d90 100644 --- a/FS/FS/part_export/ldap.pm +++ b/FS/FS/part_export/ldap.pm @@ -1,11 +1,13 @@ package FS::part_export::ldap; -use vars qw(@ISA); +use vars qw(@ISA @saltset); use FS::Record qw( dbh ); use FS::part_export; @ISA = qw(FS::part_export); +@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); + sub rebless { shift; } sub _export_insert { @@ -26,7 +28,6 @@ sub _export_insert { $crypt_password = crypt( $svc_acct->_password, $saltset[int(rand(64))].$saltset[int(rand(64))] ); - my $username_attrib; my %attrib = map { /^\s*(\w+)\s+(.*\S)\s*$/; $username_attrib = $1 if $2 eq '$username'; @@ -218,7 +219,7 @@ sub ldap_insert { #subroutine, not method } my $status = $ldap->add( $userdn, attrs => [ %attrib ] ); - die $status->error if $status->is_error; + die 'LDAP error: '. $status->error. "\n" if $status->is_error; $ldap->unbind; } @@ -245,7 +246,7 @@ sub ldap_connect { my $ldap = Net::LDAP->new($machine) or die $@; my $status = $ldap->bind( $dn, %bind_options ); - die $status->error if $status->is_error; + die 'LDAP error: '. $status->error. "\n" if $status->is_error; $ldap; } -- cgit v1.2.1 From 5153f40717ef15e1d41aeb86d29b204e84c81509 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 28 Nov 2002 05:10:33 +0000 Subject: deprecate username_policy --- FS/FS/Conf.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index e76ea3873..6de311596 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -801,7 +801,7 @@ httemplate/docs/config.html { 'key' => 'username_policy', - 'section' => '', + 'section' => 'deprecated', 'description' => 'This file controls the mechanism for preventing duplicate usernames in passwd/radius files exported from svc_accts. This should be one of \'prepend domsvc\' \'append domsvc\' \'append domain\' or \'append @domain\'', 'type' => 'select', 'select_enum' => [ 'prepend domsvc', 'append domsvc', 'append domain', 'append @domain' ], -- cgit v1.2.1 From 3926b0ad41690f96041284fc12eb75e5f9b10357 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 28 Nov 2002 05:44:19 +0000 Subject: add -g FreeBSD shellcommands export as per "Stephen Bechard" --- FS/FS/part_export.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 4b15f44ca..d62bef50d 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -785,7 +785,7 @@ tie my %ldap_options, 'Tie::IxHash', 'desc' => 'Real-time export via remote SSH (i.e. useradd, userdel, etc.)', 'options' => \%shellcommands_options, 'nodomain' => 'Y', - 'notes' => 'Run remote commands via SSH. Usernames are considered unique (also see shellcommands_withdomain). You probably want this if the commands you are running will not accept a domain as a parameter. You will need to setup SSH for unattended operation.

Use these buttons for some useful presets:
', + 'notes' => 'Run remote commands via SSH. Usernames are considered unique (also see shellcommands_withdomain). You probably want this if the commands you are running will not accept a domain as a parameter. You will need to setup SSH for unattended operation.

Use these buttons for some useful presets:
', }, 'shellcommands_withdomain' => { -- cgit v1.2.1 From 20f37c06d04ecf57e9b464bad23998fce6ac1e80 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 4 Dec 2002 12:31:49 +0000 Subject: empty invoice_lines() fix --- FS/FS/cust_bill.pm | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 3481a9a86..1742f604f 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -1092,16 +1092,14 @@ sub print_text { # ); #and subroutine for the template - sub FS::cust_bill::_template::invoice_lines { - my $lines = shift or return @buf; + my $lines = shift || scalar(@buf); map { scalar(@buf) ? shift @buf : [ '', '' ]; } ( 1 .. $lines ); } - #and fill it in $FS::cust_bill::_template::page = 1; my $lines; @@ -1121,7 +1119,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.55 2002-11-22 12:19:15 ivan Exp $ +$Id: cust_bill.pm,v 1.56 2002-12-04 12:31:49 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 59aa696fb295598b6ceecaa45009617ef6d56aaf Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 12 Dec 2002 21:44:28 +0000 Subject: custnum in welcome email --- FS/FS/svc_acct.pm | 1 + 1 file changed, 1 insertion(+) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 388b8dd88..2062eb9ba 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -369,6 +369,7 @@ sub insert { 'subject' => $welcome_subject, 'mimetype' => $welcome_mimetype, 'body' => $welcome_template->fill_in( HASH => { + 'custnum' => $self->custnum, 'username' => $self->username, 'password' => $self->_password, 'first' => $cust_main->first, -- cgit v1.2.1 From 64d21fc13eddf275f614f54ff9e17eca74dcd858 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 13 Dec 2002 00:31:32 +0000 Subject: taxclass fix (?) --- FS/FS/cust_main.pm | 23 +++++++++++------------ 1 file changed, 11 insertions(+), 12 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 237abcddb..890371de7 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1058,26 +1058,25 @@ sub bill { || $self->payby eq 'COMP' || $taxable_charged == 0 ) { - my $cust_main_county = - qsearchs('cust_main_county',{ + my $cust_main_county = qsearchs('cust_main_county',{ 'state' => $self->state, 'county' => $self->county, 'country' => $self->country, 'taxclass' => $part_pkg->taxclass, - } ) - or qsearchs('cust_main_county',{ + } ); + $cust_main_county ||= qsearchs('cust_main_county',{ 'state' => $self->state, 'county' => $self->county, 'country' => $self->country, 'taxclass' => '', - } ) - or do { - $dbh->rollback if $oldAutoCommit; - return - "fatal: can't find tax rate for state/county/country/taxclass ". - join('/', ( map $self->$_(), qw(state county country) ), - $part_pkg->taxclass ). "\n"; - }; + } ); + unless ( $cust_main_county ) { + $dbh->rollback if $oldAutoCommit; + return + "fatal: can't find tax rate for state/county/country/taxclass ". + join('/', ( map $self->$_(), qw(state county country) ), + $part_pkg->taxclass ). "\n"; + } if ( $cust_main_county->exempt_amount ) { my ($mon,$year) = (localtime($sdate) )[4,5]; -- cgit v1.2.1 From edbcab06936c79a4f8d4edc0d0222139fa8c312c Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 14 Dec 2002 21:18:23 +0000 Subject: fix for auditing packages --- FS/FS/cust_svc.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index 7516be599..8bcb0fcca 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -220,6 +220,7 @@ sub check { # or new FS::pkg_svc ( { 'pkgpart' => $cust_pkg->pkgpart, # 'svcpart' => $self->svcpart, # 'quantity' => 0 } ); + my $quantity = $pkg_svc ? $pkg_svc->quantity : 0; my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $self->pkgnum, @@ -227,7 +228,7 @@ sub check { }); return "Already ". scalar(@cust_svc). " ". $part_svc->svc. " services for pkgnum ". $self->pkgnum - if scalar(@cust_svc) >= $pkg_svc->quantity; + if scalar(@cust_svc) >= $quantity; } ''; #no error -- cgit v1.2.1 From 50dbca8812cac271c584cbe5629d4583cd11a01c Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 16 Dec 2002 21:52:01 +0000 Subject: fix for Pg 7.3, are there others? --- FS/FS/part_svc.pm | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_svc.pm b/FS/FS/part_svc.pm index 06c15ed2a..63bc2ad1c 100644 --- a/FS/FS/part_svc.pm +++ b/FS/FS/part_svc.pm @@ -265,12 +265,12 @@ COLUMNNAME, or a new part_svc_column object if none exists. =cut sub part_svc_column { - my $self = shift; - my $columnname = shift; - qsearchs('part_svc_column', { - 'svcpart' => $self->svcpart, - 'columnname' => $columnname, - } + my( $self, $columnname) = @_; + $self->svcpart && + qsearchs('part_svc_column', { + 'svcpart' => $self->svcpart, + 'columnname' => $columnname, + } ) or new FS::part_svc_column { 'svcpart' => $self->svcpart, 'columnname' => $columnname, -- cgit v1.2.1 From 99076cc92a72f9c578c95d527b14b741434b4a8f Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 17 Dec 2002 09:24:59 +0000 Subject: adding freeside-sqlradius-seconds --- FS/MANIFEST | 1 + FS/bin/freeside-sqlradius-seconds | 57 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 58 insertions(+) create mode 100644 FS/bin/freeside-sqlradius-seconds (limited to 'FS') diff --git a/FS/MANIFEST b/FS/MANIFEST index 47c3bf206..9c387d42e 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -21,6 +21,7 @@ bin/freeside-radgroup bin/freeside-receivables-report bin/freeside-sqlradius-radacctd bin/freeside-sqlradius-reset +bin/freeside-sqlradius-seconds bin/freeside-tax-report bin/freeside-cc-receipts-report bin/freeside-credit-report diff --git a/FS/bin/freeside-sqlradius-seconds b/FS/bin/freeside-sqlradius-seconds new file mode 100644 index 000000000..e65b87f89 --- /dev/null +++ b/FS/bin/freeside-sqlradius-seconds @@ -0,0 +1,57 @@ +#!/usr/bin/perl -Tw + +use strict; +use Date::Parse; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearchs); +use FS::svc_acct; + +my $fs_user = shift or die &usage; +adminsuidsetup( $fs_user ); + +my $target_user = shift or die &usage; +my $start = shift or die &usage; +my $stop = shift || time; + +my $svc_acct = qsearchs( 'svc_acct', { 'username' => $target_user } ); +die "username $target_user not found\n" unless $svc_acct; + +print $svc_acct->seconds_since_sqlradacct( str2time($start), str2time($stop) ); + +sub usage { + die "Usage:\n\n freeside-sqlradius-seconds freeside_username target_username start_date stop_date\n"; +} + + +=head1 NAME + +freeside-sqlradius-seconds - Real-time radacct import daemon + +=head1 SYNOPSIS + + freeside-sqlradius-seconds freeside_username target_username start_date [ stop_date ] + +=head1 DESCRIPTION + +Returns the number of seconds the specified username has been online between +start_date (inclusive) and stop_date (exclusive). +See L + +B is a username added by freeside-adduser. +B is the username of the user account to query. +B and B are in any format Date::Parse is happy with. +B defaults to now if not specified. + +=head1 BUGS + +Selection of the account in question is rather simplistic in that +B doesn't necessarily identify a unique account (and wouldn't +even if a domain was specified), and no sqlradius export is checked for. + +=head1 SEE ALSO + +L + +=cut + +1; -- cgit v1.2.1 From 414b0f5b52ac15a4fdec9706727ff541d3bca039 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 17 Dec 2002 09:30:52 +0000 Subject: carriage return helps alot --- FS/bin/freeside-sqlradius-seconds | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/bin/freeside-sqlradius-seconds b/FS/bin/freeside-sqlradius-seconds index e65b87f89..f785e23c2 100644 --- a/FS/bin/freeside-sqlradius-seconds +++ b/FS/bin/freeside-sqlradius-seconds @@ -16,7 +16,8 @@ my $stop = shift || time; my $svc_acct = qsearchs( 'svc_acct', { 'username' => $target_user } ); die "username $target_user not found\n" unless $svc_acct; -print $svc_acct->seconds_since_sqlradacct( str2time($start), str2time($stop) ); +print $svc_acct->seconds_since_sqlradacct( str2time($start), str2time($stop) ). + "\n"; sub usage { die "Usage:\n\n freeside-sqlradius-seconds freeside_username target_username start_date stop_date\n"; -- cgit v1.2.1 From d86fad39ef5038a76c87e15b03b579f5151eb55b Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 17 Dec 2002 09:35:36 +0000 Subject: doh --- FS/bin/freeside-sqlradius-seconds | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/bin/freeside-sqlradius-seconds b/FS/bin/freeside-sqlradius-seconds index f785e23c2..e40dc91b6 100644 --- a/FS/bin/freeside-sqlradius-seconds +++ b/FS/bin/freeside-sqlradius-seconds @@ -16,7 +16,9 @@ my $stop = shift || time; my $svc_acct = qsearchs( 'svc_acct', { 'username' => $target_user } ); die "username $target_user not found\n" unless $svc_acct; -print $svc_acct->seconds_since_sqlradacct( str2time($start), str2time($stop) ). +print $svc_acct->seconds_since_sqlradacct( + str2time($start), + $stop ? str2time($stop) : time ). "\n"; sub usage { -- cgit v1.2.1 From eb3e4b97673b20b626774b9e000c5c327c991d5b Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 17 Dec 2002 09:37:12 +0000 Subject: grr double doh --- FS/bin/freeside-sqlradius-seconds | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/bin/freeside-sqlradius-seconds b/FS/bin/freeside-sqlradius-seconds index e40dc91b6..d2358cd5e 100644 --- a/FS/bin/freeside-sqlradius-seconds +++ b/FS/bin/freeside-sqlradius-seconds @@ -11,7 +11,7 @@ adminsuidsetup( $fs_user ); my $target_user = shift or die &usage; my $start = shift or die &usage; -my $stop = shift || time; +my $stop = scalar(@_) ? shift : ''; my $svc_acct = qsearchs( 'svc_acct', { 'username' => $target_user } ); die "username $target_user not found\n" unless $svc_acct; -- cgit v1.2.1 From d37105c93eae1366ee72ef93ae3d79cc5b04ade6 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 17 Dec 2002 09:47:06 +0000 Subject: is this broken or is the calculation? --- FS/bin/freeside-sqlradius-seconds | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-sqlradius-seconds b/FS/bin/freeside-sqlradius-seconds index d2358cd5e..0539cb4d2 100644 --- a/FS/bin/freeside-sqlradius-seconds +++ b/FS/bin/freeside-sqlradius-seconds @@ -10,16 +10,13 @@ my $fs_user = shift or die &usage; adminsuidsetup( $fs_user ); my $target_user = shift or die &usage; -my $start = shift or die &usage; -my $stop = scalar(@_) ? shift : ''; +my $start = scalar(@_) && str2time(shift) or die &usage; +my $stop = scalar(@_) ? str2time(shift) : time; my $svc_acct = qsearchs( 'svc_acct', { 'username' => $target_user } ); die "username $target_user not found\n" unless $svc_acct; -print $svc_acct->seconds_since_sqlradacct( - str2time($start), - $stop ? str2time($stop) : time ). - "\n"; +print $svc_acct->seconds_since_sqlradacct( $start, $stop ). "\n"; sub usage { die "Usage:\n\n freeside-sqlradius-seconds freeside_username target_username start_date stop_date\n"; -- cgit v1.2.1 From 9f981d37086cea91e17aa2aefeee43388c60eb19 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 17 Dec 2002 09:48:46 +0000 Subject: sigh --- FS/bin/freeside-sqlradius-seconds | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-sqlradius-seconds b/FS/bin/freeside-sqlradius-seconds index 0539cb4d2..31450bd2c 100644 --- a/FS/bin/freeside-sqlradius-seconds +++ b/FS/bin/freeside-sqlradius-seconds @@ -10,8 +10,8 @@ my $fs_user = shift or die &usage; adminsuidsetup( $fs_user ); my $target_user = shift or die &usage; -my $start = scalar(@_) && str2time(shift) or die &usage; -my $stop = scalar(@_) ? str2time(shift) : time; +my $start = scalar(@_) ? str2time(shift) : die &usage; +my $stop = scalar(@_) ? str2time(shift) : time; my $svc_acct = qsearchs( 'svc_acct', { 'username' => $target_user } ); die "username $target_user not found\n" unless $svc_acct; -- cgit v1.2.1 From 0d6147067e8d5317d01692f8588b3a0167c664c8 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 17 Dec 2002 09:52:46 +0000 Subject: sheesh --- FS/bin/freeside-sqlradius-seconds | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-sqlradius-seconds b/FS/bin/freeside-sqlradius-seconds index 31450bd2c..a61e97730 100644 --- a/FS/bin/freeside-sqlradius-seconds +++ b/FS/bin/freeside-sqlradius-seconds @@ -10,8 +10,9 @@ my $fs_user = shift or die &usage; adminsuidsetup( $fs_user ); my $target_user = shift or die &usage; -my $start = scalar(@_) ? str2time(shift) : die &usage; -my $stop = scalar(@_) ? str2time(shift) : time; +my $start = shift or die &usage; +$start = str2time($start); +my $stop = scalar(@_) ? str2time(shift) : time; my $svc_acct = qsearchs( 'svc_acct', { 'username' => $target_user } ); die "username $target_user not found\n" unless $svc_acct; -- cgit v1.2.1 From 641e3f253b22c54c8970213ef86e04337caab948 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 17 Dec 2002 10:36:39 +0000 Subject: sqlradius time calculation fix wrt open sessions --- FS/FS/cust_svc.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index 8bcb0fcca..66daec17b 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -394,11 +394,12 @@ sub seconds_since_sqlradacct { FROM radacct WHERE UserName = ? AND $str2time AcctStartTime ) >= ? + AND $str2time AcctStartTime ) < ? AND ( ? - $str2time AcctStartTime ) ) < 86400 AND ( $str2time AcctStopTime ) = 0 OR AcctStopTime IS NULL )"; $sth = $dbh->prepare($query) or die $dbh->errstr; - $sth->execute($end, $username, $start, $end) + $sth->execute($end, $username, $start, $end, $end) or die $sth->errstr. " executing query $query"; my $start_during = $sth->fetchrow_arrayref->[0]; -- cgit v1.2.1 From 869f3b5401b5111789bf03a7a4cc5699ad2993a7 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 17 Dec 2002 10:42:26 +0000 Subject: doh! but finally fixed --- FS/bin/freeside-sqlradius-seconds | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/bin/freeside-sqlradius-seconds b/FS/bin/freeside-sqlradius-seconds index a61e97730..1c978fa8a 100644 --- a/FS/bin/freeside-sqlradius-seconds +++ b/FS/bin/freeside-sqlradius-seconds @@ -12,7 +12,7 @@ adminsuidsetup( $fs_user ); my $target_user = shift or die &usage; my $start = shift or die &usage; $start = str2time($start); -my $stop = scalar(@_) ? str2time(shift) : time; +my $stop = scalar(@ARGV) ? str2time(shift) : time; my $svc_acct = qsearchs( 'svc_acct', { 'username' => $target_user } ); die "username $target_user not found\n" unless $svc_acct; -- cgit v1.2.1 From f800872bff0d887ee096dfef186e6da7275ce5ae Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 17 Dec 2002 21:31:20 +0000 Subject: invoice_lines() fix --- FS/FS/cust_bill.pm | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 1742f604f..23e8731dc 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -1032,9 +1032,9 @@ sub print_text { or die "cannot load config file $templatefile"; $invoice_lines = 0; my $wasfunc = 0; - foreach ( grep /invoice_lines\(\d+\)/, @invoice_template ) { #kludgy - /invoice_lines\((\d+)\)/; - $invoice_lines += $1; + foreach ( grep /invoice_lines\(\d*\)/, @invoice_template ) { #kludgy + /invoice_lines\((\d*)\)/; + $invoice_lines += $1 || scalar(@buf); $wasfunc=1; } die "no invoice_lines() functions in template?" unless $wasfunc; @@ -1119,7 +1119,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.56 2002-12-04 12:31:49 ivan Exp $ +$Id: cust_bill.pm,v 1.57 2002-12-17 21:31:20 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From a6339c3ac72353911a0b7f585b758a4b6aada899 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 21 Dec 2002 04:31:05 +0000 Subject: kludge around uninitialized value errors --- FS/FS/svc_acct.pm | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 2062eb9ba..83af6ff52 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -266,7 +266,11 @@ sub insert { # qsearch('export_svc', { 'exportnum' => $part_export->exportnum }); #} - my $nodomain = $exports->{$part_export->exporttype}{'nodomain'}; + #my $nodomain = $exports->{$part_export->exporttype}{'nodomain'}; + #silly kludge to avoid uninitialized value errors + my $nodomain = exists( $exports->{$part_export->exporttype}{'nodomain'} ) + ? $exports->{$part_export->exporttype}{'nodomain'} + : ''; if ( $nodomain =~ /^Y/i ) { $conflict_user_svcpart{$_} = $part_export->exportnum foreach @svcparts; -- cgit v1.2.1 From 8c679e623c0e21d3d4e1b1966b310db61871e119 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 21 Dec 2002 07:36:52 +0000 Subject: $noexport hack moved to svc_Common --- FS/FS/svc_acct.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 83af6ff52..659835626 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -1,7 +1,7 @@ package FS::svc_acct; use strict; -use vars qw( @ISA $DEBUG $me $noexport_hack $conf +use vars qw( @ISA $DEBUG $me $conf $dir_prefix @shells $usernamemin $usernamemax $passwordmin $passwordmax $username_ampersand $username_letter $username_letterfirst @@ -186,7 +186,7 @@ sqlradius export only) (TODOC: L and L) -(TODOC: new exports! $noexport_hack) +(TODOC: new exports!) =cut @@ -411,7 +411,7 @@ error, otherwise returns false. The corresponding FS::cust_svc record will be deleted as well. -(TODOC: new exports! $noexport_hack) +(TODOC: new exports!) =cut -- cgit v1.2.1 From 3ed2aae6b3e6b303b4058f9cd6e54ea377196b0a Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 21 Dec 2002 10:02:24 +0000 Subject: better qsearchs warning --- FS/FS/Record.pm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index ebcbbb497..40215100f 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -330,9 +330,11 @@ for a single item, or your data is corrupted. =cut sub qsearchs { # $result_record = &FS::Record:qsearchs('table',\%hash); + my $table = $_[0]; my(@result) = qsearch(@_); - carp "warning: Multiple records in scalar search!" if scalar(@result) > 1; - #should warn more vehemently if the search was on a primary key? + carp "warning: Multiple records in scalar search ($table)" + if scalar(@result) > 1; + #should warn more vehemently if the search was on a primary key? scalar(@result) ? ($result[0]) : (); } -- cgit v1.2.1 From cbb506ec10170d3f77d618596ca8cd25d08b2bd2 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 21 Dec 2002 10:14:48 +0000 Subject: could be multiple returns from these searches, with taxclasses --- FS/FS/cust_main.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 890371de7..1727c4b94 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -591,13 +591,13 @@ sub check { # bad idea to disable, causes billing to fail because of no tax rates later # unless ( $import ) { - unless ( qsearchs('cust_main_county', { + unless ( qsearch('cust_main_county', { 'country' => $self->country, 'state' => '', } ) ) { return "Unknown state/county/country: ". $self->state. "/". $self->county. "/". $self->country - unless qsearchs('cust_main_county',{ + unless qsearch('cust_main_county',{ 'state' => $self->state, 'county' => $self->county, 'country' => $self->country, -- cgit v1.2.1 From 1a7b34a94745208217187050c1daec5bb31b7eb7 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 22 Dec 2002 08:53:25 +0000 Subject: -p option for freeside-daily to only run for a particular payby $disable_agentcheck option for cust_pkg for import optimization --- FS/FS/cust_pkg.pm | 15 ++++++++++----- FS/bin/freeside-daily | 15 +++++++++++---- 2 files changed, 21 insertions(+), 9 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index e83b95156..c15e2fe9d 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -1,7 +1,7 @@ package FS::cust_pkg; use strict; -use vars qw(@ISA); +use vars qw(@ISA $disable_agentcheck); use FS::UID qw( getotaker dbh ); use FS::Record qw( qsearch qsearchs ); use FS::cust_svc; @@ -21,6 +21,8 @@ use FS::svc_forward; @ISA = qw( FS::Record ); +$disable_agentcheck = 0; + sub _cache { my $self = shift; my ( $hashref, $cache ) = @_; @@ -142,10 +144,13 @@ sub insert { my $cust_main = $self->cust_main; return "Unknown customer ". $self->custnum unless $cust_main; - my $agent = qsearchs( 'agent', { 'agentnum' => $cust_main->agentnum } ); - my $pkgpart_href = $agent->pkgpart_hashref; - return "agent ". $agent->agentnum. " can't purchase pkgpart ". $self->pkgpart - unless $pkgpart_href->{ $self->pkgpart }; + unless ( $disable_agentcheck ) { + my $agent = qsearchs( 'agent', { 'agentnum' => $cust_main->agentnum } ); + my $pkgpart_href = $agent->pkgpart_hashref; + return "agent ". $agent->agentnum. + " can't purchase pkgpart ". $self->pkgpart + unless $pkgpart_href->{ $self->pkgpart }; + } $self->SUPER::insert; diff --git a/FS/bin/freeside-daily b/FS/bin/freeside-daily index 1db786120..c82dc07a0 100755 --- a/FS/bin/freeside-daily +++ b/FS/bin/freeside-daily @@ -11,16 +11,19 @@ use FS::cust_main; &untaint_argv; #what it sounds like (eww) use vars qw($opt_d $opt_v); -getopts("d:v"); +getopts("p:d:v"); my $user = shift or die &usage; adminsuidsetup $user; $FS::cust_main::Debug = 1 if $opt_v; +my %search; +$search{'payby'} = $opt_p if $opt_p; + my @cust_main = @ARGV - ? map { qsearchs('cust_main', { custnum => $_ } ) } @ARGV - : qsearch('cust_main', {} ) + ? map { qsearchs('cust_main', { custnum => $_, %search } ) } @ARGV + : qsearch('cust_main', \%search ) ; #we're at now now (and later). @@ -95,7 +98,7 @@ freeside-daily - Run daily billing and invoice collection events. =head1 SYNOPSIS - freeside-daily [ -d 'date' ] user [ custnum custnum ... ] + freeside-daily [ -d 'date' ] [ -p 'payby' ] [ -v ] user [ custnum custnum ... ] =head1 DESCRIPTION @@ -110,6 +113,10 @@ the bill and collect methods of a cust_main object. See L. -d: Pretend it's 'date'. Date is in any format Date::Parse is happy with, but be careful. + -p: Only process customers with the specified payby (CARD, CHEK, BILL, COMP, LECB) + + -v: enable debugging + user: From the mapsecrets file - see config.html from the base documentation custnum: if one or more customer numbers are specified, only bills those -- cgit v1.2.1 From a7ac7ab3af0dd4f9773aec7c59515fefc8eaedec Mon Sep 17 00:00:00 2001 From: steve Date: Mon, 23 Dec 2002 14:24:06 +0000 Subject: added stuff for selfservice_server-quiet, signup_server-quiet, and emailcancel messages. --- FS/FS/Conf.pm | 35 +++++++++++++++++++++++++++++++++++ FS/FS/cust_bill.pm | 5 +++-- 2 files changed, 38 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 6de311596..f0a4c9f45 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -879,6 +879,20 @@ httemplate/docs/config.html 'select_enum' => [ qw(en_US) ], }, + { + 'key' => 'selfservice_server-quiet', + 'section' => '', + 'description' => 'Disable decline and cancel emails generated by transactions initiated by the selfservice server. Not recommended, unless the customer will get instant feedback from a customer service UI, and receiving an email would be confusing/overkill.', + 'type' => 'checkbox', + }, + + { + 'key' => 'signup_server-quiet', + 'section' => '', + 'description' => 'Disable decline and cancel emails generated by transactions initiated by the signup server. Not recommended, unless the customer will get instant feedback from a customer service UI, and receiving an email would be confusing/overkill. Does not disable welcome emails.', + 'type' => 'checkbox', + }, + { 'key' => 'signup_server-payby', 'section' => '', @@ -923,6 +937,27 @@ httemplate/docs/config.html 'type' => 'checkbox', }, + { + 'key' => 'cancelmessage', + 'section' => 'billing', + 'description' => 'Template file for cancellation emails.', + 'type' => 'textarea', + }, + + { + 'key' => 'cancelsubject', + 'section' => 'billing', + 'description' => 'Subject line for cancellation emails.', + 'type' => 'text', + }, + + { + 'key' => 'emailcancel', + 'section' => 'billing', + 'description' => 'Enable emailing of cancellation notices.', + 'type' => 'checkbox', + }, + { 'key' => 'require_cardname', 'section' => 'billing', diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 23e8731dc..48315199a 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -7,6 +7,7 @@ use vars qw( $xaction $E_NoErr ); use vars qw( $bop_processor $bop_login $bop_password $bop_action @bop_options ); use vars qw( $ach_processor $ach_login $ach_password $ach_action @ach_options ); use vars qw( $invoice_lines @buf ); #yuck +use vars qw( $quiet ); use Date::Format; use Mail::Internet 1.44; use Mail::Header; @@ -823,7 +824,7 @@ sub realtime_bop { my $perror = "$processor error, invnum #". $self->invnum. ': '. $transaction->result_code. ": ". $transaction->error_message; - if ( $conf->exists('emaildecline') + if ( !$quiet && $conf->exists('emaildecline') && grep { $_ ne 'POST' } $cust_main->invoicing_list ) { my @templ = $conf->config('declinetemplate'); @@ -1119,7 +1120,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.57 2002-12-17 21:31:20 ivan Exp $ +$Id: cust_bill.pm,v 1.58 2002-12-23 14:22:48 steve Exp $ =head1 BUGS -- cgit v1.2.1 From b47b05fdc4af937a2df1a3b4017f550183814efc Mon Sep 17 00:00:00 2001 From: steve Date: Mon, 23 Dec 2002 14:54:24 +0000 Subject: added stuff for selfservice_server-quiet, signup_server-quiet, and emailcancel messages. --- FS/FS/cust_pkg.pm | 44 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 44 insertions(+) (limited to 'FS') diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index c15e2fe9d..88ffd4d17 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -2,6 +2,7 @@ package FS::cust_pkg; use strict; use vars qw(@ISA $disable_agentcheck); +use vars qw( $quiet ); use FS::UID qw( getotaker dbh ); use FS::Record qw( qsearch qsearchs ); use FS::cust_svc; @@ -19,6 +20,13 @@ use FS::svc_domain; use FS::svc_www; use FS::svc_forward; +# need all this for sending cancel emails in sub cancel + +use FS::Conf; +use Date::Format; +use Mail::Internet 1.44; +use Mail::Header; + @ISA = qw( FS::Record ); $disable_agentcheck = 0; @@ -295,7 +303,43 @@ sub cancel { $dbh->commit or die $dbh->errstr if $oldAutoCommit; + my $conf = new FS::Conf; + + if ( !$quiet && $conf->exists('emailcancel') + && grep { $_ ne 'POST' } $self->cust_main->invoicing_list) { + + my @invoicing_list = $self->cust_main->invoicing_list; + + my $invoice_from = $conf->config('invoice_from'); + my @print_text = map "$_\n", $conf->config('cancelmessage'); + my $subject = $conf->config('cancelsubject'); + my $smtpmachine = $conf->config('smtpmachine'); + + if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice + #false laziness w/FS::cust_pay::delete & fs_signup_server && ::realtime_card + #$ENV{SMTPHOSTS} = $smtpmachine; + $ENV{MAILADDRESS} = $invoice_from; + my $header = new Mail::Header ( [ + "From: $invoice_from", + "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ), + "Sender: $invoice_from", + "Reply-To: $invoice_from", + "Date: ". time2str("%a, %d %b %Y %X %z", time), + "Subject: $subject", + ] ); + my $message = new Mail::Internet ( + 'Header' => $header, + 'Body' => [ @print_text ], + ); + $!=0; + $message->smtpsend( Host => $smtpmachine ) + or $message->smtpsend( Host => $smtpmachine, Debug => 1 ); + #should this return an error? + } + } + ''; #no errors + } =item suspend -- cgit v1.2.1 From 21771a118aaf154f605cfae05ee830eaeb4dd818 Mon Sep 17 00:00:00 2001 From: steve Date: Mon, 23 Dec 2002 15:05:10 +0000 Subject: add email address to shellcommands don't error out when importing unaudited accounts (even though should probably be using $FS::svc_Common::noexport_hack anyway) --- FS/FS/part_export/shellcommands.pm | 10 ++++++++++ 1 file changed, 10 insertions(+) (limited to 'FS') diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm index 04e5041c3..dbd4017f8 100644 --- a/FS/FS/part_export/shellcommands.pm +++ b/FS/FS/part_export/shellcommands.pm @@ -34,17 +34,27 @@ sub _export_command { my ( $self, $action, $svc_acct) = (shift, shift, shift); my $command = $self->option($action); my $stdin = $self->option($action."_stdin"); + no strict 'vars'; { no strict 'refs'; ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields; } + + my $cust_pkg = $svc_acct->cust_svc->cust_pkg; + if ( $cust_pkg ) { + $email = ( grep { $_ ne 'POST' } $cust_pkg->cust_main->invoicing_list )[0]; + } else { + $email = ''; + } + $finger = shell_quote $finger; $quoted_password = shell_quote $_password; $domain = $svc_acct->domain; $crypt_password = ''; #surpress "used only once" warnings $crypt_password = crypt( $svc_acct->_password, $saltset[int(rand(64))].$saltset[int(rand(64))] ); + $self->shellcommands_queue( $svc_acct->svcnum, user => $self->option('user')||'root', host => $self->machine, -- cgit v1.2.1 From 1014e988be16a7158ff7ca0d0a6e7aac730517a0 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 23 Dec 2002 15:21:55 +0000 Subject: make agent available to invoice templates --- FS/FS/cust_bill.pm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 48315199a..331c809bc 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -1048,11 +1048,12 @@ sub print_text { #setup template variables package FS::cust_bill::_template; #! - use vars qw( $invnum $date $page $total_pages @address $overdue @buf ); + use vars qw( $invnum $date $page $total_pages @address $overdue @buf $agent ); $invnum = $self->invnum; $date = $self->_date; $page = 1; + $agent = $self->cust_main->agent->agent; if ( $FS::cust_bill::invoice_lines ) { $total_pages = @@ -1120,7 +1121,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.58 2002-12-23 14:22:48 steve Exp $ +$Id: cust_bill.pm,v 1.59 2002-12-23 15:21:55 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 022f47d636bcec1699a0e8ebce394f5756af5f8c Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 23 Dec 2002 23:56:26 +0000 Subject: remove gratuitous warning and better error messages --- FS/FS/svc_acct.pm | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 659835626..456c965af 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -366,7 +366,6 @@ sub insert { 'svcnum' => $self->svcnum, 'job' => 'FS::svc_acct::send_email' }; - warn "attempting to queue email to $to"; my $error = $wqueue->insert( 'to' => $to, 'from' => $welcome_from, @@ -383,14 +382,14 @@ sub insert { ); if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "queuing welcome email: $error"; + return "error queuing welcome email: $error"; } foreach my $jobnum ( @jobnums ) { my $error = $wqueue->depend_insert($jobnum); if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "queuing welcome email job dependancy: $error"; + return "error queuing welcome email job dependancy: $error"; } } -- cgit v1.2.1 From b1d4c3b5b5a05d38a4baf9c49bd7fdfb6990531d Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 24 Dec 2002 22:41:23 +0000 Subject: optimization for ginourmous numbers of packages for intergate, whew --- FS/bin/freeside-setup | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-setup b/FS/bin/freeside-setup index 8f3d99fd5..8b7466222 100755 --- a/FS/bin/freeside-setup +++ b/FS/bin/freeside-setup @@ -669,7 +669,7 @@ sub tables_hash_hack { ], 'primary_key' => 'pkgpart', 'unique' => [], - 'index' => [], + 'index' => [ [ disabled ], ], }, # 'part_title' => { @@ -712,7 +712,7 @@ sub tables_hash_hack { ], 'primary_key' => 'svcpart', 'unique' => [], - 'index' => [], + 'index' => [ [ 'disabled' ] ], }, 'part_svc_column' => { -- cgit v1.2.1 From 7926d92e41b592b08f15d250ac5e78f75a2a29c7 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 25 Dec 2002 06:59:09 +0000 Subject: declare $opt_p usage --- FS/bin/freeside-daily | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/bin/freeside-daily b/FS/bin/freeside-daily index c82dc07a0..579d071ac 100755 --- a/FS/bin/freeside-daily +++ b/FS/bin/freeside-daily @@ -10,7 +10,7 @@ use FS::Conf; use FS::cust_main; &untaint_argv; #what it sounds like (eww) -use vars qw($opt_d $opt_v); +use vars qw($opt_d $opt_v $opt_p); getopts("p:d:v"); my $user = shift or die &usage; -- cgit v1.2.1 From 652526712a97a71381b08b89b389d526bcbc85d1 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 27 Dec 2002 12:56:58 +0000 Subject: better times on failed billing events --- FS/FS/cust_main.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 1727c4b94..91ffa451a 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1335,7 +1335,8 @@ sub collect { my $cust_bill_event = new FS::cust_bill_event { 'invnum' => $cust_bill->invnum, 'eventpart' => $part_bill_event->eventpart, - '_date' => $invoice_time, + #'_date' => $invoice_time, + '_date' => time, 'status' => $status, 'statustext' => $statustext, }; -- cgit v1.2.1 From c423f1b4bdad5f4dea96c27f998215ca18745f6f Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 28 Dec 2002 09:16:49 +0000 Subject: prevent edge-case business-onlinepayment mod_perl leakage in multi-database installs. ugh. --- FS/FS/cust_bill.pm | 7 ++++++- FS/FS/svc_acct.pm | 3 +++ 2 files changed, 9 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 331c809bc..af248a7a8 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -36,6 +36,11 @@ $FS::UID::callback{'FS::cust_bill'} = sub { $invoice_from = $conf->config('invoice_from'); $smtpmachine = $conf->config('smtpmachine'); + ( $bop_processor,$bop_login, $bop_password, $bop_action ) = ( '', '', '', ''); + @bop_options = (); + ( $ach_processor,$ach_login, $ach_password, $ach_action ) = ( '', '', '', ''); + @ach_options = (); + if ( $conf->exists('business-onlinepayment') ) { ( $bop_processor, $bop_login, @@ -1121,7 +1126,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.59 2002-12-23 15:21:55 ivan Exp $ +$Id: cust_bill.pm,v 1.60 2002-12-28 09:16:49 ivan Exp $ =head1 BUGS diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 456c965af..9b953eac8 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -62,6 +62,9 @@ $FS::UID::callback{'FS::svc_acct'} = sub { $welcome_mimetype = $conf->config('welcome_email-mimetype') || 'text/plain'; } else { $welcome_template = ''; + $welcome_from = ''; + $welcome_subject = ''; + $welcome_mimetype = ''; } $smtpmachine = $conf->config('smtpmachine'); $radius_password = $conf->config('radius-password') || 'Password'; -- cgit v1.2.1 From fd69668cd33e9cfc2f1c8469c6e6b7089243d3e6 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 10 Jan 2003 07:41:05 +0000 Subject: pop off an extra blank line in business-onlinepayment options --- FS/FS/cust_bill.pm | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index af248a7a8..c661baa95 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -667,6 +667,10 @@ sub realtime_lec { sub realtime_bop { my( $self, $method, $processor, $login, $password, $action, $options ) = @_; + + #trim an extraneous blank line + pop @$options if scalar(@$options) % 2 && $options->[-1] =~ /^\s*$/; + my $cust_main = $self->cust_main; my $amount = $self->owed; @@ -1126,7 +1130,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.60 2002-12-28 09:16:49 ivan Exp $ +$Id: cust_bill.pm,v 1.61 2003-01-10 07:41:05 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From 2f9eb7976dca75dc6c585ea9c62f1b0898e3e953 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 14 Jan 2003 08:49:57 +0000 Subject: add freeside-selfservice-server to init script add domsvc checking as a foreign key --- FS/FS/svc_acct.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 9b953eac8..e0c4662b2 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -673,7 +673,8 @@ sub check { } my $error = $self->ut_numbern('svcnum') - || $self->ut_number('domsvc') + #|| $self->ut_number('domsvc') + || $self->ut_foreign_key('domsvc', 'svc_domain', 'svcnum' ) || $self->ut_textn('sec_phrase') ; return $error if $error; -- cgit v1.2.1 From 1bfcd9ce4738e5c9f3c8a309775235e823b2f82c Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 14 Jan 2003 09:26:49 +0000 Subject: move freeside-selfservice-server to proper MakeMaker install location --- FS/MANIFEST | 1 + FS/bin/freeside-selfservice-server | 235 +++++++++++++++++++++++++++++++++++++ 2 files changed, 236 insertions(+) create mode 100644 FS/bin/freeside-selfservice-server (limited to 'FS') diff --git a/FS/MANIFEST b/FS/MANIFEST index 9c387d42e..b3de623d7 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -19,6 +19,7 @@ bin/freeside-setinvoice bin/freeside-overdue bin/freeside-radgroup bin/freeside-receivables-report +bin/freeside-selfservice-server bin/freeside-sqlradius-radacctd bin/freeside-sqlradius-reset bin/freeside-sqlradius-seconds diff --git a/FS/bin/freeside-selfservice-server b/FS/bin/freeside-selfservice-server new file mode 100644 index 000000000..264cbc56d --- /dev/null +++ b/FS/bin/freeside-selfservice-server @@ -0,0 +1,235 @@ +#!/usr/bin/perl -w +# +# freeside-selfservice-server + +# alas, much false laziness with freeside-queued and fs_signup_server. at +# least it is slated to replace fs_{signup,passwd,mailadmin}_server +# should probably generalize the version in here, or better yet use +# Proc::Daemon or somesuch + +use strict; +use vars qw( $Debug %kids $kids $max_kids $shutdown $log_file $ssh_pid ); +use Fcntl qw(:flock); +use POSIX qw(:sys_wait_h setsid); +use IO::Handle; +use IO::Select; +use IO::File; +use Storable qw(nstore_fd fd_retrieve); +use Net::SSH qw(sshopen2); +use FS::UID qw(adminsuidsetup forksuidsetup); +use FS::ClientAPI; + +use FS::Conf; +use FS::cust_bill; +use FS::cust_pkg; + +$Debug = 2; # >= 2 will log packet contents, including potentially compromising + # information + +$shutdown = 0; +$max_kids = '10'; #? +$kids = 0; + +my $user = shift or die &usage; +my $machine = shift or die &usage; +my $pid_file = "/var/run/freeside-selfservice-server.$user.pid"; +#my $pid_file = "/var/run/freeside-selfservice-server.$user.pid"; $FS::UID::datasrc not posible, but should include machine name at least, hmm + +&init($user); + +my $conf = new FS::Conf; + +if ($conf->exists('selfservice_server-quiet')) { + $FS::cust_bill::quiet = 1; + $FS::cust_pkg::quiet = 1; +} + +my $clientd = "/usr/local/sbin/freeside-selfservice-clientd"; #better name? + +my $warnkids=0; +while (1) { + my($writer,$reader,$error) = (new IO::Handle, new IO::Handle, new IO::Handle); + warn "connecting to $machine\n" if $Debug; + + $ssh_pid = sshopen2($machine,$reader,$writer,$clientd); + +# nstore_fd(\*writer, {'hi'=>'there'}); + + warn "entering main loop\n" if $Debug; + my $undisp = 0; + my $s = IO::Select->new( $reader ); + while (1) { + + &reap_kids; + + warn "waiting for packet from client\n" if $Debug && !$undisp; + $undisp = 1; + my @handles = $s->can_read(5); + unless ( @handles ) { + &shutdown if $shutdown; + next; + } + + $undisp = 0; + + warn "receiving packet from client\n" if $Debug; + + my $packet = fd_retrieve($reader); + warn "packet received\n". + join('', map { " $_=>$packet->{$_}\n" } keys %$packet ) + if $Debug > 1; + + #prevent runaway forking + my $warnkids = 0; + while ( $kids >= $max_kids ) { + warn "WARNING: maximum $kids children reached\n" unless $warnkids++; + &reap_kids; + sleep 1; + } + + warn "forking child\n" if $Debug; + defined( my $pid = fork ) or die "can't fork: $!"; + if ( $pid ) { + $kids++; + $kids{$pid} = 1; + warn "child $pid spawned\n" if $Debug; + } else { #kid time + + #get new db handle + $FS::UID::dbh->{InactiveDestroy} = 1; + forksuidsetup($user); + + my $type = $packet->{_packet}; + warn "calling $type handler\n" if $Debug; + my $rv = eval { FS::ClientAPI->dispatch($type, $packet); }; + if ( $@ ) { + warn my $error = "WARNING: error dispatching $type: $@"; + $rv = { _error => $error }; + } + $rv->{_token} = $packet->{_token}; #identifier + + warn "sending response\n" if $Debug; + flock($writer, LOCK_EX) or die "FATAL: can't lock write stream: $!"; + nstore_fd($rv, $writer) or die "FATAL: can't send response: $!"; + $writer->flush or die "FATAL: can't flush: $!"; + flock($writer, LOCK_UN) or die "WARNING: can't release write lock: $!"; + + warn "child exiting\n" if $Debug; + exit; #end-of-kid + } + + } + +} + +### +# utility subroutines +### + +sub reap_kids { + #warn "reaping kids\n"; + foreach my $pid ( keys %kids ) { + my $kid = waitpid($pid, WNOHANG); + if ( $kid > 0 ) { + $kids--; + delete $kids{$kid}; + } + } + #warn "done reaping\n"; +} + +sub init { + my $user = shift; + + chdir "/" or die "Can't chdir to /: $!"; + open STDIN, '/dev/null' or die "Can't read /dev/null: $!"; + defined(my $pid = fork) or die "Can't fork: $!"; + if ( $pid ) { + print "freeside-selfservice-server to $machine started with pid $pid\n"; #logging to $log_file + exit unless $pid_file; + my $pidfh = new IO::File ">$pid_file" or exit; + print $pidfh "$pid\n"; + exit; + } + +# sub REAPER { my $pid = wait; $SIG{CHLD} = \&REAPER; $kids--; } +# #sub REAPER { my $pid = wait; $kids--; $SIG{CHLD} = \&REAPER; } +# $SIG{CHLD} = \&REAPER; + + $shutdown = 0; + $SIG{HUP} = sub { warn "SIGHUP received; shutting down\n"; $shutdown++; }; + $SIG{INT} = sub { warn "SIGINT received; shutting down\n"; $shutdown++; }; + $SIG{TERM} = sub { warn "SIGTERM received; shutting down\n"; $shutdown++; }; + $SIG{QUIT} = sub { warn "SIGQUIT received; shutting down\n"; $shutdown++; }; + $SIG{PIPE} = sub { warn "SIGPIPE received; shutting down\n"; $shutdown++; }; + + #false laziness w/freeside-queued + my $freeside_gid = scalar(getgrnam('freeside')) + or die "can't setgid to freeside group\n"; + $) = $freeside_gid; + $( = $freeside_gid; + #if freebsd can't setuid(), presumably it can't setgid() either. grr fleabsd + ($(,$)) = ($),$(); + $) = $freeside_gid; + + $> = $FS::UID::freeside_uid; + $< = $FS::UID::freeside_uid; + #freebsd is sofa king broken, won't setuid() + ($<,$>) = ($>,$<); + $> = $FS::UID::freeside_uid; + #eslaf + + $ENV{HOME} = (getpwuid($>))[7]; #for ssh + adminsuidsetup $user; + + #$log_file = "/usr/local/etc/freeside/selfservice.". $FS::UID::datasrc; #MACHINE NAME + $log_file = "/usr/local/etc/freeside/selfservice.$machine.log"; + + open STDOUT, '>/dev/null' + or die "Can't write to /dev/null: $!"; + setsid or die "Can't start a new session: $!"; + open STDERR, '>&STDOUT' or die "Can't dup stdout: $!"; + + $SIG{__DIE__} = \&_die; + $SIG{__WARN__} = \&_logmsg; + + warn "freeside-selfservice-server starting\n"; + +} + +sub shutdown { + my $wait = 12; #wait up to 1 minute + while ( $kids > 0 && $wait-- ) { + warn "waiting for $kids children to terminate"; + sleep 5; + } + warn "abandoning $kids children" if $kids; + kill 'TERM', $ssh_pid if $ssh_pid; + die "exiting"; +} + +sub _die { + my $msg = shift; + unlink $pid_file if -e $pid_file; + _logmsg($msg); +} + +sub _logmsg { + chomp( my $msg = shift ); + _do_logmsg( "[server] [". scalar(localtime). "] [$$] $msg\n" ); +} + +sub _do_logmsg { + chomp( my $msg = shift ); + my $log = new IO::File ">>$log_file"; + flock($log, LOCK_EX); + seek($log, 0, 2); + print $log "$msg\n"; + flock($log, LOCK_UN); + close $log; +} + +sub usage { + die "Usage:\n\n fs_signup_server user machine\n"; +} + -- cgit v1.2.1 From 2485346165b7ebb0e6d2052baa1b03546d44bece Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 16 Jan 2003 02:58:22 +0000 Subject: don't run empty shellcommands --- FS/FS/part_export/shellcommands.pm | 1 + 1 file changed, 1 insertion(+) (limited to 'FS') diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm index dbd4017f8..f592a838a 100644 --- a/FS/FS/part_export/shellcommands.pm +++ b/FS/FS/part_export/shellcommands.pm @@ -33,6 +33,7 @@ sub _export_unsuspend { sub _export_command { my ( $self, $action, $svc_acct) = (shift, shift, shift); my $command = $self->option($action); + return '' if $command =~ /^\s*$/; my $stdin = $self->option($action."_stdin"); no strict 'vars'; -- cgit v1.2.1 From e5e992881cee6c8bb5c64c101d1985d47fd62cd6 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 17 Jan 2003 06:21:38 +0000 Subject: selfservice cancel functionality --- FS/FS/ClientAPI/MyAccount.pm | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) (limited to 'FS') diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm index 674785524..9983b5d26 100644 --- a/FS/FS/ClientAPI/MyAccount.pm +++ b/FS/FS/ClientAPI/MyAccount.pm @@ -18,6 +18,7 @@ FS::ClientAPI->register_handlers( 'MyAccount/login' => \&login, 'MyAccount/customer_info' => \&customer_info, 'MyAccount/invoice' => \&invoice, + 'MyAccount/cancel' => \&cancel, ); #store in db? @@ -133,4 +134,23 @@ sub invoice { } +sub cancel { + my $p = shift; + my $session = $cache->get($p->{'session_id'}) + or return { 'error' => "Can't resume session" }; #better error message + + my $custnum = $session->{'custnum'}; + + my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ) + or return { 'error' => "unknown custnum $custnum" }; + + my @errors = $cust_main->cancel; + + my $error = scalar(@errors) ? join(' / ', @errors) : ''; + + return { 'error' => $error }; + +} + +1; -- cgit v1.2.1 From 561c9be9d086604225956da6cfdf9a9050176174 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 28 Jan 2003 06:08:39 +0000 Subject: crypt password export to ldap fix from dave denney --- FS/FS/part_export/ldap.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export/ldap.pm b/FS/FS/part_export/ldap.pm index fd7f11d90..57fd1f3f4 100644 --- a/FS/FS/part_export/ldap.pm +++ b/FS/FS/part_export/ldap.pm @@ -25,7 +25,7 @@ sub _export_insert { } } $crypt_password = ''; #surpress "used only once" warnings - $crypt_password = crypt( $svc_acct->_password, + $crypt_password = '{crypt}'. crypt( $svc_acct->_password, $saltset[int(rand(64))].$saltset[int(rand(64))] ); my $username_attrib; -- cgit v1.2.1 From 39b71146259e7c2eab3b0c3326000087a7dd75b1 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 28 Jan 2003 07:47:52 +0000 Subject: eek, and this is what caused connectup to fail too --- FS/bin/freeside-setup | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/bin/freeside-setup b/FS/bin/freeside-setup index 8b7466222..0ef3fc81b 100755 --- a/FS/bin/freeside-setup +++ b/FS/bin/freeside-setup @@ -669,7 +669,7 @@ sub tables_hash_hack { ], 'primary_key' => 'pkgpart', 'unique' => [], - 'index' => [ [ disabled ], ], + 'index' => [ [ 'disabled' ], ], }, # 'part_title' => { -- cgit v1.2.1 From c89aa83639038cc1946fec07a2dda252f64e5144 Mon Sep 17 00:00:00 2001 From: khoff Date: Wed, 5 Feb 2003 22:06:14 +0000 Subject: ip_netmask is gone now --- FS/FS/cust_svc.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index 66daec17b..5117eff45 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -292,7 +292,7 @@ sub label { my $domain = qsearchs( 'domain_record', { 'recnum' => $svc_x->recnum } ); $tag = $domain->reczone; } elsif ( $svcdb eq 'svc_broadband' ) { - $tag = $svc_x->ip_addr . '/' . $svc_x->ip_netmask; + $tag = $svc_x->ip_addr; } else { cluck "warning: asked for label of unsupported svcdb; using svcnum"; $tag = $svc_x->getfield('svcnum'); -- cgit v1.2.1 From 0354f39ed0e74fd2eae1d9da13906625b4f56591 Mon Sep 17 00:00:00 2001 From: khoff Date: Wed, 5 Feb 2003 23:17:17 +0000 Subject: svc_broadband rewrite --- FS/FS/addr_block.pm | 322 +++++++++++++++++++++++++++++++++++++++++++++ FS/FS/part_router_field.pm | 134 +++++++++++++++++++ FS/FS/part_sb_field.pm | 267 +++++++++++++++++++++++++++++++++++++ FS/FS/part_svc_router.pm | 32 +++++ FS/FS/router.pm | 156 ++++++++++++++++++++++ FS/FS/router_field.pm | 146 ++++++++++++++++++++ FS/FS/sb_field.pm | 148 +++++++++++++++++++++ FS/FS/svc_broadband.pm | 225 +++++++++++++++---------------- FS/bin/freeside-setup | 89 ++++++++----- 9 files changed, 1370 insertions(+), 149 deletions(-) create mode 100755 FS/FS/addr_block.pm create mode 100755 FS/FS/part_router_field.pm create mode 100755 FS/FS/part_sb_field.pm create mode 100755 FS/FS/part_svc_router.pm create mode 100755 FS/FS/router.pm create mode 100755 FS/FS/router_field.pm create mode 100755 FS/FS/sb_field.pm (limited to 'FS') diff --git a/FS/FS/addr_block.pm b/FS/FS/addr_block.pm new file mode 100755 index 000000000..b671723aa --- /dev/null +++ b/FS/FS/addr_block.pm @@ -0,0 +1,322 @@ +package FS::addr_block; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearchs qsearch dbh ); +use FS::router; +use FS::svc_broadband; +use NetAddr::IP; + +@ISA = qw( FS::Record ); + +=head1 NAME + +FS::addr_block - Object methods for addr_block records + +=head1 SYNOPSIS + + use FS::addr_block; + + $record = new FS::addr_block \%hash; + $record = new FS::addr_block { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::addr_block record describes an address block assigned for broadband +access. FS::addr_block inherits from FS::Record. The following fields are +currently supported: + +=over 4 + +=item blocknum - primary key, used in FS::svc_broadband to associate +services to the block. + +=item routernum - the router (see FS::router) to which this +block is assigned. + +=item ip_gateway - the gateway address used by customers within this block. + +=item ip_netmask - the netmask of the block, expressed as an integer. + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Create a new record. To add the record to the database, see "insert". + +=cut + +sub table { 'addr_block'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete + +Deletes this record from the database. If there is an error, returns the +error, otherwise returns false. + +sub delete { + my $self = shift; + return 'Block must be deallocated before deletion' + if $self->router; + + $self->SUPER::delete; +} + +=item replace OLD_RECORD + +Replaces OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=item check + +Checks all fields to make sure this is a valid record. If there is an error, +returns the error, otherwise returns false. Called by the insert and replace +methods. + +=cut + +sub check { + my $self = shift; + + my $error = + $self->ut_number('routernum') + || $self->ut_ip('ip_gateway') + || $self->ut_number('ip_netmask') + ; + return $error if $error; + + + # A routernum of 0 indicates an unassigned block and is allowed + return "Unknown routernum" + if ($self->routernum and not $self->router); + + my $self_addr = $self->NetAddr; + return "Cannot parse address: ". $self->ip_gateway . '/' . $self->ip_netmask + unless $self_addr; + + if (not $self->blocknum) { + my @block = grep { + my $block_addr = $_->NetAddr; + if($block_addr->contains($self_addr) + or $self_addr->contains($block_addr)) { $_; }; + } qsearch( 'addr_block', {}); + foreach(@block) { + return "Block intersects existing block ".$_->ip_gateway."/".$_->ip_netmask; + } + } + + ''; +} + + +=item router + +Returns the FS::router object corresponding to this object. If the +block is unassigned, returns undef. + +=cut + +sub router { + my $self = shift; + return qsearchs('router', { routernum => $self->routernum }); +} + +=item svc_broadband + +Returns a list of FS::svc_broadband objects associated +with this object. + +=cut + +sub svc_broadband { + my $self = shift; + return qsearch('svc_broadband', { blocknum => $self->blocknum }); +} + +=item NetAddr + +Returns a NetAddr::IP object for this block's address and netmask. + +=cut + +sub NetAddr { + my $self = shift; + + return new NetAddr::IP ($self->ip_gateway, $self->ip_netmask); +} + +=item next_free_addr + +Returns a NetAddr::IP object corresponding to the first unassigned address +in the block (other than the network, broadcast, or gateway address). If +there are no free addresses, returns false. + +=cut + +sub next_free_addr { + my $self = shift; + + my @used = map { $_->NetAddr->addr } + ($self, + qsearch('svc_broadband', { blocknum => $self->blocknum }) ); + + my @free = $self->NetAddr->hostenum; + while (my $ip = shift @free) { + if (not grep {$_ eq $ip->addr;} @used) { return $ip; }; + } + + ''; + +} + +=item allocate + +Allocates this address block to a router. Takes an FS::router object +as an argument. + +At present it's not possible to reallocate a block to a different router +except by deallocating it first, which requires that none of its addresses +be assigned. This is probably as it should be. + +=cut + +sub allocate { + my ($self, $router) = @_; + + return 'Block is already allocated' + if($self->router); + + return 'Block must be allocated to a router' + unless(ref $router eq 'FS::router'); + + my @svc = $self->svc_broadband; + if (@svc) { + return 'Block has assigned addresses: '. join ', ', map {$_->ip_addr} @svc; + } + + my $new = new FS::addr_block {$self->hash}; + $new->routernum($router->routernum); + return $new->replace($self); + +} + +=item deallocate + +Deallocates the block (i.e. sets the routernum to 0). If any addresses in the +block are assigned to services, it fails. + +=cut + +sub deallocate { + my $self = shift; + + my @svc = $self->svc_broadband; + if (@svc) { + return 'Block has assigned addresses: '. join ', ', map {$_->ip_addr} @svc; + } + + my $new = new FS::addr_block {$self->hash}; + $new->routernum(0); + return $new->replace($self); +} + +=item split_block + +Splits this address block into two equal blocks, occupying the same space as +the original block. The first of the two will also have the same blocknum. +The gateway address of each block will be set to the first usable address, i.e. +(network address)+1. Since this method is designed for use on unallocated +blocks, this is probably the correct behavior. + +(At present, splitting allocated blocks is disallowed. Anyone who wants to +implement this is reminded that each split costs three addresses, and any +customers who were using these addresses will have to be moved; depending on +how full the block was before being split, they might have to be moved to a +different block. Anyone who I wants to implement it is asked to tie it +to a configuration switch so that site admins can disallow it.) + +=cut + +sub split_block { + + # We should consider using Attribute::Handlers/Aspect/Hook::LexWrap/ + # something to atomicize functions, so that we can say + # + # sub split_block : atomic { + # + # instead of repeating all this AutoCommit verbage in every + # sub that does more than one database operation. + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $self = shift; + my $error; + + if ($self->router) { + return 'Block is already allocated'; + } + + #TODO: Smallest allowed block should be a config option. + if ($self->NetAddr->masklen() ge 30) { + return 'Cannot split blocks with a mask length >= 30'; + } + + my (@new, @ip); + $ip[0] = $self->NetAddr; + @ip = map {$_->first()} $ip[0]->split($self->ip_netmask + 1); + + foreach (0,1) { + $new[$_] = new FS::addr_block {$self->hash}; + $new[$_]->ip_gateway($ip[$_]->addr); + $new[$_]->ip_netmask($ip[$_]->masklen); + } + + $new[1]->blocknum(''); + + $error = $new[0]->replace($self); + if ($error) { + $dbh->rollback; + return $error; + } + + $error = $new[1]->insert; + if ($error) { + $dbh->rollback; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + return ''; +} + +=item merge + +To be implemented. + +=back + +=head1 BUGS + +Minimum block size should be a config option. It's hardcoded at /30 right +now because that's the smallest block that makes any sense at all. + +1; + diff --git a/FS/FS/part_router_field.pm b/FS/FS/part_router_field.pm new file mode 100755 index 000000000..73ca50fb6 --- /dev/null +++ b/FS/FS/part_router_field.pm @@ -0,0 +1,134 @@ +package FS::part_router_field; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearchs ); +use FS::router_field; +use FS::router; + + +@ISA = qw( FS::Record ); + +=head1 NAME + +FS::part_router_field - Object methods for part_router_field records + +=head1 SYNOPSIS + + use FS::part_router_field; + + $record = new FS::part_router_field \%hash; + $record = new FS::part_router_field { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +A part_router_field represents an xfield definition for routers. For more +information on xfields, see L. + +The following fields are supported: + +=over 4 + +=item routerfieldpart - primary key (assigned automatically) + +=item name - name of field + +=item length + +=item check_block + +=item list_source + +(See L for details on these fields.) + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Create a new record. To add the record to the database, see "insert". + +=cut + +sub table { 'part_router_field'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete + +Deletes this record from the database. If there is an error, returns the +error, otherwise returns false. + +=item replace OLD_RECORD + +Replaces OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=item check + +Checks all fields to make sure this is a valid record. If there is an error, +returns the error, otherwise returns false. Called by the insert and replace +methods. + +=cut + +sub check { + my $self = shift; + my $error = ''; + + $self->name =~ /^([a-z0-9_\-\.]{1,15})$/i + or return "Invalid field name for part_router_field"; + + ''; #no error +} + +=item list_values + +Equivalent to "eval($part_router_field->list_source)". + +=cut + +sub list_values { + my $self = shift; + return () unless $self->list_source; + my @opts = eval($self->list_source); + if($@) { + warn $@; + return (); + } else { + return @opts; + } +} + +=back + +=head1 VERSION + +$Id: + +=head1 BUGS + +Needless duplication of much of FS::part_sb_field, with the result that most of +the warnings about it apply here also. + +=head1 SEE ALSO + +FS::svc_broadband, FS::router, FS::router_field, schema.html +from the base documentation. + +=cut + +1; + diff --git a/FS/FS/part_sb_field.pm b/FS/FS/part_sb_field.pm new file mode 100755 index 000000000..8dca946b5 --- /dev/null +++ b/FS/FS/part_sb_field.pm @@ -0,0 +1,267 @@ +package FS::part_sb_field; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearchs ); + +@ISA = qw( FS::Record ); + +=head1 NAME + +FS::part_sb_field - Object methods for part_sb_field records + +=head1 SYNOPSIS + + use FS::part_sb_field; + + $record = new FS::part_sb_field \%hash; + $record = new FS::part_sb_field { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::part_sb_field object represents an extended field (xfield) definition +for svc_broadband's sb_field mechanism (see L). +FS::part_sb_field inherits from FS::Record. The following fields are +currently supported: + +=over 2 + +=item sbfieldpart - primary key (assigned automatically) + +=item name - name of the field + +=item svcpart - service type for which this field is available (see L) + +=item length - length of the contents of the field (see note #1) + +=item check_block - validation routine (see note #2) + +=item list_source - enumeration routine (see note #3) + +=back + +=head1 BACKGROUND + +Broadband services, unlike dialup services, are provided over a wide +variety of physical media (DSL, wireless, cable modems, digital circuits) +and network architectures (Ethernet, PPP, ATM). For many of these access +mechanisms, adding a new customer requires knowledge of some properties +of the physical connection (circuit number, the type of CPE in use, etc.). +It is unreasonable to expect ISPs to alter Freeside's schema (and the +associated library and UI code) to make each of these parameters a field in +svc_broadband. + +Hence sb_field and part_sb_field. They allow the Freeside administrator to +define 'extended fields' ('xfields') associated with svc_broadband records. +These are I processed in any way by Freeside itself; they exist solely for +use by exports (see L) and technical support staff. + +For a parallel mechanism (at the per-router level rather than per-service), +see L. + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Create a new record. To add the record to the database, see "insert". + +=cut + +sub table { 'part_sb_field'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete + +Deletes this record from the database. If there is an error, returns the +error, otherwise returns false. + +=item replace OLD_RECORD + +Replaces OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=item check + +Checks all fields to make sure this is a valid record. If there is an error, +returns the error, otherwise returns false. Called by the insert and replace +methods. + +=cut + +sub check { + my $self = shift; + my $error = ''; + + $error = $self->ut_numbern('svcpart'); + return $error if $error; + + unless (qsearchs('part_svc', { svcpart => $self->svcpart })) + { return "Unknown svcpart: " . $self->svcpart;} + + $self->name =~ /^([a-z0-9_\-\.]{1,15})$/i + or return "Invalid field name for part_sb_field"; + + #How to check input_block, display_block, and check_block? + + ''; #no error +} + +=item list_values + +If the I field is set, this method eval()s it and +returns its output. If the field is empty, list_values returns +an empty list. + +Any arguments passed to this method will be received by the list_source +code, but this behavior is a fortuitous accident and may be removed in +the future. + +=cut + +sub list_values { + my $self = shift; + return () unless $self->list_source; + + my @opts = eval($self->list_source); + if($@) { + warn $@; + return (); + } else { + return @opts; + } +} + +=item part_svc + +Returns the FS::part_svc object associated with this field definition. + +=cut + +sub part_svc { + my $self = shift; + return qsearchs('part_svc', { svcpart => $self->svcpart }); +} + +=back + +=head1 VERSION + +$Id: + +=head1 NOTES + +=over + +=item 1. + +The I field is not enforced. It provides a hint to UI +code about how to display the field on a form. If you want to enforce a +minimum or maximum length for a field, use a I. + +=item 2. + +The check_block mechanism used here as well as in +FS::part_router_field allows the user to define validation rules. + +When FS::sb_field::check is called, the proposed value of the xfield is +assigned to $_. The check_block is then eval()'d and its return value +captured. If the return value is false (empty/zero/undef), $_ is then assigned +back into the field and stored in the database. + +Therefore a check_block can do three different things with the value: allow +it, allow it with a modification, or reject it. This is very flexible, but +somewhat dangerous. Some warnings: + +=over 2 + +=item * + +Assume that $_ has had I error checking prior to the +check_block. That's what the check_block is for, after all. It could +contain I: evil shell commands in backquotes, 100kb JPEG images, +the Klez virus, whatever. + +=item * + +If your check_block modifies the input value, it should probably +produce a value that wouldn't be modified by going through the same +check_block again. (That is, it should map input values into its own +eigenspace.) The reason is that if someone calls $new->replace($old), +where $new and $old contain the same value for the field, they probably +want the field to keep its old value, not to get transformed by the +check_block again. So don't do silly things like '$_++' or +'tr/A-Za-z/a-zA-Z/'. + +=item * + +Don't alter the contents of the database. I the database +is perfectly reasonable, but writing to it is a bad idea. Remember that +check() might get called more than once, as described above. + +=item * + +The check_block probably won't even get called if the user submits +an I sb_field. So at present, you can't set up a default value with +something like 's/^$/foo/'. Conversely, don't replace the submitted value +with an empty string. It probably will get stored, but might be deleted at +any time. + +=back + +=item 3. + +The list_source mechanism is a UI hint (like length) to generate +drop-down or list boxes. If list_source contains a value, the UI code can +eval() it and use the results as the options on the list. + +Note 'can'. This is not a substitute for check_block. The HTML interface +currently requires that the user pick one of the options on the list +because that's the way HTML drop-down boxes work, but in the future the UI +code might add an 'Other (please specify)' option and a text box so that +the user can enter something else. Or it might ignore list_source and just +generate a text box. Or the interface might be rewritten in MS Access, +where drop-down boxes have text boxes built in. Data validation is the job +of check(), not the front end. + +Note also that a list of literals evaluates to itself, so a list_source +like + +C<('Windows', 'MacOS', 'Linux')> + +or + +C + +means exactly what you'd think. + +=head1 BUGS + +The lack of any way to do default values. We might add this as another UI +hint (since, for the most part, it's the UI's job to figure out which fields +have had values entered into them). In fact, there are lots of things we +should add as UI hints. + +Oh, and the documentation is probably full of lies. + +=head1 SEE ALSO + +FS::svc_broadband, FS::sb_field, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/part_svc_router.pm b/FS/FS/part_svc_router.pm new file mode 100755 index 000000000..0b23ab580 --- /dev/null +++ b/FS/FS/part_svc_router.pm @@ -0,0 +1,32 @@ +package FS::part_svc_router; + +use strict; +use vars qw( @ISA ); +use FS::Record qw(qsearchs); +use FS::router; +use FS::part_svc; + +@ISA = qw(FS::Record); + +sub table { 'part_svc_router'; } + +sub check { + my $self = shift; + my $error = + $self->ut_foreign_key('svcpart', 'part_svc', 'svcpart') + || $self->ut_foreign_key('routernum', 'router', 'routernum'); + return $error if $error; + ''; #no error +} + +sub router { + my $self = shift; + return qsearchs('router', { routernum => $self->routernum }); +} + +sub part_svc { + my $self = shift; + return qsearchs('part_svc', { svcpart => $self->svcpart }); +} + +1; diff --git a/FS/FS/router.pm b/FS/FS/router.pm new file mode 100755 index 000000000..3f9459a01 --- /dev/null +++ b/FS/FS/router.pm @@ -0,0 +1,156 @@ +package FS::router; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearchs qsearch ); +use FS::addr_block; + +@ISA = qw( FS::Record ); + +=head1 NAME + +FS::router - Object methods for router records + +=head1 SYNOPSIS + + use FS::router; + + $record = new FS::router \%hash; + $record = new FS::router { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::router record describes a broadband router, such as a DSLAM or a wireless + access point. FS::router inherits from FS::Record. The following +fields are currently supported: + +=over 4 + +=item routernum - primary key + +=item routername - descriptive name for the router + +=item svcnum - svcnum of the owning FS::svc_broadband, if appropriate + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Create a new record. To add the record to the database, see "insert". + +=cut + +sub table { 'router'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete + +Deletes this record from the database. If there is an error, returns the +error, otherwise returns false. + +=item replace OLD_RECORD + +Replaces OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=item check + +Checks all fields to make sure this is a valid record. If there is an error, +returns the error, otherwise returns false. Called by the insert and replace +methods. + +=cut + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('routernum') + || $self->ut_text('routername'); + return $error if $error; + + ''; +} + +=item addr_block + +Returns a list of FS::addr_block objects (address blocks) associated +with this object. + +=cut + +sub addr_block { + my $self = shift; + return qsearch('addr_block', { routernum => $self->routernum }); +} + +=item router_field + +Returns a list of FS::router_field objects assigned to this object. + +=cut + +sub router_field { + my $self = shift; + + return qsearch('router_field', { routernum => $self->routernum }); +} + +=item part_svc_router + +Returns a list of FS::part_svc_router objects associated with this +object. This is unlikely to be useful for any purpose other than retrieving +the associated FS::part_svc objects. See below. + +=cut + +sub part_svc_router { + my $self = shift; + return qsearch('part_svc_router', { routernum => $self->routernum }); +} + +=item part_svc + +Returns a list of FS::part_svc objects associated with this object. + +=cut + +sub part_svc { + my $self = shift; + return map { qsearchs('part_svc', { svcpart => $_->svcpart }) } + $self->part_svc_router; +} + +=back + +=head1 VERSION + +$Id: + +=head1 BUGS + +=head1 SEE ALSO + +FS::svc_broadband, FS::router, FS::addr_block, FS::router_field, FS::part_svc, +schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/router_field.pm b/FS/FS/router_field.pm new file mode 100755 index 000000000..eee21ab89 --- /dev/null +++ b/FS/FS/router_field.pm @@ -0,0 +1,146 @@ +package FS::router_field; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearchs ); +use FS::part_router_field; +use FS::router; + + +@ISA = qw( FS::Record ); + +=head1 NAME + +FS::router_field - Object methods for router_field records + +=head1 SYNOPSIS + + use FS::router_field; + + $record = new FS::router_field \%hash; + $record = new FS::router_field { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +FS::router_field contains values of router xfields. See FS::part_sb_field +for details on the xfield mechanism. + +=over 4 + +=item routerfieldpart - Type of router_field as defined by +FS::part_router_field + +=item routernum - The FS::router to which this value belongs. + +=item value - The contents of the field. + +=back + +=head1 METHODS + + +=over 4 + +=item new HASHREF + +Create a new record. To add the record to the database, see "insert". + +=cut + +sub table { 'router_field'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete + +Deletes this record from the database. If there is an error, returns the +error, otherwise returns false. + +=item replace OLD_RECORD + +Replaces OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=item check + +Checks all fields to make sure this is a valid record. If there is an error, +returns the error, otherwise returns false. Called by the insert and replace +methods. + +=cut + +sub check { + my $self = shift; + + return "routernum must be defined" unless $self->routernum; + return "routerfieldpart must be defined" unless $self->routerfieldpart; + + my $part_router_field = $self->part_router_field; + $_ = $self->value; + + my $check_block = $part_router_field->check_block; + if ($check_block) { + $@ = ''; + my $error = (eval($check_block) or $@); + return $error if $error; + $self->setfield('value' => $_); + } + + ''; #no error +} + +=item part_router_field + +Returns a reference to the FS:part_router_field that defines this +FS::router_field + +=cut + +sub part_router_field { + my $self = shift; + + return qsearchs('part_router_field', + { routerfieldpart => $self->routerfieldpart }); +} + +=item router + +Returns a reference to the FS::router to which this FS::router_field +belongs. + +=cut + +sub router { + my $self = shift; + + return qsearchs('router', { routernum => $self->routernum }); +} + +=back + +=head1 VERSION + +$Id: + +=head1 BUGS + +=head1 SEE ALSO + +FS::svc_broadband, FS::router, FS::router_block, FS::router_field, +schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/sb_field.pm b/FS/FS/sb_field.pm new file mode 100755 index 000000000..d4eb37844 --- /dev/null +++ b/FS/FS/sb_field.pm @@ -0,0 +1,148 @@ +package FS::sb_field; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearchs ); +use FS::part_sb_field; + +use UNIVERSAL qw( can ); + +@ISA = qw( FS::Record ); + +=head1 NAME + +FS::sb_field - Object methods for sb_field records + +=head1 SYNOPSIS + + use FS::sb_field; + + $record = new FS::sb_field \%hash; + $record = new FS::sb_field { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +See L for details on this table's mission in life. +FS::sb_field contains the actual values of the xfields defined in +part_sb_field. + +The following fields are supported: + +=over 4 + +=item sbfieldpart - Type of sb_field as defined by FS::part_sb_field + +=item svcnum - The svc_broadband to which this value belongs. + +=item value - The contents of the field. + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Create a new record. To add the record to the database, see L<"insert">. + +=cut + +sub table { 'sb_field'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete + +Deletes this record from the database. If there is an error, returns the +error, otherwise returns false. + +=item replace OLD_RECORD + +Replaces OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=item check + +Checks the value against the check_block of the corresponding part_sb_field. +Returns whatever the check_block returned (unless the check_block dies, in +which case check returns the die message). Therefore, if the check_block +wants to allow the value to be stored, it must return false. See +L for details. + +=cut + +sub check { + my $self = shift; + + return "svcnum must be defined" unless $self->svcnum; + return "sbfieldpart must be defined" unless $self->sbfieldpart; + + my $part_sb_field = $self->part_sb_field; + + $_ = $self->value; + + my $check_block = $self->part_sb_field->check_block; + if ($check_block) { + $@ = ''; + my $error = (eval($check_block) or $@); # treat fatal errors as errors + return $error if $error; + $self->setfield('value' => $_); + } + + ''; #no error +} + +=item part_sb_field + +Returns a reference to the FS::part_sb_field that defines this FS::sb_field. + +=cut + +sub part_sb_field { + my $self = shift; + + return qsearchs('part_sb_field', { sbfieldpart => $self->sbfieldpart }); +} + +=back + +=item svc_broadband + +Returns a reference to the FS::svc_broadband to which this value is attached. +Nobody's ever going to use this function, but here it is anyway. + +=cut + +sub svc_broadband { + my $self = shift; + + return qsearchs('svc_broadband', { svcnum => $self->svcnum }); +} + +=head1 VERSION + +$Id: + +=head1 BUGS + +=head1 SEE ALSO + +L, schema.html +from the base documentation. + +=cut + +1; + diff --git a/FS/FS/svc_broadband.pm b/FS/FS/svc_broadband.pm index ab92fb3d7..45f6c3601 100755 --- a/FS/FS/svc_broadband.pm +++ b/FS/FS/svc_broadband.pm @@ -2,10 +2,10 @@ package FS::svc_broadband; use strict; use vars qw(@ISA $conf); -#use FS::Record qw( qsearch qsearchs ); use FS::Record qw( qsearchs qsearch dbh ); use FS::svc_Common; use FS::cust_svc; +use FS::addr_block; use NetAddr::IP; @ISA = qw( FS::svc_Common ); @@ -45,25 +45,6 @@ An FS::svc_broadband object represents a 'broadband' Internet connection, such as a DSL, cable modem, or fixed wireless link. These services are assumed to have the following properties: -=over 2 - -=item -The network consists of one or more 'Access Concentrators' (ACs), such as -DSLAMs or wireless access points. (See L.) - -=item -Each AC provides connectivity to one or more contiguous blocks of IP addresses, -each described by a gateway address and a netmask. (See L.) - -=item -Each connection has one or more static IP addresses within one of these blocks. - -=item -The details of configuring routers and other devices are to be handled by a -site-specific L subclass. - -=back - FS::svc_broadband inherits from FS::svc_Common. The following fields are currently supported: @@ -71,14 +52,7 @@ currently supported: =item svcnum - primary key -=item -actypenum - access concentrator type; see L. This is included here -so that a part_svc can specifically be a 'wireless' or 'DSL' service by -designating actypenum as a fixed field. It does create a redundant functional -dependency between this table and ac_type, in that the matching ac_type could -be found by looking up the IP address in ac_block and then finding the block's -AC, but part_svc can't do that, and we don't feel like hacking it so that it -can. +=item blocknum - see FS::addr_block =item speed_up - maximum upload speed, in bits per second. If set to zero, upload @@ -89,28 +63,12 @@ connection. =item speed_down - maximum download speed, as above -=item -ip_addr - the customer's IP address. If the customer needs more than one IP -address, set this to the address of the customer's router. As a result, the -customer's router will have the same address for both it's internal and external +=item ip_addr - the customer's IP address. If the customer needs more than one +IP address, set this to the address of the customer's router. As a result, the +customer's router will have the same address for both its internal and external interfaces thus saving address space. This has been found to work on most NAT routers available. -=item -ip_netmask - the customer's netmask, as a single integer in the range 0-32. -(E.g. '24', not '255.255.255.0'. We assume that address blocks are contiguous.) -This should be 32 unless the customer has multiple IP addresses. - -=item -mac_addr - the MAC address of the customer's router or other device directly -connected to the network, if needed. Some systems (e.g. DHCP, MAC address-based -access control) may need this. If not, you may leave it blank. - -=item -location - a human-readable description of the location of the connected site, -such as its address. This should not be used for billing or contact purposes; -that information is stored in L. - =back =head1 METHODS @@ -120,7 +78,7 @@ that information is stored in L. =item new HASHREF Creates a new svc_broadband. To add the record to the database, see -L<"insert">. +"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. @@ -134,14 +92,12 @@ sub table { 'svc_broadband'; } Adds this record to the database. If there is an error, returns the error, otherwise returns false. -The additional fields pkgnum and svcpart (see L) should be +The additional fields pkgnum and svcpart (see FS::cust_svc) should be defined. An FS::cust_svc record will be created and inserted. =cut -# sub insert {} # Standard FS::svc_Common::insert -# (any necessary Deep Magic is handled by exports) =item delete @@ -159,19 +115,62 @@ returns the error, otherwise returns false. =cut # Standard FS::svc_Common::replace -# Notice a pattern here? + +=item sb_field + +Returns a list of FS::sb_field objects assigned to this object. + +=cut + +sub sb_field { + my $self = shift; + + return qsearch( 'sb_field', { svcnum => $self->svcnum } ); +} + +=item sb_field_hashref + +Returns a hashref of the FS::sb_field key/value pairs for this object. + +Deprecated. Please don't use it. + +=cut + +# Kristian wrote this, but don't hold it against him. He was under a powerful +# distracting influence whom he evidently found much more interesting than +# svc_broadband.pm. I can't say I blame him. + +sub sb_field_hashref { + my $self = shift; + my $svcpart = shift; + + if ((not $svcpart) && ($self->cust_svc)) { + $svcpart = $self->cust_svc->svcpart; + } + + my $hashref = {}; + + map { + my $sb_field = qsearchs('sb_field', { sbfieldpart => $_->sbfieldpart, + svcnum => $self->svcnum }); + $hashref->{$_->getfield('name')} = $sb_field ? $sb_field->getfield('value') : ''; + } qsearch('part_sb_field', { svcpart => $svcpart }); + + return $hashref; + +} =item suspend -Called by the suspend method of FS::cust_pkg (see L). +Called by the suspend method of FS::cust_pkg (see FS::cust_pkg). =item unsuspend -Called by the unsuspend method of FS::cust_pkg (see L). +Called by the unsuspend method of FS::cust_pkg (see FS::cust_pkg). =item cancel -Called by the cancel method of FS::cust_pkg (see L). +Called by the cancel method of FS::cust_pkg (see FS::cust_pkg). =item check @@ -189,105 +188,99 @@ sub check { my $error = $self->ut_numbern('svcnum') - || $self->ut_foreign_key('actypenum', 'ac_type', 'actypenum') + || $self->ut_foreign_key('blocknum', 'addr_block', 'blocknum') || $self->ut_number('speed_up') || $self->ut_number('speed_down') - || $self->ut_ip('ip_addr') - || $self->ut_numbern('ip_netmask') - || $self->ut_textn('mac_addr') - || $self->ut_textn('location') + || $self->ut_ipn('ip_addr') ; return $error if $error; if($self->speed_up < 0) { return 'speed_up must be positive'; } if($self->speed_down < 0) { return 'speed_down must be positive'; } - # This should catch errors in the ip_addr and ip_netmask. If it doesn't, - # they'll almost certainly not map into a valid block anyway. - my $self_addr = new NetAddr::IP ($self->ip_addr, $self->ip_netmask); - return 'Cannot parse address: ' . $self->ip_addr . '/' . $self->ip_netmask unless $self_addr; - - my @block = grep { - my $block_addr = new NetAddr::IP ($_->ip_gateway, $_->ip_netmask); - if ($block_addr->contains($self_addr)) { $_ }; - } qsearch( 'ac_block', { acnum => $self->acnum }); - - if(scalar @block == 0) { - return 'Block not found for address '.$self->ip_addr.' in actype '.$self->actypenum; - } elsif(scalar @block > 1) { - return 'ERROR: Intersecting blocks found for address '.$self->ip_addr.' :'. - join ', ', map {$_->ip_addr . '/' . $_->ip_netmask} @block; + if (not($self->ip_addr) or $self->ip_addr eq '0.0.0.0') { + $self->ip_addr($self->addr_block->next_free_addr->addr); + if (not $self->ip_addr) { + return "No free addresses in addr_block (blocknum: ".$self->blocknum.")"; + } } - # OK, we've found a valid block. We don't actually _do_ anything with it, though; we - # just take comfort in the knowledge that it exists. - # A simple qsearchs won't work here. Since we can assign blocks to customers, - # we have to make sure the new address doesn't fall within someone else's - # block. Ugh. + # This should catch errors in the ip_addr. If it doesn't, + # they'll almost certainly not map into the block anyway. + my $self_addr = $self->NetAddr; #netmask is /32 + return ('Cannot parse address: ' . $self->ip_addr) unless $self_addr; - my @conflicts = grep { - my $cust_addr = new NetAddr::IP($_->ip_addr, $_->ip_netmask); - if (($cust_addr->contains($self_addr)) and - ($_->svcnum ne $self->svcnum)) { $_; }; - } qsearch('svc_broadband', {}); - - if (scalar @conflicts > 0) { - return 'Address in use by existing service'; + my $block_addr = $self->addr_block->NetAddr; + unless ($block_addr->contains($self_addr)) { + return 'blocknum '.$self->blocknum.' does not contain address '.$self->ip_addr; } - # Are we trying to use a network, broadcast, or the AC's address? - foreach (qsearch('ac_block', { acnum => $self->acnum })) { - my $block_addr = new NetAddr::IP($_->ip_gateway, $_->ip_netmask); - if ($block_addr->network->addr eq $self_addr->addr) { - return 'Address is network address for block '. $block_addr->network; - } - if ($block_addr->broadcast->addr eq $self_addr->addr) { - return 'Address is broadcast address for block '. $block_addr->network; - } - if ($block_addr->addr eq $self_addr->addr) { - return 'Address belongs to the access concentrator: '. $block_addr->addr; - } + my $router = $self->addr_block->router + or return 'Cannot assign address from unallocated block:'.$self->addr_block->blocknum; + if(grep { $_->routernum == $router->routernum} $self->allowed_routers) { + } # do nothing + else { + return 'Router '.$router->routernum.' cannot provide svcpart '.$self->svcpart; } + ''; #no error } -=item ac_block +=item NetAddr -Returns the FS::ac_block record (i.e. the address block) for this broadband service. +Returns a NetAddr::IP object containing the IP address of this service. The netmask +is /32. =cut -sub ac_block { +sub NetAddr { my $self = shift; - my $self_addr = new NetAddr::IP ($self->ip_addr, $self->ip_netmask); - - foreach my $block (qsearch( 'ac_block', {} )) { - my $block_addr = new NetAddr::IP ($block->ip_addr, $block->ip_netmask); - if($block_addr->contains($self_addr)) { return $block; } - } - return ''; + return new NetAddr::IP ($self->ip_addr); } -=item ac_type +=item addr_block -Returns the FS::ac_type record for this broadband service. +Returns the FS::addr_block record (i.e. the address block) for this broadband service. =cut -sub ac_type { +sub addr_block { my $self = shift; - return qsearchs('ac_type', { actypenum => $self->actypenum }); + + return qsearchs('addr_block', { blocknum => $self->blocknum }); } =back +=item allowed_routers + +Returns a list of allowed FS::router objects. + +=cut + +sub allowed_routers { + my $self = shift; + + return map { $_->router } qsearch('part_svc_router', { svcpart => $self->svcpart }); +} + =head1 BUGS +I think there's one place in the code where we actually use sb_field_hashref. +That's a bug in itself. + +The real problem with it is that we're still grappling with the question of how +tightly xfields should be integrated with real fields. There are a few +different directions we could go with it--we I override several +functions in Record so that xfields behave almost exactly like real fields (can +be set with setfield(), appear in fields() and hash(), used as criteria in +qsearch(), etc.). + =head1 SEE ALSO -L, L, L, L, -L, schema.html from the base documentation. +FS::svc_Common, FS::Record, FS::addr_block, FS::sb_field, +FS::part_svc, schema.html from the base documentation. =cut diff --git a/FS/bin/freeside-setup b/FS/bin/freeside-setup index 0ef3fc81b..19483765e 100755 --- a/FS/bin/freeside-setup +++ b/FS/bin/freeside-setup @@ -1012,76 +1012,99 @@ sub tables_hash_hack { 'index' => [], }, - 'ac_type' => { + 'router' => { 'columns' => [ - 'actypenum', 'serial', '', '', - 'actypename', 'varchar', '', $char_d, + 'routernum', 'serial', '', '', + 'routername', 'varchar', '', $char_d, + 'svcnum', 'int', '0', '', ], - 'primary_key' => 'actypenum', + 'primary_key' => 'routernum', 'unique' => [], 'index' => [], }, - 'ac' => { + 'part_svc_router' => { 'columns' => [ - 'acnum', 'serial', '', '', - 'actypenum', 'int', '', '', - 'acname', 'varchar', '', $char_d, - ], - 'primary_key' => 'acnum', + 'svcpart', 'int', '', '', + 'routernum', 'int', '', '', + ]; + 'primary_key' => '', 'unique' => [], - 'index' => [ [ 'actypenum' ] ], + 'index' => [], }, - 'part_ac_field' => { + 'part_router_field' => { 'columns' => [ - 'acfieldpart', 'serial', '', '', - 'actypenum', 'int', '', '', + 'routerfieldpart', 'serial', '', '', 'name', 'varchar', '', $char_d, - 'ut_type', 'varchar', '', $char_d, + 'length', 'int', '', '', + 'check_block', 'text', 'NULL', '', + 'list_source', 'text', 'NULL', '', ], - 'primary_key' => 'acfieldpart', + 'primary_key' => 'routerfieldpart', 'unique' => [], - 'index' => [ [ 'actypenum' ] ], + 'index' => [], }, - 'ac_field' => { + 'router_field' => { 'columns' => [ - 'acfieldpart', 'int', '', '', - 'acnum', 'int', '', '', - 'value', 'text', '', '', + 'routerfieldpart', 'int', '', '', + 'routernum', 'int', '', '', + 'value', 'varchar', '', 128, ], 'primary_key' => '', - 'unique' => [ [ 'acfieldpart', 'acnum' ] ], - 'index' => [ [ 'acnum' ] ], + 'unique' => [ [ 'routerfieldpart', 'routernum' ] ], + 'index' => [], }, - 'ac_block' => { + 'addr_block' => { 'columns' => [ - 'acnum', 'int', '', '', + 'blocknum', 'int', '', '', + 'routernum', 'int', '', '', 'ip_gateway', 'varchar', '', 15, 'ip_netmask', 'int', '', '', ], + 'primary_key' => 'blocknum', + 'unique' => [ [ 'blocknum', 'routernum' ] ], + 'index' => [], + }, + + 'part_sb_field' => { + 'columns' => [ + 'sbfieldpart', 'int', '', '', + 'svcpart', 'int', '', '', + 'name', 'varchar', '', $char_d, + 'length', 'int', '', '', + 'check_block', 'text', 'NULL', '', + 'list_source', 'text', 'NULL', '', + ], + 'primary_key' => 'sbfieldpart', + 'unique' => [ [ 'sbfieldpart', 'svcpart' ] ], + 'index' => [], + }, + + 'sb_field' => { + 'columns' => [ + 'sbfieldpart', 'int', '', '', + 'svcnum', 'int', '', '', + 'value', 'varchar', '', 128, + ], 'primary_key' => '', - 'unique' => [], - 'index' => [ [ 'acnum' ] ], + 'unique' => [ [ 'sbfieldpart', 'svcnum' ] ], + 'index' => [], }, 'svc_broadband' => { 'columns' => [ 'svcnum', 'int', '', '', - 'actypenum', 'int', '', '', + 'blocknum', 'int', '', '', 'speed_up', 'int', '', '', 'speed_down', 'int', '', '', - 'acnum', 'int', '', '', 'ip_addr', 'varchar', '', 15, - 'ip_netmask', 'int', '', '', - 'mac_addr', 'char', '', 17, - 'location', 'varchar', '', $char_d, ], 'primary_key' => 'svcnum', 'unique' => [], - 'index' => [ [ 'actypenum' ] ], + 'index' => [], }, ); -- cgit v1.2.1 From 6e2dcb26245ef419438f60e99c91873a8d762625 Mon Sep 17 00:00:00 2001 From: khoff Date: Wed, 5 Feb 2003 23:23:00 +0000 Subject: svc_broadband rewrite --- FS/FS/ac.pm | 148 ------------------------------------------------- FS/FS/ac_block.pm | 148 ------------------------------------------------- FS/FS/ac_field.pm | 138 --------------------------------------------- FS/FS/ac_type.pm | 128 ------------------------------------------ FS/FS/part_ac_field.pm | 102 ---------------------------------- 5 files changed, 664 deletions(-) delete mode 100644 FS/FS/ac.pm delete mode 100755 FS/FS/ac_block.pm delete mode 100755 FS/FS/ac_field.pm delete mode 100755 FS/FS/ac_type.pm delete mode 100755 FS/FS/part_ac_field.pm (limited to 'FS') diff --git a/FS/FS/ac.pm b/FS/FS/ac.pm deleted file mode 100644 index 5a2b36079..000000000 --- a/FS/FS/ac.pm +++ /dev/null @@ -1,148 +0,0 @@ -package FS::ac; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearchs qsearch ); -use FS::ac_type; -use FS::ac_block; - -@ISA = qw( FS::Record ); - -=head1 NAME - -FS::ac - Object methods for ac records - -=head1 SYNOPSIS - - use FS::ac; - - $record = new FS::ac \%hash; - $record = new FS::ac { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::ac record describes a broadband Access Concentrator, such as a DSLAM -or a wireless access point. FS::ac inherits from FS::Record. The following -fields are currently supported: - -narf - -=over 4 - -=item acnum - primary key - -=item actypenum - AC type, see L - -=item acname - descriptive name for the AC - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Create a new record. To add the record to the database, see L<"insert">. - -=cut - -sub table { 'ac'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=item delete - -Deletes this record from the database. If there is an error, returns the -error, otherwise returns false. - -=item replace OLD_RECORD - -Replaces OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=item check - -Checks all fields to make sure this is a valid record. If there is an error, -returns the error, otherwise returns false. Called by the insert and replace -methods. - -=cut - -sub check { - my $self = shift; - - my $error = - $self->ut_numbern('acnum') - || $self->ut_number('actypenum') - || $self->ut_text('acname'); - return $error if $error; - - return "Unknown actypenum" - unless $self->ac_type; - ''; -} - -=item ac_type - -Returns the L object corresponding to this object. - -=cut - -sub ac_type { - my $self = shift; - return qsearchs('ac_type', { actypenum => $self->actypenum }); -} - -=item ac_block - -Returns a list of L objects (address blocks) associated -with this object. - -=cut - -sub ac_block { - my $self = shift; - return qsearch('ac_block', { acnum => $self->acnum }); -} - -=item ac_field - -Returns a hash of L objects assigned to this object. - -=cut - -sub ac_field { - my $self = shift; - - return qsearch('ac_field', { acnum => $self->acnum }); -} - -=back - -=head1 VERSION - -$Id: - -=head1 BUGS - -=head1 SEE ALSO - -L, L, L, L, schema.html -from the base documentation. - -=cut - -1; - diff --git a/FS/FS/ac_block.pm b/FS/FS/ac_block.pm deleted file mode 100755 index 09de6a4d8..000000000 --- a/FS/FS/ac_block.pm +++ /dev/null @@ -1,148 +0,0 @@ -package FS::ac_block; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearchs qsearch ); -use FS::ac_type; -use FS::ac; -use FS::svc_broadband; -use NetAddr::IP; - -@ISA = qw( FS::Record ); - -=head1 NAME - -FS::ac - Object methods for ac records - -=head1 SYNOPSIS - - use FS::ac_block; - - $record = new FS::ac_block \%hash; - $record = new FS::ac_block { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::ac_block record describes an address block assigned for broadband -access. FS::ac_block inherits from FS::Record. The following fields are -currently supported: - -=over 4 - -=item acnum - the access concentrator (see L) to which this -block is assigned. - -=item ip_gateway - the gateway address used by customers within this block. -This functions as the primary key. - -=item ip_netmask - the netmask of the block, expressed as an integer. - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Create a new record. To add the record to the database, see L<"insert">. - -=cut - -sub table { 'ac_block'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=item delete - -Deletes this record from the database. If there is an error, returns the -error, otherwise returns false. - -=item replace OLD_RECORD - -Replaces OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=item check - -Checks all fields to make sure this is a valid record. If there is an error, -returns the error, otherwise returns false. Called by the insert and replace -methods. - -=cut - -sub check { - my $self = shift; - - my $error = - $self->ut_number('acnum') - || $self->ut_ip('ip_gateway') - || $self->ut_number('ip_netmask') - ; - return $error if $error; - - return "Unknown acnum" - unless $self->ac; - - my $self_addr = new NetAddr::IP ($self->ip_gateway, $self->ip_netmask); - return "Cannot parse address: ". $self->ip_gateway . '/' . $self->ip_netmask - unless $self_addr; - - my @block = grep { - my $block_addr = new NetAddr::IP ($_->ip_gateway, $_->ip_netmask); - if($block_addr->contains($self_addr) - or $self_addr->contains($block_addr)) { $_; }; - } qsearch( 'ac_block', {}); - - foreach(@block) { - return "Block intersects existing block ".$_->ip_gateway."/".$_->ip_netmask; - } - - ''; -} - - -=item ac - -Returns the L object corresponding to this object. - -=cut - -sub ac { - my $self = shift; - return qsearchs('ac', { acnum => $self->acnum }); -} - -=item svc_broadband - -Returns a list of L objects associated -with this object. - -=cut - -#sub svc_broadband { -# my $self = shift; -# my @svc = qsearch('svc_broadband', { actypenum => $self->ac->ac_type->actypenum }); -# return grep { -# my $svc_addr = new NetAddr::IP($_->ip_addr, $_->ip_netmask); -# $self_addr->contains($svc_addr); -# } @svc; -#} - -=back - -=cut - -1; - diff --git a/FS/FS/ac_field.pm b/FS/FS/ac_field.pm deleted file mode 100755 index f6011192f..000000000 --- a/FS/FS/ac_field.pm +++ /dev/null @@ -1,138 +0,0 @@ -package FS::ac_field; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearchs ); -use FS::part_ac_field; -use FS::ac; - -use UNIVERSAL qw( can ); - -@ISA = qw( FS::Record ); - -=head1 NAME - -FS::ac_field - Object methods for ac_field records - -=head1 SYNOPSIS - - use FS::ac_field; - - $record = new FS::ac_field \%hash; - $record = new FS::ac_field { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -L contains values of fields defined by L -for an L. Values must be of the data type defined by ut_type in -L. -Supported fields as follows: - -=over 4 - -=item acfieldpart - Type of ac_field as defined by L - -=item acnum - The L to which this value belongs. - -=item value - The contents of the field. - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Create a new record. To add the record to the database, see L<"insert">. - -=cut - -sub table { 'ac_field'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=item delete - -Deletes this record from the database. If there is an error, returns the -error, otherwise returns false. - -=item replace OLD_RECORD - -Replaces OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=item check - -Checks all fields to make sure this is a valid record. If there is an error, -returns the error, otherwise returns false. Called by the insert and replace -methods. - -=cut - -sub check { - my $self = shift; - - return "acnum must be defined" unless $self->acnum; - return "acfieldpart must be defined" unless $self->acfieldpart; - - my $ut_func = $self->can("ut_" . $self->part_ac_field->ut_type); - my $error = $self->$ut_func('value'); - - return $error if $error; - - ''; #no error -} - -=item part_ac_field - -Returns a reference to the L that defines this L - -=cut - -sub part_ac_field { - my $self = shift; - - return qsearchs('part_ac_field', { acfieldpart => $self->acfieldpart }); -} - -=item ac - -Returns a reference to the L to which this L belongs. - -=cut - -sub ac { - my $self = shift; - - return qsearchs('ac', { acnum => $self->acnum }); -} - -=back - -=head1 VERSION - -$Id: - -=head1 BUGS - -=head1 SEE ALSO - -L, L, L, L, schema.html -from the base documentation. - -=cut - -1; - diff --git a/FS/FS/ac_type.pm b/FS/FS/ac_type.pm deleted file mode 100755 index e83c5c5f0..000000000 --- a/FS/FS/ac_type.pm +++ /dev/null @@ -1,128 +0,0 @@ -package FS::ac_type; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearchs ); -use FS::ac; - -@ISA = qw( FS::Record ); - -=head1 NAME - -FS::ac_type - Object methods for ac_type records - -=head1 SYNOPSIS - - use FS::ac_type; - - $record = new FS::ac_type \%hash; - $record = new FS::ac_type { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -L refers to a type of access concentrator. L -records refer to a specific L limiting the choice of access -concentrator to one of the chosen type. This should be set as a fixed -default in part_svc to prevent provisioning the wrong type of service for -a given package or service type. Supported fields as follows: - -=over 4 - -=item actypenum - Primary key. see L - -=item actypename - Text identifier for access concentrator type. - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Create a new record. To add the record to the database, see L<"insert">. - -=cut - -sub table { 'ac_type'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=item delete - -Deletes this record from the database. If there is an error, returns the -error, otherwise returns false. - -=item replace OLD_RECORD - -Replaces OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=item check - -Checks all fields to make sure this is a valid record. If there is an error, -returns the error, otherwise returns false. Called by the insert and replace -methods. - -=cut - -sub check { - my $self = shift; - - # What do we check? - - ''; #no error -} - -=item ac - -Returns a list of all L records of this type. - -=cut - -sub ac { - my $self = shift; - - return qsearch('ac', { actypenum => $self->actypenum }); -} - -=item part_ac_field - -Returns a list of all L records of this type. - -=cut - -sub part_ac_field { - my $self = shift; - - return qsearch('part_ac_field', { actypenum => $self->actypenum }); -} - -=back - -=head1 VERSION - -$Id: - -=head1 BUGS - -=head1 SEE ALSO - -L, L, L, L, schema.html -from the base documentation. - -=cut - -1; - diff --git a/FS/FS/part_ac_field.pm b/FS/FS/part_ac_field.pm deleted file mode 100755 index dcb445253..000000000 --- a/FS/FS/part_ac_field.pm +++ /dev/null @@ -1,102 +0,0 @@ -package FS::part_ac_field; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearchs ); -use FS::ac_field; -use FS::ac; - - -@ISA = qw( FS::Record ); - -=head1 NAME - -FS::part_ac_field - Object methods for part_ac_field records - -=head1 SYNOPSIS - - use FS::part_ac_field; - - $record = new FS::part_ac_field \%hash; - $record = new FS::part_ac_field { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - - -=over 4 - -=item blank - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Create a new record. To add the record to the database, see L<"insert">. - -=cut - -sub table { 'part_ac_field'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=item delete - -Deletes this record from the database. If there is an error, returns the -error, otherwise returns false. - -=item replace OLD_RECORD - -Replaces OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=item check - -Checks all fields to make sure this is a valid record. If there is an error, -returns the error, otherwise returns false. Called by the insert and replace -methods. - -=cut - -sub check { - my $self = shift; - my $error = ''; - - $self->name =~ /^([a-z0-9_\-\.]{1,15})$/i - or return "Invalid field name for part_ac_field"; - - ''; #no error -} - - -=back - -=head1 VERSION - -$Id: - -=head1 BUGS - -=head1 SEE ALSO - -L, L, L, L, schema.html -from the base documentation. - -=cut - -1; - -- cgit v1.2.1 From c232fac0743999105f6948b9fa352fe2293b09f8 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 6 Feb 2003 05:26:50 +0000 Subject: time/data detail on invoices --- FS/FS.pm | 2 + FS/FS/cust_bill.pm | 41 +++++++------- FS/FS/cust_bill_pkg.pm | 67 +++++++++++++++++++++-- FS/FS/cust_bill_pkg_detail.pm | 123 ++++++++++++++++++++++++++++++++++++++++++ FS/FS/cust_main.pm | 13 +++-- FS/MANIFEST | 2 + FS/bin/freeside-setup | 12 +++++ FS/t/cust_bill_pkg_detail.t | 5 ++ 8 files changed, 235 insertions(+), 30 deletions(-) create mode 100644 FS/FS/cust_bill_pkg_detail.pm create mode 100644 FS/t/cust_bill_pkg_detail.t (limited to 'FS') diff --git a/FS/FS.pm b/FS/FS.pm index a2df6f175..e4a32082c 100644 --- a/FS/FS.pm +++ b/FS/FS.pm @@ -102,6 +102,8 @@ L - Invoice class L - Invoice line item class +L - Invoice line item detail class + L - Invoice event definition class L - Completed invoice event class diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index c661baa95..aa82eb6f8 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -953,38 +953,43 @@ sub print_text { } #new charges - foreach ( ( grep { $_->pkgnum } $self->cust_bill_pkg ), #packages first - ( grep { ! $_->pkgnum } $self->cust_bill_pkg ), #then taxes + foreach my $cust_bill_pkg ( + ( grep { $_->pkgnum } $self->cust_bill_pkg ), #packages first + ( grep { ! $_->pkgnum } $self->cust_bill_pkg ), #then taxes ) { - if ( $_->pkgnum ) { + if ( $cust_bill_pkg->pkgnum ) { - my($cust_pkg)=qsearchs('cust_pkg', { 'pkgnum', $_->pkgnum } ); - my($part_pkg)=qsearchs('part_pkg',{'pkgpart'=>$cust_pkg->pkgpart}); - my($pkg)=$part_pkg->pkg; + my $cust_pkg = qsearchs('cust_pkg', { pkgnum =>$cust_bill_pkg->pkgnum } ); + my $part_pkg = qsearchs('part_pkg', { pkgpart=>$cust_pkg->pkgpart } ); + my $pkg = $part_pkg->pkg; - if ( $_->setup != 0 ) { - push @buf, [ "$pkg Setup", $money_char. sprintf("%10.2f",$_->setup) ]; + if ( $cust_bill_pkg->setup != 0 ) { + push @buf, [ "$pkg Setup", + $money_char. sprintf("%10.2f", $cust_bill_pkg->setup) ]; push @buf, map { [ " ". $_->[0]. ": ". $_->[1], '' ] } $cust_pkg->labels; } - if ( $_->recur != 0 ) { + if ( $cust_bill_pkg->recur != 0 ) { push @buf, [ - "$pkg (" . time2str("%x",$_->sdate) . " - " . - time2str("%x",$_->edate) . ")", - $money_char. sprintf("%10.2f",$_->recur) + "$pkg (" . time2str("%x", $cust_bill_pkg->sdate) . " - " . + time2str("%x", $cust_bill_pkg->edate) . ")", + $money_char. sprintf("%10.2f", $cust_bill_pkg->recur) ]; push @buf, map { [ " ". $_->[0]. ": ". $_->[1], '' ] } $cust_pkg->labels; } + push @buf, map { [ " $_", '' ] } $cust_bill_pkg->details; + } else { #pkgnum tax - my $itemdesc = defined $_->dbdef_table->column('itemdesc') - ? ( $_->itemdesc || 'Tax' ) + my $itemdesc = defined $cust_bill_pkg->dbdef_table->column('itemdesc') + ? ( $cust_bill_pkg->itemdesc || 'Tax' ) : 'Tax'; - push @buf,[$itemdesc, $money_char. sprintf("%10.2f",$_->setup) ] - if $_->setup != 0; + push @buf, [ $itemdesc, + $money_char. sprintf("%10.2f", $cust_bill_pkg->setup) ] + if $cust_bill_pkg->setup != 0; } } @@ -1128,10 +1133,6 @@ sub print_text { =back -=head1 VERSION - -$Id: cust_bill.pm,v 1.61 2003-01-10 07:41:05 ivan Exp $ - =head1 BUGS The delete method. diff --git a/FS/FS/cust_bill_pkg.pm b/FS/FS/cust_bill_pkg.pm index 5a1dcd2aa..a6615d05d 100644 --- a/FS/FS/cust_bill_pkg.pm +++ b/FS/FS/cust_bill_pkg.pm @@ -2,11 +2,12 @@ package FS::cust_bill_pkg; use strict; use vars qw( @ISA ); -use FS::Record qw( qsearchs ); +use FS::Record qw( qsearch qsearchs dbdef dbh ); use FS::cust_pkg; use FS::cust_bill; +use FS::cust_bill_pkg_detail; -@ISA = qw(FS::Record ); +@ISA = qw( FS::Record ); =head1 NAME @@ -73,6 +74,51 @@ sub table { 'cust_bill_pkg'; } Adds this line item to the database. If there is an error, returns the error, otherwise returns false. +=cut + +sub insert { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $self->SUPER::insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + unless ( defined dbdef->table('cust_bill_pkg_detail') && $self->get('details') ) { + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + return ''; + } + + foreach my $detail ( @{$self->get('details')} ) { + my $cust_bill_pkg_detail = new FS::cust_bill_pkg_detail { + 'pkgnum' => $self->pkgnum, + 'invnum' => $self->invnum, + 'detail' => $detail, + }; + $error = $cust_bill_pkg_detail->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + =item delete Currently unimplemented. I don't remove line items because there would then be @@ -139,11 +185,22 @@ sub cust_pkg { qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } ); } -=back +=item details + +Returns an array of detail information for the invoice line item. -=head1 VERSION +=cut -$Id: cust_bill_pkg.pm,v 1.4 2002-09-21 11:17:39 ivan Exp $ +sub details { + my $self = shift; + return () unless defined dbdef->table('cust_bill_pkg_detail'); + map { $_->detail } + qsearch ( 'cust_bill_pkg_detail', { 'pkgnum' => $self->pkgnum, + 'invnum' => $self->invnum, } ); + #qsearch ( 'cust_bill_pkg_detail', { 'lineitemnum' => $self->lineitemnum }); +} + +=back =head1 BUGS diff --git a/FS/FS/cust_bill_pkg_detail.pm b/FS/FS/cust_bill_pkg_detail.pm new file mode 100644 index 000000000..199de439b --- /dev/null +++ b/FS/FS/cust_bill_pkg_detail.pm @@ -0,0 +1,123 @@ +package FS::cust_bill_pkg_detail; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearch qsearchs ); + +@ISA = qw(FS::Record); + +=head1 NAME + +FS::cust_bill_pkg_detail - Object methods for cust_bill_pkg_detail records + +=head1 SYNOPSIS + + use FS::cust_bill_pkg_detail; + + $record = new FS::cust_bill_pkg_detail \%hash; + $record = new FS::cust_bill_pkg_detail { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cust_bill_pkg_detail object represents additional detail information for +an invoice line item (see L). FS::cust_bill_pkg_detail +inherits from FS::Record. The following fields are currently supported: + +=over 4 + +=item detailnum - primary key + +=item pkgnum - + +=item invnum - + +=item detail - detail description + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new line item detail. To add the line item detail 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 + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'cust_bill_pkg_detail'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +# the insert method can be inherited from FS::Record + +=item delete + +Delete this record from the database. + +=cut + +# the delete method can be inherited from FS::Record + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +# the replace method can be inherited from FS::Record + +=item check + +Checks all fields to make sure this is a valid line item detail. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +# the check method should currently be supplied - FS::Record contains some +# data checking routines + +sub check { + my $self = shift; + + $self->ut_numbern('detailnum') + || $self->ut_foreign_key('pkgnum', 'cust_pkg', 'pkgnum') + || $self->ut_foreign_key('invnum', 'cust_pkg', 'invnum') + || $self->ut_text('detail') + ; + +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 91ffa451a..807fadbcc 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -947,6 +947,8 @@ sub bill { my %hash = $cust_pkg->hash; my $old_cust_pkg = new FS::cust_pkg \%hash; + my @details = (); + # bill setup my $setup = 0; unless ( $cust_pkg->setup ) { @@ -1040,11 +1042,12 @@ sub bill { } if ( $setup > 0 || $recur > 0 ) { my $cust_bill_pkg = new FS::cust_bill_pkg ({ - 'pkgnum' => $cust_pkg->pkgnum, - 'setup' => $setup, - 'recur' => $recur, - 'sdate' => $sdate, - 'edate' => $cust_pkg->bill, + 'pkgnum' => $cust_pkg->pkgnum, + 'setup' => $setup, + 'recur' => $recur, + 'sdate' => $sdate, + 'edate' => $cust_pkg->bill, + 'details' => \@details, }); push @cust_bill_pkg, $cust_bill_pkg; $total_setup += $setup; diff --git a/FS/MANIFEST b/FS/MANIFEST index b3de623d7..e8b1da7a7 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -51,6 +51,7 @@ FS/agent.pm FS/agent_type.pm FS/cust_bill.pm FS/cust_bill_pkg.pm +FS/cust_bill_pkg_detail.pm FS/cust_credit.pm FS/cust_credit_bill.pm FS/cust_main.pm @@ -127,6 +128,7 @@ t/cust_bill.t t/cust_bill_event.t t/cust_bill_pay.t t/cust_bill_pkg.t +t/cust_bill_pkg_detail.t t/cust_credit.t t/cust_credit_bill.t t/cust_credit_refund.t diff --git a/FS/bin/freeside-setup b/FS/bin/freeside-setup index 19483765e..cf009c249 100755 --- a/FS/bin/freeside-setup +++ b/FS/bin/freeside-setup @@ -421,6 +421,18 @@ sub tables_hash_hack { 'index' => [ ['invnum'] ], }, + 'cust_bill_pkg_detail' => { + 'columns' => [ + 'detailnum', 'serial', '', '', + 'pkgnum', 'int', '', '', + 'invnum', 'int', '', '', + 'detail', 'varchar', '', $char_d, + ], + 'primary_key' => 'detailnum', + 'unique' => [], + 'index' => [ [ 'pkgnum', 'invnum' ] ], + }, + 'cust_credit' => { 'columns' => [ 'crednum', 'serial', '', '', diff --git a/FS/t/cust_bill_pkg_detail.t b/FS/t/cust_bill_pkg_detail.t new file mode 100644 index 000000000..ea6e3d125 --- /dev/null +++ b/FS/t/cust_bill_pkg_detail.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_bill_pkg_detail; +$loaded=1; +print "ok 1\n"; -- cgit v1.2.1 From 2fc87c32cbb509992070b044ed66e2a0e9828a17 Mon Sep 17 00:00:00 2001 From: khoff Date: Wed, 12 Feb 2003 01:21:50 +0000 Subject: s/;/,/ --- FS/bin/freeside-setup | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/bin/freeside-setup b/FS/bin/freeside-setup index cf009c249..b3cdb3384 100755 --- a/FS/bin/freeside-setup +++ b/FS/bin/freeside-setup @@ -1039,7 +1039,7 @@ sub tables_hash_hack { 'columns' => [ 'svcpart', 'int', '', '', 'routernum', 'int', '', '', - ]; + ], 'primary_key' => '', 'unique' => [], 'index' => [], -- cgit v1.2.1 From 47acc8a99bd1fcdba4fce00e1838926046cd2f81 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 1 Mar 2003 03:15:01 +0000 Subject: change next bill date comparison from < to <= --- FS/FS/cust_main.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 807fadbcc..6331fda6d 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -979,7 +979,7 @@ sub bill { my $sdate; if ( $part_pkg->getfield('freq') > 0 && ! $cust_pkg->getfield('susp') && - ( $cust_pkg->getfield('bill') || 0 ) < $time + ( $cust_pkg->getfield('bill') || 0 ) <= $time ) { my $recur_prog = $part_pkg->getfield('recur'); $recur_prog =~ /^(.*)$/ or do { -- cgit v1.2.1 From 97320dbd0747826bc4082a466cfe0ea4e8168628 Mon Sep 17 00:00:00 2001 From: khoff Date: Tue, 4 Mar 2003 01:56:10 +0000 Subject: updated for svc_broadband changes --- FS/MANIFEST | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/MANIFEST b/FS/MANIFEST index e8b1da7a7..782286544 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -44,9 +44,6 @@ FS/UI/Gtk.pm FS/UI/agent.pm FS/UID.pm FS/Msgcat.pm -FS/ac.pm -FS/ac_block.pm -FS/ac_type.pm FS/agent.pm FS/agent_type.pm FS/cust_bill.pm @@ -66,7 +63,6 @@ FS/cust_refund.pm FS/cust_credit_refund.pm FS/cust_svc.pm FS/part_bill_event.pm -FS/part_ac_field.pm FS/export_svc.pm FS/part_export.pm FS/part_export_option.pm @@ -93,12 +89,17 @@ FS/part_pop_local.pm FS/part_referral.pm FS/part_svc.pm FS/part_svc_column.pm +FS/part_router_field.pm +FS/part_sb_field.pm +FS/part_svc_router.pm FS/pkg_svc.pm FS/svc_Common.pm FS/svc_acct.pm FS/svc_acct_pop.pm FS/svc_broadband.pm FS/svc_domain.pm +FS/router.pm +FS/router_field.pm FS/type_pkgs.pm FS/nas.pm FS/port.pm @@ -107,6 +108,7 @@ FS/domain_record.pm FS/prepay_credit.pm FS/svc_www.pm FS/svc_forward.pm +FS/sb_field.pm FS/raddb.pm FS/radius_usergroup.pm FS/queue.pm -- cgit v1.2.1 From 0857c5465840060a13b93e6c5a15af6ed6476a1f Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 11 Mar 2003 11:40:35 +0000 Subject: another pg7.3 fix --- FS/FS/svc_domain.pm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm index 0d71b2775..3941d6eff 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -382,8 +382,10 @@ sub check { $recref->{action} =~ /^(M|N)$/ or return "Illegal action"; $recref->{action} = $1; - my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $recref->{catchall} } ); - return "Unknown catchall" unless $svc_acct || ! $recref->{catchall}; + if ( $recref->{catchall} ne '' ) { + my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $recref->{catchall} } ); + return "Unknown catchall" unless $svc_acct; + } $self->ut_textn('purpose'); -- cgit v1.2.1 From 9aec22e5fd00800c6e7952ae5b85cc639d4b1e78 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 20 Mar 2003 03:41:03 +0000 Subject: apache export! --- FS/FS/domain_record.pm | 4 ++-- FS/FS/part_export.pm | 28 +++++++++++++++++++++++++++- FS/FS/part_export/apache.pm | 7 +++++++ FS/MANIFEST | 1 + FS/t/part_export-apache.t | 5 +++++ 5 files changed, 42 insertions(+), 3 deletions(-) create mode 100644 FS/FS/part_export/apache.pm create mode 100644 FS/t/part_export-apache.t (limited to 'FS') diff --git a/FS/FS/domain_record.pm b/FS/FS/domain_record.pm index 37cc6c9e8..3297e6bfb 100644 --- a/FS/FS/domain_record.pm +++ b/FS/FS/domain_record.pm @@ -261,7 +261,7 @@ sub check { or return "Illegal data for PTR record: ". $self->recdata; $self->recdata($1); } elsif ( $self->rectype eq 'CNAME' ) { - $self->recdata =~ /^([a-z0-9\.\-]+)$/i + $self->recdata =~ /^([a-z0-9\.\-]+|\@)$/i or return "Illegal data for CNAME record: ". $self->recdata; $self->recdata($1); } elsif ( $self->rectype eq '_mstr' ) { @@ -313,7 +313,7 @@ sub svc_domain { =head1 VERSION -$Id: domain_record.pm,v 1.11 2002-06-23 19:16:45 ivan Exp $ +$Id: domain_record.pm,v 1.12 2003-03-20 03:41:03 ivan Exp $ =head1 BUGS diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index d62bef50d..b46d8439e 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -604,7 +604,7 @@ tie my %shellcommands_withdomain_options, 'Tie::IxHash', ; tie my %www_shellcommands_options, 'Tie::IxHash', - 'user' => { lable=>'Remote username', default=>'root' }, + 'user' => { label=>'Remote username', default=>'root' }, 'useradd' => { label=>'Insert command', default=>'mkdir /var/www/$zone; chown $username /var/www/$zone; ln -s /var/www/$zone $homedir/$zone', }, @@ -616,6 +616,27 @@ tie my %www_shellcommands_options, 'Tie::IxHash', }, ; +tie my %apache_options, 'Tie::IxHash', + 'user' => { label=>'Remote username', default=>'root' }, + 'httpd_conf' => { label=>'httpd.conf snippet location', + default=>'/etc/apache/httpd-freeside.conf', }, + 'template' => { + label => 'Template', + type => 'textarea', + default => <<'END', + #generic +# #preferred, http://httpd.apache.org/docs/dns-caveats.html +DocumentRoot /var/www/$zone +ServerName $zone +ServerAlias *.$zone +#BandWidthModule On +#LargeFileLimit 4096 12288 + + +END + }, +; + tie my %domain_shellcommands_options, 'Tie::IxHash', 'user' => { lable=>'Remote username', default=>'root' }, 'useradd' => { label=>'Insert command', @@ -894,6 +915,11 @@ tie my %ldap_options, 'Tie::IxHash', 'notes' => 'Run remote commands via SSH, for virtual web sites. You will need to setup SSH for unattended operation.', }, + 'apache' => { + 'desc' => 'Export an Apache httpd.conf file snippet.', + 'options' => \%apache_options, + 'notes' => 'Batch export of an httpd.conf snippet from a template. Typically used with something like Include /etc/apache/httpd-freeside.conf in httpd.conf. File::Rsync must be installed. Run bin/apache.export to export the files.', + }, }, 'svc_broadband' => { diff --git a/FS/FS/part_export/apache.pm b/FS/FS/part_export/apache.pm new file mode 100644 index 000000000..b72c9bdb0 --- /dev/null +++ b/FS/FS/part_export/apache.pm @@ -0,0 +1,7 @@ +package FS::part_export::bind; + +use vars qw(@ISA); +use FS::part_export::null; + +@ISA = qw(FS::part_export::null); + diff --git a/FS/MANIFEST b/FS/MANIFEST index 782286544..32a4e4f59 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -66,6 +66,7 @@ FS/part_bill_event.pm FS/export_svc.pm FS/part_export.pm FS/part_export_option.pm +FS/part_export/apache.pm FS/part_export/bind.pm FS/part_export/bind_slave.pm FS/part_export/bsdshell.pm diff --git a/FS/t/part_export-apache.t b/FS/t/part_export-apache.t new file mode 100644 index 000000000..b9995080f --- /dev/null +++ b/FS/t/part_export-apache.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::apache; +$loaded=1; +print "ok 1\n"; -- cgit v1.2.1 From fef2bffbf0315a3bd03d63c1d049d2b2afd9f1a7 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 28 Mar 2003 21:43:11 +0000 Subject: oops in null apache export --- FS/FS/part_export/apache.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export/apache.pm b/FS/FS/part_export/apache.pm index b72c9bdb0..9161d72b3 100644 --- a/FS/FS/part_export/apache.pm +++ b/FS/FS/part_export/apache.pm @@ -1,4 +1,4 @@ -package FS::part_export::bind; +package FS::part_export::apache; use vars qw(@ISA); use FS::part_export::null; -- cgit v1.2.1 From 5ffebc5c151bd680cdae15e4720ba788ad51121b Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 29 Mar 2003 02:19:44 +0000 Subject: cust_svc and svc_x methods --- FS/FS/part_export.pm | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index b46d8439e..789e8450d 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -305,6 +305,30 @@ sub part_svc { #confess "FS::part_export::part_svc deprecated"; } +=item svc_x + +Returns a list of associate FS::svc_* records. + +=cut + +sub svc_x { + my $self = shift; + map { $_->svc_x } $self->cust_svc; +} + +=item cust_svc + +Returns a list of associated FS::cust_svc records. + +=cut + +sub cust_svc { + my $self = shift; + map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) } + grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) } + $self->export_svc; +} + =item export_svc Returns a list of associated FS::export_svc records. -- cgit v1.2.1 From 7c5c428f8f102c672dd18ff0c02aaee82f5753d4 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 29 Mar 2003 02:35:49 +0000 Subject: trim leading @. off zones --- FS/FS/part_export/www_shellcommands.pm | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export/www_shellcommands.pm b/FS/FS/part_export/www_shellcommands.pm index e5b95dc1f..b3bfdfeff 100644 --- a/FS/FS/part_export/www_shellcommands.pm +++ b/FS/FS/part_export/www_shellcommands.pm @@ -30,9 +30,12 @@ sub _export_command { } my $domain_record = $svc_www->domain_record; # or die ? my $zone = $domain_record->reczone; # or die ? - unless ( $zone =~ /\.$/ ) { + if ( $zone =~ /\.$/ ) { + $zone =~ s/\.$//; + } else { my $svc_domain = $domain_record->svc_domain; # or die ? $zone .= '.'. $svc_domain->domain; + $zone =~ s/^\@\.//; } my $svc_acct = $svc_www->svc_acct; # or die ? -- cgit v1.2.1 From 48f60f666bab22a3ca5196cf6cd573b8691e4aae Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 29 Mar 2003 04:53:44 +0000 Subject: correct web UI for svc_www services & no more @.domain in www_shellcommands export --- FS/FS/cust_svc.pm | 2 +- FS/FS/domain_record.pm | 21 ++++++++++++++++++++- FS/FS/part_export/www_shellcommands.pm | 10 +--------- 3 files changed, 22 insertions(+), 11 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index 5117eff45..26e6274a1 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -290,7 +290,7 @@ sub label { $tag = $svc_x->getfield('domain'); } elsif ( $svcdb eq 'svc_www' ) { my $domain = qsearchs( 'domain_record', { 'recnum' => $svc_x->recnum } ); - $tag = $domain->reczone; + $tag = $domain->zone; } elsif ( $svcdb eq 'svc_broadband' ) { $tag = $svc_x->ip_addr; } else { diff --git a/FS/FS/domain_record.pm b/FS/FS/domain_record.pm index 3297e6bfb..2f7e270dc 100644 --- a/FS/FS/domain_record.pm +++ b/FS/FS/domain_record.pm @@ -309,11 +309,30 @@ sub svc_domain { qsearchs('svc_domain', { svcnum => $self->svcnum } ); } +=item zone + +Returns the canonical zone name. + +=cut + +sub zone { + my $self = shift; + my $zone = $self->reczone; # or die ? + if ( $zone =~ /\.$/ ) { + $zone =~ s/\.$//; + } else { + my $svc_domain = $self->svc_domain; # or die ? + $zone .= '.'. $svc_domain->domain; + $zone =~ s/^\@\.//; + } + $zone; +} + =back =head1 VERSION -$Id: domain_record.pm,v 1.12 2003-03-20 03:41:03 ivan Exp $ +$Id: domain_record.pm,v 1.13 2003-03-29 04:53:44 ivan Exp $ =head1 BUGS diff --git a/FS/FS/part_export/www_shellcommands.pm b/FS/FS/part_export/www_shellcommands.pm index b3bfdfeff..20658c7a2 100644 --- a/FS/FS/part_export/www_shellcommands.pm +++ b/FS/FS/part_export/www_shellcommands.pm @@ -29,15 +29,7 @@ sub _export_command { ${$_} = $svc_www->getfield($_) foreach $svc_www->fields; } my $domain_record = $svc_www->domain_record; # or die ? - my $zone = $domain_record->reczone; # or die ? - if ( $zone =~ /\.$/ ) { - $zone =~ s/\.$//; - } else { - my $svc_domain = $domain_record->svc_domain; # or die ? - $zone .= '.'. $svc_domain->domain; - $zone =~ s/^\@\.//; - } - + my $zone = $domain_record->zone; # or die ? my $svc_acct = $svc_www->svc_acct; # or die ? my $username = $svc_acct->username; my $homedir = $svc_acct->dir; # or die ? -- cgit v1.2.1 From f9dbf311aeddb4356855362d586d1c4643b4f538 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 31 Mar 2003 23:48:31 +0000 Subject: add 'last_bill' column --- FS/bin/freeside-setup | 1 + 1 file changed, 1 insertion(+) (limited to 'FS') diff --git a/FS/bin/freeside-setup b/FS/bin/freeside-setup index b3cdb3384..010ec4c14 100755 --- a/FS/bin/freeside-setup +++ b/FS/bin/freeside-setup @@ -609,6 +609,7 @@ sub tables_hash_hack { 'otaker', 'varchar', '', 32, 'setup', @date_type, 'bill', @date_type, + 'last_bill', @date_type, 'susp', @date_type, 'cancel', @date_type, 'expire', @date_type, -- cgit v1.2.1 From f3b8b72d2a07683b2deb2774f29407e25e725b5a Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 1 Apr 2003 01:22:25 +0000 Subject: correct last_bill problems with $0 invoice (non-existant) edge cases --- FS/FS/cust_main.pm | 2 ++ FS/FS/cust_pkg.pm | 4 ++++ 2 files changed, 6 insertions(+) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 6331fda6d..d1e975406 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1011,6 +1011,8 @@ sub bill { # only for figuring next bill date, nothing else, so, reset $sdate again # here $sdate = $cust_pkg->bill || $cust_pkg->setup || $time; + $cust_pkg->last_bill($sdate) + if $cust_pkg->dbdef_table->column('last_bill'); $mon += $part_pkg->freq; until ( $mon < 12 ) { $mon -= 12; $year++; } diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 88ffd4d17..4eea2c087 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -477,6 +477,10 @@ Useful for billing metered services. sub last_bill { my $self = shift; + if ( $self->dbdef_table->column('manual_flag') ) { + return $self->setfield('last_bill', $_[1]) if @_; + return $self->getfield('last_bill') if $self->getfield('last_bill'); + } my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum, 'edate' => $self->bill, } ); $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0; -- cgit v1.2.1 From 94494835be39e34474d8564a8cde9fdd389fcdbe Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 1 Apr 2003 08:03:22 +0000 Subject: - update qsearch for Pg 7.3 - preliminary 1.5.0 upgrade docs - syntax error in main customer view --- FS/FS/Record.pm | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 40215100f..c711f1214 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -223,13 +223,21 @@ sub qsearch { if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) { if ( $op eq '=' ) { if ( driver_name eq 'Pg' ) { - qq-( $column IS NULL OR $column = '' )-; + if ( $dbdef->table($table)->column($column)->type =~ /(int)/i ) { + qq-( $column IS NULL )-; + } else { + qq-( $column IS NULL OR $column = '' )-; + } } else { qq-( $column IS NULL OR $column = "" )-; } } elsif ( $op eq '!=' ) { if ( driver_name eq 'Pg' ) { - qq-( $column IS NOT NULL AND $column != '' )-; + if ( $dbdef->table($table)->column($column)->type =~ /(int)/i ) { + qq-( $column IS NOT NULL )-; + } else { + qq-( $column IS NOT NULL AND $column != '' )-; + } } else { qq-( $column IS NOT NULL AND $column != "" )-; } -- cgit v1.2.1 From 7ab5168716fcb97c01f0501d38780a85b9dfeaec Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 2 Apr 2003 11:38:51 +0000 Subject: better callbacks --- FS/FS/UID.pm | 53 ++++++++++++++++++++++++++++++++++++++++++++--------- FS/FS/cust_main.pm | 3 ++- 2 files changed, 46 insertions(+), 10 deletions(-) (limited to 'FS') diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm index ebf9b96e5..f67005151 100644 --- a/FS/FS/UID.pm +++ b/FS/FS/UID.pm @@ -3,8 +3,8 @@ package FS::UID; use strict; use vars qw( @ISA @EXPORT_OK $cgi $dbh $freeside_uid $user - $conf_dir $secrets $datasrc $db_user $db_pass %callback $driver_name - $AutoCommit + $conf_dir $secrets $datasrc $db_user $db_pass %callback @callback + $driver_name $AutoCommit ); use subs qw( getsecrets cgisetotaker @@ -95,9 +95,33 @@ sub forksuidsetup { # breaks multi-database installs # delete $callback{$_}; #run once } + &{$_} foreach @callback; + $dbh; } +=item install_callback + +A package can install a callback to be run in adminsuidsetup by passing +a coderef to the FS::UID->install_callback class method. If adminsuidsetup has +run already, the callback will also be run immediately. + + $coderef = sub { warn "Hi, I'm returning your call!" }; + FS::UID->install_callback($coderef); + + install_callback FS::UID sub { + warn "Hi, I'm returning your call!" + }; + +=cut + +sub install_callback { + my $class = shift; + my $callback = shift; + push @callback, $callback; + &{$callback} if $dbh; +} + =item cgisuidsetup CGI_object Takes a single argument, which is a CGI (see L) or Apache (see L) @@ -246,17 +270,28 @@ sub getsecrets { =head1 CALLBACKS -Warning: this interface is likely to change in future releases. +Warning: this interface is (still) 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 : +New (experimental) callback interface: + +A package can install a callback to be run in adminsuidsetup by passing +a coderef to the FS::UID->install_callback class method. If adminsuidsetup has +run already, the callback will also be run immediately. $coderef = sub { warn "Hi, I'm returning your call!" }; - $FS::UID::callback{'Package::Name'}; + FS::UID->install_callback($coderef); + + install_callback FS::UID sub { + warn "Hi, I'm returning your call!" + }; -=head1 VERSION +Old (deprecated) callback interface: -$Id: UID.pm,v 1.21 2002-09-27 12:14:12 ivan Exp $ +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'} = $coderef; =head1 BUGS @@ -269,7 +304,7 @@ cgisuidsetup will go away as well. Goes through contortions to support non-OO syntax with multiple datasrc's. -Callbacks are inelegant. +Callbacks are (still) inelegant. =head1 SEE ALSO diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index d1e975406..886d492c4 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -38,7 +38,8 @@ $Debug = 0; $import = 0; #ask FS::UID to run this stuff for us later -$FS::UID::callback{'FS::cust_main'} = sub { +#$FS::UID::callback{'FS::cust_main'} = sub { +install_callback FS::UID sub { $conf = new FS::Conf; #yes, need it for stuff below (prolly should be cached) }; -- cgit v1.2.1 From a3d47fd14478fdd6df79d6d26ee5d5c37ad99d5e Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 2 Apr 2003 14:52:01 +0000 Subject: added order_pkgs sub --- FS/FS/cust_main.pm | 72 +++++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 52 insertions(+), 20 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 886d492c4..cde370c68 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -277,26 +277,10 @@ sub insert { } # packages - foreach my $cust_pkg ( keys %$cust_pkgs ) { - $cust_pkg->custnum( $self->custnum ); - $error = $cust_pkg->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "inserting cust_pkg (transaction rolled back): $error"; - } - foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) { - $svc_something->pkgnum( $cust_pkg->pkgnum ); - if ( $seconds && $svc_something->isa('FS::svc_acct') ) { - $svc_something->seconds( $svc_something->seconds + $seconds ); - $seconds = 0; - } - $error = $svc_something->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - #return "inserting svc_ (transaction rolled back): $error"; - return $error; - } - } + $error = $self->order_pkgs($cust_pkgs, \$seconds); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; } if ( $seconds ) { @@ -339,6 +323,54 @@ sub insert { } +=item order_pkgs + +document me. like ->insert(%cust_pkg) on an existing record + +=cut + +sub order_pkgs { + my $self = shift; + my $cust_pkgs = shift; + my $seconds = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + foreach my $cust_pkg ( keys %$cust_pkgs ) { + $cust_pkg->custnum( $self->custnum ); + my $error = $cust_pkg->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "inserting cust_pkg (transaction rolled back): $error"; + } + foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) { + $svc_something->pkgnum( $cust_pkg->pkgnum ); + if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) { + $svc_something->seconds( $svc_something->seconds + $$seconds ); + $$seconds = 0; + } + $error = $svc_something->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + #return "inserting svc_ (transaction rolled back): $error"; + return $error; + } + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; #no error +} + =item delete NEW_CUSTNUM This deletes the customer. If there is an error, returns the error, otherwise -- cgit v1.2.1 From fdccb39f148b8fb2a8a7818e9a7999c20b2e05bd Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 19 Apr 2003 17:51:27 +0000 Subject: /^\s*$/ setup/recur expressions now failsafe to 0 (closes: Bug#498) deprecate old 1.3-style qmail integration --- FS/FS/Conf.pm | 4 ++-- FS/FS/part_pkg.pm | 2 ++ 2 files changed, 4 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index f0a4c9f45..b00e78255 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -527,8 +527,8 @@ httemplate/docs/config.html { 'key' => 'qmailmachines', - 'section' => 'mail', - 'description' => 'Your qmail machines, one per line. This enables export of `/var/qmail/control/virtualdomains\', `/var/qmail/control/recipientmap\', and `/var/qmail/control/rcpthosts\'. Setting this option (even if empty) also turns on user `.qmail-extension\' file maintenance in conjunction with the shellmachine option.', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, add qmail and shellcommands exports instead. This option used to export `/var/qmail/control/virtualdomains\', `/var/qmail/control/recipientmap\', and `/var/qmail/control/rcpthosts\'. Setting this option (even if empty) also turns on user `.qmail-extension\' file maintenance in conjunction with the shellmachine option.', 'type' => [qw( checkbox textarea )], }, diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index 99d88d56a..60b0e01f9 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -180,6 +180,8 @@ insert and replace methods. sub check { my $self = shift; + for (qw(setup recur)) { $self->set($_=>0) if $self->get($_) =~ /^\s*$/; } + my $conf = new FS::Conf; if ( $conf->exists('safe-part_pkg') ) { -- cgit v1.2.1 From 4eaa305a53b129021c3a40e9ed49196f4b4d8907 Mon Sep 17 00:00:00 2001 From: khoff Date: Mon, 21 Apr 2003 20:27:10 +0000 Subject: excludeaddr option for svc_broadband --- FS/FS/Conf.pm | 7 +++++++ FS/FS/addr_block.pm | 10 ++++++++-- 2 files changed, 15 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index b00e78255..cb404ff03 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -373,6 +373,13 @@ httemplate/docs/config.html 'type' => 'checkbox', }, + { + 'key' => 'excludeaddr', + 'section' => 'deprecated', + 'description' => 'Addresses to exclude from assignment, one per line.', + 'type' => 'textarea', + }, + { 'key' => 'erpcdmachines', 'section' => '', diff --git a/FS/FS/addr_block.pm b/FS/FS/addr_block.pm index b671723aa..c9305f6af 100755 --- a/FS/FS/addr_block.pm +++ b/FS/FS/addr_block.pm @@ -5,6 +5,7 @@ use vars qw( @ISA ); use FS::Record qw( qsearchs qsearch dbh ); use FS::router; use FS::svc_broadband; +use FS::Conf; use NetAddr::IP; @ISA = qw( FS::Record ); @@ -172,9 +173,14 @@ there are no free addresses, returns false. sub next_free_addr { my $self = shift; - my @used = map { $_->NetAddr->addr } + my $conf = new FS::Conf; + my @excludeaddr = $conf->config('excludeaddr'); + + my @used = ( + map { $_->NetAddr->addr } ($self, - qsearch('svc_broadband', { blocknum => $self->blocknum }) ); + qsearch('svc_broadband', { blocknum => $self->blocknum }) ), + @excludeaddr ); my @free = $self->NetAddr->hostenum; while (my $ip = shift @free) { -- cgit v1.2.1 From 6eedae5614eee808d0e0c4b9d9b3fe7d1217b776 Mon Sep 17 00:00:00 2001 From: khoff Date: Mon, 21 Apr 2003 20:31:20 +0000 Subject: Bug fixes for sqlmail. Added support for courier and dovecot authentication. --- FS/FS/part_export.pm | 26 ++++++-- FS/FS/part_export/sqlmail.pm | 152 +++++++++++++++++++++++++++++++------------ 2 files changed, 132 insertions(+), 46 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 789e8450d..4471d6e00 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -764,9 +764,27 @@ tie my %http_options, 'Tie::IxHash', ; tie my %sqlmail_options, 'Tie::IxHash', - 'datasrc' => { label=>'DBI data source' }, - 'username' => { label=>'Database username' }, - 'password' => { label=>'Database password' }, + 'datasrc' => { label => 'DBI data source' }, + 'username' => { label => 'Database username' }, + 'password' => { label => 'Database password' }, + 'server_type' => { + label => 'Server type', + type => 'select', + options => [qw(dovecot_plain dovecot_crypt dovecot_digest_md5 courier_plain + courier_crypt)], + default => ['dovecot_plain'], }, + 'svc_acct_table' => { label => 'User Table', default => 'user_acct' }, + 'svc_forward_table' => { label => 'Forward Table', default => 'forward' }, + 'svc_domain_table' => { label => 'Domain Table', default => 'domain' }, + 'svc_acct_fields' => { label => 'svc_acct Export Fields', + default => 'username _password domsvc svcnum' }, + 'svc_forward_fields' => { label => 'svc_forward Export Fields', + default => 'domain svcnum catchall' }, + 'svc_domain_fields' => { label => 'svc_domain Export Fields', + default => 'srcsvc dstsvc dst' }, + 'resolve_dstsvc' => { label => q{Resolve svc_forward.dstsvc to an email address and store it in dst. (Doesn't require that you also export dstsvc.)}, + type => 'checkbox' }, + ; tie my %ldap_options, 'Tie::IxHash', @@ -855,7 +873,7 @@ tie my %ldap_options, 'Tie::IxHash', 'sqlmail' => { 'desc' => 'Real-time export to SQL-backed mail server', 'options' => \%sqlmail_options, - 'nodomain' => 'Y', + 'nodomain' => 'N', 'notes' => 'Database schema can be made to work with Courier IMAP and Exim. Others could work but are untested. (...extended description from pc-intouch?...)', }, diff --git a/FS/FS/part_export/sqlmail.pm b/FS/FS/part_export/sqlmail.pm index 4194daf0c..0c0cb367b 100644 --- a/FS/FS/part_export/sqlmail.pm +++ b/FS/FS/part_export/sqlmail.pm @@ -1,54 +1,74 @@ package FS::part_export::sqlmail; -use vars qw(@ISA %fs_mail_table %fields); +use vars qw(@ISA); +use FS::Record qw(qsearchs); use FS::part_export; +use Digest::MD5 qw(md5_hex); @ISA = qw(FS::part_export); -%fs_mail_table = ( svc_acct => 'user', - svc_domain => 'domain' ); - -# fields that need to be copied into the fs_mail tables -$fields{user} = [qw(username _password finger domsvc svcnum )]; -$fields{domain} = [qw(domain svcnum catchall )]; - sub rebless { shift; } sub _export_insert { my($self, $svc) = (shift, shift); # this is a svc_something. - my $table = $fs_mail_table{$svc->cust_svc->part_svc->svcdb}; - my @attrib = map {$svc->$_} @{$fields{$table}}; + my $svcdb = $svc->cust_svc->part_svc->svcdb; + my $export_table = $self->option($svcdb . '_table') + or die('Export table not defined for svcdb: ' . $svcdb); + my @export_fields = split(/\s+/, $self->option($svcdb . '_fields')); + my $svchash = update_values($self, $svc, $svcdb); + + foreach my $key (keys(%$svchash)) { + unless (grep { $key eq $_ } @export_fields) { + delete $svchash->{$key}; + } + } + my $error = $self->sqlmail_queue( $svc->svcnum, 'insert', - $table, @attrib ); + $self->option('server_type'), $export_table, + (map { ($_, $svchash->{$_}); } keys(%$svchash))); return $error if $error; ''; + } sub _export_replace { my( $self, $new, $old ) = (shift, shift, shift); - my $table = $fs_mail_table{$new->cust_svc->part_svc->svcdb}; - - my @old = ($old->svcnum, 'delete', $table, $old->svcnum); - my @narf = map {$new->$_} @{$fields{$table}}; - $self->sqlmail_queue($new->svcnum, 'replace', $table, - $new->svcnum, @narf); - + my $svcdb = $new->cust_svc->part_svc->svcdb; + my $export_table = $self->option($svcdb . '_table') + or die('Export table not defined for svcdb: ' . $svcdb); + my @export_fields = split(/\s+/, $self->option($svcdb . '_fields')); + my $svchash = update_values($self, $new, $svcdb); + + foreach my $key (keys(%$svchash)) { + unless (grep { $key eq $_ } @export_fields) { + delete $svchash->{$key}; + } + } + + my $error = $self->sqlmail_queue( $new->svcnum, 'replace', + $old->svcnum, $self->option('server_type'), $export_table, + (map { ($_, $svchash->{$_}); } keys(%$svchash))); return $error if $error; ''; + } sub _export_delete { my( $self, $svc ) = (shift, shift); - my $table = $fs_mail_table{$new->cust_svc->part_svc->svcdb}; + + my $svcdb = $svc->cust_svc->part_svc->svcdb; + my $table = $self->option($svcdb . '_table') + or die('Export table not defined for svcdb: ' . $svcdb); + $self->sqlmail_queue( $svc->svcnum, 'delete', $table, $svc->svcnum ); } sub sqlmail_queue { - my( $self, $svcnum, $method, $table ) = (shift, shift, shift); + my( $self, $svcnum, $method ) = (shift, shift, shift); my $queue = new FS::queue { 'svcnum' => $svcnum, 'job' => "FS::part_export::sqlmail::sqlmail_$method", @@ -63,49 +83,97 @@ sub sqlmail_queue { sub sqlmail_insert { #subroutine, not method my $dbh = sqlmail_connect(shift, shift, shift); - my( $table, @attrib ) = @_; + my( $server_type, $table ) = (shift, shift); - my $sth = $dbh->prepare( - "INSERT INTO $table (" . join (',', @{$fields{$table}}) . - ") VALUES ('" . join ("','", @attrib) . "')" - ) or die $dbh->errstr; - $sth->execute() or die $sth->errstr; + my %attrs = @_; + map { $attrs{$_} = $attrs{$_} ? qq!'$attrs{$_}'! : 'NULL'; } keys(%attrs); + my $query = sprintf("INSERT INTO %s (%s) values (%s)", + $table, join(",", keys(%attrs)), + join(',', values(%attrs))); + + $dbh->do($query) or die $dbh->errstr; $dbh->disconnect; + + ''; } sub sqlmail_delete { #subroutine, not method my $dbh = sqlmail_connect(shift, shift, shift); my( $table, $svcnum ) = @_; - my $sth = $dbh->prepare( - "DELETE FROM $table WHERE svcnum = $svcnum" - ) or die $dbh->errstr; - $sth->execute() or die $sth->errstr; - + $dbh->do("DELETE FROM $table WHERE svcnum = $svcnum") or die $dbh->errstr; $dbh->disconnect; + + ''; } sub sqlmail_replace { my $dbh = sqlmail_connect(shift, shift, shift); - my( $table, $svcnum, @attrib ) = @_; + my($oldsvcnum, $server_type, $table) = (shift, shift, shift); + + my %attrs = @_; + map { $attrs{$_} = $attrs{$_} ? qq!'$attrs{$_}'! : 'NULL'; } keys(%attrs); - my %data; - @data{@{$fields{$table}}} = @attrib; + my $query = sprintf('UPDATE %s SET %s WHERE svcnum = %s', + $table, join(', ', map {"$_ = $attrs{$_}"} keys(%attrs)), + $oldsvcnum); - my $sth = $dbh->prepare( - "UPDATE $table SET " . - ( join ',', map {$_ . "='" . $data{$_} . "'"} keys(%data) ) . - " WHERE svcnum = $svcnum" - ) or die $dbh->errstr; - $sth->execute() or die $sth->errstr; + my $rv = $dbh->do($query) or die $dbh->errstr; + + if ($rv == 0) { + $query = sprintf("INSERT INTO %s (%s) values (%s)", + $table, join(",", keys(%attrs)), + join(',', values(%attrs))); + $dbh->do($query) or die $dbh->errstr; + } $dbh->disconnect; + + ''; } sub sqlmail_connect { - #my($datasrc, $username, $password) = @_; - #DBI->connect($datasrc, $username, $password) or die $DBI::errstr; DBI->connect(@_) or die $DBI::errstr; } +sub update_values { + + # Update records to conform to a particular server_type. + + my ($self, $svc, $svcdb) = (shift,shift,shift); + my $svchash = $svc->hashref or return ''; + + if ($svcdb eq 'svc_acct') { + if ($self->option('server_type') eq 'courier_crypt') { + my $salt = join '', ('.', '/', 0..9,'A'..'Z', 'a'..'z')[rand 64, rand 64]; + $svchash->{_password} = crypt($svchash->{_password}, $salt); + + } elsif ($self->option('server_type') eq 'dovecot_plain') { + $svchash->{_password} = '{PLAIN}' . $svchash->{_password}; + + } elsif ($self->option('server_type') eq 'dovecot_crypt') { + my $salt = join '', ('.', '/', 0..9,'A'..'Z', 'a'..'z')[rand 64, rand 64]; + $svchash->{_password} = '{CRYPT}' . crypt($svchash->{_password}, $salt); + + } elsif ($self->option('server_type') eq 'dovecot_digest_md5') { + my $svc_domain = qsearchs('svc_domain', { svcnum => $svc->domsvc }); + die('Unable to lookup svc_domain with domsvc: ' . $svc->domsvc) + unless ($svc_domain); + + my $domain = $svc_domain->domain; + my $md5hash = '{DIGEST-MD5}' . md5_hex(join(':', $svchash->{username}, + $domain, $svchash->{_password})); + $svchash->{_password} = $md5hash; + } + } elsif ($svcdb eq 'svc_forward') { + if ($self->option('resolve_dstsvc') && $svc->dstsvc_acct) { + $svchash->{dst} = $svc->dstsvc_acct->username . '@' . + $svc->dstsvc_acct->svc_domain->domain; + } + } + + return($svchash); + +} + -- cgit v1.2.1 From 030bef17868168b05a67d9f5866b55da1bb9439c Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 21 Apr 2003 20:53:57 +0000 Subject: on-demand vs. automatic cards & checks: added DCRD and DCHK payment types --- FS/FS/Conf.pm | 4 ++-- FS/FS/cust_main.pm | 17 ++++++++++------- FS/FS/part_bill_event.pm | 4 ++-- FS/bin/freeside-daily | 2 +- FS/bin/freeside-expiration-alerter | 6 +++--- FS/bin/freeside-setup | 2 ++ 6 files changed, 20 insertions(+), 15 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index cb404ff03..5681dde38 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -905,7 +905,7 @@ httemplate/docs/config.html 'section' => '', 'description' => 'Acceptable payment types for the signup server', 'type' => 'selectmultiple', - 'select_enum' => [ qw(CARD CHEK LECB PREPAY BILL COMP) ], + 'select_enum' => [ qw(CARD DCRD CHEK DCHK LECB PREPAY BILL COMP) ], }, { @@ -1013,7 +1013,7 @@ httemplate/docs/config.html 'section' => 'UI', 'description' => 'Default payment type. HIDE disables display of billing information and sets customers to BILL.', 'type' => 'select', - 'select_enum' => [ '', qw(CARD CHEK LECB BILL COMP HIDE) ], + 'select_enum' => [ '', qw(CARD DCRD CHEK DCHK LECB BILL COMP HIDE) ], }, { diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index cde370c68..cefc7648f 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -159,7 +159,7 @@ FS::Record. The following fields are currently supported: =item ship_fax - phone (optional) -=item payby - `CARD' (credit cards), `CHEK' (electronic check), `LECB' (Phone bill billing), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see L and sets billing type to BILL) +=item payby - I (credit card - automatic), I (credit card - on-demand), I (electronic check - automatic), I (electronic check - on-demand), I (Phone bill billing), I (billing), I (free), or I (special billing type: applies a credit - see L and sets billing type to I) =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L) @@ -700,11 +700,11 @@ sub check { } } - $self->payby =~ /^(CARD|CHEK|LECB|BILL|COMP|PREPAY)$/ + $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY)$/ or return "Illegal payby: ". $self->payby; $self->payby($1); - if ( $self->payby eq 'CARD' ) { + if ( $self->payby eq 'CARD' || $self->payby eq 'DCRD' ) { my $payinfo = $self->payinfo; $payinfo =~ s/\D//g; @@ -717,7 +717,7 @@ sub check { return gettext('unknown_card_type') if cardtype($self->payinfo) eq "Unknown"; - } elsif ( $self->payby eq 'CHEK' ) { + } elsif ( $self->payby eq 'CHEK' || $self->payby eq 'DCHK' ) { my $payinfo = $self->payinfo; $payinfo =~ s/[^\d\@]//g; @@ -770,7 +770,9 @@ sub check { } if ( $self->payname eq '' && $self->payby ne 'CHEK' && - ( ! $conf->exists('require_cardname') || $self->payby ne 'CARD' ) ) { + ( ! $conf->exists('require_cardname') + || $self->payby !~ /^(CARD|DCRD)$/ ) + ) { $self->payname( $self->first. " ". $self->getfield('last') ); } else { $self->payname =~ /^([\w \,\.\-\']+)$/ @@ -1244,8 +1246,9 @@ sub bill { (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'). +Depending on the value of `payby', this may print or email an invoice (I, +I, or I), charge a credit card (I), charge via electronic +check/ACH (I), or just add any necessary (pseudo-)payment (I). Most actions are now triggered by invoice events; see L and the invoice events web interface. diff --git a/FS/FS/part_bill_event.pm b/FS/FS/part_bill_event.pm index a75a011b0..e0e4f3f19 100644 --- a/FS/FS/part_bill_event.pm +++ b/FS/FS/part_bill_event.pm @@ -37,7 +37,7 @@ FS::Record. The following fields are currently supported: =item eventpart - primary key -=item payby - CARD, CHEK, LECB, BILL, or COMP +=item payby - CARD, DCRD, CHEK, DCHK, LECB, BILL, or COMP =item event - event name @@ -140,7 +140,7 @@ sub check { } my $error = $self->ut_numbern('eventpart') - || $self->ut_enum('payby', [qw( CARD CHEK LECB BILL COMP )] ) + || $self->ut_enum('payby', [qw( CARD DCRD CHEK DCHK LECB BILL COMP )] ) || $self->ut_text('event') || $self->ut_anything('eventcode') || $self->ut_number('seconds') diff --git a/FS/bin/freeside-daily b/FS/bin/freeside-daily index 579d071ac..63e621b57 100755 --- a/FS/bin/freeside-daily +++ b/FS/bin/freeside-daily @@ -113,7 +113,7 @@ the bill and collect methods of a cust_main object. See L. -d: Pretend it's 'date'. Date is in any format Date::Parse is happy with, but be careful. - -p: Only process customers with the specified payby (CARD, CHEK, BILL, COMP, LECB) + -p: Only process customers with the specified payby (I, I, I, I, I, I, I) -v: enable debugging diff --git a/FS/bin/freeside-expiration-alerter b/FS/bin/freeside-expiration-alerter index 5399f6d22..691fd3aa5 100755 --- a/FS/bin/freeside-expiration-alerter +++ b/FS/bin/freeside-expiration-alerter @@ -97,7 +97,7 @@ foreach my $customer (@customers) my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear); #credit cards expire at the end of the month/year of their exp date - if ($payby eq 'CARD') { + if ($payby eq 'CARD' || $payby eq 'DCRD') { ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++); $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear); $expire_time--; @@ -127,7 +127,7 @@ foreach my $customer (@customers) $FS::alerter::_template::first = $first; $FS::alerter::_template::last = $last; $FS::alerter::_template::company = $company; - if ($payby eq 'CARD') { + if ($payby eq 'CARD' || $payby eq 'DCRD') { $FS::alerter::_template::payby = "credit card (" . substr($payinfo, 0, 2) . "xxxxxxxxxx" . substr($payinfo, -4) . ")"; @@ -202,7 +202,7 @@ user: From the mapsecrets file - see config.html from the base documentation =head1 VERSION -$Id: freeside-expiration-alerter,v 1.4 2002-09-16 09:27:14 ivan Exp $ +$Id: freeside-expiration-alerter,v 1.5 2003-04-21 20:53:57 ivan Exp $ =head1 BUGS diff --git a/FS/bin/freeside-setup b/FS/bin/freeside-setup index 010ec4c14..8ec014186 100755 --- a/FS/bin/freeside-setup +++ b/FS/bin/freeside-setup @@ -291,6 +291,8 @@ foreach my $aref ( [ 'COMP', 'Comp invoice', '$cust_bill->comp();', 30, 'comp' ], [ 'CARD', 'Batch card', '$cust_bill->batch_card();', 40, 'batch-card' ], [ 'BILL', 'Send invoice', '$cust_bill->send();', 50, 'send' ], + [ 'DCRD', 'Send invoice', '$cust_bill->send();', 50, 'send' ], + [ 'DCHK', 'Send invoice', '$cust_bill->send();', 50, 'send' ], ) { my $part_bill_event = new FS::part_bill_event({ -- cgit v1.2.1 From c302e891a8eb8dd565cb3b2dc83cdfa5c0a09537 Mon Sep 17 00:00:00 2001 From: khoff Date: Mon, 21 Apr 2003 21:40:00 +0000 Subject: renamed/clarified exclude_ip_addr option. --- FS/FS/Conf.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 5681dde38..545d8b77e 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -374,9 +374,9 @@ httemplate/docs/config.html }, { - 'key' => 'excludeaddr', - 'section' => 'deprecated', - 'description' => 'Addresses to exclude from assignment, one per line.', + 'key' => 'exclude_ip_addr', + 'section' => '', + 'description' => 'Exclude these from the list of available broadband service IP addresses. (One per line)', 'type' => 'textarea', }, -- cgit v1.2.1 From e27c01a149940c1f42da1f7246f775ab0533463b Mon Sep 17 00:00:00 2001 From: khoff Date: Mon, 21 Apr 2003 21:42:24 +0000 Subject: renamed config option excludeaddr --- FS/FS/addr_block.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/addr_block.pm b/FS/FS/addr_block.pm index c9305f6af..af4e5fb79 100755 --- a/FS/FS/addr_block.pm +++ b/FS/FS/addr_block.pm @@ -174,7 +174,7 @@ sub next_free_addr { my $self = shift; my $conf = new FS::Conf; - my @excludeaddr = $conf->config('excludeaddr'); + my @excludeaddr = $conf->config('exclude_ip_addr'); my @used = ( map { $_->NetAddr->addr } -- cgit v1.2.1 From 60527016538d1794227983d99ce3b77c8fcd7426 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 22 Apr 2003 04:39:40 +0000 Subject: - mysql 4.1 is available; update documentation - remove last vestiges of 1.3-style qmail/vpopmail exports from svc_domain and svc_forward; add appropriate exports (closes: Bug#299) --- FS/FS/Conf.pm | 2 +- FS/FS/part_export.pm | 20 ++- FS/FS/part_export/domain_shellcommands.pm | 18 ++- FS/FS/part_export/forward_shellcommands.pm | 110 +++++++++++++++++ FS/FS/svc_domain.pm | 59 ++------- FS/FS/svc_forward.pm | 192 +---------------------------- FS/MANIFEST | 2 + FS/t/part_export-forward_shellcommands.t | 5 + 8 files changed, 159 insertions(+), 249 deletions(-) create mode 100644 FS/FS/part_export/forward_shellcommands.pm create mode 100644 FS/t/part_export-forward_shellcommands.t (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 545d8b77e..d0ecf32a6 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -818,7 +818,7 @@ httemplate/docs/config.html { 'key' => 'vpopmailmachines', 'section' => 'deprecated', - 'description' => 'DEPRECATED, add a cp export instead. This option used to contain your vpopmail pop toasters, one per line. Each line is of the form "machinename vpopdir vpopuid vpopgid". For example: poptoaster.domain.tld /home/vpopmail 508 508 Note: vpopuid and vpopgid are values taken from the vpopmail machine\'s /etc/passwd', + 'description' => 'DEPRECATED, add a vpopmail export instead. This option used to contain your vpopmail pop toasters, one per line. Each line is of the form "machinename vpopdir vpopuid vpopgid". For example: poptoaster.domain.tld /home/vpopmail 508 508 Note: vpopuid and vpopgid are values taken from the vpopmail machine\'s /etc/passwd', 'type' => 'textarea', }, diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 4471d6e00..f99dc6341 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -815,6 +815,18 @@ tie my %ldap_options, 'Tie::IxHash', 'radius' => { label=>'Export RADIUS attributes', type=>'checkbox', }, ; +tie my %forward_shellcommands_options, 'Tie::IxHash', + 'user' => { lable=>'Remote username', default=>'root' }, + 'useradd' => { label=>'Insert command', + default=>'', + }, + 'userdel' => { label=>'Delete command', + default=>'', + }, + 'usermod' => { label=>'Modify command', + default=>'', + }, +; #export names cannot have dashes... %exports = ( @@ -935,7 +947,7 @@ tie my %ldap_options, 'Tie::IxHash', 'domain_shellcommands' => { 'desc' => 'Run remote commands via SSH, for domains.', 'options' => \%domain_shellcommands_options, - 'notes' => 'Run remote commands via SSH, for domains. You will need to setup SSH for unattended operation.', + 'notes' => 'Run remote commands via SSH, for domains. You will need to setup SSH for unattended operation.

Use these buttons for some useful presets:
', }, @@ -948,6 +960,12 @@ tie my %ldap_options, 'Tie::IxHash', #'nodomain' => 'Y', 'notes' => 'Database schema can be made to work with Courier IMAP and Exim. Others could work but are untested. (...extended description from pc-intouch?...)', }, + + 'forward_shellcommands' => { + 'desc' => 'Run remote commands via SSH, for forwards', + 'options' => \%forward_shellcommands_options, + 'notes' => 'Run remote commands via SSH, for forwards. You will need to setup SSH for unattended operation.

Use these buttons for some useful presets:
  • /home/vpopmail/domains/$domain/$username/.qmail; chown vpopmail:vchkpw /home/vpopmail/domains/$domain/$username/.qmail; }"; this.form.userdel.value = "rm /home/vpopmail/domains/$domain/$username/.qmail"; this.form.usermod.value = "mv /home/vpopmail/domains/$old_domain/$old_username/.qmail /home/vpopmail/domains/$new_domain/$new_username; [ \"$old_destination\" != \"$new_destination\" ] && { echo \"$new_destination\" > /home/vpopmail/domains/$new_domain/$new_username/.qmail; chown vpopmail:vchkpw /home/vpopmail/domains/$new_domain/$new_username/.qmail; }";\'>
', + }, }, 'svc_www' => { diff --git a/FS/FS/part_export/domain_shellcommands.pm b/FS/FS/part_export/domain_shellcommands.pm index 5b3cd5d79..5b100e8c6 100644 --- a/FS/FS/part_export/domain_shellcommands.pm +++ b/FS/FS/part_export/domain_shellcommands.pm @@ -28,17 +28,15 @@ sub _export_command { no strict 'refs'; ${$_} = $svc_domain->getfield($_) foreach $svc_domain->fields; } + ( $qdomain = $domain ) =~ s/\./:/g; #see dot-qmail(5): EXTENSION ADDRESSES -# my $domain_record = $svc_www->domain_record; # or die ? -# my $zone = $domain_record->reczone; # or die ? -# unless ( $zone =~ /\.$/ ) { -# my $svc_domain = $domain_record->svc_domain; # or die ? -# $zone .= '.'. $svc_domain->domain; -# } - -# my $svc_acct = $svc_www->svc_acct; # or die ? -# my $username = $svc_acct->username; -# my $homedir = $svc_acct->dir; # or die ? + if ( $svc_domain->catchall ) { + no strict 'refs'; + my $svc_acct = $svc_domain->catchall_svc_acct; + ${$_} = $svc_acct->getfield($_) foreach qw(uid gid dir); + } else { + ${$_} = '' foreach qw(uid gid dir); + } #done setting variables for the command diff --git a/FS/FS/part_export/forward_shellcommands.pm b/FS/FS/part_export/forward_shellcommands.pm new file mode 100644 index 000000000..43d558a69 --- /dev/null +++ b/FS/FS/part_export/forward_shellcommands.pm @@ -0,0 +1,110 @@ +package FS::part_export::forward_shellcommands; + +use strict; +use vars qw(@ISA); +use FS::part_export; + +@ISA = qw(FS::part_export); + +sub rebless { shift; } + +sub _export_insert { + my($self) = shift; + $self->_export_command('useradd', @_); +} + +sub _export_delete { + my($self) = shift; + $self->_export_command('userdel', @_); +} + +sub _export_command { + my ( $self, $action, $svc_forward ) = (shift, shift, shift); + my $command = $self->option($action); + + #set variable for the command + no strict 'vars'; + { + no strict 'refs'; + ${$_} = $svc_forward->getfield($_) foreach $svc_forward->fields; + } + + my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $self->srcsvc } ); + $username = $svc_acct->username; + $domain = $svc_acct->domain; + if ($self->dstsvc) { + $destination = $self->dstsvc_acct->email; + } else { + $destination = $self->dst; + } + + #done setting variables for the command + + $self->shellcommands_queue( $svc_forward->svcnum, + user => $self->option('user')||'root', + host => $self->machine, + command => eval(qq("$command")), + ); +} + +sub _export_replace { + my( $self, $new, $old ) = (shift, shift, shift); + my $command = $self->option('usermod'); + + #set variable for the command + no strict 'vars'; + { + no strict 'refs'; + ${"old_$_"} = $old->getfield($_) foreach $old->fields; + ${"new_$_"} = $new->getfield($_) foreach $new->fields; + } + + my $old_svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $self->srcsvc } ); + $old_username = $old_svc_acct->username; + $old_domain = $old_svc_acct->domain; + if ($self->dstsvc) { + $old_destination = $self->dstsvc_acct->email; + } else { + $old_destination = $self->dst; + } + + my $new_svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $self->srcsvc } ); + $new_username = $new_svc_acct->username; + $new_domain = $new_svc_acct->domain; + if ($self->dstsvc) { + $new_destination = $self->dstsvc_acct->email; + } else { + $new_destination = $self->dst; + } + + #done setting variables for the command + + $self->shellcommands_queue( $new->svcnum, + user => $self->option('user')||'root', + host => $self->machine, + command => eval(qq("$command")), + ); +} + +#a good idea to queue anything that could fail or take any time +sub shellcommands_queue { + my( $self, $svcnum ) = (shift, shift); + my $queue = new FS::queue { + 'svcnum' => $svcnum, + 'job' => "FS::part_export::forward_shellcommands::ssh_cmd", + }; + $queue->insert( @_ ); +} + +sub ssh_cmd { #subroutine, not method + use Net::SSH '0.07'; + &Net::SSH::ssh_cmd( { @_ } ); +} + +#sub shellcommands_insert { #subroutine, not method +#} +#sub shellcommands_replace { #subroutine, not method +#} +#sub shellcommands_delete { #subroutine, not method +#} + diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm index 3941d6eff..81edc337e 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -3,14 +3,13 @@ package FS::svc_domain; use strict; use vars qw( @ISA $whois_hack $conf $smtpmachine @defaultrecords $soadefaultttl $soaemail $soaexpire $soamachine - $soarefresh $soaretry $qshellmachine $nossh_hack + $soarefresh $soaretry ); use Carp; use Mail::Internet 1.44; use Mail::Header; use Date::Format; use Net::Whois 1.0; -use Net::SSH; use FS::Record qw(fields qsearch qsearchs dbh); use FS::Conf; use FS::svc_Common; @@ -37,9 +36,6 @@ $FS::UID::callback{'FS::domain'} = sub { $soarefresh = $conf->config('soarefresh'); $soaretry = $conf->config('soaretry'); - $qshellmachine = $conf->exists('qmailmachines') - ? $conf->config('shellmachine') - : ''; }; =head1 NAME @@ -120,21 +116,6 @@ If any records are defined in the I configuration file, appropriate records are added to the domain_record table (see L). -If a machine is defined in the I configuration value, the -I configuration file exists, and the I field points -to an an account with a home directory (see L), the command: - - [ -e $dir/.qmail-$qdomain-defualt ] || { - touch $dir/.qmail-$qdomain-default; - chown $uid:$gid $dir/.qmail-$qdomain-default; - } - -is executed on shellmachine via ssh (see L). -This behaviour can be supressed by setting $FS::svc_domain::nossh_hack true. - -a machine is defined -in the - =cut sub insert { @@ -211,28 +192,6 @@ sub insert { $dbh->commit or die $dbh->errstr if $oldAutoCommit; - if ( $qshellmachine && $self->catchall && ! $nossh_hack ) { - - my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $self->catchall } ) - or warn "WARNING: inserted unknown catchall: ". $self->catchall; - if ( $svc_acct && $svc_acct->dir ) { - my $qdomain = $self->domain; - $qdomain =~ s/\./:/g; #see manpage for 'dot-qmail': EXTENSION ADDRESSES - my ( $uid, $gid, $dir ) = ( - $svc_acct->uid, - $svc_acct->gid, - $svc_acct->dir, - ); - - my $queue = new FS::queue { - 'svcnum' => $self->svcnum, - 'job' => 'Net::SSH::ssh_cmd', - }; - $error = $queue->insert("root\@$qshellmachine", "[ -e $dir/.qmail-$qdomain-default ] || { touch $dir/.qmail-$qdomain-default; chown $uid:$gid $dir/.qmail-$qdomain-default; }" ); - - } - } - ''; #no error } @@ -411,6 +370,15 @@ sub domain_record { } +sub catchall_svc_acct { + my $self = shift; + if ( $self->catchall ) { + qsearchs( 'svc_acct', { 'svcnum' => $self->catchall } ); + } else { + ''; + } +} + =item whois Returns the Net::Whois::Domain object (see L) for this domain, or @@ -449,8 +417,6 @@ sub submit_internic { =head1 BUGS -All BIND/DNS fields should be included (and exported). - Delete doesn't send a registration template. All registries should be supported. @@ -462,9 +428,8 @@ The $recref stuff in sub check should be cleaned up. =head1 SEE ALSO L, L, L, L, -L, L, L, L, -L, schema.html from the base documentation, config.html from the -base documentation. +L, L, L, schema.html from the base +documentation, config.html from the base documentation. =cut diff --git a/FS/FS/svc_forward.pm b/FS/FS/svc_forward.pm index 1c5b5c40d..2b1fb9225 100644 --- a/FS/FS/svc_forward.pm +++ b/FS/FS/svc_forward.pm @@ -1,9 +1,7 @@ package FS::svc_forward; use strict; -use vars qw( @ISA $nossh_hack $conf $shellmachine @qmailmachines - @vpopmailmachines ); -use Net::SSH qw(ssh); +use vars qw( @ISA ); use FS::Conf; use FS::Record qw( fields qsearch qsearchs dbh ); use FS::svc_Common; @@ -13,21 +11,6 @@ use FS::svc_domain; @ISA = qw( FS::svc_Common ); -#ask FS::UID to run this stuff for us later -$FS::UID::callback{'FS::svc_forward'} = sub { - $conf = new FS::Conf; - if ( $conf->exists('qmailmachines') ) { - $shellmachine = $conf->config('shellmachine') - } else { - $shellmachine = ''; - } - if ( $conf->exists('vpopmailmachines') ) { - @vpopmailmachines = $conf->config('vpopmailmachines'); - } else { - @vpopmailmachines = (); - } -}; - =head1 NAME FS::svc_forward - Object methods for svc_forward records @@ -91,17 +74,6 @@ 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) vpopmailmachines exists, then -the command: - - [ -d $vpopdir/domains/$domain/$source ] && { - echo "$destination" >> $vpopdir/domains/$domain/$username/.$qmail - chown $vpopuid:$vpopgid $vpopdir/domains/$domain/$username/.$qmail - } - -is executed on each vpopmailmachine via ssh (see the vpopmail documentation). -This behaviour can be supressed by setting $FS::svc_forward::nossh_hack true. - =cut sub insert { @@ -128,32 +100,6 @@ sub insert { return $error; } - my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $self->srcsvc } ); - my $username = $svc_acct->username; - my $domain = $svc_acct->domain; - my $destination; - if ($self->dstsvc) { - $destination = $self->dstsvc_acct->email; - } else { - $destination = $self->dst; - } - - foreach my $vpopmailmachine ( @vpopmailmachines ) { - my($machine, $vpopdir, $vpopuid, $vpopgid) = split(/\s+/, $vpopmailmachine); - my $queue = new FS::queue { - 'svcnum' => $self->svcnum, - 'job' => 'Net::SSH::ssh_cmd', - }; - # should be neater - my $error = $queue->insert("root\@$machine","[ -d $vpopdir/domains/$domain/$username ] && { echo \"$destination\" >> $vpopdir/domains/$domain/$username/.qmail; chown $vpopuid:$vpopgid $vpopdir/domains/$domain/$username/.qmail; }") - unless $nossh_hack; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - - } - $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error @@ -166,19 +112,6 @@ returns the error, otherwise returns false. The corresponding FS::cust_svc record will be deleted as well. -If the configuration value vpopmailmachines exists, then the command: - - { sed -e '/^$destination/d' < - $vpopdir/domains/$srcdomain/$srcusername/.qmail > - $vpopdir/domains/$srcdomain/$srcusername/.qmail.temp; - mv $vpopdir/domains/$srcdomain/$srcusername/.qmail.temp - $vpopdir/domains/$srcdomain/$srcusername/.qmail; - chown $vpopuid.$vpopgid $vpopdir/domains/$srcdomain/$srcusername/.qmail; } - - -is executed on each vpopmailmachine via ssh. This behaviour can be supressed -by setting $FS::svc_forward_nossh_hack true. - =cut sub delete { @@ -201,37 +134,6 @@ sub delete { return $error; } - my $svc_acct = $self->srcsvc_acct; - my $username = $svc_acct->username; - my $domain = $svc_acct->domain; - my $destination; - if ($self->dstsvc) { - $destination = $self->dstsvc_acct->email; - } else { - $destination = $self->dst; - } - foreach my $vpopmailmachine ( @vpopmailmachines ) { - my($machine, $vpopdir, $vpopuid, $vpopgid) = - split(/\s+/, $vpopmailmachine); - my $queue = new FS::queue { 'job' => 'Net::SSH::ssh_cmd' }; - # should be neater - my $error = $queue->insert("root\@$machine", - "sed -e '/^$destination/d' " . - "< $vpopdir/domains/$domain/$username/.qmail" . - "> $vpopdir/domains/$domain/$username/.qmail.temp; " . - "mv $vpopdir/domains/$domain/$username/.qmail.temp " . - "$vpopdir/domains/$domain/$username/.qmail; " . - "chown $vpopuid.$vpopgid $vpopdir/domains/$domain/$username/.qmail;" - ) - unless $nossh_hack; - - if ($error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - - } - $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } @@ -242,29 +144,6 @@ sub delete { Replaces OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. -If the configuration value vpopmailmachines exists, then the command: - - { sed -e '/^$destination/d' < - $vpopdir/domains/$srcdomain/$srcusername/.qmail > - $vpopdir/domains/$srcdomain/$srcusername/.qmail.temp; - mv $vpopdir/domains/$srcdomain/$srcusername/.qmail.temp - $vpopdir/domains/$srcdomain/$srcusername/.qmail; - chown $vpopuid.$vpopgid $vpopdir/domains/$srcdomain/$srcusername/.qmail; } - - -is executed on each vpopmailmachine via ssh. This behaviour can be supressed -by setting $FS::svc_forward_nossh_hack true. - -Also, if the configuration value vpopmailmachines exists, then the command: - - [ -d $vpopdir/domains/$domain/$source ] && { - echo "$destination" >> $vpopdir/domains/$domain/$username/.$qmail - chown $vpopuid:$vpopgid $vpopdir/domains/$domain/$username/.$qmail - } - -is executed on each vpopmailmachine via ssh. This behaviour can be supressed -by setting $FS::svc_forward_nossh_hack true. - =cut sub replace { @@ -295,66 +174,6 @@ sub replace { return $error; } - my $old_svc_acct = $old->srcsvc_acct; - my $old_username = $old_svc_acct->username; - my $old_domain = $old_svc_acct->domain; - my $destination; - if ($old->dstsvc) { - $destination = $old->dstsvc_acct->email; - } else { - $destination = $old->dst; - } - foreach my $vpopmailmachine ( @vpopmailmachines ) { - my($machine, $vpopdir, $vpopuid, $vpopgid) = - split(/\s+/, $vpopmailmachine); - my $queue = new FS::queue { - 'svcnum' => $new->svcnum, - 'job' => 'Net::SSH::ssh_cmd', - }; - # should be neater - my $error = $queue->insert("root\@$machine", - "sed -e '/^$destination/d' " . - "< $vpopdir/domains/$old_domain/$old_username/.qmail" . - "> $vpopdir/domains/$old_domain/$old_username/.qmail.temp; " . - "mv $vpopdir/domains/$old_domain/$old_username/.qmail.temp " . - "$vpopdir/domains/$old_domain/$old_username/.qmail; " . - "chown $vpopuid.$vpopgid " . - "$vpopdir/domains/$old_domain/$old_username/.qmail;" - ) - unless $nossh_hack; - - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - } - - #false laziness with stuff in insert, should subroutine - my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $new->srcsvc } ); - my $username = $svc_acct->username; - my $domain = $svc_acct->domain; - if ($new->dstsvc) { - $destination = $new->dstsvc_acct->email; - } else { - $destination = $new->dst; - } - - foreach my $vpopmailmachine ( @vpopmailmachines ) { - my($machine, $vpopdir, $vpopuid, $vpopgid) = split(/\s+/, $vpopmailmachine); - my $queue = new FS::queue { - 'svcnum' => $new->svcnum, - 'job' => 'Net::SSH::ssh_cmd', - }; - # should be neater - my $error = $queue->insert("root\@$machine","[ -d $vpopdir/domains/$domain/$username ] && { echo \"$destination\" >> $vpopdir/domains/$domain/$username/.qmail; chown $vpopuid:$vpopgid $vpopdir/domains/$domain/$username/.qmail; }") - unless $nossh_hack; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - } - #end subroutinable bits - $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } @@ -450,19 +269,12 @@ sub dstsvc_acct { =back -=head1 VERSION - -$Id: svc_forward.pm,v 1.12 2002-05-31 17:50:37 ivan Exp $ - =head1 BUGS -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. +L, L, schema.html from the base documentation. =cut diff --git a/FS/MANIFEST b/FS/MANIFEST index 32a4e4f59..6397cc411 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -73,6 +73,7 @@ FS/part_export/bsdshell.pm FS/part_export/cp.pm FS/part_export/cyrus.pm FS/part_export/domain_shellcommands.pm +FS/part_export/forward_shellcommands.pm FS/part_export/http.pm FS/part_export/infostreet.pm FS/part_export/ldap.pm @@ -155,6 +156,7 @@ t/part_export-bsdshell.t t/part_export-cp.t t/part_export-cyrus.t t/part_export-domain_shellcommands.t +t/part_export-forward_shellcommands.t t/part_export-http.t t/part_export-infostreet.t t/part_export-ldap.t diff --git a/FS/t/part_export-forward_shellcommands.t b/FS/t/part_export-forward_shellcommands.t new file mode 100644 index 000000000..78ca68d10 --- /dev/null +++ b/FS/t/part_export-forward_shellcommands.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::forward_shellcommands; +$loaded=1; +print "ok 1\n"; -- cgit v1.2.1 From a741f52db660b39a3f3c12acd0623d87bfc9108a Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 22 Apr 2003 18:46:52 +0000 Subject: properly deprecate ancient apache & sendmail config options --- FS/FS/Conf.pm | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index d0ecf32a6..84b3c26ed 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -228,8 +228,8 @@ httemplate/docs/config.html { 'key' => 'apacheip', - 'section' => 'apache', - 'description' => 'The current IP address to assign to new virtual hosts', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, add an apache export instead. Used to be the current IP address to assign to new virtual hosts', 'type' => 'text', }, @@ -242,8 +242,8 @@ httemplate/docs/config.html { 'key' => 'apachemachines', - 'section' => 'apache', - 'description' => 'Your Apache machines, one per line. This enables export of `/etc/apache/vhosts.conf\', which can be included in your Apache configuration via the Include directive.', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, add an apache export instead. Used to be 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.', 'type' => 'textarea', }, @@ -382,8 +382,8 @@ httemplate/docs/config.html { 'key' => 'erpcdmachines', - 'section' => '', - 'description' => 'Your ERPCD authenticaion machines, one per line. This enables export of `/usr/annex/acp_passwd\' and `/usr/annex/acp_dialup\'', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, ERPCD is no longer supported. Used to be ERPCD authenticaion machines, one per line. This enables export of `/usr/annex/acp_passwd\' and `/usr/annex/acp_dialup\'', 'type' => 'textarea', }, @@ -418,21 +418,21 @@ httemplate/docs/config.html { 'key' => 'icradius_mysqldest', 'section' => 'deprecated', - 'description' => 'DEPRECATED, add an sqlradius https://billing.crosswind.net/freeside/browse/part_export.cgi">export instead. Used to be the destination directory for the MySQL databases, on the ICRADIUS/FreeRADIUS machines. Defaults to "/usr/local/var/".', + 'description' => 'DEPRECATED, add an sqlradius export instead. Used to be the destination directory for the MySQL databases, on the ICRADIUS/FreeRADIUS machines. Defaults to "/usr/local/var/".', 'type' => 'text', }, { 'key' => 'icradius_mysqlsource', 'section' => 'deprecated', - 'description' => 'DEPRECATED, add an sqlradius https://billing.crosswind.net/freeside/browse/part_export.cgi">export instead. Used to be the source directory for for the MySQL radcheck table files, on the Freeside machine. Defaults to "/usr/local/var/freeside".', + 'description' => 'DEPRECATED, add an sqlradius export instead. Used to be the source directory for for the MySQL radcheck table files, on the Freeside machine. Defaults to "/usr/local/var/freeside".', 'type' => 'text', }, { 'key' => 'icradius_secrets', 'section' => 'deprecated', - 'description' => 'DEPRECATED, add an sqlradius https://billing.crosswind.net/freeside/browse/part_export.cgi">export instead. This option used to specify a database for ICRADIUS/FreeRADIUS export. Three lines: DBI data source, username and password.', + 'description' => 'DEPRECATED, add an sqlradius export instead. This option used to specify a database for ICRADIUS/FreeRADIUS export. Three lines: DBI data source, username and password.', 'type' => 'textarea', }, @@ -576,22 +576,22 @@ httemplate/docs/config.html { 'key' => 'sendmailconfigpath', - 'section' => 'mail', - 'description' => 'Sendmail configuration file path. Defaults to `/etc\'. Many newer distributions use `/etc/mail\'.', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, add a sendmail export instead. Used to be sendmail configuration file path. Defaults to `/etc\'. Many newer distributions use `/etc/mail\'.', 'type' => 'text', }, { 'key' => 'sendmailmachines', - 'section' => 'mail', - 'description' => 'Your sendmail machines, one per line. This enables export of `/etc/virtusertable\' and `/etc/sendmail.cw\'.', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, add a sendmail export instead. Used to be sendmail machines, one per line. This enables export of `/etc/virtusertable\' and `/etc/sendmail.cw\'.', 'type' => 'textarea', }, { 'key' => 'sendmailrestart', - 'section' => 'mail', - 'description' => 'If defined, the command which is run on sendmail machines after files are copied.', + 'section' => 'deprecated', + 'description' => 'DEPRECATED, add a sendmail export instead. Used to define the command which is run on sendmail machines after files are copied.', 'type' => 'text', }, -- cgit v1.2.1 From 970a86aec45df2ab579ac54fc67cba475c7c013b Mon Sep 17 00:00:00 2001 From: khoff Date: Wed, 23 Apr 2003 04:53:17 +0000 Subject: DBD::Pg doesn't handle char types very well. --- FS/bin/freeside-setup | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-setup b/FS/bin/freeside-setup index 8ec014186..518a2ad42 100755 --- a/FS/bin/freeside-setup +++ b/FS/bin/freeside-setup @@ -471,7 +471,7 @@ sub tables_hash_hack { 'last', 'varchar', '', $char_d, # 'middle', 'varchar', 'NULL', $char_d, 'first', 'varchar', '', $char_d, - 'ss', 'char', 'NULL', 11, + 'ss', 'varchar', 'NULL', 11, 'company', 'varchar', 'NULL', $char_d, 'address1', 'varchar', '', $char_d, 'address2', 'varchar', 'NULL', $char_d, @@ -823,7 +823,7 @@ sub tables_hash_hack { #'reczone', 'varchar', '', $char_d, 'reczone', 'varchar', '', 255, 'recaf', 'char', '', 2, - 'rectype', 'char', '', 5, + 'rectype', 'varchar', '', 5, #'recdata', 'varchar', '', $char_d, 'recdata', 'varchar', '', 255, ], -- cgit v1.2.1 From 40dfd062e7bf133824287d432812b51c6ea3456a Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 23 Apr 2003 22:16:55 +0000 Subject: might not be necessary, but to be safe... --- FS/FS/part_export.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index f99dc6341..a6a67d2db 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -885,7 +885,7 @@ tie my %forward_shellcommands_options, 'Tie::IxHash', 'sqlmail' => { 'desc' => 'Real-time export to SQL-backed mail server', 'options' => \%sqlmail_options, - 'nodomain' => 'N', + 'nodomain' => '', 'notes' => 'Database schema can be made to work with Courier IMAP and Exim. Others could work but are untested. (...extended description from pc-intouch?...)', }, -- cgit v1.2.1 From d540445a9a35750e1127e3854ecba420d588a022 Mon Sep 17 00:00:00 2001 From: khoff Date: Thu, 24 Apr 2003 01:00:42 +0000 Subject: Apparently deleting elements from svc_Common->hashref is bad. --- FS/FS/part_export/sqlmail.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export/sqlmail.pm b/FS/FS/part_export/sqlmail.pm index 0c0cb367b..f97674c27 100644 --- a/FS/FS/part_export/sqlmail.pm +++ b/FS/FS/part_export/sqlmail.pm @@ -142,7 +142,7 @@ sub update_values { # Update records to conform to a particular server_type. my ($self, $svc, $svcdb) = (shift,shift,shift); - my $svchash = $svc->hashref or return ''; + my $svchash = { %{$svc->hashref} } or return ''; # We need a copy. if ($svcdb eq 'svc_acct') { if ($self->option('server_type') eq 'courier_crypt') { -- cgit v1.2.1 From 2c0751312ced1bcbcfa0907393895fb19d25c280 Mon Sep 17 00:00:00 2001 From: khoff Date: Thu, 24 Apr 2003 01:43:10 +0000 Subject: Support for exporting to an ISC BIND9 name server --- FS/FS/part_export.pm | 30 +++++++++++++++++++++--------- 1 file changed, 21 insertions(+), 9 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index a6a67d2db..d898d2616 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -718,18 +718,30 @@ tie my %vpopmail_options, 'Tie::IxHash', ; tie my %bind_options, 'Tie::IxHash', - #'machine' => { label=>'named machine' }, - 'named_conf' => { label => 'named.conf location', - default=> '/etc/bind/named.conf' }, - 'zonepath' => { label => 'path to zone files', - default=> '/etc/bind/', }, + #'machine' => { label=>'named machine' }, + 'named_conf' => { label => 'named.conf location', + default=> '/etc/bind/named.conf' }, + 'zonepath' => { label => 'path to zone files', + default=> '/etc/bind/', }, + 'bind_release' => { label => 'ISC BIND Release', + type => 'select', + options => [qw(BIND8 BIND9)], + default => 'BIND8' }, + 'bind9_minttl' => { label => 'The minttl required by bind9 and RFC1035.', + default => '1D' }, ; tie my %bind_slave_options, 'Tie::IxHash', - #'machine' => { label=> 'Slave machine' }, - 'master' => { label=> 'Master IP address(s) (semicolon-separated)' }, - 'named_conf' => { label => 'named.conf location', - default => '/etc/bind/named.conf' }, + #'machine' => { label=> 'Slave machine' }, + 'master' => { label=> 'Master IP address(s) (semicolon-separated)' }, + 'named_conf' => { label => 'named.conf location', + default => '/etc/bind/named.conf' }, + 'bind_release' => { label => 'ISC BIND Release', + type => 'select', + options => [qw(BIND8 BIND9)], + default => 'BIND8' }, + 'bind9_minttl' => { label => 'The minttl required by bind9 and RFC1035.', + default => '1D' }, ; tie my %http_options, 'Tie::IxHash', -- cgit v1.2.1 From 21bc19b84183312dbb4087a33ad1ce5877088f82 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 24 Apr 2003 02:46:41 +0000 Subject: better shellcommands documentation of all sorts --- FS/FS/part_export.pm | 10 ++++---- FS/FS/part_export/domain_shellcommands.pm | 38 ++++++++++++++----------------- 2 files changed, 22 insertions(+), 26 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index d898d2616..8370b3f9e 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -872,13 +872,13 @@ tie my %forward_shellcommands_options, 'Tie::IxHash', 'desc' => 'Real-time export via remote SSH (i.e. useradd, userdel, etc.)', 'options' => \%shellcommands_options, 'nodomain' => 'Y', - 'notes' => 'Run remote commands via SSH. Usernames are considered unique (also see shellcommands_withdomain). You probably want this if the commands you are running will not accept a domain as a parameter. You will need to setup SSH for unattended operation.

Use these buttons for some useful presets:
', + 'notes' => 'Run remote commands via SSH. Usernames are considered unique (also see shellcommands_withdomain). You probably want this if the commands you are running will not accept a domain as a parameter. You will need to setup SSH for unattended operation.

Use these buttons for some useful presets:
The following variables are available for interpolation (prefixed with new_ or old_ for replace operations):
  • $username
  • $_password
  • $quoted_password - unencrypted password quoted for the shell
  • $crypt_password - encrypted password
  • $uid
  • $gid
  • $finger - GECOS, already quoted for the shell (do not add additional quotes)
  • $dir - home directory
  • $shell
  • $quota
  • All other fields in svc_acct are also available.
', }, 'shellcommands_withdomain' => { 'desc' => 'Real-time export via remote SSH.', 'options' => \%shellcommands_withdomain_options, - 'notes' => 'Run remote commands via SSH. username@domain (rather than just usernames) are considered unique (also see shellcommands). You probably want this if the commands you are running will accept a domain as a parameter, and will allow the same username with different domains. You will need to setup SSH for unattended operation.', + 'notes' => 'Run remote commands via SSH. username@domain (rather than just usernames) are considered unique (also see shellcommands). You probably want this if the commands you are running will accept a domain as a parameter, and will allow the same username with different domains. You will need to setup SSH for unattended operation.

The following variables are available for interpolation (prefixed with new_ or old_ for replace operations):
  • $username
  • $domain
  • $_password
  • $quoted_password - unencrypted password quoted for the shell
  • $crypt_password - encrypted password
  • $uid
  • $gid
  • $finger - GECOS, already quoted for the shell (do not add additional quotes)
  • $dir - home directory
  • $shell
  • $quota
  • All other fields in svc_acct are also available.
', }, 'ldap' => { @@ -959,7 +959,7 @@ tie my %forward_shellcommands_options, 'Tie::IxHash', 'domain_shellcommands' => { 'desc' => 'Run remote commands via SSH, for domains.', 'options' => \%domain_shellcommands_options, - 'notes' => 'Run remote commands via SSH, for domains. You will need to setup SSH for unattended operation.

Use these buttons for some useful presets:
', + 'notes' => 'Run remote commands via SSH, for domains. You will need to setup SSH for unattended operation.

Use these buttons for some useful presets:
The following variables are available for interpolation (prefixed with new_ or old_ for replace operations):
  • $domain
  • $qdomain - domain with periods replaced by colons
  • $uid - of catchall account
  • $gid - of catchall account
  • $dir - home directory of catchall account
  • All other fields in svc_domain are also available.
', }, @@ -976,7 +976,7 @@ tie my %forward_shellcommands_options, 'Tie::IxHash', 'forward_shellcommands' => { 'desc' => 'Run remote commands via SSH, for forwards', 'options' => \%forward_shellcommands_options, - 'notes' => 'Run remote commands via SSH, for forwards. You will need to setup SSH for unattended operation.

Use these buttons for some useful presets:
  • /home/vpopmail/domains/$domain/$username/.qmail; chown vpopmail:vchkpw /home/vpopmail/domains/$domain/$username/.qmail; }"; this.form.userdel.value = "rm /home/vpopmail/domains/$domain/$username/.qmail"; this.form.usermod.value = "mv /home/vpopmail/domains/$old_domain/$old_username/.qmail /home/vpopmail/domains/$new_domain/$new_username; [ \"$old_destination\" != \"$new_destination\" ] && { echo \"$new_destination\" > /home/vpopmail/domains/$new_domain/$new_username/.qmail; chown vpopmail:vchkpw /home/vpopmail/domains/$new_domain/$new_username/.qmail; }";\'>
', + 'notes' => 'Run remote commands via SSH, for forwards. You will need to setup SSH for unattended operation.

Use these buttons for some useful presets:
  • /home/vpopmail/domains/$domain/$username/.qmail; chown vpopmail:vchkpw /home/vpopmail/domains/$domain/$username/.qmail; }"; this.form.userdel.value = "rm /home/vpopmail/domains/$domain/$username/.qmail"; this.form.usermod.value = "mv /home/vpopmail/domains/$old_domain/$old_username/.qmail /home/vpopmail/domains/$new_domain/$new_username; [ \"$old_destination\" != \"$new_destination\" ] && { echo \"$new_destination\" > /home/vpopmail/domains/$new_domain/$new_username/.qmail; chown vpopmail:vchkpw /home/vpopmail/domains/$new_domain/$new_username/.qmail; }";\'>
The following variables are available for interpolation (prefixed with new_ or old_ for replace operations):
  • $username
  • $domain
  • $destination - forward destination
  • All other fields in svc_forward are also available.
', }, }, @@ -984,7 +984,7 @@ tie my %forward_shellcommands_options, 'Tie::IxHash', 'www_shellcommands' => { 'desc' => 'Run remote commands via SSH, for virtual web sites.', 'options' => \%www_shellcommands_options, - 'notes' => 'Run remote commands via SSH, for virtual web sites. You will need to setup SSH for unattended operation.', + 'notes' => 'Run remote commands via SSH, for virtual web sites. You will need to setup SSH for unattended operation.

The following variables are available for interpolation (prefixed with new_ or old_ for replace operations):
  • $zone
  • $username
  • $homedir
  • All other fields in svc_www are also available.
', }, 'apache' => { diff --git a/FS/FS/part_export/domain_shellcommands.pm b/FS/FS/part_export/domain_shellcommands.pm index 5b100e8c6..0edbab0dd 100644 --- a/FS/FS/part_export/domain_shellcommands.pm +++ b/FS/FS/part_export/domain_shellcommands.pm @@ -58,27 +58,23 @@ sub _export_replace { ${"old_$_"} = $old->getfield($_) foreach $old->fields; ${"new_$_"} = $new->getfield($_) foreach $new->fields; } -# my $old_domain_record = $old->domain_record; # or die ? -# my $old_zone = $old_domain_record->reczone; # or die ? -# unless ( $old_zone =~ /\.$/ ) { -# my $old_svc_domain = $old_domain_record->svc_domain; # or die ? -# $old_zone .= '.'. $old_svc_domain->domain; -# } -# -# my $old_svc_acct = $old->svc_acct; # or die ? -# my $old_username = $old_svc_acct->username; -# my $old_homedir = $old_svc_acct->dir; # or die ? -# -# my $new_domain_record = $new->domain_record; # or die ? -# my $new_zone = $new_domain_record->reczone; # or die ? -# unless ( $new_zone =~ /\.$/ ) { -# my $new_svc_domain = $new_domain_record->svc_domain; # or die ? -# $new_zone .= '.'. $new_svc_domain->domain; -# } - -# my $new_svc_acct = $new->svc_acct; # or die ? -# my $new_username = $new_svc_acct->username; -# my $new_homedir = $new_svc_acct->dir; # or die ? + ( $old_qdomain = $old_domain ) =~ s/\./:/g; #see dot-qmail(5): EXTENSION ADDRESSES + ( $new_qdomain = $new_domain ) =~ s/\./:/g; #see dot-qmail(5): EXTENSION ADDRESSES + + if ( $old->catchall ) { + no strict 'refs'; + my $svc_acct = $old->catchall_svc_acct; + ${"old_$_"} = $svc_acct->getfield($_) foreach qw(uid gid dir); + } else { + ${"old_$_"} = '' foreach qw(uid gid dir); + } + if ( $new->catchall ) { + no strict 'refs'; + my $svc_acct = $new->catchall_svc_acct; + ${"new_$_"} = $svc_acct->getfield($_) foreach qw(uid gid dir); + } else { + ${"new_$_"} = '' foreach qw(uid gid dir); + } #done setting variables for the command -- cgit v1.2.1 From fdf62da26a4a9127fd43f359163f231a89bc692d Mon Sep 17 00:00:00 2001 From: khoff Date: Thu, 24 Apr 2003 18:45:03 +0000 Subject: Support for nWnDnHnMnS time format --- FS/FS/domain_record.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/domain_record.pm b/FS/FS/domain_record.pm index 2f7e270dc..d3682c351 100644 --- a/FS/FS/domain_record.pm +++ b/FS/FS/domain_record.pm @@ -241,7 +241,7 @@ sub check { if ( $self->rectype eq 'SOA' ) { my $recdata = $self->recdata; $recdata =~ s/\s+/ /g; - $recdata =~ /^([a-z0-9\.\-]+ [\w\-\+]+\.[a-z0-9\.\-]+ \( (\d+ ){5}\))$/i + $recdata =~ /^([a-z0-9\.\-]+ [\w\-\+]+\.[a-z0-9\.\-]+ \( ([\dwdhmsWDHMS]+ ){5}\))$/i or return "Illegal data for SOA record: $recdata"; $self->recdata($1); } elsif ( $self->rectype eq 'NS' ) { @@ -332,7 +332,7 @@ sub zone { =head1 VERSION -$Id: domain_record.pm,v 1.13 2003-03-29 04:53:44 ivan Exp $ +$Id: domain_record.pm,v 1.14 2003-04-24 18:45:03 khoff Exp $ =head1 BUGS -- cgit v1.2.1 From cc6317796afe74fd6dcbc4712abfcb09ff199598 Mon Sep 17 00:00:00 2001 From: khoff Date: Thu, 24 Apr 2003 18:46:36 +0000 Subject: MySQL returns zero on an update when no values change. We would insert on an rv of zero, so now we select count(*)... instead of relying on the rv of the update. --- FS/FS/part_export/sqlmail.pm | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export/sqlmail.pm b/FS/FS/part_export/sqlmail.pm index f97674c27..64f72df07 100644 --- a/FS/FS/part_export/sqlmail.pm +++ b/FS/FS/part_export/sqlmail.pm @@ -115,17 +115,19 @@ sub sqlmail_replace { my %attrs = @_; map { $attrs{$_} = $attrs{$_} ? qq!'$attrs{$_}'! : 'NULL'; } keys(%attrs); - my $query = sprintf('UPDATE %s SET %s WHERE svcnum = %s', - $table, join(', ', map {"$_ = $attrs{$_}"} keys(%attrs)), - $oldsvcnum); - - my $rv = $dbh->do($query) or die $dbh->errstr; - - if ($rv == 0) { + my $query = "SELECT COUNT(*) FROM $table WHERE svcnum = $oldsvcnum"; + my $result = $dbh->selectrow_arrayref($query) or die $dbh->errstr; + + if (@$result[0] == 0) { $query = sprintf("INSERT INTO %s (%s) values (%s)", $table, join(",", keys(%attrs)), join(',', values(%attrs))); $dbh->do($query) or die $dbh->errstr; + } else { + $query = sprintf('UPDATE %s SET %s WHERE svcnum = %s', + $table, join(', ', map {"$_ = $attrs{$_}"} keys(%attrs)), + $oldsvcnum); + $dbh->do($query) or die $dbh->errstr; } $dbh->disconnect; -- cgit v1.2.1 From d5aab81fa7c59695bc4bad8820bbd7d9e1d77309 Mon Sep 17 00:00:00 2001 From: khoff Date: Sat, 26 Apr 2003 00:28:47 +0000 Subject: Tyop --- FS/FS/cust_bill.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index aa82eb6f8..76c0752ab 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -812,7 +812,7 @@ sub realtime_bop { 'invnum' => $self->invnum, 'paid' => $amount, '_date' => '', - 'payby' => method2payby{$method}, + 'payby' => $method2payby{$method}, 'payinfo' => $cust_main->payinfo, 'paybatch' => "$processor:". $transaction->authorization, } ); -- cgit v1.2.1 From 6b49613d47236c0fc01ad37021c460d0c8809c9a Mon Sep 17 00:00:00 2001 From: khoff Date: Sat, 26 Apr 2003 02:01:09 +0000 Subject: I don't like FS::Record warnings --- FS/FS/cust_svc.pm | 1 + 1 file changed, 1 insertion(+) (limited to 'FS') diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index 26e6274a1..8ac806519 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -11,6 +11,7 @@ use FS::pkg_svc; use FS::svc_acct; use FS::svc_domain; use FS::svc_forward; +use FS::svc_broadband; use FS::domain_record; use FS::part_export; -- cgit v1.2.1 From e77371fc4d3443c7b97a387bd25897b52200d64a Mon Sep 17 00:00:00 2001 From: khoff Date: Tue, 29 Apr 2003 18:28:50 +0000 Subject: Better SOA checking --- FS/FS/domain_record.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/domain_record.pm b/FS/FS/domain_record.pm index d3682c351..77b955088 100644 --- a/FS/FS/domain_record.pm +++ b/FS/FS/domain_record.pm @@ -241,7 +241,7 @@ sub check { if ( $self->rectype eq 'SOA' ) { my $recdata = $self->recdata; $recdata =~ s/\s+/ /g; - $recdata =~ /^([a-z0-9\.\-]+ [\w\-\+]+\.[a-z0-9\.\-]+ \( ([\dwdhmsWDHMS]+ ){5}\))$/i + $recdata =~ /^([a-z0-9\.\-]+ [\w\-\+]+\.[a-z0-9\.\-]+ \( ((\d+|((\d+[WDHMS])+)) ){5}\))$/i or return "Illegal data for SOA record: $recdata"; $self->recdata($1); } elsif ( $self->rectype eq 'NS' ) { @@ -332,7 +332,7 @@ sub zone { =head1 VERSION -$Id: domain_record.pm,v 1.14 2003-04-24 18:45:03 khoff Exp $ +$Id: domain_record.pm,v 1.15 2003-04-29 18:28:50 khoff Exp $ =head1 BUGS -- cgit v1.2.1 From 5b16f111a4c03075e27bfc1f2299a9ed2c71a605 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 3 May 2003 01:30:35 +0000 Subject: clean up CVS cruft --- FS/FS/part_export.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 8370b3f9e..9a1b9d864 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -307,7 +307,7 @@ sub part_svc { =item svc_x -Returns a list of associate FS::svc_* records. +Returns a list of associated FS::svc_* records. =cut -- cgit v1.2.1 From 61a2cea1f9f09fcb0482af442f45ef620277a8dc Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 3 May 2003 02:06:56 +0000 Subject: enable quota maintenance in infostreet export --- FS/FS/part_export/infostreet.pm | 37 +++++++++++++++++++++++++++++++++++++ 1 file changed, 37 insertions(+) (limited to 'FS') diff --git a/FS/FS/part_export/infostreet.pm b/FS/FS/part_export/infostreet.pm index f2d519932..caca7c5e1 100644 --- a/FS/FS/part_export/infostreet.pm +++ b/FS/FS/part_export/infostreet.pm @@ -55,6 +55,12 @@ sub _export_insert { $err_or_queue = $self->infostreet_queueContact( $svc_acct->svcnum, $svc_acct->username, %contact_info ); return $err_or_queue unless ref($err_or_queue); + + # If a quota has been specified set the quota because it is not the default + $err_or_queue = $self->infostreet_queueSetQuota( $svc_acct->svcnum, + $svc_acct->username, $svc_acct->quota ) if $svc_acct->quota; + return $err_or_queue unless ref($err_or_queue); + my $error = $err_or_queue->depend_insert( $jobnum ); return $error if $error; @@ -68,6 +74,13 @@ sub _export_replace { my( $self, $new, $old ) = (shift, shift, shift); return "can't change username with InfoStreet" if $old->username ne $new->username; + + # If the quota has changed then do the export to setQuota + my $err_or_queue = $self->infostreet_queueSetQuota( $new->svcnum, $new->username, $new->quota ) + if ( $old->quota != $new->quota ); + return $err_or_queue unless ref($err_or_queue); + + return '' unless $old->_password ne $new->_password; $self->infostreet_queue( $new->svcnum, 'passwd', $new->username, $new->_password ); @@ -150,6 +163,30 @@ sub infostreet_setContact { } +sub infostreet_queueSetQuota { + + my( $self, $svcnum) = (shift, shift); + my $queue = new FS::queue { + 'svcnum' => $svcnum, + 'job' => 'FS::part_export::infostreet::infostreet_setQuota', + }; + + $queue->insert( + $self->option('url'), + $self->option('login'), + $self->option('password'), + $self->option('groupID'), + @_, + ) or $queue; + +} + +sub infostreet_setQuota { + my($url, $is_username, $is_password, $groupID, $username, $quota) = @_; + infostreet_command($url, $is_username, $is_password, $groupID, 'setQuota', $username, [ 'int'=> $quota ] ); +} + + sub infostreet_command { #subroutine, not method my($url, $username, $password, $groupID, $method, @args) = @_; -- cgit v1.2.1 From c97973a5145438eedd9fe16841897f5c4febb995 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 8 May 2003 09:34:39 +0000 Subject: general Pg 7.3 fix for setting int columns to '' / NULL --- FS/FS/Record.pm | 22 +++++++++++++++------- 1 file changed, 15 insertions(+), 7 deletions(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index c711f1214..9a724feac 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -1231,15 +1231,23 @@ 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|text)$/i - ) { + my($value, $table, $column) = @_; + my $column_obj = $dbdef->table($table)->column($column); + my $column_type = $column_obj->type; + + if ( $value eq '' && $column_type =~ /^int/ ) { + if ( $column_obj->null ) { + 'NULL'; + } else { + cluck "WARNING: Attempting to set non-null integer $table.$column null; ". + "using 0 instead"; + 0; + } + } elsif ( $value =~ /^\d+(\.\d+)?$/ && + ! $column_type =~ /(char|binary|text)$/i ) { $value; } else { - $dbh->quote($value); + dbh->quote($value); } } -- cgit v1.2.1 From 59b2ab6633c0fe401cfe3b74f5cd4e8883a6fc22 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 10 May 2003 05:40:53 +0000 Subject: - substitute '0' for existing blank setup/recur fees - use timelocal_nocheck instead of timelocal for proper wraparound --- FS/FS/cust_main.pm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index cefc7648f..608c5e3cb 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -4,7 +4,7 @@ use strict; use vars qw( @ISA $conf $Debug $import ); use Safe; use Carp; -use Time::Local; +use Time::Local qw(timelocal_nocheck); use Date::Format; #use Date::Manip; use Business::CreditCard; @@ -994,6 +994,7 @@ sub bill { ": $setup_prog"; }; $setup_prog = $1; + $setup_prog = '0' if $setup_prog =~ /^\s*$/; #my $cpt = new Safe; ##$cpt->permit(); #what is necessary? @@ -1023,6 +1024,7 @@ sub bill { ": $recur_prog"; }; $recur_prog = $1; + $recur_prog = '0' if $recur_prog =~ /^\s*$/; # shared with $recur_prog $sdate = $cust_pkg->bill || $cust_pkg->setup || $time; @@ -1052,7 +1054,7 @@ sub bill { $mon += $part_pkg->freq; until ( $mon < 12 ) { $mon -= 12; $year++; } $cust_pkg->setfield('bill', - timelocal($sec,$min,$hour,$mday,$mon,$year)); + timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year)); $cust_pkg_mod_flag = 1; } -- cgit v1.2.1 From aa8f46a06edce17b919486a62d9e208c1954355a Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 10 May 2003 05:41:20 +0000 Subject: fix bug in last_bill method which prevented last_bill dates from being set --- FS/FS/cust_pkg.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 4eea2c087..bd3d1f503 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -477,8 +477,8 @@ Useful for billing metered services. sub last_bill { my $self = shift; - if ( $self->dbdef_table->column('manual_flag') ) { - return $self->setfield('last_bill', $_[1]) if @_; + if ( $self->dbdef_table->column('last_bill') ) { + return $self->setfield('last_bill', $_[0]) if @_; return $self->getfield('last_bill') if $self->getfield('last_bill'); } my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum, -- cgit v1.2.1 From 9033414f18177eb733d1a227d2be1c15d244f766 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 13 May 2003 03:22:35 +0000 Subject: - self-service updates: cleanup and beginnings of "make a payment" - fix pod masking FS::svc_acct::cust_svc --- FS/FS/svc_acct.pm | 2 ++ 1 file changed, 2 insertions(+) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index e0c4662b2..8f2861bfd 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -922,6 +922,8 @@ sub svc_domain { Returns the FS::cust_svc record for this account (see L). +=cut + sub cust_svc { my $self = shift; qsearchs( 'cust_svc', { 'svcnum' => $self->svcnum } ); -- cgit v1.2.1 From 6e2a0edcc8659e18af767a2d5305b450092b3542 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 13 May 2003 05:47:25 +0000 Subject: missing pod =cut at end --- FS/FS/addr_block.pm | 2 ++ 1 file changed, 2 insertions(+) (limited to 'FS') diff --git a/FS/FS/addr_block.pm b/FS/FS/addr_block.pm index af4e5fb79..c5ddca7d0 100755 --- a/FS/FS/addr_block.pm +++ b/FS/FS/addr_block.pm @@ -324,5 +324,7 @@ To be implemented. Minimum block size should be a config option. It's hardcoded at /30 right now because that's the smallest block that makes any sense at all. +=cut + 1; -- cgit v1.2.1 From d1fe599b5646d693c99908b0288a76744103b5a2 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 13 May 2003 06:01:53 +0000 Subject: - document missing fields in cust_bill_event --- FS/FS/cust_bill_event.pm | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'FS') diff --git a/FS/FS/cust_bill_event.pm b/FS/FS/cust_bill_event.pm index 44e4d4797..c97734780 100644 --- a/FS/FS/cust_bill_event.pm +++ b/FS/FS/cust_bill_event.pm @@ -44,6 +44,10 @@ currently supported: =item _date - specified as a UNIX timestamp; see L. Also see L and L for conversion functions. +=item status - event status: B or B + +=item statustext - additional status detail (i.e. error message) + =back =head1 METHODS -- cgit v1.2.1 From ac15b7153b154f5bb951f0ce62731f8216ff9fc4 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 14 May 2003 16:51:43 +0000 Subject: display recurring custom line items on invoices as well as one-shot ones --- FS/FS/cust_bill.pm | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 76c0752ab..a0634d918 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -983,13 +983,20 @@ sub print_text { push @buf, map { [ " $_", '' ] } $cust_bill_pkg->details; - } else { #pkgnum tax + } else { #pkgnum tax or one-shot line item my $itemdesc = defined $cust_bill_pkg->dbdef_table->column('itemdesc') ? ( $cust_bill_pkg->itemdesc || 'Tax' ) : 'Tax'; - push @buf, [ $itemdesc, - $money_char. sprintf("%10.2f", $cust_bill_pkg->setup) ] - if $cust_bill_pkg->setup != 0; + if ( $cust_bill_pkg->setup != 0 ) { + push @buf, [ $itemdesc, + $money_char. sprintf("%10.2f", $cust_bill_pkg->setup) ]; + } + if ( $cust_bill_pkg->recur != 0 ) { + push @buf, [ "$itemdesc (". time2str("%x", $cust_bill_pkg->sdate). " - " + . time2str("%x", $cust_bill_pkg->edate). ")", + $money_char. sprintf("%10.2f", $cust_bill_pkg->recur) + ]; + } } } -- cgit v1.2.1 From d1d57ae4fa0f2a30b36a70c656aa2672744f75a3 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 18 May 2003 06:20:21 +0000 Subject: self-service: make payment UI done --- FS/FS/ClientAPI/MyAccount.pm | 37 +++++++++++++++++++++++++++++++++++++ 1 file changed, 37 insertions(+) (limited to 'FS') diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm index 9983b5d26..80c7330e8 100644 --- a/FS/FS/ClientAPI/MyAccount.pm +++ b/FS/FS/ClientAPI/MyAccount.pm @@ -19,6 +19,7 @@ FS::ClientAPI->register_handlers( 'MyAccount/customer_info' => \&customer_info, 'MyAccount/invoice' => \&invoice, 'MyAccount/cancel' => \&cancel, + 'MyAccount/payment_info' => \&payment_info, ); #store in db? @@ -112,6 +113,42 @@ sub customer_info { } +sub payment_info { + my $p = shift; + my $session = $cache->get($p->{'session_id'}) + or return { 'error' => "Can't resume session" }; #better error message + + my %return; + + my $custnum = $session->{'custnum'}; + + my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ) + or return { 'error' => "unknown custnum $custnum" }; + + $return{balance} = $cust_main->balance; + + $return{payname} = $cust_main->payname + || $cust_main->first. ' '. $cust_main->get('last'); + + $return{$_} = $cust_main->get($_) for qw(address1 address2 city state zip); + + if ( $cust_main->payby =~ /^(CARD|DCRD)$/ ) { + #$return{card_type} = + $return{payinfo} = $cust_main->payinfo; + #exp date (month, year) + + #CARD vd DCRD remembering + } + + #list all states & counties + + return { 'error' => '', + %return, + }; + +}; + + sub invoice { my $p = shift; my $session = $cache->get($p->{'session_id'}) -- cgit v1.2.1 From 416dc3b6df09133c4130445008919408f04586c3 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 18 May 2003 08:08:12 +0000 Subject: more self-service make payment UI work --- FS/FS/ClientAPI/MyAccount.pm | 36 ++++++++++++++++++++++++++++++------ 1 file changed, 30 insertions(+), 6 deletions(-) (limited to 'FS') diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm index 80c7330e8..c722c9d5f 100644 --- a/FS/FS/ClientAPI/MyAccount.pm +++ b/FS/FS/ClientAPI/MyAccount.pm @@ -4,14 +4,16 @@ use strict; use vars qw($cache); use Digest::MD5 qw(md5_hex); use Date::Format; +use Business::CreditCard; use Cache::SharedMemoryCache; #store in db? use FS::CGI qw(small_custview); #doh use FS::Conf; -use FS::Record qw(qsearchs); +use FS::Record qw(qsearch qsearchs); use FS::svc_acct; use FS::svc_domain; use FS::cust_main; use FS::cust_bill; +use FS::cust_main_county; use FS::ClientAPI; #hmm FS::ClientAPI->register_handlers( @@ -132,15 +134,38 @@ sub payment_info { $return{$_} = $cust_main->get($_) for qw(address1 address2 city state zip); + $return{payby} = $cust_main->payby; + if ( $cust_main->payby =~ /^(CARD|DCRD)$/ ) { - #$return{card_type} = + $return{card_type} = cardtype($cust_main->payinfo); $return{payinfo} = $cust_main->payinfo; - #exp date (month, year) - #CARD vd DCRD remembering + if ( $cust_main->paydate =~ /^(\d{4})-(\d{2})-\d{2}$/ ) { #Pg date format + @return{'month', 'year'} = ( $2, $1 ); + } elsif ( $cust_main->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) { + @return{'month', 'year'} = ( $1, $3 ); + } + } - #list all states & counties + #list all counties/states/countries + $return{'cust_main_county'} = + [ map { $_->hashref } qsearch('cust_main_county', {}) ], + + #shortcut for one-country folks + my $conf = new FS::Conf; + my %states = map { $_->state => 1 } + qsearch('cust_main_county', { + 'country' => $conf->config('defaultcountry') || 'US' + } ); + $return{'states'} = [ sort { $a cmp $b } keys %states ]; + + $return{card_types} = { + 'VISA' => 'VISA card', + 'MasterCard' => 'MasterCard', + 'Discover' => 'Discover card', + 'American Express' => 'American Express card', + }; return { 'error' => '', %return, @@ -148,7 +173,6 @@ sub payment_info { }; - sub invoice { my $p = shift; my $session = $cache->get($p->{'session_id'}) -- cgit v1.2.1 From 667a729f660ad4f871acd5eb3173303396543eeb Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 18 May 2003 11:44:37 +0000 Subject: interface for making payments all done --- FS/FS/ClientAPI/MyAccount.pm | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm index c722c9d5f..c750ada46 100644 --- a/FS/FS/ClientAPI/MyAccount.pm +++ b/FS/FS/ClientAPI/MyAccount.pm @@ -107,7 +107,6 @@ sub customer_info { } - return { 'error' => '', 'custnum' => $custnum, %return, @@ -130,14 +129,14 @@ sub payment_info { $return{balance} = $cust_main->balance; $return{payname} = $cust_main->payname - || $cust_main->first. ' '. $cust_main->get('last'); + || ( $cust_main->first. ' '. $cust_main->get('last') ); $return{$_} = $cust_main->get($_) for qw(address1 address2 city state zip); $return{payby} = $cust_main->payby; if ( $cust_main->payby =~ /^(CARD|DCRD)$/ ) { - $return{card_type} = cardtype($cust_main->payinfo); + warn $return{card_type} = cardtype($cust_main->payinfo); $return{payinfo} = $cust_main->payinfo; if ( $cust_main->paydate =~ /^(\d{4})-(\d{2})-\d{2}$/ ) { #Pg date format @@ -167,6 +166,9 @@ sub payment_info { 'American Express' => 'American Express card', }; + my $_date = time; + $return{paybatch} = 'webui-MyAccount-$_date-$$-". rand() * 2**32 + return { 'error' => '', %return, }; -- cgit v1.2.1 From fd9138f66cf7f3ab9557e0beebb4e2657a59e34c Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 19 May 2003 12:00:45 +0000 Subject: maintenance: - add FS::Misc with send_email subroutine, remove all duplicate code from various modules - move the realtime_bop from cust_bill to cust_main & change usage slightly. invnum is no longer required. FS::cust_bill::realtime_bop remains as a wrapper. self-service: - fix some syntax errors, make payment UI (step one) really should be working now --- FS/FS/ClientAPI/MyAccount.pm | 16 ++- FS/FS/Misc.pm | 95 ++++++++++++++ FS/FS/cust_bill.pm | 298 +++---------------------------------------- FS/FS/cust_main.pm | 216 +++++++++++++++++++++++++++++++ FS/FS/cust_pay.pm | 50 +++----- FS/FS/cust_pkg.pm | 49 ++----- FS/FS/svc_acct.pm | 32 ++--- FS/FS/svc_domain.pm | 6 +- FS/MANIFEST | 2 + FS/t/Misc.t | 5 + 10 files changed, 394 insertions(+), 375 deletions(-) create mode 100644 FS/FS/Misc.pm create mode 100644 FS/t/Misc.t (limited to 'FS') diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm index c750ada46..a64cfb5d7 100644 --- a/FS/FS/ClientAPI/MyAccount.pm +++ b/FS/FS/ClientAPI/MyAccount.pm @@ -167,7 +167,7 @@ sub payment_info { }; my $_date = time; - $return{paybatch} = 'webui-MyAccount-$_date-$$-". rand() * 2**32 + $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32; return { 'error' => '', %return, @@ -175,6 +175,20 @@ sub payment_info { }; +sub make_payment{ + my $p = shift; + + my $session = $cache->get($p->{'session_id'}) + or return { 'error' => "Can't resume session" }; #better error message + + my %return; + + my $custnum = $session->{'custnum'}; + + + +} + sub invoice { my $p = shift; my $session = $cache->get($p->{'session_id'}) diff --git a/FS/FS/Misc.pm b/FS/FS/Misc.pm new file mode 100644 index 000000000..56dc72e36 --- /dev/null +++ b/FS/FS/Misc.pm @@ -0,0 +1,95 @@ +package FS::Misc; + +use strict; +use vars qw ( @ISA @EXPORT_OK ); +use Exporter; + +@ISA = qw( Exporter ); +@EXPORT_OK = qw( send_email ); + +=head1 NAME + +FS::Misc - Miscellaneous subroutines + +=head1 SYNOPSIS + + use FS::Misc qw(send_email); + + send_email(); + +=head1 DESCRIPTION + +Miscellaneous subroutines. This module contains miscellaneous subroutines +called from multiple other modules. These are not OO or necessarily related, +but are collected here to elimiate code duplication. + +=head1 SUBROUTINES + +=over 4 + +=item send_email OPTION => VALUE ... + +Options: + +I - (required) + +I - (required) comma-separated scalar or arrayref of recipients + +I - (required) + +I - (optional) MIME type + +I - (required) arrayref of body text lines + +=cut + +use vars qw( $conf ); +use Date::Format; +use Mail::Header; +use Mail::Internet 1.44; +use FS::UID; + +FS::UID->install_callback( sub { + $conf = new FS::Conf; +} ); + +sub send_email { + my(%options) = shift; + + $ENV{MAILADDRESS} = $options{'from'}; + my $to = ref($options{to}) ? join(', ', @{ $options{to} } ) : $options{to}; + my @header = ( + 'From: '. $options{'from'}, + 'To: '. $to, + 'Sender: '. $options{'from'}, + 'Reply-To: '. $options{'from'}, + 'Date: '. time2str("%a, %d %b %Y %X %z", time), + 'Subject: '. $options{'subject'}, + ); + push @header, 'Content-Type: '. $options{'content-type'} + if exists($options{'content-type'}); + my $header = new Mail::Header ( \@header ); + + my $message = new Mail::Internet ( + 'Header' => $header, + 'Body' => $options{'body'}, + ); + + my $smtpmachine = $conf->config('smtpmachine'); + $!=0; + $message->smtpsend( 'Host' => $smtpmachine ) + or $message->smtpsend( Host => $smtpmachine, Debug => 1 ) + or return "can't send email to $to via server $smtpmachine with SMTP: $!"; +} + +=head1 BUGS + +This package exists. + +=head1 SEE ALSO + +L, L, L, the base documentation. + +=cut + +1; diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index a0634d918..a22f44b24 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -2,18 +2,12 @@ package FS::cust_bill; use strict; use vars qw( @ISA $conf $money_char ); -use vars qw( $lpr $invoice_from $smtpmachine ); -use vars qw( $xaction $E_NoErr ); -use vars qw( $bop_processor $bop_login $bop_password $bop_action @bop_options ); -use vars qw( $ach_processor $ach_login $ach_password $ach_action @ach_options ); use vars qw( $invoice_lines @buf ); #yuck -use vars qw( $quiet ); use Date::Format; -use Mail::Internet 1.44; -use Mail::Header; use Text::Template; use FS::UID qw( datasrc ); use FS::Record qw( qsearch qsearchs ); +use FS::Misc qw( send_email ); use FS::cust_main; use FS::cust_bill_pkg; use FS::cust_credit; @@ -26,46 +20,10 @@ use FS::cust_bill_event; @ISA = qw( FS::Record ); #ask FS::UID to run this stuff for us later -$FS::UID::callback{'FS::cust_bill'} = sub { - +FS::UID->install_callback( sub { $conf = new FS::Conf; - $money_char = $conf->config('money_char') || '$'; - - $lpr = $conf->config('lpr'); - $invoice_from = $conf->config('invoice_from'); - $smtpmachine = $conf->config('smtpmachine'); - - ( $bop_processor,$bop_login, $bop_password, $bop_action ) = ( '', '', '', ''); - @bop_options = (); - ( $ach_processor,$ach_login, $ach_password, $ach_action ) = ( '', '', '', ''); - @ach_options = (); - - if ( $conf->exists('business-onlinepayment') ) { - ( $bop_processor, - $bop_login, - $bop_password, - $bop_action, - @bop_options - ) = $conf->config('business-onlinepayment'); - $bop_action ||= 'normal authorization'; - ( $ach_processor, $ach_login, $ach_password, $ach_action, @ach_options ) = - ( $bop_processor, $bop_login, $bop_password, $bop_action, @bop_options ); - eval "use Business::OnlinePayment"; - } - - if ( $conf->exists('business-onlinepayment-ach') ) { - ( $ach_processor, - $ach_login, - $ach_password, - $ach_action, - @ach_options - ) = $conf->config('business-onlinepayment-ach'); - $ach_action ||= 'normal authorization'; - eval "use Business::OnlinePayment"; - } - -}; +} ); =head1 NAME @@ -373,33 +331,20 @@ sub send { if ( grep { $_ ne 'POST' } @invoicing_list or !@invoicing_list ) { #email #better to notify this person than silence - @invoicing_list = ($invoice_from) unless @invoicing_list; - - #false laziness w/FS::cust_pay::delete & fs_signup_server && ::realtime_card - #$ENV{SMTPHOSTS} = $smtpmachine; - $ENV{MAILADDRESS} = $invoice_from; - my $header = new Mail::Header ( [ - "From: $invoice_from", - "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ), - "Sender: $invoice_from", - "Reply-To: $invoice_from", - "Date: ". time2str("%a, %d %b %Y %X %z", time), - "Subject: Invoice", - ] ); - my $message = new Mail::Internet ( - 'Header' => $header, - 'Body' => [ @print_text ], #( date) + @invoicing_list = ($conf->config('invoice_from')) unless @invoicing_list; + + my $error = send_email( + 'from' => $conf->config('invoice_from'), + 'to' => [ grep { $_ ne 'POST' } @invoicing_list ], + 'subject' => 'Invoice', + 'body' => \@print_text, ); - $!=0; - $message->smtpsend( Host => $smtpmachine ) - or $message->smtpsend( Host => $smtpmachine, Debug => 1 ) - or return "(customer # ". $self->custnum. ") can't send invoice email". - " to ". join(', ', grep { $_ ne 'POST' } @invoicing_list ). - " via server $smtpmachine with SMTP: $!"; + return "can't send invoice: $error" if $error; } if ( grep { $_ eq 'POST' } @invoicing_list ) { #postal + my $lpr = $conf->config('lpr'); open(LPR, "|$lpr") or return "Can't open pipe to $lpr: $!"; print LPR @print_text; @@ -610,15 +555,7 @@ for supported processors. sub realtime_card { my $self = shift; - $self->realtime_bop( - 'CC', - $bop_processor, - $bop_login, - $bop_password, - $bop_action, - \@bop_options, - @_ - ); + $self->realtime_bop( 'CC', @_ ); } =item realtime_ach @@ -632,15 +569,7 @@ for supported processors. sub realtime_ach { my $self = shift; - $self->realtime_bop( - 'ECHECK', - $ach_processor, - $ach_login, - $ach_password, - $ach_action, - \@ach_options, - @_ - ); + $self->realtime_bop( 'ECHECK', @_ ); } =item realtime_lec @@ -654,53 +583,15 @@ for supported processors. sub realtime_lec { my $self = shift; - $self->realtime_bop( - 'LEC', - $bop_processor, - $bop_login, - $bop_password, - $bop_action, - \@bop_options, - @_ - ); + $self->realtime_bop( 'LEC', @_ ); } sub realtime_bop { - my( $self, $method, $processor, $login, $password, $action, $options ) = @_; - - #trim an extraneous blank line - pop @$options if scalar(@$options) % 2 && $options->[-1] =~ /^\s*$/; + my( $self, $method ) = @_; my $cust_main = $self->cust_main; my $amount = $self->owed; - my $address = $cust_main->address1; - $address .= ", ". $cust_main->address2 if $cust_main->address2; - - my($payname, $payfirst, $paylast); - if ( $cust_main->payname && $method ne 'ECHECK' ) { - $payname = $cust_main->payname; - $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/ - or do { - #$dbh->rollback if $oldAutoCommit; - return "Illegal payname $payname"; - }; - ($payfirst, $paylast) = ($1, $2); - } else { - $payfirst = $cust_main->getfield('first'); - $paylast = $cust_main->getfield('last'); - $payname = "$payfirst $paylast"; - } - - my @invoicing_list = grep { $_ ne 'POST' } $cust_main->invoicing_list; - if ( $conf->exists('emailinvoiceauto') - || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) { - push @invoicing_list, $cust_main->all_emails; - } - my $email = $invoicing_list[0]; - - my( $action1, $action2 ) = split(/\s*\,\s*/, $action ); - my $description = 'Internet Services'; if ( $conf->exists('business-onlinepayment-description') ) { my $dtempl = $conf->config('business-onlinepayment-description'); @@ -714,163 +605,12 @@ sub realtime_bop { grep { $_->pkgnum } $self->cust_bill_pkg ); $description = eval qq("$dtempl"); - } - my %content; - if ( $method eq 'CC' ) { - $content{card_number} = $cust_main->payinfo; - $cust_main->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; - $content{expiration} = "$2/$1"; - } elsif ( $method eq 'ECHECK' ) { - my($account_number,$routing_code) = $cust_main->payinfo; - ( $content{account_number}, $content{routing_code} ) = - split('@', $cust_main->payinfo); - $content{bank_name} = $cust_main->payname; - } elsif ( $method eq 'LEC' ) { - $content{phone} = $cust_main->payinfo; - } - - my $transaction = - new Business::OnlinePayment( $processor, @$options ); - $transaction->content( - 'type' => $method, - 'login' => $login, - 'password' => $password, - 'action' => $action1, - 'description' => $description, - 'amount' => $amount, - 'invoice_number' => $self->invnum, - 'customer_id' => $self->custnum, - 'last_name' => $paylast, - 'first_name' => $payfirst, - 'name' => $payname, - 'address' => $address, - 'city' => $cust_main->city, - 'state' => $cust_main->state, - 'zip' => $cust_main->zip, - 'country' => $cust_main->country, - 'referer' => 'http://cleanwhisker.420.am/', - 'email' => $email, - 'phone' => $cust_main->daytime || $cust_main->night, - %content, #after + $cust_main->realtime_bop($method, $amount, + 'description' => $description, + 'invnum' => $self->invnum, ); - $transaction->submit(); - - if ( $transaction->is_success() && $action2 ) { - my $auth = $transaction->authorization; - my $ordernum = $transaction->can('order_number') - ? $transaction->order_number - : ''; - - #warn "********* $auth ***********\n"; - #warn "********* $ordernum ***********\n"; - my $capture = - new Business::OnlinePayment( $processor, @$options ); - - my %capture = ( - %content, - type => $method, - action => $action2, - login => $login, - password => $password, - order_number => $ordernum, - amount => $amount, - authorization => $auth, - description => $description, - ); - - foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code - transaction_sequence_num local_transaction_date - local_transaction_time AVS_result_code )) { - $capture{$field} = $transaction->$field() if $transaction->can($field); - } - - $capture->content( %capture ); - - $capture->submit(); - - unless ( $capture->is_success ) { - my $e = "Authorization sucessful but capture failed, invnum #". - $self->invnum. ': '. $capture->result_code. - ": ". $capture->error_message; - warn $e; - return $e; - } - - } - - if ( $transaction->is_success() ) { - - my %method2payby = ( - 'CC' => 'CARD', - 'ECHECK' => 'CHEK', - 'LEC' => 'LECB', - ); - - my $cust_pay = new FS::cust_pay ( { - 'invnum' => $self->invnum, - 'paid' => $amount, - '_date' => '', - 'payby' => $method2payby{$method}, - 'payinfo' => $cust_main->payinfo, - 'paybatch' => "$processor:". $transaction->authorization, - } ); - my $error = $cust_pay->insert; - if ( $error ) { - # gah, even with transactions. - my $e = 'WARNING: Card/ACH debited but database not updated - '. - 'error applying payment, invnum #' . $self->invnum. - " ($processor): $error"; - warn $e; - return $e; - } else { - return ''; - } - #} elsif ( $options{'report_badcard'} ) { - } else { - - my $perror = "$processor error, invnum #". $self->invnum. ': '. - $transaction->result_code. ": ". $transaction->error_message; - - if ( !$quiet && $conf->exists('emaildecline') - && grep { $_ ne 'POST' } $cust_main->invoicing_list - ) { - my @templ = $conf->config('declinetemplate'); - my $template = new Text::Template ( - TYPE => 'ARRAY', - SOURCE => [ map "$_\n", @templ ], - ) or return "($perror) can't create template: $Text::Template::ERROR"; - $template->compile() - or return "($perror) can't compile template: $Text::Template::ERROR"; - - my $templ_hash = { error => $transaction->error_message }; - - #false laziness w/FS::cust_pay::delete & fs_signup_server && ::send - $ENV{MAILADDRESS} = $invoice_from; - my $header = new Mail::Header ( [ - "From: $invoice_from", - "To: ". join(', ', grep { $_ ne 'POST' } $cust_main->invoicing_list ), - "Sender: $invoice_from", - "Reply-To: $invoice_from", - "Date: ". time2str("%a, %d %b %Y %X %z", time), - "Subject: Your payment could not be processed", - ] ); - my $message = new Mail::Internet ( - 'Header' => $header, - 'Body' => [ $template->fill_in(HASH => $templ_hash) ], - ); - $!=0; - $message->smtpsend( Host => $smtpmachine ) - or $message->smtpsend( Host => $smtpmachine, Debug => 1 ) - or return "($perror) (customer # ". $self->custnum. - ") can't send card decline email to ". - join(', ', grep { $_ ne 'POST' } $cust_main->invoicing_list ). - " via server $smtpmachine with SMTP: $!"; - } - - return $perror; - } } diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 608c5e3cb..b162622a4 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -10,6 +10,7 @@ use Date::Format; use Business::CreditCard; use FS::UID qw( getotaker dbh ); use FS::Record qw( qsearchs qsearch dbdef ); +use FS::Misc qw( send_email ); use FS::cust_pkg; use FS::cust_bill; use FS::cust_bill_pkg; @@ -1408,6 +1409,221 @@ sub collect { } +=item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ] + + +Runs a realtime credit card, ACH (electronic check) or phone bill transaction +via a Business::OnlinePayment realtime gateway. See +L for supported gateways. + +Available methods are: I, I and I + +Available options are: I, I, I + +I is a free-text field passed to the gateway. It defaults to +"Internet services". + +If an I is specified, this payment (if sucessful) is applied to the +specified invoice. If you don't specify an I you might want to +call the B method. + +I can be set true to surpress email decline notices. + +(moved from cust_bill) (probably should get realtime_{card,ach,lec} here too) + +=cut + +sub realtime_bop { + my( $self, $method, $amount, %options ) = @_; + $options{'description'} ||= 'Internet services'; + + #pre-requisites + die "Real-time processing not enabled\n" + unless $conf->exists('business-onlinepayment'); + eval "use Business::OnlinePayment"; + die $@ if $@; + + #load up config + my $bop_config = 'business-onlinepayment'; + $bop_config .= '-ach' + if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach'); + my ( $processor, $login, $password, $action, @bop_options ) = + $conf->config($bop_config); + $action ||= 'normal authorization'; + pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/; + + #massage data + + my $address = $self->address1; + $address .= ", ". $self->address2 if $self->address2; + + my($payname, $payfirst, $paylast); + if ( $self->payname && $method ne 'ECHECK' ) { + $payname = $self->payname; + $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/ + or return "Illegal payname $payname"; + ($payfirst, $paylast) = ($1, $2); + } else { + $payfirst = $self->getfield('first'); + $paylast = $self->getfield('last'); + $payname = "$payfirst $paylast"; + } + + my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list; + if ( $conf->exists('emailinvoiceauto') + || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) { + push @invoicing_list, $self->all_emails; + } + my $email = $invoicing_list[0]; + + my %content; + if ( $method eq 'CC' ) { + $content{card_number} = $self->payinfo; + $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; + $content{expiration} = "$2/$1"; + } elsif ( $method eq 'ECHECK' ) { + my($account_number,$routing_code) = $self->payinfo; + ( $content{account_number}, $content{routing_code} ) = + split('@', $self->payinfo); + $content{bank_name} = $self->payname; + } elsif ( $method eq 'LEC' ) { + $content{phone} = $self->payinfo; + } + + #transaction(s) + + my( $action1, $action2 ) = split(/\s*\,\s*/, $action ); + + my $transaction = + new Business::OnlinePayment( $processor, @bop_options ); + $transaction->content( + 'type' => $method, + 'login' => $login, + 'password' => $password, + 'action' => $action1, + 'description' => $options{'description'}, + 'amount' => $amount, + 'invoice_number' => $options{'invnum'}, + 'customer_id' => $self->custnum, + 'last_name' => $paylast, + 'first_name' => $payfirst, + 'name' => $payname, + 'address' => $address, + 'city' => $self->city, + 'state' => $self->state, + 'zip' => $self->zip, + 'country' => $self->country, + 'referer' => 'http://cleanwhisker.420.am/', + 'email' => $email, + 'phone' => $self->daytime || $self->night, + %content, #after + ); + $transaction->submit(); + + if ( $transaction->is_success() && $action2 ) { + my $auth = $transaction->authorization; + my $ordernum = $transaction->can('order_number') + ? $transaction->order_number + : ''; + + my $capture = + new Business::OnlinePayment( $processor, @bop_options ); + + my %capture = ( + %content, + type => $method, + action => $action2, + login => $login, + password => $password, + order_number => $ordernum, + amount => $amount, + authorization => $auth, + description => $options{'description'}, + ); + + foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code + transaction_sequence_num local_transaction_date + local_transaction_time AVS_result_code )) { + $capture{$field} = $transaction->$field() if $transaction->can($field); + } + + $capture->content( %capture ); + + $capture->submit(); + + unless ( $capture->is_success ) { + my $e = "Authorization sucessful but capture failed, custnum #". + $self->custnum. ': '. $capture->result_code. + ": ". $capture->error_message; + warn $e; + return $e; + } + + } + + #result handling + if ( $transaction->is_success() ) { + + my %method2payby = ( + 'CC' => 'CARD', + 'ECHECK' => 'CHEK', + 'LEC' => 'LECB', + ); + + my $cust_pay = new FS::cust_pay ( { + 'invnum' => $self->invnum, #!!!!!!!! + 'paid' => $amount, + '_date' => '', + 'payby' => $method2payby{$method}, + 'payinfo' => $self->payinfo, + 'paybatch' => "$processor:". $transaction->authorization, + } ); + my $error = $cust_pay->insert; + if ( $error ) { + # gah, even with transactions. + my $e = 'WARNING: Card/ACH debited but database not updated - '. + 'error applying payment, invnum #' . $self->invnum. + " ($processor): $error"; + warn $e; + return $e; + } else { + return ''; + } + + } else { + + my $perror = "$processor error: ". $transaction->error_message; + + if ( !$options{'quiet'} && $conf->exists('emaildecline') + && grep { $_ ne 'POST' } $self->invoicing_list + ) { + my @templ = $conf->config('declinetemplate'); + my $template = new Text::Template ( + TYPE => 'ARRAY', + SOURCE => [ map "$_\n", @templ ], + ) or return "($perror) can't create template: $Text::Template::ERROR"; + $template->compile() + or return "($perror) can't compile template: $Text::Template::ERROR"; + + my $templ_hash = { error => $transaction->error_message }; + + my $error = send_email( + 'from' => $conf->config('invoice_from'), + 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ], + 'subject' => 'Your payment could not be processed', + 'body' => [ $template->fill_in(HASH => $templ_hash) ], + ); + + $perror .= " (also received error sending decline notification: $error)" + if $error; + + } + + return $perror; + } + +} + =item total_owed Returns the total owed for this customer on all invoices diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index 79cf82755..55f2fc4a3 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -1,13 +1,12 @@ package FS::cust_pay; use strict; -use vars qw( @ISA $conf $unsuspendauto $smtpmachine $invoice_from ); +use vars qw( @ISA $conf $unsuspendauto ); use Date::Format; -use Mail::Header; -use Mail::Internet 1.44; use Business::CreditCard; use FS::UID qw( dbh ); use FS::Record qw( dbh qsearch qsearchs dbh ); +use FS::Misc qw(send_email); use FS::cust_bill; use FS::cust_bill_pay; use FS::cust_main; @@ -15,14 +14,10 @@ use FS::cust_main; @ISA = qw( FS::Record ); #ask FS::UID to run this stuff for us later -$FS::UID::callback{'FS::cust_pay'} = sub { - +FS::UID->install_callback( sub { $conf = new FS::Conf; $unsuspendauto = $conf->exists('unsuspendauto'); - $smtpmachine = $conf->config('smtpmachine'); - $invoice_from = $conf->config('invoice_from'); - -}; +} ); =head1 NAME @@ -265,19 +260,12 @@ sub delete { if ( $conf->config('deletepayments') ne '' ) { my $cust_main = qsearchs('cust_main',{ 'custnum' => $self->custnum }); - #false laziness w/FS::cust_bill::send & fs_signup_server - $ENV{MAILADDRESS} = $invoice_from; #??? well as good as any - my $header = new Mail::Header ( [ - "From: $invoice_from", - "To: ". $conf->config('deletepayments'), - "Sender: $invoice_from", - "Reply-To: $invoice_from", - "Date: ". time2str("%a, %d %b %Y %X %z", time), - "Subject: FREESIDE NOTIFICATION: Payment deleted", - ] ); - my $message = new Mail::Internet ( - 'Header' => $header, - 'Body' => [ + + my $error = send_email( + 'from' => $conf->config('invoice_from'), #??? well as good as any + 'to' => $conf->config('deletepayments'), + 'subject' => 'FREESIDE NOTIFICATION: Payment deleted', + 'body' => [ "This is an automatic message from your Freeside installation\n", "informing you that the following payment has been deleted:\n", "\n", @@ -291,16 +279,12 @@ sub delete { 'paybatch: '. $self->paybatch. "\n", ], ); - $!=0; - $message->smtpsend( Host => $smtpmachine ) - or $message->smtpsend( Host => $smtpmachine, Debug => 1 ) - or do { - $dbh->rollback if $oldAutoCommit; - return "(customer # ". $self->custnum. - ") can't send payment deletion email to ". - $conf->config('deletepayments'). - " via server $smtpmachine with SMTP: $!"; - }; + + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "can't send payment deletion notification: $error"; + } + } $dbh->commit or die $dbh->errstr if $oldAutoCommit; @@ -406,7 +390,7 @@ sub unapplied { =head1 VERSION -$Id: cust_pay.pm,v 1.23 2002-11-19 09:51:58 ivan Exp $ +$Id: cust_pay.pm,v 1.24 2003-05-19 12:00:44 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index bd3d1f503..9ab269503 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -5,6 +5,7 @@ use vars qw(@ISA $disable_agentcheck); use vars qw( $quiet ); use FS::UID qw( getotaker dbh ); use FS::Record qw( qsearch qsearchs ); +use FS::Misc qw( send_email ); use FS::cust_svc; use FS::part_pkg; use FS::cust_main; @@ -20,12 +21,8 @@ use FS::svc_domain; use FS::svc_www; use FS::svc_forward; -# need all this for sending cancel emails in sub cancel - +# for sending cancel emails in sub cancel use FS::Conf; -use Date::Format; -use Mail::Internet 1.44; -use Mail::Header; @ISA = qw( FS::Record ); @@ -304,38 +301,16 @@ sub cancel { $dbh->commit or die $dbh->errstr if $oldAutoCommit; my $conf = new FS::Conf; - - if ( !$quiet && $conf->exists('emailcancel') - && grep { $_ ne 'POST' } $self->cust_main->invoicing_list) { - - my @invoicing_list = $self->cust_main->invoicing_list; - - my $invoice_from = $conf->config('invoice_from'); - my @print_text = map "$_\n", $conf->config('cancelmessage'); - my $subject = $conf->config('cancelsubject'); - my $smtpmachine = $conf->config('smtpmachine'); - - if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice - #false laziness w/FS::cust_pay::delete & fs_signup_server && ::realtime_card - #$ENV{SMTPHOSTS} = $smtpmachine; - $ENV{MAILADDRESS} = $invoice_from; - my $header = new Mail::Header ( [ - "From: $invoice_from", - "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ), - "Sender: $invoice_from", - "Reply-To: $invoice_from", - "Date: ". time2str("%a, %d %b %Y %X %z", time), - "Subject: $subject", - ] ); - my $message = new Mail::Internet ( - 'Header' => $header, - 'Body' => [ @print_text ], - ); - $!=0; - $message->smtpsend( Host => $smtpmachine ) - or $message->smtpsend( Host => $smtpmachine, Debug => 1 ); - #should this return an error? - } + my @invoicing_list = grep { $_ ne 'POST' } $self->cust_main->invoicing_list; + if ( !$quiet && $conf->exists('emailcancel') && @invoicing_list ) { + my $conf = new FS::Conf; + my $error = send_email( + 'from' => $conf->config('invoice_from'), + 'to' => \@invoicing_list, + 'subject' => $conf->config('cancelsubject'), + 'body' => [ map "$_\n", $conf->config('cancelmessage') ], + ); + #should this do something on errors? } ''; #no errors diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 8f2861bfd..497e59c94 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -1024,36 +1024,28 @@ sub radius_groups { =item send_email +This is the FS::svc_acct job-queue-able version. It still uses +FS::Misc::send_email under-the-hood. + =cut sub send_email { my %opt = @_; - use Date::Format; - use Mail::Internet 1.44; - use Mail::Header; + eval "use FS::Misc qw(send_email)"; + die $@ if $@; $opt{mimetype} ||= 'text/plain'; $opt{mimetype} .= '; charset="iso-8859-1"' unless $opt{mimetype} =~ /charset/; - $ENV{MAILADDRESS} = $opt{from}; - my $header = new Mail::Header ( [ - "From: $opt{from}", - "To: $opt{to}", - "Sender: $opt{from}", - "Reply-To: $opt{from}", - "Date: ". time2str("%a, %d %b %Y %X %z", time), - "Subject: $opt{subject}", - "Content-Type: $opt{mimetype}", - ] ); - my $message = new Mail::Internet ( - 'Header' => $header, - 'Body' => [ map "$_\n", split("\n", $opt{body}) ], + my $error = send_email( + 'from' => $opt{from}, + 'to' => $opt{to}, + 'subject' => $opt{subject}, + 'content-type' => $opt{mimetype}, + 'body' => [ map "$_\n", split("\n", $opt{body}) ], ); - $!=0; - $message->smtpsend( Host => $smtpmachine ) - or $message->smtpsend( Host => $smtpmachine, Debug => 1 ) - or die "can't send email to $opt{to} via $smtpmachine with SMTP: $!"; + die $error if $error; } =item check_and_rebuild_fuzzyfiles diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm index 81edc337e..2e8866a56 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -1,13 +1,11 @@ package FS::svc_domain; use strict; -use vars qw( @ISA $whois_hack $conf $smtpmachine +use vars qw( @ISA $whois_hack $conf @defaultrecords $soadefaultttl $soaemail $soaexpire $soamachine $soarefresh $soaretry ); use Carp; -use Mail::Internet 1.44; -use Mail::Header; use Date::Format; use Net::Whois 1.0; use FS::Record qw(fields qsearch qsearchs dbh); @@ -26,8 +24,6 @@ use FS::queue; $FS::UID::callback{'FS::domain'} = sub { $conf = new FS::Conf; - $smtpmachine = $conf->config('smtpmachine'); - @defaultrecords = $conf->config('defaultrecords'); $soadefaultttl = $conf->config('soadefaultttl'); $soaemail = $conf->config('soaemail'); diff --git a/FS/MANIFEST b/FS/MANIFEST index 6397cc411..272b5b731 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -36,6 +36,7 @@ FS/ClientAPI/passwd.pm FS/ClientAPI/MyAccount.pm FS/Conf.pm FS/ConfItem.pm +FS/Misc.pm FS/Record.pm FS/SearchCache.pm FS/UI/Base.pm @@ -125,6 +126,7 @@ t/InitHandler.t t/ClientAPI.t t/Conf.t t/ConfItem.t +t/Misc.t t/Record.t t/UID.t t/Msgcat.t diff --git a/FS/t/Misc.t b/FS/t/Misc.t new file mode 100644 index 000000000..cc7751ab6 --- /dev/null +++ b/FS/t/Misc.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::Misc; +$loaded=1; +print "ok 1\n"; -- cgit v1.2.1 From a1295d0682aa81a408abe06fcaa7c14440f6a2e2 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 19 May 2003 13:38:41 +0000 Subject: first crack at payment processing with self-service (step two of the process) --- FS/FS/ClientAPI/MyAccount.pm | 23 +++++++++++++++++++++++ FS/FS/cust_main.pm | 13 +++++++++++-- 2 files changed, 34 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm index a64cfb5d7..2ce55a8e7 100644 --- a/FS/FS/ClientAPI/MyAccount.pm +++ b/FS/FS/ClientAPI/MyAccount.pm @@ -185,7 +185,30 @@ sub make_payment{ my $custnum = $session->{'custnum'}; + my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ) + or return { 'error' => "unknown custnum $custnum" }; + + if ( $p->{'save'} ) { + my $new = new FS::cust_main { $cust_main->hash }; + $new->set( $_ => $p->{$_} ) + foreach qw( payname address1 address2 city state zip payinfo ); + $new->set( 'paydate' => $p->{'month'}. '-'. $p->{'year'} ); + $new->set( 'payby' => $p->{'auto'} ? 'CARD' : 'DCRD' ); + my $error = $new->replace($cust_main); + return { 'error' => $error } if $error; + $cust_main = $new; + } + + my $error = $cust_main->realtime_bop( 'CC', $p->{'amount'}, quiet=>1, + 'paydate' => $p->{'month'}. '-'. $p->{'year'}, + map { $_ => $p->{$_} } + qw( payname address1 address2 city state zip payinfo ) + ); + return { 'error' => $error } if $error; + + $cust_main->apply_payments; + return { 'error' => '' }; } diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index b162622a4..09c56474c 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1411,7 +1411,6 @@ sub collect { =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ] - Runs a realtime credit card, ACH (electronic check) or phone bill transaction via a Business::OnlinePayment realtime gateway. See L for supported gateways. @@ -1420,6 +1419,10 @@ Available methods are: I, I and I Available options are: I, I, I +The additional options I, I, I, I, I, +I, I and I are also available. Any of these options, +if set, will override the value from the customer record. + I is a free-text field passed to the gateway. It defaults to "Internet services". @@ -1443,6 +1446,11 @@ sub realtime_bop { eval "use Business::OnlinePayment"; die $@ if $@; + #overrides + $self->set( $_ => $options{$_} ) + foreach grep { exists($options{$_}) } + qw( payname address1 address2 city state zip payinfo paydate ); + #load up config my $bop_config = 'business-onlinepayment'; $bop_config .= '-ach' @@ -1571,7 +1579,8 @@ sub realtime_bop { ); my $cust_pay = new FS::cust_pay ( { - 'invnum' => $self->invnum, #!!!!!!!! + 'custnum' => $self->custnum, + 'invnum' => $options{'invnum'}, 'paid' => $amount, '_date' => '', 'payby' => $method2payby{$method}, -- cgit v1.2.1 From e2a51e422dbd070a4571f229f8e5c6929950d137 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 19 May 2003 13:54:55 +0000 Subject: fix up some bugs in processing payments via self-service... appears to be working so far --- FS/FS/ClientAPI/MyAccount.pm | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) (limited to 'FS') diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm index 2ce55a8e7..6e9bf23a9 100644 --- a/FS/FS/ClientAPI/MyAccount.pm +++ b/FS/FS/ClientAPI/MyAccount.pm @@ -17,11 +17,12 @@ use FS::cust_main_county; use FS::ClientAPI; #hmm FS::ClientAPI->register_handlers( - 'MyAccount/login' => \&login, - 'MyAccount/customer_info' => \&customer_info, - 'MyAccount/invoice' => \&invoice, - 'MyAccount/cancel' => \&cancel, - 'MyAccount/payment_info' => \&payment_info, + 'MyAccount/login' => \&login, + 'MyAccount/customer_info' => \&customer_info, + 'MyAccount/invoice' => \&invoice, + 'MyAccount/cancel' => \&cancel, + 'MyAccount/payment_info' => \&payment_info, + 'MyAccount/process_payment' => \&process_payment, ); #store in db? @@ -175,7 +176,7 @@ sub payment_info { }; -sub make_payment{ +sub process_payment { my $p = shift; my $session = $cache->get($p->{'session_id'}) -- cgit v1.2.1 From e354694764fb1442b6bc74a63189f094c51f1a89 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 20 May 2003 05:43:47 +0000 Subject: working self-service self-payments! --- FS/FS/ClientAPI/MyAccount.pm | 4 ++-- FS/FS/cust_main.pm | 20 +++++++++++++++----- 2 files changed, 17 insertions(+), 7 deletions(-) (limited to 'FS') diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm index 6e9bf23a9..e12e93b12 100644 --- a/FS/FS/ClientAPI/MyAccount.pm +++ b/FS/FS/ClientAPI/MyAccount.pm @@ -193,7 +193,7 @@ sub process_payment { my $new = new FS::cust_main { $cust_main->hash }; $new->set( $_ => $p->{$_} ) foreach qw( payname address1 address2 city state zip payinfo ); - $new->set( 'paydate' => $p->{'month'}. '-'. $p->{'year'} ); + $new->set( 'paydate' => $p->{'year'}. '-'. $p->{'month'}. '-01' ); $new->set( 'payby' => $p->{'auto'} ? 'CARD' : 'DCRD' ); my $error = $new->replace($cust_main); return { 'error' => $error } if $error; @@ -201,7 +201,7 @@ sub process_payment { } my $error = $cust_main->realtime_bop( 'CC', $p->{'amount'}, quiet=>1, - 'paydate' => $p->{'month'}. '-'. $p->{'year'}, + 'paydate' => $p->{'year'}. '-'. $p->{'month'}. '-01', map { $_ => $p->{$_} } qw( payname address1 address2 city state zip payinfo ) ); diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 09c56474c..7e2ff388e 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -33,7 +33,7 @@ use FS::Msgcat qw(gettext); @ISA = qw( FS::Record ); -$Debug = 0; +$Debug = 1; #$Debug = 1; $import = 0; @@ -761,10 +761,15 @@ sub check { unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/; $self->paydate(''); } else { - $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ - or return "Illegal expiration date: ". $self->paydate; - my $y = length($2) == 4 ? $2 : "20$2"; - $self->paydate("$y-$1-01"); + my( $m, $y ); + if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) { + ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" ); + } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{2})[\/\-]\d+$/ ) { + ( $m, $y ) = ( $3, "20$2" ); + } else { + return "Illegal expiration date: ". $self->paydate; + } + $self->paydate("$y-$m-01"); my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900; return gettext('expired_card') if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) ); @@ -1438,6 +1443,11 @@ I can be set true to surpress email decline notices. sub realtime_bop { my( $self, $method, $amount, %options ) = @_; + if ( $Debug ) { + warn "$self $method $amount\n"; + warn " $_ => $options{$_}\n" foreach keys %options; + } + $options{'description'} ||= 'Internet services'; #pre-requisites -- cgit v1.2.1 From 0ef12cb47ee609b04f54fb52e448c73ed3869ec1 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 30 May 2003 09:22:53 +0000 Subject: sqlradius exports include "op" field --- FS/FS/part_export/sqlradius.pm | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm index ccf9a7687..60450ee63 100644 --- a/FS/FS/part_export/sqlradius.pm +++ b/FS/FS/part_export/sqlradius.pm @@ -187,11 +187,15 @@ sub sqlradius_insert { #subroutine, not method } else { my $i_sth = $dbh->prepare( - "INSERT INTO rad$table ( UserName, Attribute, Value ) ". - "VALUES ( ?, ?, ? )" + "INSERT INTO rad$table ( UserName, Attribute, op, Value ) ". + "VALUES ( ?, ?, ?, ? )" ) or die $dbh->errstr; - $i_sth->execute( $username, $attribute, $attributes{$attribute} ) - or die $i_sth->errstr; + $i_sth->execute( + $username, + $attribute, + ( $attribute =~ /Password/i ? '==' : ':=' ), + $attributes{$attribute}, + ) or die $i_sth->errstr; } -- cgit v1.2.1 From 745aca307ef43c0c9bd5d8ee78464f624acb7b3f Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 2 Jun 2003 12:22:44 +0000 Subject: add last_bill field to manpage --- FS/FS/cust_pkg.pm | 2 ++ 1 file changed, 2 insertions(+) (limited to 'FS') diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 9ab269503..9f20603bd 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -100,6 +100,8 @@ inherits from FS::Record. The following fields are currently supported: =item bill - date (next bill date) +=item last_bill - last bill date + =item susp - date =item expire - date -- cgit v1.2.1 From b5e03a09e99ede045b0e3be87085c628d422e3ea Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 3 Jun 2003 05:49:16 +0000 Subject: router.svcnum nullability fix --- FS/bin/freeside-setup | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/bin/freeside-setup b/FS/bin/freeside-setup index 518a2ad42..a1fab5fa0 100755 --- a/FS/bin/freeside-setup +++ b/FS/bin/freeside-setup @@ -1031,7 +1031,7 @@ sub tables_hash_hack { 'columns' => [ 'routernum', 'serial', '', '', 'routername', 'varchar', '', $char_d, - 'svcnum', 'int', '0', '', + 'svcnum', 'int', 'NULL', '', ], 'primary_key' => 'routernum', 'unique' => [], -- cgit v1.2.1 From a60b96753d5c615914fa766b2b0fe8bd2f86c337 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 3 Jun 2003 06:09:52 +0000 Subject: use serial for primary keys in new tables too --- FS/bin/freeside-setup | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-setup b/FS/bin/freeside-setup index a1fab5fa0..d2a98dd0c 100755 --- a/FS/bin/freeside-setup +++ b/FS/bin/freeside-setup @@ -1031,7 +1031,7 @@ sub tables_hash_hack { 'columns' => [ 'routernum', 'serial', '', '', 'routername', 'varchar', '', $char_d, - 'svcnum', 'int', 'NULL', '', + 'svcnum', 'int', '0', '', ], 'primary_key' => 'routernum', 'unique' => [], @@ -1074,7 +1074,7 @@ sub tables_hash_hack { 'addr_block' => { 'columns' => [ - 'blocknum', 'int', '', '', + 'blocknum', 'serial', '', '', 'routernum', 'int', '', '', 'ip_gateway', 'varchar', '', 15, 'ip_netmask', 'int', '', '', @@ -1086,7 +1086,7 @@ sub tables_hash_hack { 'part_sb_field' => { 'columns' => [ - 'sbfieldpart', 'int', '', '', + 'sbfieldpart', 'serial', '', '', 'svcpart', 'int', '', '', 'name', 'varchar', '', $char_d, 'length', 'int', '', '', -- cgit v1.2.1 From 978b435880e71f6a4765525ea9797b7dc65bd625 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 3 Jun 2003 12:41:50 +0000 Subject: minor update to cp export - eliminate redundant "host" parameter --- FS/FS/part_export.pm | 1 - FS/FS/part_export/cp.pm | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 9a1b9d864..06fab6ad1 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -692,7 +692,6 @@ tie my %cyrus_options, 'Tie::IxHash', ; tie my %cp_options, 'Tie::IxHash', - 'host' => { label=>'Hostname' }, 'port' => { label=>'Port number' }, 'username' => { label=>'Username' }, 'password' => { label=>'Password' }, diff --git a/FS/FS/part_export/cp.pm b/FS/FS/part_export/cp.pm index d998c1d95..c37dc3b98 100644 --- a/FS/FS/part_export/cp.pm +++ b/FS/FS/part_export/cp.pm @@ -42,7 +42,7 @@ sub cp_queue { 'job' => 'FS::part_export::cp::cp_command', }; $queue->insert( - $self->option('host'), + $self->machine, $self->option('port'), $self->option('username'), $self->option('password'), -- cgit v1.2.1 From f6aa1cedd7da9198a9ccf7e1acfb786612993ced Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 4 Jun 2003 16:14:38 +0000 Subject: allow empty slipip's --- FS/FS/svc_acct.pm | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 497e59c94..282ef5aab 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -783,12 +783,14 @@ sub check { $recref->{quota} = $1; unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) { - unless ( $recref->{slipip} eq '0e0' ) { + if ( $recref->{slipip} eq '' ) { + $recref->{slipip} = ''; + } elsif ( $recref->{slipip} eq '0e0' ) { + $recref->{slipip} = '0e0'; + } else { $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'; } } -- cgit v1.2.1 From 9bb4c3a8b4cc5313049ad043d2798e37ee210ae6 Mon Sep 17 00:00:00 2001 From: khoff Date: Thu, 5 Jun 2003 00:22:48 +0000 Subject: order/cancel packages rewritten --- FS/FS/cust_pkg.pm | 231 +++++++++++++++++++++++------------------------------- 1 file changed, 96 insertions(+), 135 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 9f20603bd..a423c5518 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -605,6 +605,61 @@ sub attribute_since_sqlradacct { } +=item transfer DEST_PKGNUM + +Transfers as many services as possible from this package to another package. +The destination package must already exist. Services are moved only if +the destination allows services with the correct I (not svcdb). +Any services that can't be moved remain in the original package. + +Returns an error, if there is one; otherwise, returns the number of services +that couldn't be moved. + +=cut + +sub transfer { + my ($self, $dest_pkgnum) = @_; + + my $remaining = 0; + my $dest; + my %target; + my $pkg_svc; + + if (ref ($dest_pkgnum) eq 'FS::cust_pkg') { + $dest = $dest_pkgnum; + $dest_pkgnum = $dest->pkgnum; + } else { + $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum }); + } + + return ('Package does not exist: '.$dest_pkgnum) unless $dest; + + foreach $pkg_svc (qsearch('pkg_svc', { pkgpart => $dest->pkgpart })) { + $target{$pkg_svc->svcpart} = $pkg_svc->quantity; + } + + my $cust_svc; + + foreach $cust_svc ($dest->cust_svc) { + $target{$cust_svc->svcpart}--; + } + + foreach $cust_svc ($self->cust_svc) { + if($target{$cust_svc->svcpart} > 0) { + $target{$cust_svc->svcpart}--; + my $new = new FS::cust_svc { + svcnum => $cust_svc->svcnum, + svcpart => $cust_svc->svcpart, + pkgnum => $dest_pkgnum }; + my $error = $new->replace($cust_svc); + return $error if $error; + } else { + $remaining++ + } + } + return $remaining; +} + =back =head1 SUBROUTINES @@ -631,156 +686,62 @@ newly-created cust_pkg objects. =cut sub order { - my($custnum, $pkgparts, $remove_pkgnums, $return_cust_pkg) = @_; - $remove_pkgnums = [] unless defined($remove_pkgnums); + # Rewritten to make use of the transfer() method, and in general + # to not suck so badly. + + my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg) = @_; + + # Transactionize this whole mess my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; - # generate %part_pkg - # $part_pkg{$pkgpart} is true iff $custnum may purchase $pkgpart - # - my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum}); - my($agent)=qsearchs('agent',{'agentnum'=> $cust_main->agentnum }); - my %part_pkg = %{ $agent->pkgpart_hashref }; - - my(%svcnum); - # generate %svcnum - # for those packages being removed: - #@{ $svcnum{$svcpart} } goes from a svcpart to a list of FS::cust_svc objects - my($pkgnum); - foreach $pkgnum ( @{$remove_pkgnums} ) { - foreach my $cust_svc (qsearch('cust_svc',{'pkgnum'=>$pkgnum})) { - push @{ $svcnum{$cust_svc->getfield('svcpart')} }, $cust_svc; - } - } - - my @cust_svc; - #generate @cust_svc - # for those packages the customer is purchasing: - # @{$pkgparts} is a list of said packages, by pkgpart - # @cust_svc is a corresponding list of lists of FS::Record objects - foreach my $pkgpart ( @{$pkgparts} ) { - unless ( $part_pkg{$pkgpart} ) { + my $error; + my $cust_main = qsearchs('cust_main', { custnum => $custnum }); + return "Customer not found: $custnum" unless $cust_main; + + # Create the new packages. + my $cust_pkg; + foreach (@$pkgparts) { + $cust_pkg = new FS::cust_pkg { custnum => $custnum, + pkgpart => $_ }; + $error = $cust_pkg->insert; + if ($error) { $dbh->rollback if $oldAutoCommit; - return "Customer not permitted to purchase pkgpart $pkgpart!"; + return $error; } - push @cust_svc, [ - map { - ( $svcnum{$_} && @{ $svcnum{$_} } ) ? shift @{ $svcnum{$_} } : (); - } map { $_->svcpart } - qsearch('pkg_svc', { pkgpart => $pkgpart, - quantity => { op=>'>', value=>'0', } } ) - ]; + push @$return_cust_pkg, $cust_pkg; } - - #special-case until this can be handled better - # move services to new svcparts - even if the svcparts don't match (svcdb - # needs to...) - # looks like they're moved in no particular order, ewwwwwwww - # and looks like just one of each svcpart can be moved... o well - - #start with still-leftover services - #foreach my $svcpart ( grep { scalar(@{ $svcnum{$_} }) } keys %svcnum ) { - foreach my $svcpart ( keys %svcnum ) { - next unless @{ $svcnum{$svcpart} }; - - my $svcdb = $svcnum{$svcpart}->[0]->part_svc->svcdb; - - #find an empty place to put one - my $i = 0; - foreach my $pkgpart ( @{$pkgparts} ) { - my @pkg_svc = - qsearch('pkg_svc', { pkgpart => $pkgpart, - quantity => { op=>'>', value=>'0', } } ); - #my @pkg_svc = - # grep { $_->quantity > 0 } qsearch('pkg_svc', { pkgpart=>$pkgpart } ); - if ( ! @{$cust_svc[$i]} #find an empty place to put them with - && grep { $svcdb eq $_->part_svc->svcdb } #with appropriate svcdb - @pkg_svc - ) { - my $new_svcpart = - ( grep { $svcdb eq $_->part_svc->svcdb } @pkg_svc )[0]->svcpart; - my $cust_svc = shift @{$svcnum{$svcpart}}; - $cust_svc->svcpart($new_svcpart); - #warn "changing from $svcpart to $new_svcpart!!!\n"; - $cust_svc[$i] = [ $cust_svc ]; + # $return_cust_pkg now contains refs to all of the newly + # created packages. + + # Transfer services and cancel old packages. + foreach my $old_pkgnum (@$remove_pkgnum) { + my $old_pkg = qsearchs ('cust_pkg', { pkgnum => $old_pkgnum }); + foreach my $new_pkg (@$return_cust_pkg) { + $error = $old_pkg->transfer($new_pkg); + if ($error and $error == 0) { + # $old_pkg->transfer failed. + $dbh->rollback if $oldAutoCommit; + return $error; } - $i++; } - - } - - #check for leftover services - foreach (keys %svcnum) { - next unless @{ $svcnum{$_} }; - $dbh->rollback if $oldAutoCommit; - return "Leftover services, svcpart $_: svcnum ". - join(', ', map { $_->svcnum } @{ $svcnum{$_} } ); - } - - #no leftover services, let's make changes. - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - #first cancel old packages - foreach my $pkgnum ( @{$remove_pkgnums} ) { - my($old) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); - unless ( $old ) { + if ($error > 0) { + # Transfers were successful, but we went through all of the + # new packages and still had services left on the old package. + # We can't cancel the package under the circumstances, so abort. $dbh->rollback if $oldAutoCommit; - return "Package $pkgnum not found to remove!"; + return "Unable to transfer all services from package ".$old_pkg->pkgnum; } - my(%hash) = $old->hash; - $hash{'cancel'}=time; - my($new) = new FS::cust_pkg ( \%hash ); - my($error)=$new->replace($old); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Couldn't update package $pkgnum: $error"; + $error = $old_pkg->cancel; + if ($error) { + $dbh->rollback; + return $error; } } - - #now add new packages, changing cust_svc records if necessary - my $pkgpart; - while ($pkgpart=shift @{$pkgparts} ) { - - my $new = new FS::cust_pkg { - 'custnum' => $custnum, - 'pkgpart' => $pkgpart, - }; - my $error = $new->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Couldn't insert new cust_pkg record: $error"; - } - push @{$return_cust_pkg}, $new if $return_cust_pkg; - my $pkgnum = $new->pkgnum; - - foreach my $cust_svc ( @{ shift @cust_svc } ) { - my(%hash) = $cust_svc->hash; - $hash{'pkgnum'}=$pkgnum; - my $new = new FS::cust_svc ( \%hash ); - - #avoid Record diffing missing changed svcpart field from above. - my $old = qsearchs('cust_svc', { 'svcnum' => $cust_svc->svcnum } ); - - my $error = $new->replace($old); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Couldn't link old service to new package: $error"; - } - } - } - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; #no errors + ''; } =back -- cgit v1.2.1 From fc970220d488dfbcf2f7a4b1c7ae6b7618af1ecc Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 6 Jun 2003 10:49:59 +0000 Subject: add suspend/unsuspend capability to CP export --- FS/FS/part_export/cp.pm | 34 ++++++++++++++++++++++++++++------ 1 file changed, 28 insertions(+), 6 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export/cp.pm b/FS/FS/part_export/cp.pm index c37dc3b98..ee5f54285 100644 --- a/FS/FS/part_export/cp.pm +++ b/FS/FS/part_export/cp.pm @@ -10,10 +10,10 @@ sub rebless { shift; } sub _export_insert { my( $self, $svc_acct ) = (shift, shift); $self->cp_queue( $svc_acct->svcnum, 'create_mailbox', - Mailbox => $svc_acct->username, - Password => $svc_acct->_password, - Workgroup => $self->option('workgroup'), - Domain => $svc_acct->domain, + 'Mailbox' => $svc_acct->username, + 'Password' => $svc_acct->_password, + 'Workgroup' => $self->option('workgroup'), + 'Domain' => $svc_acct->domain, ); } @@ -30,8 +30,30 @@ sub _export_replace { sub _export_delete { my( $self, $svc_acct ) = (shift, shift); $self->cp_queue( $svc_acct->svcnum, 'delete_mailbox', - Mailbox => $svc_acct->username, - Domain => $svc_acct->domain, + 'Mailbox' => $svc_acct->username, + 'Domain' => $svc_acct->domain, + ); +} + +sub _export_suspend { + my( $self, $svc_acct ) = (shift, shift); + $self->cp_queue( $svc_acct->svcnum, 'set_mailbox_status', + 'Mailbox' => $svc_acct->username, + 'Domain' => $svc_acct->domain, + 'OTHER' => 'T', + 'OTHER_SUSPEND' => 'T', + ); +} + +sub _export_unsuspend { + my( $self, $svc_acct ) = (shift, shift); + $self->cp_queue( $svc_acct->svcnum, 'set_mailbox_status', + 'Mailbox' => $svc_acct->username, + 'Domain' => $svc_acct->domain, + 'PAYMENT' => 'F', + 'OTHER' => 'F', + 'OTHER_SUSPEND' => 'F', + 'OTHER_BOUNCE' => 'F', ); } -- cgit v1.2.1 From d5da3d1db2e73288cb15b8dbd6e3c34d54eb0faa Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 7 Jun 2003 01:42:52 +0000 Subject: require Time::Local 1.04 on perls before 5.6 --- FS/FS/cust_main.pm | 1 + 1 file changed, 1 insertion(+) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 7e2ff388e..923de00c4 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -4,6 +4,7 @@ use strict; use vars qw( @ISA $conf $Debug $import ); use Safe; use Carp; +BEGIN { eval "use Time::Local 1.05;" if $] < 5.006; }; use Time::Local qw(timelocal_nocheck); use Date::Format; #use Date::Manip; -- cgit v1.2.1 From 82b6a3add627d151f749bc26d170e6bb4b80d526 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 7 Jun 2003 01:47:23 +0000 Subject: give a better error message regarding Time::Local on old perls. really. --- FS/FS/cust_main.pm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 923de00c4..0176c7723 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -4,8 +4,10 @@ use strict; use vars qw( @ISA $conf $Debug $import ); use Safe; use Carp; -BEGIN { eval "use Time::Local 1.05;" if $] < 5.006; }; -use Time::Local qw(timelocal_nocheck); +BEGIN { + eval "use Time::Local 1.05;" if $] < 5.006; + eval "use Time::Local qw(timelocal_nocheck);"; +} use Date::Format; #use Date::Manip; use Business::CreditCard; -- cgit v1.2.1 From 9533cf0292866372f32a80e61ea590f20005bf74 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 7 Jun 2003 01:57:33 +0000 Subject: really, really give a better error message when used under 5.005 now. really. --- FS/FS/cust_main.pm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 0176c7723..079583a9a 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -5,7 +5,9 @@ use vars qw( @ISA $conf $Debug $import ); use Safe; use Carp; BEGIN { - eval "use Time::Local 1.05;" if $] < 5.006; + eval "use Time::Local;"; + die "Time::Local version 1.05 with Perl versions before 5.6" + if $] < 5.006 && !defined($Time::Local::VERSION); eval "use Time::Local qw(timelocal_nocheck);"; } use Date::Format; -- cgit v1.2.1 From 6c0c9e76ef87a5600496debb2c0a53332b5ac5f5 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 7 Jun 2003 01:58:45 +0000 Subject: and fix the error message --- FS/FS/cust_main.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 079583a9a..533c630f2 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -6,7 +6,7 @@ use Safe; use Carp; BEGIN { eval "use Time::Local;"; - die "Time::Local version 1.05 with Perl versions before 5.6" + die "Time::Local version 1.05 required with Perl versions before 5.6" if $] < 5.006 && !defined($Time::Local::VERSION); eval "use Time::Local qw(timelocal_nocheck);"; } -- cgit v1.2.1 From 19270ddc47dead26e94d01a78dd4a5e8313ffdac Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 9 Jun 2003 11:11:21 +0000 Subject: add "$ignore_quantity" bypass --- FS/FS/cust_svc.pm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index 8ac806519..c0cb6f4e9 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -1,7 +1,7 @@ package FS::cust_svc; use strict; -use vars qw( @ISA ); +use vars qw( @ISA $ignore_quantity ); use Carp qw( cluck ); use FS::Record qw( qsearch qsearchs dbh ); use FS::cust_pkg; @@ -17,6 +17,8 @@ use FS::part_export; @ISA = qw( FS::Record ); +$ignore_quantity = 0; + sub _cache { my $self = shift; my ( $hashref, $cache ) = @_; @@ -229,7 +231,7 @@ sub check { }); return "Already ". scalar(@cust_svc). " ". $part_svc->svc. " services for pkgnum ". $self->pkgnum - if scalar(@cust_svc) >= $quantity; + if scalar(@cust_svc) >= $quantity && (!$ignore_quantity || !$quantity); } ''; #no error -- cgit v1.2.1 From f012a5c9f502bc480414686b44c41df0b27c8b2f Mon Sep 17 00:00:00 2001 From: khoff Date: Wed, 11 Jun 2003 19:13:43 +0000 Subject: We're passing a list here, not one argument. --- FS/FS/Misc.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/Misc.pm b/FS/FS/Misc.pm index 56dc72e36..1f951595a 100644 --- a/FS/FS/Misc.pm +++ b/FS/FS/Misc.pm @@ -54,7 +54,7 @@ FS::UID->install_callback( sub { } ); sub send_email { - my(%options) = shift; + my(%options) = @_; $ENV{MAILADDRESS} = $options{'from'}; my $to = ref($options{to}) ? join(', ', @{ $options{to} } ) : $options{to}; -- cgit v1.2.1 From 0bdae1eced79650fd64c66cdf2107a8f2d0b9067 Mon Sep 17 00:00:00 2001 From: khoff Date: Wed, 11 Jun 2003 20:27:18 +0000 Subject: In scalar context, smtpsend returns the number of addresses that the message was successfully delivered to. I'm assuming 'Debug' causes Net::SMTP to warn the debug output, not return it. --- FS/FS/Misc.pm | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/Misc.pm b/FS/FS/Misc.pm index 1f951595a..efad2dfd6 100644 --- a/FS/FS/Misc.pm +++ b/FS/FS/Misc.pm @@ -77,9 +77,16 @@ sub send_email { my $smtpmachine = $conf->config('smtpmachine'); $!=0; - $message->smtpsend( 'Host' => $smtpmachine ) - or $message->smtpsend( Host => $smtpmachine, Debug => 1 ) - or return "can't send email to $to via server $smtpmachine with SMTP: $!"; + + my $rv = $message->smtpsend( 'Host' => $smtpmachine ) + or $message->smtpsend( Host => $smtpmachine, Debug => 1 ); + + if ($rv) { #smtpsend returns a list of addresses, not true/false + return ''; + } else { + return "can't send email to $to via server $smtpmachine with SMTP: $!"; + } + } =head1 BUGS -- cgit v1.2.1 From 1e40dbcd2cc56ab3a0c548dab5a75b5ff1360b69 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 12 Jun 2003 12:43:27 +0000 Subject: sqlradius doc update; don't need to allow null OP columns --- FS/FS/part_export.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 06fab6ad1..4e3326442 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -890,7 +890,7 @@ tie my %forward_shellcommands_options, 'Tie::IxHash', 'desc' => 'Real-time export to SQL-backed RADIUS (ICRADIUS, FreeRADIUS)', 'options' => \%sqlradius_options, 'nodomain' => 'Y', - 'notes' => 'Real-time export of radcheck, radreply and usergroup tables to any SQL database for FreeRADIUS or ICRADIUS. An existing RADIUS database will be updated in realtime, but you can use freeside-sqlradius-reset to delete the entire RADIUS database and repopulate the tables from the Freeside database. See the DBI documentation and the documentation for your DBD for the exact syntax of a DBI data source. If using FreeRADIUS 0.5 or above, make sure your op fields are set to allow NULL values.', + 'notes' => 'Real-time export of radcheck, radreply and usergroup tables to any SQL database for FreeRADIUS or ICRADIUS. An existing RADIUS database will be updated in realtime, but you can use freeside-sqlradius-reset to delete the entire RADIUS database and repopulate the tables from the Freeside database. See the DBI documentation and the documentation for your DBD for the exact syntax of a DBI data source.', }, 'sqlmail' => { -- cgit v1.2.1 From faea8c040128dcace598fb224cf9f7e9a2e256c9 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 12 Jun 2003 12:57:44 +0000 Subject: _default_ default now sets GECOS like the OS-defaults --- FS/FS/part_export.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 4e3326442..9330a925d 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -548,7 +548,7 @@ tie my %shellcommands_options, 'Tie::IxHash', #'machine' => { label=>'Remote machine' }, 'user' => { label=>'Remote username', default=>'root' }, 'useradd' => { label=>'Insert command', - default=>'useradd -d $dir -m -s $shell -u $uid -p $crypt_password $username' + default=>'useradd -c $finger -d $dir -m -s $shell -u $uid -p $crypt_password $username' #default=>'cp -pr /etc/skel $dir; chown -R $uid.$gid $dir' }, 'useradd_stdin' => { label=>'Insert command STDIN', @@ -564,7 +564,7 @@ tie my %shellcommands_options, 'Tie::IxHash', default=>'', }, 'usermod' => { label=>'Modify command', - default=>'usermod -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -p $new_crypt_password $old_username', + default=>'usermod -c $new_finger -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -p $new_crypt_password $old_username', #default=>'[ -d $old_dir ] && mv $old_dir $new_dir || ( '. # 'chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; '. # 'find . -depth -print | cpio -pdm $new_dir; '. -- cgit v1.2.1 From 2c2f1122f76c0aec0861bf3d9c7fb9dff109c346 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 13 Jun 2003 08:11:24 +0000 Subject: add vpopmail presets to shellcommands_withdomain export --- FS/FS/part_export.pm | 10 ++++++++-- FS/FS/part_export/shellcommands.pm | 11 +++++++++++ 2 files changed, 19 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 9330a925d..300e88821 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -576,6 +576,9 @@ tie my %shellcommands_options, 'Tie::IxHash', type =>'textarea', default=>'', }, + 'usermod_pwonly' => { label=>'Disallow username changes', + type =>'checkbox', + }, 'suspend' => { label=>'Suspension command', default=>'', }, @@ -613,6 +616,9 @@ tie my %shellcommands_withdomain_options, 'Tie::IxHash', type =>'textarea', #default=>"$_password\n$_password\n", }, + 'usermod_pwonly' => { label=>'Disallow username changes', + type =>'checkbox', + }, 'suspend' => { label=>'Suspension command', default=>'', }, @@ -875,9 +881,9 @@ tie my %forward_shellcommands_options, 'Tie::IxHash', }, 'shellcommands_withdomain' => { - 'desc' => 'Real-time export via remote SSH.', + 'desc' => 'Real-time export via remote SSH (vpopmail, etc.).', 'options' => \%shellcommands_withdomain_options, - 'notes' => 'Run remote commands via SSH. username@domain (rather than just usernames) are considered unique (also see shellcommands). You probably want this if the commands you are running will accept a domain as a parameter, and will allow the same username with different domains. You will need to setup SSH for unattended operation.

The following variables are available for interpolation (prefixed with new_ or old_ for replace operations):
  • $username
  • $domain
  • $_password
  • $quoted_password - unencrypted password quoted for the shell
  • $crypt_password - encrypted password
  • $uid
  • $gid
  • $finger - GECOS, already quoted for the shell (do not add additional quotes)
  • $dir - home directory
  • $shell
  • $quota
  • All other fields in svc_acct are also available.
', + 'notes' => 'Run remote commands via SSH. username@domain (rather than just usernames) are considered unique (also see shellcommands). You probably want this if the commands you are running will accept a domain as a parameter, and will allow the same username with different domains. You will need to setup SSH for unattended operation.

Use these buttons for some useful presets:
The following variables are available for interpolation (prefixed with new_ or old_ for replace operations):
  • $username
  • $domain
  • $_password
  • $quoted_password - unencrypted password quoted for the shell
  • $crypt_password - encrypted password
  • $uid
  • $gid
  • $finger - GECOS, already quoted for the shell (do not add additional quotes)
  • $dir - home directory
  • $shell
  • $quota
  • All other fields in svc_acct are also available.
', }, 'ldap' => { diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm index f592a838a..b1f9b0d68 100644 --- a/FS/FS/part_export/shellcommands.pm +++ b/FS/FS/part_export/shellcommands.pm @@ -81,6 +81,17 @@ sub _export_replace { $new_crypt_password = ''; #surpress "used only once" warnings $new_crypt_password = crypt( $new->_password, $saltset[int(rand(64))].$saltset[int(rand(64))]); + if ( $self->option('usermod_pwonly') ) { + my $error = ''; + if ( $old_username ne $new_username ) { + $error ||= "can't change username"; + } + if ( $old_domain ne $new_domain ) { + $error ||= "can't change domain"; + } + return $error. ' ('. $self->exporttype. ' to '. $self->machine. ')' + if $error; + } $self->shellcommands_queue( $new->svcnum, user => $self->option('user')||'root', host => $self->machine, -- cgit v1.2.1 From d8d7c720d27047d4cde950e741f80fc2e77eb7a6 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 13 Jun 2003 08:23:21 +0000 Subject: full path to vpopmail commands --- FS/FS/part_export.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 300e88821..ad77ec8c2 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -883,7 +883,7 @@ tie my %forward_shellcommands_options, 'Tie::IxHash', 'shellcommands_withdomain' => { 'desc' => 'Real-time export via remote SSH (vpopmail, etc.).', 'options' => \%shellcommands_withdomain_options, - 'notes' => 'Run remote commands via SSH. username@domain (rather than just usernames) are considered unique (also see shellcommands). You probably want this if the commands you are running will accept a domain as a parameter, and will allow the same username with different domains. You will need to setup SSH for unattended operation.

Use these buttons for some useful presets:
The following variables are available for interpolation (prefixed with new_ or old_ for replace operations):
  • $username
  • $domain
  • $_password
  • $quoted_password - unencrypted password quoted for the shell
  • $crypt_password - encrypted password
  • $uid
  • $gid
  • $finger - GECOS, already quoted for the shell (do not add additional quotes)
  • $dir - home directory
  • $shell
  • $quota
  • All other fields in svc_acct are also available.
', + 'notes' => 'Run remote commands via SSH. username@domain (rather than just usernames) are considered unique (also see shellcommands). You probably want this if the commands you are running will accept a domain as a parameter, and will allow the same username with different domains. You will need to setup SSH for unattended operation.

Use these buttons for some useful presets:
The following variables are available for interpolation (prefixed with new_ or old_ for replace operations):
  • $username
  • $domain
  • $_password
  • $quoted_password - unencrypted password quoted for the shell
  • $crypt_password - encrypted password
  • $uid
  • $gid
  • $finger - GECOS, already quoted for the shell (do not add additional quotes)
  • $dir - home directory
  • $shell
  • $quota
  • All other fields in svc_acct are also available.
', }, 'ldap' => { -- cgit v1.2.1 From 4a02b0fa8b35533d8d938941cbb5ca89903132c0 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 13 Jun 2003 08:38:58 +0000 Subject: pass vpopmail passwords on command-line (unfortunately) --- FS/FS/part_export.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index ad77ec8c2..5cdce1608 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -883,7 +883,7 @@ tie my %forward_shellcommands_options, 'Tie::IxHash', 'shellcommands_withdomain' => { 'desc' => 'Real-time export via remote SSH (vpopmail, etc.).', 'options' => \%shellcommands_withdomain_options, - 'notes' => 'Run remote commands via SSH. username@domain (rather than just usernames) are considered unique (also see shellcommands). You probably want this if the commands you are running will accept a domain as a parameter, and will allow the same username with different domains. You will need to setup SSH for unattended operation.

Use these buttons for some useful presets:
The following variables are available for interpolation (prefixed with new_ or old_ for replace operations):
  • $username
  • $domain
  • $_password
  • $quoted_password - unencrypted password quoted for the shell
  • $crypt_password - encrypted password
  • $uid
  • $gid
  • $finger - GECOS, already quoted for the shell (do not add additional quotes)
  • $dir - home directory
  • $shell
  • $quota
  • All other fields in svc_acct are also available.
', + 'notes' => 'Run remote commands via SSH. username@domain (rather than just usernames) are considered unique (also see shellcommands). You probably want this if the commands you are running will accept a domain as a parameter, and will allow the same username with different domains. You will need to setup SSH for unattended operation.

Use these buttons for some useful presets:
The following variables are available for interpolation (prefixed with new_ or old_ for replace operations):
  • $username
  • $domain
  • $_password
  • $quoted_password - unencrypted password quoted for the shell
  • $crypt_password - encrypted password
  • $uid
  • $gid
  • $finger - GECOS, already quoted for the shell (do not add additional quotes)
  • $dir - home directory
  • $shell
  • $quota
  • All other fields in svc_acct are also available.
', }, 'ldap' => { -- cgit v1.2.1 From 927ed7458ff7536ec321e8d214ed8adfbd12193f Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 13 Jun 2003 09:12:29 +0000 Subject: proper command escape for vpopmail export --- FS/FS/part_export.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 5cdce1608..f1a0b1a2e 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -883,7 +883,7 @@ tie my %forward_shellcommands_options, 'Tie::IxHash', 'shellcommands_withdomain' => { 'desc' => 'Real-time export via remote SSH (vpopmail, etc.).', 'options' => \%shellcommands_withdomain_options, - 'notes' => 'Run remote commands via SSH. username@domain (rather than just usernames) are considered unique (also see shellcommands). You probably want this if the commands you are running will accept a domain as a parameter, and will allow the same username with different domains. You will need to setup SSH for unattended operation.

Use these buttons for some useful presets:
The following variables are available for interpolation (prefixed with new_ or old_ for replace operations):
  • $username
  • $domain
  • $_password
  • $quoted_password - unencrypted password quoted for the shell
  • $crypt_password - encrypted password
  • $uid
  • $gid
  • $finger - GECOS, already quoted for the shell (do not add additional quotes)
  • $dir - home directory
  • $shell
  • $quota
  • All other fields in svc_acct are also available.
', + 'notes' => 'Run remote commands via SSH. username@domain (rather than just usernames) are considered unique (also see shellcommands). You probably want this if the commands you are running will accept a domain as a parameter, and will allow the same username with different domains. You will need to setup SSH for unattended operation.

Use these buttons for some useful presets:
The following variables are available for interpolation (prefixed with new_ or old_ for replace operations):
  • $username
  • $domain
  • $_password
  • $quoted_password - unencrypted password quoted for the shell
  • $crypt_password - encrypted password
  • $uid
  • $gid
  • $finger - GECOS, already quoted for the shell (do not add additional quotes)
  • $dir - home directory
  • $shell
  • $quota
  • All other fields in svc_acct are also available.
', }, 'ldap' => { -- cgit v1.2.1 From 92b6d3bef27fdcfb22cb67f2c62173cfda246684 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 13 Jun 2003 15:19:02 +0000 Subject: $new_quoted_password vs. $quoted_new__password --- FS/FS/part_export/shellcommands.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm index b1f9b0d68..edc944009 100644 --- a/FS/FS/part_export/shellcommands.pm +++ b/FS/FS/part_export/shellcommands.pm @@ -75,7 +75,8 @@ sub _export_replace { ${"new_$_"} = $new->getfield($_) foreach $new->fields; } $new_finger = shell_quote $new_finger; - $quoted_new__password = shell_quote $new__password; + $quoted_new__password = shell_quote $new__password; #old, wrong? + $new_quoted_password = shell_quote $new__password; #new, better? $old_domain = $old->domain; $new_domain = $new->domain; $new_crypt_password = ''; #surpress "used only once" warnings -- cgit v1.2.1 From 9e6413e476a3516a08710efa5ff4d5949c1aa88c Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 14 Jun 2003 02:02:55 +0000 Subject: add index on cust_bill._date --- FS/bin/freeside-setup | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/bin/freeside-setup b/FS/bin/freeside-setup index d2a98dd0c..734744efe 100755 --- a/FS/bin/freeside-setup +++ b/FS/bin/freeside-setup @@ -373,7 +373,7 @@ sub tables_hash_hack { ], 'primary_key' => 'invnum', 'unique' => [], - 'index' => [ ['custnum'] ], + 'index' => [ ['custnum'], ['_date'] ], }, 'cust_bill_event' => { -- cgit v1.2.1 From 3464d4c767130711e724fbd96e391e03fa3a1796 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 22 Jun 2003 14:21:57 +0000 Subject: fix the credit card retry on change or manual "retry_card" to ONCE per invoice --- FS/FS/cust_main.pm | 166 ++++++++++++++++++++++++++++++++++------------------- 1 file changed, 106 insertions(+), 60 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 533c630f2..b45540095 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -306,24 +306,12 @@ sub insert { } } - #false laziness with sub replace - my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; - $error = $queue->insert($self->getfield('last'), $self->company); + $error = $self->queue_fuzzyfiles_update; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; + return "updating fuzzy search cache: $error"; } - if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) { - $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; - $error = $queue->insert($self->getfield('last'), $self->company); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - } - #eslaf - $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -525,34 +513,47 @@ sub replace { if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ && grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) { - # card/check info has changed, want to retry realtime_card invoice events - #false laziness w/collect - foreach my $cust_bill_event ( - grep { - #$_->part_bill_event->plan eq 'realtime-card' - $_->part_bill_event->eventcode =~ - /^\$cust_bill\->realtime_(card|ach|lec)\(\);$/ - && $_->status eq 'done' - && $_->statustext - } - map { $_->cust_bill_event } - grep { $_->cust_bill_event } - $self->open_cust_bill - - ) { - my $error = $cust_bill_event->retry; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error scheduling invoice events for retry: $error"; - } + # card/check/lec info has changed, want to retry realtime_ invoice events + my $error = $self->retry_realtime; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; } - #eslaf + } + $error = $self->queue_fuzzyfiles_update; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "updating fuzzy search cache: $error"; } - #false laziness with sub insert + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + +=item queue_fuzzyfiles_update + +Used by insert & replace to update the fuzzy search cache + +=cut + +sub queue_fuzzyfiles_update { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; - $error = $queue->insert($self->getfield('last'), $self->company); + my $error = $queue->insert($self->getfield('last'), $self->company); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "queueing job (transaction rolled back): $error"; @@ -560,13 +561,12 @@ sub replace { if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) { $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; - $error = $queue->insert($self->getfield('last'), $self->company); + $error = $queue->insert($self->getfield('ship_last'), $self->ship_company); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "queueing job (transaction rolled back): $error"; } } - #eslaf $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -1276,7 +1276,10 @@ 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. -retry_card - Retry cards even when not scheduled by invoice events. +retry - Retry card/echeck/LEC transactions even when not scheduled by invoice +events. + +retry_card - Deprecated alias for 'retry' batch_card - This option is deprecated. See the invoice events web interface to control whether cards are batched or run against a realtime gateway. @@ -1310,26 +1313,16 @@ sub collect { return ''; } - if ( exists($options{'retry_card'}) && $options{'retry_card'} ) { - #false laziness w/replace - foreach my $cust_bill_event ( - grep { - #$_->part_bill_event->plan eq 'realtime-card' - $_->part_bill_event->eventcode eq '$cust_bill->realtime_card();' - && $_->status eq 'done' - && $_->statustext - } - map { $_->cust_bill_event } - grep { $_->cust_bill_event } - $self->open_cust_bill - ) { - my $error = $cust_bill_event->retry; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error scheduling invoice events for retry: $error"; - } + if ( exists($options{'retry_card'}) ) { + carp 'retry_card option passed to collect is deprecated; use retry'; + $options{'retry'} ||= $options{'retry_card'}; + } + if ( exists($options{'retry'}) && $options{'retry'} ) { + my $error = $self->retry_realtime; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; } - #eslaf } foreach my $cust_bill ( $self->cust_bill ) { @@ -1419,6 +1412,60 @@ sub collect { } +=item retry_realtime + +Schedules realtime credit card / electronic check / LEC billing events for +for retry. Useful if card information has changed or manual retry is desired. +The 'collect' method must be called to actually retry the transaction. + +Implementation details: For each of this customer's open invoices, changes +the status of the first "done" (with statustext error) realtime processing +event to "failed". + +=cut + +sub retry_realtime { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + foreach my $cust_bill ( + grep { $_->cust_bill_event } + $self->open_cust_bill + ) { + my @cust_bill_event = + sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds } + grep { + #$_->part_bill_event->plan eq 'realtime-card' + $_->part_bill_event->eventcode =~ + /\$cust_bill\->realtime_(card|ach|lec)$/ + && $_->status eq 'done' + && $_->statustext + } + $_->cust_bill_event; + next unless @cust_bill_event; + my $error = $cust_bill_event[0]->retry; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error scheduling invoice event for retry: $error"; + } + + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ] Runs a realtime credit card, ACH (electronic check) or phone bill transaction @@ -2506,4 +2553,3 @@ L, L, schema.html from the base documentation. 1; - -- cgit v1.2.1 From 4383c98b73d549da1773934614ea791802753323 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 24 Jun 2003 14:12:31 +0000 Subject: explicitly use the necessary modules --- FS/FS/part_export/forward_shellcommands.pm | 2 ++ FS/FS/part_export/sqlmail.pm | 3 ++- 2 files changed, 4 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export/forward_shellcommands.pm b/FS/FS/part_export/forward_shellcommands.pm index 43d558a69..a53628a19 100644 --- a/FS/FS/part_export/forward_shellcommands.pm +++ b/FS/FS/part_export/forward_shellcommands.pm @@ -2,7 +2,9 @@ package FS::part_export::forward_shellcommands; use strict; use vars qw(@ISA); +use FS::Record qw(qsearchs); use FS::part_export; +use FS::svc_acct; @ISA = qw(FS::part_export); diff --git a/FS/FS/part_export/sqlmail.pm b/FS/FS/part_export/sqlmail.pm index 64f72df07..8ccad3c7e 100644 --- a/FS/FS/part_export/sqlmail.pm +++ b/FS/FS/part_export/sqlmail.pm @@ -1,9 +1,10 @@ package FS::part_export::sqlmail; use vars qw(@ISA); +use Digest::MD5 qw(md5_hex); use FS::Record qw(qsearchs); use FS::part_export; -use Digest::MD5 qw(md5_hex); +use FS::svc_domain; @ISA = qw(FS::part_export); -- cgit v1.2.1 From c550b6ea1846f933dd130fc690777ad89f55012d Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 25 Jun 2003 00:57:16 +0000 Subject: forward_shellcommands update: might work now --- FS/FS/part_export/forward_shellcommands.pm | 26 ++++++++++++-------------- 1 file changed, 12 insertions(+), 14 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export/forward_shellcommands.pm b/FS/FS/part_export/forward_shellcommands.pm index a53628a19..f6fcb6062 100644 --- a/FS/FS/part_export/forward_shellcommands.pm +++ b/FS/FS/part_export/forward_shellcommands.pm @@ -2,9 +2,7 @@ package FS::part_export::forward_shellcommands; use strict; use vars qw(@ISA); -use FS::Record qw(qsearchs); use FS::part_export; -use FS::svc_acct; @ISA = qw(FS::part_export); @@ -31,13 +29,13 @@ sub _export_command { ${$_} = $svc_forward->getfield($_) foreach $svc_forward->fields; } - my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $self->srcsvc } ); + my $svc_acct = $svc_forward->srcsvc_acct; $username = $svc_acct->username; $domain = $svc_acct->domain; - if ($self->dstsvc) { - $destination = $self->dstsvc_acct->email; + if ($svc_forward->dstsvc_acct) { + $destination = $svc_forward->dstsvc_acct->email; } else { - $destination = $self->dst; + $destination = $svc_forward->dst; } #done setting variables for the command @@ -61,22 +59,22 @@ sub _export_replace { ${"new_$_"} = $new->getfield($_) foreach $new->fields; } - my $old_svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $self->srcsvc } ); + my $old_svc_acct = $old->srcsvc_acct; $old_username = $old_svc_acct->username; $old_domain = $old_svc_acct->domain; - if ($self->dstsvc) { - $old_destination = $self->dstsvc_acct->email; + if ($old->dstsvc_acct) { + $old_destination = $old->dstsvc_acct->email; } else { - $old_destination = $self->dst; + $old_destination = $old->dst; } - my $new_svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $self->srcsvc } ); + my $new_svc_acct = $new->srcsvc_acct; $new_username = $new_svc_acct->username; $new_domain = $new_svc_acct->domain; - if ($self->dstsvc) { - $new_destination = $self->dstsvc_acct->email; + if ($new->dstsvc) { + $new_destination = $new->dstsvc_acct->email; } else { - $new_destination = $self->dst; + $new_destination = $new->dst; } #done setting variables for the command -- cgit v1.2.1 From 6ea99c2561e6c87310194097e88ddf1cf089c868 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 25 Jun 2003 08:40:20 +0000 Subject: svc_acct doc update cp export - disable old-style suspending --- FS/FS/part_export/cp.pm | 20 +++++++++++--------- FS/FS/svc_acct.pm | 4 ++++ 2 files changed, 15 insertions(+), 9 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export/cp.pm b/FS/FS/part_export/cp.pm index ee5f54285..c4750dd5d 100644 --- a/FS/FS/part_export/cp.pm +++ b/FS/FS/part_export/cp.pm @@ -91,20 +91,22 @@ sub cp_command { #subroutine, not method ); } - my $other = 'F'; + #my $other = 'F'; if ( $new_password =~ /^\*SUSPENDED\* (.*)$/ ) { $new_password = $1; - $other = 'T'; + # $other = 'T'; } - cp_command($host, $port, $username, $password, 'set_mailbox_status', - Domain => $domain, - Mailbox => $new_username, - Other => $other, - Other_Bounce => $other, - ); + #cp_command($host, $port, $username, $password, $login_domain, + # 'set_mailbox_status', + # Domain => $domain, + # Mailbox => $new_username, + # Other => $other, + # Other_Bounce => $other, + #); if ( $old_password ne $new_password ) { - cp_command($host, $port, $username, $password, 'change_mailbox', + cp_command($host, $port, $username, $password, $login_domain, + 'change_mailbox', Domain => $domain, Mailbox => $new_username, Password => $new_password, diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 282ef5aab..1fed9520f 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -603,6 +603,8 @@ error, returns the error, otherwise returns false. Called by the suspend method of FS::cust_pkg (see L). +Calls any export-specific suspend hooks. + =cut sub suspend { @@ -627,6 +629,8 @@ an error, returns the error, otherwise returns false. Called by the unsuspend method of FS::cust_pkg (see L). +Calls any export-specific unsuspend hooks. + =cut sub unsuspend { -- cgit v1.2.1 From 5aed678a590be255eccc42b944975c4a846b1807 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 27 Jun 2003 14:19:59 +0000 Subject: add radius-ip configuration parameter for Framed-IP-Address vs. Framed-Address --- FS/FS/Conf.pm | 8 ++++++++ FS/FS/svc_acct.pm | 5 +++-- 2 files changed, 11 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 84b3c26ed..706ebe720 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -1031,6 +1031,14 @@ httemplate/docs/config.html 'select_enum' => [ 'Password', 'User-Password' ], }, + { + 'key' => 'radius-ip', + 'section' => '', + 'description' => 'RADIUS attribute for IP addresses.', + 'type' => 'select', + 'select_enum' => [ 'Framed-IP-Address', 'Framed-Address' ], + }, + { 'key' => 'svc_acct-alldomains', 'section' => '', diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 1fed9520f..5b8107fc8 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -9,7 +9,7 @@ use vars qw( @ISA $DEBUG $me $conf $username_uppercase $welcome_template $welcome_from $welcome_subject $welcome_mimetype $smtpmachine - $radius_password + $radius_password $radius_ip $dirhash @saltset @pw_set ); use Carp; @@ -68,6 +68,7 @@ $FS::UID::callback{'FS::svc_acct'} = sub { } $smtpmachine = $conf->config('smtpmachine'); $radius_password = $conf->config('radius-password') || 'Password'; + $radius_ip = $conf->config('radius-ip') || 'Framed-IP-Address'; }; @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); @@ -866,7 +867,7 @@ sub radius_reply { ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) ); } grep { /^radius_/ && $self->getfield($_) } fields( $self->table ); if ( $self->slipip && $self->slipip ne '0e0' ) { - $reply{'Framed-IP-Address'} = $self->slipip; + $reply{$radius_ip} = $self->slipip; } %reply; } -- cgit v1.2.1 From 44c2f829e36a7751e0c97a4dd33dff8e3f192a30 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 30 Jun 2003 07:44:46 +0000 Subject: increase maximum domain length to 67 --- FS/FS/svc_domain.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm index 2e8866a56..32b94563d 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -324,7 +324,7 @@ sub check { } #if ( $recref->{domain} =~ /^([\w\-\.]{1,22})\.(com|net|org|edu)$/ ) { - if ( $recref->{domain} =~ /^([\w\-]{1,22})\.(com|net|org|edu)$/ ) { + if ( $recref->{domain} =~ /^([\w\-]{1,63})\.(com|net|org|edu)$/ ) { $recref->{domain} = "$1.$2"; # hmmmmmmmm. } elsif ( $whois_hack && $recref->{domain} =~ /^([\w\-\.]+)$/ ) { -- cgit v1.2.1 From 70997699eb64ce36ca408214cfe4dbc502d7ca58 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 30 Jun 2003 12:22:24 +0000 Subject: adding sqlradius_withdomain export including realms, closes: bug#514 --- FS/FS/part_export.pm | 15 ++++++++++++++- FS/FS/part_export/sqlradius.pm | 23 ++++++++++++++--------- FS/FS/part_export/sqlradius_withdomain.pm | 12 ++++++++++++ FS/bin/freeside-sqlradius-reset | 4 +++- FS/t/part_export-sqlradius_withdomain.t | 5 +++++ 5 files changed, 48 insertions(+), 11 deletions(-) create mode 100644 FS/FS/part_export/sqlradius_withdomain.pm create mode 100644 FS/t/part_export-sqlradius_withdomain.t (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index f1a0b1a2e..0941da1fb 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -691,6 +691,12 @@ tie my %sqlradius_options, 'Tie::IxHash', 'password' => { label=>'Database password' }, ; +tie my %sqlradius_withdomain_options, 'Tie::IxHash', + 'datasrc' => { label=>'DBI data source ' }, + 'username' => { label=>'Database username' }, + 'password' => { label=>'Database password' }, +; + tie my %cyrus_options, 'Tie::IxHash', 'server' => { label=>'IMAP server' }, 'username' => { label=>'Admin username' }, @@ -896,7 +902,14 @@ tie my %forward_shellcommands_options, 'Tie::IxHash', 'desc' => 'Real-time export to SQL-backed RADIUS (ICRADIUS, FreeRADIUS)', 'options' => \%sqlradius_options, 'nodomain' => 'Y', - 'notes' => 'Real-time export of radcheck, radreply and usergroup tables to any SQL database for FreeRADIUS or ICRADIUS. An existing RADIUS database will be updated in realtime, but you can use freeside-sqlradius-reset to delete the entire RADIUS database and repopulate the tables from the Freeside database. See the DBI documentation and the documentation for your DBD for the exact syntax of a DBI data source.', + 'notes' => 'Real-time export of radcheck, radreply and usergroup tables to any SQL database for FreeRADIUS or ICRADIUS. This export does not export RADIUS realms (see also sqlradius_withdomain). AAn existing RADIUS database will be updated in realtime, but you can use freeside-sqlradius-reset to delete the entire RADIUS database and repopulate the tables from the Freeside database. See the DBI documentation and the documentation for your DBD for the exact syntax of a DBI data source.', + }, + + 'sqlradius_withdomain' => { + 'desc' => 'Real-time export to SQL-backed RADIUS (ICRADIUS, FreeRADIUS) with realms', + 'options' => \%sqlradius_withdomain_options, + 'nodomain' => '', + 'notes' => 'Real-time export of radcheck, radreply and usergroup tables to any SQL database for FreeRADIUS or ICRADIUS. This export exports domains to RADIUS realms (see also sqlradius). An existing RADIUS database will be updated in realtime, but you can use freeside-sqlradius-reset to delete the entire RADIUS database and repopulate the tables from the Freeside database. See the DBI documentation and the documentation for your DBD for the exact syntax of a DBI data source.', }, 'sqlmail' => { diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm index 60450ee63..8a8f9beba 100644 --- a/FS/FS/part_export/sqlradius.pm +++ b/FS/FS/part_export/sqlradius.pm @@ -8,6 +8,11 @@ use FS::part_export; sub rebless { shift; } +sub export_username { + my($self, $svc_acct) = (shift, shift); + $svc_acct->username; +} + sub _export_insert { my($self, $svc_acct) = (shift, shift); @@ -16,14 +21,14 @@ sub _export_insert { my %attrib = $svc_acct->$method(); next unless keys %attrib; my $err_or_queue = $self->sqlradius_queue( $svc_acct->svcnum, 'insert', - $table, $svc_acct->username, %attrib ); + $table, $self->export_username($svc_acct), %attrib ); return $err_or_queue unless ref($err_or_queue); } my @groups = $svc_acct->radius_groups; if ( @groups ) { my $err_or_queue = $self->sqlradius_queue( $svc_acct->svcnum, 'usergroup_insert', - $svc_acct->username, @groups ); + $self->export_username($svc_acct), @groups ); return $err_or_queue unless ref($err_or_queue); } ''; @@ -44,9 +49,9 @@ sub _export_replace { my $dbh = dbh; my $jobnum = ''; - if ( $old->username ne $new->username ) { + if ( $self->export_username($old) ne $self->export_username($new) ) { my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'rename', - $new->username, $old->username ); + $self->export_username($new), $self->export_username($old) ); unless ( ref($err_or_queue) ) { $dbh->rollback if $oldAutoCommit; return $err_or_queue; @@ -63,7 +68,7 @@ sub _export_replace { } keys %new ) { my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert', - $table, $new->username, %new ); + $table, $self->export_username($new), %new ); unless ( ref($err_or_queue) ) { $dbh->rollback if $oldAutoCommit; return $err_or_queue; @@ -80,7 +85,7 @@ sub _export_replace { my @del = grep { !exists $new{$_} } keys %old; if ( @del ) { my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'attrib_delete', - $table, $new->username, @del ); + $table, $self->export_username($new), @del ); unless ( ref($err_or_queue) ) { $dbh->rollback if $oldAutoCommit; return $err_or_queue; @@ -109,7 +114,7 @@ sub _export_replace { if ( @delgroups ) { my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'usergroup_delete', - $new->username, @delgroups ); + $self->export_username($new), @delgroups ); unless ( ref($err_or_queue) ) { $dbh->rollback if $oldAutoCommit; return $err_or_queue; @@ -125,7 +130,7 @@ sub _export_replace { if ( @newgroups ) { my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'usergroup_insert', - $new->username, @newgroups ); + $self->export_username($new), @newgroups ); unless ( ref($err_or_queue) ) { $dbh->rollback if $oldAutoCommit; return $err_or_queue; @@ -147,7 +152,7 @@ sub _export_replace { sub _export_delete { my( $self, $svc_acct ) = (shift, shift); my $err_or_queue = $self->sqlradius_queue( $svc_acct->svcnum, 'delete', - $svc_acct->username ); + $self->export_username($svc_acct) ); ref($err_or_queue) ? '' : $err_or_queue; } diff --git a/FS/FS/part_export/sqlradius_withdomain.pm b/FS/FS/part_export/sqlradius_withdomain.pm new file mode 100644 index 000000000..1c8f38c9d --- /dev/null +++ b/FS/FS/part_export/sqlradius_withdomain.pm @@ -0,0 +1,12 @@ +package FS::part_export::sqlradius_withdomain; + +use vars qw(@ISA); +use FS::part_export::sqlradius; + +@ISA = qw(FS::part_export::sqlradius); + +sub export_username { + my($self, $svc_acct) = (shift, shift); + $svc_acct->email; +} + diff --git a/FS/bin/freeside-sqlradius-reset b/FS/bin/freeside-sqlradius-reset index 9d3a6a700..74f90a582 100755 --- a/FS/bin/freeside-sqlradius-reset +++ b/FS/bin/freeside-sqlradius-reset @@ -12,7 +12,9 @@ adminsuidsetup $user; #my $machine = shift or die &usage; -my @exports = qsearch('part_export', { 'exporttype' => 'sqlradius' } ); +my @exports = qsearch('part_export', { exporttype=>'sqlradius' } ); +push @exports, qsearch('part_export', { exporttype=>'sqlradius_withdomain' } ); + foreach my $export ( @exports ) { my $icradius_dbh = DBI->connect( diff --git a/FS/t/part_export-sqlradius_withdomain.t b/FS/t/part_export-sqlradius_withdomain.t new file mode 100644 index 000000000..504bf679f --- /dev/null +++ b/FS/t/part_export-sqlradius_withdomain.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::sqlradius_withdomain; +$loaded=1; +print "ok 1\n"; -- cgit v1.2.1 From 68d5b555f4f51ade6d3a2627e9c3e3b22a21a5a3 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 30 Jun 2003 13:18:39 +0000 Subject: removing deprecated freeside-overdue --- FS/MANIFEST | 30 ++++---- FS/bin/freeside-overdue | 196 ------------------------------------------------ 2 files changed, 16 insertions(+), 210 deletions(-) delete mode 100755 FS/bin/freeside-overdue (limited to 'FS') diff --git a/FS/MANIFEST b/FS/MANIFEST index 272b5b731..846f37310 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -3,31 +3,31 @@ MANIFEST MANIFEST.SKIP Makefile.PL README -bin/freeside-bill -bin/freeside-daily -bin/freeside-email -bin/freeside-queued bin/freeside-addoutsource bin/freeside-addoutsourceuser +bin/freeside-adduser +bin/freeside-apply-credits +bin/freeside-bill +bin/freeside-cc-receipts-report +bin/freeside-count-active-customers +bin/freeside-credit-report +bin/freeside-daily bin/freeside-deloutsource bin/freeside-deloutsourceuser -bin/freeside-apply-credits -bin/freeside-adduser bin/freeside-deluser -bin/freeside-setup -bin/freeside-setinvoice -bin/freeside-overdue +bin/freeside-email +bin/freeside-expiration-alerter +bin/freeside-queued bin/freeside-radgroup bin/freeside-receivables-report +bin/freeside-reexport bin/freeside-selfservice-server +bin/freeside-setinvoice +bin/freeside-setup bin/freeside-sqlradius-radacctd bin/freeside-sqlradius-reset bin/freeside-sqlradius-seconds bin/freeside-tax-report -bin/freeside-cc-receipts-report -bin/freeside-credit-report -bin/freeside-expiration-alerter -bin/freeside-reexport FS.pm FS/CGI.pm FS/InitHandler.pm @@ -130,6 +130,7 @@ t/Misc.t t/Record.t t/UID.t t/Msgcat.t +t/SearchCache.t t/cust_bill.t t/cust_bill_event.t t/cust_bill_pay.t @@ -146,6 +147,7 @@ t/cust_pay_batch.t t/cust_pkg.t t/cust_refund.t t/cust_svc.t +t/cust_tax_exempt.t t/domain_record.t t/nas.t t/part_bill_event.t @@ -190,6 +192,6 @@ t/svc_www.t t/type_pkgs.t t/queue.t t/queue_arg.t +t/queue_depend.t t/msgcat.t t/raddb.t -t/cust_tax_exempt.t diff --git a/FS/bin/freeside-overdue b/FS/bin/freeside-overdue deleted file mode 100755 index 116245f9c..000000000 --- a/FS/bin/freeside-overdue +++ /dev/null @@ -1,196 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use vars qw( $days_to_pay $cust_main $cust_pkg - $cust_svc $svc_acct ); -use Getopt::Std; -use FS::cust_main; -use FS::cust_pkg; -use FS::cust_svc; -use FS::svc_acct; -use FS::Record qw(qsearch qsearchs); -use FS::UID qw(adminsuidsetup); - -&untaint_argv; -my %opt; -getopts('ed:qpl:scbyoi', \%opt); -my $user = shift or die &usage; - -adminsuidsetup $user; - -my $now = time; #eventually take a time option like freeside-bill -my ($sec,$min,$hour,$mday,$mon,$year) = - (localtime($now) )[0,1,2,3,4,5]; -$mon++; -$year += 1900; - -foreach $cust_main ( qsearch('cust_main',{} ) ) { - - my ( $eyear, $emon, $eday ) = ( 2037, 12, 31 ); - if ( $cust_main->paydate =~ /^(\d{4})\-(\d{1,2})\-(\d{1,2})$/ - && $cust_main->payby eq 'BILL') { - ( $eyear, $emon, $eday ) = ( $1, $2, $3 ); - } - - if ( ( $opt{d} - && $cust_main->balance_date(time - $opt{d} * 86400) > 0 - && qsearchs( 'cust_pkg', { 'custnum' => $cust_main->custnum, - 'susp' => "" } ) ) - || ( $opt{e} - && $cust_main->payby eq 'BILL' - && ( $eyear < $year - || ( $eyear == $year && $emon < $mon ) ) ) - ) { - - unless ( $opt{q} ) { - print $cust_main->custnum, "\t", - $cust_main->last, "\t", $cust_main->first, "\t", - $cust_main->balance_date(time-$opt{d} * 86400); - } - - if ( $opt{p} && ! grep { $_ eq 'POST' } $cust_main->invoicing_list ) { - print "\n\tAdding postal invoicing" unless $opt{q}; - my @invoicing_list = $cust_main->invoicing_list; - push @invoicing_list, 'POST'; - $cust_main->invoicing_list(\@invoicing_list); - } - - if ( $opt{l} ) { - print "\n\tCharging late fee of \$$opt{l}" unless $opt{q}; - my $error = $cust_main->charge($opt{l}, 'Late fee'); - # comment or plandata with info so we don't redo the same late fee every - # day - } - - foreach $cust_pkg ( qsearch( 'cust_pkg', - { 'custnum' => $cust_main->custnum } ) ) { - - if ($opt{s}) { - print "\n\tSuspending pkgnum " . $cust_pkg->pkgnum unless $opt{q}; - $cust_pkg->suspend; - } - - if ($opt{c}) { - print "\n\tCancelling pkgnum " . $cust_pkg->pkgnum unless $opt{q}; - $cust_pkg->cancel; - } - - } - - if ( $opt{b} ) { - print "\n\tBilling" unless $opt{q}; - my $error = $cust_main->bill('time'=>$now); - warn "Error billing, customer #" . $cust_main->custnum . - ":" . $error if $error; - } - - if ( $opt{y} ) { - print "\n\tApplying outstanding payments and credits" unless $opt{q}; - $cust_main->apply_payments; - $cust_main->apply_credits; - } - - if ( $opt{o} ) { - print "\n\tCollecting" unless $opt{q}; - my $error = $cust_main->collect( - 'invoice_time' => $now, - 'batch_card' => $opt{i} ? 'no' : 'yes', - 'force_print' => 'yes', - ); - warn "Error collecting from customer #" . $cust_main->custnum. ":$error" - if $error; - } - - print "\n" unless $opt{q}; - - } - -} - -sub untaint_argv { - foreach $_ ( $[ .. $#ARGV ) { - $ARGV[$_] =~ /^([\w\-\/\.]*)$/ || die "Illegal arguement \"$ARGV[$_]\""; - $ARGV[$_]=$1; - } -} - -sub usage { - die "Usage:\n\n freeside-overdue [ -e ] [ -d days ] [ -q ] [ -p ] [ -l amount ] [ -s ] [ -c ] [ -b ] [ -y ] [ -o [ -i ] ] user\n"; -} - - -=head1 NAME - -freeside-overdue - Perform actions on overdue and/or expired accounts. - -=head1 SYNOPSIS - - freeside-overdue [ -e ] [ -d days ] [ -q ] [ -p ] [ -l amount ] [ -s ] [ -c ] [ -b ] [ -y ] [ -o [ -i ] ] user - -=head1 DESCRIPTION - -This script is deprecated in 1.4.0. You should use freeside-daily and invoice -events instead. - -Performs actions on overdue and/or expired accounts. - -Selection options (at least one selection option is required): - - -d: Customers with a balance due on invoices older than the supplied number - of days. Requires an integer argument. - - -e: Customers with a billing expiration date in the past. - -Action options: - - -q: Be quiet (by default, selected accounts are printed). - - -p: Add postal invoicing to the relevant customers. - - -l: Add a charge of the given amount to the relevant customers. - - -s: Suspend accounts. - - -c: Cancel accounts. - - -b: Bill customers (create invoices) - - -y: Apply unapplied payments and credits - - -o: Collect from customers (charge cards, print invoices) - - -i: real-time billing (as opposed to batch billing). only relevant - for credit cards. - - user: From the mapsecrets file - see config.html from the base documentation - -=head1 CRONTAB - -Example crontab entries: - -# suspend expired accounts -20 4 * * * freeside-overdue -e -s user - -# quietly add postal invoicing to customers over 30 days past due -20 4 * * * freeside-overdue -d 30 -p -q user - -# suspend accounts and charge a $10.23 fee for customers over 60 days past due -20 4 * * * freeside-overdue -d 60 -s -l 10.23 user - -# cancel accounts over 90 days past due -20 4 * * * freeside-overdue -d 90 -c user - -=head1 ORIGINAL AUTHORS - -Original disable-overdue version by mw/kwh: Mark W.? and Kristian Hoffmann ? - -Ivan seems to be turning it into the "do-everything" CLI. - -=head1 BUGS - -Hell now that this is the do-everything CLI it should have --longoptions - -=cut - -1; - -- cgit v1.2.1 From f78217427dce10b328e4140c6e6c796aa212c599 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 30 Jun 2003 18:56:05 +0000 Subject: pass additional fields to ACH processors (Authorize.Net should work now) --- FS/FS/cust_main.pm | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index b45540095..ea6f032f4 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1556,6 +1556,10 @@ sub realtime_bop { ( $content{account_number}, $content{routing_code} ) = split('@', $self->payinfo); $content{bank_name} = $self->payname; + $content{account_type} = 'CHECKING'; + $content{account_name} = $payname; + $content{customer_org} = $self->company ? 'B' : 'I'; + $content{customer_ssn} = $self->ss; } elsif ( $method eq 'LEC' ) { $content{phone} = $self->payinfo; } -- cgit v1.2.1 From 40c5ef8814185ba19b68edc8aab96afc75b95e06 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 30 Jun 2003 19:16:50 +0000 Subject: bugfix for manual re-charging changes (Bug#423) --- FS/FS/cust_main.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index ea6f032f4..165e6962b 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1451,7 +1451,7 @@ sub retry_realtime { && $_->status eq 'done' && $_->statustext } - $_->cust_bill_event; + $cust_bill->cust_bill_event; next unless @cust_bill_event; my $error = $cust_bill_event[0]->retry; if ( $error ) { -- cgit v1.2.1 From e0bbe0e15d90b4fe8abf45b0cb3e4eee3c9810e2 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 1 Jul 2003 00:27:41 +0000 Subject: typo --- FS/FS/part_export.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 0941da1fb..ff519969d 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -902,7 +902,7 @@ tie my %forward_shellcommands_options, 'Tie::IxHash', 'desc' => 'Real-time export to SQL-backed RADIUS (ICRADIUS, FreeRADIUS)', 'options' => \%sqlradius_options, 'nodomain' => 'Y', - 'notes' => 'Real-time export of radcheck, radreply and usergroup tables to any SQL database for FreeRADIUS or ICRADIUS. This export does not export RADIUS realms (see also sqlradius_withdomain). AAn existing RADIUS database will be updated in realtime, but you can use freeside-sqlradius-reset to delete the entire RADIUS database and repopulate the tables from the Freeside database. See the DBI documentation and the documentation for your DBD for the exact syntax of a DBI data source.', + 'notes' => 'Real-time export of radcheck, radreply and usergroup tables to any SQL database for FreeRADIUS or ICRADIUS. This export does not export RADIUS realms (see also sqlradius_withdomain). An existing RADIUS database will be updated in realtime, but you can use freeside-sqlradius-reset to delete the entire RADIUS database and repopulate the tables from the Freeside database. See the DBI documentation and the documentation for your DBD for the exact syntax of a DBI data source.', }, 'sqlradius_withdomain' => { -- cgit v1.2.1 From 035d0767d78b76853a8804a67325de10165df220 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 2 Jul 2003 12:56:04 +0000 Subject: relaxed "first package" restrictions; will find any appropriate service with quantity 1 --- FS/FS/part_pkg.pm | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index 60b0e01f9..6571c529b 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -267,12 +267,14 @@ SVCDB is specified and does not match the svcdb of the service definition, sub svcpart { my $self = shift; - my $svcdb = shift; - my @pkg_svc = $self->pkg_svc; - return '' if scalar(@pkg_svc) != 1 - || $pkg_svc[0]->quantity != 1 - || ( $svcdb && $pkg_svc[0]->part_svc->svcdb ne $svcdb ); + my $svcdb = scalar(@_) ? shift : ''; + my @pkg_svc = grep { + $_->quantity == 1 + && ( $svcdb eq $_->part_svc->svcdb || !$svcdb ) + } $self->pkg_svc; + return '' if scalar(@pkg_svc) != 1; $pkg_svc[0]->svcpart; + } =item payby -- cgit v1.2.1 From 1116af6d9150abdf8e0438f45c78b357ab8820a6 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 2 Jul 2003 12:58:55 +0000 Subject: tyop --- FS/FS/part_pkg.pm | 1 - 1 file changed, 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index 6571c529b..6525864c4 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -274,7 +274,6 @@ sub svcpart { } $self->pkg_svc; return '' if scalar(@pkg_svc) != 1; $pkg_svc[0]->svcpart; - } =item payby -- cgit v1.2.1 From af213c494294f73750b6b5b07ca828782ff3a9e4 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 4 Jul 2003 00:51:29 +0000 Subject: optimize javascript to handle large numbers of POPs --- FS/FS/svc_acct_pop.pm | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct_pop.pm b/FS/FS/svc_acct_pop.pm index 3c9ea0130..404816b47 100644 --- a/FS/FS/svc_acct_pop.pm +++ b/FS/FS/svc_acct_pop.pm @@ -142,8 +142,7 @@ sub popselector { function popstate_changed(what) { state = what.options[what.selectedIndex].text; - for (var i = what.form.popnum.length;i > 0;i--) - what.form.popnum.options[i] = null; + what.form.popnum.options.length = 0 what.form.popnum.options[0] = new Option("", "", false, true); END @@ -182,7 +181,7 @@ END =head1 VERSION -$Id: svc_acct_pop.pm,v 1.7 2002-04-10 13:42:48 ivan Exp $ +$Id: svc_acct_pop.pm,v 1.8 2003-07-04 00:51:29 ivan Exp $ =head1 BUGS -- cgit v1.2.1 From f2098c54512150c098f28f59ffe4a62464ef630e Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 4 Jul 2003 01:37:46 +0000 Subject: don't populate the whole initial list if there are tons of POPs --- FS/FS/svc_acct_pop.pm | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/svc_acct_pop.pm b/FS/FS/svc_acct_pop.pm index 404816b47..196ab7ebb 100644 --- a/FS/FS/svc_acct_pop.pm +++ b/FS/FS/svc_acct_pop.pm @@ -166,7 +166,13 @@ END $text .= ''; #callback? return 3 html pieces? #''; $text .= qq!! . "\n"; + foreach ($self->list) { + $text .= q!