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