diff options
Diffstat (limited to 'FS')
382 files changed, 0 insertions, 54627 deletions
diff --git a/FS/Changes b/FS/Changes deleted file mode 100644 index c94ef10..0000000 --- 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 d8999ca..0000000 --- a/FS/FS.pm +++ /dev/null @@ -1,269 +0,0 @@ -package FS; - -use strict; -use vars qw($VERSION); - -$VERSION = '%%%VERSION%%%'; - -#find missing entries in this file with: -# for a in `ls *pm | cut -d. -f1`; do grep 'L<FS::'$a'>' ../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<FS::Conf> - Freeside configuration values - -L<FS::ConfItem> - Freeside configuration option meta-data. - -L<FS::UID> - User class (not yet OO) - -L<FS::CGI> - Non OO-subroutines for the web interface. - -L<FS::Msgcat> - Message catalog - -L<FS::SearchCache> - Search cache - -L<FS::raddb> - RADIUS dictionary - -=head2 Database record classes - -L<FS::Record> - Database record base class - -L<FS::svc_acct_pop> - POP (Point of Presence, not Post -Office Protocol) class - -L<FS::part_pop_local> - Local calling area class - -L<FS::part_referral> - Referral class - -L<FS::cust_main_county> - Locale (tax rate) class - -L<FS::cust_tax_exempt> - Tax exemption record class - -L<FS::svc_Common> - Service base class - -L<FS::svc_acct> - Account (shell, RADIUS, POP3) class - -L<FS::acct_snarf> - External mail account class - -L<FS::radius_usergroup> - RADIUS groups - -L<FS::svc_domain> - Domain class - -L<FS::domain_record> - DNS zone entries - -L<FS::svc_forward> - Mail forwarding class - -L<FS::svc_www> - Web virtual host class. - -L<FS::svc_broadband> - DSL, wireless and other broadband class. - -L<FS::svc_external> - Externally tracked service class. - -L<FS::part_svc> - Service definition class - -L<FS::part_svc_column> - Column constraint class - -L<FS::export_svc> - Class linking service definitions (see L<FS::part_svc>) -with exports (see L<FS::part_export>) - -L<FS::part_export> - External provisioning export class - -L<FS::part_export_option> - Export option class - -L<FS::part_pkg> - Package definition class - -L<FS::part_pkg_option> - Package definition option class - -L<FS::pkg_svc> - Class linking package definitions (see L<FS::part_pkg>) with -service definitions (see L<FS::part_svc>) - -L<FS::reg_code> - One-time registration codes - -L<FS::reg_code_pkg> - Class linking registration codes (see L<FS::reg_code>) with package definitions (see L<FS::part_pkg>) - -L<FS::rate> - Rate plans for call billing - -L<FS::rate_region> - Rate regions for call billing - -L<FS::rate_prefix> - Rate region prefixes for call billing - -L<FS::rate_detail> - Rate plan detail for call billing - -L<FS::agent> - Agent (reseller) class - -L<FS::agent_type> - Agent type class - -L<FS::type_pkgs> - Class linking agent types (see L<FS::agent_type>) with -package definitions (see L<FS::part_pkg>) - -L<FS::cust_svc> - Service class - -L<FS::cust_pkg> - Customer package class - -L<FS::cust_main> - Customer class - -L<FS::cust_main_invoice> - Invoice destination -class - -L<FS::cust_bill> - Invoice class - -L<FS::cust_bill_pkg> - Invoice line item class - -L<FS::cust_bill_pkg_detail> - Invoice line item detail class - -L<FS::part_bill_event> - Invoice event definition class - -L<FS::cust_bill_event> - Completed invoice event class - -L<FS::cust_pay> - Payment class - -L<FS::cust_pay_void> - Voided payment class - -L<FS::cust_bill_pay> - Payment application class - -L<FS::cust_credit> - Credit class - -L<FS::cust_refund> - Refund class - -L<FS::cust_credit_refund> - Refund application to credit class - -L<FS::cust_credit_bill> - Credit application to invoice class - -L<FS::cust_pay_refund> - Refund application to payment class - -L<FS::pay_batch> - Credit card transaction queue class - -L<FS::cust_pay_batch> - Credit card transaction member queue class - -L<FS::prepay_credit> - Prepaid "calling card" credit class. - -L<FS::nas> - Network Access Server class - -L<FS::port> - NAS port class - -L<FS::session> - User login session class - -L<FS::queue> - Job queue - -L<FS::queue_arg> - Job arguments - -L<FS::queue_depend> - Job dependencies - -L<FS::msgcat> - Message catalogs - -L<FS::clientapi_session> - -L<FS::clientapi_session_field> - -=head1 Client API - -L<FS::ClientAPI> - -L<FS::ClientAPI_SessionCache> - -L<FS::ClientAPI::Signup> - -L<FS::ClientAPI::passwd> - -L<FS::ClientAPI::MyAccount> - -L<FS::ClientAPI::Agent> - -=head1 Remote API modules - -L<FS::SelfService> - -L<FS::SignupClient> - -L<FS::SessionClient> - -L<FS::MailAdminServer> (deprecated in favor of the self-service server) - -=head2 Command-line utilities - -L<freeside-adduser> - -L<freeside-queued> - -L<freeside-daily> - -L<freeside-expiration-alerter> - -L<freeside-email> - -L<freeside-cc-receipts-report> - -L<freeside-credit-report> - -L<freeside-receivables-report> - -L<freeside-tax-report> - -L<freeside-bill> - -L<freeside-overdue> - -=head2 User Interface classes - -L<FS::UI::Web> - Web 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.perl.com/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 <http://www.sisd.com/freeside>. - -The main documentation is in httemplate/docs. - -=head1 SUPPORT - -A mailing list for users is available. Send a blank message to -<freeside-users-subscribe@sisd.com> to subscribe. - -A mailing list for developers is available. It is intended to be lower volume -and higher SNR than the users list. Send a blank message to -<freeside-devel-subscribe@sisd.com> to subscribe. - -Commercial support is available; see -<http://www.sisd.com/freeside/commercial.html>. - -=head1 AUTHOR - -Primarily Ivan Kohler <ivan@sisd.com>, with help from many kind folks. - -See the CREDITS file in the Freeside distribution for a (hopefully) complete -list and the individal files for details. - -=head1 SEE ALSO - -perl(1), main Freeside documentation in htdocs/docs/ - -=head1 BUGS - -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/AccessRight.pm b/FS/FS/AccessRight.pm deleted file mode 100644 index d03b79a..0000000 --- a/FS/FS/AccessRight.pm +++ /dev/null @@ -1,150 +0,0 @@ -package FS::AccessRight; - -use strict; -use vars qw(@rights); # %rights); -use Tie::IxHash; - -=head1 NAME - -FS::AccessRight - Access control rights. - -=head1 SYNOPSIS - - use FS::AccessRight; - -=head1 DESCRIPTION - -Access control rights - Permission to perform specific actions that can be -assigned to users and/or groups. - -=cut - -#@rights = ( -# 'Reports' => [ -# '_desc' => 'Access to high-level reporting', -# ], -# 'Configuration' => [ -# '_desc' => 'Access to configuration', -# -# 'Settings' => {}, -# -# 'agent' => [ -# '_desc' => 'Master access to reseller configuration', -# 'agent_type' => {}, -# 'agent' => {}, -# ], -# -# 'export_svc_pkg' => [ -# '_desc' => 'Access to export, service and package configuration', -# 'part_export' => {}, -# 'part_svc' => {}, -# 'part_pkg' => {}, -# 'pkg_class' => {}, -# ], -# -# 'billing' => [ -# '_desc' => 'Access to billing configuration', -# 'payment_gateway' => {}, -# 'part_bill_event' => {}, -# 'prepay_credit' => {}, -# 'rate' => {}, -# 'cust_main_county' => {}, -# ], -# -# 'dialup' => [ -# '_desc' => 'Access to dialup configuraiton', -# 'svc_acct_pop' => {}, -# ], -# -# 'broadband' => [ -# '_desc' => 'Access to broadband configuration', -# 'router' => {}, -# 'addr_block' => {}, -# ], -# -# 'misc' => [ -# 'part_referral' => {}, -# 'part_virtual_field' => {}, -# 'msgcat' => {}, -# 'inventory_class' => {}, -# ], -# -# }, -# -#); -# -##turn it into a more hash-like structure, but ordered via IxHash - -#well, this is what we have for now. could be ordered better, could be lots of -# things better, but this ACL system does 99% of what folks need and the UI -# isn't *that* bad -@rights = ( - 'New customer', - 'View customer', - #'View Customer | View tickets', - 'Edit customer', - 'Cancel customer', - 'Complimentary customer', #aka users-allow_comp - 'Delete customer', #aka. deletecustomers #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. - - 'Order customer package', - 'One-time charge', - 'Change customer package', - 'Bulk change customer packages', - 'Edit customer package dates', - 'Customize customer package', - 'Suspend customer package', - 'Unsuspend customer package', - 'Cancel customer package immediately', - 'Cancel customer package later', - - 'Provision customer service', - 'Unprovision customer service', - - 'View/link unlinked services', #not agent-virtualizable without more work - - 'View invoices', - - 'Post payment', - 'Post payment batch', - 'Unapply payment', #aka. unapplypayments Enable "unapplication" of unclosed payments. - 'Process payment', - 'Refund payment', - - 'Delete payment', #aka. deletepayments - 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. - - 'Post credit', - #'Apply credit', - 'Unapply credit', #aka unapplycredits Enable "unapplication" of unclosed credits. - 'Delete credit', #aka. deletecredits Enable deletion of unclosed credits. Be very careful! Only delete credits that were data-entry errors, not adjustments. Optionally specify one or more comma-separated email addresses to be notified when a credit is deleted. - - 'Credit card void', #aka. cc-void #Enable local-only voiding of echeck payments in addition to refunds against the payment gateway - 'Echeck void', #aka. echeck-void #Enable local-only voiding of echeck payments in addition to refunds against the payment gateway - 'Regular void', - 'Unvoid', #aka. unvoid #Enable unvoiding of voided payments - - 'List customers', - #'List zip codes', - 'List invoices', - 'List packages', - 'List services', - - 'List rating data', - - 'Financial reports', - - 'Job queue', # these are not currently agent-virtualized - 'Import', # - 'Export', # - - 'Edit advertising sources', - 'Edit global advertising sources', - - 'Configuration', #most of the rest of the configuraiton is not - # agent-virtualized -); - -sub rights { - @rights; -} - diff --git a/FS/FS/CGI.pm b/FS/FS/CGI.pm deleted file mode 100644 index 1f3b59e..0000000 --- a/FS/FS/CGI.pm +++ /dev/null @@ -1,422 +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 rooturl table itable ntable - small_custview myexit http_header); - -=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 { - use Carp; - carp 'FS::CGI::header deprecated; include /elements/header.html instead'; - - my($title,$menubar,$etc)=@_; #$etc is for things like onLoad= etc. - $etc = '' unless defined $etc; - - my $x = <<END; - <HTML> - <HEAD> - <TITLE> - $title - </TITLE> - <META HTTP-Equiv="Cache-Control" Content="no-cache"> - <META HTTP-Equiv="Pragma" Content="no-cache"> - <META HTTP-Equiv="Expires" Content="0"> - </HEAD> - <BODY BGCOLOR="#e8e8e8"$etc> - <FONT SIZE=6> - <CENTER>$title</CENTER> - </FONT> - <BR><!--<BR>--> -END - $x .= $menubar. "<BR><BR>" if $menubar; - $x; -} - -=item http_header - -Sets an http header. - -=cut - -sub http_header { - my ( $header, $value ) = @_; - if (exists $ENV{MOD_PERL}) { - if ( defined $main::Response - && $main::Response->isa('Apache::ASP::Response') ) { #Apache::ASP - if ( $header =~ /^Content-Type$/ ) { - $main::Response->{ContentType} = $value; - } else { - $main::Response->AddHeader( $header => $value ); - } - } elsif ( defined $HTML::Mason::Commands::r ) { #Mason - ## is this the correct pacakge for $r ??? for 1.0x and 1.1x ? - if ( $header =~ /^Content-Type$/ ) { - $HTML::Mason::Commands::r->content_type($value); - } else { - $HTML::Mason::Commands::r->header_out( $header => $value ); - } - } else { - die "http_header called in unknown environment"; - } - } else { - die "http_header called not running under mod_perl"; - } - -} - -=item menubar ITEM, URL, ... - -Returns an HTML menubar. - -=cut - -sub menubar { #$menubar=menubar('Main Menu', '../', 'Item', 'url', ... ); - use Carp; - carp 'FS::CGI::menubar deprecated; include /elements/menubar.html instead'; - - my($item,$url,@html); - while (@_) { - ($item,$url)=splice(@_,0,2); - next if $item =~ /^\s*Main\s+Menu\s*$/i; - push @html, qq!<A HREF="$url">$item</A>!; - } - 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 <<END; -<HTML> - <HEAD> - <TITLE>Error processing your request</TITLE> - <META HTTP-Equiv="Cache-Control" Content="no-cache"> - <META HTTP-Equiv="Pragma" Content="no-cache"> - <META HTTP-Equiv="Expires" Content="0"> - </HEAD> - <BODY> - <CENTER> - <H4>Error processing your request</H4> - </CENTER> - Your request could not be processed because of the following error: - <P><B>$error</B> - </BODY> -</HTML> -END - -} - -=item eidiot ERROR - -This is depriciated. Don't use it. - -Sends 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_string = $cgi->isa('Apache') ? $cgi->uri : $cgi->url; - $url_string =~ s/\?.*//; - my $url = new URI::URL ( $url_string ); - my(@path)=$url->path_components; - splice @path, 0-$up; - $url->path_components(@path); - my $x = $url->as_string; - $x .= '/' unless $x =~ /\/$/; - $x; -} - -=item rooturl - -=cut - -sub rooturl { - # better to start with the client-provided URL - my $cgi = &FS::UID::cgi; - my $url_string = $cgi->isa('Apache') ? $cgi->uri : $cgi->url; - $url_string =~ s/\?.*//; - - #even though this is kludgy - $url_string =~ - s{ - (browse|config|docs|edit|graph|misc|search|view) - / - (process/)? - ([\w\-\.]+) - $ - } - {}x; - - $url_string; - -} - -=item table - -Returns HTML tag for beginning a table. - -=cut - -sub table { - use Carp; - carp 'FS::CGI::table deprecated; include /elements/table.html instead'; - - my $col = shift; - if ( $col ) { - qq!<TABLE BGCOLOR="$col" BORDER=1 WIDTH="100%" CELLSPACING=0 CELLPADDING=2 BORDERCOLOR="#999999">!; - } else { - '<TABLE BORDER=1 CELLSPACING=0 CELLPADDING=2 BORDERCOLOR="#999999">'; - } -} - -=item itable - -Returns HTML tag for beginning an (invisible) table. - -=cut - -sub itable { - my $col = shift; - my $cellspacing = shift || 0; - my $width = ( scalar(@_) && shift ) ? '' : 'WIDTH="100%"'; #bah - if ( $col ) { - qq!<TABLE BGCOLOR="$col" BORDER=0 CELLSPACING=$cellspacing $width>!; - } else { - qq!<TABLE BORDER=0 CELLSPACING=$cellspacing $width>!; - } -} - -=item ntable - -This is getting silly. - -=cut - -sub ntable { - my $col = shift; - my $cellspacing = shift || 0; - if ( $col ) { - qq!<TABLE BGCOLOR="$col" BORDER=0 CELLSPACING=$cellspacing>!; - } else { - '<TABLE BORDER CELLSPACING=0 CELLPADDING=2 BORDERCOLOR="#999999">'; - } - -} - -=item small_custview CUSTNUM || CUST_MAIN_OBJECT, COUNTRYDEFAULT, NOBALANCE_FLAG - -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 $nobalance = shift; - - my $cust_main = ref($arg) ? $arg - : qsearchs('cust_main', { 'custnum' => $arg } ) - or die "unknown custnum $arg"; - - my $html = 'Customer #<B>'. $cust_main->custnum. '</B></A>'. - ' - <B><FONT COLOR="'. $cust_main->statuscolor. '">'. - ucfirst($cust_main->status). '</FONT></B>'. - ntable('#e8e8e8'). '<TR><TD VALIGN="top">'. ntable("#cccccc",2). - '<TR><TD ALIGN="right" VALIGN="top">Billing<BR>Address</TD><TD BGCOLOR="#ffffff">'. - $cust_main->getfield('last'). ', '. $cust_main->first. '<BR>'; - - $html .= $cust_main->company. '<BR>' if $cust_main->company; - $html .= $cust_main->address1. '<BR>'; - $html .= $cust_main->address2. '<BR>' if $cust_main->address2; - $html .= $cust_main->city. ', '. $cust_main->state. ' '. $cust_main->zip. '<BR>'; - $html .= $cust_main->country. '<BR>' - if $cust_main->country && $cust_main->country ne $countrydefault; - - $html .= '</TD></TR><TR><TD></TD><TD BGCOLOR="#ffffff">'; - if ( $cust_main->daytime && $cust_main->night ) { - use FS::Msgcat; - $html .= ( FS::Msgcat::_gettext('daytime') || 'Day' ). - ' '. $cust_main->daytime. - '<BR>'. ( FS::Msgcat::_gettext('night') || 'Night' ). - ' '. $cust_main->night; - } elsif ( $cust_main->daytime || $cust_main->night ) { - $html .= $cust_main->daytime || $cust_main->night; - } - if ( $cust_main->fax ) { - $html .= '<BR>Fax '. $cust_main->fax; - } - - $html .= '</TD></TR></TABLE></TD>'; - - if ( defined $cust_main->dbdef_table->column('ship_last') ) { - - my $pre = $cust_main->ship_last ? 'ship_' : ''; - - $html .= '<TD VALIGN="top">'. ntable("#cccccc",2). - '<TR><TD ALIGN="right" VALIGN="top">Service<BR>Address</TD><TD BGCOLOR="#ffffff">'. - $cust_main->get("${pre}last"). ', '. - $cust_main->get("${pre}first"). '<BR>'; - $html .= $cust_main->get("${pre}company"). '<BR>' - if $cust_main->get("${pre}company"); - $html .= $cust_main->get("${pre}address1"). '<BR>'; - $html .= $cust_main->get("${pre}address2"). '<BR>' - if $cust_main->get("${pre}address2"); - $html .= $cust_main->get("${pre}city"). ', '. - $cust_main->get("${pre}state"). ' '. - $cust_main->get("${pre}ship_zip"). '<BR>'; - $html .= $cust_main->get("${pre}country"). '<BR>' - if $cust_main->get("${pre}country") - && $cust_main->get("${pre}country") ne $countrydefault; - - $html .= '</TD></TR><TR><TD></TD><TD BGCOLOR="#ffffff">'; - - if ( $cust_main->get("${pre}daytime") && $cust_main->get("${pre}night") ) { - use FS::Msgcat; - $html .= ( FS::Msgcat::_gettext('daytime') || 'Day' ). - ' '. $cust_main->get("${pre}daytime"). - '<BR>'. ( FS::Msgcat::_gettext('night') || 'Night' ). - ' '. $cust_main->get("${pre}night"); - } elsif ( $cust_main->get("${pre}daytime") - || $cust_main->get("${pre}night") ) { - $html .= $cust_main->get("${pre}daytime") - || $cust_main->get("${pre}night"); - } - if ( $cust_main->get("${pre}fax") ) { - $html .= '<BR>Fax '. $cust_main->get("${pre}fax"); - } - - $html .= '</TD></TR></TABLE></TD>'; - } - - $html .= '</TR></TABLE>'; - - $html .= '<BR>Balance: <B>$'. $cust_main->balance. '</B><BR>' - unless $nobalance; - - # last payment might be good here too? - - $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<CGI>, L<CGI::Base> - -=cut - -1; - - diff --git a/FS/FS/ClientAPI.pm b/FS/FS/ClientAPI.pm deleted file mode 100644 index 902f58b..0000000 --- a/FS/FS/ClientAPI.pm +++ /dev/null @@ -1,37 +0,0 @@ -package FS::ClientAPI; - -use strict; -use vars qw(%handler $domain $DEBUG); - -$DEBUG = 0; - -%handler = (); - -#find modules -foreach my $INC ( @INC ) { - my $glob = "$INC/FS/ClientAPI/*.pm"; - warn "FS::ClientAPI: searching $glob" if $DEBUG; - foreach my $file ( glob($glob) ) { - $file =~ /\/(\w+)\.pm$/ or do { - warn "unrecognized ClientAPI file: $file"; - next - }; - my $mod = $1; - warn "using FS::ClientAPI::$mod" if $DEBUG; - eval "use FS::ClientAPI::$mod;"; - die "error using FS::ClientAPI::$mod: $@" if $@; - } -} - -#--- - -sub dispatch { - my ( $self, $name ) = ( shift, shift ); - $name =~ s(/)(::)g; - my $sub = "FS::ClientAPI::$name"; - no strict 'refs'; - &{$sub}(@_); -} - -1; - diff --git a/FS/FS/ClientAPI/Agent.pm b/FS/FS/ClientAPI/Agent.pm deleted file mode 100644 index daede59..0000000 --- a/FS/FS/ClientAPI/Agent.pm +++ /dev/null @@ -1,125 +0,0 @@ -package FS::ClientAPI::Agent; - -#some false laziness w/MyAccount - -use strict; -use vars qw($cache); -use subs qw(_cache); -use Digest::MD5 qw(md5_hex); -use FS::Record qw(qsearchs); # qsearch dbdef dbh); -use FS::ClientAPI_SessionCache; -use FS::agent; -use FS::cust_main qw(smart_search); - -sub _cache { - $cache ||= new FS::ClientAPI_SessionCache( { - 'namespace' => 'FS::ClientAPI::Agent', - } ); -} - -sub agent_login { - my $p = shift; - - #don't allow a blank login to first unconfigured agent with no user/pass - return { error => 'Must specify your reseller username and password.' } - unless length($p->{'username'}) && length($p->{'password'}); - - my $agent = qsearchs( 'agent', { - 'username' => $p->{'username'}, - '_password' => $p->{'password'}, - } ); - - unless ( $agent ) { return { error => 'Incorrect password.' } } - - my $session = { - 'agentnum' => $agent->agentnum, - 'agent' => $agent->agent, - }; - - 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' ); - - { 'error' => '', - 'session_id' => $session_id, - }; -} - -sub agent_logout { - my $p = shift; - if ( $p->{'session_id'} ) { - _cache->remove($p->{'session_id'}); - return { 'error' => '' }; - } else { - return { 'error' => "Can't resume session" }; #better error message - } -} - -sub agent_info { - my $p = shift; - - my $session = _cache->get($p->{'session_id'}) - or return { 'error' => "Can't resume session" }; #better error message - - #my %return; - - my $agentnum = $session->{'agentnum'}; - - my $agent = qsearchs( 'agent', { 'agentnum' => $agentnum } ) - or return { 'error' => "unknown agentnum $agentnum" }; - - { 'error' => '', - 'agentnum' => $agentnum, - 'agent' => $agent->agent, - 'num_prospect' => $agent->num_prospect_cust_main, - 'num_active' => $agent->num_active_cust_main, - 'num_susp' => $agent->num_susp_cust_main, - 'num_cancel' => $agent->num_cancel_cust_main, - #%return, - }; - -} - -sub agent_list_customers { - my $p = shift; - - my $session = _cache->get($p->{'session_id'}) - or return { 'error' => "Can't resume session" }; #better error message - - #my %return; - - my $agentnum = $session->{'agentnum'}; - - my $agent = qsearchs( 'agent', { 'agentnum' => $agentnum } ) - or return { 'error' => "unknown agentnum $agentnum" }; - - my @cust_main = smart_search( 'search' => $p->{'search'}, - 'agentnum' => $agentnum, - ); - - #aggregate searches - push @cust_main, - map $agent->$_(), map $_.'_cust_main', - grep $p->{$_}, qw( prospect active susp cancel ); - - #eliminate dups? - my %saw = (); - @cust_main = grep { !$saw{$_->custnum}++ } @cust_main; - - { customers => [ map { - my $cust_main = $_; - my $hashref = $cust_main->hashref; - $hashref->{$_} = $cust_main->$_() - foreach qw(name status statuscolor); - delete $hashref->{$_} foreach qw( payinfo paycvv ); - $hashref; - } @cust_main - ], - } - -} - -1; diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm deleted file mode 100644 index 54b8a99..0000000 --- a/FS/FS/ClientAPI/MyAccount.pm +++ /dev/null @@ -1,918 +0,0 @@ -package FS::ClientAPI::MyAccount; - -use strict; -use vars qw($cache); -use subs qw(_cache); -use Digest::MD5 qw(md5_hex); -use Date::Format; -use Business::CreditCard; -use Time::Duration; -use FS::CGI qw(small_custview); #doh -use FS::Conf; -use FS::Record qw(qsearch qsearchs); -use FS::Msgcat qw(gettext); -use FS::ClientAPI_SessionCache; -use FS::svc_acct; -use FS::svc_domain; -use FS::svc_external; -use FS::part_svc; -use FS::cust_main; -use FS::cust_bill; -use FS::cust_main_county; -use FS::cust_pkg; - -use vars qw( @cust_main_editable_fields ); -@cust_main_editable_fields = qw( - first last company address1 address2 city - county state zip country daytime night fax - ship_first ship_last ship_company ship_address1 ship_address2 ship_city - ship_state ship_zip ship_country ship_daytime ship_night ship_fax - payby payinfo payname paystart_month paystart_year payissue payip -); - -use subs qw(_provision); - -sub _cache { - $cache ||= new FS::ClientAPI_SessionCache( { - 'namespace' => 'FS::ClientAPI::MyAccount', - } ); -} - -#false laziness w/FS::ClientAPI::passwd::passwd -sub login { - my $p = shift; - - my $svc_domain = qsearchs('svc_domain', { 'domain' => $p->{'domain'} } ) - or return { error => 'Domain '. $p->{'domain'}. ' not found' }; - - my $svc_acct = qsearchs( 'svc_acct', { 'username' => $p->{'username'}, - 'domsvc' => $svc_domain->svcnum, } - ); - return { error => 'User not found.' } unless $svc_acct; - - my $conf = new FS::Conf; - my $pkg_svc = $svc_acct->cust_svc->pkg_svc; - return { error => 'Only primary user may log in.' } - if $conf->exists('selfservice_server-primary_only') - && ( ! $pkg_svc || $pkg_svc->primary_svc ne 'Y' ); - - return { error => 'Incorrect password.' } - unless $svc_acct->check_password($p->{'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 logout { - my $p = shift; - if ( $p->{'session_id'} ) { - _cache->remove($p->{'session_id'}); - return { 'error' => '' }; - } else { - return { 'error' => "Can't resume session" }; #better error message - } -} - -sub customer_info { - my $p = shift; - - my($context, $session, $custnum) = _custoragent_session_custnum($p); - return { 'error' => $session } if $context eq 'error'; - - my %return; - if ( $custnum ) { #customer record - - my $search = { 'custnum' => $custnum }; - $search->{'agentnum'} = $session->{'agentnum'} if $context eq 'agent'; - my $cust_main = qsearchs('cust_main', $search ) - 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('countrydefault') ); - - $return{name} = $cust_main->first. ' '. $cust_main->get('last'); - - for (@cust_main_editable_fields) { - $return{$_} = $cust_main->get($_); - } - - if ( $cust_main->payby =~ /^(CARD|DCRD)$/ ) { - $return{payinfo} = $cust_main->payinfo_masked; - @return{'month', 'year'} = $cust_main->paydate_monthyear; - } - - $return{'invoicing_list'} = - join(', ', grep { $_ !~ /^(POST|FAX)$/ } $cust_main->invoicing_list ); - $return{'postal_invoicing'} = - 0 < ( grep { $_ eq 'POST' } $cust_main->invoicing_list ); - - } elsif ( $session->{'svcnum'} ) { #no customer record - - my $svc_acct = qsearchs('svc_acct', { 'svcnum' => $session->{'svcnum'} } ) - or die "unknown svcnum"; - $return{name} = $svc_acct->email; - - } else { - - return { 'error' => 'Expired session' }; #XXX redirect to login w/this err! - - } - - return { 'error' => '', - 'custnum' => $custnum, - %return, - }; - -} - -sub edit_info { - my $p = shift; - my $session = _cache->get($p->{'session_id'}) - or return { 'error' => "Can't resume session" }; #better error message - - my $custnum = $session->{'custnum'} - or return { 'error' => "no customer record" }; - - my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ) - or return { 'error' => "unknown custnum $custnum" }; - - my $new = new FS::cust_main { $cust_main->hash }; - $new->set( $_ => $p->{$_} ) - foreach grep { exists $p->{$_} } @cust_main_editable_fields; - - if ( $p->{'payby'} =~ /^(CARD|DCRD)$/ ) { - $new->paydate($p->{'year'}. '-'. $p->{'month'}. '-01'); - if ( $new->payinfo eq $cust_main->payinfo_masked ) { - $new->payinfo($cust_main->payinfo); - } else { - $new->paycvv($p->{'paycvv'}); - } - } - - my @invoicing_list; - if ( exists $p->{'invoicing_list'} || exists $p->{'postal_invoicing'} ) { - #false laziness with httemplate/edit/process/cust_main.cgi - @invoicing_list = split( /\s*\,\s*/, $p->{'invoicing_list'} ); - push @invoicing_list, 'POST' if $p->{'postal_invoicing'}; - } else { - @invoicing_list = $cust_main->invoicing_list; - } - - my $error = $new->replace($cust_main, \@invoicing_list); - return { 'error' => $error } if $error; - #$cust_main = $new; - - return { 'error' => '' }; -} - -sub payment_info { - my $p = shift; - my $session = _cache->get($p->{'session_id'}) - or return { 'error' => "Can't resume session" }; #better error message - - ## - #generic - ## - - my $conf = new FS::Conf; - my %states = map { $_->state => 1 } - qsearch('cust_main_county', { - 'country' => $conf->config('countrydefault') || 'US' - } ); - - use vars qw($payment_info); #cache for performance - $payment_info ||= { - - #list all counties/states/countries - 'cust_main_county' => - [ map { $_->hashref } qsearch('cust_main_county', {}) ], - - #shortcut for one-country folks - 'states' => - [ sort { $a cmp $b } keys %states ], - - 'card_types' => { - 'VISA' => 'VISA card', - 'MasterCard' => 'MasterCard', - 'Discover' => 'Discover card', - 'American Express' => 'American Express card', - 'Switch' => 'Switch', - 'Solo' => 'Solo', - }, - - }; - - ## - #customer-specific - ## - - my %return = %$payment_info; - - my $custnum = $session->{'custnum'}; - - my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ) - or return { 'error' => "unknown custnum $custnum" }; - - $return{balance} = $cust_main->balance; - - $return{payname} = $cust_main->payname - || ( $cust_main->first. ' '. $cust_main->get('last') ); - - $return{$_} = $cust_main->get($_) for qw(address1 address2 city state zip); - - $return{payby} = $cust_main->payby; - - if ( $cust_main->payby =~ /^(CARD|DCRD)$/ ) { - #warn $return{card_type} = cardtype($cust_main->payinfo); - $return{payinfo} = $cust_main->payinfo; - - @return{'month', 'year'} = $cust_main->paydate_monthyear; - - } - - #doubleclick protection - my $_date = time; - $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32; - - return { 'error' => '', - %return, - }; - -}; - -#some false laziness with httemplate/process/payment.cgi - look there for -#ACH and CVV support stuff -sub process_payment { - - my $p = shift; - - my $session = _cache->get($p->{'session_id'}) - or return { 'error' => "Can't resume session" }; #better error message - - my %return; - - my $custnum = $session->{'custnum'}; - - my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ) - or return { 'error' => "unknown custnum $custnum" }; - - $p->{'payname'} =~ /^([\w \,\.\-\']+)$/ - or return { 'error' => gettext('illegal_name'). " payname: ". $p->{'payname'} }; - my $payname = $1; - - $p->{'paybatch'} =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=]*)$/ - or return { 'error' => gettext('illegal_text'). " paybatch: ". $p->{'paybatch'} }; - my $paybatch = $1; - - my $payinfo; - my $paycvv = ''; - #if ( $payby eq 'CHEK' ) { - # - # $p->{'payinfo1'} =~ /^(\d+)$/ - # or return { 'error' => "illegal account number ". $p->{'payinfo1'} }; - # my $payinfo1 = $1; - # $p->{'payinfo2'} =~ /^(\d+)$/ - # or return { 'error' => "illegal ABA/routing number ". $p->{'payinfo2'} }; - # my $payinfo2 = $1; - # $payinfo = $payinfo1. '@'. $payinfo2; - # - #} elsif ( $payby eq 'CARD' ) { - - $payinfo = $p->{'payinfo'}; - $payinfo =~ s/\D//g; - $payinfo =~ /^(\d{13,16})$/ - or return { 'error' => gettext('invalid_card') }; # . ": ". $self->payinfo - $payinfo = $1; - validate($payinfo) - or return { 'error' => gettext('invalid_card') }; # . ": ". $self->payinfo - return { 'error' => gettext('unknown_card_type') } - if cardtype($payinfo) eq "Unknown"; - - if ( defined $cust_main->dbdef_table->column('paycvv') ) { - if ( length($p->{'paycvv'} ) ) { - if ( cardtype($payinfo) eq 'American Express card' ) { - $p->{'paycvv'} =~ /^(\d{4})$/ - or return { 'error' => "CVV2 (CID) for American Express cards is four digits." }; - $paycvv = $1; - } else { - $p->{'paycvv'} =~ /^(\d{3})$/ - or return { 'error' => "CVV2 (CVC2/CID) is three digits." }; - $paycvv = $1; - } - } - } - - #} else { - # die "unknown payby $payby"; - #} - - my $error = $cust_main->realtime_bop( 'CC', $p->{'amount'}, - 'quiet' => 1, - 'payinfo' => $payinfo, - 'paydate' => $p->{'year'}. '-'. $p->{'month'}. '-01', - 'payname' => $payname, - 'paybatch' => $paybatch, - 'paycvv' => $paycvv, - map { $_ => $p->{$_} } qw( paystart_month paystart_year payissue payip - address1 address2 city state zip ) - ); - return { 'error' => $error } if $error; - - $cust_main->apply_payments; - - if ( $p->{'save'} ) { - my $new = new FS::cust_main { $cust_main->hash }; - $new->set( $_ => $p->{$_} ) - foreach qw( payname paystart_month paystart_year payissue payip - address1 address2 city state zip payinfo ); - $new->set( 'paydate' => $p->{'year'}. '-'. $p->{'month'}. '-01' ); - $new->set( 'payby' => $p->{'auto'} ? 'CARD' : 'DCRD' ); - my $error = $new->replace($cust_main); - return { 'error' => $error } if $error; - $cust_main = $new; - } - - return { 'error' => '' }; - -} - -sub process_prepay { - - my $p = shift; - - my $session = _cache->get($p->{'session_id'}) - or return { 'error' => "Can't resume session" }; #better error message - - my %return; - - my $custnum = $session->{'custnum'}; - - my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ) - or return { 'error' => "unknown custnum $custnum" }; - - my( $amount, $seconds ) = ( 0, 0 ); - my $error = $cust_main->recharge_prepay( $p->{'prepaid_cardnum'}, - \$amount, - \$seconds - ); - - return { 'error' => $error } if $error; - - return { 'error' => '', - 'amount' => $amount, - 'seconds' => $seconds, - 'duration' => duration_exact($seconds), - }; - -} - -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 ), - 'invoice_html' => $cust_bill->print_html, - }; - -} - -sub invoice_logo { - my $p = shift; - - #sessioning for this? how do we get the session id to the backend invoice - # template so it can add it to the link, blah - - my $templatename = $p->{'templatename'}; - - #false laziness-ish w/view/cust_bill-logo.cgi - - my $conf = new FS::Conf; - if ( $templatename =~ /^([^\.\/]*)$/ && $conf->exists("logo_$1.png") ) { - $templatename = "_$1"; - } else { - $templatename = ''; - } - - my $filename = "logo$templatename.png"; - - return { 'error' => '', - 'logo' => $conf->config_binary($filename), - 'content_type' => 'image/png', #should allow gif, jpg too - }; -} - - -sub list_invoices { - my $p = shift; - my $session = _cache->get($p->{'session_id'}) - or return { 'error' => "Can't resume session" }; #better error message - - my $custnum = $session->{'custnum'}; - - my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ) - or return { 'error' => "unknown custnum $custnum" }; - - my @cust_bill = $cust_main->cust_bill; - - return { 'error' => '', - 'invoices' => [ map { { 'invnum' => $_->invnum, - '_date' => $_->_date, - } - } @cust_bill - ] - }; -} - -sub cancel { - my $p = shift; - my $session = _cache->get($p->{'session_id'}) - or return { 'error' => "Can't resume session" }; #better error message - - my $custnum = $session->{'custnum'}; - - my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ) - or return { 'error' => "unknown custnum $custnum" }; - - my @errors = $cust_main->cancel( 'quiet'=>1 ); - - my $error = scalar(@errors) ? join(' / ', @errors) : ''; - - return { 'error' => $error }; - -} - -sub list_pkgs { - my $p = shift; - - my($context, $session, $custnum) = _custoragent_session_custnum($p); - return { 'error' => $session } if $context eq 'error'; - - my $search = { 'custnum' => $custnum }; - $search->{'agentnum'} = $session->{'agentnum'} if $context eq 'agent'; - my $cust_main = qsearchs('cust_main', $search ) - or return { 'error' => "unknown custnum $custnum" }; - - #return { 'cust_pkg' => [ map { $_->hashref } $cust_main->ncancelled_pkgs ] }; - - my $conf = new FS::Conf; - - { 'svcnum' => $session->{'svcnum'}, - 'custnum' => $custnum, - 'cust_pkg' => [ map { - { $_->hash, - $_->part_pkg->hash, - part_svc => - [ map $_->hashref, $_->available_part_svc ], - cust_svc => - [ map { my $ref = { $_->hash, - label => [ $_->label ], - }; - $ref->{_password} = $_->svc_x->_password - if $context eq 'agent' - && $conf->exists('agent-showpasswords') - && $_->part_svc->svcdb eq 'svc_acct'; - $ref; - } $_->cust_svc - ], - }; - } $cust_main->ncancelled_pkgs - ], - 'small_custview' => - small_custview( $cust_main, $conf->config('countrydefault') ), - }; - -} - -sub list_svcs { - my $p = shift; - - use Data::Dumper; - - my($context, $session, $custnum) = _custoragent_session_custnum($p); - return { 'error' => $session } if $context eq 'error'; - - my $search = { 'custnum' => $custnum }; - $search->{'agentnum'} = $session->{'agentnum'} if $context eq 'agent'; - my $cust_main = qsearchs('cust_main', $search ) - or return { 'error' => "unknown custnum $custnum" }; - - my @cust_svc = (); - #foreach my $cust_pkg ( $cust_main->ncancelled_pkgs ) { - foreach my $cust_pkg ( $cust_main->unsuspended_pkgs ) { - push @cust_svc, @{[ $cust_pkg->cust_svc ]}; #@{[ ]} to force array context - } - @cust_svc = grep { $_->part_svc->svcdb eq $p->{'svcdb'} } @cust_svc - if $p->{'svcdb'}; - - #@svc_x = sort { $a->domain cmp $b->domain || $a->username cmp $b->username } - # @svc_x; - - { - #no#'svcnum' => $session->{'svcnum'}, - 'custnum' => $custnum, - 'svcs' => [ map { - my $svc_x = $_->svc_x; - my($label, $value) = $_->label; - - { 'svcnum' => $_->svcnum, - 'label' => $label, - 'value' => $value, - 'username' => $svc_x->username, - 'email' => $svc_x->email, - # more... - }; - } - @cust_svc - ], - }; - -} - -sub order_pkg { - my $p = shift; - - my($context, $session, $custnum) = _custoragent_session_custnum($p); - return { 'error' => $session } if $context eq 'error'; - - my $search = { 'custnum' => $custnum }; - $search->{'agentnum'} = $session->{'agentnum'} if $context eq 'agent'; - my $cust_main = qsearchs('cust_main', $search ) - or return { 'error' => "unknown custnum $custnum" }; - - #false laziness w/ClientAPI/Signup.pm - - my $cust_pkg = new FS::cust_pkg ( { - 'custnum' => $custnum, - 'pkgpart' => $p->{'pkgpart'}, - } ); - my $error = $cust_pkg->check; - return { 'error' => $error } if $error; - - my @svc = (); - unless ( $p->{'svcpart'} eq 'none' ) { - - my $svcdb; - my $svcpart = ''; - if ( $p->{'svcpart'} =~ /^(\d+)$/ ) { - $svcpart = $1; - my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } ); - return { 'error' => "Unknown svcpart $svcpart" } unless $part_svc; - $svcdb = $part_svc->svcdb; - } else { - $svcdb = 'svc_acct'; - } - $svcpart ||= $cust_pkg->part_pkg->svcpart($svcdb); - - my %fields = ( - 'svc_acct' => [ qw( username _password sec_phrase popnum ) ], - 'svc_domain' => [ qw( domain ) ], - 'svc_external' => [ qw( id title ) ], - ); - - my $svc_x = "FS::$svcdb"->new( { - 'svcpart' => $svcpart, - map { $_ => $p->{$_} } @{$fields{$svcdb}} - } ); - - if ( $svcdb eq 'svc_acct' ) { - my @acct_snarf; - my $snarfnum = 1; - while ( length($p->{"snarf_machine$snarfnum"}) ) { - my $acct_snarf = new FS::acct_snarf ( { - 'machine' => $p->{"snarf_machine$snarfnum"}, - 'protocol' => $p->{"snarf_protocol$snarfnum"}, - 'username' => $p->{"snarf_username$snarfnum"}, - '_password' => $p->{"snarf_password$snarfnum"}, - } ); - $snarfnum++; - push @acct_snarf, $acct_snarf; - } - $svc_x->child_objects( \@acct_snarf ); - } - - my $y = $svc_x->setdefault; # arguably should be in new method - return { 'error' => $y } if $y && !ref($y); - - $error = $svc_x->check; - return { 'error' => $error } if $error; - - push @svc, $svc_x; - - } - - use Tie::RefHash; - tie my %hash, 'Tie::RefHash'; - %hash = ( $cust_pkg => \@svc ); - #msgcat - $error = $cust_main->order_pkgs( \%hash, '', 'noexport' => 1 ); - return { 'error' => $error } if $error; - - my $conf = new FS::Conf; - if ( $conf->exists('signup_server-realtime') ) { - - my $old_balance = $cust_main->balance; - - my $bill_error = $cust_main->bill; - $cust_main->apply_payments; - $cust_main->apply_credits; - $bill_error = $cust_main->collect; - - if ( $cust_main->balance > $old_balance - && $cust_main->balance > 0 - && $cust_main->payby !~ /^(BILL|DCRD|DCHK)$/ ) { - #this makes sense. credit is "un-doing" the invoice - $cust_main->credit( sprintf("%.2f", $cust_main->balance - $old_balance ), - 'self-service decline' ); - $cust_main->apply_credits( 'order' => 'newest' ); - - $cust_pkg->cancel('quiet'=>1); - return { 'error' => '_decline', 'bill_error' => $bill_error }; - } else { - $cust_pkg->reexport; - } - - } else { - $cust_pkg->reexport; - } - - return { error => '', pkgnum => $cust_pkg->pkgnum }; - -} - -sub cancel_pkg { - my $p = shift; - my $session = _cache->get($p->{'session_id'}) - or return { 'error' => "Can't resume session" }; #better error message - - my $custnum = $session->{'custnum'}; - - my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ) - or return { 'error' => "unknown custnum $custnum" }; - - my $pkgnum = $p->{'pkgnum'}; - - my $cust_pkg = qsearchs('cust_pkg', { 'custnum' => $custnum, - 'pkgnum' => $pkgnum, } ) - or return { 'error' => "unknown pkgnum $pkgnum" }; - - my $error = $cust_pkg->cancel( 'quiet'=>1 ); - return { 'error' => $error }; - -} - -sub provision_acct { - my $p = shift; - - return { 'error' => gettext('passwords_dont_match') } - if $p->{'_password'} ne $p->{'_password2'}; - return { 'error' => gettext('empty_password') } - unless length($p->{'_password'}); - - _provision( 'FS::svc_acct', - [qw(username _password)], - [qw(username _password)], - $p, - @_ - ); -} - -sub provision_external { - my $p = shift; - #_provision( 'FS::svc_external', [qw(id title)], [qw(id title)], $p, @_ ); - _provision( 'FS::svc_external', - [], - [qw(id title)], - $p, - @_ - ); -} - -sub _provision { - my( $class, $fields, $return_fields, $p ) = splice(@_, 0, 4); - - my($context, $session, $custnum) = _custoragent_session_custnum($p); - return { 'error' => $session } if $context eq 'error'; - - my $search = { 'custnum' => $custnum }; - $search->{'agentnum'} = $session->{'agentnum'} if $context eq 'agent'; - my $cust_main = qsearchs('cust_main', $search ) - or return { 'error' => "unknown custnum $custnum" }; - - my $pkgnum = $p->{'pkgnum'}; - - my $cust_pkg = qsearchs('cust_pkg', { 'custnum' => $custnum, - 'pkgnum' => $pkgnum, - } ) - or return { 'error' => "unknown pkgnum $pkgnum" }; - - my $part_svc = qsearchs('part_svc', { 'svcpart' => $p->{'svcpart'} } ) - or return { 'error' => "unknown svcpart $p->{'svcpart'}" }; - - my $svc_x = $class->new( { - 'pkgnum' => $p->{'pkgnum'}, - 'svcpart' => $p->{'svcpart'}, - map { $_ => $p->{$_} } @$fields - } ); - my $error = $svc_x->insert; - $svc_x = qsearchs($svc_x->table, { 'svcnum' => $svc_x->svcnum }) - unless $error; - - return { 'svc' => $part_svc->svc, - 'error' => $error, - map { $_ => $svc_x->get($_) } @$return_fields - }; - -} - -sub part_svc_info { - my $p = shift; - - my($context, $session, $custnum) = _custoragent_session_custnum($p); - return { 'error' => $session } if $context eq 'error'; - - my $search = { 'custnum' => $custnum }; - $search->{'agentnum'} = $session->{'agentnum'} if $context eq 'agent'; - my $cust_main = qsearchs('cust_main', $search ) - or return { 'error' => "unknown custnum $custnum" }; - - my $pkgnum = $p->{'pkgnum'}; - - my $cust_pkg = qsearchs('cust_pkg', { 'custnum' => $custnum, - 'pkgnum' => $pkgnum, - } ) - or return { 'error' => "unknown pkgnum $pkgnum" }; - - my $svcpart = $p->{'svcpart'}; - - my $pkg_svc = qsearchs('pkg_svc', { 'pkgpart' => $cust_pkg->pkgpart, - 'svcpart' => $svcpart, } ) - or return { 'error' => "unknown svcpart $svcpart for pkgnum $pkgnum" }; - my $part_svc = $pkg_svc->part_svc; - - my $conf = new FS::Conf; - - return { - 'svc' => $part_svc->svc, - 'svcdb' => $part_svc->svcdb, - 'pkgnum' => $pkgnum, - 'svcpart' => $svcpart, - 'custnum' => $custnum, - - 'security_phrase' => 0, #XXX ! - 'svc_acct_pop' => [], #XXX ! - 'popnum' => '', - 'init_popstate' => '', - 'popac' => '', - 'acstate' => '', - - 'small_custview' => - small_custview( $cust_main, $conf->config('countrydefault') ), - - }; - -} - -sub unprovision_svc { - my $p = shift; - - my($context, $session, $custnum) = _custoragent_session_custnum($p); - return { 'error' => $session } if $context eq 'error'; - - my $search = { 'custnum' => $custnum }; - $search->{'agentnum'} = $session->{'agentnum'} if $context eq 'agent'; - my $cust_main = qsearchs('cust_main', $search ) - or return { 'error' => "unknown custnum $custnum" }; - - my $svcnum = $p->{'svcnum'}; - - my $cust_svc = qsearchs('cust_svc', { 'svcnum' => $svcnum, } ) - or return { 'error' => "unknown svcnum $svcnum" }; - - return { 'error' => "Service $svcnum does not belong to customer $custnum" } - unless $cust_svc->cust_pkg->custnum == $custnum; - - my $conf = new FS::Conf; - - return { 'svc' => $cust_svc->part_svc->svc, - 'error' => $cust_svc->cancel, - 'small_custview' => - small_custview( $cust_main, $conf->config('countrydefault') ), - }; - -} - -sub myaccount_passwd { - my $p = shift; - my($context, $session, $custnum) = _custoragent_session_custnum($p); - return { 'error' => $session } if $context eq 'error'; - - return { 'error' => "New passwords don't match." } - if $p->{'new_password'} ne $p->{'new_password2'}; - - return { 'error' => 'Enter new password' } - unless length($p->{'new_password'}); - - #my $search = { 'custnum' => $custnum }; - #$search->{'agentnum'} = $session->{'agentnum'} if $context eq 'agent'; - $custnum =~ /^(\d+)$/ or die "illegal custnum"; - my $search = " AND custnum = $1"; - $search .= " AND agentnum = ". $session->{'agentnum'} if $context eq 'agent'; - - my $svc_acct = qsearchs( { - 'table' => 'svc_acct', - 'addl_from' => 'LEFT JOIN cust_svc USING ( svcnum ) '. - 'LEFT JOIN cust_pkg USING ( pkgnum ) '. - 'LEFT JOIN cust_main USING ( custnum ) ', - 'hashref' => { 'svcnum' => $p->{'svcnum'}, }, - 'extra_sql' => $search, #important - } ) - or return { 'error' => "Service not found" }; - - $svc_acct->_password($p->{'new_password'}); - my $error = $svc_acct->replace(); - - my($label, $value) = $svc_acct->cust_svc->label; - - return { 'error' => $error, - 'label' => $label, - 'value' => $value, - }; - -} - -#-- - -sub _custoragent_session_custnum { - my $p = shift; - - my($context, $session, $custnum); - if ( $p->{'session_id'} ) { - - $context = 'customer'; - $session = _cache->get($p->{'session_id'}) - or return ( 'error' => "Can't resume session" ); #better error message - $custnum = $session->{'custnum'}; - - } elsif ( $p->{'agent_session_id'} ) { - - $context = 'agent'; - my $agent_cache = new FS::ClientAPI_SessionCache( { - 'namespace' => 'FS::ClientAPI::Agent', - } ); - $session = $agent_cache->get($p->{'agent_session_id'}) - or return ( 'error' => "Can't resume session" ); #better error message - $custnum = $p->{'custnum'}; - - } else { - return ( 'error' => "Can't resume session" ); #better error message - } - - ($context, $session, $custnum); - -} - -1; - diff --git a/FS/FS/ClientAPI/Signup.pm b/FS/FS/ClientAPI/Signup.pm deleted file mode 100644 index ed71651..0000000 --- a/FS/FS/ClientAPI/Signup.pm +++ /dev/null @@ -1,344 +0,0 @@ -package FS::ClientAPI::Signup; - -use strict; -use Tie::RefHash; -use FS::Conf; -use FS::Record qw(qsearch qsearchs dbdef); -use FS::Msgcat qw(gettext); -use FS::ClientAPI_SessionCache; -use FS::agent; -use FS::cust_main_county; -use FS::part_pkg; -use FS::svc_acct_pop; -use FS::cust_main; -use FS::cust_pkg; -use FS::svc_acct; -use FS::acct_snarf; -use FS::queue; -use FS::reg_code; - -sub signup_info { - my $packet = shift; - - my $conf = new FS::Conf; - - use vars qw($signup_info); #cache for performance; - $signup_info ||= { - - 'cust_main_county' => - [ map { $_->hashref } qsearch('cust_main_county', {}) ], - - 'agent' => - [ - map { $_->hashref } - qsearch('agent', dbdef->table('agent')->column('disabled') - ? { 'disabled' => '' } - : {} - ) - ], - - 'part_referral' => - [ - map { $_->hashref } - qsearch('part_referral', - dbdef->table('part_referral')->column('disabled') - ? { 'disabled' => '' } - : {} - ) - ], - - 'agentnum2part_pkg' => - { - map { - my $href = $_->pkgpart_hashref; - $_->agentnum => - [ - map { { 'payby' => [ $_->payby ], %{$_->hashref} } } - grep { $_->svcpart('svc_acct') && $href->{ $_->pkgpart } } - qsearch( 'part_pkg', { 'disabled' => '' } ) - ]; - } qsearch('agent', dbdef->table('agent')->column('disabled') - ? { 'disabled' => '' } - : {} - ) - }, - - 'svc_acct_pop' => [ map { $_->hashref } qsearch('svc_acct_pop',{} ) ], - - 'security_phrase' => $conf->exists('security_phrase'), - - 'payby' => [ $conf->config('signup_server-payby') ], - - 'cvv_enabled' => defined dbdef->table('cust_main')->column('paycvv'), - - 'ship_enabled' => defined dbdef->table('cust_main')->column('ship_last'), - - 'msgcat' => { map { $_=>gettext($_) } qw( - passwords_dont_match invalid_card unknown_card_type not_a empty_password - ) }, - - 'statedefault' => $conf->config('statedefault') || 'CA', - - 'countrydefault' => $conf->config('countrydefault') || 'US', - - 'refnum' => $conf->config('signup_server-default_refnum'), - - }; - - my $agentnum = $conf->config('signup_server-default_agentnum'); - - my $session = ''; - if ( exists $packet->{'session_id'} ) { - my $cache = new FS::ClientAPI_SessionCache( { - 'namespace' => 'FS::ClientAPI::Agent', - } ); - $session = $cache->get($packet->{'session_id'}); - if ( $session ) { - $agentnum = $session->{'agentnum'}; - } else { - return { 'error' => "Can't resume session" }; #better error message - } - } - - $signup_info->{'part_pkg'} = []; - - if ( $packet->{'reg_code'} ) { - $signup_info->{'part_pkg'} = - [ map { { 'payby' => [ $_->payby ], %{$_->hashref} } } - grep { $_->svcpart('svc_acct') } - map { $_->part_pkg } - qsearchs( 'reg_code', { 'code' => $packet->{'reg_code'}, - 'agentnum' => $agentnum, } ) - - ]; - - $signup_info->{'error'} = 'Unknown registration code' - unless @{ $signup_info->{'part_pkg'} }; - - } elsif ( $packet->{'promo_code'} ) { - - $signup_info->{'part_pkg'} = - [ map { { 'payby' => [ $_->payby ], %{$_->hashref} } } - grep { $_->svcpart('svc_acct') } - qsearch( 'part_pkg', { 'promo_code' => { - op=>'ILIKE', - value=>$packet->{'promo_code'} - }, - 'disabled' => '', } ) - ]; - - $signup_info->{'error'} = 'Unknown promotional code' - unless @{ $signup_info->{'part_pkg'} }; - } - - if ( $agentnum && ! @{ $signup_info->{'part_pkg'} } ) { - $signup_info->{'part_pkg'} = $signup_info->{'agentnum2part_pkg'}{$agentnum}; - } - # else { - # delete $signup_info->{'part_pkg'}; - #} - - if ( $session ) { - my $agent_signup_info = { %$signup_info }; - delete $agent_signup_info->{agentnum2part_pkg}; - $agent_signup_info->{'agent'} = $session->{'agent'}; - $agent_signup_info; - } else { - $signup_info; - } - -} - -sub new_customer { - my $packet = shift; - - my $conf = new FS::Conf; - - #things that aren't necessary in base class, but are for signup server - #return "Passwords don't match" - # if $hashref->{'_password'} ne $hashref->{'_password2'} - return { 'error' => gettext('empty_password') } - unless length($packet->{'_password'}); - # a bit inefficient for large numbers of pops - return { 'error' => gettext('no_access_number_selected') } - unless $packet->{'popnum'} || !scalar(qsearch('svc_acct_pop',{} )); - - my $agentnum; - if ( exists $packet->{'session_id'} ) { - my $cache = new FS::ClientAPI_SessionCache( { - 'namespace' => 'FS::ClientAPI::Agent', - } ); - my $session = $cache->get($packet->{'session_id'}); - if ( $session ) { - $agentnum = $session->{'agentnum'}; - } else { - return { 'error' => "Can't resume session" }; #better error message - } - } else { - $agentnum = $packet->{agentnum} - || $conf->config('signup_server-default_agentnum'); - } - - #shares some stuff with htdocs/edit/process/cust_main.cgi... take any - # common that are still here and library them. - my $cust_main = new FS::cust_main ( { - #'custnum' => '', - 'agentnum' => $agentnum, - 'refnum' => $packet->{refnum} - || $conf->config('signup_server-default_refnum'), - - map { $_ => $packet->{$_} } qw( - - last first ss company address1 address2 - city county state zip country - daytime night fax - - ship_last ship_first ship_ss ship_company ship_address1 ship_address2 - ship_city ship_county ship_state ship_zip ship_country - ship_daytime ship_night ship_fax - - payby - payinfo paycvv paydate payname - paystart_month paystart_year payissue - payip - - referral_custnum comments - ) - - } ); - - return { 'error' => "Illegal payment type" } - unless grep { $_ eq $packet->{'payby'} } - $conf->config('signup_server-payby'); - - $cust_main->payinfo($cust_main->daytime) - if $cust_main->payby eq 'LECB' && ! $cust_main->payinfo; - - my @invoicing_list = split( /\s*\,\s*/, $packet->{'invoicing_list'} ); - - $packet->{'pkgpart'} =~ /^(\d+)$/ or '' =~ /^()$/; - my $pkgpart = $1; - return { 'error' => 'Please select a package' } unless $pkgpart; #msgcat - - my $part_pkg = - qsearchs( 'part_pkg', { 'pkgpart' => $pkgpart } ) - or return { 'error' => "WARNING: unknown pkgpart: $pkgpart" }; - my $svcpart = $part_pkg->svcpart('svc_acct'); - - my $reg_code = ''; - if ( $packet->{'reg_code'} ) { - $reg_code = qsearchs( 'reg_code', { 'code' => $packet->{'reg_code'}, - 'agentnum' => $agentnum, } ) - or return { 'error' => 'Unknown registration code' }; - } - - my $cust_pkg = new FS::cust_pkg ( { - #later#'custnum' => $custnum, - 'pkgpart' => $packet->{'pkgpart'}, - 'promo_code' => $packet->{'promo_code'}, - 'reg_code' => $packet->{'reg_code'}, - } ); - #my $error = $cust_pkg->check; - #return { 'error' => $error } if $error; - - my $svc_acct = new FS::svc_acct ( { - 'svcpart' => $svcpart, - map { $_ => $packet->{$_} } - qw( username _password sec_phrase popnum ), - } ); - - my @acct_snarf; - my $snarfnum = 1; - while ( exists($packet->{"snarf_machine$snarfnum"}) - && length($packet->{"snarf_machine$snarfnum"}) ) { - my $acct_snarf = new FS::acct_snarf ( { - 'machine' => $packet->{"snarf_machine$snarfnum"}, - 'protocol' => $packet->{"snarf_protocol$snarfnum"}, - 'username' => $packet->{"snarf_username$snarfnum"}, - '_password' => $packet->{"snarf_password$snarfnum"}, - } ); - $snarfnum++; - push @acct_snarf, $acct_snarf; - } - $svc_acct->child_objects( \@acct_snarf ); - - my $y = $svc_acct->setdefault; # arguably should be in new method - return { 'error' => $y } if $y && !ref($y); - - #$error = $svc_acct->check; - #return { 'error' => $error } if $error; - - #setup a job dependancy to delay provisioning - my $placeholder = new FS::queue ( { - 'job' => 'FS::ClientAPI::Signup::__placeholder', - 'status' => 'locked', - } ); - my $error = $placeholder->insert; - return { 'error' => $error } if $error; - - use Tie::RefHash; - tie my %hash, 'Tie::RefHash'; - %hash = ( $cust_pkg => [ $svc_acct ] ); - #msgcat - $error = $cust_main->insert( - \%hash, - \@invoicing_list, - 'depend_jobnum' => $placeholder->jobnum, - ); - if ( $error ) { - my $perror = $placeholder->delete; - $error .= " (Additionally, error removing placeholder: $perror)" if $perror; - return { 'error' => $error }; - } - - if ( $conf->exists('signup_server-realtime') ) { - - #warn "[fs_signup_server] Billing customer...\n" if $Debug; - - my $bill_error = $cust_main->bill; - #warn "[fs_signup_server] error billing new customer: $bill_error" - # if $bill_error; - - $cust_main->apply_payments; - $cust_main->apply_credits; - - $bill_error = $cust_main->collect; - #warn "[fs_signup_server] error collecting from new customer: $bill_error" - # if $bill_error; - - if ( $cust_main->balance > 0 ) { - - #this makes sense. credit is "un-doing" the invoice - $cust_main->credit( $cust_main->balance, 'signup server decline' ); - $cust_main->apply_credits; - - #should check list for errors... - #$cust_main->suspend; - local $FS::svc_Common::noexport_hack = 1; - $cust_main->cancel('quiet'=>1); - - my $perror = $placeholder->depended_delete; - warn "error removing provisioning jobs after decline: $perror" if $perror; - unless ( $perror ) { - $perror = $placeholder->delete; - warn "error removing placeholder after decline: $perror" if $perror; - } - - return { 'error' => '_decline' }; - } - - } - - if ( $reg_code ) { - $error = $reg_code->delete; - return { 'error' => $error } if $error; - } - - $error = $placeholder->delete; - return { 'error' => $error } if $error; - - return { error => '' }; - -} - -1; diff --git a/FS/FS/ClientAPI/passwd.pm b/FS/FS/ClientAPI/passwd.pm deleted file mode 100644 index b22d761..0000000 --- a/FS/FS/ClientAPI/passwd.pm +++ /dev/null @@ -1,46 +0,0 @@ -package FS::ClientAPI::passwd; - -use strict; -use FS::Record qw(qsearchs); -use FS::svc_acct; -use FS::svc_domain; - -sub passwd { - my $packet = shift; - - my $domain = $FS::ClientAPI::domain || $packet->{'domain'}; - my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } ) - or return { error => "Domain $domain not found" }; - - my $old_password = $packet->{'old_password'}; - my $new_password = $packet->{'new_password'}; - my $new_gecos = $packet->{'new_gecos'}; - my $new_shell = $packet->{'new_shell'}; - - #false laziness w/FS::ClientAPI::MyAccount::login - - my $svc_acct = qsearchs( 'svc_acct', { 'username' => $packet->{'username'}, - 'domsvc' => $svc_domain->svcnum, } - ); - return { error => 'User not found.' } unless $svc_acct; - return { error => 'Incorrect password.' } - unless $svc_acct->check_password($old_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/ClientAPI_SessionCache.pm b/FS/FS/ClientAPI_SessionCache.pm deleted file mode 100644 index b722484..0000000 --- a/FS/FS/ClientAPI_SessionCache.pm +++ /dev/null @@ -1,78 +0,0 @@ -package FS::ClientAPI_SessionCache; - -use strict; -use vars qw($module); -use FS::UID qw(datasrc); - -#ask FS::UID to run this stuff for us later -install_callback FS::UID sub { - my $conf = new FS::Conf; - $module = $conf->config('selfservice_server-cache_module') - || 'Cache::SharedMemoryCache'; -}; - -=head1 NAME - -FS::ClientAPI_SessionCache; - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -Minimal Cache::Cache-alike interface for storing session cache information. -Backends to Cache::SharedMemoryCache, Cache::FileCache, or an internal -implementation which stores information in the clientapi_session and -clientapi_session_field database tables. - -=head1 METHODS - -=over 4 - -=item new - -=cut - -sub new { - my $proto = shift; - my $class = ref($proto) || $proto; - unless ( $module =~ /^_Database$/ ) { - eval "use $module;"; - die $@ if $@; - my $self = $module->new(@_); - $self->set_cache_root('/usr/local/etc/freeside/clientapi_session.'.datasrc) - if $module =~ /^Cache::FileCache$/; - $self; - } else { - my $self = shift; - bless ($self, $class); - } -} - -sub get { - my($self, $session_id) = @_; - die '_Database self-service session cache not yet implemented'; -} - -sub set { - my($self, $session_id, $session, $expiration) = @_; - die '_Database self-service session cache not yet implemented'; -} - -sub remove { - my($self, $session_id) = @_; - die '_Database self-service session cache not yet implemented'; -} - -=back - -=head1 BUGS - -Minimal documentation. - -=head1 SEE ALSO - -L<Cache::Cache>, L<FS::clientapi_session>, L<FS::clientapi_session_field> - -=cut - -1; diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm deleted file mode 100644 index f649511..0000000 --- a/FS/FS/Conf.pm +++ /dev/null @@ -1,1758 +0,0 @@ -package FS::Conf; - -use vars qw($default_dir @config_items $DEBUG ); -use IO::File; -use File::Basename; -use FS::ConfItem; -use FS::ConfDefaults; - -$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 config_binary KEY - -Returns the exact scalar value for key. - -=cut - -sub config_binary { - my($self,$file)=@_; - my($dir)=$self->dir; - my $fh = new IO::File "<$dir/$file" or return; - local $/; - my $content = <$fh>; - $content; -} - -=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 config_orbase KEY SUFFIX - -Returns the configuration value or values (depending on context) for -KEY_SUFFIX, if it exists, otherwise for KEY - -=cut - -sub config_orbase { - my( $self, $file, $suffix ) = @_; - if ( $self->exists("${file}_$suffix") ) { - $self->config("${file}_$suffix"); - } else { - $self->config($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<FS::ConfItem>. - -=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 <a href="../docs/billing.html">billing documentation</a> for details.', - 'type' => 'textarea', - } - } glob($self->dir. '/invoice_template_*') - ), - ( map { - my $basename = basename($_); - $basename =~ /^(.*)$/; - $basename = $1; - new FS::ConfItem { - 'key' => $basename, - 'section' => 'billing', - 'description' => 'Alternate HTML template for invoices. See the <a href="../docs/billing.html">billing documentation</a> for details.', - 'type' => 'textarea', - } - } glob($self->dir. '/invoice_html_*') - ), - ( map { - my $basename = basename($_); - $basename =~ /^(.*)$/; - $basename = $1; - ($latexname = $basename ) =~ s/latex/html/; - new FS::ConfItem { - 'key' => $basename, - 'section' => 'billing', - 'description' => "Alternate Notes section for HTML invoices. Defaults to the same data in $latexname if not specified.", - 'type' => 'textarea', - } - } glob($self->dir. '/invoice_htmlnotes_*') - ), - ( map { - my $basename = basename($_); - $basename =~ /^(.*)$/; - $basename = $1; - new FS::ConfItem { - 'key' => $basename, - 'section' => 'billing', - 'description' => 'Alternate LaTeX template for invoices. See the <a href="../docs/billing.html">billing documentation</a> for details.', - 'type' => 'textarea', - } - } glob($self->dir. '/invoice_latex_*') - ), - ( map { - my $basename = basename($_); - $basename =~ /^(.*)$/; - $basename = $1; - new FS::ConfItem { - 'key' => $basename, - 'section' => 'billing', - 'description' => 'Alternate Notes section for LaTeX typeset PostScript invoices. See the <a href="../docs/billing.html">billing documentation</a> for details.', - 'type' => 'textarea', - } - } glob($self->dir. '/invoice_latexnotes_*') - ); -} - -=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 <a href="#invoice_template">invoice_template</a> instead.', - 'type' => 'text', - }, - - { - 'key' => 'alerter_template', - 'section' => 'billing', - 'description' => 'Template file for billing method expiration alerts. See the <a href="../docs/billing.html#invoice_template">billing documentation</a> for details.', - 'type' => 'textarea', - }, - - { - 'key' => 'apacheroot', - 'section' => 'deprecated', - 'description' => '<b>DEPRECATED</b>, add a <i>www_shellcommands</i> <a href="../browse/part_export.cgi">export</a> instead. The directory containing Apache virtual hosts', - 'type' => 'text', - }, - - { - 'key' => 'apacheip', - 'section' => 'deprecated', - 'description' => '<b>DEPRECATED</b>, add an <i>apache</i> <a href="../browse/part_export.cgi">export</a> instead. Used to be the current IP address to assign to new virtual hosts', - 'type' => 'text', - }, - - { - 'key' => 'apachemachine', - 'section' => 'deprecated', - 'description' => '<b>DEPRECATED</b>, add a <i>www_shellcommands</i> <a href="../browse/part_export.cgi">export</a> 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' => 'deprecated', - 'description' => '<b>DEPRECATED</b>, add an <i>apache</i> <a href="../browse/part_export.cgi">export</a> instead. Used to be Apache machines, one per line. This enables export of `/etc/apache/vhosts.conf\', which can be included in your Apache configuration via the <a href="http://www.apache.org/docs/mod/core.html#include">Include</a> directive.', - 'type' => 'textarea', - }, - - { - 'key' => 'bindprimary', - 'section' => 'deprecated', - 'description' => '<b>DEPRECATED</b>, add a <i>bind</i> <a href="../browse/part_export.cgi">export</a> 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' => '<b>DEPRECATED</b>, add a <i>bind_slave</i> <a href="../browse/part_export.cgi">export</a> instead. Your BIND secondary nameservers, one per line. This enables export of /var/named/named.conf', - 'type' => 'textarea', - }, - - { - 'key' => 'encryption', - 'section' => 'billing', - 'description' => 'Enable encryption of credit cards.', - 'type' => 'checkbox', - }, - - { - 'key' => 'encryptionmodule', - 'section' => 'billing', - 'description' => 'Use which module for encryption?', - 'type' => 'text', - }, - - { - 'key' => 'encryptionpublickey', - 'section' => 'billing', - 'description' => 'Your RSA Public Key - Required if Encryption is turned on.', - 'type' => 'textarea', - }, - - { - 'key' => 'encryptionprivatekey', - 'section' => 'billing', - 'description' => 'Your RSA Private Key - Including this will enable the "Bill Now" feature. However if the system is compromised, a hacker can use this key to decode the stored credit card information. This is generally not a good idea.', - 'type' => 'textarea', - }, - - { - 'key' => 'business-onlinepayment', - 'section' => 'billing', - 'description' => '<a href="http://search.cpan.org/search?mode=module&query=Business%3A%3AOnlinePayment">Business::OnlinePayment</a> 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-ach', - 'section' => 'billing', - 'description' => 'Alternate <a href="http://search.cpan.org/search?mode=module&query=Business%3A%3AOnlinePayment">Business::OnlinePayment</a> support for ACH transactions (defaults to regular <b>business-onlinepayment</b>). 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 <a href="http://search.cpan.org/search?mode=module&query=Business%3A%3AOnlinePayment">Business::OnlinePayment</a>. Evaluated as a double-quoted perl string, with the following variables available: <code>$agent</code> (the agent name), and <code>$pkgs</code> (a comma-separated list of packages for which these charges apply)', - 'type' => 'text', - }, - - { - 'key' => 'business-onlinepayment-email-override', - 'section' => 'billing', - 'description' => 'Email address used instead of customer email address when submitting a BOP transaction.', - 'type' => 'text', - }, - - { - 'key' => 'bsdshellmachines', - 'section' => 'deprecated', - 'description' => '<b>DEPRECATED</b>, add a <i>bsdshell</i> <a href="../browse/part_export.cgi">export</a> 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' => 'cyrus', - 'section' => 'deprecated', - 'description' => '<b>DEPRECATED</b>, add a <i>cyrus</i> <a href="../browse/part_export.cgi">export</a> instead. This option used to integrate with <a href="http://asg.web.cmu.edu/cyrus/imapd/">Cyrus IMAP Server</a>, 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' => '<b>DEPRECATED</b>, add a <i>cp</i> <a href="../browse/part_export.cgi">export</a> instead. This option used to integrate with <a href="http://www.cp.net/">Critial Path Account Provisioning Protocol</a>, 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' => 'billing', - 'description' => 'Enable deletion of unclosed payments. Really, with voids this is pretty much not recommended in any situation anymore. 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' => 'deletecredits', - 'section' => 'deprecated', - 'description' => '<B>DEPRECATED</B>, now controlled by ACLs. Used to enable deletion of unclosed credits. Be very careful! Only delete credits that were data-entry errors, not adjustments. Optionally specify one or more comma-separated email addresses to be notified when a credit is deleted.', - 'type' => [qw( checkbox text )], - }, - - { - 'key' => 'unapplypayments', - 'section' => 'deprecated', - 'description' => '<B>DEPRECATED</B>, now controlled by ACLs. Used to enable "unapplication" of unclosed payments.', - 'type' => 'checkbox', - }, - - { - 'key' => 'unapplycredits', - 'section' => 'deprecated', - 'description' => '<B>DEPRECATED</B>, now controlled by ACLs. Used to nable "unapplication" of unclosed credits.', - 'type' => 'checkbox', - }, - - { - 'key' => 'dirhash', - 'section' => 'shell', - 'description' => 'Optional numeric value to control directory hashing. If positive, hashes directories for the specified number of levels from the front of the username. If negative, hashes directories for the specified number of levels from the end of the username. Some examples: <ul><li>1: user -> <a href="#home">/home</a>/u/user<li>2: user -> <a href="#home">/home</a>/u/s/user<li>-1: user -> <a href="#home">/home</a>/r/user<li>-2: user -> <a href="#home">home</a>/r/e/user</ul>', - 'type' => 'text', - }, - - { - 'key' => 'disable_customer_referrals', - 'section' => 'UI', - 'description' => 'Disable new customer-to-customer referrals in the web interface', - 'type' => 'checkbox', - }, - - { - '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 <a href ="#emailinvoiceauto">emailinvoiceauto</a>.', - 'type' => 'checkbox', - }, - - { - 'key' => 'emailinvoiceauto', - 'section' => 'billing', - 'description' => 'Automatically adds new accounts to the email invoice list', - 'type' => 'checkbox', - }, - - { - 'key' => 'exclude_ip_addr', - 'section' => '', - 'description' => 'Exclude these from the list of available broadband service IP addresses. (One per line)', - 'type' => 'textarea', - }, - - { - 'key' => 'erpcdmachines', - 'section' => 'deprecated', - 'description' => '<b>DEPRECATED</b>, ERPCD is no longer supported. Used to be ERPCD authentication 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' => '<b>DEPRECATED</b>, add an <i>sqlradius</i> <a href="../browse/part_export.cgi">export</a> instead. This option used to enable radcheck and radreply table population - by default in the Freeside database, or in the database specified by the <a href="http://rootwood.haze.st/aspside/config/config-view.cgi#icradius_secrets">icradius_secrets</a> 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. <blockquote><b>ADDITIONAL DEPRECATED FUNCTIONALITY</b> (instead use <a href="http://www.mysql.com/documentation/mysql/bychapter/manual_MySQL_Database_Administration.html#Replication">MySQL replication</a> or point icradius_secrets to the external database) - your <a href="ftp://ftp.cheapnet.net/pub/icradius">ICRADIUS</a> machines or <a href="http://www.freeradius.org/">FreeRADIUS</a> (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: <CODE>"radius.isp.tld radius_db radius_user passw0rd"</CODE></blockquote>', - 'type' => [qw( checkbox textarea )], - }, - - { - 'key' => 'icradius_mysqldest', - 'section' => 'deprecated', - 'description' => '<b>DEPRECATED</b>, add an <i>sqlradius</i> <a href="../browse/part_export.cgi">export</a> 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' => '<b>DEPRECATED</b>, add an <i>sqlradius</i> <a href="../browse/part_export.cgi">export</a> 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' => '<b>DEPRECATED</b>, add an <i>sqlradius</i> <a href="../browse/part_export.cgi">export</a> 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 <a href="../docs/billing.html">billing documentation</a> for details.', - 'type' => 'textarea', - }, - - { - 'key' => 'invoice_html', - 'section' => 'billing', - 'description' => 'Optional HTML template for invoices. See the <a href="../docs/billing.html">billing documentation</a> for details.', - - 'type' => 'textarea', - }, - - { - 'key' => 'invoice_htmlnotes', - 'section' => 'billing', - 'description' => 'Notes section for HTML invoices. Defaults to the same data in invoice_latexnotes if not specified.', - 'type' => 'textarea', - }, - - { - 'key' => 'invoice_htmlfooter', - 'section' => 'billing', - 'description' => 'Footer for HTML invoices. Defaults to the same data in invoice_latexfooter if not specified.', - 'type' => 'textarea', - }, - - { - 'key' => 'invoice_htmlreturnaddress', - 'section' => 'billing', - 'description' => 'Return address for HTML invoices. Defaults to the same data in invoice_latexreturnaddress if not specified.', - 'type' => 'textarea', - }, - - { - 'key' => 'invoice_latex', - 'section' => 'billing', - 'description' => 'Optional LaTeX template for typeset PostScript invoices. See the <a href="../docs/billing.html">billing documentation</a> for details.', - 'type' => 'textarea', - }, - - { - 'key' => 'invoice_latexnotes', - 'section' => 'billing', - 'description' => 'Notes section for LaTeX typeset PostScript invoices.', - 'type' => 'textarea', - }, - - { - 'key' => 'invoice_latexfooter', - 'section' => 'billing', - 'description' => 'Footer for LaTeX typeset PostScript invoices.', - 'type' => 'textarea', - }, - - { - 'key' => 'invoice_latexreturnaddress', - 'section' => 'billing', - 'description' => 'Return address for LaTeX typeset PostScript invoices.', - 'type' => 'textarea', - }, - - { - 'key' => 'invoice_latexsmallfooter', - 'section' => 'billing', - 'description' => 'Optional small footer for multi-page LaTeX typeset PostScript invoices.', - 'type' => 'textarea', - }, - - { - 'key' => 'invoice_email_pdf', - 'section' => 'billing', - 'description' => 'Send PDF invoice as an attachment to emailed invoices. By default, includes the plain text invoice as the email body, unless invoice_email_pdf_note is set.', - 'type' => 'checkbox' - }, - - { - 'key' => 'invoice_email_pdf_note', - 'section' => 'billing', - 'description' => 'If defined, this text will replace the default plain text invoice as the body of emailed PDF invoices.', - 'type' => 'textarea' - }, - - - { - 'key' => 'invoice_default_terms', - 'section' => 'billing', - 'description' => 'Optional default invoice term, used to calculate a due date printed on invoices.', - 'type' => 'select', - 'select_enum' => [ '', 'Payable upon receipt', 'Net 0', 'Net 10', 'Net 15', 'Net 30', 'Net 45', 'Net 60' ], - }, - - { - 'key' => 'invoice_send_receipts', - 'section' => 'deprecated', - 'description' => '<b>DEPRECATED</b>, this used to send an invoice copy on payments and credits. See the payment_receipt_email and XXXX instead.', - 'type' => 'checkbox', - }, - - { - 'key' => 'payment_receipt_email', - 'section' => 'billing', - 'description' => 'Template file for payment receipts. Payment receipts are sent to the customer email invoice destination(s) when a payment is received. See the <a href="http://search.cpan.org/~mjd/Text-Template/lib/Text/Template.pm">Text::Template</a> documentation for details on the template substitution language. The following variables are available: <ul><li><code>$date</code> <li><code>$name</code> <li><code>$paynum</code> - Freeside payment number <li><code>$paid</code> - Amount of payment <li><code>$payby</code> - Payment type (Card, Check, Electronic check, etc.) <li><code>$payinfo</code> - Masked credit card number or check number <li><code>$balance</code> - New balance</ul>', - 'type' => 'textarea', - }, - - { - 'key' => 'lpr', - 'section' => 'required', - 'description' => 'Print command for paper invoices, for example `lpr -h\'', - 'type' => 'text', - }, - - { - 'key' => 'maildisablecatchall', - 'section' => 'deprecated', - 'description' => '<b>DEPRECATED</b>, 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 TXT)} }, - { 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' => '<b>DEPRECATED</b>. 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' => 'password-noampersand', - 'section' => 'password', - 'description' => 'Disallow ampersands in passwords', - 'type' => 'checkbox', - }, - - { - 'key' => 'password-noexclamation', - 'section' => 'password', - 'description' => 'Disallow exclamations in passwords (Not setting this could break old text Livingston or Cistron Radius servers)', - 'type' => 'checkbox', - }, - - { - 'key' => 'qmailmachines', - 'section' => 'deprecated', - 'description' => '<b>DEPRECATED</b>, add <i>qmail</i> and <i>shellcommands</i> <a href="../browse/part_export.cgi">exports</a> instead. This option used to export `/var/qmail/control/virtualdomains\', `/var/qmail/control/recipientmap\', and `/var/qmail/control/rcpthosts\'. Setting this option (even if empty) also turns on user `.qmail-extension\' file maintenance in conjunction with the <b>shellmachine</b> option.', - 'type' => [qw( checkbox textarea )], - }, - - { - 'key' => 'radiusmachines', - 'section' => 'deprecated', - 'description' => '<b>DEPRECATED</b>, add an <i>sqlradius</i> <a href="../browse/part_export.cgi">export</a> 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' => 'deprecated', - 'description' => 'Deprecated template file for reports.', - 'type' => 'textarea', - }, - - - { - 'key' => 'maxsearchrecordsperpage', - 'section' => 'UI', - 'description' => 'If set, number of search records to return per page.', - 'type' => 'text', - }, - - { - 'key' => 'sendmailconfigpath', - 'section' => 'deprecated', - 'description' => '<b>DEPRECATED</b>, add a <i>sendmail</i> <a href="../browse/part_export.cgi">export</a> instead. Used to be sendmail configuration file path. Defaults to `/etc\'. Many newer distributions use `/etc/mail\'.', - 'type' => 'text', - }, - - { - 'key' => 'sendmailmachines', - 'section' => 'deprecated', - 'description' => '<b>DEPRECATED</b>, add a <i>sendmail</i> <a href="../browse/part_export.cgi">export</a> instead. Used to be sendmail machines, one per line. This enables export of `/etc/virtusertable\' and `/etc/sendmail.cw\'.', - 'type' => 'textarea', - }, - - { - 'key' => 'sendmailrestart', - 'section' => 'deprecated', - 'description' => '<b>DEPRECATED</b>, add a <i>sendmail</i> <a href="../browse/part_export.cgi">export</a> instead. Used to define 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: <code>$ip</code>, <code>$nasip</code> and <code>$nasfqdn</code>, which are the IP address of the starting session, and the IP address and fully-qualified domain name of the NAS this session is on.', - '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: <code>$ip</code>, <code>$nasip</code> and <code>$nasfqdn</code>, which are the IP address of the starting session, and the IP address and fully-qualified domain name of the NAS this session is on.', - 'type' => 'text', - }, - - { - 'key' => 'shellmachine', - 'section' => 'deprecated', - 'description' => '<b>DEPRECATED</b>, add a <i>shellcommands</i> <a href="../browse/part_export.cgi">export</a> 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' => '<b>DEPRECATED</b>, add a <i>shellcommands</i> <a href="../browse/part_export.cgi">export</a> instead. This option used to contain command(s) to run on shellmachine when an account is created. If the <b>shellmachine</b> option is set but this option is not, <code>useradd -d $dir -m -s $shell -u $uid $username</code> is the default. If this option is set but empty, <code>cp -pr /etc/skel $dir; chown -R $uid.$gid $dir</code> is the default instead. Otherwise the value is evaluated as a double-quoted perl string, with the following variables available: <code>$username</code>, <code>$uid</code>, <code>$gid</code>, <code>$dir</code>, and <code>$shell</code>.', - 'type' => [qw( checkbox text )], - }, - - { - 'key' => 'shellmachine-userdel', - 'section' => 'deprecated', - 'description' => '<b>DEPRECATED</b>, add a <i>shellcommands</i> <a href="../browse/part_export.cgi">export</a> instead. This option used to contain command(s) to run on shellmachine when an account is deleted. If the <b>shellmachine</b> option is set but this option is not, <code>userdel $username</code> is the default. If this option is set but empty, <code>rm -rf $dir</code> is the default instead. Otherwise the value is evaluated as a double-quoted perl string, with the following variables available: <code>$username</code> and <code>$dir</code>.', - 'type' => [qw( checkbox text )], - }, - - { - 'key' => 'shellmachine-usermod', - 'section' => 'deprecated', - 'description' => '<b>DEPRECATED</b>, add a <i>shellcommands</i> <a href="../browse/part_export.cgi">export</a> instead. This option used to contain command(s) to run on shellmachine when an account is modified. If the <b>shellmachine</b> option is set but this option is empty, <code>[ -d $old_dir ] && mv $old_dir $new_dir || ( chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; find . -depth -print | cpio -pdm $new_dir; chmod u-t $new_dir; chown -R $uid.$gid $new_dir; rm -rf $old_dir )</code> is the default. Otherwise the contents of the file are treated as a double-quoted perl string, with the following variables available: <code>$old_dir</code>, <code>$new_dir</code>, <code>$uid</code> and <code>$gid</code>.', - #'type' => [qw( checkbox text )], - 'type' => 'text', - }, - - { - 'key' => 'shellmachines', - 'section' => 'deprecated', - 'description' => '<b>DEPRECATED</b>, add a <i>sysvshell</i> <a href="../browse/part_export.cgi">export</a> 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 backend (employee) web interface', - 'type' => 'checkbox', - }, - - { - 'key' => 'signupurl', - 'section' => 'UI', - 'description' => 'if you are using customer-to-customer referrals, and you enter the URL of your <a href="../docs/signup.html">signup server CGI</a>, 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' => '<b>DEPRECATED</b>, 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' => '<b>DEPRECATED</b>, 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 <a href="../browse/part_export.cgi">exports</a> 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-percent', - 'section' => 'username', - 'description' => 'Allow the percent character (%) in usernames.', - 'type' => 'checkbox', - }, - - { - 'key' => 'username_policy', - 'section' => 'deprecated', - 'description' => 'This file controls the mechanism for preventing duplicate usernames in passwd/radius files exported from svc_accts. This should be one of \'prepend domsvc\' \'append domsvc\' \'append domain\' or \'append @domain\'', - 'type' => 'select', - 'select_enum' => [ 'prepend domsvc', 'append domsvc', 'append domain', 'append @domain' ], - #'type' => 'text', - }, - - { - 'key' => 'vpopmailmachines', - 'section' => 'deprecated', - 'description' => '<b>DEPRECATED</b>, add a <i>vpopmail</i> <a href="../browse/part_export.cgi">export</a> 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: <code>poptoaster.domain.tld /home/vpopmail 508 508</code> Note: vpopuid and vpopgid are values taken from the vpopmail machine\'s /etc/passwd', - 'type' => 'textarea', - }, - - { - 'key' => 'vpopmailrestart', - 'section' => 'deprecated', - 'description' => '<b>DEPRECATED</b>, add a <i>vpopmail</i> <a href="../browse/part_export.cgi">export</a> instead. This option used to define the shell commands to run on vpopmail machines after files are copied. An example can be found in eg/vpopmailrestart of the source distribution.', - 'type' => 'textarea', - }, - - { - 'key' => 'safe-part_pkg', - 'section' => 'deprecated', - 'description' => '<b>DEPRECATED</b>, obsolete. Used to validate 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' => 'legacy_link-steal', - 'section' => 'UI', - 'description' => 'Allow "stealing" an already-audited service from one customer (or package) to another using the link function.', - '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' => 'selfservice_server-quiet', - 'section' => 'deprecated', - 'description' => '<b>DEPRECATED</b>, the self-service server no longer sends superfluous decline and cancel emails. Used to disable decline and cancel emails generated by transactions initiated by the selfservice server.', - 'type' => 'checkbox', - }, - - { - 'key' => 'signup_server-quiet', - 'section' => 'deprecated', - 'description' => '<b>DEPRECATED</b>, the signup server is now part of the self-service server and no longer sends superfluous decline and cancel emails. Used to disable decline and cancel emails generated by transactions initiated by the signup server. Does not disable welcome emails.', - 'type' => 'checkbox', - }, - - { - 'key' => 'signup_server-payby', - 'section' => '', - 'description' => 'Acceptable payment types for the signup server', - 'type' => 'selectmultiple', - 'select_enum' => [ qw(CARD DCRD CHEK DCHK LECB PREPAY BILL COMP) ], - }, - - { - 'key' => 'signup_server-email', - 'section' => 'deprecated', - 'description' => '<b>DEPRECATED</b>, this feature is no longer available. See the ***fill me in*** report instead. Used to contain a comma-separated list of email addresses to receive notification of signups via the signup server.', - 'type' => 'text', - }, - - { - 'key' => 'signup_server-default_agentnum', - 'section' => '', - 'description' => 'Default agentnum for the signup server', - 'type' => 'text', - }, - - { - 'key' => 'signup_server-default_refnum', - 'section' => '', - 'description' => 'Default advertising source number for 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 do not provision accounts which subsequently have a balance.', - 'type' => 'checkbox', - }, - - { - 'key' => 'backend-realtime', - 'section' => '', - 'description' => 'Run billing for backend signups immediately.', - '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' => 'emaildecline-exclude', - 'section' => 'billing', - 'description' => 'List of error messages that should not trigger email decline notices, one per line.', - 'type' => 'textarea', - }, - - { - 'key' => 'cancelmessage', - 'section' => 'billing', - 'description' => 'Template file for cancellation emails.', - 'type' => 'textarea', - }, - - { - 'key' => 'cancelsubject', - 'section' => 'billing', - 'description' => 'Subject line for cancellation emails.', - 'type' => 'text', - }, - - { - 'key' => 'emailcancel', - 'section' => 'billing', - 'description' => 'Enable emailing of cancellation notices.', - 'type' => 'checkbox', - }, - - { - 'key' => 'require_cardname', - 'section' => 'billing', - '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' => 'require_taxclasses', - 'section' => 'billing', - 'description' => 'Require a taxclass to be entered for every package', - '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 <a href="http://search.cpan.org/~mjd/Text-Template/lib/Text/Template.pm">Text::Template</a> documentation for details on the template substitution language. The following variables are available<ul><li><code>$username</code> <li><code>$password</code> <li><code>$first</code> <li><code>$last</code> <li><code>$pkg</code></ul>', - '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' ], - }, - - { - 'key' => 'payby', - 'section' => 'billing', - 'description' => 'Available payment types.', - 'type' => 'selectmultiple', - 'select_enum' => [ qw(CARD DCRD CHEK DCHK LECB BILL CASH WEST MCRD COMP) ], - }, - - { - 'key' => 'payby-default', - 'section' => 'UI', - 'description' => 'Default payment type. HIDE disables display of billing information and sets customers to BILL.', - 'type' => 'select', - 'select_enum' => [ '', qw(CARD DCRD CHEK DCHK LECB BILL CASH WEST MCRD COMP HIDE) ], - }, - - { - 'key' => 'svc_acct-notes', - 'section' => 'UI', - 'description' => 'Extra HTML to be displayed on the Account View screen.', - 'type' => 'textarea', - }, - - { - 'key' => 'radius-password', - 'section' => '', - 'description' => 'RADIUS attribute for plain-text passwords.', - 'type' => 'select', - 'select_enum' => [ 'Password', 'User-Password' ], - }, - - { - 'key' => 'radius-ip', - 'section' => '', - 'description' => 'RADIUS attribute for IP addresses.', - 'type' => 'select', - 'select_enum' => [ 'Framed-IP-Address', 'Framed-Address' ], - }, - - { - 'key' => 'svc_acct-alldomains', - 'section' => '', - 'description' => 'Allow accounts to select any domain in the database. Normally accounts can only select from the domain set in the service definition and those purchased by the customer.', - 'type' => 'checkbox', - }, - - { - 'key' => 'dump-scpdest', - 'section' => '', - 'description' => 'destination for scp database dumps: user@host:/path', - 'type' => 'text', - }, - - { - 'key' => 'dump-pgpid', - 'section' => '', - 'description' => "Optional PGP public key user or key id for database dumps. The public key should exist on the freeside user's public keyring, and the gpg binary and GnuPG perl module should be installed.", - 'type' => 'text', - }, - - { - 'key' => 'users-allow_comp', - 'section' => 'deprecated', - 'description' => '<b>DEPRECATED</b>, enable the <i>Complimentary customer</i> access right instead. Was: Usernames (Freeside users, created with <a href="../docs/man/bin/freeside-adduser.html">freeside-adduser</a>) which can create complimentary customers, one per line. If no usernames are entered, all users can create complimentary accounts.', - 'type' => 'textarea', - }, - - { - 'key' => 'cvv-save', - 'section' => 'billing', - 'description' => 'Save CVV2 information after the initial transaction for the selected credit card types. Enabling this option may be in violation of your merchant agreement(s), so please check them carefully before enabling this option for any credit card types.', - 'type' => 'selectmultiple', - 'select_enum' => [ "VISA card", - "MasterCard", - "Discover card", - "American Express card", - "Diner's Club/Carte Blanche", - "enRoute", - "JCB", - "BankCard", - ], - }, - - { - 'key' => 'allow_negative_charges', - 'section' => 'billing', - 'description' => 'Allow negative charges. Normally not used unless importing data from a legacy system that requires this.', - 'type' => 'checkbox', - }, - { - 'key' => 'auto_unset_catchall', - 'section' => '', - 'description' => 'When canceling a svc_acct that is the email catchall for one or more svc_domains, automatically set their catchall fields to null. If this option is not set, the attempt will simply fail.', - 'type' => 'checkbox', - }, - - { - 'key' => 'system_usernames', - 'section' => 'username', - 'description' => 'A list of system usernames that cannot be edited or removed, one per line. Use a bare username to prohibit modification/deletion of the username in any domain, or username@domain to prohibit modification/deletetion of a specific username and domain.', - 'type' => 'textarea', - }, - - { - 'key' => 'cust_pkg-change_svcpart', - 'section' => '', - 'description' => "When changing packages, move services even if svcparts don't match between old and new pacakge definitions.", - 'type' => 'checkbox', - }, - - { - 'key' => 'disable_autoreverse', - 'section' => 'BIND', - 'description' => 'Disable automatic synchronization of reverse-ARPA entries.', - 'type' => 'checkbox', - }, - - { - 'key' => 'svc_www-enable_subdomains', - 'section' => '', - 'description' => 'Enable selection of specific subdomains for virtual host creation.', - 'type' => 'checkbox', - }, - - { - 'key' => 'svc_www-usersvc_svcpart', - 'section' => '', - 'description' => 'Allowable service definition svcparts for virtual hosts, one per line.', - 'type' => 'textarea', - }, - - { - 'key' => 'selfservice_server-primary_only', - 'section' => '', - 'description' => 'Only allow primary accounts to access self-service functionality.', - 'type' => 'checkbox', - }, - - { - 'key' => 'card_refund-days', - 'section' => 'billing', - 'description' => 'After a payment, the number of days a refund link will be available for that payment. Defaults to 120.', - 'type' => 'text', - }, - - { - 'key' => 'agent-showpasswords', - 'section' => '', - 'description' => 'Display unencrypted user passwords in the agent (reseller) interface', - 'type' => 'checkbox', - }, - - { - 'key' => 'global_unique-username', - 'section' => 'username', - 'description' => 'Global username uniqueness control: none (usual setting - check uniqueness per exports), username (all usernames are globally unique, regardless of domain or exports), or username@domain (all username@domain pairs are globally unique, regardless of exports). disabled turns off duplicate checking completely and is STRONGLY NOT RECOMMENDED unless you REALLY need to turn this off.', - 'type' => 'select', - 'select_enum' => [ 'none', 'username', 'username@domain', 'disabled' ], - }, - - { - 'key' => 'svc_external-skip_manual', - 'section' => 'UI', - 'description' => 'When provisioning svc_external services, skip manual entry of id and title fields in the UI. Usually used in conjunction with an export that populates these fields (i.e. artera_turbo).', - 'type' => 'checkbox', - }, - - { - 'key' => 'svc_external-display_type', - 'section' => 'UI', - 'description' => 'Select a specific svc_external type to enable some UI changes specific to that type (i.e. artera_turbo).', - 'type' => 'select', - 'select_enum' => [ 'generic', 'artera_turbo', ], - }, - - { - 'key' => 'ticket_system', - 'section' => '', - 'description' => 'Ticketing system integration. <b>RT_Internal</b> uses the built-in RT ticketing system (see the <a href="../docs/install-rt">integrated ticketing installation instructions</a>). <b>RT_External</b> accesses an external RT installation in a separate database (local or remote).', - 'type' => 'select', - #'select_enum' => [ '', qw(RT_Internal RT_Libs RT_External) ], - 'select_enum' => [ '', qw(RT_Internal RT_External) ], - }, - - { - 'key' => 'ticket_system-default_queueid', - 'section' => '', - 'description' => 'Default queue used when creating new customer tickets.', - 'type' => 'select-sub', - 'options_sub' => sub { - my $conf = new FS::Conf; - if ( $conf->config('ticket_system') ) { - eval "use FS::TicketSystem;"; - die $@ if $@; - FS::TicketSystem->queues(); - } else { - (); - } - }, - 'option_sub' => sub { - my $conf = new FS::Conf; - if ( $conf->config('ticket_system') ) { - eval "use FS::TicketSystem;"; - die $@ if $@; - FS::TicketSystem->queue(shift); - } else { - ''; - } - }, - }, - - { - 'key' => 'ticket_system-custom_priority_field', - 'section' => '', - 'description' => 'Custom field from the ticketing system to use as a custom priority classification.', - 'type' => 'text', - }, - - { - 'key' => 'ticket_system-custom_priority_field-values', - 'section' => '', - 'description' => 'Values for the custom field from the ticketing system to break down and sort customer ticket lists.', - 'type' => 'textarea', - }, - - { - 'key' => 'ticket_system-custom_priority_field_queue', - 'section' => '', - 'description' => 'Ticketing system queue in which the custom field specified in ticket_system-custom_priority_field is located.', - 'type' => 'text', - }, - - { - 'key' => 'ticket_system-rt_external_datasrc', - 'section' => '', - 'description' => 'With external RT integration, the DBI data source for the external RT installation, for example, <code>DBI:Pg:user=rt_user;password=rt_word;host=rt.example.com;dbname=rt</code>', - 'type' => 'text', - - }, - - { - 'key' => 'ticket_system-rt_external_url', - 'section' => '', - 'description' => 'With external RT integration, the URL for the external RT installation, for example, <code>https://rt.example.com/rt</code>', - 'type' => 'text', - }, - - { - 'key' => 'company_name', - 'section' => 'required', - 'description' => 'Your company name', - 'type' => 'text', - }, - - { - 'key' => 'echeck-void', - 'section' => 'deprecated', - 'description' => '<B>DEPRECATED</B>, now controlled by ACLs. Used to enable local-only voiding of echeck payments in addition to refunds against the payment gateway', - 'type' => 'checkbox', - }, - - { - 'key' => 'cc-void', - 'section' => 'deprecated', - 'description' => '<B>DEPRECATED</B>, now controlled by ACLs. Used to enable local-only voiding of credit card payments in addition to refunds against the payment gateway', - 'type' => 'checkbox', - }, - - { - 'key' => 'unvoid', - 'section' => 'deprecated', - 'description' => '<B>DEPRECATED</B>, now controlled by ACLs. Used to enable unvoiding of voided payments', - 'type' => 'checkbox', - }, - - { - 'key' => 'address2-search', - 'section' => 'UI', - 'description' => 'Enable a "Unit" search box which searches the second address field', - 'type' => 'checkbox', - }, - - { 'key' => 'referral_credit', - 'section' => 'billing', - 'description' => "Enables one-time referral credits in the amount of one month <i>referred</i> customer's recurring fee (irregardless of frequency).", - 'type' => 'checkbox', - }, - - { 'key' => 'selfservice_server-cache_module', - 'section' => '', - 'description' => 'Module used to store self-service session information. All modules handle any number of self-service servers. Cache::SharedMemoryCache is appropriate for a single database / single Freeside server. Cache::FileCache is useful for multiple databases on a single server, or when IPC::ShareLite is not available (i.e. FreeBSD).', # _Database stores session information in the database and is appropriate for multiple Freeside servers, but may be slower.', - 'type' => 'select', - 'select_enum' => [ 'Cache::SharedMemoryCache', 'Cache::FileCache', ], # '_Database' ], - }, - - { - 'key' => 'hylafax', - 'section' => '', - 'description' => 'Options for a HylaFAX server to enable the FAX invoice destination. They should be in the form of a space separated list of arguments to the Fax::Hylafax::Client::sendfax subroutine. You probably shouldn\'t override things like \'docfile\'. *Note* Only supported when using typeset invoices (see the invoice_latex configuration option).', - 'type' => [qw( checkbox textarea )], - }, - - { - 'key' => 'svc_acct-usage_suspend', - 'section' => 'billing', - 'description' => 'Suspends the package an account belongs to when svc_acct.seconds is decremented to 0 or below (accounts with an empty seconds value are ignored). Typically used in conjunction with prepaid packages and freeside-sqlradius-radacctd.', - 'type' => 'checkbox', - }, - - { - 'key' => 'svc_acct-usage_unsuspend', - 'section' => 'billing', - 'description' => 'Unuspends the package an account belongs to when svc_acct.seconds is incremented from 0 or below to a positive value (accounts with an empty seconds value are ignored). Typically used in conjunction with prepaid packages and freeside-sqlradius-radacctd.', - 'type' => 'checkbox', - }, - - { - 'key' => 'cust-fields', - 'section' => 'UI', - 'description' => 'Which customer fields to display on reports by default', - 'type' => 'select', - 'select_hash' => [ FS::ConfDefaults->cust_fields_avail() ], - }, - - { - 'key' => 'cust_pkg-display_times', - 'section' => 'UI', - 'description' => 'Display full timestamps (not just dates) for customer packages. Useful if you are doing real-time things like hourly prepaid.', - 'type' => 'checkbox', - }, - - { - 'key' => 'svc_acct-edit_uid', - 'section' => 'shell', - 'description' => 'Allow UID editing.', - 'type' => 'checkbox', - }, - - { - 'key' => 'svc_acct-edit_gid', - 'section' => 'shell', - 'description' => 'Allow GID editing.', - 'type' => 'checkbox', - }, - - { - 'key' => 'zone-underscore', - 'section' => 'BIND', - 'description' => 'Allow underscores in zone names. As underscores are illegal characters in zone names, this option is not recommended.', - 'type' => 'checkbox', - }, - - #these should become per-user... - { - 'key' => 'vonage-username', - 'section' => '', - 'description' => 'Vonage Click2Call username (see <a href="https://secure.click2callu.com/">https://secure.click2callu.com/</a>)', - 'type' => 'text', - }, - { - 'key' => 'vonage-password', - 'section' => '', - 'description' => 'Vonage Click2Call username (see <a href="https://secure.click2callu.com/">https://secure.click2callu.com/</a>)', - 'type' => 'text', - }, - { - 'key' => 'vonage-fromnumber', - 'section' => '', - 'description' => 'Vonage Click2Call number (see <a href="https://secure.click2callu.com/">https://secure.click2callu.com/</a>)', - 'type' => 'text', - }, - - { - 'key' => 'echeck-nonus', - 'section' => 'billing', - 'description' => 'Disable ABA-format account checking for Electronic Check payment info', - 'type' => 'checkbox', - }, - - { - 'key' => 'voip-cust_cdr_spools', - 'section' => '', - 'description' => 'Enable the per-customer option for individual CDR spools.', - 'type' => 'checkbox', - }, - - { - 'key' => 'svc_forward-arbitrary_dst', - 'section' => '', - 'description' => "Allow forwards to point to arbitrary strings that don't necessarily look like email addresses. Only used when using forwards for weird, non-email things.", - 'type' => 'checkbox', - }, - - { - 'key' => 'tax-ship_address', - 'section' => 'billing', - 'description' => 'By default, tax calculations are done based on the billing address. Enable this switch to calculate tax based on the shipping address instead. Note: Tax reports can take a long time when enabled.', - 'type' => 'checkbox', - }, - - { - 'key' => 'batch-default_format', - 'section' => 'billing', - 'description' => 'Default format for batches.', - 'type' => 'select', - 'select_enum' => [ 'csv-td_canada_trust-merchant_pc_batch', 'BoM' ] - }, - - { - 'key' => 'batchconfig-BoM', - 'section' => 'billing', - 'description' => 'Configuration for Bank of Montreal batching, seven lines: 1. Origin ID, 2. Datacenter, 3. Typecode, 4. Short name, 5. Long name, 6. Bank, 7. Bank account', - 'type' => 'textarea', - }, - - { - 'key' => 'payment_history-years', - 'section' => 'UI', - 'description' => 'Number of years of payment history to show by default. Currently defaults to 2.', - 'type' => 'text', - }, - - { - 'key' => 'cust_main-ticket_statuses', - 'section' => 'UI', - 'description' => 'Show tickets with these statuses on the customer view page.', - 'type' => 'selectmultiple', - 'select_enum' => [qw( new open stalled resolved rejected deleted )], - }, - - { - 'key' => 'cust_main-max_tickets', - 'section' => 'UI', - 'description' => 'Maximum number of tickets to show on the customer view page.', - 'type' => 'text', - }, - - { - 'key' => 'cust_main-skeleton_tables', - 'section' => '', - 'description' => 'Tables which will have skeleton records inserted into them for each customer. Syntax for specifying tables is unfortunately a tricky perl data structure for now.', - 'type' => 'textarea', - }, - - { - 'key' => 'cust_main-skeleton_custnum', - 'section' => '', - 'description' => 'Customer number specifying the source data to copy into skeleton tables for new customers.', - 'type' => 'text', - }, - -); - -1; - diff --git a/FS/FS/ConfDefaults.pm b/FS/FS/ConfDefaults.pm deleted file mode 100644 index b9cbcfb..0000000 --- a/FS/FS/ConfDefaults.pm +++ /dev/null @@ -1,68 +0,0 @@ -package FS::ConfDefaults; - -=head1 NAME - -FS::ConfDefaults - Freeside configuration default and available values - -=head1 SYNOPSIS - - use FS::ConfDefaults; - - @avail_cust_fields = FS::ConfDefaults->cust_fields_avail(); - -=head1 DESCRIPTION - -Just a small class to keep config default and available values - -=head1 METHODS - -=over 4 - -=item cust_fields_avail - -Returns a list, suitable for assigning to a hash, of available values and -labels for customer fields values. - -=cut - -# XXX should use msgcat for "Day phone" and "Night phone", but how? -sub cust_fields_avail { ( - - 'Customer' => - 'Last, First or Company (Last, First)', - 'Cust# | Customer' => - 'custnum | Last, First or Company (Last, First)', - - 'Name | Company' => - 'Last, First | Company', - 'Cust# | Name | Company' => - 'custnum | Last, First | Company', - - '(bill) Customer | (service) Customer' => - 'Last, First or Company (Last, First) | (same for service contact if present)', - 'Cust# | (bill) Customer | (service) Customer' => - 'custnum | Last, First or Company (Last, First) | (same for service contact if present)', - - '(bill) Name | (bill) Company | (service) Name | (service) Company' => - 'Last, First | Company | (same for service address if present)', - 'Cust# | (bill) Name | (bill) Company | (service) Name | (service) Company' => - 'custnum | Last, First | Company | (same for service address if present)', - - 'Cust# | Name | Company | Address 1 | Address 2 | City | State | Zip | Country | Day phone | Night phone | Invoicing email(s)' => - 'custnum | Last, First | Company | (all address fields ) | Day phone | Night phone | Invoicing email(s)', - -); } - -=back - -=head1 BUGS - -Not yet. - -=head1 SEE ALSO - -L<FS::Conf> - -=cut - -1; diff --git a/FS/FS/ConfItem.pm b/FS/FS/ConfItem.pm deleted file mode 100644 index a0e997a..0000000 --- a/FS/FS/ConfItem.pm +++ /dev/null @@ -1,63 +0,0 @@ -package FS::ConfItem; - -=head1 NAME - -FS::ConfItem - Configuration 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<FS::Conf> - -=cut - -1; - diff --git a/FS/FS/Cron/backup.pm b/FS/FS/Cron/backup.pm deleted file mode 100644 index 204069a..0000000 --- a/FS/FS/Cron/backup.pm +++ /dev/null @@ -1,43 +0,0 @@ -package FS::Cron::backup; - -use strict; -use vars qw( @ISA @EXPORT_OK ); -use Exporter; -use FS::UID qw(driver_name datasrc); - -@ISA = qw( Exporter ); -@EXPORT_OK = qw( backup_scp ); - -sub backup_scp { - my $conf = new FS::Conf; - my $dest = $conf->config('dump-scpdest'); - if ( $dest ) { - datasrc =~ /dbname=([\w\.]+)$/ or die "unparsable datasrc ". datasrc; - my $database = $1; - eval "use Net::SCP qw(scp);"; - die $@ if $@; - if ( driver_name eq 'Pg' ) { - system("pg_dump $database >/var/tmp/$database.sql") - } else { - die "database dumps not yet supported for ". driver_name; - } - if ( $conf->config('dump-pgpid') ) { - eval 'use GnuPG;'; - die $@ if $@; - my $gpg = new GnuPG; - $gpg->encrypt( plaintext => "/var/tmp/$database.sql", - output => "/var/tmp/$database.gpg", - recipient => $conf->config('dump-pgpid'), - ); - chmod 0600, '/var/tmp/$database.gpg'; - scp("/var/tmp/$database.gpg", $dest); - unlink "/var/tmp/$database.gpg" or die $!; - } else { - chmod 0600, '/var/tmp/$database.sql'; - scp("/var/tmp/$database.sql", $dest); - } - unlink "/var/tmp/$database.sql" or die $!; - } -} - -1; diff --git a/FS/FS/Cron/bill.pm b/FS/FS/Cron/bill.pm deleted file mode 100644 index 774bf30..0000000 --- a/FS/FS/Cron/bill.pm +++ /dev/null @@ -1,119 +0,0 @@ -package FS::Cron::bill; - -use strict; -use vars qw( @ISA @EXPORT_OK ); -use Exporter; -use Date::Parse; -use FS::Record qw(qsearch qsearchs); -use FS::cust_main; - -@ISA = qw( Exporter ); -@EXPORT_OK = qw ( bill ); - -sub bill { - - my %opt = @_; - - $FS::cust_main::DEBUG = 1 if $opt{'v'}; - - my %search = (); - $search{'payby'} = $opt{'p'} if $opt{'p'}; - $search{'agentnum'} = $opt{'a'} if $opt{'a'}; - - #we're at now now (and later). - my($time)= $opt{'d'} ? str2time($opt{'d'}) : $^T; - $time += $opt{'y'} * 86400 if $opt{'y'}; - - # select * from cust_main where - my $where_pkg = <<"END"; - 0 < ( select count(*) from cust_pkg - where cust_main.custnum = cust_pkg.custnum - and ( cancel is null or cancel = 0 ) - and ( setup is null or setup = 0 - or bill is null or bill <= $time - or ( expire is not null and expire <= $^T ) - ) - ) -END - - # or - my $where_bill_event = <<"END"; - 0 < ( select count(*) from cust_bill - where cust_main.custnum = cust_bill.custnum - and 0 < charged - - coalesce( - ( select sum(amount) from cust_bill_pay - where cust_bill.invnum = cust_bill_pay.invnum ) - ,0 - ) - - coalesce( - ( select sum(amount) from cust_credit_bill - where cust_bill.invnum = cust_credit_bill.invnum ) - ,0 - ) - and 0 < ( select count(*) from part_bill_event - where payby = cust_main.payby - and ( disabled is null or disabled = '' ) - and seconds <= $time - cust_bill._date - and 0 = ( select count(*) from cust_bill_event - where cust_bill.invnum = cust_bill_event.invnum - and part_bill_event.eventpart = cust_bill_event.eventpart - and status = 'done' - ) - - ) - ) -END - - my $extra_sql = ( scalar(%search) ? ' AND ' : ' WHERE ' ). "( $where_pkg OR $where_bill_event )"; - - my @cust_main; - if ( @ARGV ) { - @cust_main = map { qsearchs('cust_main', { custnum => $_, %search } ) } @ARGV - } else { - @cust_main = qsearch('cust_main', \%search, '', $extra_sql ); - } - ; - - my($cust_main,%saw); - foreach $cust_main ( @cust_main ) { - - # $^T not $time because -d is for pre-printing invoices - foreach my $cust_pkg ( - grep { $_->expire && $_->expire <= $^T } $cust_main->ncancelled_pkgs - ) { - my $error = $cust_pkg->cancel; - warn "Error cancelling expired pkg ". $cust_pkg->pkgnum. " for custnum ". - $cust_main->custnum. ": $error" - if $error; - } - # $^T not $time because -d is for pre-printing invoices - foreach my $cust_pkg ( - grep { $_->part_pkg->is_prepaid - && $_->bill && $_->bill < $^T && ! $_->susp - } - $cust_main->ncancelled_pkgs - ) { - my $error = $cust_pkg->suspend; - warn "Error suspending package ". $cust_pkg->pkgnum. - " for custnum ". $cust_main->custnum. - ": $error" - if $error; - } - - my $error = $cust_main->bill( 'time' => $time, - 'resetup' => $opt{'s'}, - ); - 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, - 'freq' => $opt{'freq'}, - ); - warn "Error collecting, custnum". $cust_main->custnum. ": $error" if $error; - - } - -} diff --git a/FS/FS/Cron/vacuum.pm b/FS/FS/Cron/vacuum.pm deleted file mode 100644 index 075572d..0000000 --- a/FS/FS/Cron/vacuum.pm +++ /dev/null @@ -1,23 +0,0 @@ -package FS::Cron::vacuum; - -use vars qw( @ISA @EXPORT_OK); -use Exporter; -use FS::UID qw(driver_name dbh); -use FS::Schema qw(dbdef); - -@ISA = qw( Exporter ); -@EXPORT_OK = qw( vacuum ); - -sub vacuum { - - if ( driver_name eq 'Pg' ) { - dbh->{AutoCommit} = 1; #so we can vacuum - foreach my $table ( dbdef->tables ) { - my $sth = dbh->prepare("VACUUM ANALYZE $table") or die dbh->errstr; - $sth->execute or die $sth->errstr; - } - } - -} - -1; diff --git a/FS/FS/CurrentUser.pm b/FS/FS/CurrentUser.pm deleted file mode 100644 index bcd337d..0000000 --- a/FS/FS/CurrentUser.pm +++ /dev/null @@ -1,67 +0,0 @@ -package FS::CurrentUser; - -use vars qw($CurrentUser $upgrade_hack); - -#not at compile-time, circular dependancey causes trouble -#use FS::Record qw(qsearchs); -#use FS::access_user; - -$upgrade_hack = 0; - -=head1 NAME - -FS::CurrentUser - Package representing the current user - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -=cut - -sub load_user { - my( $class, $user ) = @_; #, $pass - - if ( $upgrade_hack ) { - return $CurrentUser = new FS::CurrentUser::BootstrapUser; - } - - #return "" if $user =~ /^fs_(queue|selfservice)$/; - - #not the best thing in the world... - eval "use FS::Record qw(qsearchs);"; - die $@ if $@; - eval "use FS::access_user;"; - die $@ if $@; - - $CurrentUser = qsearchs('access_user', { - 'username' => $user, - #'_password' => - 'disabled' => '', - } ); - - die "unknown user: $user" unless $CurrentUser; # or bad password - - $CurrentUser; -} - -=head1 BUGS - -Creepy crawlies - -=head1 SEE ALSO - -=cut - -package FS::CurrentUser::BootstrapUser; - -sub new { - my $proto = shift; - my $class = ref($proto) || $proto; - my $self = {}; - bless ($self, $class); -} - -sub AUTOLOAD { 1 }; - -1; - diff --git a/FS/FS/Daemon.pm b/FS/FS/Daemon.pm deleted file mode 100644 index 7e0d45c..0000000 --- a/FS/FS/Daemon.pm +++ /dev/null @@ -1,92 +0,0 @@ -package FS::Daemon; - -use vars qw( @ISA @EXPORT_OK ); -use vars qw( $pid_dir $me $pid_file $sigint $sigterm $logfile ); -use Exporter; -use Fcntl qw(:flock); -use POSIX qw(setsid); -use IO::File; -use Date::Format; - -#this is a simple refactoring of the stuff from freeside-queued, just to -#avoid duplicate code. eventually this should use something from CPAN. - -@ISA = qw(Exporter); -@EXPORT_OK = qw( daemonize1 drop_root daemonize2 sigint sigterm logfile ); - -$pid_dir = '/var/run'; - -sub daemonize1 { - $me = shift; - - $pid_file = "$pid_dir/$me"; - $pid_file .= '.'.shift if scalar(@_); - $pid_file .= '.pid'; - - 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 "$me 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; - } - - #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++; }; -} - -sub drop_root { - my $freeside_gid = scalar(getgrnam('freeside')) - or die "can't find 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; -} - -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: $!"; - - $SIG{__DIE__} = \&_die; - $SIG{__WARN__} = \&_logmsg; - - warn "$me starting\n"; -} - -sub sigint { $sigint; } -sub sigterm { $sigterm; } - -sub logfile { $logfile = shift; } #_logmsg('test'); } - -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 ">>$logfile"; - 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; -} - diff --git a/FS/FS/InitHandler.pm b/FS/FS/InitHandler.pm deleted file mode 100644 index 5038cf3..0000000 --- a/FS/FS/InitHandler.pm +++ /dev/null @@ -1,91 +0,0 @@ -package FS::InitHandler; - -# this leaks memory under graceful restarts and i wouldn't use it on any -# modern server. useful for very slow machines with memory to spare, just -# always do a full restart - -use strict; -use vars qw($DEBUG); -use FS::UID qw(adminsuidsetup); -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_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 (<MAPSECRETS>) { - 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/Misc.pm b/FS/FS/Misc.pm deleted file mode 100644 index 101a2d4..0000000 --- a/FS/FS/Misc.pm +++ /dev/null @@ -1,420 +0,0 @@ -package FS::Misc; - -use strict; -use vars qw ( @ISA @EXPORT_OK $DEBUG ); -use Exporter; -use Carp; -use Data::Dumper; - -@ISA = qw( Exporter ); -@EXPORT_OK = qw( send_email send_fax states_hash state_label ); - -$DEBUG = 0; - -=head1 NAME - -FS::Misc - Miscellaneous subroutines - -=head1 SYNOPSIS - - use FS::Misc qw(send_email); - - send_email(); - -=head1 DESCRIPTION - -Miscellaneous subroutines. This module contains miscellaneous subroutines -called from multiple other modules. These are not OO or necessarily related, -but are collected here to elimiate code duplication. - -=head1 SUBROUTINES - -=over 4 - -=item send_email OPTION => VALUE ... - -Options: - -I<from> - (required) - -I<to> - (required) comma-separated scalar or arrayref of recipients - -I<subject> - (required) - -I<content-type> - (optional) MIME type for the body - -I<body> - (required unless I<nobody> is true) arrayref of body text lines - -I<mimeparts> - (optional, but required if I<nobody> is true) arrayref of MIME::Entity->build PARAMHASH refs or MIME::Entity objects. These will be passed as arguments to MIME::Entity->attach(). - -I<nobody> - (optional) when set true, send_email will ignore the I<body> option and simply construct a message with the given I<mimeparts>. In this case, -I<content-type>, if specified, overrides the default "multipart/mixed" for the outermost MIME container. - -I<content-encoding> - (optional) when using nobody, optional top-level MIME -encoding which, if specified, overrides the default "7bit". - -I<type> - (optional) type parameter for multipart/related messages - -=cut - -use vars qw( $conf ); -use Date::Format; -use Mail::Header; -use Mail::Internet 1.44; -use MIME::Entity; -use FS::UID; - -FS::UID->install_callback( sub { - $conf = new FS::Conf; -} ); - -sub send_email { - my(%options) = @_; - if ( $DEBUG ) { - my %doptions = %options; - $doptions{'body'} = '(full body not shown in debug)'; - warn "FS::Misc::send_email called with options:\n ". Dumper(\%doptions); -# join("\n", map { " $_: ". $options{$_} } keys %options ). "\n" - } - - $ENV{MAILADDRESS} = $options{'from'}; - my $to = ref($options{to}) ? join(', ', @{ $options{to} } ) : $options{to}; - - my @mimeargs = (); - my @mimeparts = (); - if ( $options{'nobody'} ) { - - croak "'mimeparts' option required when 'nobody' option given\n" - unless $options{'mimeparts'}; - - @mimeparts = @{$options{'mimeparts'}}; - - @mimeargs = ( - 'Type' => ( $options{'content-type'} || 'multipart/mixed' ), - 'Encoding' => ( $options{'content-encoding'} || '7bit' ), - ); - - } else { - - @mimeparts = @{$options{'mimeparts'}} - if ref($options{'mimeparts'}) eq 'ARRAY'; - - if (scalar(@mimeparts)) { - - @mimeargs = ( - 'Type' => 'multipart/mixed', - 'Encoding' => '7bit', - ); - - unshift @mimeparts, { - 'Type' => ( $options{'content-type'} || 'text/plain' ), - 'Data' => $options{'body'}, - 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ), - 'Disposition' => 'inline', - }; - - } else { - - @mimeargs = ( - 'Type' => ( $options{'content-type'} || 'text/plain' ), - 'Data' => $options{'body'}, - 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ), - ); - - } - - } - - my $domain; - if ( $options{'from'} =~ /\@([\w\.\-]+)/ ) { - $domain = $1; - } else { - warn 'no domain found in invoice from address '. $options{'from'}. - '; constructing Message-ID @example.com'; - $domain = 'example.com'; - } - my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain"; - - my $message = MIME::Entity->build( - 'From' => $options{'from'}, - 'To' => $to, - 'Sender' => $options{'from'}, - 'Reply-To' => $options{'from'}, - 'Date' => time2str("%a, %d %b %Y %X %z", time), - 'Subject' => $options{'subject'}, - 'Message-ID' => "<$message_id>", - @mimeargs, - ); - - if ( $options{'type'} ) { - #false laziness w/cust_bill::generate_email - $message->head->replace('Content-type', - $message->mime_type. - '; boundary="'. $message->head->multipart_boundary. '"'. - '; type='. $options{'type'} - ); - } - - foreach my $part (@mimeparts) { - - if ( UNIVERSAL::isa($part, 'MIME::Entity') ) { - - warn "attaching MIME part from MIME::Entity object\n" - if $DEBUG; - $message->add_part($part); - - } elsif ( ref($part) eq 'HASH' ) { - - warn "attaching MIME part from hashref:\n". - join("\n", map " $_: ".$part->{$_}, keys %$part ). "\n" - if $DEBUG; - $message->attach(%$part); - - } else { - croak "mimepart $part isn't a hashref or MIME::Entity object!"; - } - - } - - my $smtpmachine = $conf->config('smtpmachine'); - $!=0; - - $message->mysmtpsend( 'Host' => $smtpmachine, - 'MailFrom' => $options{'from'}, - ); - -} - -#this kludges a "mysmtpsend" method into Mail::Internet for send_email above -package Mail::Internet; - -use Mail::Address; -use Net::SMTP; - -sub Mail::Internet::mysmtpsend { - my $src = shift; - my %opt = @_; - my $host = $opt{Host}; - my $envelope = $opt{MailFrom}; - my $noquit = 0; - my $smtp; - my @hello = defined $opt{Hello} ? (Hello => $opt{Hello}) : (); - - push(@hello, 'Port', $opt{'Port'}) - if exists $opt{'Port'}; - - push(@hello, 'Debug', $opt{'Debug'}) - if exists $opt{'Debug'}; - - if(ref($host) && UNIVERSAL::isa($host,'Net::SMTP')) { - $smtp = $host; - $noquit = 1; - } - else { - #local $SIG{__DIE__}; - #$smtp = eval { Net::SMTP->new($host, @hello) }; - $smtp = new Net::SMTP $host, @hello; - } - - unless ( defined($smtp) ) { - my $err = $!; - $err =~ s/Invalid argument/Unknown host/; - return "can't connect to $host: $err" - } - - my $hdr = $src->head->dup; - - _prephdr($hdr); - - # Who is it to - - my @rcpt = map { ref($_) ? @$_ : $_ } grep { defined } @opt{'To','Cc','Bcc'}; - @rcpt = map { $hdr->get($_) } qw(To Cc Bcc) - unless @rcpt; - my @addr = map($_->address, Mail::Address->parse(@rcpt)); - - return 'No valid destination addresses found!' - unless(@addr); - - $hdr->delete('Bcc'); # Remove blind Cc's - - # Send it - - #warn "Headers: \n" . join('',@{$hdr->header}); - #warn "Body: \n" . join('',@{$src->body}); - - my $ok = $smtp->mail( $envelope ) && - $smtp->to(@addr) && - $smtp->data(join("", @{$hdr->header},"\n",@{$src->body})); - - if ( $ok ) { - $smtp->quit - unless $noquit; - return ''; - } else { - return $smtp->code. ' '. $smtp->message; - } - -} -package FS::Misc; -#eokludge - -=item send_fax OPTION => VALUE ... - -Options: - -I<dialstring> - (required) 10-digit phone number w/ area code - -I<docdata> - (required) Array ref containing PostScript or TIFF Class F document - --or- - -I<docfile> - (required) Filename of PostScript TIFF Class F document - -...any other options will be passed to L<Fax::Hylafax::Client::sendfax> - - -=cut - -sub send_fax { - - my %options = @_; - - die 'HylaFAX support has not been configured.' - unless $conf->exists('hylafax'); - - eval { - require Fax::Hylafax::Client; - }; - - if ($@) { - if ($@ =~ /^Can't locate Fax.*/) { - die "You must have Fax::Hylafax::Client installed to use invoice faxing." - } else { - die $@; - } - } - - my %hylafax_opts = map { split /\s+/ } $conf->config('hylafax'); - - die 'Called send_fax without a \'dialstring\'.' - unless exists($options{'dialstring'}); - - if (exists($options{'docdata'}) and ref($options{'docdata'}) eq 'ARRAY') { - my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; - my $fh = new File::Temp( - TEMPLATE => 'faxdoc.'. $options{'dialstring'} . '.XXXXXXXX', - DIR => $dir, - UNLINK => 0, - ) or die "can't open temp file: $!\n"; - - $options{docfile} = $fh->filename; - - print $fh @{$options{'docdata'}}; - close $fh; - - delete $options{'docdata'}; - } - - die 'Called send_fax without a \'docfile\' or \'docdata\'.' - unless exists($options{'docfile'}); - - #FIXME: Need to send canonical dialstring to HylaFAX, but this only - # works in the US. - - $options{'dialstring'} =~ s/[^\d\+]//g; - if ($options{'dialstring'} =~ /^\d{10}$/) { - $options{dialstring} = '+1' . $options{'dialstring'}; - } else { - return 'Invalid dialstring ' . $options{'dialstring'} . '.'; - } - - my $faxjob = &Fax::Hylafax::Client::sendfax(%options, %hylafax_opts); - - if ($faxjob->success) { - warn "Successfully queued fax to '$options{dialstring}' with jobid " . - $faxjob->jobid - if $DEBUG; - return ''; - } else { - return 'Error while sending FAX: ' . $faxjob->trace; - } - -} - -=item states_hash COUNTRY - -Returns a list of key/value pairs containing state (or other sub-country -division) abbriviations and names. - -=cut - -use FS::Record qw(qsearch); -use Locale::SubCountry; - -sub states_hash { - my($country) = @_; - - my @states = -# sort - map { s/[\n\r]//g; $_; } - map { $_->state; } - qsearch( 'cust_main_county', - { 'country' => $country }, - 'DISTINCT ON ( state ) *', - ) - ; - - #it could throw a fatal "Invalid country code" error (for example "AX") - my $subcountry = eval { new Locale::SubCountry($country) } - or return ( '', '(n/a)' ); - - #"i see your schwartz is as big as mine!" - map { ( $_->[0] => $_->[1] ) } - sort { $a->[1] cmp $b->[1] } - map { [ $_ => state_label($_, $subcountry) ] } - @states; -} - -=item state_label STATE COUNTRY_OR_LOCALE_SUBCOUNRY_OBJECT - -=cut - -sub state_label { - my( $state, $country ) = @_; - - unless ( ref($country) ) { - $country = eval { new Locale::SubCountry($country) } - or return'(n/a)'; - - } - - # US kludge to avoid changing existing behaviour - # also we actually *use* the abbriviations... - my $full_name = $country->country_code eq 'US' - ? '' - : $country->full_name($state); - - $full_name = '' if $full_name eq 'unknown'; - $full_name =~ s/\(see also.*\)\s*$//; - $full_name .= " ($state)" if $full_name; - - $full_name || $state || '(n/a)'; - -} - -=back - -=head1 BUGS - -This package exists. - -=head1 SEE ALSO - -L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation. - -L<Fax::Hylafax::Client> - -=cut - -1; diff --git a/FS/FS/Msgcat.pm b/FS/FS/Msgcat.pm deleted file mode 100644 index 625743d..0000000 --- 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<FS::msgcat> 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<FS::msgcat>, L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/Pony.pm b/FS/FS/Pony.pm deleted file mode 100644 index c37dd78..0000000 --- a/FS/FS/Pony.pm +++ /dev/null @@ -1,23 +0,0 @@ -package FS::Pony; - -=head1 NAME - -FS::Pony - A pony - -=head1 SYNOPSYS - -use FS::Pony; # <-- yours! - -=head1 DESCRIPTION - -We told you it came with a pony. - -=head1 BUGS - -=head1 SEE ALSO - -http://420.am/~ivan/nopony.jpg - -=cut - -1; diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm deleted file mode 100644 index a551bb8..0000000 --- a/FS/FS/Record.pm +++ /dev/null @@ -1,1971 +0,0 @@ -package FS::Record; - -use strict; -use vars qw( $AUTOLOAD @ISA @EXPORT_OK $DEBUG - $me %virtual_fields_cache $nowarn_identical ); -use Exporter; -use Carp qw(carp cluck croak confess); -use File::CounterFile; -use Locale::Country; -use DBI qw(:sql_types); -use DBIx::DBSchema 0.25; -use FS::UID qw(dbh getotaker datasrc driver_name); -use FS::CurrentUser; -use FS::Schema qw(dbdef); -use FS::SearchCache; -use FS::Msgcat qw(gettext); -use FS::Conf; - -use FS::part_virtual_field; - -use Tie::IxHash; - -@ISA = qw(Exporter); - -#export dbdef for now... everything else expects to find it here -@EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef jsearch); - -$DEBUG = 0; -$me = '[FS::Record]'; - -$nowarn_identical = 0; - -my $rsa_module; -my $rsa_loaded; -my $rsa_encrypt; -my $rsa_decrypt; - -FS::UID->install_callback( sub { - $File::CounterFile::DEFAULT_DIR = "/usr/local/etc/freeside/counters.". datasrc; -} ); - -=head1 NAME - -FS::Record - Database record objects - -=head1 SYNOPSIS - - use FS::Record; - use FS::Record qw(dbh fields qsearch qsearchs); - - $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->delete; - - $error = $new_record->replace($old_record); - - # external use deprecated - handled by the database (at least for Pg, mysql) - $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'); - - $quoted_value = _quote($value,'table','field'); - - #deprecated - $fields = hfields('table'); - if ( $fields->{Field} ) { # etc. - - @fields = fields 'table'; #as a subroutine - @fields = $record->fields; #as a method call - - -=head1 DESCRIPTION - -(Mostly) object-oriented interface to database records. Records are currently -implemented on top of DBI. FS::Record is intended as a base class for -table-specific classes to inherit from, i.e. FS::cust_main. - -=head1 CONSTRUCTORS - -=over 4 - -=item new [ TABLE, ] HASHREF - -Creates a new record. It doesn't store it in the database, though. See -L<"insert"> for that. - -Note that the object stores this hash reference, not a distinct copy of the -hash it points to. You can ask the object for a copy with the I<hash> -method. - -TABLE can only be omitted when a dervived class overrides the table method. - -=cut - -sub new { - my $proto = shift; - my $class = ref($proto) || $proto; - my $self = {}; - bless ($self, $class); - - unless ( defined ( $self->table ) ) { - $self->{'Table'} = shift; - carp "warning: FS::Record::new called with table name ". $self->{'Table'}; - } - - $self->{'Hash'} = shift; - - foreach my $field ( grep !defined($self->{'Hash'}{$_}), $self->fields ) { - $self->{'Hash'}{$field}=''; - } - - $self->_rebless if $self->can('_rebless'); - - $self->{'modified'} = 0; - - $self->_cache($self->{'Hash'}, 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 deprecated, use new!"; - $self->new(@_); - } else { - croak "FS::Record::create called (not from a subclass)!"; - } -} - -=item qsearch PARAMS_HASHREF | TABLE, HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ, ADDL_FROM - -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. - -The preferred usage is to pass a hash reference of named parameters: - - my @records = qsearch( { - 'table' => 'table_name', - 'hashref' => { 'field' => 'value' - 'field' => { 'op' => '<', - 'value' => '420', - }, - }, - - #these are optional... - 'select' => '*', - 'extra_sql' => 'AND field ', - #'cache_obj' => '', #optional - 'addl_from' => 'LEFT JOIN othtable USING ( field )', - } - ); - -Much code still uses old-style positional parameters, this is also probably -fine in the common case where there are only two parameters: - - my @records = qsearch( 'table', { 'field' => 'value' } ); - -###oops, argh, FS::Record::new only lets us create database fields. -#Normal behaviour if SELECT is not specified is `*', as in -#C<SELECT * FROM table WHERE ...>. However, there is an experimental new -#feature where you can specify SELECT - remember, the objects returned, -#although blessed into the appropriate `FS::TABLE' package, will only have the -#fields you specify. This might have unwanted results if you then go calling -#regular FS::TABLE methods -#on it. - -=cut - -sub qsearch { - my($stable, $record, $select, $extra_sql, $cache, $addl_from ); - if ( ref($_[0]) ) { #hashref for now, eventually maybe accept a list too - my $opt = shift; - $stable = $opt->{'table'} or die "table name is required"; - $record = $opt->{'hashref'} || {}; - $select = $opt->{'select'} || '*'; - $extra_sql = $opt->{'extra_sql'} || ''; - $cache = $opt->{'cache_obj'} || ''; - $addl_from = $opt->{'addl_from'} || ''; - } else { - ($stable, $record, $select, $extra_sql, $cache, $addl_from ) = @_; - $select ||= '*'; - } - - #$stable =~ /^([\w\_]+)$/ or die "Illegal table: $table"; - #for jsearch - $stable =~ /^([\w\s\(\)\.\,\=]+)$/ or die "Illegal table: $stable"; - $stable = $1; - my $dbh = dbh; - - my $table = $cache ? $cache->table : $stable; - my $dbdef_table = dbdef->table($table) - or die "No schema for table $table found - ". - "do you need to run freeside-upgrade?"; - my $pkey = $dbdef_table->primary_key; - - my @real_fields = grep exists($record->{$_}), real_fields($table); - my @virtual_fields; - if ( eval 'scalar(@FS::'. $table. '::ISA);' ) { - @virtual_fields = grep exists($record->{$_}), "FS::$table"->virtual_fields; - } else { - cluck "warning: FS::$table not loaded; virtual fields not searchable"; - @virtual_fields = (); - } - - my $statement = "SELECT $select FROM $stable"; - $statement .= " $addl_from" if $addl_from; - if ( @real_fields or @virtual_fields ) { - $statement .= ' WHERE '. join(' AND ', - ( map { - - my $op = '='; - my $column = $_; - if ( ref($record->{$_}) ) { - $op = $record->{$_}{'op'} if $record->{$_}{'op'}; - #$op = 'LIKE' if $op =~ /^ILIKE$/i && driver_name ne 'Pg'; - if ( uc($op) eq 'ILIKE' ) { - $op = 'LIKE'; - $record->{$_}{'value'} = lc($record->{$_}{'value'}); - $column = "LOWER($_)"; - } - $record->{$_} = $record->{$_}{'value'} - } - - if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) { - if ( $op eq '=' ) { - if ( driver_name eq 'Pg' ) { - my $type = dbdef->table($table)->column($column)->type; - if ( $type =~ /(int|(big)?serial)/i ) { - qq-( $column IS NULL )-; - } else { - qq-( $column IS NULL OR $column = '' )-; - } - } else { - qq-( $column IS NULL OR $column = "" )-; - } - } elsif ( $op eq '!=' ) { - if ( driver_name eq 'Pg' ) { - my $type = dbdef->table($table)->column($column)->type; - if ( $type =~ /(int|(big)?serial)/i ) { - qq-( $column IS NOT NULL )-; - } else { - qq-( $column IS NOT NULL AND $column != '' )-; - } - } else { - qq-( $column IS NOT NULL AND $column != "" )-; - } - } else { - if ( driver_name eq 'Pg' ) { - qq-( $column $op '' )-; - } else { - qq-( $column $op "" )-; - } - } - } else { - "$column $op ?"; - } - } @real_fields ), - ( map { - my $op = '='; - my $column = $_; - if ( ref($record->{$_}) ) { - $op = $record->{$_}{'op'} if $record->{$_}{'op'}; - if ( uc($op) eq 'ILIKE' ) { - $op = 'LIKE'; - $record->{$_}{'value'} = lc($record->{$_}{'value'}); - $column = "LOWER($_)"; - } - $record->{$_} = $record->{$_}{'value'}; - } - - # ... EXISTS ( SELECT name, value FROM part_virtual_field - # JOIN virtual_field - # ON part_virtual_field.vfieldpart = virtual_field.vfieldpart - # WHERE recnum = svc_acct.svcnum - # AND (name, value) = ('egad', 'brain') ) - - my $value = $record->{$_}; - - my $subq; - - $subq = ($value ? 'EXISTS ' : 'NOT EXISTS ') . - "( SELECT part_virtual_field.name, virtual_field.value ". - "FROM part_virtual_field JOIN virtual_field ". - "ON part_virtual_field.vfieldpart = virtual_field.vfieldpart ". - "WHERE virtual_field.recnum = ${table}.${pkey} ". - "AND part_virtual_field.name = '${column}'". - ($value ? - " AND virtual_field.value ${op} '${value}'" - : "") . ")"; - $subq; - - } @virtual_fields ) ); - - } - - $statement .= " $extra_sql" if defined($extra_sql); - - warn "[debug]$me $statement\n" if $DEBUG > 1; - my $sth = $dbh->prepare($statement) - or croak "$dbh->errstr doing $statement"; - - my $bind = 1; - - foreach my $field ( - grep defined( $record->{$_} ) && $record->{$_} ne '', @real_fields - ) { - if ( $record->{$field} =~ /^\d+(\.\d+)?$/ - && dbdef->table($table)->column($field)->type =~ /(int|(big)?serial)/i - ) { - $sth->bind_param($bind++, $record->{$field}, { TYPE => SQL_INTEGER } ); - } else { - $sth->bind_param($bind++, $record->{$field}, { TYPE => SQL_VARCHAR } ); - } - } - -# $sth->execute( map $record->{$_}, -# grep defined( $record->{$_} ) && $record->{$_} ne '', @fields -# ) or croak "Error executing \"$statement\": ". $sth->errstr; - - $sth->execute or croak "Error executing \"$statement\": ". $sth->errstr; - - if ( eval 'scalar(@FS::'. $table. '::ISA);' ) { - @virtual_fields = "FS::$table"->virtual_fields; - } else { - cluck "warning: FS::$table not loaded; virtual fields not returned either"; - @virtual_fields = (); - } - - my %result; - tie %result, "Tie::IxHash"; - my @stuff = @{ $sth->fetchall_arrayref( {} ) }; - if($pkey) { - %result = map { $_->{$pkey}, $_ } @stuff; - } else { - @result{@stuff} = @stuff; - } - - $sth->finish; - - if ( keys(%result) and @virtual_fields ) { - $statement = - "SELECT virtual_field.recnum, part_virtual_field.name, ". - "virtual_field.value ". - "FROM part_virtual_field JOIN virtual_field USING (vfieldpart) ". - "WHERE part_virtual_field.dbtable = '$table' AND ". - "virtual_field.recnum IN (". - join(',', keys(%result)). ") AND part_virtual_field.name IN ('". - join(q!', '!, @virtual_fields) . "')"; - warn "[debug]$me $statement\n" if $DEBUG > 1; - $sth = $dbh->prepare($statement) or croak "$dbh->errstr doing $statement"; - $sth->execute or croak "Error executing \"$statement\": ". $sth->errstr; - - foreach (@{ $sth->fetchall_arrayref({}) }) { - my $recnum = $_->{recnum}; - my $name = $_->{name}; - my $value = $_->{value}; - if (exists($result{$recnum})) { - $result{$recnum}->{$name} = $value; - } - } - } - my @return; - if ( eval 'scalar(@FS::'. $table. '::ISA);' ) { - if ( eval 'FS::'. $table. '->can(\'new\')' eq \&new ) { - #derivied class didn't override new method, so this optimization is safe - if ( $cache ) { - @return = map { - new_or_cached( "FS::$table", { %{$_} }, $cache ) - } values(%result); - } else { - @return = map { - new( "FS::$table", { %{$_} } ) - } values(%result); - } - } else { - #okay, its been tested - # warn "untested code (class FS::$table uses custom new method)"; - @return = map { - eval 'FS::'. $table. '->new( { %{$_} } )'; - } values(%result); - } - - # Check for encrypted fields and decrypt them. - my $conf = new FS::Conf; - if ($conf->exists('encryption') && eval 'defined(@FS::'. $table . '::encrypted_fields)') { - foreach my $record (@return) { - foreach my $field (eval '@FS::'. $table . '::encrypted_fields') { - # Set it directly... This may cause a problem in the future... - $record->setfield($field, $record->decrypt($record->getfield($field))); - } - } - } - } else { - cluck "warning: FS::$table not loaded; returning FS::Record objects"; - @return = map { - FS::Record->new( $table, { %{$_} } ); - } values(%result); - } - return @return; -} - -=item by_key PRIMARY_KEY_VALUE - -This is a class method that returns the record with the given primary key -value. This method is only useful in FS::Record subclasses. For example: - - my $cust_main = FS::cust_main->by_key(1); # retrieve customer with custnum 1 - -is equivalent to: - - my $cust_main = qsearchs('cust_main', { 'custnum' => 1 } ); - -=cut - -sub by_key { - my ($class, $pkey_value) = @_; - - my $table = $class->table - or croak "No table for $class found"; - - my $dbdef_table = dbdef->table($table) - or die "No schema for table $table found - ". - "do you need to create it or run dbdef-create?"; - my $pkey = $dbdef_table->primary_key - or die "No primary key for table $table"; - - return qsearchs($table, { $pkey => $pkey_value }); -} - -=item jsearch TABLE, HASHREF, SELECT, EXTRA_SQL, PRIMARY_TABLE, PRIMARY_KEY - -Experimental JOINed search method. Using this method, you can execute a -single SELECT spanning multiple tables, and cache the results for subsequent -method calls. Interface will almost definately change in an incompatible -fashion. - -Arguments: - -=cut - -sub jsearch { - my($table, $record, $select, $extra_sql, $ptable, $pkey ) = @_; - my $cache = FS::SearchCache->new( $ptable, $pkey ); - my %saw; - ( $cache, - grep { !$saw{$_->getfield($pkey)}++ } - qsearch($table, $record, $select, $extra_sql, $cache ) - ); -} - -=item qsearchs PARAMS_HASHREF | TABLE, HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ, ADDL_FROM - -Same as qsearch, except that if more than one record matches, it B<carp>s but -returns the first. If this happens, you either made a logic error in asking -for a single item, or your data is corrupted. - -=cut - -sub qsearchs { # $result_record = &FS::Record:qsearchs('table',\%hash); - my $table = $_[0]; - my(@result) = qsearch(@_); - cluck "warning: Multiple records in scalar search ($table)" - if scalar(@result) > 1; - #should warn more vehemently if the search was on a primary key? - scalar(@result) ? ($result[0]) : (); -} - -=back - -=head1 METHODS - -=over 4 - -=item table - -Returns the table name. - -=cut - -sub table { -# cluck "warning: FS::Record::table deprecated; supply one in subclass!"; - my $self = shift; - $self -> {'Table'}; -} - -=item dbdef_table - -Returns the DBIx::DBSchema::Table object for the table. - -=cut - -sub dbdef_table { - my($self)=@_; - my($table)=$self->table; - dbdef->table($table); -} - -=item get, getfield COLUMN - -Returns the value of the column/field/key COLUMN. - -=cut - -sub get { - my($self,$field) = @_; - # to avoid "Use of unitialized value" errors - if ( defined ( $self->{Hash}->{$field} ) ) { - $self->{Hash}->{$field}; - } else { - ''; - } -} -sub getfield { - my $self = shift; - $self->get(@_); -} - -=item set, setfield COLUMN, VALUE - -Sets the value of the column/field/key COLUMN to VALUE. Returns VALUE. - -=cut - -sub set { - my($self,$field,$value) = @_; - $self->{'modified'} = 1; - $self->{'Hash'}->{$field} = $value; -} -sub setfield { - my $self = shift; - $self->set(@_); -} - -=item AUTLOADED METHODS - -$record->column is a synonym for $record->get('column'); - -$record->column('value') is a synonym for $record->set('column','value'); - -=cut - -# readable/safe -sub AUTOLOAD { - my($self,$value)=@_; - my($field)=$AUTOLOAD; - $field =~ s/.*://; - if ( defined($value) ) { - confess "errant AUTOLOAD $field for $self (arg $value)" - unless ref($self) && $self->can('setfield'); - $self->setfield($field,$value); - } else { - confess "errant AUTOLOAD $field for $self (no args)" - unless ref($self) && $self->can('getfield'); - $self->getfield($field); - } -} - -# efficient -#sub AUTOLOAD { -# my $field = $AUTOLOAD; -# $field =~ s/.*://; -# if ( defined($_[1]) ) { -# $_[0]->setfield($field, $_[1]); -# } else { -# $_[0]->getfield($field); -# } -#} - -=item hash - -Returns a list of the column/value pairs, usually for assigning to a new hash. - -To make a distinct duplicate of an FS::Record object, you can do: - - $new = new FS::Record ( $old->table, { $old->hash } ); - -=cut - -sub hash { - my($self) = @_; - confess $self. ' -> hash: Hash attribute is undefined' - unless defined($self->{'Hash'}); - %{ $self->{'Hash'} }; -} - -=item hashref - -Returns a reference to the column/value hash. This may be deprecated in the -future; if there's a reason you can't just use the autoloaded or get/set -methods, speak up. - -=cut - -sub hashref { - my($self) = @_; - $self->{'Hash'}; -} - -=item modified - -Returns true if any of this object's values have been modified with set (or via -an autoloaded method). Doesn't yet recognize when you retreive a hashref and -modify that. - -=cut - -sub modified { - my $self = shift; - $self->{'modified'}; -} - -=item insert - -Inserts this record to the database. If there is an error, returns the error, -otherwise returns false. - -=cut - -sub insert { - my $self = shift; - my $saved = {}; - - my $error = $self->check; - return $error if $error; - - #single-field unique keys are given a value if false - #(like MySQL's AUTO_INCREMENT or Pg SERIAL) - foreach ( $self->dbdef_table->unique->singles ) { - $self->unique($_) unless $self->getfield($_); - } - - #and also the primary key, if the database isn't going to - my $primary_key = $self->dbdef_table->primary_key; - my $db_seq = 0; - if ( $primary_key ) { - my $col = $self->dbdef_table->column($primary_key); - - $db_seq = - uc($col->type) =~ /^(BIG)?SERIAL\d?/ - || ( driver_name eq 'Pg' - && defined($col->default) - && $col->default =~ /^nextval\(/i - ) - || ( driver_name eq 'mysql' - && defined($col->local) - && $col->local =~ /AUTO_INCREMENT/i - ); - $self->unique($primary_key) unless $self->getfield($primary_key) || $db_seq; - } - - my $table = $self->table; - - - # Encrypt before the database - my $conf = new FS::Conf; - if ($conf->exists('encryption') && defined(eval '@FS::'. $table . 'encrypted_fields')) { - foreach my $field (eval '@FS::'. $table . '::encrypted_fields') { - $self->{'saved'} = $self->getfield($field); - $self->setfield($field, $self->enrypt($self->getfield($field))); - } - } - - - #false laziness w/delete - my @real_fields = - grep defined($self->getfield($_)) && $self->getfield($_) ne "", - real_fields($table) - ; - my @values = map { _quote( $self->getfield($_), $table, $_) } @real_fields; - #eslaf - - my $statement = "INSERT INTO $table "; - if ( @real_fields ) { - $statement .= - "( ". - join( ', ', @real_fields ). - ") VALUES (". - join( ', ', @values ). - ")" - ; - } else { - $statement .= 'DEFAULT VALUES'; - } - warn "[debug]$me $statement\n" if $DEBUG > 1; - my $sth = dbh->prepare($statement) or return dbh->errstr; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - $sth->execute or return $sth->errstr; - - # get inserted id from the database, if applicable & needed - if ( $db_seq && ! $self->getfield($primary_key) ) { - warn "[debug]$me retreiving sequence from database\n" if $DEBUG; - - my $insertid = ''; - - if ( driver_name eq 'Pg' ) { - - #my $oid = $sth->{'pg_oid_status'}; - #my $i_sql = "SELECT $primary_key FROM $table WHERE oid = ?"; - - my $default = $self->dbdef_table->column($primary_key)->default; - unless ( $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i ) { - dbh->rollback if $FS::UID::AutoCommit; - return "can't parse $table.$primary_key default value". - " for sequence name: $default"; - } - my $sequence = $1; - - my $i_sql = "SELECT currval('$sequence')"; - my $i_sth = dbh->prepare($i_sql) or do { - dbh->rollback if $FS::UID::AutoCommit; - return dbh->errstr; - }; - #$i_sth->execute($oid) or do { - $i_sth->execute() or do { - dbh->rollback if $FS::UID::AutoCommit; - return $i_sth->errstr; - }; - $insertid = $i_sth->fetchrow_arrayref->[0]; - - } elsif ( driver_name eq 'mysql' ) { - - $insertid = dbh->{'mysql_insertid'}; - # work around mysql_insertid being null some of the time, ala RT :/ - unless ( $insertid ) { - warn "WARNING: DBD::mysql didn't return mysql_insertid; ". - "using SELECT LAST_INSERT_ID();"; - my $i_sql = "SELECT LAST_INSERT_ID()"; - my $i_sth = dbh->prepare($i_sql) or do { - dbh->rollback if $FS::UID::AutoCommit; - return dbh->errstr; - }; - $i_sth->execute or do { - dbh->rollback if $FS::UID::AutoCommit; - return $i_sth->errstr; - }; - $insertid = $i_sth->fetchrow_arrayref->[0]; - } - - } else { - - dbh->rollback if $FS::UID::AutoCommit; - return "don't know how to retreive inserted ids from ". driver_name. - ", try using counterfiles (maybe run dbdef-create?)"; - - } - - $self->setfield($primary_key, $insertid); - - } - - my @virtual_fields = - grep defined($self->getfield($_)) && $self->getfield($_) ne "", - $self->virtual_fields; - if (@virtual_fields) { - my %v_values = map { $_, $self->getfield($_) } @virtual_fields; - - my $vfieldpart = $self->vfieldpart_hashref; - - my $v_statement = "INSERT INTO virtual_field(recnum, vfieldpart, value) ". - "VALUES (?, ?, ?)"; - - my $v_sth = dbh->prepare($v_statement) or do { - dbh->rollback if $FS::UID::AutoCommit; - return dbh->errstr; - }; - - foreach (keys(%v_values)) { - $v_sth->execute($self->getfield($primary_key), - $vfieldpart->{$_}, - $v_values{$_}) - or do { - dbh->rollback if $FS::UID::AutoCommit; - return $v_sth->errstr; - }; - } - } - - - my $h_sth; - if ( defined dbdef->table('h_'. $table) ) { - my $h_statement = $self->_h_statement('insert'); - warn "[debug]$me $h_statement\n" if $DEBUG > 2; - $h_sth = dbh->prepare($h_statement) or do { - dbh->rollback if $FS::UID::AutoCommit; - return dbh->errstr; - }; - } else { - $h_sth = ''; - } - $h_sth->execute or return $h_sth->errstr if $h_sth; - - dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit; - - # Now that it has been saved, reset the encrypted fields so that $new - # can still be used. - foreach my $field (keys %{$saved}) { - $self->setfield($field, $saved->{$field}); - } - - ''; -} - -=item add - -Depriciated (use insert instead). - -=cut - -sub add { - cluck "warning: FS::Record::add deprecated!"; - insert @_; #call method in this scope -} - -=item delete - -Delete this record from the database. If there is an error, returns the error, -otherwise returns false. - -=cut - -sub delete { - my $self = shift; - - my $statement = "DELETE FROM ". $self->table. " WHERE ". join(' AND ', - map { - $self->getfield($_) eq '' - #? "( $_ IS NULL OR $_ = \"\" )" - ? ( driver_name eq 'Pg' - ? "$_ IS NULL" - : "( $_ IS NULL OR $_ = \"\" )" - ) - : "$_ = ". _quote($self->getfield($_),$self->table,$_) - } ( $self->dbdef_table->primary_key ) - ? ( $self->dbdef_table->primary_key) - : real_fields($self->table) - ); - warn "[debug]$me $statement\n" if $DEBUG > 1; - my $sth = dbh->prepare($statement) or return dbh->errstr; - - my $h_sth; - if ( defined dbdef->table('h_'. $self->table) ) { - my $h_statement = $self->_h_statement('delete'); - warn "[debug]$me $h_statement\n" if $DEBUG > 2; - $h_sth = dbh->prepare($h_statement) or return dbh->errstr; - } else { - $h_sth = ''; - } - - my $primary_key = $self->dbdef_table->primary_key; - my $v_sth; - my @del_vfields; - my $vfp = $self->vfieldpart_hashref; - foreach($self->virtual_fields) { - next if $self->getfield($_) eq ''; - unless(@del_vfields) { - my $st = "DELETE FROM virtual_field WHERE recnum = ? AND vfieldpart = ?"; - $v_sth = dbh->prepare($st) or return dbh->errstr; - } - push @del_vfields, $_; - } - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $rc = $sth->execute or return $sth->errstr; - #not portable #return "Record not found, statement:\n$statement" if $rc eq "0E0"; - $h_sth->execute or return $h_sth->errstr if $h_sth; - $v_sth->execute($self->getfield($primary_key), $vfp->{$_}) - or return $v_sth->errstr - foreach (@del_vfields); - - dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit; - - #no need to needlessly destoy the data either (causes problems actually) - #undef $self; #no need to keep object! - - ''; -} - -=item del - -Depriciated (use delete instead). - -=cut - -sub del { - cluck "warning: FS::Record::del deprecated!"; - &delete(@_); #call method in this scope -} - -=item replace OLD_RECORD - -Replace the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -sub replace { - my $new = shift; - my $old = shift; - - if (!defined($old)) { - warn "[debug]$me replace called with no arguments; autoloading old record\n" - if $DEBUG; - my $primary_key = $new->dbdef_table->primary_key; - if ( $primary_key ) { - $old = qsearchs($new->table, { $primary_key => $new->$primary_key() } ) - or croak "can't find ". $new->table. ".$primary_key ". - $new->$primary_key(); - } else { - croak $new->table. " has no primary key; pass old record as argument"; - } - } - - warn "[debug]$me $new ->replace $old\n" if $DEBUG; - - if ( $new->can('replace_check') ) { - my $error = $new->replace_check($old); - return $error if $error; - } - - return "Records not in same table!" unless $new->table eq $old->table; - - my $primary_key = $old->dbdef_table->primary_key; - return "Can't change primary key $primary_key ". - 'from '. $old->getfield($primary_key). - ' to ' . $new->getfield($primary_key) - if $primary_key - && ( $old->getfield($primary_key) ne $new->getfield($primary_key) ); - - my $error = $new->check; - return $error if $error; - - # Encrypt for replace - my $conf = new FS::Conf; - my $saved = {}; - if ($conf->exists('encryption') && defined(eval '@FS::'. $new->table . 'encrypted_fields')) { - foreach my $field (eval '@FS::'. $new->table . '::encrypted_fields') { - $saved->{$field} = $new->getfield($field); - $new->setfield($field, $new->encrypt($new->getfield($field))); - } - } - - #my @diff = grep $new->getfield($_) ne $old->getfield($_), $old->fields; - my %diff = map { ($new->getfield($_) ne $old->getfield($_)) - ? ($_, $new->getfield($_)) : () } $old->fields; - - unless ( keys(%diff) ) { - carp "[warning]$me $new -> replace $old: records identical" - unless $nowarn_identical; - return ''; - } - - my $statement = "UPDATE ". $old->table. " SET ". join(', ', - map { - "$_ = ". _quote($new->getfield($_),$old->table,$_) - } real_fields($old->table) - ). ' WHERE '. - join(' AND ', - map { - - if ( $old->getfield($_) eq '' ) { - - #false laziness w/qsearch - if ( driver_name eq 'Pg' ) { - my $type = $old->dbdef_table->column($_)->type; - if ( $type =~ /(int|(big)?serial)/i ) { - qq-( $_ IS NULL )-; - } else { - qq-( $_ IS NULL OR $_ = '' )-; - } - } else { - qq-( $_ IS NULL OR $_ = "" )-; - } - - } else { - "$_ = ". _quote($old->getfield($_),$old->table,$_); - } - - } ( $primary_key ? ( $primary_key ) : real_fields($old->table) ) - ) - ; - warn "[debug]$me $statement\n" if $DEBUG > 1; - my $sth = dbh->prepare($statement) or return dbh->errstr; - - my $h_old_sth; - if ( defined dbdef->table('h_'. $old->table) ) { - my $h_old_statement = $old->_h_statement('replace_old'); - warn "[debug]$me $h_old_statement\n" if $DEBUG > 2; - $h_old_sth = dbh->prepare($h_old_statement) or return dbh->errstr; - } else { - $h_old_sth = ''; - } - - my $h_new_sth; - if ( defined dbdef->table('h_'. $new->table) ) { - my $h_new_statement = $new->_h_statement('replace_new'); - warn "[debug]$me $h_new_statement\n" if $DEBUG > 2; - $h_new_sth = dbh->prepare($h_new_statement) or return dbh->errstr; - } else { - $h_new_sth = ''; - } - - # For virtual fields we have three cases with different SQL - # statements: add, replace, delete - my $v_add_sth; - my $v_rep_sth; - my $v_del_sth; - my (@add_vfields, @rep_vfields, @del_vfields); - my $vfp = $old->vfieldpart_hashref; - foreach(grep { exists($diff{$_}) } $new->virtual_fields) { - if($diff{$_} eq '') { - # Delete - unless(@del_vfields) { - my $st = "DELETE FROM virtual_field WHERE recnum = ? ". - "AND vfieldpart = ?"; - warn "[debug]$me $st\n" if $DEBUG > 2; - $v_del_sth = dbh->prepare($st) or return dbh->errstr; - } - push @del_vfields, $_; - } elsif($old->getfield($_) eq '') { - # Add - unless(@add_vfields) { - my $st = "INSERT INTO virtual_field (value, recnum, vfieldpart) ". - "VALUES (?, ?, ?)"; - warn "[debug]$me $st\n" if $DEBUG > 2; - $v_add_sth = dbh->prepare($st) or return dbh->errstr; - } - push @add_vfields, $_; - } else { - # Replace - unless(@rep_vfields) { - my $st = "UPDATE virtual_field SET value = ? ". - "WHERE recnum = ? AND vfieldpart = ?"; - warn "[debug]$me $st\n" if $DEBUG > 2; - $v_rep_sth = dbh->prepare($st) or return dbh->errstr; - } - push @rep_vfields, $_; - } - } - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $rc = $sth->execute or return $sth->errstr; - #not portable #return "Record not found (or records identical)." if $rc eq "0E0"; - $h_old_sth->execute or return $h_old_sth->errstr if $h_old_sth; - $h_new_sth->execute or return $h_new_sth->errstr if $h_new_sth; - - $v_del_sth->execute($old->getfield($primary_key), - $vfp->{$_}) - or return $v_del_sth->errstr - foreach(@del_vfields); - - $v_add_sth->execute($new->getfield($_), - $old->getfield($primary_key), - $vfp->{$_}) - or return $v_add_sth->errstr - foreach(@add_vfields); - - $v_rep_sth->execute($new->getfield($_), - $old->getfield($primary_key), - $vfp->{$_}) - or return $v_rep_sth->errstr - foreach(@rep_vfields); - - dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit; - - # Now that it has been saved, reset the encrypted fields so that $new - # can still be used. - foreach my $field (keys %{$saved}) { - $new->setfield($field, $saved->{$field}); - } - - ''; - -} - -=item rep - -Depriciated (use replace instead). - -=cut - -sub rep { - cluck "warning: FS::Record::rep deprecated!"; - replace @_; #call method in this scope -} - -=item check - -Checks virtual fields (using check_blocks). Subclasses should still provide -a check method to validate real fields, foreign keys, etc., and call this -method via $self->SUPER::check. - -(FIXME: Should this method try to make sure that it I<is> being called from -a subclass's check method, to keep the current semantics as far as possible?) - -=cut - -sub check { - #confess "FS::Record::check not implemented; supply one in subclass!"; - my $self = shift; - - foreach my $field ($self->virtual_fields) { - for ($self->getfield($field)) { - # See notes on check_block in FS::part_virtual_field. - eval $self->pvf($field)->check_block; - if ( $@ ) { - #this is bad, probably want to follow the stack backtrace up and see - #wtf happened - my $err = "Fatal error checking $field for $self"; - cluck "$err: $@"; - return "$err (see log for backtrace): $@"; - - } - $self->setfield($field, $_); - } - } - ''; -} - -sub _h_statement { - my( $self, $action, $time ) = @_; - - $time ||= time; - - my @fields = - grep defined($self->getfield($_)) && $self->getfield($_) ne "", - real_fields($self->table); - ; - my @values = map { _quote( $self->getfield($_), $self->table, $_) } @fields; - - "INSERT INTO h_". $self->table. " ( ". - join(', ', qw(history_date history_user history_action), @fields ). - ") VALUES (". - join(', ', $time, dbh->quote(getotaker()), dbh->quote($action), @values). - ")" - ; -} - -=item unique COLUMN - -B<Warning>: External use is B<deprecated>. - -Replaces COLUMN in record with a unique number, using counters in the -filesystem. Used by the B<insert> method on single-field unique columns -(see L<DBIx::DBSchema::Table>) and also as a fallback for primary keys -that aren't SERIAL (Pg) or AUTO_INCREMENT (mysql). - -Returns the new value. - -=cut - -sub unique { - my($self,$field) = @_; - my($table)=$self->table; - - croak "Unique called on field $field, but it is ", - $self->getfield($field), - ", not null!" - if $self->getfield($field); - - #warn "table $table is tainted" if is_tainted($table); - #warn "field $field is tainted" if is_tainted($field); - - my($counter) = new File::CounterFile "$table.$field",0; -# hack for web demo -# getotaker() =~ /^([\w\-]{1,16})$/ or die "Illegal CGI REMOTE_USER!"; -# my($user)=$1; -# my($counter) = new File::CounterFile "$user/$table.$field",0; -# endhack - - my $index = $counter->inc; - $index = $counter->inc while qsearchs($table, { $field=>$index } ); - - $index =~ /^(\d*)$/; - $index=$1; - - $self->setfield($field,$index); - -} - -=item ut_float COLUMN - -Check/untaint floating point numeric data: 1.1, 1, 1.1e10, 1e10. May not be -null. If there is an error, returns the error, otherwise returns false. - -=cut - -sub ut_float { - my($self,$field)=@_ ; - ($self->getfield($field) =~ /^(\d+\.\d+)$/ || - $self->getfield($field) =~ /^(\d+)$/ || - $self->getfield($field) =~ /^(\d+\.\d+e\d+)$/ || - $self->getfield($field) =~ /^(\d+e\d+)$/) - or return "Illegal or empty (float) $field: ". $self->getfield($field); - $self->setfield($field,$1); - ''; -} - -=item ut_snumber COLUMN - -Check/untaint signed numeric data (whole numbers). May not be null. If there -is an error, returns the error, otherwise returns false. - -=cut - -sub ut_snumber { - my($self, $field) = @_; - $self->getfield($field) =~ /^(-?)\s*(\d+)$/ - or return "Illegal or empty (numeric) $field: ". $self->getfield($field); - $self->setfield($field, "$1$2"); - ''; -} - -=item ut_number COLUMN - -Check/untaint simple numeric data (whole numbers). May not be null. If there -is an error, returns the error, otherwise returns false. - -=cut - -sub ut_number { - my($self,$field)=@_; - $self->getfield($field) =~ /^(\d+)$/ - or return "Illegal or empty (numeric) $field: ". $self->getfield($field); - $self->setfield($field,$1); - ''; -} - -=item ut_numbern COLUMN - -Check/untaint simple numeric data (whole numbers). May be null. If there is -an error, returns the error, otherwise returns false. - -=cut - -sub ut_numbern { - my($self,$field)=@_; - $self->getfield($field) =~ /^(\d*)$/ - or return "Illegal (numeric) $field: ". $self->getfield($field); - $self->setfield($field,$1); - ''; -} - -=item ut_money COLUMN - -Check/untaint monetary numbers. May be negative. Set to 0 if null. If there -is an error, returns the error, otherwise returns false. - -=cut - -sub ut_money { - my($self,$field)=@_; - $self->setfield($field, 0) if $self->getfield($field) eq ''; - $self->getfield($field) =~ /^(\-)? ?(\d*)(\.\d{2})?$/ - or return "Illegal (money) $field: ". $self->getfield($field); - #$self->setfield($field, "$1$2$3" || 0); - $self->setfield($field, ( ($1||''). ($2||''). ($3||'') ) || 0); - ''; -} - -=item ut_text COLUMN - -Check/untaint text. Alphanumerics, spaces, and the following punctuation -symbols are currently permitted: ! @ # $ % & ( ) - + ; : ' " , . ? / = [ ] -May not be null. If there is an error, returns the error, otherwise returns -false. - -=cut - -sub ut_text { - my($self,$field)=@_; - #warn "msgcat ". \&msgcat. "\n"; - #warn "notexist ". \¬exist. "\n"; - #warn "AUTOLOAD ". \&AUTOLOAD. "\n"; - $self->getfield($field) - =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]]+)$/ - or return gettext('illegal_or_empty_text'). " $field: ". - $self->getfield($field); - $self->setfield($field,$1); - ''; -} - -=item ut_textn COLUMN - -Check/untaint text. Alphanumerics, spaces, and the following punctuation -symbols are currently permitted: ! @ # $ % & ( ) - + ; : ' " , . ? / -May be null. If there is an error, returns the error, otherwise returns false. - -=cut - -sub ut_textn { - my($self,$field)=@_; - $self->getfield($field) - =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]]*)$/ - or return gettext('illegal_text'). " $field: ". $self->getfield($field); - $self->setfield($field,$1); - ''; -} - -=item ut_alpha COLUMN - -Check/untaint alphanumeric strings (no spaces). May not be null. If there is -an error, returns the error, otherwise returns false. - -=cut - -sub ut_alpha { - my($self,$field)=@_; - $self->getfield($field) =~ /^(\w+)$/ - or return "Illegal or empty (alphanumeric) $field: ". - $self->getfield($field); - $self->setfield($field,$1); - ''; -} - -=item ut_alpha COLUMN - -Check/untaint alphanumeric strings (no spaces). May be null. If there is an -error, returns the error, otherwise returns false. - -=cut - -sub ut_alphan { - my($self,$field)=@_; - $self->getfield($field) =~ /^(\w*)$/ - or return "Illegal (alphanumeric) $field: ". $self->getfield($field); - $self->setfield($field,$1); - ''; -} - -=item ut_phonen COLUMN [ COUNTRY ] - -Check/untaint phone numbers. May be null. If there is an error, returns -the error, otherwise returns false. - -Takes an optional two-letter ISO country code; without it or with unsupported -countries, ut_phonen simply calls ut_alphan. - -=cut - -sub ut_phonen { - my( $self, $field, $country ) = @_; - return $self->ut_alphan($field) unless defined $country; - my $phonen = $self->getfield($field); - if ( $phonen eq '' ) { - $self->setfield($field,''); - } elsif ( $country eq 'US' || $country eq 'CA' ) { - $phonen =~ s/\D//g; - $phonen =~ /^(\d{3})(\d{3})(\d{4})(\d*)$/ - or return gettext('illegal_phone'). " $field: ". $self->getfield($field); - $phonen = "$1-$2-$3"; - $phonen .= " x$4" if $4; - $self->setfield($field,$phonen); - } else { - warn "warning: don't know how to check phone numbers for country $country"; - return $self->ut_textn($field); - } - ''; -} - -=item ut_ip COLUMN - -Check/untaint ip addresses. IPv4 only for now. - -=cut - -sub ut_ip { - my( $self, $field ) = @_; - $self->getfield($field) =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/ - or return "Illegal (IP address) $field: ". $self->getfield($field); - for ( $1, $2, $3, $4 ) { return "Illegal (IP address) $field" if $_ > 255; } - $self->setfield($field, "$1.$2.$3.$4"); - ''; -} - -=item ut_ipn COLUMN - -Check/untaint ip addresses. IPv4 only for now. May be null. - -=cut - -sub ut_ipn { - my( $self, $field ) = @_; - if ( $self->getfield($field) =~ /^()$/ ) { - $self->setfield($field,''); - ''; - } else { - $self->ut_ip($field); - } -} - -=item ut_domain COLUMN - -Check/untaint host and domain names. - -=cut - -sub ut_domain { - my( $self, $field ) = @_; - #$self->getfield($field) =~/^(\w+\.)*\w+$/ - $self->getfield($field) =~/^(([\w\-]+\.)*\w+)$/ - or return "Illegal (domain) $field: ". $self->getfield($field); - $self->setfield($field,$1); - ''; -} - -=item ut_name COLUMN - -Check/untaint proper names; allows alphanumerics, spaces and the following -punctuation: , . - ' - -May not be null. - -=cut - -sub ut_name { - my( $self, $field ) = @_; - $self->getfield($field) =~ /^([\w \,\.\-\']+)$/ - or return gettext('illegal_name'). " $field: ". $self->getfield($field); - $self->setfield($field,$1); - ''; -} - -=item ut_zip COLUMN - -Check/untaint zip codes. - -=cut - -my @zip_reqd_countries = qw( CA ); #US implicit... - -sub ut_zip { - my( $self, $field, $country ) = @_; - - if ( $country eq 'US' ) { - - $self->getfield($field) =~ /^\s*(\d{5}(\-\d{4})?)\s*$/ - or return gettext('illegal_zip'). " $field for country $country: ". - $self->getfield($field); - $self->setfield($field, $1); - - } elsif ( $country eq 'CA' ) { - - $self->getfield($field) =~ /^\s*([A-Z]\d[A-Z])\s*(\d[A-Z]\d)\s*$/i - or return gettext('illegal_zip'). " $field for country $country: ". - $self->getfield($field); - $self->setfield($field, "$1 $2"); - - } else { - - if ( $self->getfield($field) =~ /^\s*$/ - && ( !$country || ! grep { $_ eq $country } @zip_reqd_countries ) - ) - { - $self->setfield($field,''); - } else { - $self->getfield($field) =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/ - or return gettext('illegal_zip'). " $field: ". $self->getfield($field); - $self->setfield($field,$1); - } - - } - - ''; -} - -=item ut_country COLUMN - -Check/untaint country codes. Country names are changed to codes, if possible - -see L<Locale::Country>. - -=cut - -sub ut_country { - my( $self, $field ) = @_; - unless ( $self->getfield($field) =~ /^(\w\w)$/ ) { - if ( $self->getfield($field) =~ /^([\w \,\.\(\)\']+)$/ - && country2code($1) ) { - $self->setfield($field,uc(country2code($1))); - } - } - $self->getfield($field) =~ /^(\w\w)$/ - or return "Illegal (country) $field: ". $self->getfield($field); - $self->setfield($field,uc($1)); - ''; -} - -=item ut_anything COLUMN - -Untaints arbitrary data. Be careful. - -=cut - -sub ut_anything { - my( $self, $field ) = @_; - $self->getfield($field) =~ /^(.*)$/s - or return "Illegal $field: ". $self->getfield($field); - $self->setfield($field,$1); - ''; -} - -=item ut_enum COLUMN CHOICES_ARRAYREF - -Check/untaint a column, supplying all possible choices, like the "enum" type. - -=cut - -sub ut_enum { - my( $self, $field, $choices ) = @_; - foreach my $choice ( @$choices ) { - if ( $self->getfield($field) eq $choice ) { - $self->setfield($choice); - return ''; - } - } - return "Illegal (enum) field $field: ". $self->getfield($field); -} - -=item ut_foreign_key COLUMN FOREIGN_TABLE FOREIGN_COLUMN - -Check/untaint a foreign column key. Call a regular ut_ method (like ut_number) -on the column first. - -=cut - -sub ut_foreign_key { - my( $self, $field, $table, $foreign ) = @_; - qsearchs($table, { $foreign => $self->getfield($field) }) - or return "Can't find ". $self->table. ".$field ". $self->getfield($field). - " in $table.$foreign"; - ''; -} - -=item ut_foreign_keyn COLUMN FOREIGN_TABLE FOREIGN_COLUMN - -Like ut_foreign_key, except the null value is also allowed. - -=cut - -sub ut_foreign_keyn { - my( $self, $field, $table, $foreign ) = @_; - $self->getfield($field) - ? $self->ut_foreign_key($field, $table, $foreign) - : ''; -} - -=item ut_agentnum_acl - -Checks this column as an agentnum, taking into account the current users's -ACLs. - -=cut - -sub ut_agentnum_acl { - my( $self, $field, $null_acl ) = @_; - - my $error = $self->ut_foreign_keyn($field, 'agent', 'agentnum'); - return "Illegal agentnum: $error" if $error; - - my $curuser = $FS::CurrentUser::CurrentUser; - - if ( $self->$field() ) { - - return "Access deined" - unless $curuser->agentnum($self->$field()); - - } else { - - return "Access denied" - unless $curuser->access_right($null_acl); - - } - - ''; - -} - -=item virtual_fields [ TABLE ] - -Returns a list of virtual fields defined for the table. This should not -be exported, and should only be called as an instance or class method. - -=cut - -sub virtual_fields { - my $self = shift; - my $table; - $table = $self->table or confess "virtual_fields called on non-table"; - - confess "Unknown table $table" unless dbdef->table($table); - - return () unless dbdef->table('part_virtual_field'); - - unless ( $virtual_fields_cache{$table} ) { - my $query = 'SELECT name from part_virtual_field ' . - "WHERE dbtable = '$table'"; - my $dbh = dbh; - my $result = $dbh->selectcol_arrayref($query); - confess "Error executing virtual fields query: $query: ". $dbh->errstr - if $dbh->err; - $virtual_fields_cache{$table} = $result; - } - - @{$virtual_fields_cache{$table}}; - -} - - -=item fields [ TABLE ] - -This is a wrapper for real_fields and virtual_fields. Code that called -fields before should probably continue to call fields. - -=cut - -sub fields { - my $something = shift; - my $table; - if($something->isa('FS::Record')) { - $table = $something->table; - } else { - $table = $something; - $something = "FS::$table"; - } - return (real_fields($table), $something->virtual_fields()); -} - -=back - -=item pvf FIELD_NAME - -Returns the FS::part_virtual_field object corresponding to a field in the -record (specified by FIELD_NAME). - -=cut - -sub pvf { - my ($self, $name) = (shift, shift); - - if(grep /^$name$/, $self->virtual_fields) { - return qsearchs('part_virtual_field', { dbtable => $self->table, - name => $name } ); - } - '' -} - -=head1 SUBROUTINES - -=over 4 - -=item real_fields [ TABLE ] - -Returns a list of the real columns in the specified table. Called only by -fields() and other subroutines elsewhere in FS::Record. - -=cut - -sub real_fields { - my $table = shift; - - my($table_obj) = dbdef->table($table); - confess "Unknown table $table" unless $table_obj; - $table_obj->columns; -} - -=item _quote VALUE, TABLE, COLUMN - -This is an internal function used to construct SQL statements. It returns -VALUE DBI-quoted (see L<DBI/"quote">) unless VALUE is a number and the column -type (see L<DBIx::DBSchema::Column>) does not end in `char' or `binary'. - -=cut - -sub _quote { - my($value, $table, $column) = @_; - my $column_obj = dbdef->table($table)->column($column); - my $column_type = $column_obj->type; - my $nullable = $column_obj->null; - - warn " $table.$column: $value ($column_type". - ( $nullable ? ' NULL' : ' NOT NULL' ). - ")\n" if $DEBUG > 2; - - if ( $value eq '' && $column_type =~ /^(int|numeric)/ ) { - if ( $nullable ) { - 'NULL'; - } else { - cluck "WARNING: Attempting to set non-null integer $table.$column null; ". - "using 0 instead"; - 0; - } - } elsif ( $value =~ /^\d+(\.\d+)?$/ && - ! $column_type =~ /(char|binary|text)$/i ) { - $value; - } else { - dbh->quote($value); - } -} - -=item vfieldpart_hashref TABLE - -Returns a hashref of virtual field names and vfieldparts applicable to the given -TABLE. - -=cut - -sub vfieldpart_hashref { - my $self = shift; - my $table = $self->table; - - return {} unless dbdef->table('part_virtual_field'); - - my $dbh = dbh; - my $statement = "SELECT vfieldpart, name FROM part_virtual_field WHERE ". - "dbtable = '$table'"; - my $sth = $dbh->prepare($statement); - $sth->execute or croak "Execution of '$statement' failed: ".$dbh->errstr; - return { map { $_->{name}, $_->{vfieldpart} } - @{$sth->fetchall_arrayref({})} }; - -} - - -=item hfields TABLE - -This is deprecated. Don't use it. - -It returns a hash-type list with the fields of this record's table set true. - -=cut - -sub hfields { - carp "warning: hfields is deprecated"; - my($table)=@_; - my(%hash); - foreach (fields($table)) { - $hash{$_}=1; - } - \%hash; -} - -sub _dump { - my($self)=@_; - join("\n", map { - "$_: ". $self->getfield($_). "|" - } (fields($self->table)) ); -} - -sub encrypt { - my ($self, $value) = @_; - my $encrypted; - - my $conf = new FS::Conf; - if ($conf->exists('encryption')) { - if ($self->is_encrypted($value)) { - # Return the original value if it isn't plaintext. - $encrypted = $value; - } else { - $self->loadRSA; - if (ref($rsa_encrypt) =~ /::RSA/) { # We Can Encrypt - # RSA doesn't like the empty string so let's pack it up - # The database doesn't like the RSA data so uuencode it - my $length = length($value)+1; - $encrypted = pack("u*",$rsa_encrypt->encrypt(pack("Z$length",$value))); - } else { - die ("You can't encrypt w/o a valid RSA engine - Check your installation or disable encryption"); - } - } - } - return $encrypted; -} - -sub is_encrypted { - my ($self, $value) = @_; - # Possible Bug - Some work may be required here.... - - if (length($value) > 80) { - return 1; - } else { - return 0; - } -} - -sub decrypt { - my ($self,$value) = @_; - my $decrypted = $value; # Will return the original value if it isn't encrypted or can't be decrypted. - my $conf = new FS::Conf; - if ($conf->exists('encryption') && $self->is_encrypted($value)) { - $self->loadRSA; - if (ref($rsa_decrypt) =~ /::RSA/) { - my $encrypted = unpack ("u*", $value); - $decrypted = unpack("Z*", $rsa_decrypt->decrypt($encrypted)); - } - } - return $decrypted; -} - -sub loadRSA { - my $self = shift; - #Initialize the Module - $rsa_module = 'Crypt::OpenSSL::RSA'; # The Default - - my $conf = new FS::Conf; - if ($conf->exists('encryptionmodule') && $conf->config('encryptionmodule') ne '') { - $rsa_module = $conf->config('encryptionmodule'); - } - - if (!$rsa_loaded) { - eval ("require $rsa_module"); # No need to import the namespace - $rsa_loaded++; - } - # Initialize Encryption - if ($conf->exists('encryptionpublickey') && $conf->config('encryptionpublickey') ne '') { - my $public_key = join("\n",$conf->config('encryptionpublickey')); - $rsa_encrypt = $rsa_module->new_public_key($public_key); - } - - # Intitalize Decryption - if ($conf->exists('encryptionprivatekey') && $conf->config('encryptionprivatekey') ne '') { - my $private_key = join("\n",$conf->config('encryptionprivatekey')); - $rsa_decrypt = $rsa_module->new_private_key($private_key); - } -} - -sub DESTROY { return; } - -#sub DESTROY { -# my $self = shift; -# #use Carp qw(cluck); -# #cluck "DESTROYING $self"; -# warn "DESTROYING $self"; -#} - -#sub is_tainted { -# return ! eval { join('',@_), kill 0; 1; }; -# } - -=back - -=head1 BUGS - -This module should probably be renamed, since much of the functionality is -of general use. It is not completely unlike Adapter::DBI (see below). - -Exported qsearch and qsearchs should be deprecated in favor of method calls -(against an FS::Record object like the old search and searchs that qsearch -and qsearchs were on top of.) - -The whole fields / hfields mess should be removed. - -The various WHERE clauses should be subroutined. - -table string should be deprecated in favor of DBIx::DBSchema::Table. - -No doubt we could benefit from a Tied hash. Documenting how exists / defined -true maps to the database (and WHERE clauses) would also help. - -The ut_ methods should ask the dbdef for a default length. - -ut_sqltype (like ut_varchar) should all be defined - -A fallback check method should be provided which uses the dbdef. - -The ut_money method assumes money has two decimal digits. - -The Pg money kludge in the new method only strips `$'. - -The ut_phonen method only checks US-style phone numbers. - -The _quote function should probably use ut_float instead of a regex. - -All the subroutines probably should be methods, here or elsewhere. - -Probably should borrow/use some dbdef methods where appropriate (like sub -fields) - -As of 1.14, DBI fetchall_hashref( {} ) doesn't set fetchrow_hashref NAME_lc, -or allow it to be set. Working around it is ugly any way around - DBI should -be fixed. (only affects RDBMS which return uppercase column names) - -ut_zip should take an optional country like ut_phone. - -=head1 SEE ALSO - -L<DBIx::DBSchema>, L<FS::UID>, L<DBI> - -Adapter::DBI from Ch. 11 of Advanced Perl Programming by Sriram Srinivasan. - -http://poop.sf.net/ - -=cut - -1; - diff --git a/FS/FS/Report.pm b/FS/FS/Report.pm deleted file mode 100644 index 181fea2..0000000 --- a/FS/FS/Report.pm +++ /dev/null @@ -1,46 +0,0 @@ -package FS::Report; - -use strict; - -=head1 NAME - -FS::Report - Report data objects - -=head1 SYNOPSIS - - #see the more speicific report objects, currently only FS::Report::Table - -=head1 DESCRIPTION - -See the more specific report objects, currently only FS::Report::Table - -=head1 METHODS - -=over 4 - -=item new [ OPTION => VALUE ... ] - -Constructor. Takes a list of options and their values. - -=cut - -sub new { - my $proto = shift; - my $class = ref($proto) || $proto; - my $self = @_ ? ( ref($_[0]) ? shift : { @_ } ) : {}; - bless( $self, $class ); -} - -=back - -=head1 BUGS - -Documentation. - -=head1 SEE ALSO - -L<FS::Report::Table>, reports in the web interface. - -=cut - -1; diff --git a/FS/FS/Report/Table.pm b/FS/FS/Report/Table.pm deleted file mode 100644 index 9f636fa..0000000 --- a/FS/FS/Report/Table.pm +++ /dev/null @@ -1,27 +0,0 @@ -package FS::Report::Table; - -use strict; -use vars qw( @ISA ); -use FS::Report; - -@ISA = qw( FS::Report ); - -=head1 NAME - -FS::Report::Table - Tables of report data - -=head1 SYNOPSIS - -See the more specific report objects, currently only FS::Report::Table::Monthly - -=head1 BUGS - -Documentation. - -=head1 SEE ALSO - -L<FS::Report::Table::Monthly>, reports in the web interface. - -=cut - -1; diff --git a/FS/FS/Report/Table/Monthly.pm b/FS/FS/Report/Table/Monthly.pm deleted file mode 100644 index 145f2a8..0000000 --- a/FS/FS/Report/Table/Monthly.pm +++ /dev/null @@ -1,366 +0,0 @@ -package FS::Report::Table::Monthly; - -use strict; -use vars qw( @ISA $expenses_kludge ); -use Time::Local; -use FS::UID qw( dbh ); -use FS::Report::Table; -use FS::CurrentUser; - -@ISA = qw( FS::Report::Table ); - -$expenses_kludge = 0; - -=head1 NAME - -FS::Report::Table::Monthly - Tables of report data, indexed monthly - -=head1 SYNOPSIS - - use FS::Report::Table::Monthly; - - my $report = new FS::Report::Table::Monthly ( - 'items' => [ 'invoiced', 'netsales', 'credits', 'receipts', ], - 'start_month' => 4, - 'start_year' => 2000, - 'end_month' => 4, - 'end_year' => 2020, - #opt - 'agentnum' => 54 - 'params' => [ [ 'paramsfor', 'item_one' ], [ 'item', 'two' ] ], # ... - 'remove_empty' => 1, #collapse empty rows, default 0 - 'item_labels' => [ ], #useful with remove_empty - ); - - my $data = $report->data; - -=head1 METHODS - -=over 4 - -=item data - -Returns a hashref of data (!! describe) - -=cut - -sub data { - my $self = shift; - - #use Data::Dumper; - #warn Dumper($self); - - my $smonth = $self->{'start_month'}; - my $syear = $self->{'start_year'}; - my $emonth = $self->{'end_month'}; - my $eyear = $self->{'end_year'}; - my $agentnum = $self->{'agentnum'}; - - my %data; - - while ( $syear < $eyear || ( $syear == $eyear && $smonth < $emonth+1 ) ) { - - push @{$data{label}}, "$smonth/$syear"; - - my $speriod = timelocal(0,0,0,1,$smonth-1,$syear); - push @{$data{speriod}}, $speriod; - if ( ++$smonth == 13 ) { $syear++; $smonth=1; } - my $eperiod = timelocal(0,0,0,1,$smonth-1,$syear); - push @{$data{eperiod}}, $eperiod; - - my $col = 0; - my @row = (); - foreach my $item ( @{$self->{'items'}} ) { - my @param = $self->{'params'} ? @{ $self->{'params'}[$col] }: (); - my $value = $self->$item($speriod, $eperiod, $agentnum, @param); - #push @{$data{$item}}, $value; - push @{$data{data}->[$col++]}, $value; - } - - } - - #these need to get generalized, sheesh - $data{'items'} = $self->{'items'}; - $data{'item_labels'} = $self->{'item_labels'} || $self->{'items'}; - $data{'colors'} = $self->{'colors'}; - $data{'links'} = $self->{'links'} || []; - - #use Data::Dumper; - #warn Dumper(\%data); - - if ( $self->{'remove_empty'} ) { - - #warn "removing empty rows\n"; - - my $col = 0; - #these need to get generalized, sheesh - my @newitems = (); - my @newlabels = (); - my @newdata = (); - my @newcolors = (); - my @newlinks = (); - foreach my $item ( @{$self->{'items'}} ) { - - if ( grep { $_ != 0 } @{$data{'data'}->[$col]} ) { - push @newitems, $data{'items'}->[$col]; - push @newlabels, $data{'item_labels'}->[$col]; - push @newdata, $data{'data'}->[$col]; - push @newcolors, $data{'colors'}->[$col]; - push @newlinks, $data{'links'}->[$col]; - } - - $col++; - } - - $data{'items'} = \@newitems; - $data{'item_labels'} = \@newlabels; - $data{'data'} = \@newdata; - $data{'colors'} = \@newcolors; - $data{'links'} = \@newlinks; - - } - - #use Data::Dumper; - #warn Dumper(\%data); - - \%data; - -} - -sub invoiced { #invoiced - my( $self, $speriod, $eperiod, $agentnum ) = @_; - - $self->scalar_sql(" - SELECT SUM(charged) - FROM cust_bill - LEFT JOIN cust_main USING ( custnum ) - WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum) - ); - -} - -sub netsales { #net sales - my( $self, $speriod, $eperiod, $agentnum ) = @_; - - my $credited = $self->scalar_sql(" - SELECT SUM(cust_credit_bill.amount) - FROM cust_credit_bill - LEFT JOIN cust_bill USING ( invnum ) - LEFT JOIN cust_main USING ( custnum ) - WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum, 'cust_bill') - ); - - #horrible local kludge - my $expenses = !$expenses_kludge ? 0 : $self->scalar_sql(" - SELECT SUM(cust_bill_pkg.setup) - FROM cust_bill_pkg - LEFT JOIN cust_bill USING ( invnum ) - LEFT JOIN cust_main USING ( custnum ) - LEFT JOIN cust_pkg USING ( pkgnum ) - LEFT JOIN part_pkg USING ( pkgpart ) - WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum, 'cust_bill'). " - AND LOWER(part_pkg.pkg) LIKE 'expense _%' - "); - - $self->invoiced($speriod,$eperiod,$agentnum) - $credited - $expenses; -} - -#deferred revenue - -sub receipts { #cashflow - my( $self, $speriod, $eperiod, $agentnum ) = @_; - - my $refunded = $self->scalar_sql(" - SELECT SUM(refund) - FROM cust_refund - LEFT JOIN cust_main USING ( custnum ) - WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum) - ); - - #horrible local kludge that doesn't even really work right - my $expenses = !$expenses_kludge ? 0 : $self->scalar_sql(" - SELECT SUM(cust_bill_pay.amount) - FROM cust_bill_pay - LEFT JOIN cust_bill USING ( invnum ) - LEFT JOIN cust_main USING ( custnum ) - WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum, 'cust_bill_pay'). " - AND 0 < ( SELECT COUNT(*) from cust_bill_pkg, cust_pkg, part_pkg - WHERE cust_bill.invnum = cust_bill_pkg.invnum - AND cust_pkg.pkgnum = cust_bill_pkg.pkgnum - AND cust_pkg.pkgpart = part_pkg.pkgpart - AND LOWER(part_pkg.pkg) LIKE 'expense _%' - ) - "); - # my $expenses_sql2 = "SELECT SUM(cust_bill_pay.amount) FROM cust_bill_pay, cust_bill_pkg, cust_bill, cust_pkg, part_pkg WHERE cust_bill_pay.invnum = cust_bill.invnum AND cust_bill.invnum = cust_bill_pkg.invnum AND cust_bill_pay._date >= $speriod AND cust_bill_pay._date < $eperiod AND cust_pkg.pkgnum = cust_bill_pkg.pkgnum AND cust_pkg.pkgpart = part_pkg.pkgpart AND LOWER(part_pkg.pkg) LIKE 'expense _%'"; - - $self->payments($speriod, $eperiod, $agentnum) - $refunded - $expenses; -} - -sub payments { - my( $self, $speriod, $eperiod, $agentnum ) = @_; - $self->scalar_sql(" - SELECT SUM(paid) - FROM cust_pay - LEFT JOIN cust_main USING ( custnum ) - WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum) - ); -} - -sub credits { - my( $self, $speriod, $eperiod, $agentnum ) = @_; - $self->scalar_sql(" - SELECT SUM(amount) - FROM cust_credit - LEFT JOIN cust_main USING ( custnum ) - WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum) - ); -} - -#these should be auto-generated or $AUTOLOADed or something -sub invoiced_12mo { - my( $self, $speriod, $eperiod, $agentnum ) = @_; - $speriod = $self->_subtract_11mo($speriod); - $self->invoiced($speriod, $eperiod, $agentnum); -} - -sub netsales_12mo { - my( $self, $speriod, $eperiod, $agentnum ) = @_; - $speriod = $self->_subtract_11mo($speriod); - $self->netsales($speriod, $eperiod, $agentnum); -} - -sub receipts_12mo { - my( $self, $speriod, $eperiod, $agentnum ) = @_; - $speriod = $self->_subtract_11mo($speriod); - $self->receipts($speriod, $eperiod, $agentnum); -} - -sub payments_12mo { - my( $self, $speriod, $eperiod, $agentnum ) = @_; - $speriod = $self->_subtract_11mo($speriod); - $self->payments($speriod, $eperiod, $agentnum); -} - -sub credits_12mo { - my( $self, $speriod, $eperiod, $agentnum ) = @_; - $speriod = $self->_subtract_11mo($speriod); - $self->credits($speriod, $eperiod, $agentnum); -} - -#not being too bad with the false laziness -use Time::Local qw(timelocal); -sub _subtract_11mo { - my($self, $time) = @_; - my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($time) )[0,1,2,3,4,5]; - $mon -= 11; - if ( $mon < 0 ) { $mon+=12; $year--; } - timelocal($sec,$min,$hour,$mday,$mon,$year); -} - -sub cust_bill_pkg { - my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_; - - my $where = ''; - if ( $opt{'classnum'} =~ /^(\d+)$/ ) { - if ( $1 == 0 ) { - $where = "classnum IS NULL"; - } else { - $where = "classnum = $1"; - } - } - - $agentnum ||= $opt{'agentnum'}; - - $self->scalar_sql(" - SELECT SUM(cust_bill_pkg.setup + cust_bill_pkg.recur) - FROM cust_bill_pkg - LEFT JOIN cust_bill USING ( invnum ) - LEFT JOIN cust_main USING ( custnum ) - LEFT JOIN cust_pkg USING ( pkgnum ) - LEFT JOIN part_pkg USING ( pkgpart ) - WHERE pkgnum != 0 - AND $where - AND ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum) - ); - -} - -# NEEDS TO BE AGENTNUM-capable -sub canceled { #active - my( $self, $speriod, $eperiod, $agentnum ) = @_; - $self->scalar_sql(" - SELECT COUNT(*) - FROM cust_pkg - LEFT JOIN cust_main USING ( custnum ) - WHERE 0 = ( SELECT COUNT(*) - FROM cust_pkg - WHERE cust_pkg.custnum = cust_main.custnum - AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) - ) - AND cust_pkg.cancel > $speriod AND cust_pkg.cancel < $eperiod - "); -} - -# NEEDS TO BE AGENTNUM-capable -sub newaccount { #newaccount - my( $self, $speriod, $eperiod, $agentnum ) = @_; - $self->scalar_sql(" - SELECT COUNT(*) FROM cust_pkg - WHERE cust_pkg.custnum = cust_main.custnum - AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) - AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) - AND cust_pkg.setup > $speriod AND cust_pkg.setup < $eperiod - "); -} - -# NEEDS TO BE AGENTNUM-capable -sub suspended { #suspended - my( $self, $speriod, $eperiod, $agentnum ) = @_; - $self->scalar_sql(" - SELECT COUNT(*) FROM cust_pkg - WHERE cust_pkg.custnum = cust_main.custnum - AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) - AND 0 = ( SELECT COUNT(*) FROM cust_pkg - WHERE cust_pkg.custnum = cust_main.custnum - AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) - ) - AND cust_pkg.susp > $speriod AND cust_pkg.susp < $eperiod - "); -} - -sub in_time_period_and_agent { - my( $self, $speriod, $eperiod, $agentnum ) = splice(@_, 0, 4); - my $table = @_ ? shift().'.' : ''; - - my $sql = "${table}_date >= $speriod AND ${table}_date < $eperiod"; - - #agent selection - $sql .= " AND agentnum = $agentnum" - if $agentnum; - - #agent virtualization - $sql .= ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql; - - $sql; -} - -sub scalar_sql { - my( $self, $sql ) = ( shift, shift ); - my $sth = dbh->prepare($sql) or die dbh->errstr; - $sth->execute - or die "Unexpected error executing statement $sql: ". $sth->errstr; - $sth->fetchrow_arrayref->[0] || 0; -} - -=back - -=head1 BUGS - -Documentation. - -=head1 SEE ALSO - -=cut - -1; - diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm deleted file mode 100644 index 0bb97f4..0000000 --- a/FS/FS/Schema.pm +++ /dev/null @@ -1,1602 +0,0 @@ -package FS::Schema; - -use vars qw(@ISA @EXPORT_OK $DEBUG $setup_hack %dbdef_cache); -use subs qw(reload_dbdef); -use Exporter; -use DBIx::DBSchema 0.30; -use DBIx::DBSchema::Table; -use DBIx::DBSchema::Column 0.06; -use DBIx::DBSchema::ColGroup::Unique; -use DBIx::DBSchema::ColGroup::Index; -use FS::UID qw(datasrc); - -@ISA = qw(Exporter); -@EXPORT_OK = qw( dbdef dbdef_dist reload_dbdef ); - -$DEBUG = 0; -$me = '[FS::Schema]'; - -=head1 NAME - -FS::Schema - Freeside database schema - -=head1 SYNOPSYS - - use FS::Schema qw(dbdef dbdef_dist reload_dbdef); - - $dbdef = reload_dbdef; - $dbdef = reload_dbdef "/non/standard/filename"; - $dbdef = dbdef; - $dbdef_dist = dbdef_dist; - -=head1 DESCRIPTION - -This class represents the database schema. - -=head1 METHODS - -=over 4 - -=item reload_dbdef([FILENAME]) - -Load a database definition (see L<DBIx::DBSchema>), optionally from a -non-default filename. This command is executed at startup unless -I<$FS::Schema::setup_hack> is true. Returns a DBIx::DBSchema object. - -=cut - -sub reload_dbdef { - my $file = shift; - - unless ( exists $dbdef_cache{$file} ) { - warn "[debug]$me loading dbdef for $file\n" if $DEBUG; - $dbdef_cache{$file} = DBIx::DBSchema->load( $file ) - or die "can't load database schema from $file"; - } else { - warn "[debug]$me re-using cached dbdef for $file\n" if $DEBUG; - } - $dbdef = $dbdef_cache{$file}; -} - -=item dbdef - -Returns the current database definition (represents the current database, -assuming it is up-to-date). See L<DBIx::DBSchema>. - -=cut - -sub dbdef { $dbdef; } - -=item dbdef_dist [ OPTION => VALUE ... ] - -Returns the current canoical database definition as defined in this file. - -=cut - -sub dbdef_dist { - - ### - # create a dbdef object from the old data structure - ### - - my $tables_hashref = tables_hashref(); - - #turn it into objects - my $dbdef = new DBIx::DBSchema map { - my @columns; - while (@{$tables_hashref->{$_}{'columns'}}) { - #my($name, $type, $null, $length, $default, $local) = - my @coldef = - splice @{$tables_hashref->{$_}{'columns'}}, 0, 6; - my %hash = map { $_ => shift @coldef } - qw( name type null length default local ); - - unless ( defined $hash{'default'} ) { - warn "$_:\n". - join('', map "$_ => $hash{$_}\n", keys %hash) ;# $stop = <STDIN>; - } - - push @columns, new DBIx::DBSchema::Column ( \%hash ); - } - DBIx::DBSchema::Table->new( - $_, - $tables_hashref->{$_}{'primary_key'}, - DBIx::DBSchema::ColGroup::Unique->new($tables_hashref->{$_}{'unique'}), - DBIx::DBSchema::ColGroup::Index->new($tables_hashref->{$_}{'index'}), - @columns, - ); - } keys %$tables_hashref; - - if ( $DEBUG ) { - warn "[debug]$me initial dbdef_dist created ($dbdef) with tables:\n"; - warn "[debug]$me $_\n" foreach $dbdef->tables; - } - - my $cust_main = $dbdef->table('cust_main'); - #unless ($ship) { #remove ship_ from cust_main - # $cust_main->delcolumn($_) foreach ( grep /^ship_/, $cust_main->columns ); - #} else { #add indices - push @{$cust_main->index->lol_ref}, - map { [ "ship_$_" ] } qw( last company daytime night fax ); - #} - - #add radius attributes to svc_acct - # - #my($svc_acct)=$dbdef->table('svc_acct'); - # - #my($attribute); - #foreach $attribute (@attributes) { - # $svc_acct->addcolumn ( new DBIx::DBSchema::Column ( - # 'radius_'. $attribute, - # 'varchar', - # 'NULL', - # $char_d, - # )); - #} - # - #foreach $attribute (@check_attributes) { - # $svc_acct->addcolumn( new DBIx::DBSchema::Column ( - # 'rc_'. $attribute, - # 'varchar', - # 'NULL', - # $char_d, - # )); - #} - - #create history tables (false laziness w/create-history-tables) - foreach my $table ( - grep { ! /^clientapi_session/ } - grep { ! /^h_/ } - $dbdef->tables - ) { - my $tableobj = $dbdef->table($table) - or die "unknown table $table"; - - die "unique->lol_ref undefined for $table" - unless defined $tableobj->unique->lol_ref; - die "index->lol_ref undefined for $table" - unless defined $tableobj->index->lol_ref; - - my $h_tableobj = DBIx::DBSchema::Table->new( { - name => "h_$table", - primary_key => 'historynum', - unique => DBIx::DBSchema::ColGroup::Unique->new( [] ), - 'index' => DBIx::DBSchema::ColGroup::Index->new( [ - @{$tableobj->unique->lol_ref}, - @{$tableobj->index->lol_ref} - ] ), - columns => [ - DBIx::DBSchema::Column->new( { - 'name' => 'historynum', - 'type' => 'serial', - 'null' => 'NOT NULL', - 'length' => '', - 'default' => '', - 'local' => '', - } ), - DBIx::DBSchema::Column->new( { - 'name' => 'history_date', - 'type' => 'int', - 'null' => 'NULL', - 'length' => '', - 'default' => '', - 'local' => '', - } ), - DBIx::DBSchema::Column->new( { - 'name' => 'history_user', - 'type' => 'varchar', - 'null' => 'NOT NULL', - 'length' => '80', - 'default' => '', - 'local' => '', - } ), - DBIx::DBSchema::Column->new( { - 'name' => 'history_action', - 'type' => 'varchar', - 'null' => 'NOT NULL', - 'length' => '80', - 'default' => '', - 'local' => '', - } ), - map { - my $column = $tableobj->column($_); - - #clone so as to not disturb the original - $column = DBIx::DBSchema::Column->new( { - map { $_ => $column->$_() } - qw( name type null length default local ) - } ); - - if ( $column->type eq 'serial' ) { - $column->type('int'); - $column->null('NULL'); - } - #$column->default('') - # if $column->default =~ /^nextval\(/i; - #( my $local = $column->local ) =~ s/AUTO_INCREMENT//i; - #$column->local($local); - $column; - } $tableobj->columns - ], - } ); - $dbdef->addtable($h_tableobj); - } - - $dbdef; - -} - -sub tables_hashref { - - my $char_d = 80; #default maxlength for text fields - - #my(@date_type) = ( 'timestamp', '', '' ); - my @date_type = ( 'int', 'NULL', '' ); - my @perl_type = ( 'text', 'NULL', '' ); - my @money_type = ( 'decimal', '', '10,2' ); - - my $username_len = 32; #usernamemax config file - - # name type nullability length default local - - return { - - 'agent' => { - 'columns' => [ - 'agentnum', 'serial', '', '', '', '', - 'agent', 'varchar', '', $char_d, '', '', - 'typenum', 'int', '', '', '', '', - 'freq', 'int', 'NULL', '', '', '', - 'prog', @perl_type, '', '', - 'disabled', 'char', 'NULL', 1, '', '', - 'username', 'varchar', 'NULL', $char_d, '', '', - '_password','varchar', 'NULL', $char_d, '', '', - 'ticketing_queueid', 'int', 'NULL', '', '', '', - ], - 'primary_key' => 'agentnum', - 'unique' => [], - 'index' => [ ['typenum'], ['disabled'] ], - }, - - 'agent_type' => { - 'columns' => [ - 'typenum', 'serial', '', '', '', '', - 'atype', 'varchar', '', $char_d, '', '', - ], - 'primary_key' => 'typenum', - 'unique' => [], - 'index' => [], - }, - - 'type_pkgs' => { - 'columns' => [ - 'typepkgnum', 'serial', '', '', '', '', - 'typenum', 'int', '', '', '', '', - 'pkgpart', 'int', '', '', '', '', - ], - 'primary_key' => 'typepkgnum', - 'unique' => [ ['typenum', 'pkgpart'] ], - 'index' => [ ['typenum'] ], - }, - - 'cust_bill' => { - 'columns' => [ - 'invnum', 'serial', '', '', '', '', - 'custnum', 'int', '', '', '', '', - '_date', @date_type, '', '', - 'charged', @money_type, '', '', - 'printed', 'int', '', '', '', '', - 'closed', 'char', 'NULL', 1, '', '', - ], - 'primary_key' => 'invnum', - 'unique' => [], - 'index' => [ ['custnum'], ['_date'] ], - }, - - 'cust_bill_event' => { - 'columns' => [ - 'eventnum', 'serial', '', '', '', '', - 'invnum', 'int', '', '', '', '', - 'eventpart', 'int', '', '', '', '', - '_date', @date_type, '', '', - 'status', 'varchar', '', $char_d, '', '', - 'statustext', 'text', 'NULL', '', '', '', - ], - 'primary_key' => 'eventnum', - #no... there are retries now #'unique' => [ [ 'eventpart', 'invnum' ] ], - 'unique' => [], - 'index' => [ ['invnum'], ['status'] ], - }, - - 'part_bill_event' => { - 'columns' => [ - 'eventpart', 'serial', '', '', '', '', - 'freq', 'varchar', 'NULL', $char_d, '', '', - 'payby', 'char', '', 4, '', '', - 'event', 'varchar', '', $char_d, '', '', - 'eventcode', @perl_type, '', '', - 'seconds', 'int', 'NULL', '', '', '', - 'weight', 'int', '', '', '', '', - 'plan', 'varchar', 'NULL', $char_d, '', '', - 'plandata', 'text', 'NULL', '', '', '', - 'disabled', 'char', 'NULL', 1, '', '', - ], - 'primary_key' => 'eventpart', - 'unique' => [], - 'index' => [ ['payby'], ['disabled'], ], - }, - - 'cust_bill_pkg' => { - 'columns' => [ - 'billpkgnum', 'serial', '', '', '', '', - 'pkgnum', 'int', '', '', '', '', - 'invnum', 'int', '', '', '', '', - 'setup', @money_type, '', '', - 'recur', @money_type, '', '', - 'sdate', @date_type, '', '', - 'edate', @date_type, '', '', - 'itemdesc', 'varchar', 'NULL', $char_d, '', '', - ], - 'primary_key' => 'billpkgnum', - 'unique' => [], - 'index' => [ ['invnum'], [ 'pkgnum' ] ], - }, - - 'cust_bill_pkg_detail' => { - 'columns' => [ - 'detailnum', 'serial', '', '', '', '', - 'pkgnum', 'int', '', '', '', '', - 'invnum', 'int', '', '', '', '', - 'detail', 'varchar', '', $char_d, '', '', - ], - 'primary_key' => 'detailnum', - 'unique' => [], - 'index' => [ [ 'pkgnum', 'invnum' ] ], - }, - - 'cust_credit' => { - 'columns' => [ - 'crednum', 'serial', '', '', '', '', - 'custnum', 'int', '', '', '', '', - '_date', @date_type, '', '', - 'amount', @money_type, '', '', - 'otaker', 'varchar', '', 32, '', '', - 'reason', 'text', 'NULL', '', '', '', - 'closed', 'char', 'NULL', 1, '', '', - ], - 'primary_key' => 'crednum', - 'unique' => [], - 'index' => [ ['custnum'] ], - }, - - 'cust_credit_bill' => { - 'columns' => [ - 'creditbillnum', 'serial', '', '', '', '', - 'crednum', 'int', '', '', '', '', - 'invnum', 'int', '', '', '', '', - '_date', @date_type, '', '', - 'amount', @money_type, '', '', - ], - 'primary_key' => 'creditbillnum', - 'unique' => [], - 'index' => [ ['crednum'], ['invnum'] ], - }, - - 'cust_credit_bill_pkg' => { - 'columns' => [ - 'creditbillpkgnum', 'serial', '', '', '', '', - 'creditbillnum', 'int', '', '', '', '', - 'billpkgnum', 'int', '', '', '', '', - 'amount', @money_type, '', '', - 'setuprecur', 'varchar', '', $char_d, '', '', - ], - 'primary_key' => 'creditbillpkgnum', - 'unique' => [], - 'index' => [ [ 'creditbillnum' ], [ 'billpkgnum' ], ], - }, - - 'cust_main' => { - 'columns' => [ - 'custnum', 'serial', '', '', '', '', - 'agentnum', 'int', '', '', '', '', - 'agent_custid', 'varchar', 'NULL', $char_d, '', '', -# 'titlenum', 'int', 'NULL', '', '', '', - 'last', 'varchar', '', $char_d, '', '', -# 'middle', 'varchar', 'NULL', $char_d, '', '', - 'first', 'varchar', '', $char_d, '', '', - 'ss', 'varchar', 'NULL', 11, '', '', - 'company', 'varchar', 'NULL', $char_d, '', '', - 'address1', 'varchar', '', $char_d, '', '', - 'address2', 'varchar', 'NULL', $char_d, '', '', - 'city', 'varchar', '', $char_d, '', '', - 'county', 'varchar', 'NULL', $char_d, '', '', - 'state', 'varchar', 'NULL', $char_d, '', '', - 'zip', 'varchar', 'NULL', 10, '', '', - 'country', 'char', '', 2, '', '', - 'daytime', 'varchar', 'NULL', 20, '', '', - 'night', 'varchar', 'NULL', 20, '', '', - 'fax', 'varchar', 'NULL', 12, '', '', - 'ship_last', 'varchar', 'NULL', $char_d, '', '', -# 'ship_middle', 'varchar', 'NULL', $char_d, '', '', - 'ship_first', 'varchar', 'NULL', $char_d, '', '', - 'ship_company', 'varchar', 'NULL', $char_d, '', '', - 'ship_address1', 'varchar', 'NULL', $char_d, '', '', - 'ship_address2', 'varchar', 'NULL', $char_d, '', '', - 'ship_city', 'varchar', 'NULL', $char_d, '', '', - 'ship_county', 'varchar', 'NULL', $char_d, '', '', - 'ship_state', 'varchar', 'NULL', $char_d, '', '', - 'ship_zip', 'varchar', 'NULL', 10, '', '', - 'ship_country', 'char', 'NULL', 2, '', '', - 'ship_daytime', 'varchar', 'NULL', 20, '', '', - 'ship_night', 'varchar', 'NULL', 20, '', '', - 'ship_fax', 'varchar', 'NULL', 12, '', '', - 'payby', 'char', '', 4, '', '', - 'payinfo', 'varchar', 'NULL', 512, '', '', - 'paycvv', 'varchar', 'NULL', 512, '', '', - 'paymask', 'varchar', 'NULL', $char_d, '', '', - #'paydate', @date_type, '', '', - 'paydate', 'varchar', 'NULL', 10, '', '', - 'paystart_month', 'int', 'NULL', '', '', '', - 'paystart_year', 'int', 'NULL', '', '', '', - 'payissue', 'varchar', 'NULL', 2, '', '', - 'payname', 'varchar', 'NULL', $char_d, '', '', - 'payip', 'varchar', 'NULL', 15, '', '', - 'tax', 'char', 'NULL', 1, '', '', - 'otaker', 'varchar', '', 32, '', '', - 'refnum', 'int', '', '', '', '', - 'referral_custnum', 'int', 'NULL', '', '', '', - 'comments', 'text', 'NULL', '', '', '', - 'spool_cdr','char', 'NULL', 1, '', '', - ], - 'primary_key' => 'custnum', - 'unique' => [ [ 'agentnum', 'agent_custid' ] ], - #'index' => [ ['last'], ['company'] ], - 'index' => [ ['last'], [ 'company' ], [ 'referral_custnum' ], - [ 'daytime' ], [ 'night' ], [ 'fax' ], [ 'refnum' ], - [ 'county' ], [ 'state' ], [ 'country' ], [ 'zip' ], - [ 'ship_last' ], [ 'ship_company' ], - [ 'payby' ], [ 'paydate' ], - - ], - }, - - 'cust_main_invoice' => { - 'columns' => [ - 'destnum', 'serial', '', '', '', '', - 'custnum', 'int', '', '', '', '', - 'dest', 'varchar', '', $char_d, '', '', - ], - 'primary_key' => 'destnum', - 'unique' => [], - 'index' => [ ['custnum'], ], - }, - - 'cust_main_county' => { #county+state+country are checked off the - #cust_main_county for validation and to provide - # a tax rate. - 'columns' => [ - 'taxnum', 'serial', '', '', '', '', - 'state', 'varchar', 'NULL', $char_d, '', '', - 'county', 'varchar', 'NULL', $char_d, '', '', - 'country', 'char', '', 2, '', '', - 'taxclass', 'varchar', 'NULL', $char_d, '', '', - 'exempt_amount', @money_type, '', '', - 'tax', 'real', '', '', '', '', #tax % - 'taxname', 'varchar', 'NULL', $char_d, '', '', - 'setuptax', 'char', 'NULL', 1, '', '', # Y = setup tax exempt - 'recurtax', 'char', 'NULL', 1, '', '', # Y = recur tax exempt - ], - 'primary_key' => 'taxnum', - 'unique' => [], - # 'unique' => [ ['taxnum'], ['state', 'county'] ], - 'index' => [ [ 'county' ], [ 'state' ], [ 'country' ] ], - }, - - 'cust_pay' => { - 'columns' => [ - 'paynum', 'serial', '', '', '', '', - #now cust_bill_pay #'invnum', 'int', '', '', '', '', - 'custnum', 'int', '', '', '', '', - 'paid', @money_type, '', '', - '_date', @date_type, '', '', - 'payby', 'char', '', 4, '', '', # CARD/BILL/COMP, should be - # index into payby table - # eventually - 'payinfo', 'varchar', 'NULL', $char_d, '', '', #see cust_main above - 'paybatch', 'varchar', 'NULL', $char_d, '', '', #for auditing purposes. - 'closed', 'char', 'NULL', 1, '', '', - ], - 'primary_key' => 'paynum', - 'unique' => [], - 'index' => [ [ 'custnum' ], [ 'paybatch' ], [ 'payby' ], [ '_date' ] ], - }, - - 'cust_pay_void' => { - 'columns' => [ - 'paynum', 'int', '', '', '', '', - 'custnum', 'int', '', '', '', '', - 'paid', @money_type, '', '', - '_date', @date_type, '', '', - 'payby', 'char', '', 4, '', '', # CARD/BILL/COMP, should be - # index into payby table - # eventually - 'payinfo', 'varchar', 'NULL', $char_d, '', '', #see cust_main above - 'paybatch', 'varchar', 'NULL', $char_d, '', '', #for auditing purposes. - 'closed', 'char', 'NULL', 1, '', '', - 'void_date', @date_type, '', '', - 'reason', 'varchar', 'NULL', $char_d, '', '', - 'otaker', 'varchar', '', 32, '', '', - ], - 'primary_key' => 'paynum', - 'unique' => [], - 'index' => [ [ 'custnum' ] ], - }, - - 'cust_bill_pay' => { - 'columns' => [ - 'billpaynum', 'serial', '', '', '', '', - 'invnum', 'int', '', '', '', '', - 'paynum', 'int', '', '', '', '', - 'amount', @money_type, '', '', - '_date', @date_type, '', '', - ], - 'primary_key' => 'billpaynum', - 'unique' => [], - 'index' => [ [ 'paynum' ], [ 'invnum' ] ], - }, - - 'cust_bill_pay_pkg' => { - 'columns' => [ - 'billpaypkgnum', 'serial', '', '', '', '', - 'billpaynum', 'int', '', '', '', '', - 'billpkgnum', 'int', '', '', '', '', - 'amount', @money_type, '', '', - 'setuprecur', 'varchar', '', $char_d, '', '', - ], - 'primary_key' => 'billpaypkgnum', - 'unique' => [], - 'index' => [ [ 'billpaynum' ], [ 'billpkgnum' ], ], - }, - - 'pay_batch' => { #batches of payments to an external processor - 'columns' => [ - 'batchnum', 'serial', '', '', '', '', - 'status', 'char', 'NULL', 1, '', '', - 'download', @date_type, '', '', - 'upload', @date_type, '', '', - ], - 'primary_key' => 'batchnum', - 'unique' => [], - 'index' => [], - }, - - 'cust_pay_batch' => { #what's this used for again? list of customers - #in current CARD batch? (necessarily CARD?) - 'columns' => [ - 'paybatchnum', 'serial', '', '', '', '', - 'batchnum', 'int', '', '', '', '', - 'invnum', 'int', '', '', '', '', - 'custnum', 'int', '', '', '', '', - 'last', 'varchar', '', $char_d, '', '', - 'first', 'varchar', '', $char_d, '', '', - 'address1', 'varchar', '', $char_d, '', '', - 'address2', 'varchar', 'NULL', $char_d, '', '', - 'city', 'varchar', '', $char_d, '', '', - 'state', 'varchar', 'NULL', $char_d, '', '', - 'zip', 'varchar', 'NULL', 10, '', '', - 'country', 'char', '', 2, '', '', - # 'trancode', 'int', '', '', '', '' - 'payby', 'char', '', 4, '', '', # CARD/BILL/COMP, should be - 'payinfo', 'varchar', '', 512, '', '', - #'exp', @date_type, '', '' - 'exp', 'varchar', 'NULL', 11, '', '', - 'payname', 'varchar', 'NULL', $char_d, '', '', - 'amount', @money_type, '', '', - 'status', 'varchar', 'NULL', $char_d, '', '', - ], - 'primary_key' => 'paybatchnum', - 'unique' => [], - 'index' => [ ['batchnum'], ['invnum'], ['custnum'] ], - }, - - 'cust_pkg' => { - 'columns' => [ - 'pkgnum', 'serial', '', '', '', '', - 'custnum', 'int', '', '', '', '', - 'pkgpart', 'int', '', '', '', '', - 'otaker', 'varchar', '', 32, '', '', - 'setup', @date_type, '', '', - 'bill', @date_type, '', '', - 'last_bill', @date_type, '', '', - 'susp', @date_type, '', '', - 'cancel', @date_type, '', '', - 'expire', @date_type, '', '', - 'manual_flag', 'char', 'NULL', 1, '', '', - ], - 'primary_key' => 'pkgnum', - 'unique' => [], - 'index' => [ ['custnum'], ['pkgpart'] ], - }, - - 'cust_refund' => { - 'columns' => [ - 'refundnum', 'serial', '', '', '', '', - #now cust_credit_refund #'crednum', 'int', '', '', '', '', - 'custnum', 'int', '', '', '', '', - '_date', @date_type, '', '', - 'refund', @money_type, '', '', - 'otaker', 'varchar', '', 32, '', '', - 'reason', 'varchar', '', $char_d, '', '', - 'payby', 'char', '', 4, '', '', # CARD/BILL/COMP, should - # be index into payby - # table eventually - 'payinfo', 'varchar', 'NULL', $char_d, '', '', #see cust_main above - 'paybatch', 'varchar', 'NULL', $char_d, '', '', - 'closed', 'char', 'NULL', 1, '', '', - ], - 'primary_key' => 'refundnum', - 'unique' => [], - 'index' => [], - }, - - 'cust_credit_refund' => { - 'columns' => [ - 'creditrefundnum', 'serial', '', '', '', '', - 'crednum', 'int', '', '', '', '', - 'refundnum', 'int', '', '', '', '', - 'amount', @money_type, '', '', - '_date', @date_type, '', '', - ], - 'primary_key' => 'creditrefundnum', - 'unique' => [], - 'index' => [ [ 'crednum', 'refundnum' ] ], - }, - - - 'cust_svc' => { - 'columns' => [ - 'svcnum', 'serial', '', '', '', '', - 'pkgnum', 'int', 'NULL', '', '', '', - 'svcpart', 'int', '', '', '', '', - ], - 'primary_key' => 'svcnum', - 'unique' => [], - 'index' => [ ['svcnum'], ['pkgnum'], ['svcpart'] ], - }, - - 'part_pkg' => { - 'columns' => [ - 'pkgpart', 'serial', '', '', '', '', - 'pkg', 'varchar', '', $char_d, '', '', - 'comment', 'varchar', '', $char_d, '', '', - 'promo_code', 'varchar', 'NULL', $char_d, '', '', - 'setup', @perl_type, '', '', - 'freq', 'varchar', '', $char_d, '', '', #billing frequency - 'recur', @perl_type, '', '', - 'setuptax', 'char', 'NULL', 1, '', '', - 'recurtax', 'char', 'NULL', 1, '', '', - 'plan', 'varchar', 'NULL', $char_d, '', '', - 'plandata', 'text', 'NULL', '', '', '', - 'disabled', 'char', 'NULL', 1, '', '', - 'taxclass', 'varchar', 'NULL', $char_d, '', '', - 'classnum', 'int', 'NULL', '', '', '', - ], - 'primary_key' => 'pkgpart', - 'unique' => [], - 'index' => [ [ 'promo_code' ], [ 'disabled' ] ], - }, - -# 'part_title' => { -# 'columns' => [ -# 'titlenum', 'int', '', '', -# 'title', 'varchar', '', $char_d, -# ], -# 'primary_key' => 'titlenum', -# 'unique' => [ [] ], -# 'index' => [ [] ], -# }, - - 'pkg_svc' => { - 'columns' => [ - 'pkgsvcnum', 'serial', '', '', '', '', - 'pkgpart', 'int', '', '', '', '', - 'svcpart', 'int', '', '', '', '', - 'quantity', 'int', '', '', '', '', - 'primary_svc','char', 'NULL', 1, '', '', - ], - 'primary_key' => 'pkgsvcnum', - 'unique' => [ ['pkgpart', 'svcpart'] ], - 'index' => [ ['pkgpart'] ], - }, - - 'part_referral' => { - 'columns' => [ - 'refnum', 'serial', '', '', '', '', - 'referral', 'varchar', '', $char_d, '', '', - 'disabled', 'char', 'NULL', 1, '', '', - 'agentnum', 'int', 'NULL', '', '', '', - ], - 'primary_key' => 'refnum', - 'unique' => [], - 'index' => [ ['disabled'] ], - }, - - 'part_svc' => { - 'columns' => [ - 'svcpart', 'serial', '', '', '', '', - 'svc', 'varchar', '', $char_d, '', '', - 'svcdb', 'varchar', '', $char_d, '', '', - 'disabled', 'char', 'NULL', 1, '', '', - ], - 'primary_key' => 'svcpart', - 'unique' => [], - 'index' => [ [ 'disabled' ] ], - }, - - 'part_svc_column' => { - 'columns' => [ - 'columnnum', 'serial', '', '', '', '', - 'svcpart', 'int', '', '', '', '', - 'columnname', 'varchar', '', 64, '', '', - 'columnvalue', 'varchar', 'NULL', $char_d, '', '', - 'columnflag', 'char', 'NULL', 1, '', '', - ], - 'primary_key' => 'columnnum', - 'unique' => [ [ 'svcpart', 'columnname' ] ], - 'index' => [ [ 'svcpart' ] ], - }, - - #(this should be renamed to part_pop) - 'svc_acct_pop' => { - 'columns' => [ - 'popnum', 'serial', '', '', '', '', - 'city', 'varchar', '', $char_d, '', '', - 'state', 'varchar', '', $char_d, '', '', - 'ac', 'char', '', 3, '', '', - 'exch', 'char', '', 3, '', '', - 'loc', 'char', 'NULL', 4, '', '', #NULL for legacy purposes - ], - 'primary_key' => 'popnum', - 'unique' => [], - 'index' => [ [ 'state' ] ], - }, - - 'part_pop_local' => { - 'columns' => [ - 'localnum', 'serial', '', '', '', '', - 'popnum', 'int', '', '', '', '', - 'city', 'varchar', 'NULL', $char_d, '', '', - 'state', 'char', 'NULL', 2, '', '', - 'npa', 'char', '', 3, '', '', - 'nxx', 'char', '', 3, '', '', - ], - 'primary_key' => 'localnum', - 'unique' => [], - 'index' => [ [ 'npa', 'nxx' ], [ 'popnum' ] ], - }, - - 'svc_acct' => { - 'columns' => [ - 'svcnum', 'int', '', '', '', '', - 'username', 'varchar', '', $username_len, '', '', #unique (& remove dup code) - '_password', 'varchar', '', 72, '', '', #13 for encryped pw's plus ' *SUSPENDED* (md5 passwords can be 34, blowfish 60) - 'sec_phrase', 'varchar', 'NULL', $char_d, '', '', - 'popnum', 'int', 'NULL', '', '', '', - 'uid', 'int', 'NULL', '', '', '', - 'gid', 'int', 'NULL', '', '', '', - 'finger', 'varchar', 'NULL', $char_d, '', '', - 'dir', 'varchar', 'NULL', $char_d, '', '', - 'shell', 'varchar', 'NULL', $char_d, '', '', - 'quota', 'varchar', 'NULL', $char_d, '', '', - 'slipip', 'varchar', 'NULL', 15, '', '', #four TINYINTs, bah. - 'seconds', 'int', 'NULL', '', '', '', #uhhhh - 'domsvc', 'int', '', '', '', '', - ], - 'primary_key' => 'svcnum', - #'unique' => [ [ 'username', 'domsvc' ] ], - 'unique' => [], - 'index' => [ ['username'], ['domsvc'] ], - }, - - #'svc_charge' => { - # 'columns' => [ - # 'svcnum', 'int', '', '', - # 'amount', @money_type, - # ], - # 'primary_key' => 'svcnum', - # 'unique' => [ [] ], - # 'index' => [ [] ], - #}, - - 'svc_domain' => { - 'columns' => [ - 'svcnum', 'int', '', '', '', '', - 'domain', 'varchar', '', $char_d, '', '', - 'catchall', 'int', 'NULL', '', '', '', - ], - 'primary_key' => 'svcnum', - 'unique' => [ ['domain'] ], - 'index' => [], - }, - - 'domain_record' => { - 'columns' => [ - 'recnum', 'serial', '', '', '', '', - 'svcnum', 'int', '', '', '', '', - 'reczone', 'varchar', '', 255, '', '', - 'recaf', 'char', '', 2, '', '', - 'rectype', 'varchar', '', 5, '', '', - 'recdata', 'varchar', '', 255, '', '', - ], - 'primary_key' => 'recnum', - 'unique' => [], - 'index' => [ ['svcnum'] ], - }, - - 'svc_forward' => { - 'columns' => [ - 'svcnum', 'int', '', '', '', '', - 'srcsvc', 'int', 'NULL', '', '', '', - 'src', 'varchar', 'NULL', 255, '', '', - 'dstsvc', 'int', 'NULL', '', '', '', - 'dst', 'varchar', 'NULL', 255, '', '', - ], - 'primary_key' => 'svcnum', - 'unique' => [], - 'index' => [ ['srcsvc'], ['dstsvc'] ], - }, - - 'svc_www' => { - 'columns' => [ - 'svcnum', 'int', '', '', '', '', - 'recnum', 'int', '', '', '', '', - 'usersvc', 'int', '', '', '', '', - ], - 'primary_key' => 'svcnum', - 'unique' => [], - 'index' => [], - }, - - #'svc_wo' => { - # 'columns' => [ - # 'svcnum', 'int', '', '', - # 'svcnum', 'int', '', '', - # 'svcnum', 'int', '', '', - # 'worker', 'varchar', '', $char_d, - # '_date', @date_type, - # ], - # 'primary_key' => 'svcnum', - # 'unique' => [ [] ], - # 'index' => [ [] ], - #}, - - 'prepay_credit' => { - 'columns' => [ - 'prepaynum', 'serial', '', '', '', '', - 'identifier', 'varchar', '', $char_d, '', '', - 'amount', @money_type, '', '', - 'seconds', 'int', 'NULL', '', '', '', - 'agentnum', 'int', 'NULL', '', '', '', - ], - 'primary_key' => 'prepaynum', - 'unique' => [ ['identifier'] ], - 'index' => [], - }, - - 'port' => { - 'columns' => [ - 'portnum', 'serial', '', '', '', '', - 'ip', 'varchar', 'NULL', 15, '', '', - 'nasport', 'int', 'NULL', '', '', '', - 'nasnum', 'int', '', '', '', '', - ], - 'primary_key' => 'portnum', - 'unique' => [], - 'index' => [], - }, - - 'nas' => { - 'columns' => [ - 'nasnum', 'serial', '', '', '', '', - 'nas', 'varchar', '', $char_d, '', '', - 'nasip', 'varchar', '', 15, '', '', - 'nasfqdn', 'varchar', '', $char_d, '', '', - 'last', 'int', '', '', '', '', - ], - 'primary_key' => 'nasnum', - 'unique' => [ [ 'nas' ], [ 'nasip' ] ], - 'index' => [ [ 'last' ] ], - }, - - 'session' => { - 'columns' => [ - 'sessionnum', 'serial', '', '', '', '', - 'portnum', 'int', '', '', '', '', - 'svcnum', 'int', '', '', '', '', - 'login', @date_type, '', '', - 'logout', @date_type, '', '', - ], - 'primary_key' => 'sessionnum', - 'unique' => [], - 'index' => [ [ 'portnum' ] ], - }, - - 'queue' => { - 'columns' => [ - 'jobnum', 'serial', '', '', '', '', - 'job', 'text', '', '', '', '', - '_date', 'int', '', '', '', '', - 'status', 'varchar', '', $char_d, '', '', - 'statustext', 'text', 'NULL', '', '', '', - 'svcnum', 'int', 'NULL', '', '', '', - ], - 'primary_key' => 'jobnum', - 'unique' => [], - 'index' => [ [ 'svcnum' ], [ 'status' ] ], - }, - - 'queue_arg' => { - 'columns' => [ - 'argnum', 'serial', '', '', '', '', - 'jobnum', 'int', '', '', '', '', - 'arg', 'text', 'NULL', '', '', '', - ], - 'primary_key' => 'argnum', - 'unique' => [], - 'index' => [ [ 'jobnum' ] ], - }, - - 'queue_depend' => { - 'columns' => [ - 'dependnum', 'serial', '', '', '', '', - 'jobnum', 'int', '', '', '', '', - 'depend_jobnum', 'int', '', '', '', '', - ], - 'primary_key' => 'dependnum', - 'unique' => [], - 'index' => [ [ 'jobnum' ], [ 'depend_jobnum' ] ], - }, - - 'export_svc' => { - 'columns' => [ - 'exportsvcnum' => 'serial', '', '', '', '', - 'exportnum' => 'int', '', '', '', '', - 'svcpart' => 'int', '', '', '', '', - ], - 'primary_key' => 'exportsvcnum', - 'unique' => [ [ 'exportnum', 'svcpart' ] ], - 'index' => [ [ 'exportnum' ], [ 'svcpart' ] ], - }, - - 'part_export' => { - 'columns' => [ - 'exportnum', 'serial', '', '', '', '', - 'machine', 'varchar', '', $char_d, '', '', - 'exporttype', 'varchar', '', $char_d, '', '', - 'nodomain', 'char', 'NULL', 1, '', '', - ], - 'primary_key' => 'exportnum', - 'unique' => [], - 'index' => [ [ 'machine' ], [ 'exporttype' ] ], - }, - - 'part_export_option' => { - 'columns' => [ - 'optionnum', 'serial', '', '', '', '', - 'exportnum', 'int', '', '', '', '', - 'optionname', 'varchar', '', $char_d, '', '', - 'optionvalue', 'text', 'NULL', '', '', '', - ], - 'primary_key' => 'optionnum', - 'unique' => [], - 'index' => [ [ 'exportnum' ], [ 'optionname' ] ], - }, - - 'radius_usergroup' => { - 'columns' => [ - 'usergroupnum', 'serial', '', '', '', '', - 'svcnum', 'int', '', '', '', '', - 'groupname', 'varchar', '', $char_d, '', '', - ], - 'primary_key' => 'usergroupnum', - 'unique' => [], - 'index' => [ [ 'svcnum' ], [ 'groupname' ] ], - }, - - 'msgcat' => { - 'columns' => [ - 'msgnum', 'serial', '', '', '', '', - 'msgcode', 'varchar', '', $char_d, '', '', - 'locale', 'varchar', '', 16, '', '', - 'msg', 'text', '', '', '', '', - ], - 'primary_key' => 'msgnum', - 'unique' => [ [ 'msgcode', 'locale' ] ], - 'index' => [], - }, - - 'cust_tax_exempt' => { - 'columns' => [ - 'exemptnum', 'serial', '', '', '', '', - 'custnum', 'int', '', '', '', '', - 'taxnum', 'int', '', '', '', '', - 'year', 'int', '', '', '', '', - 'month', 'int', '', '', '', '', - 'amount', @money_type, '', '', - ], - 'primary_key' => 'exemptnum', - 'unique' => [ [ 'custnum', 'taxnum', 'year', 'month' ] ], - 'index' => [], - }, - - 'cust_tax_exempt_pkg' => { - 'columns' => [ - 'exemptpkgnum', 'serial', '', '', '', '', - #'custnum', 'int', '', '', '', '' - 'billpkgnum', 'int', '', '', '', '', - 'taxnum', 'int', '', '', '', '', - 'year', 'int', '', '', '', '', - 'month', 'int', '', '', '', '', - 'amount', @money_type, '', '', - ], - 'primary_key' => 'exemptpkgnum', - 'unique' => [], - 'index' => [ [ 'taxnum', 'year', 'month' ], - [ 'billpkgnum' ], - [ 'taxnum' ] - ], - }, - - 'router' => { - 'columns' => [ - 'routernum', 'serial', '', '', '', '', - 'routername', 'varchar', '', $char_d, '', '', - 'svcnum', 'int', 'NULL', '', '', '', - ], - 'primary_key' => 'routernum', - 'unique' => [], - 'index' => [], - }, - - 'part_svc_router' => { - 'columns' => [ - 'svcrouternum', 'serial', '', '', '', '', - 'svcpart', 'int', '', '', '', '', - 'routernum', 'int', '', '', '', '', - ], - 'primary_key' => 'svcrouternum', - 'unique' => [], - 'index' => [], - }, - - 'addr_block' => { - 'columns' => [ - 'blocknum', 'serial', '', '', '', '', - 'routernum', 'int', '', '', '', '', - 'ip_gateway', 'varchar', '', 15, '', '', - 'ip_netmask', 'int', '', '', '', '', - ], - 'primary_key' => 'blocknum', - 'unique' => [ [ 'blocknum', 'routernum' ] ], - 'index' => [], - }, - - 'svc_broadband' => { - 'columns' => [ - 'svcnum', 'int', '', '', '', '', - 'blocknum', 'int', '', '', '', '', - 'speed_up', 'int', '', '', '', '', - 'speed_down', 'int', '', '', '', '', - 'ip_addr', 'varchar', '', 15, '', '', - ], - 'primary_key' => 'svcnum', - 'unique' => [], - 'index' => [], - }, - - 'part_virtual_field' => { - 'columns' => [ - 'vfieldpart', 'int', '', '', '', '', - 'dbtable', 'varchar', '', 32, '', '', - 'name', 'varchar', '', 32, '', '', - 'check_block', 'text', 'NULL', '', '', '', - 'length', 'int', 'NULL', '', '', '', - 'list_source', 'text', 'NULL', '', '', '', - 'label', 'varchar', 'NULL', 80, '', '', - ], - 'primary_key' => 'vfieldpart', - 'unique' => [], - 'index' => [], - }, - - 'virtual_field' => { - 'columns' => [ - 'vfieldnum', 'serial', '', '', '', '', - 'recnum', 'int', '', '', '', '', - 'vfieldpart', 'int', '', '', '', '', - 'value', 'varchar', '', 128, '', '', - ], - 'primary_key' => 'vfieldnum', - 'unique' => [ [ 'vfieldpart', 'recnum' ] ], - 'index' => [], - }, - - 'acct_snarf' => { - 'columns' => [ - 'snarfnum', 'int', '', '', '', '', - 'svcnum', 'int', '', '', '', '', - 'machine', 'varchar', '', 255, '', '', - 'protocol', 'varchar', '', $char_d, '', '', - 'username', 'varchar', '', $char_d, '', '', - '_password', 'varchar', '', $char_d, '', '', - ], - 'primary_key' => 'snarfnum', - 'unique' => [], - 'index' => [ [ 'svcnum' ] ], - }, - - 'svc_external' => { - 'columns' => [ - 'svcnum', 'int', '', '', '', '', - 'id', 'int', 'NULL', '', '', '', - 'title', 'varchar', 'NULL', $char_d, '', '', - ], - 'primary_key' => 'svcnum', - 'unique' => [], - 'index' => [], - }, - - 'cust_pay_refund' => { - 'columns' => [ - 'payrefundnum', 'serial', '', '', '', '', - 'paynum', 'int', '', '', '', '', - 'refundnum', 'int', '', '', '', '', - '_date', @date_type, '', '', - 'amount', @money_type, '', '', - ], - 'primary_key' => 'payrefundnum', - 'unique' => [], - 'index' => [ ['paynum'], ['refundnum'] ], - }, - - 'part_pkg_option' => { - 'columns' => [ - 'optionnum', 'serial', '', '', '', '', - 'pkgpart', 'int', '', '', '', '', - 'optionname', 'varchar', '', $char_d, '', '', - 'optionvalue', 'text', 'NULL', '', '', '', - ], - 'primary_key' => 'optionnum', - 'unique' => [], - 'index' => [ [ 'pkgpart' ], [ 'optionname' ] ], - }, - - 'rate' => { - 'columns' => [ - 'ratenum', 'serial', '', '', '', '', - 'ratename', 'varchar', '', $char_d, '', '', - ], - 'primary_key' => 'ratenum', - 'unique' => [], - 'index' => [], - }, - - 'rate_detail' => { - 'columns' => [ - 'ratedetailnum', 'serial', '', '', '', '', - 'ratenum', 'int', '', '', '', '', - 'orig_regionnum', 'int', 'NULL', '', '', '', - 'dest_regionnum', 'int', '', '', '', '', - 'min_included', 'int', '', '', '', '', - #'min_charge', @money_type, '', '', - 'min_charge', 'decimal', '', '10,5', '', '', - 'sec_granularity', 'int', '', '', '', '', - #time period (link to table of periods)? - ], - 'primary_key' => 'ratedetailnum', - 'unique' => [ [ 'ratenum', 'orig_regionnum', 'dest_regionnum' ] ], - 'index' => [ [ 'ratenum', 'dest_regionnum' ] ], - }, - - 'rate_region' => { - 'columns' => [ - 'regionnum', 'serial', '', '', '', '', - 'regionname', 'varchar', '', $char_d, '', '', - ], - 'primary_key' => 'regionnum', - 'unique' => [], - 'index' => [], - }, - - 'rate_prefix' => { - 'columns' => [ - 'prefixnum', 'serial', '', '', '', '', - 'regionnum', 'int', '', '',, '', '', - 'countrycode', 'varchar', '', 3, '', '', - 'npa', 'varchar', 'NULL', 6, '', '', - 'nxx', 'varchar', 'NULL', 3, '', '', - ], - 'primary_key' => 'prefixnum', - 'unique' => [], - 'index' => [ [ 'countrycode' ], [ 'regionnum' ] ], - }, - - 'reg_code' => { - 'columns' => [ - 'codenum', 'serial', '', '', '', '', - 'code', 'varchar', '', $char_d, '', '', - 'agentnum', 'int', '', '', '', '', - ], - 'primary_key' => 'codenum', - 'unique' => [ [ 'agentnum', 'code' ] ], - 'index' => [ [ 'agentnum' ] ], - }, - - 'reg_code_pkg' => { - 'columns' => [ - 'codepkgnum', 'serial', '', '', '', '', - 'codenum', 'int', '', '', '', '', - 'pkgpart', 'int', '', '', '', '', - ], - 'primary_key' => 'codepkgnum', - 'unique' => [ [ 'codenum', 'pkgpart' ] ], - 'index' => [ [ 'codenum' ] ], - }, - - 'clientapi_session' => { - 'columns' => [ - 'sessionnum', 'serial', '', '', '', '', - 'sessionid', 'varchar', '', $char_d, '', '', - 'namespace', 'varchar', '', $char_d, '', '', - ], - 'primary_key' => 'sessionnum', - 'unique' => [ [ 'sessionid', 'namespace' ] ], - 'index' => [], - }, - - 'clientapi_session_field' => { - 'columns' => [ - 'fieldnum', 'serial', '', '', '', '', - 'sessionnum', 'int', '', '', '', '', - 'fieldname', 'varchar', '', $char_d, '', '', - 'fieldvalue', 'text', 'NULL', '', '', '', - ], - 'primary_key' => 'fieldnum', - 'unique' => [ [ 'sessionnum', 'fieldname' ] ], - 'index' => [], - }, - - 'payment_gateway' => { - 'columns' => [ - 'gatewaynum', 'serial', '', '', '', '', - 'gateway_module', 'varchar', '', $char_d, '', '', - 'gateway_username', 'varchar', 'NULL', $char_d, '', '', - 'gateway_password', 'varchar', 'NULL', $char_d, '', '', - 'gateway_action', 'varchar', 'NULL', $char_d, '', '', - 'disabled', 'char', 'NULL', 1, '', '', - ], - 'primary_key' => 'gatewaynum', - 'unique' => [], - 'index' => [ [ 'disabled' ] ], - }, - - 'payment_gateway_option' => { - 'columns' => [ - 'optionnum', 'serial', '', '', '', '', - 'gatewaynum', 'int', '', '', '', '', - 'optionname', 'varchar', '', $char_d, '', '', - 'optionvalue', 'text', 'NULL', '', '', '', - ], - 'primary_key' => 'optionnum', - 'unique' => [], - 'index' => [ [ 'gatewaynum' ], [ 'optionname' ] ], - }, - - 'agent_payment_gateway' => { - 'columns' => [ - 'agentgatewaynum', 'serial', '', '', '', '', - 'agentnum', 'int', '', '', '', '', - 'gatewaynum', 'int', '', '', '', '', - 'cardtype', 'varchar', 'NULL', $char_d, '', '', - 'taxclass', 'varchar', 'NULL', $char_d, '', '', - ], - 'primary_key' => 'agentgatewaynum', - 'unique' => [], - 'index' => [ [ 'agentnum', 'cardtype' ], ], - }, - - 'banned_pay' => { - 'columns' => [ - 'bannum', 'serial', '', '', '', '', - 'payby', 'char', '', 4, '', '', - 'payinfo', 'varchar', '', 128, '', '', #say, a 512-big digest _hex encoded - #'paymask', 'varchar', 'NULL', $char_d, '', '' - '_date', @date_type, '', '', - 'otaker', 'varchar', '', 32, '', '', - 'reason', 'varchar', 'NULL', $char_d, '', '', - ], - 'primary_key' => 'bannum', - 'unique' => [ [ 'payby', 'payinfo' ] ], - 'index' => [], - }, - - 'cancel_reason' => { - 'columns' => [ - 'reasonnum', 'serial', '', '', '', '', - 'reason', 'varchar', '', $char_d, '', '', - 'disabled', 'char', 'NULL', 1, '', '', - ], - 'primary_key' => 'reasonnum', - 'unique' => [], - 'index' => [ [ 'disabled' ] ], - }, - - 'pkg_class' => { - 'columns' => [ - 'classnum', 'serial', '', '', '', '', - 'classname', 'varchar', '', $char_d, '', '', - ], - 'primary_key' => 'classnum', - 'unique' => [], - 'index' => [], - }, - - 'cdr' => { - 'columns' => [ - # qw( name type null length default local ); - - ### - #asterisk fields - ### - - 'acctid', 'bigserial', '', '', '', '', - 'calldate', 'TIMESTAMP with time zone', '', '', \'now()', '', - 'clid', 'varchar', '', $char_d, \"''", '', - 'src', 'varchar', '', $char_d, \"''", '', - 'dst', 'varchar', '', $char_d, \"''", '', - 'dcontext', 'varchar', '', $char_d, \"''", '', - 'channel', 'varchar', '', $char_d, \"''", '', - 'dstchannel', 'varchar', '', $char_d, \"''", '', - 'lastapp', 'varchar', '', $char_d, \"''", '', - 'lastdata', 'varchar', '', $char_d, \"''", '', - - #these don't seem to be logged by most of the SQL cdr_* modules - #except tds under sql-illegal names, so; - # ... don't rely on them for rating? - # and, what they hey, i went ahead and changed the names and data types - # to freeside-style dates... - #'start', 'timestamp', 'NULL', '', '', '', - #'answer', 'timestamp', 'NULL', '', '', '', - #'end', 'timestamp', 'NULL', '', '', '', - 'startdate', @date_type, '', '', - 'answerdate', @date_type, '', '', - 'enddate', @date_type, '', '', - # - - 'duration', 'int', '', '', 0, '', - 'billsec', 'int', '', '', 0, '', - 'disposition', 'varchar', '', 45, \"''", '', - 'amaflags', 'int', '', '', 0, '', - 'accountcode', 'varchar', '', 20, \"''", '', - 'uniqueid', 'varchar', '', 32, \"''", '', - 'userfield', 'varchar', '', 255, \"''", '', - - ### - # fields for unitel/RSLCOM/convergent that don't map well to asterisk - # defaults - ### - - #cdr_type: Usage = 1, S&E = 7, OC&C = 8 - 'cdrtypenum', 'int', 'NULL', '', '', '', - - 'charged_party', 'varchar', 'NULL', $char_d, '', '', - - 'upstream_currency', 'char', 'NULL', 3, '', '', - 'upstream_price', 'decimal', 'NULL', '10,2', '', '', - 'upstream_rateplanid', 'int', 'NULL', '', '', '', #? - - # how it was rated internally... - 'ratedetailnum', 'int', 'NULL', '', '', '', - 'rated_price', 'decimal', 'NULL', '10,2', '', '', - - 'distance', 'decimal', 'NULL', '', '', '', - 'islocal', 'int', 'NULL', '', '', '', # '', '', 0, '' instead? - - #cdr_calltype: the big list in appendix 2 - 'calltypenum', 'int', 'NULL', '', '', '', - - 'description', 'varchar', 'NULL', $char_d, '', '', - 'quantity', 'int', 'NULL', '', '', '', - - #cdr_carrier: Telstra =1, Optus = 2, RSL COM = 3 - 'carrierid', 'int', 'NULL', '', '', '', - - 'upstream_rateid', 'int', 'NULL', '', '', '', - - ### - #and now for our own fields - ### - - # a svcnum... right..? - 'svcnum', 'int', 'NULL', '', '', '', - - #NULL, done (or something) - 'freesidestatus', 'varchar', 'NULL', 32, '', '', - - ], - 'primary_key' => 'acctid', - 'unique' => [], - 'index' => [ [ 'calldate' ], [ 'dst' ], [ 'accountcode' ], [ 'freesidestatus' ] ], - }, - - 'cdr_calltype' => { - 'columns' => [ - 'calltypenum', 'serial', '', '', '', '', - 'calltypename', 'varchar', '', $char_d, '', '', - ], - 'primary_key' => 'calltypenum', - 'unique' => [], - 'index' => [], - }, - - 'cdr_type' => { - 'columns' => [ - 'cdrtypenum' => 'serial', '', '', '', '', - 'cdrtypename' => 'varchar', '', '', '', '', - ], - 'primary_key' => 'cdrtypenum', - 'unique' => [], - 'index' => [], - }, - - 'cdr_carrier' => { - 'columns' => [ - 'carrierid' => 'serial', '', '', '', '', - 'carriername' => 'varchar', '', '', '', '', - ], - 'primary_key' => 'carrierid', - 'unique' => [], - 'index' => [], - }, - - #map upstream rateid to ours... - 'cdr_upstream_rate' => { - 'columns' => [ - 'upstreamratenum', 'serial', '', '', '', '', - 'upstream_rateid', 'varchar', '', $char_d, '', '', - 'ratedetailnum', 'int', 'NULL', '', '', '', - ], - 'primary_key' => 'upstreamratenum', #XXX need a primary key - 'unique' => [ [ 'upstream_rateid' ] ], #unless we add another field, yeah - 'index' => [], - }, - - 'inventory_item' => { - 'columns' => [ - 'itemnum', 'serial', '', '', '', '', - 'classnum', 'int', '', '', '', '', - 'item', 'varchar', '', $char_d, '', '', - 'svcnum', 'int', 'NULL', '', '', '', - ], - 'primary_key' => 'itemnum', - 'unique' => [ [ 'classnum', 'item' ] ], - 'index' => [ [ 'classnum' ], [ 'svcnum' ] ], - }, - - 'inventory_class' => { - 'columns' => [ - 'classnum', 'serial', '', '', '', '', - 'classname', 'varchar', '', $char_d, '', '', - ], - 'primary_key' => 'classnum', - 'unique' => [], - 'index' => [], - }, - - 'access_user' => { - 'columns' => [ - 'usernum', 'serial', '', '', '', '', - 'username', 'varchar', '', $char_d, '', '', - '_password', 'varchar', '', $char_d, '', '', - 'last', 'varchar', '', $char_d, '', '', - 'first', 'varchar', '', $char_d, '', '', - 'disabled', 'char', 'NULL', 1, '', '', - ], - 'primary_key' => 'usernum', - 'unique' => [ [ 'username' ] ], - 'index' => [], - }, - - 'access_user_pref' => { - 'columns' => [ - 'prefnum', 'serial', '', '', '', '', - 'usernum', 'int', '', '', '', '', - 'prefname', 'varchar', '', $char_d, '', '', - 'prefvalue', 'text', 'NULL', '', '', '', - ], - 'primary_key' => 'prefnum', - 'unique' => [], - 'index' => [ [ 'usernum' ] ], - }, - - 'access_group' => { - 'columns' => [ - 'groupnum', 'serial', '', '', '', '', - 'groupname', 'varchar', '', $char_d, '', '', - ], - 'primary_key' => 'groupnum', - 'unique' => [ [ 'groupname' ] ], - 'index' => [], - }, - - 'access_usergroup' => { - 'columns' => [ - 'usergroupnum', 'serial', '', '', '', '', - 'usernum', 'int', '', '', '', '', - 'groupnum', 'int', '', '', '', '', - ], - 'primary_key' => 'usergroupnum', - 'unique' => [ [ 'usernum', 'groupnum' ] ], - 'index' => [ [ 'usernum' ] ], - }, - - 'access_groupagent' => { - 'columns' => [ - 'groupagentnum', 'serial', '', '', '', '', - 'groupnum', 'int', '', '', '', '', - 'agentnum', 'int', '', '', '', '', - ], - 'primary_key' => 'groupagentnum', - 'unique' => [ [ 'groupnum', 'agentnum' ] ], - 'index' => [ [ 'groupnum' ] ], - }, - - 'access_right' => { - 'columns' => [ - 'rightnum', 'serial', '', '', '', '', - 'righttype', 'varchar', '', $char_d, '', '', - 'rightobjnum', 'int', '', '', '', '', - 'rightname', 'varchar', '', '', '', '', - ], - 'primary_key' => 'rightnum', - 'unique' => [ [ 'righttype', 'rightobjnum', 'rightname' ] ], - 'index' => [], - }, - - 'svc_phone' => { - 'columns' => [ - 'svcnum', 'int', '', '', '', '', - 'countrycode', 'varchar', '', 3, '', '', - 'phonenum', 'varchar', '', 15, '', '', #12 ? - 'pin', 'varchar', 'NULL', $char_d, '', '', - ], - 'primary_key' => 'svcnum', - 'unique' => [], - 'index' => [ [ 'countrycode', 'phonenum' ] ], - }, - - }; - - #'new_table' => { - # 'columns' => [ - # 'num', 'serial', '', '', '', '', - # ], - # 'primary_key' => 'num', - # 'unique' => [], - # 'index' => [], - #}, - -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<DBIx::DBSchema> - -=cut - -1; - diff --git a/FS/FS/SearchCache.pm b/FS/FS/SearchCache.pm deleted file mode 100644 index 4218acf..0000000 --- a/FS/FS/SearchCache.pm +++ /dev/null @@ -1,96 +0,0 @@ -package FS::SearchCache; - -use strict; -use vars qw($DEBUG); -#use Carp qw(carp cluck croak confess); - -$DEBUG = 0; - -=head1 NAME - -FS::SearchCache - cache - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -=head1 METHODS - -=over 4 - -=item new - -=cut - -sub new { - my $proto = shift; - my $class = ref($proto) || $proto; - my( $table, $key ) = @_; - warn "table $table\n" if $DEBUG > 1; - warn "key $key\n" if $DEBUG > 1; - my $self = { 'table' => $table, - 'key' => $key, - 'cache' => {}, - 'subcache' => {}, - }; - bless ($self, $class); - - $self; -} - -=item table - -=cut - -sub table { my $self = shift; $self->{table}; } - -=item key - -=cut - -sub key { my $self = shift; $self->{key}; } - -=item cache - -=cut - -sub cache { my $self = shift; $self->{cache}; } - -=item subcache - -=cut - -sub subcache { - my $self = shift; - my $col = shift; - my $table = shift; - my $keyval = shift; - if ( exists $self->{subcache}->{$col}->{$keyval} ) { - warn "returning existing subcache for $keyval ($col)". - "$self->{subcache}->{$col}->{$keyval}\n" if $DEBUG; - return $self->{subcache}->{$col}->{$keyval}; - } else { - #my $tablekey = @_ ? shift : $col; - my $tablekey = $col; - my $subcache = ref($self)->new( $table, $tablekey ); - $self->{subcache}->{$col}->{$keyval} = $subcache; - warn "creating new subcache $table $tablekey: $subcache\n" if $DEBUG; - $subcache; - } -} - -=back - -=head1 BUGS - -Dismal documentation. - -=head1 SEE ALSO - -L<FS::Record>, L<FS::cust_main> - -=cut - -1; - - diff --git a/FS/FS/Setup.pm b/FS/FS/Setup.pm deleted file mode 100644 index 90f6f10..0000000 --- a/FS/FS/Setup.pm +++ /dev/null @@ -1,462 +0,0 @@ -package FS::Setup; - -use strict; -use vars qw( @ISA @EXPORT_OK ); -use Exporter; -#use Tie::DxHash; -use Tie::IxHash; -use FS::UID qw( dbh ); -use FS::Record; - -use FS::svc_domain; -$FS::svc_domain::whois_hack = 1; -$FS::svc_domain::whois_hack = 1; - -@ISA = qw( Exporter ); -@EXPORT_OK = qw( create_initial_data ); - -=head1 NAME - -FS::Setup - Database setup - -=head1 SYNOPSIS - - use FS::Setup; - -=head1 DESCRIPTION - -Currently this module simply provides a place to store common subroutines for -database setup. - -=head1 SUBROUTINES - -=over 4 - -=item - -=cut - -sub create_initial_data { - my %opt = @_; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - $FS::UID::AutoCommit = 0; - - populate_locales(); - - #initial_data data - populate_initial_data(%opt); - - populate_access(); - - populate_msgcat(); - - if ( $oldAutoCommit ) { - dbh->commit or die dbh->errstr; - } - -} - -sub populate_locales { - - use Locale::Country; - use Locale::SubCountry; - use FS::cust_main_county; - - #cust_main_county - foreach my $country ( sort map uc($_), all_country_codes ) { - - my $subcountry = eval { new Locale::SubCountry($country) }; - my @states = $subcountry ? $subcountry->all_codes : undef; - - if ( !scalar(@states) || ( scalar(@states)==1 && !defined($states[0]) ) ) { - - my $cust_main_county = new FS::cust_main_county({ - 'tax' => 0, - 'country' => $country, - }); - my $error = $cust_main_county->insert; - die $error if $error; - - } else { - - if ( $states[0] =~ /^(\d+|\w)$/ ) { - @states = map $subcountry->full_name($_), @states - } - - foreach my $state ( @states ) { - - my $cust_main_county = new FS::cust_main_county({ - 'state' => $state, - 'tax' => 0, - 'country' => $country, - }); - my $error = $cust_main_county->insert; - die $error if $error; - - } - - } - } - -} - -sub populate_initial_data { - my %opt = @_; - - my $data = initial_data(%opt); - - foreach my $table ( keys %$data ) { - - my $class = "FS::$table"; - eval "use $class;"; - die $@ if $@; - - my @records = @{ $data->{$table} }; - - foreach my $record ( @records ) { - my $args = delete($record->{'_insert_args'}) || []; - my $object = $class->new( $record ); - my $error = $object->insert( @$args ); - die "error inserting record into $table: $error\n" - if $error; - } - - } - -} - -sub initial_data { - my %opt = @_; - - #tie my %hash, 'Tie::DxHash', - tie my %hash, 'Tie::IxHash', - - #superuser group - 'access_group' => [ - { 'groupname' => 'Superuser' }, - ], - - #billing events - 'part_bill_event' => [ - { 'payby' => 'CARD', - 'event' => 'Batch card', - 'seconds' => 0, - 'eventcode' => '$cust_bill->batch_card();', - 'weight' => 40, - 'plan' => 'batch-card', - }, - { 'payby' => 'BILL', - 'event' => 'Send invoice', - 'seconds' => 0, - 'eventcode' => '$cust_bill->send();', - 'weight' => 50, - 'plan' => 'send', - }, - { 'payby' => 'DCRD', - 'event' => 'Send invoice', - 'seconds' => 0, - 'eventcode' => '$cust_bill->send();', - 'weight' => 50, - 'plan' => 'send', - }, - { 'payby' => 'DCHK', - 'event' => 'Send invoice', - 'seconds' => 0, - 'eventcode' => '$cust_bill->send();', - 'weight' => 50, - 'plan' => 'send', - }, - { 'payby' => 'DCLN', - 'event' => 'Suspend', - 'seconds' => 0, - 'eventcode' => '$cust_bill->suspend();', - 'weight' => 40, - 'plan' => 'suspend', - }, - ], - - #you must create a service definition. An example of a service definition - #would be a dial-up account or a domain. First, it is necessary to create a - #domain definition. Click on View/Edit service definitions and Add a new - #service definition with Table svc_domain (and no modifiers). - 'part_svc' => [ - { 'svc' => 'Domain', - 'svcdb' => 'svc_domain', - } - ], - - #Now that you have created your first service, you must create a package - #including this service which you can sell to customers. Zero, one, or many - #services are bundled into a package. Click on View/Edit package - #definitions and Add a new package definition which includes quantity 1 of - #the svc_domain service you created above. - 'part_pkg' => [ - { 'pkg' => 'System Domain', - 'comment' => '(NOT FOR CUSTOMERS)', - 'freq' => '0', - 'plan' => 'flat', - '_insert_args' => [ - 'pkg_svc' => { 1 => 1 }, # XXX - 'primary_svc' => 1, #XXX - 'options' => { - 'setup_fee' => '0', - 'recur_fee' => '0', - }, - ], - }, - ], - - #After you create your first package, then you must define who is able to - #sell that package by creating an agent type. An example of an agent type - #would be an internal sales representitive which sells regular and - #promotional packages, as opposed to an external sales representitive - #which would only sell regular packages of services. Click on View/Edit - #agent types and Add a new agent type. - 'agent_type' => [ - { 'atype' => 'internal' }, - ], - - #Allow this agent type to sell the package you created above. - 'type_pkgs' => [ - { 'typenum' => 1, #XXX - 'pkgpart' => 1, #XXX - }, - ], - - #After creating a new agent type, you must create an agent. Click on - #View/Edit agents and Add a new agent. - 'agent' => [ - { 'agent' => 'Internal', - 'typenum' => 1, # XXX - }, - ], - - #Set up at least one Advertising source. Advertising sources will help you - #keep track of how effective your advertising is, tracking where customers - #heard of your service offerings. You must create at least one advertising - #source. If you do not wish to use the referral functionality, simply - #create a single advertising source only. Click on View/Edit advertising - #sources and Add a new advertising source. - 'part_referral' => [ - { 'referral' => 'Internal', }, - ], - - #Click on New Customer and create a new customer for your system accounts - #with billing type Complimentary. Leave the First package dropdown set to - #(none). - 'cust_main' => [ - { 'agentnum' => 1, #XXX - 'refnum' => 1, #XXX - 'first' => 'System', - 'last' => 'Accounts', - 'address1' => '1234 System Lane', - 'city' => 'Systemtown', - 'state' => 'CA', - 'zip' => '54321', - 'country' => 'US', - 'payby' => 'COMP', - 'payinfo' => 'system', #or something - 'paydate' => '1/2037', - }, - ], - - #From the Customer View screen of the newly created customer, order the - #package you defined above. - 'cust_pkg' => [ - { 'custnum' => 1, #XXX - 'pkgpart' => 1, #XXX - }, - ], - - #From the Package View screen of the newly created package, choose - #(Provision) to add the customer's service for this new package. - #Add your own domain. - 'svc_domain' => [ - { 'domain' => $opt{'domain'}, - 'pkgnum' => 1, #XXX - 'svcpart' => 1, #XXX - 'action' => 'N', #pseudo-field - }, - ], - - #Go back to View/Edit service definitions on the main menu, and Add a new - #service definition with Table svc_acct. Select your domain in the domsvc - #Modifier. Set Fixed to define a service locked-in to this domain, or - #Default to define a service which may select from among this domain and - #the customer's domains. - - #not yet.... - - #) - ; - - \%hash; - -} - -sub populate_access { - - use FS::AccessRight; - use FS::access_right; - - foreach my $rightname ( FS::AccessRight->rights ) { - my $access_right = new FS::access_right { - 'righttype' => 'FS::access_group', - 'rightobjnum' => 1, #$supergroup->groupnum, - 'rightname' => $rightname, - }; - my $ar_error = $access_right->insert; - die $ar_error if $ar_error; - } - - #foreach my $agent ( qsearch('agent', {} ) ) { - my $access_groupagent = new FS::access_groupagent { - 'groupnum' => 1, #$supergroup->groupnum, - 'agentnum' => 1, #$agent->agentnum, - }; - my $aga_error = $access_groupagent->insert; - die $aga_error if $aga_error; - #} - -} - -sub populate_msgcat { - - use FS::Record qw(qsearch); - use FS::msgcat; - - foreach my $del_msgcat ( qsearch('msgcat', {}) ) { - my $error = $del_msgcat->delete; - die $error if $error; - } - - my %messages = msgcat_messages(); - - foreach my $msgcode ( keys %messages ) { - foreach my $locale ( keys %{$messages{$msgcode}} ) { - my $msgcat = new FS::msgcat( { - 'msgcode' => $msgcode, - 'locale' => $locale, - 'msg' => $messages{$msgcode}{$locale}, - }); - my $error = $msgcat->insert; - die $error if $error; - } - } - -} - -sub msgcat_messages { - - # 'msgcode' => { - # 'en_US' => 'Message', - # }, - - ( - - 'passwords_dont_match' => { - 'en_US' => "Passwords don't match", - }, - - 'invalid_card' => { - 'en_US' => 'Invalid credit card number', - }, - - 'unknown_card_type' => { - 'en_US' => 'Unknown card type', - }, - - 'not_a' => { - 'en_US' => 'Not a ', - }, - - 'empty_password' => { - 'en_US' => 'Empty password', - }, - - 'no_access_number_selected' => { - 'en_US' => 'No access number selected', - }, - - 'illegal_text' => { - 'en_US' => 'Illegal (text)', - #'en_US' => 'Only letters, numbers, spaces, and the following punctuation symbols are permitted: ! @ # $ % & ( ) - + ; : \' " , . ? / in field', - }, - - 'illegal_or_empty_text' => { - 'en_US' => 'Illegal or empty (text)', - #'en_US' => 'Only letters, numbers, spaces, and the following punctuation symbols are permitted: ! @ # $ % & ( ) - + ; : \' " , . ? / in required field', - }, - - 'illegal_username' => { - 'en_US' => 'Illegal username', - }, - - 'illegal_password' => { - 'en_US' => 'Illegal password (', - }, - - 'illegal_password_characters' => { - 'en_US' => ' characters)', - }, - - 'username_in_use' => { - 'en_US' => 'Username in use', - }, - - 'illegal_email_invoice_address' => { - 'en_US' => 'Illegal email invoice address', - }, - - 'illegal_name' => { - 'en_US' => 'Illegal (name)', - #'en_US' => 'Only letters, numbers, spaces and the following punctuation symbols are permitted: , . - \' in field', - }, - - 'illegal_phone' => { - 'en_US' => 'Illegal (phone)', - #'en_US' => '', - }, - - 'illegal_zip' => { - 'en_US' => 'Illegal (zip)', - #'en_US' => '', - }, - - 'expired_card' => { - 'en_US' => 'Expired card', - }, - - 'daytime' => { - 'en_US' => 'Day Phone', - }, - - 'night' => { - 'en_US' => 'Night Phone', - }, - - 'svc_external-id' => { - 'en_US' => 'External ID', - }, - - 'svc_external-title' => { - 'en_US' => 'Title', - }, - - ); -} - -=back - -=head1 BUGS - -Sure. - -=head1 SEE ALSO - -=cut - -1; - diff --git a/FS/FS/TicketSystem.pm b/FS/FS/TicketSystem.pm deleted file mode 100644 index a80a827..0000000 --- a/FS/FS/TicketSystem.pm +++ /dev/null @@ -1,30 +0,0 @@ -package FS::TicketSystem; - -use strict; -use vars qw( $conf $system $AUTOLOAD ); -use FS::Conf; -use FS::UID; - -FS::UID->install_callback( sub { - $conf = new FS::Conf; - $system = $conf->config('ticket_system'); -} ); - -sub AUTOLOAD { - my $self = shift; - - my($sub)=$AUTOLOAD; - $sub =~ s/.*://; - - my $conf = new FS::Conf; - die "FS::TicketSystem::$AUTOLOAD called, but no ticket system configured\n" - unless $system; - - eval "use FS::TicketSystem::$system;"; - die $@ if $@; - - $self .= "::$system"; - $self->$sub(@_); -} - -1; diff --git a/FS/FS/TicketSystem/RT_External.pm b/FS/FS/TicketSystem/RT_External.pm deleted file mode 100644 index 7dde862..0000000 --- a/FS/FS/TicketSystem/RT_External.pm +++ /dev/null @@ -1,264 +0,0 @@ -package FS::TicketSystem::RT_External; - -use strict; -use vars qw( $conf $default_queueid - $priority_field $priority_field_queue $field - $dbh $external_url ); -use URI::Escape; -use FS::UID qw(dbh); -use FS::Record qw(qsearchs); -use FS::cust_main; - -FS::UID->install_callback( sub { - $conf = new FS::Conf; - $default_queueid = $conf->config('ticket_system-default_queueid'); - $priority_field = - $conf->config('ticket_system-custom_priority_field'); - if ( $priority_field ) { - $priority_field_queue = - $conf->config('ticket_system-custom_priority_field_queue'); - $field = $priority_field_queue - ? $priority_field_queue. '.%7B'. $priority_field. '%7D' - : $priority_field; - } else { - $priority_field_queue = ''; - $field = ''; - } - - $external_url = ''; - $dbh = dbh; - if ($conf->config('ticket_system') eq 'RT_External') { - my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc'); - $dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 }) - or die "RT_External DBI->connect error: $DBI::errstr\n"; - - $external_url = $conf->config('ticket_system-rt_external_url'); - } - -} ); - -sub num_customer_tickets { - my( $self, $custnum, $priority ) = @_; - - my( $from_sql, @param) = $self->_from_customer( $custnum, $priority ); - - my $sql = "SELECT COUNT(*) $from_sql"; - my $sth = $dbh->prepare($sql) or die $dbh->errstr. " preparing $sql"; - $sth->execute(@param) or die $sth->errstr. " executing $sql"; - - $sth->fetchrow_arrayref->[0]; - -} - -sub customer_tickets { - my( $self, $custnum, $limit, $priority ) = @_; - $limit ||= 0; - - my( $from_sql, @param) = $self->_from_customer( $custnum, $priority ); - my $sql = "SELECT tickets.*, queues.name". - ( length($priority) ? ", objectcustomfieldvalues.content" : '' ). - " $from_sql ORDER BY priority, id DESC LIMIT $limit"; - my $sth = $dbh->prepare($sql) or die $dbh->errstr. "preparing $sql"; - $sth->execute(@param) or die $sth->errstr. "executing $sql"; - - #munge column names??? #httemplate/view/cust_main/tickets.html has column - #names that might not make sense now... - $sth->fetchall_arrayref({}); - -} - -sub _from_customer { - my( $self, $custnum, $priority ) = @_; - - my @param = (); - my $join = ''; - my $where = ''; - if ( defined($priority) ) { - - my $queue_sql = " ObjectCustomFields.ObjectId = ( SELECT id FROM queues - WHERE queues.name = ? ) - OR ( ? = '' AND ObjectCustomFields.ObjectId = 0 )"; - - my $customfield_sql = - "customfield = ( - SELECT CustomFields.Id FROM CustomFields - JOIN ObjectCustomFields - ON ( CustomFields.id = ObjectCustomFields.CustomField ) - WHERE LookupType = 'RT::Queue-RT::Ticket' - AND name = ? - AND ( $queue_sql ) - )"; - - push @param, $priority_field, - $priority_field_queue, - $priority_field_queue; - - if ( length($priority) ) { - #$where = " - # and ? = ( select content from TicketCustomFieldValues - # where ticket = tickets.id - # and customfield = ( select id from customfields - # where name = ? - # and ( $queue_sql ) - # ) - # ) - #"; - unshift @param, $priority; - - $join = "JOIN ObjectCustomFieldValues - ON ( tickets.id = ObjectCustomFieldValues.ObjectId )"; - - $where = " AND content = ? - AND ObjectCustomFieldValues.disabled != 1 - AND ObjectType = 'RT::Ticket' - AND $customfield_sql"; - - } else { - - $where = - "AND 0 = ( SELECT count(*) FROM ObjectCustomFieldValues - WHERE ObjectId = tickets.id - AND ObjectType = 'RT::Ticket' - AND $customfield_sql - ) - "; - } - - } - - my $sql = " - FROM tickets - JOIN queues ON ( tickets.queue = queues.id ) - JOIN links ON ( tickets.id = links.localbase ) - $join - WHERE ( ". join(' OR ', map "status = '$_'", $self->statuses ). " ) - AND target = 'freeside://freeside/cust_main/$custnum' - $where - "; - - ( $sql, @param ); - -} - -sub statuses { - #my $self = shift; - my @statuses = grep { ! /^\s*$/ } $conf->config('cust_main-ticket_statuses'); - @statuses = (qw( new open stalled )) unless scalar(@statuses); - @statuses; -} - -sub href_customer_tickets { - my( $self, $custnum, $priority ) = @_; - - #my $href = $self->baseurl; - - #i snarfed this from an RT bookmarked search, then unescaped (some of) it with - #perl -npe 's/%([0-9A-F]{2})/pack('C', hex($1))/eg;' - - my $href .= - "Search/Results.html?Order=ASC&". - "Query= MemberOf = 'freeside://freeside/cust_main/$custnum' ". - #" AND ( Status = 'open' OR Status = 'new' OR Status = 'stalled' )" - " AND ( ". join(' OR ', map "Status = '$_'", $self->statuses ). " ) " - ; - - if ( defined($priority) && $field && $priority_field_queue ) { - $href .= " AND Queue = '$priority_field_queue' "; - } - if ( defined($priority) && $field ) { - $href .= " AND 'CF.$field' "; - if ( $priority ) { - $href .= "= '$priority' "; - } else { - $href .= "IS 'NULL' "; #this is "RTQL", not SQL - } - } - - #$href = - uri_escape($href); - #eventually should unescape all of it... - - $href .= '&Rows=100'. - '&OrderBy=id&Page=1'. - '&Format=%27%20%20%20%3Cb%3E%3Ca%20href%3D%22'. - $self->baseurl. - 'Ticket%2FDisplay.html%3Fid%3D__id__%22%3E__id__%3C%2Fa%3E%3C%2Fb%3E%2FTITLE%3A%23%27%2C%20%0A%27%3Cb%3E%3Ca%20href%3D%22'. - $self->baseurl. - 'Ticket%2FDisplay.html%3Fid%3D__id__%22%3E__Subject__%3C%2Fa%3E%3C%2Fb%3E%2FTITLE%3ASubject%27%2C%20%0A%27__Status__%27%2C%20'; - - if ( defined($priority) && $field ) { - $href .= '%0A%27__CustomField.'. $field. '__%2FTITLE%3ASeverity%27%2C%20'; - } - - $href .= '%0A%27__QueueName__%27%2C%20%0A%27__OwnerName__%27%2C%20%0A%27__Priority__%27%2C%20%0A%27__NEWLINE__%27%2C%20%0A%27%27%2C%20%0A%27%3Csmall%3E__Requestors__%3C%2Fsmall%3E%27%2C%20%0A%27%3Csmall%3E__CreatedRelative__%3C%2Fsmall%3E%27%2C'; - - if ( defined($priority) && $field ) { - $href .= '%20%0A%27__-__%27%2C'; - } - - $href .= '%20%0A%27%3Csmall%3E__ToldRelative__%3C%2Fsmall%3E%27%2C%20%0A%27%3Csmall%3E__LastUpdatedRelative__%3C%2Fsmall%3E%27%2C%20%0A%27%3Csmall%3E__TimeLeft__%3C%2Fsmall%3E%27'; - - #$href = - #uri_escape($href); - - $self->baseurl. $href; - -} - -sub href_new_ticket { - my( $self, $custnum_or_cust_main, $requestors ) = @_; - - my( $custnum, $cust_main ); - if ( ref($custnum_or_cust_main) ) { - $cust_main = $custnum_or_cust_main; - $custnum = $cust_main->custnum; - } else { - $custnum = $custnum_or_cust_main; - $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ); - } - my $queueid = $cust_main->agent->ticketing_queueid || $default_queueid; - - $self->baseurl. - 'Ticket/Create.html?'. - "Queue=$queueid". - "&new-MemberOf=freeside://freeside/cust_main/$custnum". - ( $requestors ? '&Requestors='. uri_escape($requestors) : '' ) - ; -} - -sub href_ticket { - my($self, $ticketnum) = @_; - $self->baseurl. 'Ticket/Display.html?id='.$ticketnum; -} - -sub queues { - my($self) = @_; - - my $sql = "SELECT id, name FROM queues WHERE disabled = 0"; - my $sth = $dbh->prepare($sql) or die $dbh->errstr. " preparing $sql"; - $sth->execute() or die $sth->errstr. " executing $sql"; - - map { $_->[0] => $_->[1] } @{ $sth->fetchall_arrayref([]) }; - -} - -sub queue { - my($self, $queueid) = @_; - - return '' unless $queueid; - - my $sql = "SELECT name FROM queues WHERE id = ?"; - my $sth = $dbh->prepare($sql) or die $dbh->errstr. " preparing $sql"; - $sth->execute($queueid) or die $sth->errstr. " executing $sql"; - - $sth->fetchrow_arrayref->[0]; - -} - -sub baseurl { - #my $self = shift; - $external_url; -} - -1; - diff --git a/FS/FS/TicketSystem/RT_Internal.pm b/FS/FS/TicketSystem/RT_Internal.pm deleted file mode 100644 index 8fce918..0000000 --- a/FS/FS/TicketSystem/RT_Internal.pm +++ /dev/null @@ -1,29 +0,0 @@ -package FS::TicketSystem::RT_Internal; - -use strict; -use vars qw( @ISA ); -use FS::UID qw(dbh); -use FS::CGI qw(popurl); -use FS::TicketSystem::RT_Libs; - -@ISA = qw( FS::TicketSystem::RT_Libs ); - -sub sql_num_customer_tickets { - "( select count(*) from tickets - join links on ( tickets.id = links.localbase ) - where ( status = 'new' or status = 'open' or status = 'stalled' ) - and target = 'freeside://freeside/cust_main/' || custnum - )"; -} - -sub baseurl { - #my $self = shift; - if ( $RT::URI::freeside::URL ) { - $RT::URI::freeside::URL. 'rt/'; - } else { - 'http://you_need_to_set_RT_URI_freeside_URL_in_SiteConfig.pm/'; - } -} - -1; - diff --git a/FS/FS/TicketSystem/RT_Libs.pm b/FS/FS/TicketSystem/RT_Libs.pm deleted file mode 100644 index aebe8c5..0000000 --- a/FS/FS/TicketSystem/RT_Libs.pm +++ /dev/null @@ -1,10 +0,0 @@ -package FS::TicketSystem::RT_Libs; - -use strict; -use vars qw( @ISA ); -use FS::TicketSystem::RT_External; - -@ISA = qw( FS::TicketSystem::RT_External ); - -1; - diff --git a/FS/FS/UI/Web.pm b/FS/FS/UI/Web.pm deleted file mode 100644 index 080ac6e..0000000 --- a/FS/FS/UI/Web.pm +++ /dev/null @@ -1,326 +0,0 @@ -package FS::UI::Web; - -use vars qw($DEBUG); -use FS::Conf; -use FS::Record qw(dbdef); - -#use vars qw(@ISA); -#use FS::UI -#@ISA = qw( FS::UI ); - -$DEBUG = 0; - -use Date::Parse; -sub parse_beginning_ending { - my($cgi) = @_; - - my $beginning = 0; - if ( $cgi->param('begin') =~ /^(\d+)$/ ) { - $beginning = $1; - } elsif ( $cgi->param('beginning') =~ /^([ 0-9\-\/]{1,64})$/ ) { - $beginning = str2time($1) || 0; - } - - my $ending = 4294967295; #2^32-1 - if ( $cgi->param('end') =~ /^(\d+)$/ ) { - $ending = $1 - 1; - } elsif ( $cgi->param('ending') =~ /^([ 0-9\-\/]{1,64})$/ ) { - #probably need an option to turn off the + 86399 - $ending = str2time($1) + 86399; - } - - ( $beginning, $ending ); -} - -### -# cust_main report subroutines -### - - -=item cust_header [ CUST_FIELDS_VALUE ] - -Returns an array of customer information headers according to the supplied -customer fields value, or if no value is supplied, the B<cust-fields> -configuration value. - -=cut - -use vars qw( @cust_fields ); - -sub cust_header { - - warn "FS::svc_Common::cust_header called" - if $DEBUG; - - my %header2method = ( - 'Customer' => 'name', - 'Cust#' => 'custnum', - 'Name' => 'contact', - 'Company' => 'company', - '(bill) Customer' => 'name', - '(service) Customer' => 'ship_name', - '(bill) Name' => 'contact', - '(service) Name' => 'ship_contact', - '(bill) Company' => 'company', - '(service) Company' => 'ship_company', - 'Address 1' => 'address1', - 'Address 2' => 'address2', - 'City' => 'city', - 'State' => 'state', - 'Zip' => 'zip', - 'Country' => 'country_full', - 'Day phone' => 'daytime', # XXX should use msgcat, but how? - 'Night phone' => 'night', # XXX should use msgcat, but how? - 'Invoicing email(s)' => 'invoicing_list_emailonly', - ); - - my $cust_fields; - my @cust_header; - if ( @_ && $_[0] ) { - - warn " using supplied cust-fields override". - " (ignoring cust-fields config file)" - if $DEBUG; - $cust_fields = shift; - - } else { - - my $conf = new FS::Conf; - if ( $conf->exists('cust-fields') - && $conf->config('cust-fields') =~ /^([\w \|\#\(\)]+):?/ - ) - { - warn " found cust-fields configuration value" - if $DEBUG; - $cust_fields = $1; - } else { - warn " no cust-fields configuration value found; using default 'Customer'" - if $DEBUG; - $cust_fields = 'Customer'; - } - - } - - @cust_header = split(/ \| /, $cust_fields); - @cust_fields = map { $header2method{$_} } @cust_header; - - #my $svc_x = shift; - @cust_header; -} - -=item cust_sql_fields [ CUST_FIELDS_VALUE ] - -Returns a list of fields for the SELECT portion of an SQL query. - -As with L<the cust_header subroutine|/cust_header>, the fields returned are -defined by the supplied customer fields setting, or if no customer fields -setting is supplied, the <B>cust-fields</B> configuration value. - -=cut - -sub cust_sql_fields { - - my @fields = qw( last first company ); - push @fields, map "ship_$_", @fields; - push @fields, 'country'; - - cust_header(@_); - #inefficientish, but tiny lists and only run once per page - push @fields, - grep { my $field = $_; grep { $_ eq $field } @cust_fields } - qw( address1 address2 city state zip daytime night ); - - map "cust_main.$_", @fields; -} - -=item cust_fields SVC_OBJECT [ CUST_FIELDS_VALUE ] - -Given a svc_ object that contains fields from cust_main (say, from a -JOINed search. See httemplate/search/svc_* for examples), returns an array -of customer information, or "(unlinked)" if this service is not linked to a -customer. - -As with L<the cust_header subroutine|/cust_header>, the fields returned are -defined by the supplied customer fields setting, or if no customer fields -setting is supplied, the <B>cust-fields</B> configuration value. - -=cut - -sub cust_fields { - my $svc_x = shift; - warn "FS::svc_Common::cust_fields called for $svc_x ". - "(cust_fields: @cust_fields)" - if $DEBUG > 1; - - #cust_header(@_) unless @cust_fields; #now need to cache to keep cust_fields - # #override incase we were passed as a sub - - my $seen_unlinked = 0; - map { - if ( $svc_x->custnum ) { - warn " $svc_x -> $_" - if $DEBUG > 1; - $svc_x->$_(@_); - } else { - warn " ($svc_x unlinked)" - if $DEBUG > 1; - $seen_unlinked++ ? '' : '(unlinked)'; - } - } @cust_fields; -} - -### -# begin JSRPC code... -### - -package FS::UI::Web::JSRPC; - -use strict; -use vars qw($DEBUG); -use Carp; -use Storable qw(nfreeze); -use MIME::Base64; -use JSON; -use FS::UID; -use FS::Record qw(qsearchs); -use FS::queue; - -$DEBUG = 0; - -sub new { - my $class = shift; - my $self = { - env => {}, - job => shift, - cgi => shift, - }; - - bless $self, $class; - - croak "CGI object required as second argument" unless $self->{'cgi'}; - - return $self; -} - -sub process { - - my $self = shift; - - my $cgi = $self->{'cgi'}; - - # XXX this should parse JSON foo and build a proper data structure - my @args = $cgi->param('arg'); - - #work around konqueror bug! - @args = map { s/\x00$//; $_; } @args; - - my $sub = $cgi->param('sub'); #???? - - warn "FS::UI::Web::JSRPC::process:\n". - " cgi=$cgi\n". - " sub=$sub\n". - " args=".join(', ',@args)."\n" - if $DEBUG; - - if ( $sub eq 'start_job' ) { - - $self->start_job(@args); - - } elsif ( $sub eq 'job_status' ) { - - $self->job_status(@args); - - } else { - - die "unknown sub $sub"; - - } - -} - -sub start_job { - my $self = shift; - - warn "FS::UI::Web::start_job: ". join(', ', @_) if $DEBUG; -# my %param = @_; - my %param = (); - while ( @_ ) { - my( $field, $value ) = splice(@_, 0, 2); - unless ( exists( $param{$field} ) ) { - $param{$field} = $value; - } elsif ( ! ref($param{$field}) ) { - $param{$field} = [ $param{$field}, $value ]; - } else { - push @{$param{$field}}, $value; - } - } - warn "FS::UI::Web::start_job\n". - join('', map { - if ( ref($param{$_}) ) { - " $_ => [ ". join(', ', @{$param{$_}}). " ]\n"; - } else { - " $_ => $param{$_}\n"; - } - } keys %param ) - if $DEBUG; - - #first get the CGI params shipped off to a job ASAP so an id can be returned - #to the caller - - my $job = new FS::queue { 'job' => $self->{'job'} }; - - #too slow to insert all the cgi params as individual args..,? - #my $error = $queue->insert('_JOB', $cgi->Vars); - - #warn 'froze string of size '. length(nfreeze(\%param)). " for job args\n" - # if $DEBUG; - - my $error = $job->insert( '_JOB', encode_base64(nfreeze(\%param)) ); - - if ( $error ) { - - warn "job not inserted: $error\n" - if $DEBUG; - - $error; #this doesn't seem to be handled well, - # will trigger "illegal jobnum" below? - # (should never be an error inserting the job, though, only thing - # would be Pg f%*kage) - } else { - - warn "job inserted successfully with jobnum ". $job->jobnum. "\n" - if $DEBUG; - - $job->jobnum; - } - -} - -sub job_status { - my( $self, $jobnum ) = @_; #$url ??? - - sleep 1; # XXX could use something better... - - my $job; - if ( $jobnum =~ /^(\d+)$/ ) { - $job = qsearchs('queue', { 'jobnum' => $jobnum } ); - } else { - die "FS::UI::Web::job_status: illegal jobnum $jobnum\n"; - } - - my @return; - if ( $job && $job->status ne 'failed' ) { - @return = ( 'progress', $job->statustext ); - } elsif ( !$job ) { #handle job gone case : job successful - # so close popup, redirect parent window... - @return = ( 'complete' ); - } else { - @return = ( 'error', $job ? $job->statustext : $jobnum ); - } - - objToJson(\@return); - -} - -1; - diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm deleted file mode 100644 index eb703d3..0000000 --- a/FS/FS/UID.pm +++ /dev/null @@ -1,346 +0,0 @@ -package FS::UID; - -use strict; -use vars qw( - @ISA @EXPORT_OK $cgi $dbh $freeside_uid $user - $conf_dir $secrets $datasrc $db_user $db_pass %callback @callback - $driver_name $AutoCommit -); -use subs qw( - getsecrets cgisetotaker -); -use Exporter; -use Carp qw(carp croak cluck confess); -use DBI; -use FS::Conf; -use FS::CurrentUser; - -@ISA = qw(Exporter); -@EXPORT_OK = qw(checkeuid checkruid cgisuidsetup adminsuidsetup forksuidsetup - getotaker dbh datasrc getsecrets driver_name myconnect ); - -$freeside_uid = scalar(getpwnam('freeside')); - -$conf_dir = "/usr/local/etc/freeside/"; - -$AutoCommit = 1; #ours, not DBI - -=head1 NAME - -FS::UID - Subroutines for database login and assorted other stuff - -=head1 SYNOPSIS - - use FS::UID qw(adminsuidsetup cgisuidsetup dbh datasrc getotaker - checkeuid checkruid); - - adminsuidsetup $user; - - $cgi = new CGI; - $dbh = cgisuidsetup($cgi); - - $dbh = dbh; - - $datasrc = datasrc; - - $driver_name = driver_name; - -=head1 DESCRIPTION - -Provides a hodgepodge of subroutines. - -=head1 SUBROUTINES - -=over 4 - -=item adminsuidsetup USER - -Sets the user to USER (see config.html from the base documentation). -Cleans the environment. -Make sure the script is running as freeside, or setuid freeside. -Opens a connection to the database. -Swaps real and effective UIDs. -Runs any defined callbacks (see below). -Returns the DBI database handle (usually you don't need this). - -=cut - -sub adminsuidsetup { - $dbh->disconnect if $dbh; - &forksuidsetup(@_); -} - -sub forksuidsetup { - $user = shift; - my $olduser = $user; - - if ( $FS::CurrentUser::upgrade_hack ) { - $user = 'fs_bootstrap'; - } else { - croak "fatal: adminsuidsetup called without arguements" unless $user; - - $user =~ /^([\w\-\.]+)$/ or croak "fatal: illegal user $user"; - $user = $1; - } - - $ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin'; - $ENV{'SHELL'} = '/bin/sh'; - $ENV{'IFS'} = " \t\n"; - $ENV{'CDPATH'} = ''; - $ENV{'ENV'} = ''; - $ENV{'BASH_ENV'} = ''; - - croak "Not running uid freeside!" unless checkeuid(); - - if ( $FS::CurrentUser::upgrade_hack && $olduser ) { - $dbh = &myconnect($olduser); - } else { - $dbh = &myconnect(); - } - - use FS::Schema qw(reload_dbdef); - reload_dbdef("/usr/local/etc/freeside/dbdef.$datasrc") - unless $FS::Schema::setup_hack; - - FS::CurrentUser->load_user($user); - - foreach ( keys %callback ) { - &{$callback{$_}}; - # breaks multi-database installs # delete $callback{$_}; #run once - } - - &{$_} foreach @callback; - - $dbh; -} - -sub myconnect { - DBI->connect( getsecrets(@_), { 'AutoCommit' => 0, - 'ChopBlanks' => 1, - 'ShowErrorStatement' => 1, - } - ) - or die "DBI->connect error: $DBI::errstr\n"; -} - -=item install_callback - -A package can install a callback to be run in adminsuidsetup by passing -a coderef to the FS::UID->install_callback class method. If adminsuidsetup has -run already, the callback will also be run immediately. - - $coderef = sub { warn "Hi, I'm returning your call!" }; - FS::UID->install_callback($coderef); - - install_callback FS::UID sub { - warn "Hi, I'm returning your call!" - }; - -=cut - -sub install_callback { - my $class = shift; - my $callback = shift; - push @callback, $callback; - &{$callback} if $dbh; -} - -=item cgisuidsetup CGI_object - -Takes a single argument, which is a CGI (see L<CGI>) or Apache (see L<Apache>) -object (CGI::Base is depriciated). Runs cgisetotaker and then adminsuidsetup. - -=cut - -sub cgisuidsetup { - $cgi=shift; - if ( $cgi->isa('CGI::Base') ) { - carp "Use of CGI::Base is depriciated"; - } elsif ( $cgi->isa('Apache') ) { - - } elsif ( ! $cgi->isa('CGI') ) { - croak "fatal: unrecognized object $cgi"; - } - cgisetotaker; - adminsuidsetup($user); -} - -=item cgi - -Returns the CGI (see L<CGI>) object. - -=cut - -sub cgi { - carp "warning: \$FS::UID::cgi isa Apache" if $cgi->isa('Apache'); - $cgi; -} - -=item dbh - -Returns the DBI database handle. - -=cut - -sub dbh { - $dbh; -} - -=item datasrc - -Returns the DBI data source. - -=cut - -sub datasrc { - $datasrc; -} - -=item driver_name - -Returns just the driver name portion of the DBI data source. - -=cut - -sub driver_name { - return $driver_name if defined $driver_name; - $driver_name = ( split(':', $datasrc) )[1]; -} - -sub suidsetup { - croak "suidsetup depriciated"; -} - -=item getotaker - -Returns the current Freeside user. - -=cut - -sub getotaker { - $user; -} - -=item cgisetotaker - -Sets and returns the CGI REMOTE_USER. $cgi should be defined as a CGI.pm -object (see L<CGI>) or an Apache object (see L<Apache>). Support for CGI::Base -and derived classes is depriciated. - -=cut - -sub cgisetotaker { - if ( $cgi && $cgi->isa('CGI::Base') && defined $cgi->var('REMOTE_USER')) { - carp "Use of CGI::Base is depriciated"; - $user = lc ( $cgi->var('REMOTE_USER') ); - } elsif ( $cgi && $cgi->isa('CGI') && defined $cgi->remote_user ) { - $user = lc ( $cgi->remote_user ); - } elsif ( $cgi && $cgi->isa('Apache') ) { - $user = lc ( $cgi->connection->user ); - } else { - die "fatal: Can't get REMOTE_USER! for cgi $cgi - you need to setup ". - "Apache user authentication as documented in httemplate/docs/install.html"; - } - $user; -} - -=item checkeuid - -Returns true if effective UID is that of the freeside user. - -=cut - -sub checkeuid { - ( $> == $freeside_uid ); -} - -=item checkruid - -Returns true if the real UID is that of the freeside user. - -=cut - -sub checkruid { - ( $< == $freeside_uid ); -} - -=item getsecrets [ USER ] - -Sets the user to USER, if supplied. -Sets and returns the DBI datasource, username and password for this user from -the `/usr/local/etc/freeside/mapsecrets' file. - -=cut - -sub getsecrets { - my($setuser) = shift; - $user = $setuser if $setuser; - my($conf) = new FS::Conf $conf_dir; - - if ( $conf->exists('mapsecrets') ) { - die "No user!" unless $user; - my($line) = grep /^\s*($user|\*)\s/, $conf->config('mapsecrets'); - confess "User $user not found in mapsecrets!" unless $line; - $line =~ /^\s*($user|\*)\s+(.*)$/; - $secrets = $2; - die "Illegal mapsecrets line for user?!" unless $secrets; - } else { - # no mapsecrets file at all, so do the default thing - $secrets = 'secrets'; - } - - ($datasrc, $db_user, $db_pass) = $conf->config($secrets) - or die "Can't get secrets: $secrets: $!\n"; - $FS::Conf::default_dir = $conf_dir. "/conf.$datasrc"; - undef $driver_name; - ($datasrc, $db_user, $db_pass); -} - -=back - -=head1 CALLBACKS - -Warning: this interface is (still) likely to change in future releases. - -New (experimental) callback interface: - -A package can install a callback to be run in adminsuidsetup by passing -a coderef to the FS::UID->install_callback class method. If adminsuidsetup has -run already, the callback will also be run immediately. - - $coderef = sub { warn "Hi, I'm returning your call!" }; - FS::UID->install_callback($coderef); - - install_callback FS::UID sub { - warn "Hi, I'm returning your call!" - }; - -Old (deprecated) callback interface: - -A package can install a callback to be run in adminsuidsetup by putting a -coderef into the hash %FS::UID::callback : - - $coderef = sub { warn "Hi, I'm returning your call!" }; - $FS::UID::callback{'Package::Name'} = $coderef; - -=head1 BUGS - -Too many package-global variables. - -Not OO. - -No capabilities yet. When mod_perl and Authen::DBI are implemented, -cgisuidsetup will go away as well. - -Goes through contortions to support non-OO syntax with multiple datasrc's. - -Callbacks are (still) inelegant. - -=head1 SEE ALSO - -L<FS::Record>, L<CGI>, L<DBI>, config.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/XMLRPC.pm b/FS/FS/XMLRPC.pm deleted file mode 100644 index 84f3e41..0000000 --- a/FS/FS/XMLRPC.pm +++ /dev/null @@ -1,165 +0,0 @@ -package FS::XMLRPC; - -use strict; -use vars qw( @ISA $DEBUG ); -use Frontier::RPC2; - -# Instead of 'use'ing freeside modules on the fly below, just preload them now. -use FS; -use FS::CGI; -use FS::Conf; -use FS::Record; -use FS::cust_main; - -@ISA = qw( ); - -$DEBUG = 1; - -=head1 NAME - -FS::XMLRPC - Object methods for handling XMLRPC requests - -=head1 SYNOPSIS - - use FS::XMLRPC; - - $xmlrpc = new FS::XMLRPC; - - ($error, $response_xml) = $xmlrpc->serve($request_xml); - -=head1 DESCRIPTION - -The FS::XMLRPC object is a mechanisim to access read-only data from freeside's subroutines. It does not, at least not at this point, give you the ability to access methods of freeside objects remotely. It can, however, be used to call subroutines such as FS::cust_main::smart_search and FS::Record::qsearch. - -See the serve method below for calling syntax. - -=head1 METHODS - -=over 4 - -=item new - -Provides a FS::XMLRPC object used to handle incoming XMLRPC requests. - -=cut - -sub new { - - my $class = shift; - my $self = {}; - bless($self, $class); - - $self->{_coder} = new Frontier::RPC2; - - return $self; - -} - -=item serve REQUEST_XML_SCALAR - -The serve method takes a scalar containg an XMLRPC request for one of freeside's subroutines (not object methods). Parameters passed in the 'methodCall' will be passed as a list to the subroutine untouched. The return value of the called subroutine _must_ be a freeside object reference (eg. qsearchs) or a list of freeside object references (eg. qsearch, smart_search), _and_, the object(s) returned must support the hashref method. This will be checked first by calling UNIVERSAL::can('FS::class::subroutine', 'hashref'). - -Return value is an XMLRPC methodResponse containing the results of the call. The result of the subroutine call itself will be coded in the methodResponse as an array of structs, regardless of whether there was many or a single object returned. In other words, after you decode the response, you'll always have an array. - -=cut - -sub serve { - - my ($self, $request_xml) = (shift, shift); - my $response_xml; - - my $coder = $self->{_coder}; - my $call = $coder->decode($request_xml); - - warn "Got methodCall with method_name='" . $call->{method_name} . "'" - if $DEBUG; - - $response_xml = $coder->encode_response(&_serve($call->{method_name}, $call->{value})); - - return ('', $response_xml); - -} - -sub _serve { #Subroutine, not method - - my ($method_name, $params) = (shift, shift); - - use Data::Dumper; - - #die 'Called _serve without parameters' unless ref($params) eq 'ARRAY'; - $params = [] unless (ref($params) eq 'ARRAY'); - - if ($method_name =~ /^(\w+)\.(\w+)/) { - - #my ($class, $sub) = split(/\./, $method_name); - my ($class, $sub) = ($1, $2); - my $fssub = "FS::${class}::${sub}"; - warn "fssub: ${fssub}" if $DEBUG; - warn "params: " . Dumper($params) if $DEBUG; - - my @result; - - if ($class eq 'Conf') { #Special case for FS::Conf because we need an obj. - - if ($sub eq 'config') { - my $conf = new FS::Conf; - @result = ($conf->config(@$params)); - } else { - warn "FS::XMLRPC: Can't call undefined subroutine '${fssub}'"; - } - - } else { - - unless (UNIVERSAL::can("FS::${class}", $sub)) { - warn "FS::XMLRPC: Can't call undefined subroutine '${fssub}'"; - # Should we encode an error in the response, - # or just break silently to the remote caller and complain locally? - return []; - } - - eval { - no strict 'refs'; - my $fssub = "FS::${class}::${sub}"; - @result = (&$fssub(@$params)); - }; - - if ($@) { - warn "FS::XMLRPC: Error while calling '${fssub}': $@"; - return []; - } - - } - - warn Dumper(@result); - - if (grep { UNIVERSAL::can($_, 'hashref') ? 0 : 1 } @result) { - #warn "FS::XMLRPC: One or more objects returned from '${fssub}' doesn't " . - # "support the 'hashref' method."; - - # If they're not FS::Record decendants, just return the results unmap'd? - # This is more flexible, but possibly more error-prone. - return [ @result ]; - } else { - return [ map { $_->hashref } @result ]; - } - } elsif ($method_name eq 'version') { - return [ $FS::VERSION ]; - } # else... - - warn "Unhandle XMLRPC request '${method_name}'"; - return []; - -} - -=head1 BUGS - -Probably lots. - -=head1 SEE ALSO - -L<Frontier::RPC2>. - -=cut - -1; - diff --git a/FS/FS/access_group.pm b/FS/FS/access_group.pm deleted file mode 100644 index 2519040..0000000 --- a/FS/FS/access_group.pm +++ /dev/null @@ -1,162 +0,0 @@ -package FS::access_group; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); -use FS::m2name_Common; -use FS::access_groupagent; -use FS::access_right; - -@ISA = qw(FS::m2m_Common FS::m2name_Common FS::Record); - -=head1 NAME - -FS::access_group - Object methods for access_group records - -=head1 SYNOPSIS - - use FS::access_group; - - $record = new FS::access_group \%hash; - $record = new FS::access_group { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::access_group object represents an access group. FS::access_group inherits from -FS::Record. The following fields are currently supported: - -=over 4 - -=item groupnum - primary key - -=item groupname - Access group name - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new access group. To add the access group to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'access_group'; } - -=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 access group. 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('groupnum') - || $self->ut_text('groupname') - ; - return $error if $error; - - $self->SUPER::check; -} - -=item access_groupagent - -Returns all associated FS::access_groupagent records. - -=cut - -sub access_groupagent { - my $self = shift; - qsearch('access_groupagent', { 'groupnum' => $self->groupnum } ); -} - -=item access_rights - -Returns all associated FS::access_right records. - -=cut - -sub access_rights { - my $self = shift; - qsearch('access_right', { 'righttype' => 'FS::access_group', - 'rightobjnum' => $self->groupnum - } - ); -} - -=item access_right RIGHTNAME - -Returns the specified FS::access_right record. Can be used as a boolean, to -test if this group has the given RIGHTNAME. - -=cut - -sub access_right { - my( $self, $name ) = shift; - qsearchs('access_right', { 'righttype' => 'FS::access_group', - 'rightobjnum' => $self->groupnum, - 'rightname' => $name, - } - ); -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/access_groupagent.pm b/FS/FS/access_groupagent.pm deleted file mode 100644 index 3de8fee..0000000 --- a/FS/FS/access_groupagent.pm +++ /dev/null @@ -1,134 +0,0 @@ -package FS::access_groupagent; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); -use FS::agent; - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::access_groupagent - Object methods for access_groupagent records - -=head1 SYNOPSIS - - use FS::access_groupagent; - - $record = new FS::access_groupagent \%hash; - $record = new FS::access_groupagent { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::access_groupagent object represents an group reseller virtualization. FS::access_groupagent inherits from -FS::Record. The following fields are currently supported: - -=over 4 - -=item groupagentnum - primary key - -=item groupnum - - -=item agentnum - - - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new group reseller virtualization. To add the record to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'access_groupagent'; } - -=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 group reseller virtualization. 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('groupagentnum') - || $self->ut_foreign_key('groupnum', 'access_group', 'groupnum') - || $self->ut_foreign_key('agentnum', 'agent', 'agentnum') - ; - return $error if $error; - - $self->SUPER::check; -} - -=item agent - -Returns the associated FS::agent object. - -=cut - -sub agent { - my $self = shift; - qsearchs('agent', { 'agentnum' => $self->agentnum } ); -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/access_right.pm b/FS/FS/access_right.pm deleted file mode 100644 index 67200f2..0000000 --- a/FS/FS/access_right.pm +++ /dev/null @@ -1,127 +0,0 @@ -package FS::access_right; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::access_right - Object methods for access_right records - -=head1 SYNOPSIS - - use FS::access_right; - - $record = new FS::access_right \%hash; - $record = new FS::access_right { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::access_right object represents an example. FS::access_right inherits from -FS::Record. The following fields are currently supported: - -=over 4 - -=item rightnum - primary key - -=item righttype - - -=item rightobjnum - - -=item rightname - - - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new example. To add the example to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'access_right'; } - -=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('rightnum') - || $self->ut_text('righttype') - || $self->ut_text('rightobjnum') - || $self->ut_text('rightname') - ; - return $error if $error; - - $self->SUPER::check; -} - -=back - -=head1 BUGS - -The author forgot to customize this manpage. - -=head1 SEE ALSO - -L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/access_user.pm b/FS/FS/access_user.pm deleted file mode 100644 index 874da66..0000000 --- a/FS/FS/access_user.pm +++ /dev/null @@ -1,376 +0,0 @@ -package FS::access_user; - -use strict; -use vars qw( @ISA $htpasswd_file ); -use FS::Record qw( qsearch qsearchs dbh ); -use FS::m2m_Common; -use FS::access_usergroup; -use FS::agent; - -@ISA = qw( FS::m2m_Common FS::Record ); - -#kludge htpasswd for now -$htpasswd_file = '/usr/local/etc/freeside/htpasswd'; - -=head1 NAME - -FS::access_user - Object methods for access_user records - -=head1 SYNOPSIS - - use FS::access_user; - - $record = new FS::access_user \%hash; - $record = new FS::access_user { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::access_user object represents an internal access user. FS::access_user inherits from -FS::Record. The following fields are currently supported: - -=over 4 - -=item usernum - primary key - -=item username - - -=item _password - - -=item last - - -=item first - - -=item disabled - empty or 'Y' - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new internal access user. To add the user to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'access_user'; } - -=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; - - my $error = - $self->SUPER::insert(@_) - || $self->htpasswd_kludge() - ; - - if ( $error ) { - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; - return $error; - } else { - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - } - -} - -sub htpasswd_kludge { - my $self = shift; - - #awful kludge to skip setting htpasswd for fs_* users - return '' if $self->username =~ /^fs_/; - - unshift @_, '-c' unless -e $htpasswd_file; - if ( - system('htpasswd', '-b', @_, - $htpasswd_file, - $self->username, - $self->_password, - ) == 0 - ) - { - return ''; - } else { - return 'htpasswd exited unsucessfully'; - } -} - - -=item delete - -Delete this record from the database. - -=cut - -sub delete { - my $self = shift; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $error = - $self->SUPER::delete(@_) - || $self->htpasswd_kludge('-D') - ; - - if ( $error ) { - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; - return $error; - } else { - $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($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, @_) - || $new->htpasswd_kludge() - ; - - if ( $error ) { - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; - return $error; - } else { - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - } - -} - -=item check - -Checks all fields to make sure this is a valid internal access user. 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('usernum') - || $self->ut_text('username') - || $self->ut_text('_password') - || $self->ut_text('last') - || $self->ut_text('first') - || $self->ut_enum('disabled', [ '', 'Y' ] ) - ; - return $error if $error; - - $self->SUPER::check; -} - -=item name - -Returns a name string for this user: "Last, First". - -=cut - -sub name { - my $self = shift; - $self->get('last'). ', '. $self->first; -} - -=item access_usergroup - -=cut - -sub access_usergroup { - my $self = shift; - qsearch( 'access_usergroup', { 'usernum' => $self->usernum } ); -} - -#=item access_groups -# -#=cut -# -#sub access_groups { -# -#} -# -#=item access_groupnames -# -#=cut -# -#sub access_groupnames { -# -#} - -=item agentnums - -Returns a list of agentnums this user can view (via group membership). - -=cut - -sub agentnums { - my $self = shift; - my $sth = dbh->prepare( - "SELECT DISTINCT agentnum FROM access_usergroup - JOIN access_groupagent USING ( groupnum ) - WHERE usernum = ?" - ) or die dbh->errstr; - $sth->execute($self->usernum) or die $sth->errstr; - map { $_->[0] } @{ $sth->fetchall_arrayref }; -} - -=item agentnums_href - -Returns a hashref of agentnums this user can view. - -=cut - -sub agentnums_href { - my $self = shift; - { map { $_ => 1 } $self->agentnums }; -} - -=item agentnums_sql - -Returns an sql fragement to select only agentnums this user can view. - -=cut - -sub agentnums_sql { - my $self = shift; - - my @agentnums = $self->agentnums; - return ' 1 = 0 ' unless scalar(@agentnums); - - '( '. - join( ' OR ', map "agentnum = $_", @agentnums ). - ' )'; -} - -=item agentnum - -Returns true if the user can view the specified agent. - -=cut - -sub agentnum { - my( $self, $agentnum ) = @_; - my $sth = dbh->prepare( - "SELECT COUNT(*) FROM access_usergroup - JOIN access_groupagent USING ( groupnum ) - WHERE usernum = ? AND agentnum = ?" - ) or die dbh->errstr; - $sth->execute($self->usernum, $agentnum) or die $sth->errstr; - $sth->fetchrow_arrayref->[0]; -} - -=item agents - -Returns the list of agents this user can view (via group membership), as -FS::agent objects. - -=cut - -sub agents { - my $self = shift; - qsearch({ - 'table' => 'agent', - 'hashref' => { disabled=>'' }, - 'extra_sql' => ' AND '. $self->agentnums_sql, - }); -} - -=item access_right - -Given a right name, returns true if this user has this right (currently via -group membership, eventually also via user overrides). - -=cut - -sub access_right { - my( $self, $rightname ) = @_; - my $sth = dbh->prepare(" - SELECT groupnum FROM access_usergroup - LEFT JOIN access_group USING ( groupnum ) - LEFT JOIN access_right - ON ( access_group.groupnum = access_right.rightobjnum ) - WHERE usernum = ? - AND righttype = 'FS::access_group' - AND rightname = ? - ") or die dbh->errstr; - $sth->execute($self->usernum, $rightname) or die $sth->errstr; - my $row = $sth->fetchrow_arrayref; - $row ? $row->[0] : ''; -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/access_user_pref.pm b/FS/FS/access_user_pref.pm deleted file mode 100644 index ff957f2..0000000 --- a/FS/FS/access_user_pref.pm +++ /dev/null @@ -1,127 +0,0 @@ -package FS::access_user_pref; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::access_user_pref - Object methods for access_user_pref records - -=head1 SYNOPSIS - - use FS::access_user_pref; - - $record = new FS::access_user_pref \%hash; - $record = new FS::access_user_pref { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::access_user_pref object represents an example. FS::access_user_pref inherits from -FS::Record. The following fields are currently supported: - -=over 4 - -=item prefnum - primary key - -=item usernum - - -=item prefname - - -=item prefvalue - - - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new example. To add the example to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'access_user_pref'; } - -=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('prefnum') - || $self->ut_number('usernum') - || $self->ut_text('prefname') - || $self->ut_textn('prefvalue') - ; - return $error if $error; - - $self->SUPER::check; -} - -=back - -=head1 BUGS - -The author forgot to customize this manpage. - -=head1 SEE ALSO - -L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/access_usergroup.pm b/FS/FS/access_usergroup.pm deleted file mode 100644 index 4d8836c..0000000 --- a/FS/FS/access_usergroup.pm +++ /dev/null @@ -1,144 +0,0 @@ -package FS::access_usergroup; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); -use FS::access_user; -use FS::access_group; - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::access_usergroup - Object methods for access_usergroup records - -=head1 SYNOPSIS - - use FS::access_usergroup; - - $record = new FS::access_usergroup \%hash; - $record = new FS::access_usergroup { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::access_usergroup object represents an example. FS::access_usergroup inherits from -FS::Record. The following fields are currently supported: - -=over 4 - -=item usergroupnum - primary key - -=item usernum - - -=item groupnum - - - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new example. To add the example to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'access_usergroup'; } - -=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('usergroupnum') - || $self->ut_number('usernum') - || $self->ut_number('groupnum') - ; - return $error if $error; - - $self->SUPER::check; -} - -=item access_user - -=cut - -sub access_user { - my $self = shift; - qsearchs( 'access_user', { 'usernum' => $self->usernum } ); -} - -=item access_group - -=cut - -sub access_group { - my $self = shift; - qsearchs( 'access_group', { 'groupnum' => $self->groupnum } ); -} - -=back - -=head1 BUGS - -The author forgot to customize this manpage. - -=head1 SEE ALSO - -L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/acct_snarf.pm b/FS/FS/acct_snarf.pm deleted file mode 100644 index b4e88bf..0000000 --- a/FS/FS/acct_snarf.pm +++ /dev/null @@ -1,128 +0,0 @@ -package FS::acct_snarf; - -use strict; -use vars qw( @ISA ); -use FS::Record; - -@ISA = qw( FS::Record ); - -=head1 NAME - -FS::acct_snarf - Object methods for acct_snarf records - -=head1 SYNOPSIS - - use FS::acct_snarf; - - $record = new FS::acct_snarf \%hash; - $record = new FS::acct_snarf { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::svc_acct object represents an external mail account, typically for -download of mail. FS::acct_snarf inherits from FS::Record. The following -fields are currently supported: - -=over 4 - -=item snarfnum - primary key - -=item svcnum - Account (see L<FS::svc_acct>) - -=item machine - external machine to download mail from - -=item protocol - protocol (pop3, imap, etc.) - -=item username - external login username - -=item _password - external login password - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new record. To add the record to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -sub table { 'acct_snarf'; } - -=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 external mail account. 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('snarfnum') - || $self->ut_number('svcnum') - || $self->ut_foreign_key('svcnum', 'svc_acct', 'svcnum') - || $self->ut_domain('machine') - || $self->ut_alphan('protocol') - || $self->ut_textn('username') - ; - return $error if $error; - - $self->_password =~ /^[^\t\n]*$/ or return "illegal password"; - $self->_password($1); - - ''; #no error -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/addr_block.pm b/FS/FS/addr_block.pm deleted file mode 100755 index 1fb6060..0000000 --- a/FS/FS/addr_block.pm +++ /dev/null @@ -1,331 +0,0 @@ -package FS::addr_block; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearchs qsearch dbh ); -use FS::router; -use FS::svc_broadband; -use FS::Conf; -use NetAddr::IP; - -@ISA = qw( FS::Record ); - -=head1 NAME - -FS::addr_block - Object methods for addr_block records - -=head1 SYNOPSIS - - use FS::addr_block; - - $record = new FS::addr_block \%hash; - $record = new FS::addr_block { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::addr_block record describes an address block assigned for broadband -access. FS::addr_block inherits from FS::Record. The following fields are -currently supported: - -=over 4 - -=item blocknum - primary key, used in FS::svc_broadband to associate -services to the block. - -=item routernum - the router (see FS::router) to which this -block is assigned. - -=item ip_gateway - the gateway address used by customers within this block. - -=item ip_netmask - the netmask of the block, expressed as an integer. - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Create a new record. To add the record to the database, see "insert". - -=cut - -sub table { 'addr_block'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=item delete - -Deletes this record from the database. If there is an error, returns the -error, otherwise returns false. - -sub delete { - my $self = shift; - return 'Block must be deallocated before deletion' - if $self->router; - - $self->SUPER::delete; -} - -=item replace OLD_RECORD - -Replaces OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=item check - -Checks all fields to make sure this is a valid record. If there is an error, -returns the error, otherwise returns false. Called by the insert and replace -methods. - -=cut - -sub check { - my $self = shift; - - my $error = - $self->ut_number('routernum') - || $self->ut_ip('ip_gateway') - || $self->ut_number('ip_netmask') - ; - return $error if $error; - - - # A routernum of 0 indicates an unassigned block and is allowed - return "Unknown routernum" - if ($self->routernum and not $self->router); - - my $self_addr = $self->NetAddr; - return "Cannot parse address: ". $self->ip_gateway . '/' . $self->ip_netmask - unless $self_addr; - - if (not $self->blocknum) { - my @block = grep { - my $block_addr = $_->NetAddr; - if($block_addr->contains($self_addr) - or $self_addr->contains($block_addr)) { $_; }; - } qsearch( 'addr_block', {}); - foreach(@block) { - return "Block intersects existing block ".$_->ip_gateway."/".$_->ip_netmask; - } - } - - $self->SUPER::check; -} - - -=item router - -Returns the FS::router object corresponding to this object. If the -block is unassigned, returns undef. - -=cut - -sub router { - my $self = shift; - return qsearchs('router', { routernum => $self->routernum }); -} - -=item svc_broadband - -Returns a list of FS::svc_broadband objects associated -with this object. - -=cut - -sub svc_broadband { - my $self = shift; - return qsearch('svc_broadband', { blocknum => $self->blocknum }); -} - -=item NetAddr - -Returns a NetAddr::IP object for this block's address and netmask. - -=cut - -sub NetAddr { - my $self = shift; - - return new NetAddr::IP ($self->ip_gateway, $self->ip_netmask); -} - -=item next_free_addr - -Returns a NetAddr::IP object corresponding to the first unassigned address -in the block (other than the network, broadcast, or gateway address). If -there are no free addresses, returns false. - -=cut - -sub next_free_addr { - my $self = shift; - - my $conf = new FS::Conf; - my @excludeaddr = $conf->config('exclude_ip_addr'); - -my @used = -( (map { $_->NetAddr->addr } - ($self, - qsearch('svc_broadband', { blocknum => $self->blocknum })) - ), @excludeaddr -); - - my @free = $self->NetAddr->hostenum; - while (my $ip = shift @free) { - if (not grep {$_ eq $ip->addr;} @used) { return $ip; }; - } - - ''; - -} - -=item allocate - -Allocates this address block to a router. Takes an FS::router object -as an argument. - -At present it's not possible to reallocate a block to a different router -except by deallocating it first, which requires that none of its addresses -be assigned. This is probably as it should be. - -=cut - -sub allocate { - my ($self, $router) = @_; - - return 'Block is already allocated' - if($self->router); - - return 'Block must be allocated to a router' - unless(ref $router eq 'FS::router'); - - my @svc = $self->svc_broadband; - if (@svc) { - return 'Block has assigned addresses: '. join ', ', map {$_->ip_addr} @svc; - } - - my $new = new FS::addr_block {$self->hash}; - $new->routernum($router->routernum); - return $new->replace($self); - -} - -=item deallocate - -Deallocates the block (i.e. sets the routernum to 0). If any addresses in the -block are assigned to services, it fails. - -=cut - -sub deallocate { - my $self = shift; - - my @svc = $self->svc_broadband; - if (@svc) { - return 'Block has assigned addresses: '. join ', ', map {$_->ip_addr} @svc; - } - - my $new = new FS::addr_block {$self->hash}; - $new->routernum(0); - return $new->replace($self); -} - -=item split_block - -Splits this address block into two equal blocks, occupying the same space as -the original block. The first of the two will also have the same blocknum. -The gateway address of each block will be set to the first usable address, i.e. -(network address)+1. Since this method is designed for use on unallocated -blocks, this is probably the correct behavior. - -(At present, splitting allocated blocks is disallowed. Anyone who wants to -implement this is reminded that each split costs three addresses, and any -customers who were using these addresses will have to be moved; depending on -how full the block was before being split, they might have to be moved to a -different block. Anyone who I<still> wants to implement it is asked to tie it -to a configuration switch so that site admins can disallow it.) - -=cut - -sub split_block { - - # We should consider using Attribute::Handlers/Aspect/Hook::LexWrap/ - # something to atomicize functions, so that we can say - # - # sub split_block : atomic { - # - # instead of repeating all this AutoCommit verbage in every - # sub that does more than one database operation. - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $self = shift; - my $error; - - if ($self->router) { - return 'Block is already allocated'; - } - - #TODO: Smallest allowed block should be a config option. - if ($self->NetAddr->masklen() ge 30) { - return 'Cannot split blocks with a mask length >= 30'; - } - - my (@new, @ip); - $ip[0] = $self->NetAddr; - @ip = map {$_->first()} $ip[0]->split($self->ip_netmask + 1); - - foreach (0,1) { - $new[$_] = new FS::addr_block {$self->hash}; - $new[$_]->ip_gateway($ip[$_]->addr); - $new[$_]->ip_netmask($ip[$_]->masklen); - } - - $new[1]->blocknum(''); - - $error = $new[0]->replace($self); - if ($error) { - $dbh->rollback; - return $error; - } - - $error = $new[1]->insert; - if ($error) { - $dbh->rollback; - return $error; - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - return ''; -} - -=item merge - -To be implemented. - -=back - -=head1 BUGS - -Minimum block size should be a config option. It's hardcoded at /30 right -now because that's the smallest block that makes any sense at all. - -=cut - -1; - diff --git a/FS/FS/agent.pm b/FS/FS/agent.pm deleted file mode 100644 index e40ef09..0000000 --- a/FS/FS/agent.pm +++ /dev/null @@ -1,444 +0,0 @@ -package FS::agent; - -use strict; -use vars qw( @ISA ); -#use Crypt::YAPassGen; -use FS::Record qw( dbh qsearch qsearchs ); -use FS::cust_main; -use FS::cust_pkg; -use FS::agent_type; -use FS::reg_code; -use FS::TicketSystem; - -@ISA = qw( FS::Record ); - -=head1 NAME - -FS::agent - Object methods for agent records - -=head1 SYNOPSIS - - use FS::agent; - - $record = new FS::agent \%hash; - $record = new FS::agent { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - - $agent_type = $record->agent_type; - - $hashref = $record->pkgpart_hashref; - #may purchase $pkgpart if $hashref->{$pkgpart}; - -=head1 DESCRIPTION - -An FS::agent object represents an agent. Every customer has an agent. Agents -can be used to track things like resellers or salespeople. FS::agent inherits -from FS::Record. The following fields are currently supported: - -=over 4 - -=item agentnum - primary key (assigned automatically for new agents) - -=item agent - Text name of this agent - -=item typenum - Agent type. See L<FS::agent_type> - -=item prog - For future use. - -=item freq - For future use. - -=item disabled - Disabled flag, empty or 'Y' - -=item username - Username for the Agent interface - -=item _password - Password for the Agent interface - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new agent. To add the agent to the database, see L<"insert">. - -=cut - -sub table { 'agent'; } - -=item insert - -Adds this agent to the database. If there is an error, returns the error, -otherwise returns false. - -=item delete - -Deletes this agent from the database. Only agents with no customers can be -deleted. If there is an error, returns the error, otherwise returns false. - -=cut - -sub delete { - my $self = shift; - - return "Can't delete an agent with customers!" - if qsearch( 'cust_main', { 'agentnum' => $self->agentnum } ); - - $self->SUPER::delete; -} - -=item replace OLD_RECORD - -Replaces OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=item check - -Checks all fields to make sure this is a valid agent. If there is an error, -returns the error, otherwise returns false. Called by the insert and replace -methods. - -=cut - -sub check { - my $self = shift; - - my $error = - $self->ut_numbern('agentnum') - || $self->ut_text('agent') - || $self->ut_number('typenum') - || $self->ut_numbern('freq') - || $self->ut_textn('prog') - ; - return $error if $error; - - if ( $self->dbdef_table->column('disabled') ) { - $error = $self->ut_enum('disabled', [ '', 'Y' ] ); - return $error if $error; - } - - if ( $self->dbdef_table->column('username') ) { - $error = $self->ut_alphan('username'); - return $error if $error; - if ( length($self->username) ) { - my $conflict = qsearchs('agent', { 'username' => $self->username } ); - return 'duplicate agent username (with '. $conflict->agent. ')' - if $conflict && $conflict->agentnum != $self->agentnum; - $error = $self->ut_text('password'); # ut_text... arbitrary choice - } else { - $self->_password(''); - } - } - - return "Unknown typenum!" - unless $self->agent_type; - - $self->SUPER::check; -} - -=item agent_type - -Returns the FS::agent_type object (see L<FS::agent_type>) for this agent. - -=cut - -sub agent_type { - my $self = shift; - qsearchs( 'agent_type', { 'typenum' => $self->typenum } ); -} - -=item pkgpart_hashref - -Returns a hash reference. The keys of the hash are pkgparts. The value is -true if this agent may purchase the specified package definition. See -L<FS::part_pkg>. - -=cut - -sub pkgpart_hashref { - my $self = shift; - $self->agent_type->pkgpart_hashref; -} - -=item ticketing_queue - -Returns the queue name corresponding with the id from the I<ticketing_queueid> -field, or the empty string. - -=cut - -sub ticketing_queue { - my $self = shift; - FS::TicketSystem->queue($self->ticketing_queueid); -}; - -=item num_prospect_cust_main - -Returns the number of prospects (customers with no packages ever ordered) for -this agent. - -=cut - -sub num_prospect_cust_main { - shift->num_sql(FS::cust_main->prospect_sql); -} - -sub num_sql { - my( $self, $sql ) = @_; - my $statement = "SELECT COUNT(*) FROM cust_main WHERE agentnum = ? AND $sql"; - my $sth = dbh->prepare($statement) or die dbh->errstr." preparing $statement"; - $sth->execute($self->agentnum) or die $sth->errstr. " executing $statement"; - $sth->fetchrow_arrayref->[0]; -} - -=item prospect_cust_main - -Returns the prospects (customers with no packages ever ordered) for this agent, -as cust_main objects. - -=cut - -sub prospect_cust_main { - shift->cust_main_sql(FS::cust_main->prospect_sql); -} - -sub cust_main_sql { - my( $self, $sql ) = @_; - qsearch( 'cust_main', - { 'agentnum' => $self->agentnum }, - '', - " AND $sql" - ); -} - -=item num_active_cust_main - -Returns the number of active customers for this agent (customers with active -recurring packages). - -=cut - -sub num_active_cust_main { - shift->num_sql(FS::cust_main->active_sql); -} - -=item active_cust_main - -Returns the active customers for this agent, as cust_main objects. - -=cut - -sub active_cust_main { - shift->cust_main_sql(FS::cust_main->active_sql); -} - -=item num_inactive_cust_main - -Returns the number of inactive customers for this agent (customers with no -active recurring packages, but otherwise unsuspended/uncancelled). - -=cut - -sub num_inactive_cust_main { - shift->num_sql(FS::cust_main->inactive_sql); -} - -=item inactive_cust_main - -Returns the inactive customers for this agent, as cust_main objects. - -=cut - -sub inactive_cust_main { - shift->cust_main_sql(FS::cust_main->inactive_sql); -} - - -=item num_susp_cust_main - -Returns the number of suspended customers for this agent. - -=cut - -sub num_susp_cust_main { - shift->num_sql(FS::cust_main->susp_sql); -} - -=item susp_cust_main - -Returns the suspended customers for this agent, as cust_main objects. - -=cut - -sub susp_cust_main { - shift->cust_main_sql(FS::cust_main->susp_sql); -} - -=item num_cancel_cust_main - -Returns the number of cancelled customer for this agent. - -=cut - -sub num_cancel_cust_main { - shift->num_sql(FS::cust_main->cancel_sql); -} - -=item cancel_cust_main - -Returns the cancelled customers for this agent, as cust_main objects. - -=cut - -sub cancel_cust_main { - shift->cust_main_sql(FS::cust_main->cancel_sql); -} - -=item num_active_cust_pkg - -Returns the number of active customer packages for this agent. - -=cut - -sub num_active_cust_pkg { - shift->num_pkg_sql(FS::cust_pkg->active_sql); -} - -sub num_pkg_sql { - my( $self, $sql ) = @_; - my $statement = - "SELECT COUNT(*) FROM cust_pkg LEFT JOIN cust_main USING ( custnum )". - " WHERE agentnum = ? AND $sql"; - my $sth = dbh->prepare($statement) or die dbh->errstr." preparing $statement"; - $sth->execute($self->agentnum) or die $sth->errstr. "executing $statement"; - $sth->fetchrow_arrayref->[0]; -} - -=item num_inactive_cust_pkg - -Returns the number of inactive customer packages (one-time packages otherwise -unsuspended/uncancelled) for this agent. - -=cut - -sub num_inactive_cust_pkg { - shift->num_pkg_sql(FS::cust_pkg->inactive_sql); -} - -=item num_susp_cust_pkg - -Returns the number of suspended customer packages for this agent. - -=cut - -sub num_susp_cust_pkg { - shift->num_pkg_sql(FS::cust_pkg->susp_sql); -} - -=item num_cancel_cust_pkg - -Returns the number of cancelled customer packages for this agent. - -=cut - -sub num_cancel_cust_pkg { - shift->num_pkg_sql(FS::cust_pkg->cancel_sql); -} - -=item generate_reg_codes NUM PKGPART_ARRAYREF - -Generates the specified number of registration codes, allowing purchase of the -specified package definitions. Returns an array reference of the newly -generated codes, or a scalar error message. - -=cut - -#false laziness w/prepay_credit::generate -sub generate_reg_codes { - my( $self, $num, $pkgparts ) = @_; - - my @codeset = ( 'A'..'Z' ); - - 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 @codes = (); - for ( 1 ... $num ) { - my $reg_code = new FS::reg_code { - 'agentnum' => $self->agentnum, - 'code' => join('', map($codeset[int(rand $#codeset)], (0..7) ) ), - }; - my $error = $reg_code->insert($pkgparts); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - push @codes, $reg_code->code; - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - \@codes; - -} - -=item num_reg_code - -Returns the number of unused registration codes for this agent. - -=cut - -sub num_reg_code { - my $self = shift; - my $sth = dbh->prepare( - "SELECT COUNT(*) FROM reg_code WHERE agentnum = ?" - ) or die dbh->errstr; - $sth->execute($self->agentnum) or die $sth->errstr; - $sth->fetchrow_arrayref->[0]; -} - -=item num_prepay_credit - -Returns the number of unused prepaid cards for this agent. - -=cut - -sub num_prepay_credit { - my $self = shift; - my $sth = dbh->prepare( - "SELECT COUNT(*) FROM prepay_credit WHERE agentnum = ?" - ) or die dbh->errstr; - $sth->execute($self->agentnum) or die $sth->errstr; - $sth->fetchrow_arrayref->[0]; -} - - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::Record>, L<FS::agent_type>, L<FS::cust_main>, L<FS::part_pkg>, -schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/agent_payment_gateway.pm b/FS/FS/agent_payment_gateway.pm deleted file mode 100644 index bd99d0c..0000000 --- a/FS/FS/agent_payment_gateway.pm +++ /dev/null @@ -1,139 +0,0 @@ -package FS::agent_payment_gateway; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); -use FS::payment_gateway; - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::agent_payment_gateway - Object methods for agent_payment_gateway records - -=head1 SYNOPSIS - - use FS::agent_payment_gateway; - - $record = new FS::agent_payment_gateway \%hash; - $record = new FS::agent_payment_gateway { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::agent_payment_gateway object represents a payment gateway override for -a specific agent. FS::agent_payment_gateway inherits from FS::Record. The -following fields are currently supported: - -=over 4 - -=item agentgatewaynum - primary key - -=item agentnum - - -=item gatewaynum - - -=item cardtype - - -=item taxclass - - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new override. To add the override to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'agent_payment_gateway'; } - -=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 override. 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('agentgatewaynum') - || $self->ut_foreign_key('agentnum', 'agent', 'agentnum') - || $self->ut_foreign_key('gatewaynum', 'payment_gateway', 'gatewaynum' ) - || $self->ut_textn('cardtype') - || $self->ut_textn('taxclass') - ; - return $error if $error; - - $self->SUPER::check; -} - -=item payment_gateway - -=cut - -sub payment_gateway { - my $self = shift; - qsearchs('payment_gateway', { 'gatewaynum' => $self->gatewaynum } ); -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::payment_gateway>, L<FS::agent>, L<FS::Record>, schema.html from the -base documentation. - -=cut - -1; - diff --git a/FS/FS/agent_type.pm b/FS/FS/agent_type.pm deleted file mode 100644 index 2660bb4..0000000 --- a/FS/FS/agent_type.pm +++ /dev/null @@ -1,191 +0,0 @@ -package FS::agent_type; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch ); -use FS::m2m_Common; -use FS::agent; -use FS::type_pkgs; - -@ISA = qw( FS::m2m_Common FS::Record ); - -=head1 NAME - -FS::agent_type - Object methods for agent_type records - -=head1 SYNOPSIS - - use FS::agent_type; - - $record = new FS::agent_type \%hash; - $record = new FS::agent_type { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - - $hashref = $record->pkgpart_hashref; - #may purchase $pkgpart if $hashref->{$pkgpart}; - - @type_pkgs = $record->type_pkgs; - - @pkgparts = $record->pkgpart; - -=head1 DESCRIPTION - -An FS::agent_type object represents an agent type. Every agent (see -L<FS::agent>) has an agent type. Agent types define which packages (see -L<FS::part_pkg>) may be purchased by customers (see L<FS::cust_main>), via -FS::type_pkgs records (see L<FS::type_pkgs>). FS::agent_type inherits from -FS::Record. The following fields are currently supported: - -=over 4 - -=item typenum - primary key (assigned automatically for new agent types) - -=item atype - Text name of this agent type - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new agent type. To add the agent type to the database, see -L<"insert">. - -=cut - -sub table { 'agent_type'; } - -=item insert - -Adds this agent type to the database. If there is an error, returns the error, -otherwise returns false. - -=item delete - -Deletes this agent type from the database. Only agent types with no agents -can be deleted. If there is an error, returns the error, otherwise returns -false. - -=cut - -sub delete { - my $self = shift; - - return "Can't delete an agent_type with agents!" - if qsearch( 'agent', { 'typenum' => $self->typenum } ); - - $self->SUPER::delete; -} - -=item replace OLD_RECORD - -Replaces OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=item check - -Checks all fields to make sure this is a valid agent type. If there is an -error, returns the error, otherwise returns false. Called by the insert and -replace methods. - -=cut - -sub check { - my $self = shift; - - $self->ut_numbern('typenum') - or $self->ut_text('atype') - or $self->SUPER::check; - -} - -=item pkgpart_hashref - -Returns a hash reference. The keys of the hash are pkgparts. The value is -true iff this agent may purchase the specified package definition. See -L<FS::part_pkg>. - -=cut - -sub pkgpart_hashref { - my $self = shift; - my %pkgpart; - #$pkgpart{$_}++ foreach $self->pkgpart; - # not compatible w/5.004_04 (fixed in 5.004_05) - foreach ( $self->pkgpart ) { $pkgpart{$_}++; } - \%pkgpart; -} - -=item type_pkgs - -Returns all FS::type_pkgs objects (see L<FS::type_pkgs>) for this agent type. - -=cut - -sub type_pkgs { - my $self = shift; - qsearch('type_pkgs', { 'typenum' => $self->typenum } ); -} - -=item type_pkgs_enabled - -Returns all FS::type_pkg objects (see L<FS::type_pkgs>) that link to enabled -package definitions (see L<FS::part_pkg>). - -An additional strange feature is that the returned type_pkg objects also have -all fields of the associated part_pkg object. - -=cut - -sub type_pkgs_enabled { - my $self = shift; - qsearch({ - 'table' => 'type_pkgs', - 'addl_from' => 'JOIN part_pkg USING ( pkgpart )', - 'hashref' => { 'typenum' => $self->typenum }, - 'extra_sql' => " AND ( disabled = '' OR disabled IS NULL )". - " ORDER BY pkg", - }); -} - -=item pkgpart - -Returns the pkgpart of all package definitions (see L<FS::part_pkg>) for this -agent type. - -=cut - -sub pkgpart { - my $self = shift; - map $_->pkgpart, $self->type_pkgs; -} - -=back - -=head1 BUGS - -type_pkgs_enabled should order itself by something (pkg?) - -type_pkgs_enabled should populate something that caches for the part_pkg method -rather than add fields to this object, right? In fact we need a "poop" object -framework that does that automatically for any joined search at some point.... -right? - -=head1 SEE ALSO - -L<FS::Record>, L<FS::agent>, L<FS::type_pkgs>, L<FS::cust_main>, -L<FS::part_pkg>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/banned_pay.pm b/FS/FS/banned_pay.pm deleted file mode 100644 index 1ad87f5..0000000 --- a/FS/FS/banned_pay.pm +++ /dev/null @@ -1,136 +0,0 @@ -package FS::banned_pay; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); -use FS::UID qw( getotaker ); - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::banned_pay - Object methods for banned_pay records - -=head1 SYNOPSIS - - use FS::banned_pay; - - $record = new FS::banned_pay \%hash; - $record = new FS::banned_pay { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::banned_pay object represents an banned credit card or ACH account. -FS::banned_pay inherits from FS::Record. The following fields are currently -supported: - -=over 4 - -=item bannum - primary key - -=item payby - I<CARD> or I<CHEK> - -=item payinfo - fingerprint of banned card (base64-encoded MD5 digest) - -=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see -L<Time::Local> and L<Date::Parse> for conversion functions. - -=item otaker - order taker (assigned automatically, see L<FS::UID>) - -=item reason - reason (text) - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new ban. To add the ban to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'banned_pay'; } - -=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 ban. 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('bannum') - || $self->ut_enum('payby', [ 'CARD', 'CHEK' ] ) - || $self->ut_text('payinfo') - || $self->ut_numbern('_date') - || $self->ut_textn('reason') - ; - return $error if $error; - - $self->_date(time) unless $self->_date; - - $self->otaker(getotaker); - - $self->SUPER::check; -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/cancel_reason.pm b/FS/FS/cancel_reason.pm deleted file mode 100644 index 19cc721..0000000 --- a/FS/FS/cancel_reason.pm +++ /dev/null @@ -1,123 +0,0 @@ -package FS::cancel_reason; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::cancel_reason - Object methods for cancel_reason records - -=head1 SYNOPSIS - - use FS::cancel_reason; - - $record = new FS::cancel_reason \%hash; - $record = new FS::cancel_reason { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::cancel_reason object represents an cancellation reason. -FS::cancel_reason inherits from FS::Record. The following fields are -currently supported: - -=over 4 - -=item reasonnum - primary key - -=item reason - - -=item disabled - empty or "Y" - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new cancellation reason. To add the reason to the database, see -L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'cancel_reason'; } - -=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 reason. 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('reasonnum') - || $self->ut_text('reason') - || $self->ut_enum('disabled', [ '', 'Y' ] ) - ; - return $error if $error; - - $self->SUPER::check; -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/cdr.pm b/FS/FS/cdr.pm deleted file mode 100644 index 2f47170..0000000 --- a/FS/FS/cdr.pm +++ /dev/null @@ -1,642 +0,0 @@ -package FS::cdr; - -use strict; -use vars qw( @ISA ); -use Date::Parse; -use Date::Format; -use Time::Local; -use FS::UID qw( dbh ); -use FS::Record qw( qsearch qsearchs ); -use FS::cdr_type; -use FS::cdr_calltype; -use FS::cdr_carrier; -use FS::cdr_upstream_rate; - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::cdr - Object methods for cdr records - -=head1 SYNOPSIS - - use FS::cdr; - - $record = new FS::cdr \%hash; - $record = new FS::cdr { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::cdr object represents an Call Data Record, typically from a telephony -system or provider of some sort. FS::cdr inherits from FS::Record. The -following fields are currently supported: - -=over 4 - -=item acctid - primary key - -=item calldate - Call timestamp (SQL timestamp) - -=item clid - Caller*ID with text - -=item src - Caller*ID number / Source number - -=item dst - Destination extension - -=item dcontext - Destination context - -=item channel - Channel used - -=item dstchannel - Destination channel if appropriate - -=item lastapp - Last application if appropriate - -=item lastdata - Last application data - -=item startdate - Start of call (UNIX-style integer timestamp) - -=item answerdate - Answer time of call (UNIX-style integer timestamp) - -=item enddate - End time of call (UNIX-style integer timestamp) - -=item duration - Total time in system, in seconds - -=item billsec - Total time call is up, in seconds - -=item disposition - What happened to the call: ANSWERED, NO ANSWER, BUSY - -=item amaflags - What flags to use: BILL, IGNORE etc, specified on a per channel basis like accountcode. - -=cut - - #ignore the "omit" and "documentation" AMAs?? - #AMA = Automated Message Accounting. - #default: Sets the system default. - #omit: Do not record calls. - #billing: Mark the entry for billing - #documentation: Mark the entry for documentation. - -=back - -=item accountcode - CDR account number to use: account - -=item uniqueid - Unique channel identifier (Unitel/RSLCOM Event ID) - -=item userfield - CDR user-defined field - -=item cdr_type - CDR type - see L<FS::cdr_type> (Usage = 1, S&E = 7, OC&C = 8) - -=item charged_party - Service number to be billed - -=item upstream_currency - Wholesale currency from upstream - -=item upstream_price - Wholesale price from upstream - -=item upstream_rateplanid - Upstream rate plan ID - -=item rated_price - Rated (or re-rated) price - -=item distance - km (need units field?) - -=item islocal - Local - 1, Non Local = 0 - -=item calltypenum - Type of call - see L<FS::cdr_calltype> - -=item description - Description (cdr_type 7&8 only) (used for cust_bill_pkg.itemdesc) - -=item quantity - Number of items (cdr_type 7&8 only) - -=item carrierid - Upstream Carrier ID (see L<FS::cdr_carrier>) - -=cut - -#Telstra =1, Optus = 2, RSL COM = 3 - -=item upstream_rateid - Upstream Rate ID - -=item svcnum - Link to customer service (see L<FS::cust_svc>) - -=item freesidestatus - NULL, done (or something) - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new CDR. To add the CDR to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'cdr'; } - -=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 CDR. If there is -an error, returns the error, otherwise returns false. Called by the insert -and replace methods. - -Note: Unlike most types of records, we don't want to "reject" a CDR and we want -to process them as quickly as possible, so we allow the database to check most -of the data. - -=cut - -sub check { - my $self = shift; - -# we don't want to "reject" a CDR like other sorts of input... -# my $error = -# $self->ut_numbern('acctid') -## || $self->ut_('calldate') -# || $self->ut_text('clid') -# || $self->ut_text('src') -# || $self->ut_text('dst') -# || $self->ut_text('dcontext') -# || $self->ut_text('channel') -# || $self->ut_text('dstchannel') -# || $self->ut_text('lastapp') -# || $self->ut_text('lastdata') -# || $self->ut_numbern('startdate') -# || $self->ut_numbern('answerdate') -# || $self->ut_numbern('enddate') -# || $self->ut_number('duration') -# || $self->ut_number('billsec') -# || $self->ut_text('disposition') -# || $self->ut_number('amaflags') -# || $self->ut_text('accountcode') -# || $self->ut_text('uniqueid') -# || $self->ut_text('userfield') -# || $self->ut_numbern('cdrtypenum') -# || $self->ut_textn('charged_party') -## || $self->ut_n('upstream_currency') -## || $self->ut_n('upstream_price') -# || $self->ut_numbern('upstream_rateplanid') -## || $self->ut_n('distance') -# || $self->ut_numbern('islocal') -# || $self->ut_numbern('calltypenum') -# || $self->ut_textn('description') -# || $self->ut_numbern('quantity') -# || $self->ut_numbern('carrierid') -# || $self->ut_numbern('upstream_rateid') -# || $self->ut_numbern('svcnum') -# || $self->ut_textn('freesidestatus') -# ; -# return $error if $error; - - $self->calldate( $self->startdate_sql ) - if !$self->calldate && $self->startdate; - - unless ( $self->charged_party ) { - if ( $self->dst =~ /^(\+?1)?8[02-8]{2}/ ) { - $self->charged_party($self->dst); - } else { - $self->charged_party($self->src); - } - } - - #check the foreign keys even? - #do we want to outright *reject* the CDR? - my $error = - $self->ut_numbern('acctid') - - #Usage = 1, S&E = 7, OC&C = 8 - || $self->ut_foreign_keyn('cdrtypenum', 'cdr_type', 'cdrtypenum' ) - - #the big list in appendix 2 - || $self->ut_foreign_keyn('calltypenum', 'cdr_calltype', 'calltypenum' ) - - # Telstra =1, Optus = 2, RSL COM = 3 - || $self->ut_foreign_keyn('carrierid', 'cdr_carrier', 'carrierid' ) - ; - return $error if $error; - - $self->SUPER::check; -} - -=item set_status_and_rated_price STATUS [ RATED_PRICE ] - -Sets the status to the provided string. If there is an error, returns the -error, otherwise returns false. - -=cut - -sub set_status_and_rated_price { - my($self, $status, $rated_price) = @_; - $self->freesidestatus($status); - $self->rated_price($rated_price); - $self->replace(); -} - -=item calldate_unix - -Parses the calldate in SQL string format and returns a UNIX timestamp. - -=cut - -sub calldate_unix { - str2time(shift->calldate); -} - -=item startdate_sql - -Parses the startdate in UNIX timestamp format and returns a string in SQL -format. - -=cut - -sub startdate_sql { - my($sec,$min,$hour,$mday,$mon,$year) = localtime(shift->startdate); - $mon++; - $year += 1900; - "$year-$mon-$mday $hour:$min:$sec"; -} - -=item cdr_carrier - -Returns the FS::cdr_carrier object associated with this CDR, or false if no -carrierid is defined. - -=cut - -my %carrier_cache = (); - -sub cdr_carrier { - my $self = shift; - return '' unless $self->carrierid; - $carrier_cache{$self->carrierid} ||= - qsearchs('cdr_carrier', { 'carrierid' => $self->carrierid } ); -} - -=item carriername - -Returns the carrier name (see L<FS::cdr_carrier>), or the empty string if -no FS::cdr_carrier object is assocated with this CDR. - -=cut - -sub carriername { - my $self = shift; - my $cdr_carrier = $self->cdr_carrier; - $cdr_carrier ? $cdr_carrier->carriername : ''; -} - -=item cdr_calltype - -Returns the FS::cdr_calltype object associated with this CDR, or false if no -calltypenum is defined. - -=cut - -my %calltype_cache = (); - -sub cdr_calltype { - my $self = shift; - return '' unless $self->calltypenum; - $calltype_cache{$self->calltypenum} ||= - qsearchs('cdr_calltype', { 'calltypenum' => $self->calltypenum } ); -} - -=item calltypename - -Returns the call type name (see L<FS::cdr_calltype>), or the empty string if -no FS::cdr_calltype object is assocated with this CDR. - -=cut - -sub calltypename { - my $self = shift; - my $cdr_calltype = $self->cdr_calltype; - $cdr_calltype ? $cdr_calltype->calltypename : ''; -} - -=item cdr_upstream_rate - -Returns the upstream rate mapping (see L<FS::cdr_upstream_rate>), or the empty -string if no FS::cdr_upstream_rate object is associated with this CDR. - -=cut - -sub cdr_upstream_rate { - my $self = shift; - return '' unless $self->upstream_rateid; - qsearchs('cdr_upstream_rate', { 'upstream_rateid' => $self->upstream_rateid }) - or ''; -} - -=item _convergent_format COLUMN [ COUNTRYCODE ] - -Returns the number in COLUMN formatted as follows: - -If the country code does not match COUNTRYCODE (default "61"), it is returned -unchanged. - -If the country code does match COUNTRYCODE (default "61"), it is removed. In -addiiton, "0" is prepended unless the number starts with 13, 18 or 19. (???) - -=cut - -sub _convergent_format { - my( $self, $field ) = ( shift, shift ); - my $countrycode = scalar(@_) ? shift : '61'; #+61 = australia - #my $number = $self->$field(); - my $number = $self->get($field); - #if ( $number =~ s/^(\+|011)$countrycode// ) { - if ( $number =~ s/^\+$countrycode// ) { - $number = "0$number" - unless $number =~ /^1[389]/; #??? - } - $number; -} - -=item downstream_csv [ OPTION => VALUE, ... ] - -=cut - -my %export_formats = ( - 'convergent' => [ - 'carriername', #CARRIER - sub { shift->_convergent_format('src') }, #SERVICE_NUMBER - sub { shift->_convergent_format('charged_party') }, #CHARGED_NUMBER - sub { time2str('%Y-%m-%d', shift->calldate_unix ) }, #DATE - sub { time2str('%T', shift->calldate_unix ) }, #TIME - 'billsec', #'duration', #DURATION - sub { shift->_convergent_format('dst') }, #NUMBER_DIALED - '', #XXX add (from prefixes in most recent email) #FROM_DESC - '', #XXX add (from prefixes in most recent email) #TO_DESC - 'calltypename', #CLASS_CODE - 'rated_price', #PRICE - sub { shift->rated_price ? 'Y' : 'N' }, #RATED - '', #OTHER_INFO - ], -); - -sub downstream_csv { - my( $self, %opt ) = @_; - - my $format = $opt{'format'}; # 'convergent'; - return "Unknown format $format" unless exists $export_formats{$format}; - - eval "use Text::CSV_XS;"; - die $@ if $@; - my $csv = new Text::CSV_XS; - - my @columns = - map { - ref($_) ? &{$_}($self) : $self->$_(); - } - @{ $export_formats{$format} }; - - my $status = $csv->combine(@columns); - die "FS::CDR: error combining ". $csv->error_input(). "into downstream CSV" - unless $status; - - $csv->string; - -} - -=back - -=head1 CLASS METHODS - -=over 4 - -=item batch_import - -=cut - -my($tmp_mday, $tmp_mon, $tmp_year); - -my %import_formats = ( - 'asterisk' => [ - 'accountcode', - 'src', - 'dst', - 'dcontext', - 'clid', - 'channel', - 'dstchannel', - 'lastapp', - 'lastdata', - 'startdate', # XXX will need massaging - 'answer', # XXX same - 'end', # XXX same - 'duration', - 'billsec', - 'disposition', - 'amaflags', - 'uniqueid', - 'userfield', - ], - 'unitel' => [ - 'uniqueid', - #'cdr_type', - 'cdrtypenum', - 'calldate', # may need massaging? huh maybe not... - #'billsec', #XXX duration and billsec? - sub { $_[0]->billsec( $_[1] ); - $_[0]->duration( $_[1] ); - }, - 'src', - 'dst', # XXX needs to have "+61" prepended unless /^\+/ ??? - 'charged_party', - 'upstream_currency', - 'upstream_price', - 'upstream_rateplanid', - 'distance', - 'islocal', - 'calltypenum', - 'startdate', #XXX needs massaging - 'enddate', #XXX same - 'description', - 'quantity', - 'carrierid', - 'upstream_rateid', - ], - 'ams' => [ - - # Date - sub { my($cdr, $date) = @_; - $date =~ /^(\d{1,2})\/(\d{1,2})\/(\d\d(\d\d)?)$/ - or die "unparsable date: $date"; #maybe we shouldn't die... - #$cdr->startdate( timelocal(0, 0, 0 ,$2, $1-1, $3) ); - ($tmp_mday, $tmp_mon, $tmp_year) = ( $2, $1-1, $3 ); - }, - - # Time - sub { my($cdr, $time) = @_; - #my($sec, $min, $hour, $mday, $mon, $year)= localtime($cdr->startdate); - $time =~ /^(\d{1,2}):(\d{1,2}):(\d{1,2})$/ - or die "unparsable time: $time"; #maybe we shouldn't die... - #$cdr->startdate( timelocal($3, $2, $1 ,$mday, $mon, $year) ); - $cdr->startdate( - timelocal($3, $2, $1 ,$tmp_mday, $tmp_mon, $tmp_year) - ); - }, - - # Source_Number - 'src', - - # Terminating_Number - 'dst', - - # Duration - sub { my($cdr, $min) = @_; - my $sec = sprintf('%.0f', $min * 60 ); - $cdr->billsec( $sec ); - $cdr->duration( $sec ); - }, - - ], -); - -sub batch_import { - my $param = shift; - - my $fh = $param->{filehandle}; - my $format = $param->{format}; - - return "Unknown format $format" unless exists $import_formats{$format}; - - eval "use Text::CSV_XS;"; - die $@ if $@; - - my $csv = new Text::CSV_XS; - - my $imported = 0; - #my $columns; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - if ( $format eq 'ams' ) { # and other formats with a header too? - - } - - my $body = 0; - my $line; - while ( defined($line=<$fh>) ) { - - #skip header... - if ( ! $body++ && $format eq 'ams' && $line =~ /^[\w\, ]+$/ ) { - next; - } - - $csv->parse($line) or do { - $dbh->rollback if $oldAutoCommit; - return "can't parse: ". $csv->error_input(); - }; - - my @columns = $csv->fields(); - #warn join('-',@columns); - - if ( $format eq 'ams' ) { - @columns = map { s/^ +//; $_; } @columns; - } - - my @later = (); - my %cdr = - map { - - my $field_or_sub = $_; - if ( ref($field_or_sub) ) { - push @later, $field_or_sub, shift(@columns); - (); - } else { - ( $field_or_sub => shift @columns ); - } - - } - @{ $import_formats{$format} } - ; - - my $cdr = new FS::cdr ( \%cdr ); - - while ( scalar(@later) ) { - my $sub = shift @later; - my $data = shift @later; - &{$sub}($cdr, $data); # $cdr->&{$sub}($data); - } - - my $error = $cdr->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - - #or just skip? - #next; - } - - $imported++; - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - #might want to disable this if we skip records for any reason... - return "Empty file!" unless $imported; - - ''; - -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/cdr_calltype.pm b/FS/FS/cdr_calltype.pm deleted file mode 100644 index fe45608..0000000 --- a/FS/FS/cdr_calltype.pm +++ /dev/null @@ -1,115 +0,0 @@ -package FS::cdr_calltype; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::cdr_calltype - Object methods for cdr_calltype records - -=head1 SYNOPSIS - - use FS::cdr_calltype; - - $record = new FS::cdr_calltype \%hash; - $record = new FS::cdr_calltype { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::cdr_calltype object represents an CDR call type. FS::cdr_calltype -inherits from FS::Record. The following fields are currently supported: - -=over 4 - -=item calltypenum - primary key - -=item calltypename - CDR call type name - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new call type. To add the call type to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'cdr_calltype'; } - -=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 call type. If there is -an error, returns the error, otherwise returns false. Called by the insert -and replace methods. - -=cut - -sub check { - my $self = shift; - - my $error = - $self->ut_numbern('calltypenum') - || $self->ut_text('calltypename') - ; - return $error if $error; - - $self->SUPER::check; -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/cdr_carrier.pm b/FS/FS/cdr_carrier.pm deleted file mode 100644 index 609c939..0000000 --- a/FS/FS/cdr_carrier.pm +++ /dev/null @@ -1,116 +0,0 @@ -package FS::cdr_carrier; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::cdr_carrier - Object methods for cdr_carrier records - -=head1 SYNOPSIS - - use FS::cdr_carrier; - - $record = new FS::cdr_carrier \%hash; - $record = new FS::cdr_carrier { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::cdr_carrier object represents an CDR carrier or upstream. -FS::cdr_carrier inherits from FS::Record. The following fields are currently -supported: - -=over 4 - -=item carrierid - primary key - -=item carriername - Carrier name - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new carrier. To add the carrier to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'cdr_carrier'; } - -=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 carrier. 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('carrierid') - || $self->ut_text('carriername') - ; - return $error if $error; - - $self->SUPER::check; -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/cdr_type.pm b/FS/FS/cdr_type.pm deleted file mode 100644 index e258bf8..0000000 --- a/FS/FS/cdr_type.pm +++ /dev/null @@ -1,119 +0,0 @@ -package FS::cdr_type; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::cdr_type - Object methods for cdr_type records - -=head1 SYNOPSIS - - use FS::cdr_type; - - $record = new FS::cdr_type \%hash; - $record = new FS::cdr_type { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::cdr_type object represents an CDR type. FS::cdr_type inherits from -FS::Record. The following fields are currently supported: - -=over 4 - -=item cdrtypenum - primary key - -=item typename - CDR type name - - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new CDR type. To add the CDR type to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'cdr_type'; } - -=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 CDR type. 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('cdrtypenum') - || $self->ut_text('typename') - ; - return $error if $error; - - $self->SUPER::check; -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/cdr_upstream_rate.pm b/FS/FS/cdr_upstream_rate.pm deleted file mode 100644 index 2fd9782..0000000 --- a/FS/FS/cdr_upstream_rate.pm +++ /dev/null @@ -1,138 +0,0 @@ -package FS::cdr_upstream_rate; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); -use FS::rate_detail; - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::cdr_upstream_rate - Object methods for cdr_upstream_rate records - -=head1 SYNOPSIS - - use FS::cdr_upstream_rate; - - $record = new FS::cdr_upstream_rate \%hash; - $record = new FS::cdr_upstream_rate { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::cdr_upstream_rate object represents an upstream rate mapping to -internal rate detail (see L<FS::rate_detail>). FS::cdr_upstream_rate inherits -from FS::Record. The following fields are currently supported: - -=over 4 - -=item upstreamratenum - primary key - -=item upstream_rateid - CDR upstream Rate ID (cdr.upstream_rateid - see L<FS::cdr>) - -=item ratedetailnum - Rate detail - see L<FS::rate_detail> - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new upstream rate mapping. To add the upstream rate to the database, -see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'cdr_upstream_rate'; } - -=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 upstream rate. 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('upstreamratenum') - #|| $self->ut_number('upstream_rateid') - || $self->ut_alpha('upstream_rateid') - #|| $self->ut_text('upstream_rateid') - || $self->ut_foreign_key('ratedetailnum', 'rate_detail', 'ratedetailnum' ) - ; - return $error if $error; - - $self->SUPER::check; -} - -=item rate_detail - -Returns the internal rate detail object for this upstream rate (see -L<FS::rate_detail>). - -=cut - -sub rate_detail { - my $self = shift; - qsearchs('rate_detail', { 'ratedetailnum' => $self->ratedetailnum } ); -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/clientapi_session.pm b/FS/FS/clientapi_session.pm deleted file mode 100644 index f71a126..0000000 --- a/FS/FS/clientapi_session.pm +++ /dev/null @@ -1,121 +0,0 @@ -package FS::clientapi_session; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::clientapi_session - Object methods for clientapi_session records - -=head1 SYNOPSIS - - use FS::clientapi_session; - - $record = new FS::clientapi_session \%hash; - $record = new FS::clientapi_session { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::clientapi_session object represents an FS::ClientAPI session. -FS::clientapi_session inherits from FS::Record. The following fields are -currently supported: - -=over 4 - -=item sessionnum - primary key - -=item sessionid - session ID - -=item namespace - session namespace - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new record. To add the record to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'clientapi_session'; } - -=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; - - my $error = - $self->ut_numbern('primary_key') - || $self->ut_number('validate_other_fields') - ; - return $error if $error; - - $self->SUPER::check; -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::ClientAPI>, <FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/clientapi_session_field.pm b/FS/FS/clientapi_session_field.pm deleted file mode 100644 index bfa487d..0000000 --- a/FS/FS/clientapi_session_field.pm +++ /dev/null @@ -1,126 +0,0 @@ -package FS::clientapi_session_field; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::clientapi_session_field - Object methods for clientapi_session_field records - -=head1 SYNOPSIS - - use FS::clientapi_session_field; - - $record = new FS::clientapi_session_field \%hash; - $record = new FS::clientapi_session_field { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::clientapi_session_field object represents a FS::ClientAPI session data -field. FS::clientapi_session_field inherits from FS::Record. The following -fields are currently supported: - -=over 4 - -=item fieldnum - primary key - -=item sessionnum - Base ClientAPI sesison (see L<FS::clientapi_session>) - -=item fieldname - -=item fieldvalie - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new record. To add the record to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'clientapi_session_field'; } - -=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; - - my $error = - $self->ut_numbern('primary_key') - || $self->ut_number('validate_other_fields') - ; - return $error if $error; - - $self->SUPER::check; -} - -=back - -=head1 BUGS - -The author forgot to customize this manpage. - -=head1 SEE ALSO - -L<FS::clientapi_session>, L<FS::ClientAPI>, L<FS::Record>, schema.html from the -base documentation. - -=cut - -1; - diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm deleted file mode 100644 index a93d175..0000000 --- a/FS/FS/cust_bill.pm +++ /dev/null @@ -1,2638 +0,0 @@ -package FS::cust_bill; - -use strict; -use vars qw( @ISA $DEBUG $conf $money_char ); -use vars qw( $invoice_lines @buf ); #yuck -use Fcntl qw(:flock); #for spool_csv -use IPC::Run3; -use Date::Format; -use Text::Template 1.20; -use File::Temp 0.14; -use String::ShellQuote; -use HTML::Entities; -use Locale::Country; -use FS::UID qw( datasrc ); -use FS::Misc qw( send_email send_fax ); -use FS::Record qw( qsearch qsearchs dbh ); -use FS::cust_main_Mixin; -use FS::cust_main; -use FS::cust_bill_pkg; -use FS::cust_credit; -use FS::cust_pay; -use FS::cust_pkg; -use FS::cust_credit_bill; -use FS::pay_batch; -use FS::cust_pay_batch; -use FS::cust_bill_event; -use FS::part_pkg; -use FS::cust_bill_pay; -use FS::part_bill_event; - -@ISA = qw( FS::cust_main_Mixin FS::Record ); - -$DEBUG = 0; - -#ask FS::UID to run this stuff for us later -FS::UID->install_callback( sub { - $conf = new FS::Conf; - $money_char = $conf->config('money_char') || '$'; -} ); - -=head1 NAME - -FS::cust_bill - Object methods for cust_bill records - -=head1 SYNOPSIS - - use FS::cust_bill; - - $record = new FS::cust_bill \%hash; - $record = new FS::cust_bill { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - - ( $total_previous_balance, @previous_cust_bill ) = $record->previous; - - @cust_bill_pkg_objects = $cust_bill->cust_bill_pkg; - - ( $total_previous_credits, @previous_cust_credit ) = $record->cust_credit; - - @cust_pay_objects = $cust_bill->cust_pay; - - $tax_amount = $record->tax; - - @lines = $cust_bill->print_text; - @lines = $cust_bill->print_text $time; - -=head1 DESCRIPTION - -An FS::cust_bill object represents an invoice; a declaration that a customer -owes you money. The specific charges are itemized as B<cust_bill_pkg> records -(see L<FS::cust_bill_pkg>). FS::cust_bill inherits from FS::Record. The -following fields are currently supported: - -=over 4 - -=item invnum - primary key (assigned automatically for new invoices) - -=item custnum - customer (see L<FS::cust_main>) - -=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see -L<Time::Local> and L<Date::Parse> for conversion functions. - -=item charged - amount of this invoice - -=item printed - deprecated - -=item closed - books closed flag, empty or `Y' - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new invoice. To add the invoice to the database, see L<"insert">. -Invoices are normally created by calling the bill method of a customer object -(see L<FS::cust_main>). - -=cut - -sub table { 'cust_bill'; } - -sub cust_linked { $_[0]->cust_main_custnum; } -sub cust_unlinked_msg { - my $self = shift; - "WARNING: can't find cust_main.custnum ". $self->custnum. - ' (cust_bill.invnum '. $self->invnum. ')'; -} - -=item insert - -Adds this invoice to the database ("Posts" the invoice). If there is an error, -returns the error, otherwise returns false. - -=item delete - -This method now works but you probably shouldn't use it. Instead, apply a -credit against the invoice. - -Using this method to delete invoices outright is really, really bad. There -would be no record you ever posted this invoice, and there are no check to -make sure charged = 0 or that there are no associated cust_bill_pkg records. - -Really, don't use it. - -=cut - -sub delete { - my $self = shift; - return "Can't delete closed invoice" if $self->closed =~ /^Y/i; - $self->SUPER::delete(@_); -} - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -Only printed may be changed. printed is normally updated by calling the -collect method of a customer object (see L<FS::cust_main>). - -=cut - -#replace can be inherited from Record.pm - -# replace_check is now the preferred way to #implement replace data checks -# (so $object->replace() works without an argument) - -sub replace_check { - my( $new, $old ) = ( shift, shift ); - return "Can't change custnum!" unless $old->custnum == $new->custnum; - #return "Can't change _date!" unless $old->_date eq $new->_date; - return "Can't change _date!" unless $old->_date == $new->_date; - return "Can't change charged!" unless $old->charged == $new->charged - || $old->charged == 0; - - ''; -} - -=item check - -Checks all fields to make sure this is a valid invoice. If there is an error, -returns the error, otherwise returns false. Called by the insert and replace -methods. - -=cut - -sub check { - my $self = shift; - - my $error = - $self->ut_numbern('invnum') - || $self->ut_number('custnum') - || $self->ut_numbern('_date') - || $self->ut_money('charged') - || $self->ut_numbern('printed') - || $self->ut_enum('closed', [ '', 'Y' ]) - ; - return $error if $error; - - return "Unknown customer" - unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); - - $self->_date(time) unless $self->_date; - - $self->printed(0) if $self->printed eq ''; - - $self->SUPER::check; -} - -=item previous - -Returns a list consisting of the total previous balance for this customer, -followed by the previous outstanding invoices (as FS::cust_bill objects also). - -=cut - -sub previous { - my $self = shift; - my $total = 0; - my @cust_bill = sort { $a->_date <=> $b->_date } - grep { $_->owed != 0 && $_->_date < $self->_date } - qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) - ; - foreach ( @cust_bill ) { $total += $_->owed; } - $total, @cust_bill; -} - -=item cust_bill_pkg - -Returns the line items (see L<FS::cust_bill_pkg>) for this invoice. - -=cut - -sub cust_bill_pkg { - my $self = shift; - qsearch( 'cust_bill_pkg', { 'invnum' => $self->invnum } ); -} - -=item open_cust_bill_pkg - -Returns the open line items for this invoice. - -Note that cust_bill_pkg with both setup and recur fees are returned as two -separate line items, each with only one fee. - -=cut - -# modeled after cust_main::open_cust_bill -sub open_cust_bill_pkg { - my $self = shift; - - # grep { $_->owed > 0 } $self->cust_bill_pkg - - my %other = ( 'recur' => 'setup', - 'setup' => 'recur', ); - my @open = (); - foreach my $field ( qw( recur setup )) { - push @open, map { $_->set( $other{$field}, 0 ); $_; } - grep { $_->owed($field) > 0 } - $self->cust_bill_pkg; - } - - @open; -} - -=item cust_bill_event - -Returns the completed invoice events (see L<FS::cust_bill_event>) for this -invoice. - -=cut - -sub cust_bill_event { - my $self = shift; - qsearch( 'cust_bill_event', { 'invnum' => $self->invnum } ); -} - - -=item cust_main - -Returns the customer (see L<FS::cust_main>) for this invoice. - -=cut - -sub cust_main { - my $self = shift; - qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); -} - -=item cust_suspend_if_balance_over AMOUNT - -Suspends the customer associated with this invoice if the total amount owed on -this invoice and all older invoices is greater than the specified amount. - -Returns a list: an empty list on success or a list of errors. - -=cut - -sub cust_suspend_if_balance_over { - my( $self, $amount ) = ( shift, shift ); - my $cust_main = $self->cust_main; - if ( $cust_main->total_owed_date($self->_date) < $amount ) { - return (); - } else { - $cust_main->suspend; - } -} - -=item cust_credit - -Depreciated. See the cust_credited method. - - #Returns a list consisting of the total previous credited (see - #L<FS::cust_credit>) and unapplied for this customer, followed by the previous - #outstanding credits (FS::cust_credit objects). - -=cut - -sub cust_credit { - use Carp; - croak "FS::cust_bill->cust_credit depreciated; see ". - "FS::cust_bill->cust_credit_bill"; - #my $self = shift; - #my $total = 0; - #my @cust_credit = sort { $a->_date <=> $b->_date } - # grep { $_->credited != 0 && $_->_date < $self->_date } - # qsearch('cust_credit', { 'custnum' => $self->custnum } ) - #; - #foreach (@cust_credit) { $total += $_->credited; } - #$total, @cust_credit; -} - -=item cust_pay - -Depreciated. See the cust_bill_pay method. - -#Returns all payments (see L<FS::cust_pay>) for this invoice. - -=cut - -sub cust_pay { - use Carp; - croak "FS::cust_bill->cust_pay depreciated; see FS::cust_bill->cust_bill_pay"; - #my $self = shift; - #sort { $a->_date <=> $b->_date } - # qsearch( 'cust_pay', { 'invnum' => $self->invnum } ) - #; -} - -=item cust_bill_pay - -Returns all payment applications (see L<FS::cust_bill_pay>) for this invoice. - -=cut - -sub cust_bill_pay { - my $self = shift; - sort { $a->_date <=> $b->_date } - qsearch( 'cust_bill_pay', { 'invnum' => $self->invnum } ); -} - -=item cust_credited - -Returns all applied credits (see L<FS::cust_credit_bill>) for this invoice. - -=cut - -sub cust_credited { - my $self = shift; - sort { $a->_date <=> $b->_date } - qsearch( 'cust_credit_bill', { 'invnum' => $self->invnum } ) - ; -} - -=item tax - -Returns the tax amount (see L<FS::cust_bill_pkg>) for this invoice. - -=cut - -sub tax { - my $self = shift; - my $total = 0; - my @taxlines = qsearch( 'cust_bill_pkg', { 'invnum' => $self->invnum , - 'pkgnum' => 0 } ); - foreach (@taxlines) { $total += $_->setup; } - $total; -} - -=item owed - -Returns the amount owed (still outstanding) on this invoice, which is charged -minus all payment applications (see L<FS::cust_bill_pay>) and credit -applications (see L<FS::cust_credit_bill>). - -=cut - -sub owed { - my $self = shift; - my $balance = $self->charged; - $balance -= $_->amount foreach ( $self->cust_bill_pay ); - $balance -= $_->amount foreach ( $self->cust_credited ); - $balance = sprintf( "%.2f", $balance); - $balance =~ s/^\-0\.00$/0.00/; #yay ieee fp - $balance; -} - - -=item generate_email PARAMHASH - -PARAMHASH can contain the following: - -=over 4 - -=item from => sender address, required - -=item tempate => alternate template name, optional - -=item print_text => text attachment arrayref, optional - -=item subject => email subject, optional - -=back - -Returns an argument list to be passed to L<FS::Misc::send_email>. - -=cut - -use MIME::Entity; - -sub generate_email { - - my $self = shift; - my %args = @_; - - my $me = '[FS::cust_bill::generate_email]'; - - my %return = ( - 'from' => $args{'from'}, - 'subject' => (($args{'subject'}) ? $args{'subject'} : 'Invoice'), - ); - - if (ref($args{'to'} eq 'ARRAY')) { - $return{'to'} = $args{'to'}; - } else { - $return{'to'} = [ grep { $_ !~ /^(POST|FAX)$/ } - $self->cust_main->invoicing_list - ]; - } - - if ( $conf->exists('invoice_html') ) { - - warn "$me creating HTML/text multipart message" - if $DEBUG; - - $return{'nobody'} = 1; - - my $alternative = build MIME::Entity - 'Type' => 'multipart/alternative', - 'Encoding' => '7bit', - 'Disposition' => 'inline' - ; - - my $data; - if ( $conf->exists('invoice_email_pdf') - and scalar($conf->config('invoice_email_pdf_note')) ) { - - warn "$me using 'invoice_email_pdf_note' in multipart message" - if $DEBUG; - $data = [ map { $_ . "\n" } - $conf->config('invoice_email_pdf_note') - ]; - - } else { - - warn "$me not using 'invoice_email_pdf_note' in multipart message" - if $DEBUG; - if ( ref($args{'print_text'}) eq 'ARRAY' ) { - $data = $args{'print_text'}; - } else { - $data = [ $self->print_text('', $args{'template'}) ]; - } - - } - - $alternative->attach( - 'Type' => 'text/plain', - #'Encoding' => 'quoted-printable', - 'Encoding' => '7bit', - 'Data' => $data, - 'Disposition' => 'inline', - ); - - $args{'from'} =~ /\@([\w\.\-]+)/ or $1 = 'example.com'; - my $content_id = join('.', rand()*(2**32), $$, time). "\@$1"; - - my $path = "$FS::UID::conf_dir/conf.$FS::UID::datasrc"; - my $file; - if ( defined($args{'_template'}) && length($args{'_template'}) - && -e "$path/logo_". $args{'_template'}. ".png" - ) - { - $file = "$path/logo_". $args{'_template'}. ".png"; - } else { - $file = "$path/logo.png"; - } - - my $image = build MIME::Entity - 'Type' => 'image/png', - 'Encoding' => 'base64', - 'Path' => $file, - 'Filename' => 'logo.png', - 'Content-ID' => "<$content_id>", - ; - - $alternative->attach( - 'Type' => 'text/html', - 'Encoding' => 'quoted-printable', - 'Data' => [ '<html>', - ' <head>', - ' <title>', - ' '. encode_entities($return{'subject'}), - ' </title>', - ' </head>', - ' <body bgcolor="#e8e8e8">', - $self->print_html('', $args{'template'}, $content_id), - ' </body>', - '</html>', - ], - 'Disposition' => 'inline', - #'Filename' => 'invoice.pdf', - ); - - if ( $conf->exists('invoice_email_pdf') ) { - - #attaching pdf too: - # multipart/mixed - # multipart/related - # multipart/alternative - # text/plain - # text/html - # image/png - # application/pdf - - my $related = build MIME::Entity 'Type' => 'multipart/related', - 'Encoding' => '7bit'; - - #false laziness w/Misc::send_email - $related->head->replace('Content-type', - $related->mime_type. - '; boundary="'. $related->head->multipart_boundary. '"'. - '; type=multipart/alternative' - ); - - $related->add_part($alternative); - - $related->add_part($image); - - my $pdf = build MIME::Entity $self->mimebuild_pdf('', $args{'template'}); - - $return{'mimeparts'} = [ $related, $pdf ]; - - } else { - - #no other attachment: - # multipart/related - # multipart/alternative - # text/plain - # text/html - # image/png - - $return{'content-type'} = 'multipart/related'; - $return{'mimeparts'} = [ $alternative, $image ]; - $return{'type'} = 'multipart/alternative'; #Content-Type of first part... - #$return{'disposition'} = 'inline'; - - } - - } else { - - if ( $conf->exists('invoice_email_pdf') ) { - warn "$me creating PDF attachment" - if $DEBUG; - - #mime parts arguments a la MIME::Entity->build(). - $return{'mimeparts'} = [ - { $self->mimebuild_pdf('', $args{'template'}) } - ]; - } - - if ( $conf->exists('invoice_email_pdf') - and scalar($conf->config('invoice_email_pdf_note')) ) { - - warn "$me using 'invoice_email_pdf_note'" - if $DEBUG; - $return{'body'} = [ map { $_ . "\n" } - $conf->config('invoice_email_pdf_note') - ]; - - } else { - - warn "$me not using 'invoice_email_pdf_note'" - if $DEBUG; - if ( ref($args{'print_text'}) eq 'ARRAY' ) { - $return{'body'} = $args{'print_text'}; - } else { - $return{'body'} = [ $self->print_text('', $args{'template'}) ]; - } - - } - - } - - %return; - -} - -=item mimebuild_pdf - -Returns a list suitable for passing to MIME::Entity->build(), representing -this invoice as PDF attachment. - -=cut - -sub mimebuild_pdf { - my $self = shift; - ( - 'Type' => 'application/pdf', - 'Encoding' => 'base64', - 'Data' => [ $self->print_pdf(@_) ], - 'Disposition' => 'attachment', - 'Filename' => 'invoice.pdf', - ); -} - -=item send [ TEMPLATENAME [ , AGENTNUM [ , INVOICE_FROM ] ] ] - -Sends this invoice to the destinations configured for this customer: sends -email, prints and/or faxes. See L<FS::cust_main_invoice>. - -TEMPLATENAME, if specified, is the name of a suffix for alternate invoices. - -AGENTNUM, if specified, means that this invoice will only be sent for customers -of the specified agent or agent(s). AGENTNUM can be a scalar agentnum (for a -single agent) or an arrayref of agentnums. - -INVOICE_FROM, if specified, overrides the default email invoice From: address. - -=cut - -sub send { - my $self = shift; - my $template = scalar(@_) ? shift : ''; - if ( scalar(@_) && $_[0] ) { - my $agentnums = ref($_[0]) ? shift : [ shift ]; - return 'N/A' unless grep { $_ == $self->cust_main->agentnum } @$agentnums; - } - - my $invoice_from = - scalar(@_) - ? shift - : ( $self->_agent_invoice_from || $conf->config('invoice_from') ); - - my @invoicing_list = $self->cust_main->invoicing_list; - - $self->email($template, $invoice_from) - if grep { $_ !~ /^(POST|FAX)$/ } @invoicing_list or !@invoicing_list; - - $self->print($template) - if grep { $_ eq 'POST' } @invoicing_list; #postal - - $self->fax($template) - if grep { $_ eq 'FAX' } @invoicing_list; #fax - - ''; - -} - -=item email [ TEMPLATENAME [ , INVOICE_FROM ] ] - -Emails this invoice. - -TEMPLATENAME, if specified, is the name of a suffix for alternate invoices. - -INVOICE_FROM, if specified, overrides the default email invoice From: address. - -=cut - -sub email { - my $self = shift; - my $template = scalar(@_) ? shift : ''; - my $invoice_from = - scalar(@_) - ? shift - : ( $self->_agent_invoice_from || $conf->config('invoice_from') ); - - my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } - $self->cust_main->invoicing_list; - - #better to notify this person than silence - @invoicing_list = ($invoice_from) unless @invoicing_list; - - my $error = send_email( - $self->generate_email( - 'from' => $invoice_from, - 'to' => [ grep { $_ !~ /^(POST|FAX)$/ } @invoicing_list ], - 'template' => $template, - ) - ); - die "can't email invoice: $error\n" if $error; - #die "$error\n" if $error; - -} - -=item lpr_data [ TEMPLATENAME ] - -Returns the postscript or plaintext for this invoice as an arrayref. - -TEMPLATENAME, if specified, is the name of a suffix for alternate invoices. - -=cut - -sub lpr_data { - my( $self, $template) = @_; - $conf->exists('invoice_latex') - ? [ $self->print_ps('', $template) ] - : [ $self->print_text('', $template) ]; -} - -=item print [ TEMPLATENAME ] - -Prints this invoice. - -TEMPLATENAME, if specified, is the name of a suffix for alternate invoices. - -=cut - -sub print { - my $self = shift; - my $template = scalar(@_) ? shift : ''; - - my $lpr = $conf->config('lpr'); - - my $outerr = ''; - run3 $lpr, $self->lpr_data($template), \$outerr, \$outerr; - if ( $? ) { - $outerr = ": $outerr" if length($outerr); - die "Error from $lpr (exit status ". ($?>>8). ")$outerr\n"; - } - -} - -=item fax [ TEMPLATENAME ] - -Faxes this invoice. - -TEMPLATENAME, if specified, is the name of a suffix for alternate invoices. - -=cut - -sub fax { - my $self = shift; - my $template = scalar(@_) ? shift : ''; - - die 'FAX invoice destination not (yet?) supported with plain text invoices.' - unless $conf->exists('invoice_latex'); - - my $dialstring = $self->cust_main->getfield('fax'); - #Check $dialstring? - - my $error = send_fax( 'docdata' => $self->lpr_data($template), - 'dialstring' => $dialstring, - ); - die $error if $error; - -} - -=item send_if_newest [ TEMPLATENAME [ , AGENTNUM [ , INVOICE_FROM ] ] ] - -Like B<send>, but only sends the invoice if it is the newest open invoice for -this customer. - -=cut - -sub send_if_newest { - my $self = shift; - - return '' - if scalar( - grep { $_->owed > 0 } - qsearch('cust_bill', { - 'custnum' => $self->custnum, - #'_date' => { op=>'>', value=>$self->_date }, - 'invnum' => { op=>'>', value=>$self->invnum }, - } ) - ); - - $self->send(@_); -} - -=item send_csv OPTION => VALUE, ... - -Sends invoice as a CSV data-file to a remote host with the specified protocol. - -Options are: - -protocol - currently only "ftp" -server -username -password -dir - -The file will be named "N-YYYYMMDDHHMMSS.csv" where N is the invoice number -and YYMMDDHHMMSS is a timestamp. - -See L</print_csv> for a description of the output format. - -=cut - -sub send_csv { - my($self, %opt) = @_; - - #create file(s) - - my $spooldir = "/usr/local/etc/freeside/export.". datasrc. "/cust_bill"; - mkdir $spooldir, 0700 unless -d $spooldir; - - my $tracctnum = $self->invnum. time2str('-%Y%m%d%H%M%S', time); - my $file = "$spooldir/$tracctnum.csv"; - - my ( $header, $detail ) = $self->print_csv(%opt, 'tracctnum' => $tracctnum ); - - open(CSV, ">$file") or die "can't open $file: $!"; - print CSV $header; - - print CSV $detail; - - close CSV; - - my $net; - if ( $opt{protocol} eq 'ftp' ) { - eval "use Net::FTP;"; - die $@ if $@; - $net = Net::FTP->new($opt{server}) or die @$; - } else { - die "unknown protocol: $opt{protocol}"; - } - - $net->login( $opt{username}, $opt{password} ) - or die "can't FTP to $opt{username}\@$opt{server}: login error: $@"; - - $net->binary or die "can't set binary mode"; - - $net->cwd($opt{dir}) or die "can't cwd to $opt{dir}"; - - $net->put($file) or die "can't put $file: $!"; - - $net->quit; - - unlink $file; - -} - -=item spool_csv - -Spools CSV invoice data. - -Options are: - -=over 4 - -=item format - 'default' or 'billco' - -=item dest - if set (to POST, EMAIL or FAX), only sends spools invoices if the customer has the corresponding invoice destinations set (see L<FS::cust_main_invoice>). - -=item agent_spools - if set to a true value, will spool to per-agent files rather than a single global file - -=item balanceover - if set, only spools the invoice if the total amount owed on this invoice and all older invoices is greater than the specified amount. - -=back - -=cut - -sub spool_csv { - my($self, %opt) = @_; - - my $cust_main = $self->cust_main; - - if ( $opt{'dest'} ) { - my %invoicing_list = map { /^(POST|FAX)$/ or 'EMAIL' =~ /^(.*)$/; $1 => 1 } - $cust_main->invoicing_list; - return 'N/A' unless $invoicing_list{$opt{'dest'}} - || ! keys %invoicing_list; - } - - if ( $opt{'balanceover'} ) { - return 'N/A' - if $cust_main->total_owed_date($self->_date) < $opt{'balanceover'}; - } - - my $spooldir = "/usr/local/etc/freeside/export.". datasrc. "/cust_bill"; - mkdir $spooldir, 0700 unless -d $spooldir; - - my $tracctnum = $self->invnum. time2str('-%Y%m%d%H%M%S', time); - - my $file = - "$spooldir/". - ( $opt{'agent_spools'} ? 'agentnum'.$cust_main->agentnum : 'spool' ). - ( lc($opt{'format'}) eq 'billco' ? '-header' : '' ) . - '.csv'; - - my ( $header, $detail ) = $self->print_csv(%opt, 'tracctnum' => $tracctnum ); - - open(CSV, ">>$file") or die "can't open $file: $!"; - flock(CSV, LOCK_EX); - seek(CSV, 0, 2); - - print CSV $header; - - if ( lc($opt{'format'}) eq 'billco' ) { - - flock(CSV, LOCK_UN); - close CSV; - - $file = - "$spooldir/". - ( $opt{'agent_spools'} ? 'agentnum'.$cust_main->agentnum : 'spool' ). - '-detail.csv'; - - open(CSV,">>$file") or die "can't open $file: $!"; - flock(CSV, LOCK_EX); - seek(CSV, 0, 2); - } - - print CSV $detail; - - flock(CSV, LOCK_UN); - close CSV; - - return ''; - -} - -=item print_csv OPTION => VALUE, ... - -Returns CSV data for this invoice. - -Options are: - -format - 'default' or 'billco' - -Returns a list consisting of two scalars. The first is a single line of CSV -header information for this invoice. The second is one or more lines of CSV -detail information for this invoice. - -If I<format> is not specified or "default", the fields of the CSV file are as -follows: - -record_type, invnum, custnum, _date, charged, first, last, company, address1, address2, city, state, zip, country, pkg, setup, recur, sdate, edate - -=over 4 - -=item record type - B<record_type> is either C<cust_bill> or C<cust_bill_pkg> - -B<record_type> is C<cust_bill> for the initial header line only. The -last five fields (B<pkg> through B<edate>) are irrelevant, and all other -fields are filled in. - -B<record_type> is C<cust_bill_pkg> for detail lines. Only the first two fields -(B<record_type> and B<invnum>) and the last five fields (B<pkg> through B<edate>) -are filled in. - -=item invnum - invoice number - -=item custnum - customer number - -=item _date - invoice date - -=item charged - total invoice amount - -=item first - customer first name - -=item last - customer first name - -=item company - company name - -=item address1 - address line 1 - -=item address2 - address line 1 - -=item city - -=item state - -=item zip - -=item country - -=item pkg - line item description - -=item setup - line item setup fee (one or both of B<setup> and B<recur> will be defined) - -=item recur - line item recurring fee (one or both of B<setup> and B<recur> will be defined) - -=item sdate - start date for recurring fee - -=item edate - end date for recurring fee - -=back - -If I<format> is "billco", the fields of the header CSV file are as follows: - - +-------------------------------------------------------------------+ - | FORMAT HEADER FILE | - |-------------------------------------------------------------------| - | Field | Description | Name | Type | Width | - | 1 | N/A-Leave Empty | RC | CHAR | 2 | - | 2 | N/A-Leave Empty | CUSTID | CHAR | 15 | - | 3 | Transaction Account No | TRACCTNUM | CHAR | 15 | - | 4 | Transaction Invoice No | TRINVOICE | CHAR | 15 | - | 5 | Transaction Zip Code | TRZIP | CHAR | 5 | - | 6 | Transaction Company Bill To | TRCOMPANY | CHAR | 30 | - | 7 | Transaction Contact Bill To | TRNAME | CHAR | 30 | - | 8 | Additional Address Unit Info | TRADDR1 | CHAR | 30 | - | 9 | Bill To Street Address | TRADDR2 | CHAR | 30 | - | 10 | Ancillary Billing Information | TRADDR3 | CHAR | 30 | - | 11 | Transaction City Bill To | TRCITY | CHAR | 20 | - | 12 | Transaction State Bill To | TRSTATE | CHAR | 2 | - | 13 | Bill Cycle Close Date | CLOSEDATE | CHAR | 10 | - | 14 | Bill Due Date | DUEDATE | CHAR | 10 | - | 15 | Previous Balance | BALFWD | NUM* | 9 | - | 16 | Pmt/CR Applied | CREDAPPLY | NUM* | 9 | - | 17 | Total Current Charges | CURRENTCHG | NUM* | 9 | - | 18 | Total Amt Due | TOTALDUE | NUM* | 9 | - | 19 | Total Amt Due | AMTDUE | NUM* | 9 | - | 20 | 30 Day Aging | AMT30 | NUM* | 9 | - | 21 | 60 Day Aging | AMT60 | NUM* | 9 | - | 22 | 90 Day Aging | AMT90 | NUM* | 9 | - | 23 | Y/N | AGESWITCH | CHAR | 1 | - | 24 | Remittance automation | SCANLINE | CHAR | 100 | - | 25 | Total Taxes & Fees | TAXTOT | NUM* | 9 | - | 26 | Customer Reference Number | CUSTREF | CHAR | 15 | - | 27 | Federal Tax*** | FEDTAX | NUM* | 9 | - | 28 | State Tax*** | STATETAX | NUM* | 9 | - | 29 | Other Taxes & Fees*** | OTHERTAX | NUM* | 9 | - +-------+-------------------------------+------------+------+-------+ - -If I<format> is "billco", the fields of the detail CSV file are as follows: - - FORMAT FOR DETAIL FILE - | | | | - Field | Description | Name | Type | Width - 1 | N/A-Leave Empty | RC | CHAR | 2 - 2 | N/A-Leave Empty | CUSTID | CHAR | 15 - 3 | Account Number | TRACCTNUM | CHAR | 15 - 4 | Invoice Number | TRINVOICE | CHAR | 15 - 5 | Line Sequence (sort order) | LINESEQ | NUM | 6 - 6 | Transaction Detail | DETAILS | CHAR | 100 - 7 | Amount | AMT | NUM* | 9 - 8 | Line Format Control** | LNCTRL | CHAR | 2 - 9 | Grouping Code | GROUP | CHAR | 2 - 10 | User Defined | ACCT CODE | CHAR | 15 - -=cut - -sub print_csv { - my($self, %opt) = @_; - - eval "use Text::CSV_XS"; - die $@ if $@; - - my $cust_main = $self->cust_main; - - my $csv = Text::CSV_XS->new({'always_quote'=>1}); - - if ( lc($opt{'format'}) eq 'billco' ) { - - my $taxtotal = 0; - $taxtotal += $_->{'amount'} foreach $self->_items_tax; - - my $duedate = ''; - if ( $conf->exists('invoice_default_terms') - && $conf->config('invoice_default_terms')=~ /^\s*Net\s*(\d+)\s*$/ ) { - $duedate = time2str("%m/%d/%Y", $self->_date + ($1*86400) ); - } - - my( $previous_balance, @unused ) = $self->previous; #previous balance - - my $pmt_cr_applied = 0; - $pmt_cr_applied += $_->{'amount'} - foreach ( $self->_items_payments, $self->_items_credits ) ; - - my $totaldue = sprintf('%.2f', $self->owed + $previous_balance); - - $csv->combine( - '', # 1 | N/A-Leave Empty CHAR 2 - '', # 2 | N/A-Leave Empty CHAR 15 - $opt{'tracctnum'}, # 3 | Transaction Account No CHAR 15 - $self->invnum, # 4 | Transaction Invoice No CHAR 15 - $cust_main->zip, # 5 | Transaction Zip Code CHAR 5 - $cust_main->company, # 6 | Transaction Company Bill To CHAR 30 - #$cust_main->payname, # 7 | Transaction Contact Bill To CHAR 30 - $cust_main->contact, # 7 | Transaction Contact Bill To CHAR 30 - $cust_main->address2, # 8 | Additional Address Unit Info CHAR 30 - $cust_main->address1, # 9 | Bill To Street Address CHAR 30 - '', # 10 | Ancillary Billing Information CHAR 30 - $cust_main->city, # 11 | Transaction City Bill To CHAR 20 - $cust_main->state, # 12 | Transaction State Bill To CHAR 2 - - # XXX ? - time2str("%m/%d/%Y", $self->_date), # 13 | Bill Cycle Close Date CHAR 10 - - # XXX ? - $duedate, # 14 | Bill Due Date CHAR 10 - - $previous_balance, # 15 | Previous Balance NUM* 9 - $pmt_cr_applied, # 16 | Pmt/CR Applied NUM* 9 - sprintf("%.2f", $self->charged), # 17 | Total Current Charges NUM* 9 - $totaldue, # 18 | Total Amt Due NUM* 9 - $totaldue, # 19 | Total Amt Due NUM* 9 - '', # 20 | 30 Day Aging NUM* 9 - '', # 21 | 60 Day Aging NUM* 9 - '', # 22 | 90 Day Aging NUM* 9 - 'N', # 23 | Y/N CHAR 1 - '', # 24 | Remittance automation CHAR 100 - $taxtotal, # 25 | Total Taxes & Fees NUM* 9 - $self->custnum, # 26 | Customer Reference Number CHAR 15 - '0', # 27 | Federal Tax*** NUM* 9 - sprintf("%.2f", $taxtotal), # 28 | State Tax*** NUM* 9 - '0', # 29 | Other Taxes & Fees*** NUM* 9 - ); - - } else { - - $csv->combine( - 'cust_bill', - $self->invnum, - $self->custnum, - time2str("%x", $self->_date), - sprintf("%.2f", $self->charged), - ( map { $cust_main->getfield($_) } - qw( first last company address1 address2 city state zip country ) ), - map { '' } (1..5), - ) or die "can't create csv"; - } - - my $header = $csv->string. "\n"; - - my $detail = ''; - if ( lc($opt{'format'}) eq 'billco' ) { - - my $lineseq = 0; - foreach my $item ( $self->_items_pkg ) { - - $csv->combine( - '', # 1 | N/A-Leave Empty CHAR 2 - '', # 2 | N/A-Leave Empty CHAR 15 - $opt{'tracctnum'}, # 3 | Account Number CHAR 15 - $self->invnum, # 4 | Invoice Number CHAR 15 - $lineseq++, # 5 | Line Sequence (sort order) NUM 6 - $item->{'description'}, # 6 | Transaction Detail CHAR 100 - $item->{'amount'}, # 7 | Amount NUM* 9 - '', # 8 | Line Format Control** CHAR 2 - '', # 9 | Grouping Code CHAR 2 - '', # 10 | User Defined CHAR 15 - ); - - $detail .= $csv->string. "\n"; - - } - - } else { - - foreach my $cust_bill_pkg ( $self->cust_bill_pkg ) { - - my($pkg, $setup, $recur, $sdate, $edate); - if ( $cust_bill_pkg->pkgnum ) { - - ($pkg, $setup, $recur, $sdate, $edate) = ( - $cust_bill_pkg->cust_pkg->part_pkg->pkg, - ( $cust_bill_pkg->setup != 0 - ? sprintf("%.2f", $cust_bill_pkg->setup ) - : '' ), - ( $cust_bill_pkg->recur != 0 - ? sprintf("%.2f", $cust_bill_pkg->recur ) - : '' ), - ( $cust_bill_pkg->sdate - ? time2str("%x", $cust_bill_pkg->sdate) - : '' ), - ($cust_bill_pkg->edate - ?time2str("%x", $cust_bill_pkg->edate) - : '' ), - ); - - } else { #pkgnum tax - next unless $cust_bill_pkg->setup != 0; - my $itemdesc = defined $cust_bill_pkg->dbdef_table->column('itemdesc') - ? ( $cust_bill_pkg->itemdesc || 'Tax' ) - : 'Tax'; - ($pkg, $setup, $recur, $sdate, $edate) = - ( $itemdesc, sprintf("%10.2f",$cust_bill_pkg->setup), '', '', '' ); - } - - $csv->combine( - 'cust_bill_pkg', - $self->invnum, - ( map { '' } (1..11) ), - ($pkg, $setup, $recur, $sdate, $edate) - ) or die "can't create csv"; - - $detail .= $csv->string. "\n"; - - } - - } - - ( $header, $detail ); - -} - -=item comp - -Pays this invoice with a compliemntary payment. If there is an error, -returns the error, otherwise returns false. - -=cut - -sub comp { - my $self = shift; - my $cust_pay = new FS::cust_pay ( { - 'invnum' => $self->invnum, - 'paid' => $self->owed, - '_date' => '', - 'payby' => 'COMP', - 'payinfo' => $self->cust_main->payinfo, - 'paybatch' => '', - } ); - $cust_pay->insert; -} - -=item realtime_card - -Attempts to pay this invoice with a credit card payment via a -Business::OnlinePayment realtime gateway. See -http://search.cpan.org/search?mode=module&query=Business%3A%3AOnlinePayment -for supported processors. - -=cut - -sub realtime_card { - my $self = shift; - $self->realtime_bop( 'CC', @_ ); -} - -=item realtime_ach - -Attempts to pay this invoice with an electronic check (ACH) payment via a -Business::OnlinePayment realtime gateway. See -http://search.cpan.org/search?mode=module&query=Business%3A%3AOnlinePayment -for supported processors. - -=cut - -sub realtime_ach { - my $self = shift; - $self->realtime_bop( 'ECHECK', @_ ); -} - -=item realtime_lec - -Attempts to pay this invoice with phone bill (LEC) payment via a -Business::OnlinePayment realtime gateway. See -http://search.cpan.org/search?mode=module&query=Business%3A%3AOnlinePayment -for supported processors. - -=cut - -sub realtime_lec { - my $self = shift; - $self->realtime_bop( 'LEC', @_ ); -} - -sub realtime_bop { - my( $self, $method ) = @_; - - my $cust_main = $self->cust_main; - my $balance = $cust_main->balance; - my $amount = ( $balance < $self->owed ) ? $balance : $self->owed; - $amount = sprintf("%.2f", $amount); - return "not run (balance $balance)" unless $amount > 0; - - my $description = 'Internet Services'; - if ( $conf->exists('business-onlinepayment-description') ) { - my $dtempl = $conf->config('business-onlinepayment-description'); - - my $agent_obj = $cust_main->agent - or die "can't retreive agent for $cust_main (agentnum ". - $cust_main->agentnum. ")"; - my $agent = $agent_obj->agent; - my $pkgs = join(', ', - map { $_->cust_pkg->part_pkg->pkg } - grep { $_->pkgnum } $self->cust_bill_pkg - ); - $description = eval qq("$dtempl"); - } - - $cust_main->realtime_bop($method, $amount, - 'description' => $description, - 'invnum' => $self->invnum, - ); - -} - -=item batch_card - -Adds a payment for this invoice to the pending credit card batch (see -L<FS::cust_pay_batch>). - -=cut - -sub batch_card { - my $self = shift; - my $cust_main = $self->cust_main; - - my $amount = sprintf("%.2f", $cust_main->balance - $cust_main->in_transit_payments); - return '' unless $amount > 0; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $pay_batch = qsearchs('pay_batch', {'status' => 'O'}); - - unless ( $pay_batch ) { - $pay_batch = new FS::pay_batch; - $pay_batch->setfield('status' => 'O'); - my $error = $pay_batch->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - die "error creating new batch: $error\n"; - } - } - - my $old_cust_pay_batch = qsearchs('cust_pay_batch', { - 'batchnum' => $pay_batch->getfield('batchnum'), - 'custnum' => $cust_main->getfield('custnum'), - } ); - - my $cust_pay_batch = new FS::cust_pay_batch ( { - 'batchnum' => $pay_batch->getfield('batchnum'), - 'invnum' => $self->getfield('invnum'), # is there a better value? - 'custnum' => $cust_main->getfield('custnum'), - 'last' => $cust_main->getfield('last'), - 'first' => $cust_main->getfield('first'), - 'address1' => $cust_main->getfield('address1'), - 'address2' => $cust_main->getfield('address2'), - 'city' => $cust_main->getfield('city'), - 'state' => $cust_main->getfield('state'), - 'zip' => $cust_main->getfield('zip'), - 'country' => $cust_main->getfield('country'), - 'payby' => $cust_main->payby, - 'payinfo' => $cust_main->payinfo, - 'exp' => $cust_main->getfield('paydate'), - 'payname' => $cust_main->getfield('payname'), - 'amount' => $amount, # consolidating - } ); - - $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum) - if $old_cust_pay_batch; - - my $error; - if ($old_cust_pay_batch) { - $error = $cust_pay_batch->replace($old_cust_pay_batch) - } else { - $error = $cust_pay_batch->insert; - } - - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - die $error; - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; -} - -sub _agent_template { - my $self = shift; - $self->_agent_plandata('agent_templatename'); -} - -sub _agent_invoice_from { - my $self = shift; - $self->_agent_plandata('agent_invoice_from'); -} - -sub _agent_plandata { - my( $self, $option ) = @_; - - my $part_bill_event = qsearchs( 'part_bill_event', - { - 'payby' => $self->cust_main->payby, - 'plan' => 'send_agent', - 'plandata' => { 'op' => '~', - 'value' => "(^|\n)agentnum ". - '([0-9]*, )*'. - $self->cust_main->agentnum. - '(, [0-9]*)*'. - "(\n|\$)", - }, - }, - '', - 'ORDER BY seconds LIMIT 1' - ); - - return '' unless $part_bill_event; - - if ( $part_bill_event->plandata =~ /^$option (.*)$/m ) { - return $1; - } else { - warn "can't parse part_bill_event eventpart#". $part_bill_event->eventpart. - " plandata for $option"; - return ''; - } - -} - -=item print_text [ TIME [ , TEMPLATE ] ] - -Returns an text invoice, as a list of lines. - -TIME an optional value used to control the printing of overdue messages. The -default is now. It isn't the date of the invoice; that's the `_date' field. -It is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see -L<Time::Local> and L<Date::Parse> for conversion functions. - -=cut - -#still some false laziness w/_items stuff (and send_csv) -sub print_text { - - my( $self, $today, $template ) = @_; - $today ||= time; - -# my $invnum = $self->invnum; - my $cust_main = $self->cust_main; - $cust_main->payname( $cust_main->first. ' '. $cust_main->getfield('last') ) - unless $cust_main->payname && $cust_main->payby !~ /^(CHEK|DCHK)$/; - - my( $pr_total, @pr_cust_bill ) = $self->previous; #previous balance -# my( $cr_total, @cr_cust_credit ) = $self->cust_credit; #credits - #my $balance_due = $self->owed + $pr_total - $cr_total; - my $balance_due = $self->owed + $pr_total; - - #my @collect = (); - #my($description,$amount); - @buf = (); - - #previous balance - foreach ( @pr_cust_bill ) { - push @buf, [ - "Previous Balance, Invoice #". $_->invnum. - " (". time2str("%x",$_->_date). ")", - $money_char. sprintf("%10.2f",$_->owed) - ]; - } - if (@pr_cust_bill) { - push @buf,['','-----------']; - push @buf,[ 'Total Previous Balance', - $money_char. sprintf("%10.2f",$pr_total ) ]; - push @buf,['','']; - } - - #new charges - foreach my $cust_bill_pkg ( - ( grep { $_->pkgnum } $self->cust_bill_pkg ), #packages first - ( grep { ! $_->pkgnum } $self->cust_bill_pkg ), #then taxes - ) { - - my $desc = $cust_bill_pkg->desc; - - if ( $cust_bill_pkg->pkgnum > 0 ) { - - if ( $cust_bill_pkg->setup != 0 ) { - my $description = $desc; - $description .= ' Setup' if $cust_bill_pkg->recur != 0; - push @buf, [ $description, - $money_char. sprintf("%10.2f", $cust_bill_pkg->setup) ]; - push @buf, - map { [ " ". $_->[0]. ": ". $_->[1], '' ] } - $cust_bill_pkg->cust_pkg->h_labels($self->_date); - } - - if ( $cust_bill_pkg->recur != 0 ) { - push @buf, [ - "$desc (" . time2str("%x", $cust_bill_pkg->sdate) . " - " . - time2str("%x", $cust_bill_pkg->edate) . ")", - $money_char. sprintf("%10.2f", $cust_bill_pkg->recur) - ]; - push @buf, - map { [ " ". $_->[0]. ": ". $_->[1], '' ] } - $cust_bill_pkg->cust_pkg->h_labels( $cust_bill_pkg->edate, - $cust_bill_pkg->sdate ); - } - - push @buf, map { [ " $_", '' ] } $cust_bill_pkg->details; - - } else { #pkgnum tax or one-shot line item - - if ( $cust_bill_pkg->setup != 0 ) { - push @buf, [ $desc, - $money_char. sprintf("%10.2f", $cust_bill_pkg->setup) ]; - } - if ( $cust_bill_pkg->recur != 0 ) { - push @buf, [ "$desc (". time2str("%x", $cust_bill_pkg->sdate). " - " - . time2str("%x", $cust_bill_pkg->edate). ")", - $money_char. sprintf("%10.2f", $cust_bill_pkg->recur) - ]; - } - - } - - } - - push @buf,['','-----------']; - push @buf,['Total New Charges', - $money_char. sprintf("%10.2f",$self->charged) ]; - push @buf,['','']; - - push @buf,['','-----------']; - push @buf,['Total Charges', - $money_char. sprintf("%10.2f",$self->charged + $pr_total) ]; - push @buf,['','']; - - #credits - foreach ( $self->cust_credited ) { - - #something more elaborate if $_->amount ne $_->cust_credit->credited ? - - my $reason = substr($_->cust_credit->reason,0,32); - $reason .= '...' if length($reason) < length($_->cust_credit->reason); - $reason = " ($reason) " if $reason; - push @buf,[ - "Credit #". $_->crednum. " (". time2str("%x",$_->cust_credit->_date) .")". - $reason, - $money_char. sprintf("%10.2f",$_->amount) - ]; - } - #foreach ( @cr_cust_credit ) { - # push @buf,[ - # "Credit #". $_->crednum. " (" . time2str("%x",$_->_date) .")", - # $money_char. sprintf("%10.2f",$_->credited) - # ]; - #} - - #get & print payments - foreach ( $self->cust_bill_pay ) { - - #something more elaborate if $_->amount ne ->cust_pay->paid ? - - push @buf,[ - "Payment received ". time2str("%x",$_->cust_pay->_date ), - $money_char. sprintf("%10.2f",$_->amount ) - ]; - } - - #balance due - my $balance_due_msg = $self->balance_due_msg; - - push @buf,['','-----------']; - push @buf,[$balance_due_msg, $money_char. - sprintf("%10.2f", $balance_due ) ]; - - #create the template - $template ||= $self->_agent_template; - my $templatefile = 'invoice_template'; - $templatefile .= "_$template" if length($template); - my @invoice_template = $conf->config($templatefile) - or die "cannot load config file $templatefile"; - $invoice_lines = 0; - my $wasfunc = 0; - foreach ( grep /invoice_lines\(\d*\)/, @invoice_template ) { #kludgy - /invoice_lines\((\d*)\)/; - $invoice_lines += $1 || scalar(@buf); - $wasfunc=1; - } - die "no invoice_lines() functions in template?" unless $wasfunc; - my $invoice_template = new Text::Template ( - TYPE => 'ARRAY', - SOURCE => [ map "$_\n", @invoice_template ], - ) or die "can't create new Text::Template object: $Text::Template::ERROR"; - $invoice_template->compile() - or die "can't compile template: $Text::Template::ERROR"; - - #setup template variables - package FS::cust_bill::_template; #! - use vars qw( $invnum $date $page $total_pages @address $overdue @buf $agent ); - - $invnum = $self->invnum; - $date = $self->_date; - $page = 1; - $agent = $self->cust_main->agent->agent; - - if ( $FS::cust_bill::invoice_lines ) { - $total_pages = - int( scalar(@FS::cust_bill::buf) / $FS::cust_bill::invoice_lines ); - $total_pages++ - if scalar(@FS::cust_bill::buf) % $FS::cust_bill::invoice_lines; - } else { - $total_pages = 1; - } - - #format address (variable for the template) - my $l = 0; - @address = ( '', '', '', '', '', '' ); - package FS::cust_bill; #! - $FS::cust_bill::_template::address[$l++] = - $cust_main->payname. - ( ( $cust_main->payby eq 'BILL' ) && $cust_main->payinfo - ? " (P.O. #". $cust_main->payinfo. ")" - : '' - ) - ; - $FS::cust_bill::_template::address[$l++] = $cust_main->company - if $cust_main->company; - $FS::cust_bill::_template::address[$l++] = $cust_main->address1; - $FS::cust_bill::_template::address[$l++] = $cust_main->address2 - if $cust_main->address2; - $FS::cust_bill::_template::address[$l++] = - $cust_main->city. ", ". $cust_main->state. " ". $cust_main->zip; - - my $countrydefault = $conf->config('countrydefault') || 'US'; - $FS::cust_bill::_template::address[$l++] = code2country($cust_main->country) - unless $cust_main->country eq $countrydefault; - - # #overdue? (variable for the template) - # $FS::cust_bill::_template::overdue = ( - # $balance_due > 0 - # && $today > $self->_date - ## && $self->printed > 1 - # && $self->printed > 0 - # ); - - #and subroutine for the template - sub FS::cust_bill::_template::invoice_lines { - my $lines = shift || scalar(@buf); - map { - scalar(@buf) ? shift @buf : [ '', '' ]; - } - ( 1 .. $lines ); - } - - #and fill it in - $FS::cust_bill::_template::page = 1; - my $lines; - my @collect; - while (@buf) { - push @collect, split("\n", - $invoice_template->fill_in( PACKAGE => 'FS::cust_bill::_template' ) - ); - $FS::cust_bill::_template::page++; - } - - map "$_\n", @collect; - -} - -=item print_latex [ TIME [ , TEMPLATE ] ] - -Internal method - returns a filename of a filled-in LaTeX template for this -invoice (Note: add ".tex" to get the actual filename). - -See print_ps and print_pdf for methods that return PostScript and PDF output. - -TIME an optional value used to control the printing of overdue messages. The -default is now. It isn't the date of the invoice; that's the `_date' field. -It is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see -L<Time::Local> and L<Date::Parse> for conversion functions. - -=cut - -#still some false laziness w/print_text and print_html (and send_csv) (mostly print_text should use _items stuff though) -sub print_latex { - - my( $self, $today, $template ) = @_; - $today ||= time; - warn "FS::cust_bill::print_latex called on $self with suffix $template\n" - if $DEBUG; - - my $cust_main = $self->cust_main; - $cust_main->payname( $cust_main->first. ' '. $cust_main->getfield('last') ) - unless $cust_main->payname && $cust_main->payby !~ /^(CHEK|DCHK)$/; - - my( $pr_total, @pr_cust_bill ) = $self->previous; #previous balance -# my( $cr_total, @cr_cust_credit ) = $self->cust_credit; #credits - #my $balance_due = $self->owed + $pr_total - $cr_total; - my $balance_due = $self->owed + $pr_total; - - #create the template - $template ||= $self->_agent_template; - my $templatefile = 'invoice_latex'; - my $suffix = length($template) ? "_$template" : ''; - $templatefile .= $suffix; - my @invoice_template = map "$_\n", $conf->config($templatefile) - or die "cannot load config file $templatefile"; - - my($format, $text_template); - if ( grep { /^%%Detail/ } @invoice_template ) { - #change this to a die when the old code is removed - warn "old-style invoice template $templatefile; ". - "patch with conf/invoice_latex.diff or use new conf/invoice_latex*\n"; - $format = 'old'; - } else { - $format = 'Text::Template'; - $text_template = new Text::Template( - TYPE => 'ARRAY', - SOURCE => \@invoice_template, - DELIMITERS => [ '[@--', '--@]' ], - ); - - $text_template->compile() - or die 'While compiling ' . $templatefile . ': ' . $Text::Template::ERROR; - } - - my $returnaddress; - if ( length($conf->config_orbase('invoice_latexreturnaddress', $template)) ) { - $returnaddress = join("\n", - $conf->config_orbase('invoice_latexreturnaddress', $template) - ); - } else { - $returnaddress = '~'; - } - - my %invoice_data = ( - 'invnum' => $self->invnum, - 'date' => time2str('%b %o, %Y', $self->_date), - 'today' => time2str('%b %o, %Y', $today), - 'agent' => _latex_escape($cust_main->agent->agent), - 'payname' => _latex_escape($cust_main->payname), - 'company' => _latex_escape($cust_main->company), - 'address1' => _latex_escape($cust_main->address1), - 'address2' => _latex_escape($cust_main->address2), - 'city' => _latex_escape($cust_main->city), - 'state' => _latex_escape($cust_main->state), - 'zip' => _latex_escape($cust_main->zip), - 'footer' => join("\n", $conf->config_orbase('invoice_latexfooter', $template) ), - 'smallfooter' => join("\n", $conf->config_orbase('invoice_latexsmallfooter', $template) ), - 'returnaddress' => $returnaddress, - 'quantity' => 1, - 'terms' => $conf->config('invoice_default_terms') || 'Payable upon receipt', - #'notes' => join("\n", $conf->config('invoice_latexnotes') ), - 'conf_dir' => "$FS::UID::conf_dir/conf.$FS::UID::datasrc", - ); - - my $countrydefault = $conf->config('countrydefault') || 'US'; - if ( $cust_main->country eq $countrydefault ) { - $invoice_data{'country'} = ''; - } else { - $invoice_data{'country'} = _latex_escape(code2country($cust_main->country)); - } - - $invoice_data{'notes'} = - join("\n", -# #do variable substitutions in notes -# map { my $b=$_; $b =~ s/\$(\w+)/$invoice_data{$1}/eg; $b } - $conf->config_orbase('invoice_latexnotes', $template) - ); - warn "invoice notes: ". $invoice_data{'notes'}. "\n" - if $DEBUG; - - $invoice_data{'footer'} =~ s/\n+$//; - $invoice_data{'smallfooter'} =~ s/\n+$//; - $invoice_data{'notes'} =~ s/\n+$//; - - $invoice_data{'po_line'} = - ( $cust_main->payby eq 'BILL' && $cust_main->payinfo ) - ? _latex_escape("Purchase Order #". $cust_main->payinfo) - : '~'; - - my @filled_in = (); - if ( $format eq 'old' ) { - - my @line_item = (); - my @total_item = (); - while ( @invoice_template ) { - my $line = shift @invoice_template; - - if ( $line =~ /^%%Detail\s*$/ ) { - - while ( ( my $line_item_line = shift @invoice_template ) - !~ /^%%EndDetail\s*$/ ) { - push @line_item, $line_item_line; - } - foreach my $line_item ( $self->_items ) { - #foreach my $line_item ( $self->_items_pkg ) { - $invoice_data{'ref'} = $line_item->{'pkgnum'}; - $invoice_data{'description'} = - _latex_escape($line_item->{'description'}); - if ( exists $line_item->{'ext_description'} ) { - $invoice_data{'description'} .= - "\\tabularnewline\n~~". - join( "\\tabularnewline\n~~", - map _latex_escape($_), @{$line_item->{'ext_description'}} - ); - } - $invoice_data{'amount'} = $line_item->{'amount'}; - $invoice_data{'product_code'} = $line_item->{'pkgpart'} || 'N/A'; - push @filled_in, - map { my $b=$_; $b =~ s/\$(\w+)/$invoice_data{$1}/eg; $b } @line_item; - } - - } elsif ( $line =~ /^%%TotalDetails\s*$/ ) { - - while ( ( my $total_item_line = shift @invoice_template ) - !~ /^%%EndTotalDetails\s*$/ ) { - push @total_item, $total_item_line; - } - - my @total_fill = (); - - my $taxtotal = 0; - foreach my $tax ( $self->_items_tax ) { - $invoice_data{'total_item'} = _latex_escape($tax->{'description'}); - $taxtotal += $tax->{'amount'}; - $invoice_data{'total_amount'} = '\dollar '. $tax->{'amount'}; - push @total_fill, - map { my $b=$_; $b =~ s/\$(\w+)/$invoice_data{$1}/eg; $b } - @total_item; - } - - if ( $taxtotal ) { - $invoice_data{'total_item'} = 'Sub-total'; - $invoice_data{'total_amount'} = - '\dollar '. sprintf('%.2f', $self->charged - $taxtotal ); - unshift @total_fill, - map { my $b=$_; $b =~ s/\$(\w+)/$invoice_data{$1}/eg; $b } - @total_item; - } - - $invoice_data{'total_item'} = '\textbf{Total}'; - $invoice_data{'total_amount'} = - '\textbf{\dollar '. sprintf('%.2f', $self->charged + $pr_total ). '}'; - push @total_fill, - map { my $b=$_; $b =~ s/\$(\w+)/$invoice_data{$1}/eg; $b } - @total_item; - - #foreach my $thing ( sort { $a->_date <=> $b->_date } $self->_items_credits, $self->_items_payments - - # credits - foreach my $credit ( $self->_items_credits ) { - $invoice_data{'total_item'} = _latex_escape($credit->{'description'}); - #$credittotal - $invoice_data{'total_amount'} = '-\dollar '. $credit->{'amount'}; - push @total_fill, - map { my $b=$_; $b =~ s/\$(\w+)/$invoice_data{$1}/eg; $b } - @total_item; - } - - # payments - foreach my $payment ( $self->_items_payments ) { - $invoice_data{'total_item'} = _latex_escape($payment->{'description'}); - #$paymenttotal - $invoice_data{'total_amount'} = '-\dollar '. $payment->{'amount'}; - push @total_fill, - map { my $b=$_; $b =~ s/\$(\w+)/$invoice_data{$1}/eg; $b } - @total_item; - } - - $invoice_data{'total_item'} = '\textbf{'. $self->balance_due_msg. '}'; - $invoice_data{'total_amount'} = - '\textbf{\dollar '. sprintf('%.2f', $self->owed + $pr_total ). '}'; - push @total_fill, - map { my $b=$_; $b =~ s/\$(\w+)/$invoice_data{$1}/eg; $b } - @total_item; - - push @filled_in, @total_fill; - - } else { - #$line =~ s/\$(\w+)/$invoice_data{$1}/eg; - $line =~ s/\$(\w+)/exists($invoice_data{$1}) ? $invoice_data{$1} : nounder($1)/eg; - push @filled_in, $line; - } - - } - - sub nounder { - my $var = $1; - $var =~ s/_/\-/g; - $var; - } - - } elsif ( $format eq 'Text::Template' ) { - - my @detail_items = (); - my @total_items = (); - - $invoice_data{'detail_items'} = \@detail_items; - $invoice_data{'total_items'} = \@total_items; - - foreach my $line_item ( $self->_items ) { - my $detail = { - ext_description => [], - }; - $detail->{'ref'} = $line_item->{'pkgnum'}; - $detail->{'quantity'} = 1; - $detail->{'description'} = _latex_escape($line_item->{'description'}); - if ( exists $line_item->{'ext_description'} ) { - @{$detail->{'ext_description'}} = map { - _latex_escape($_); - } @{$line_item->{'ext_description'}}; - } - $detail->{'amount'} = $line_item->{'amount'}; - $detail->{'product_code'} = $line_item->{'pkgpart'} || 'N/A'; - - push @detail_items, $detail; - } - - - my $taxtotal = 0; - foreach my $tax ( $self->_items_tax ) { - my $total = {}; - $total->{'total_item'} = _latex_escape($tax->{'description'}); - $taxtotal += $tax->{'amount'}; - $total->{'total_amount'} = '\dollar '. $tax->{'amount'}; - push @total_items, $total; - } - - if ( $taxtotal ) { - my $total = {}; - $total->{'total_item'} = 'Sub-total'; - $total->{'total_amount'} = - '\dollar '. sprintf('%.2f', $self->charged - $taxtotal ); - unshift @total_items, $total; - } - - { - my $total = {}; - $total->{'total_item'} = '\textbf{Total}'; - $total->{'total_amount'} = - '\textbf{\dollar '. sprintf('%.2f', $self->charged + $pr_total ). '}'; - push @total_items, $total; - } - - #foreach my $thing ( sort { $a->_date <=> $b->_date } $self->_items_credits, $self->_items_payments - - # credits - foreach my $credit ( $self->_items_credits ) { - my $total; - $total->{'total_item'} = _latex_escape($credit->{'description'}); - #$credittotal - $total->{'total_amount'} = '-\dollar '. $credit->{'amount'}; - push @total_items, $total; - } - - # payments - foreach my $payment ( $self->_items_payments ) { - my $total = {}; - $total->{'total_item'} = _latex_escape($payment->{'description'}); - #$paymenttotal - $total->{'total_amount'} = '-\dollar '. $payment->{'amount'}; - push @total_items, $total; - } - - { - my $total; - $total->{'total_item'} = '\textbf{'. $self->balance_due_msg. '}'; - $total->{'total_amount'} = - '\textbf{\dollar '. sprintf('%.2f', $self->owed + $pr_total ). '}'; - push @total_items, $total; - } - - } else { - die "guru meditation #54"; - } - - my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; - my $fh = new File::Temp( TEMPLATE => 'invoice.'. $self->invnum. '.XXXXXXXX', - DIR => $dir, - SUFFIX => '.tex', - UNLINK => 0, - ) or die "can't open temp file: $!\n"; - if ( $format eq 'old' ) { - print $fh join('', @filled_in ); - } elsif ( $format eq 'Text::Template' ) { - $text_template->fill_in(OUTPUT => $fh, HASH => \%invoice_data); - } else { - die "guru meditation #32"; - } - close $fh; - - $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename; - return $1; - -} - -=item print_ps [ TIME [ , TEMPLATE ] ] - -Returns an postscript invoice, as a scalar. - -TIME an optional value used to control the printing of overdue messages. The -default is now. It isn't the date of the invoice; that's the `_date' field. -It is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see -L<Time::Local> and L<Date::Parse> for conversion functions. - -=cut - -sub print_ps { - my $self = shift; - - my $file = $self->print_latex(@_); - - my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; - chdir($dir); - - my $sfile = shell_quote $file; - - system("pslatex $sfile.tex >/dev/null 2>&1") == 0 - or die "pslatex $file.tex failed; see $file.log for details?\n"; - system("pslatex $sfile.tex >/dev/null 2>&1") == 0 - or die "pslatex $file.tex failed; see $file.log for details?\n"; - - system('dvips', '-q', '-t', 'letter', "$file.dvi", '-o', "$file.ps" ) == 0 - or die "dvips failed"; - - open(POSTSCRIPT, "<$file.ps") - or die "can't open $file.ps: $! (error in LaTeX template?)\n"; - - unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps", "$file.tex"); - - my $ps = ''; - while (<POSTSCRIPT>) { - $ps .= $_; - } - - close POSTSCRIPT; - - return $ps; - -} - -=item print_pdf [ TIME [ , TEMPLATE ] ] - -Returns an PDF invoice, as a scalar. - -TIME an optional value used to control the printing of overdue messages. The -default is now. It isn't the date of the invoice; that's the `_date' field. -It is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see -L<Time::Local> and L<Date::Parse> for conversion functions. - -=cut - -sub print_pdf { - my $self = shift; - - my $file = $self->print_latex(@_); - - my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; - chdir($dir); - - #system('pdflatex', "$file.tex"); - #system('pdflatex', "$file.tex"); - #! LaTeX Error: Unknown graphics extension: .eps. - - my $sfile = shell_quote $file; - - system("pslatex $sfile.tex >/dev/null 2>&1") == 0 - or die "pslatex $file.tex failed; see $file.log for details?\n"; - system("pslatex $sfile.tex >/dev/null 2>&1") == 0 - or die "pslatex $file.tex failed; see $file.log for details?\n"; - - #system('dvipdf', "$file.dvi", "$file.pdf" ); - system( - "dvips -q -t letter -f $sfile.dvi ". - "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ". - " -c save pop -" - ) == 0 - or die "dvips | gs failed: $!"; - - open(PDF, "<$file.pdf") - or die "can't open $file.pdf: $! (error in LaTeX template?)\n"; - - unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex"); - - my $pdf = ''; - while (<PDF>) { - $pdf .= $_; - } - - close PDF; - - return $pdf; - -} - -=item print_html [ TIME [ , TEMPLATE [ , CID ] ] ] - -Returns an HTML invoice, as a scalar. - -TIME an optional value used to control the printing of overdue messages. The -default is now. It isn't the date of the invoice; that's the `_date' field. -It is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see -L<Time::Local> and L<Date::Parse> for conversion functions. - -CID is a MIME Content-ID used to create a "cid:" URL for the logo image, used -when emailing the invoice as part of a multipart/related MIME email. - -=cut - -#some falze laziness w/print_text and print_latex (and send_csv) -sub print_html { - my( $self, $today, $template, $cid ) = @_; - $today ||= time; - - my $cust_main = $self->cust_main; - $cust_main->payname( $cust_main->first. ' '. $cust_main->getfield('last') ) - unless $cust_main->payname && $cust_main->payby !~ /^(CHEK|DCHK)$/; - - $template ||= $self->_agent_template; - my $templatefile = 'invoice_html'; - my $suffix = length($template) ? "_$template" : ''; - $templatefile .= $suffix; - my @html_template = map "$_\n", $conf->config($templatefile) - or die "cannot load config file $templatefile"; - - my $html_template = new Text::Template( - TYPE => 'ARRAY', - SOURCE => \@html_template, - DELIMITERS => [ '<%=', '%>' ], - ); - - $html_template->compile() - or die 'While compiling ' . $templatefile . ': ' . $Text::Template::ERROR; - - my %invoice_data = ( - 'invnum' => $self->invnum, - 'date' => time2str('%b %o, %Y', $self->_date), - 'today' => time2str('%b %o, %Y', $today), - 'agent' => encode_entities($cust_main->agent->agent), - 'payname' => encode_entities($cust_main->payname), - 'company' => encode_entities($cust_main->company), - 'address1' => encode_entities($cust_main->address1), - 'address2' => encode_entities($cust_main->address2), - 'city' => encode_entities($cust_main->city), - 'state' => encode_entities($cust_main->state), - 'zip' => encode_entities($cust_main->zip), - 'terms' => $conf->config('invoice_default_terms') - || 'Payable upon receipt', - 'cid' => $cid, - 'template' => $template, -# 'conf_dir' => "$FS::UID::conf_dir/conf.$FS::UID::datasrc", - ); - - if ( - defined( $conf->config_orbase('invoice_htmlreturnaddress', $template) ) - && length( $conf->config_orbase('invoice_htmlreturnaddress', $template) ) - ) { - $invoice_data{'returnaddress'} = - join("\n", $conf->config('invoice_htmlreturnaddress', $template) ); - } else { - $invoice_data{'returnaddress'} = - join("\n", map { - s/~/ /g; - s/\\\\\*?\s*$/<BR>/; - s/\\hyphenation\{[\w\s\-]+\}//; - $_; - } - $conf->config_orbase( 'invoice_latexreturnaddress', - $template - ) - ); - } - - my $countrydefault = $conf->config('countrydefault') || 'US'; - if ( $cust_main->country eq $countrydefault ) { - $invoice_data{'country'} = ''; - } else { - $invoice_data{'country'} = - encode_entities(code2country($cust_main->country)); - } - - if ( - defined( $conf->config_orbase('invoice_htmlnotes', $template) ) - && length( $conf->config_orbase('invoice_htmlnotes', $template) ) - ) { - $invoice_data{'notes'} = - join("\n", $conf->config_orbase('invoice_htmlnotes', $template) ); - } else { - $invoice_data{'notes'} = - join("\n", map { - s/%%(.*)$/<!-- $1 -->/; - s/\\section\*\{\\textsc\{(.)(.*)\}\}/<p><b><font size="+1">$1<\/font>\U$2<\/b>/; - s/\\begin\{enumerate\}/<ol>/; - s/\\item / <li>/; - s/\\end\{enumerate\}/<\/ol>/; - s/\\textbf\{(.*)\}/<b>$1<\/b>/; - $_; - } - $conf->config_orbase('invoice_latexnotes', $template) - ); - } - -# #do variable substitutions in notes -# $invoice_data{'notes'} = -# join("\n", -# map { my $b=$_; $b =~ s/\$(\w+)/$invoice_data{$1}/eg; $b } -# $conf->config_orbase('invoice_latexnotes', $suffix) -# ); - - if ( - defined( $conf->config_orbase('invoice_htmlfooter', $template) ) - && length( $conf->config_orbase('invoice_htmlfooter', $template) ) - ) { - $invoice_data{'footer'} = - join("\n", $conf->config_orbase('invoice_htmlfooter', $template) ); - } else { - $invoice_data{'footer'} = - join("\n", map { s/~/ /g; s/\\\\\*?\s*$/<BR>/; $_; } - $conf->config_orbase('invoice_latexfooter', $template) - ); - } - - $invoice_data{'po_line'} = - ( $cust_main->payby eq 'BILL' && $cust_main->payinfo ) - ? encode_entities("Purchase Order #". $cust_main->payinfo) - : ''; - - my $money_char = $conf->config('money_char') || '$'; - - foreach my $line_item ( $self->_items ) { - my $detail = { - ext_description => [], - }; - $detail->{'ref'} = $line_item->{'pkgnum'}; - $detail->{'description'} = encode_entities($line_item->{'description'}); - if ( exists $line_item->{'ext_description'} ) { - @{$detail->{'ext_description'}} = map { - encode_entities($_); - } @{$line_item->{'ext_description'}}; - } - $detail->{'amount'} = $money_char. $line_item->{'amount'}; - $detail->{'product_code'} = $line_item->{'pkgpart'} || 'N/A'; - - push @{$invoice_data{'detail_items'}}, $detail; - } - - - my $taxtotal = 0; - foreach my $tax ( $self->_items_tax ) { - my $total = {}; - $total->{'total_item'} = encode_entities($tax->{'description'}); - $taxtotal += $tax->{'amount'}; - $total->{'total_amount'} = $money_char. $tax->{'amount'}; - push @{$invoice_data{'total_items'}}, $total; - } - - if ( $taxtotal ) { - my $total = {}; - $total->{'total_item'} = 'Sub-total'; - $total->{'total_amount'} = - $money_char. sprintf('%.2f', $self->charged - $taxtotal ); - unshift @{$invoice_data{'total_items'}}, $total; - } - - my( $pr_total, @pr_cust_bill ) = $self->previous; #previous balance - { - my $total = {}; - $total->{'total_item'} = '<b>Total</b>'; - $total->{'total_amount'} = - "<b>$money_char". sprintf('%.2f', $self->charged + $pr_total ). '</b>'; - push @{$invoice_data{'total_items'}}, $total; - } - - #foreach my $thing ( sort { $a->_date <=> $b->_date } $self->_items_credits, $self->_items_payments - - # credits - foreach my $credit ( $self->_items_credits ) { - my $total; - $total->{'total_item'} = encode_entities($credit->{'description'}); - #$credittotal - $total->{'total_amount'} = "-$money_char". $credit->{'amount'}; - push @{$invoice_data{'total_items'}}, $total; - } - - # payments - foreach my $payment ( $self->_items_payments ) { - my $total = {}; - $total->{'total_item'} = encode_entities($payment->{'description'}); - #$paymenttotal - $total->{'total_amount'} = "-$money_char". $payment->{'amount'}; - push @{$invoice_data{'total_items'}}, $total; - } - - { - my $total; - $total->{'total_item'} = '<b>'. $self->balance_due_msg. '</b>'; - $total->{'total_amount'} = - "<b>$money_char". sprintf('%.2f', $self->owed + $pr_total ). '</b>'; - push @{$invoice_data{'total_items'}}, $total; - } - - $html_template->fill_in( HASH => \%invoice_data); -} - -# quick subroutine for print_latex -# -# There are ten characters that LaTeX treats as special characters, which -# means that they do not simply typeset themselves: -# # $ % & ~ _ ^ \ { } -# -# TeX ignores blanks following an escaped character; if you want a blank (as -# in "10% of ..."), you have to "escape" the blank as well ("10\%\ of ..."). - -sub _latex_escape { - my $value = shift; - $value =~ s/([#\$%&~_\^{}])( )?/"\\$1". ( ( defined($2) && length($2) ) ? "\\$2" : '' )/ge; - $value =~ s/([<>])/\$$1\$/g; - $value; -} - -#utility methods for print_* - -sub balance_due_msg { - my $self = shift; - my $msg = 'Balance Due'; - return $msg unless $conf->exists('invoice_default_terms'); - if ( $conf->config('invoice_default_terms') =~ /^\s*Net\s*(\d+)\s*$/ ) { - $msg .= ' - Please pay by '. time2str("%x", $self->_date + ($1*86400) ); - } elsif ( $conf->config('invoice_default_terms') ) { - $msg .= ' - '. $conf->config('invoice_default_terms'); - } - $msg; -} - -sub _items { - my $self = shift; - my @display = scalar(@_) - ? @_ - : qw( _items_previous _items_pkg ); - #: qw( _items_pkg ); - #: qw( _items_previous _items_pkg _items_tax _items_credits _items_payments ); - my @b = (); - foreach my $display ( @display ) { - push @b, $self->$display(@_); - } - @b; -} - -sub _items_previous { - my $self = shift; - my $cust_main = $self->cust_main; - my( $pr_total, @pr_cust_bill ) = $self->previous; #previous balance - my @b = (); - foreach ( @pr_cust_bill ) { - push @b, { - 'description' => 'Previous Balance, Invoice #'. $_->invnum. - ' ('. time2str('%x',$_->_date). ')', - #'pkgpart' => 'N/A', - 'pkgnum' => 'N/A', - 'amount' => sprintf("%.2f", $_->owed), - }; - } - @b; - - #{ - # 'description' => 'Previous Balance', - # #'pkgpart' => 'N/A', - # 'pkgnum' => 'N/A', - # 'amount' => sprintf("%10.2f", $pr_total ), - # 'ext_description' => [ map { - # "Invoice ". $_->invnum. - # " (". time2str("%x",$_->_date). ") ". - # sprintf("%10.2f", $_->owed) - # } @pr_cust_bill ], - - #}; -} - -sub _items_pkg { - my $self = shift; - my @cust_bill_pkg = grep { $_->pkgnum } $self->cust_bill_pkg; - $self->_items_cust_bill_pkg(\@cust_bill_pkg, @_); -} - -sub _items_tax { - my $self = shift; - my @cust_bill_pkg = grep { ! $_->pkgnum } $self->cust_bill_pkg; - $self->_items_cust_bill_pkg(\@cust_bill_pkg, @_); -} - -sub _items_cust_bill_pkg { - my $self = shift; - my $cust_bill_pkg = shift; - - my @b = (); - foreach my $cust_bill_pkg ( @$cust_bill_pkg ) { - - my $desc = $cust_bill_pkg->desc; - - if ( $cust_bill_pkg->pkgnum > 0 ) { - - if ( $cust_bill_pkg->setup != 0 ) { - my $description = $desc; - $description .= ' Setup' if $cust_bill_pkg->recur != 0; - my @d = $cust_bill_pkg->cust_pkg->h_labels_short($self->_date); - push @d, $cust_bill_pkg->details if $cust_bill_pkg->recur == 0; - push @b, { - description => $description, - #pkgpart => $part_pkg->pkgpart, - pkgnum => $cust_bill_pkg->pkgnum, - amount => sprintf("%.2f", $cust_bill_pkg->setup), - ext_description => \@d, - }; - } - - if ( $cust_bill_pkg->recur != 0 ) { - push @b, { - description => "$desc (" . - time2str('%x', $cust_bill_pkg->sdate). ' - '. - time2str('%x', $cust_bill_pkg->edate). ')', - #pkgpart => $part_pkg->pkgpart, - pkgnum => $cust_bill_pkg->pkgnum, - amount => sprintf("%.2f", $cust_bill_pkg->recur), - ext_description => - [ $cust_bill_pkg->cust_pkg->h_labels_short( $cust_bill_pkg->edate, - $cust_bill_pkg->sdate), - $cust_bill_pkg->details, - ], - }; - } - - } else { #pkgnum tax or one-shot line item (??) - - if ( $cust_bill_pkg->setup != 0 ) { - push @b, { - 'description' => $desc, - 'amount' => sprintf("%.2f", $cust_bill_pkg->setup), - }; - } - if ( $cust_bill_pkg->recur != 0 ) { - push @b, { - 'description' => "$desc (". - time2str("%x", $cust_bill_pkg->sdate). ' - '. - time2str("%x", $cust_bill_pkg->edate). ')', - 'amount' => sprintf("%.2f", $cust_bill_pkg->recur), - }; - } - - } - - } - - @b; - -} - -sub _items_credits { - my $self = shift; - - my @b; - #credits - foreach ( $self->cust_credited ) { - - #something more elaborate if $_->amount ne $_->cust_credit->credited ? - - my $reason = $_->cust_credit->reason; - #my $reason = substr($_->cust_credit->reason,0,32); - #$reason .= '...' if length($reason) < length($_->cust_credit->reason); - $reason = " ($reason) " if $reason; - push @b, { - #'description' => 'Credit ref\#'. $_->crednum. - # " (". time2str("%x",$_->cust_credit->_date) .")". - # $reason, - 'description' => 'Credit applied '. - time2str("%x",$_->cust_credit->_date). $reason, - 'amount' => sprintf("%.2f",$_->amount), - }; - } - #foreach ( @cr_cust_credit ) { - # push @buf,[ - # "Credit #". $_->crednum. " (" . time2str("%x",$_->_date) .")", - # $money_char. sprintf("%10.2f",$_->credited) - # ]; - #} - - @b; - -} - -sub _items_payments { - my $self = shift; - - my @b; - #get & print payments - foreach ( $self->cust_bill_pay ) { - - #something more elaborate if $_->amount ne ->cust_pay->paid ? - - push @b, { - 'description' => "Payment received ". - time2str("%x",$_->cust_pay->_date ), - 'amount' => sprintf("%.2f", $_->amount ) - }; - } - - @b; - -} - - -=back - -=head1 SUBROUTINES - -=over 4 - -=item reprint - -=cut - -sub process_reprint { - process_re_X('print', @_); -} - -=item reemail - -=cut - -sub process_reemail { - process_re_X('email', @_); -} - -=item refax - -=cut - -sub process_refax { - process_re_X('fax', @_); -} - -use Storable qw(thaw); -use Data::Dumper; -use MIME::Base64; -sub process_re_X { - my( $method, $job ) = ( shift, shift ); - warn "process_re_X $method for job $job\n" if $DEBUG; - - my $param = thaw(decode_base64(shift)); - warn Dumper($param) if $DEBUG; - - re_X( - $method, - $job, - %$param, - ); - -} - -sub re_X { - my($method, $job, %param ) = @_; -# [ 'begin', 'end', 'agentnum', 'open', 'days', 'newest_percust' ], - if ( $DEBUG ) { - warn "re_X $method for job $job with param:\n". - join( '', map { " $_ => ". $param{$_}. "\n" } keys %param ); - } - - #some false laziness w/search/cust_bill.html - my $distinct = ''; - my $orderby = 'ORDER BY cust_bill._date'; - - my @where; - - if ( $param{'begin'} =~ /^(\d+)$/ ) { - push @where, "cust_bill._date >= $1"; - } - if ( $param{'end'} =~ /^(\d+)$/ ) { - push @where, "cust_bill._date < $1"; - } - if ( $param{'agentnum'} =~ /^(\d+)$/ ) { - push @where, "cust_main.agentnum = $1"; - } - - my $owed = - "charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay - WHERE cust_bill_pay.invnum = cust_bill.invnum ) - - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill - WHERE cust_credit_bill.invnum = cust_bill.invnum )"; - - push @where, "0 != $owed" - if $param{'open'}; - - push @where, "cust_bill._date < ". (time-86400*$param{'days'}) - if $param{'days'}; - - my $extra_sql = scalar(@where) ? 'WHERE '. join(' AND ', @where) : ''; - - my $addl_from = 'left join cust_main using ( custnum )'; - - if ( $param{'newest_percust'} ) { - $distinct = 'DISTINCT ON ( cust_bill.custnum )'; - $orderby = 'ORDER BY cust_bill.custnum ASC, cust_bill._date DESC'; - #$count_query = "SELECT COUNT(DISTINCT cust_bill.custnum), 'N/A', 'N/A'"; - } - - my @cust_bill = qsearch( 'cust_bill', - {}, - "$distinct cust_bill.*", - $extra_sql, - '', - $addl_from - ); - - my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo - foreach my $cust_bill ( @cust_bill ) { - $cust_bill->$method(); - - if ( $job ) { #progressbar foo - $num++; - if ( time - $min_sec > $last ) { - my $error = $job->update_statustext( - int( 100 * $num / scalar(@cust_bill) ) - ); - die $error if $error; - $last = time; - } - } - - } - -} - -=back - -=head1 BUGS - -The delete method. - -print_text formatting (and some logic :/) is in source, but needs to be -slurped in from a file. Also number of lines ($=). - -=head1 SEE ALSO - -L<FS::Record>, L<FS::cust_main>, L<FS::cust_bill_pay>, L<FS::cust_pay>, -L<FS::cust_bill_pkg>, L<FS::cust_bill_credit>, schema.html from the base -documentation. - -=cut - -1; - diff --git a/FS/FS/cust_bill_ApplicationCommon.pm b/FS/FS/cust_bill_ApplicationCommon.pm deleted file mode 100644 index fb06a4b..0000000 --- a/FS/FS/cust_bill_ApplicationCommon.pm +++ /dev/null @@ -1,243 +0,0 @@ -package FS::cust_bill_ApplicationCommon; - -use strict; -use vars qw( @ISA $DEBUG ); -use FS::Schema qw( dbdef ); -use FS::Record qw( qsearch qsearchs dbh ); - -@ISA = qw( FS::Record ); - -$DEBUG = 1; - -=head1 NAME - -FS::cust_bill_ApplicationCommon - Base class for bill application classes - -=head1 SYNOPSIS - -use FS::cust_bill_ApplicationCommon; - -@ISA = qw( FS::cust_bill_ApplicationCommon ); - -sub _app_source_name { 'payment'; } -sub _app_source_table { 'cust_pay'; } -sub _app_lineitem_breakdown_table { 'cust_bill_pay_pkg'; } - -=head1 DESCRIPTION - -FS::cust_bill_ApplicationCommon is intended as a base class for classes which -represent application of things to invoices, currently payments -(see L<FS::cust_bill_pay>) or credits (see L<FS::cust_credit_bill>). - -=head1 METHODS - -=item insert - -=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(@_) - || $self->apply_to_lineitems; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; - -} - -=item delete - -=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; - - foreach my $app ( $self->lineitem_applications ) { - my $error = $app->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 apply_to_lineitems - -Auto-applies this invoice application to specific line items, if possible. - -=cut - -sub apply_to_lineitems { - my $self = shift; - - my @apply = (); - - 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 @open = $self->cust_bill->open_cust_bill_pkg; #FOR UPDATE...? - warn scalar(@open). " open line items for invoice ". - $self->cust_bill->invnum. "\n" - if $DEBUG; - my $total = 0; - $total += $_->setup + $_->recur foreach @open; - $total = sprintf('%.2f', $total); - - if ( $self->amount > $total ) { - dbh->rollback if $oldAutoCommit; - return "Can't apply a ". $self->_app_source_name. ' of $'. $self->amount. - " greater than the remaining owed on line items (\$$total)"; - } - - #easy cases: - # - one lineitem (a simple special case of:) - # - amount is for whole invoice (well, all of remaining lineitem links) - if ( $self->amount == $total ) { - - #@apply = map { [ $_, $_->amount ]; } @open; - @apply = map { [ $_, $_->setup || $_->recur ]; } @open; - - } else { - - #slightly magic case: - # - amount exactly and uniquely matches a single open lineitem - # (you must be trying to pay or credit that item, then) - - my @same = grep { $_->setup == $self->amount - || $_->recur == $self->amount - } - @open; - @apply = map { [ $_, $self->amount ]; } @same - if scalar(@same) == 1; - - } - - #and the rest: - # - leave unapplied, for now - # - eventually, auto-apply? sequentially? pro-rated against total remaining? - - # do the applicaiton(s) - my $table = $self->lineitem_breakdown_table; - my $source_key = dbdef->table($self->table)->primary_key; - foreach my $apply ( @apply ) { - my ( $cust_bill_pkg, $amount ) = @$apply; - my $application = "FS::$table"->new( { - $source_key => $self->$source_key(), - 'billpkgnum' => $cust_bill_pkg->billpkgnum, - 'amount' => $amount, - 'setuprecur' => ( $cust_bill_pkg->setup > 0 ? 'setup' : 'recur' ), - }); - my $error = $application->insert; - if ( $error ) { - dbh->rollbck if $oldAutoCommit; - return $error; - } - } - - ''; - -} - -=item lineitem_applications - -Returns all the specific line item applications for this invoice application. - -=cut - -sub lineitem_applications { - my $self = shift; - my $primary_key = dbdef->table($self->table)->primary_key; - qsearchs({ - 'table' => $self->lineitem_breakdown_table, - 'hashref' => { $primary_key => $self->$primary_key() }, - }); - -} - -=item cust_bill - -Returns the invoice (see L<FS::cust_bill>) - -=cut - -sub cust_bill { - my $self = shift; - qsearchs( 'cust_bill', { 'invnum' => $self->invnum } ); -} - -=item lineitem_breakdown_table - -=cut - -sub lineitem_breakdown_table { - my $self = shift; - $self->_load_table($self->_app_lineitem_breakdown_table); -} - -sub _load_table { - my( $self, $table ) = @_; - eval "use FS::$table"; - die $@ if $@; - $table; -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::cust_bill_pay> and L<FS::cust_bill_pay_pkg>, -L<FS::cust_credit_bill> and L<FS::cust_credit_bill_pkg> - -=cut - -1; - diff --git a/FS/FS/cust_bill_event.pm b/FS/FS/cust_bill_event.pm deleted file mode 100644 index 128e5a5..0000000 --- a/FS/FS/cust_bill_event.pm +++ /dev/null @@ -1,282 +0,0 @@ -package FS::cust_bill_event; - -use strict; -use vars qw( @ISA $DEBUG ); -use FS::Record qw( qsearch qsearchs ); -use FS::cust_main_Mixin; -use FS::cust_bill; -use FS::part_bill_event; - -@ISA = qw(FS::cust_main_Mixin FS::Record); - -$DEBUG = 0; - -=head1 NAME - -FS::cust_bill_event - Object methods for cust_bill_event records - -=head1 SYNOPSIS - - use FS::cust_bill_event; - - $record = new FS::cust_bill_event \%hash; - $record = new FS::cust_bill_event { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::cust_bill_event object represents an complete invoice event. -FS::cust_bill_event inherits from FS::Record. The following fields are -currently supported: - -=over 4 - -=item eventnum - primary key - -=item invnum - invoice (see L<FS::cust_bill>) - -=item eventpart - event definition (see L<FS::part_bill_event>) - -=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see -L<Time::Local> and L<Date::Parse> for conversion functions. - -=item status - event status: B<done> or B<failed> - -=item statustext - additional status detail (i.e. error message) - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new completed invoice event. To add the compelted invoice event to -the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'cust_bill_event'; } - -sub cust_linked { $_[0]->cust_main_custnum; } -sub cust_unlinked_msg { - my $self = shift; - "WARNING: can't find cust_main.custnum ". $self->custnum. - ' (cust_bill.invnum '. $self->invnum. ')'; -} - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=cut - -# the insert method can be inherited from FS::Record - -=item delete - -Delete this record from the database. - -=cut - -# the delete method can be inherited from FS::Record - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -# the replace method can be inherited from FS::Record - -=item check - -Checks all fields to make sure this is a valid completed invoice event. If -there is an error, returns the error, otherwise returns false. Called by the -insert and replace methods. - -=cut - -# the check method should currently be supplied - FS::Record contains some -# data checking routines - -sub check { - my $self = shift; - - my $error = $self->ut_numbern('eventnum') - || $self->ut_number('invnum') - || $self->ut_number('eventpart') - || $self->ut_number('_date') - || $self->ut_enum('status', [qw( done failed )]) - || $self->ut_textn('statustext') - ; - - return "Unknown invnum ". $self->invnum - unless qsearchs( 'cust_bill' ,{ 'invnum' => $self->invnum } ); - - return "Unknown eventpart ". $self->eventpart - unless qsearchs( 'part_bill_event' ,{ 'eventpart' => $self->eventpart } ); - - $self->SUPER::check; -} - -=item part_bill_event - -Returns the invoice event definition (see L<FS::part_bill_event>) for this -completed invoice event. - -=cut - -sub part_bill_event { - my $self = shift; - qsearchs( 'part_bill_event', { 'eventpart' => $self->eventpart } ); -} - -=item cust_bill - -Returns the invoice (see L<FS::cust_bill>) for this completed invoice event. - -=cut - -sub cust_bill { - my $self = shift; - qsearchs( 'cust_bill', { 'invnum' => $self->invnum } ); -} - -=item retry - -Changes the status of this event from B<done> to B<failed>, allowing it to be -retried. - -=cut - -sub retry { - my $self = shift; - return '' unless $self->status eq 'done'; - my $old = ref($self)->new( { $self->hash } ); - $self->status('failed'); - $self->replace($old); -} - -=back - -=head1 SUBROUTINES - -=over 4 - -=item reprint - -=cut - -sub process_reprint { - process_re_X('print', @_); -} - -=item reemail - -=cut - -sub process_reemail { - process_re_X('email', @_); -} - -=item refax - -=cut - -sub process_refax { - process_re_X('fax', @_); -} - -use Storable qw(thaw); -use Data::Dumper; -use MIME::Base64; -sub process_re_X { - my( $method, $job ) = ( shift, shift ); - - my $param = thaw(decode_base64(shift)); - warn Dumper($param) if $DEBUG; - - re_X( - $method, - $param->{'beginning'}, - $param->{'ending'}, - $param->{'failed'}, - $job, - ); - -} - -sub re_X { - my($method, $beginning, $ending, $failed, $job) = @_; - - my $where = " WHERE plan LIKE 'send%'". - " AND cust_bill_event._date >= $beginning". - " AND cust_bill_event._date <= $ending"; - $where .= " AND statustext != '' AND statustext IS NOT NULL" - if $failed; - - my $from = 'LEFT JOIN part_bill_event USING ( eventpart )'; - - my @cust_bill_event = qsearch( 'cust_bill_event', {}, '', $where, '', $from ); - - my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo - foreach my $cust_bill_event ( @cust_bill_event ) { - - $cust_bill_event->cust_bill->$method( - $cust_bill_event->part_bill_event->templatename - ); - - if ( $job ) { #progressbar foo - $num++; - if ( time - $min_sec > $last ) { - my $error = $job->update_statustext( - int( 100 * $num / scalar(@cust_bill_event) ) - ); - die $error if $error; - $last = time; - } - } - - } - - #this doesn't work, but it would be nice - #if ( $job ) { #progressbar foo - # my $error = $job->update_statustext( - # scalar(@cust_bill_event). " invoices re-${method}ed" - # ); - # die $error if $error; - #} - -} - -=back - -=head1 BUGS - -Far too early in the morning. - -=head1 SEE ALSO - -L<FS::part_bill_event>, L<FS::cust_bill>, L<FS::Record>, schema.html from the -base documentation. - -=cut - -1; - diff --git a/FS/FS/cust_bill_pay.pm b/FS/FS/cust_bill_pay.pm deleted file mode 100644 index 67f8eaf..0000000 --- a/FS/FS/cust_bill_pay.pm +++ /dev/null @@ -1,163 +0,0 @@ -package FS::cust_bill_pay; - -use strict; -use vars qw( @ISA $conf ); -use FS::Record qw( qsearchs ); -use FS::cust_bill_ApplicationCommon; -use FS::cust_bill; -use FS::cust_pay; - -@ISA = qw( FS::cust_bill_ApplicationCommon ); - -#ask FS::UID to run this stuff for us later -FS::UID->install_callback( sub { - $conf = new FS::Conf; -} ); - -=head1 NAME - -FS::cust_bill_pay - Object methods for cust_bill_pay records - -=head1 SYNOPSIS - - use FS::cust_bill_pay; - - $record = new FS::cust_bill_pay \%hash; - $record = new FS::cust_bill_pay { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::cust_bill_pay object represents the application of a payment to a -specific invoice. FS::cust_bill_pay inherits from -FS::cust_bill_ApplicationCommon and FS::Record. The following fields are -currently supported: - -=over 4 - -=item billpaynum - primary key (assigned automatically) - -=item invnum - Invoice (see L<FS::cust_bill>) - -=item paynum - Payment (see L<FS::cust_pay>) - -=item amount - Amount of the payment to apply to the specific invoice. - -=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see -L<Time::Local> and L<Date::Parse> for conversion functions. - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new record. To add the record to the database, see L<"insert">. - -=cut - -sub table { 'cust_bill_pay'; } - -sub _app_source_name { 'payment'; } -sub _app_source_table { 'cust_pay'; } -sub _app_lineitem_breakdown_table { 'cust_bill_pay_pkg'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=item delete - -Deletes this payment application, unless the closed flag for the parent payment -(see L<FS::cust_pay>) is set. - -=cut - -sub delete { - my $self = shift; - return "Can't delete application for closed payment" - if $self->cust_pay->closed =~ /^Y/i; - return "Can't delete application for closed invoice" - if $self->cust_bill->closed =~ /^Y/i; - $self->SUPER::delete(@_); -} - -=item replace OLD_RECORD - -Currently unimplemented (accounting reasons). - -=cut - -sub replace { - return "Can't modify application of payment!"; -} - -=item check - -Checks all fields to make sure this is a valid payment application. 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('billpaynum') - || $self->ut_foreign_key('paynum', 'cust_pay', 'paynum' ) - || $self->ut_foreign_key('invnum', 'cust_bill', 'invnum' ) - || $self->ut_numbern('_date') - || $self->ut_money('amount') - ; - return $error if $error; - - return "amount must be > 0" if $self->amount <= 0; - - $self->_date(time) unless $self->_date; - - return "Cannot apply more than remaining value of invoice" - unless $self->amount <= $self->cust_bill->owed; - - return "Cannot apply more than remaining value of payment" - unless $self->amount <= $self->cust_pay->unapplied; - - $self->SUPER::check; -} - -=item cust_pay - -Returns the payment (see L<FS::cust_pay>) - -=cut - -sub cust_pay { - my $self = shift; - qsearchs( 'cust_pay', { 'paynum' => $self->paynum } ); -} - -=back - -=head1 BUGS - -Delete and replace methods. - -=head1 SEE ALSO - -L<FS::cust_pay>, L<FS::cust_bill>, L<FS::Record>, schema.html from the -base documentation. - -=cut - -1; - diff --git a/FS/FS/cust_bill_pay_pkg.pm b/FS/FS/cust_bill_pay_pkg.pm deleted file mode 100644 index af331cd..0000000 --- a/FS/FS/cust_bill_pay_pkg.pm +++ /dev/null @@ -1,132 +0,0 @@ -package FS::cust_bill_pay_pkg; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::cust_bill_pay_pkg - Object methods for cust_bill_pay_pkg records - -=head1 SYNOPSIS - - use FS::cust_bill_pay_pkg; - - $record = new FS::cust_bill_pay_pkg \%hash; - $record = new FS::cust_bill_pay_pkg { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::cust_bill_pay_pkg object represents application of a payment (see -L<FS::cust_bill_pay>) to a specific line item within an invoice (see -L<FS::cust_bill_pkg>). FS::cust_bill_pay_pkg inherits from FS::Record. The -following fields are currently supported: - -=over 4 - -=item billpaypkgnum - primary key - -=item billpaynum - Payment application to the overall invoice (see L<FS::cust_bill_pay>) - -=item billpkgnum - Line item to which payment is applied (see L<FS::cust_bill_pkg>) - -=item amount - Amount of the payment applied to this line item. - -=item setuprecur - 'setup' or 'recur', designates whether the payment was applied to the setup or recurring portion of the line item. - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new record. To add the record to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'cust_bill_pay_pkg'; } - -=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 payment application. 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('billpaypkgnum') - || $self->ut_foreign_key('billpaynum', 'cust_bill_pay', 'billpaynum' ) - || $self->ut_foreign_key('billpkgnum', 'cust_bill_pkg', 'billpkgnum' ) - || $self->ut_money('amount') - || $self->ut_enum('setuprecur', [ 'setup', 'recur' ] ) - ; - return $error if $error; - - $self->SUPER::check; -} - -=back - -=head1 BUGS - -B<setuprecur> field is a kludge to compensate for cust_bill_pkg having separate -setup and recur fields. It should be removed once that's fixed. - -=head1 SEE ALSO - -L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/cust_bill_pkg.pm b/FS/FS/cust_bill_pkg.pm deleted file mode 100644 index e41a3c5..0000000 --- a/FS/FS/cust_bill_pkg.pm +++ /dev/null @@ -1,309 +0,0 @@ -package FS::cust_bill_pkg; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs dbdef dbh ); -use FS::cust_main_Mixin; -use FS::cust_pkg; -use FS::cust_bill; -use FS::cust_bill_pkg_detail; -use FS::cust_bill_pay_pkg; -use FS::cust_credit_bill_pkg; - -@ISA = qw( FS::cust_main_Mixin FS::Record ); - -=head1 NAME - -FS::cust_bill_pkg - Object methods for cust_bill_pkg records - -=head1 SYNOPSIS - - use FS::cust_bill_pkg; - - $record = new FS::cust_bill_pkg \%hash; - $record = new FS::cust_bill_pkg { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::cust_bill_pkg object represents an invoice line item. -FS::cust_bill_pkg inherits from FS::Record. The following fields are currently -supported: - -=over 4 - -=item billpkgnum - primary key - -=item invnum - invoice (see L<FS::cust_bill>) - -=item pkgnum - package (see L<FS::cust_pkg>) or 0 for the special virtual sales tax package, or -1 for the virtual line item (itemdesc is used for the line) - -=item setup - setup fee - -=item recur - recurring fee - -=item sdate - starting date of recurring fee - -=item edate - ending date of recurring fee - -=item itemdesc - Line item description (currentlty used only when pkgnum is 0 or -1) - -=back - -sdate and edate are specified as UNIX timestamps; see L<perlfunc/"time">. Also -see L<Time::Local> and L<Date::Parse> for conversion functions. - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new line item. To add the line item to the database, see -L<"insert">. Line items are normally created by calling the bill method of a -customer object (see L<FS::cust_main>). - -=cut - -sub table { 'cust_bill_pkg'; } - -=item insert - -Adds this line item to the database. If there is an error, returns the error, -otherwise returns false. - -=cut - -sub insert { - my $self = shift; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $error = $self->SUPER::insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - unless ( defined dbdef->table('cust_bill_pkg_detail') && $self->get('details') ) { - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - return ''; - } - - foreach my $detail ( @{$self->get('details')} ) { - my $cust_bill_pkg_detail = new FS::cust_bill_pkg_detail { - 'pkgnum' => $self->pkgnum, - 'invnum' => $self->invnum, - 'detail' => $detail, - }; - $error = $cust_bill_pkg_detail->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - -} - -=item delete - -Currently unimplemented. I don't remove line items because there would then be -no record the items ever existed (which is bad, no?) - -=cut - -sub delete { - return "Can't delete cust_bill_pkg records!"; -} - -=item replace OLD_RECORD - -Currently unimplemented. This would be even more of an accounting nightmare -than deleteing the items. Just don't do it. - -=cut - -sub replace { - return "Can't modify cust_bill_pkg records!"; -} - -=item check - -Checks all fields to make sure this is a valid line item. If there is an -error, returns the error, otherwise returns false. Called by the insert -method. - -=cut - -sub check { - my $self = shift; - - my $error = - $self->ut_numbern('billpkgnum') - || $self->ut_snumber('pkgnum') - || $self->ut_number('invnum') - || $self->ut_money('setup') - || $self->ut_money('recur') - || $self->ut_numbern('sdate') - || $self->ut_numbern('edate') - || $self->ut_textn('itemdesc') - ; - return $error if $error; - - #if ( $self->pkgnum != 0 ) { #allow unchecked pkgnum 0 for tax! (add to part_pkg?) - if ( $self->pkgnum > 0 ) { #allow -1 for non-pkg line items and 0 for tax (add to part_pkg?) - return "Unknown pkgnum ". $self->pkgnum - unless qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } ); - } - - return "Unknown invnum" - unless qsearchs( 'cust_bill' ,{ 'invnum' => $self->invnum } ); - - $self->SUPER::check; -} - -=item cust_pkg - -Returns the package (see L<FS::cust_pkg>) for this invoice line item. - -=cut - -sub cust_pkg { - my $self = shift; - qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } ); -} - -=item details - -Returns an array of detail information for the invoice line item. - -=cut - -sub details { - my $self = shift; - return () unless defined dbdef->table('cust_bill_pkg_detail'); - map { $_->detail } - qsearch ( 'cust_bill_pkg_detail', { 'pkgnum' => $self->pkgnum, - 'invnum' => $self->invnum, } ); - #qsearch ( 'cust_bill_pkg_detail', { 'lineitemnum' => $self->lineitemnum }); -} - -=item desc - -Returns a description for this line item. For typical line items, this is the -I<pkg> field of the corresponding B<FS::part_pkg> object (see L<FS::part_pkg>). -For one-shot line items and named taxes, it is the I<itemdesc> field of this -line item, and for generic taxes, simply returns "Tax". - -=cut - -sub desc { - my $self = shift; - - if ( $self->pkgnum > 0 ) { - $self->cust_pkg->part_pkg->pkg; - } else { - $self->itemdesc || 'Tax'; - } -} - -=item owed_setup - -Returns the amount owed (still outstanding) on this line item's setup fee, -which is the amount of the line item minus all payment applications (see -L<FS::cust_bill_pay_pkg> and credit applications (see -L<FS::cust_credit_bill_pkg>). - -=cut - -sub owed_setup { - my $self = shift; - $self->owed('setup', @_); -} - -=item owed_recur - -Returns the amount owed (still outstanding) on this line item's recurring fee, -which is the amount of the line item minus all payment applications (see -L<FS::cust_bill_pay_pkg> and credit applications (see -L<FS::cust_credit_bill_pkg>). - -=cut - -sub owed_recur { - my $self = shift; - $self->owed('recur', @_); -} - -# modeled after cust_bill::owed... -sub owed { - my( $self, $field ) = @_; - my $balance = $self->$field(); - $balance -= $_->amount foreach ( $self->cust_bill_pay_pkg($field) ); - $balance -= $_->amount foreach ( $self->cust_credit_bill_pkg($field) ); - $balance = sprintf( '%.2f', $balance ); - $balance =~ s/^\-0\.00$/0.00/; #yay ieee fp - $balance; -} - -sub cust_bill_pay_pkg { - my( $self, $field ) = @_; - qsearch( 'cust_bill_pay_pkg', { 'billpkgnum' => $self->billpkgnum, - 'setuprecur' => $field, - } - ); -} - -sub cust_credit_bill_pkg { - my( $self, $field ) = @_; - qsearch( 'cust_credit_bill_pkg', { 'billpkgnum' => $self->billpkgnum, - 'setuprecur' => $field, - } - ); -} - -=back - -=head1 BUGS - -setup and recur shouldn't be separate fields. There should be one "amount" -field and a flag to tell you if it is a setup/one-time fee or a recurring fee. - -A line item with both should really be two separate records (preserving -sdate and edate for setup fees for recurring packages - that information may -be valuable later). Invoice generation (cust_main::bill), invoice printing -(cust_bill), tax reports (report_tax.cgi) and line item reports -(cust_bill_pkg.cgi) would need to be updated. - -owed_setup and owed_recur could then be repaced by just owed, and -cust_bill::open_cust_bill_pkg and -cust_bill_ApplicationCommon::apply_to_lineitems could be simplified. - -=head1 SEE ALSO - -L<FS::Record>, L<FS::cust_bill>, L<FS::cust_pkg>, L<FS::cust_main>, schema.html -from the base documentation. - -=cut - -1; - diff --git a/FS/FS/cust_bill_pkg_detail.pm b/FS/FS/cust_bill_pkg_detail.pm deleted file mode 100644 index 4156816..0000000 --- a/FS/FS/cust_bill_pkg_detail.pm +++ /dev/null @@ -1,124 +0,0 @@ -package FS::cust_bill_pkg_detail; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::cust_bill_pkg_detail - Object methods for cust_bill_pkg_detail records - -=head1 SYNOPSIS - - use FS::cust_bill_pkg_detail; - - $record = new FS::cust_bill_pkg_detail \%hash; - $record = new FS::cust_bill_pkg_detail { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::cust_bill_pkg_detail object represents additional detail information for -an invoice line item (see L<FS::cust_bill_pkg>). FS::cust_bill_pkg_detail -inherits from FS::Record. The following fields are currently supported: - -=over 4 - -=item detailnum - primary key - -=item pkgnum - - -=item invnum - - -=item detail - detail description - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new line item detail. To add the line item detail to the database, -see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'cust_bill_pkg_detail'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=cut - -# the insert method can be inherited from FS::Record - -=item delete - -Delete this record from the database. - -=cut - -# the delete method can be inherited from FS::Record - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -# the replace method can be inherited from FS::Record - -=item check - -Checks all fields to make sure this is a valid line item detail. If there is -an error, returns the error, otherwise returns false. Called by the insert -and replace methods. - -=cut - -# the check method should currently be supplied - FS::Record contains some -# data checking routines - -sub check { - my $self = shift; - - $self->ut_numbern('detailnum') - || $self->ut_foreign_key('pkgnum', 'cust_pkg', 'pkgnum') - || $self->ut_foreign_key('invnum', 'cust_bill', 'invnum') - || $self->ut_text('detail') - || $self->SUPER::check - ; - -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::cust_bill_pkg>, L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm deleted file mode 100644 index 9cc92d2..0000000 --- a/FS/FS/cust_credit.pm +++ /dev/null @@ -1,339 +0,0 @@ -package FS::cust_credit; - -use strict; -use vars qw( @ISA $conf $unsuspendauto ); -use Date::Format; -use FS::UID qw( dbh getotaker ); -use FS::Misc qw(send_email); -use FS::Record qw( qsearch qsearchs ); -use FS::cust_main_Mixin; -use FS::cust_main; -use FS::cust_refund; -use FS::cust_credit_bill; - -@ISA = qw( FS::cust_main_Mixin FS::Record ); - -#ask FS::UID to run this stuff for us later -$FS::UID::callback{'FS::cust_credit'} = sub { - - $conf = new FS::Conf; - $unsuspendauto = $conf->exists('unsuspendauto'); - -}; - -=head1 NAME - -FS::cust_credit - Object methods for cust_credit records - -=head1 SYNOPSIS - - use FS::cust_credit; - - $record = new FS::cust_credit \%hash; - $record = new FS::cust_credit { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::cust_credit object represents a credit; the equivalent of a negative -B<cust_bill> record (see L<FS::cust_bill>). FS::cust_credit inherits from -FS::Record. The following fields are currently supported: - -=over 4 - -=item crednum - primary key (assigned automatically for new credits) - -=item custnum - customer (see L<FS::cust_main>) - -=item amount - amount of the credit - -=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see -L<Time::Local> and L<Date::Parse> for conversion functions. - -=item otaker - order taker (assigned automatically, see L<FS::UID>) - -=item reason - text - -=item closed - books closed flag, empty or `Y' - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new credit. To add the credit to the database, see L<"insert">. - -=cut - -sub table { 'cust_credit'; } -sub cust_linked { $_[0]->cust_main_custnum; } -sub cust_unlinked_msg { - my $self = shift; - "WARNING: can't find cust_main.custnum ". $self->custnum. - ' (cust_credit.crednum '. $self->crednum. ')'; -} - -=item insert - -Adds this credit to the database ("Posts" the credit). If there is an error, -returns the error, otherwise returns false. - -=cut - -sub insert { - my $self = shift; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $cust_main = qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); - my $old_balance = $cust_main->balance; - - my $error = $self->SUPER::insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error inserting $self: $error"; - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - #false laziness w/ cust_credit::insert - if ( $unsuspendauto && $old_balance && $cust_main->balance <= 0 ) { - my @errors = $cust_main->unsuspend; - #return - # side-fx with nested transactions? upstack rolls back? - warn "WARNING:Errors unsuspending customer ". $cust_main->custnum. ": ". - join(' / ', @errors) - if @errors; - } - #eslaf - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; - -} - -=item delete - -Currently unimplemented. - -=cut - -sub delete { - my $self = shift; - return "Can't delete closed credit" 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_credit_bill ( $self->cust_credit_bill ) { - my $error = $cust_credit_bill->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('deletecredits') ne '' ) { - - my $cust_main = qsearchs('cust_main',{ 'custnum' => $self->custnum }); - - my $error = send_email( - 'from' => $conf->config('invoice_from'), #??? well as good as any - 'to' => $conf->config('deletecredits'), - 'subject' => 'FREESIDE NOTIFICATION: Credit deleted', - 'body' => [ - "This is an automatic message from your Freeside installation\n", - "informing you that the following credit has been deleted:\n", - "\n", - 'crednum: '. $self->crednum. "\n", - 'custnum: '. $self->custnum. - " (". $cust_main->last. ", ". $cust_main->first. ")\n", - 'amount: $'. sprintf("%.2f", $self->amount). "\n", - 'date: '. time2str("%a %b %e %T %Y", $self->_date). "\n", - 'reason: '. $self->reason. "\n", - ], - ); - - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "can't send credit deletion notification: $error"; - } - - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; - -} - -=item replace OLD_RECORD - -Credits may not be modified; there would then be no record the credit was ever -posted. - -=cut - -sub replace { - #return "Can't modify credit!" - my $self = shift; - return "Can't modify closed credit" if $self->closed =~ /^Y/i; - $self->SUPER::replace(@_); -} - -=item check - -Checks all fields to make sure this is a valid credit. If there is an error, -returns the error, otherwise returns false. Called by the insert and replace -methods. - -=cut - -sub check { - my $self = shift; - - my $error = - $self->ut_numbern('crednum') - || $self->ut_number('custnum') - || $self->ut_numbern('_date') - || $self->ut_money('amount') - || $self->ut_textn('reason') - || $self->ut_enum('closed', [ '', 'Y' ]) - ; - return $error if $error; - - return "amount must be > 0 " if $self->amount <= 0; - - return "Unknown customer" - unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); - - $self->_date(time) unless $self->_date; - - $self->otaker(getotaker); - - $self->SUPER::check; -} - -=item cust_refund - -Depreciated. See the cust_credit_refund method. - -#Returns all refunds (see L<FS::cust_refund>) for this credit. - -=cut - -sub cust_refund { - use Carp; - croak "FS::cust_credit->cust_pay depreciated; see ". - "FS::cust_credit->cust_credit_refund"; - #my $self = shift; - #sort { $a->_date <=> $b->_date } - # qsearch( 'cust_refund', { 'crednum' => $self->crednum } ) - #; -} - -=item cust_credit_refund - -Returns all refund applications (see L<FS::cust_credit_refund>) for this credit. - -=cut - -sub cust_credit_refund { - my $self = shift; - sort { $a->_date <=> $b->_date } - qsearch( 'cust_credit_refund', { 'crednum' => $self->crednum } ) - ; -} - -=item cust_credit_bill - -Returns all application to invoices (see L<FS::cust_credit_bill>) for this -credit. - -=cut - -sub cust_credit_bill { - my $self = shift; - sort { $a->_date <=> $b->_date } - qsearch( 'cust_credit_bill', { 'crednum' => $self->crednum } ) - ; -} - -=item credited - -Returns the amount of this credit that is still outstanding; which is -amount minus all refund applications (see L<FS::cust_credit_refund>) and -applications to invoices (see L<FS::cust_credit_bill>). - -=cut - -sub credited { - my $self = shift; - my $amount = $self->amount; - $amount -= $_->amount foreach ( $self->cust_credit_refund ); - $amount -= $_->amount foreach ( $self->cust_credit_bill ); - sprintf( "%.2f", $amount ); -} - -=item cust_main - -Returns the customer (see L<FS::cust_main>) for this credit. - -=cut - -sub cust_main { - my $self = shift; - qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); -} - - -=back - -=head1 BUGS - -The delete method. The replace method. - -=head1 SEE ALSO - -L<FS::Record>, L<FS::cust_credit_refund>, L<FS::cust_refund>, -L<FS::cust_credit_bill> L<FS::cust_bill>, schema.html from the base -documentation. - -=cut - -1; - diff --git a/FS/FS/cust_credit_bill.pm b/FS/FS/cust_credit_bill.pm deleted file mode 100644 index c015ec1..0000000 --- a/FS/FS/cust_credit_bill.pm +++ /dev/null @@ -1,166 +0,0 @@ -package FS::cust_credit_bill; - -use strict; -use vars qw( @ISA $conf ); -use FS::UID qw( getotaker ); -use FS::Record qw( qsearch qsearchs ); -use FS::cust_bill_ApplicationCommon; -use FS::cust_bill; -use FS::cust_credit; - -@ISA = qw( FS::cust_bill_ApplicationCommon ); - -#ask FS::UID to run this stuff for us later -FS::UID->install_callback( sub { - $conf = new FS::Conf; -} ); - -=head1 NAME - -FS::cust_credit_bill - Object methods for cust_credit_bill records - -=head1 SYNOPSIS - - use FS::cust_credit_bill; - - $record = new FS::cust_credit_bill \%hash; - $record = new FS::cust_credit_bill { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::cust_credit_bill object represents application of a credit (see -L<FS::cust_credit>) to an invoice (see L<FS::cust_bill>). FS::cust_credit_bill -inherits from FS::cust_bill_ApplicationCommon and FS::Record. The following -fields are currently supported: - -=over 4 - -=item creditbillnum - primary key - -=item crednum - credit being applied - -=item invnum - invoice to which credit is applied (see L<FS::cust_bill>) - -=item amount - amount of the credit applied - -=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see -L<Time::Local> and L<Date::Parse> for conversion functions. - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new cust_credit_bill. To add the cust_credit_bill to the database, -see L<"insert">. - -=cut - -sub table { 'cust_credit_bill'; } - -sub _app_source_name { 'credit'; } -sub _app_source_table { 'cust_credit'; } -sub _app_lineitem_breakdown_table { 'cust_credit_bill_pkg'; } - -=item insert - -Adds this cust_credit_bill to the database ("Posts" all or part of a credit). -If there is an error, returns the error, otherwise returns false. - -=item delete - -Currently unimplemented. - -=cut - -sub delete { - my $self = shift; - return "Can't delete application for closed credit" - if $self->cust_credit->closed =~ /^Y/i; - return "Can't delete application for closed invoice" - if $self->cust_bill->closed =~ /^Y/i; - $self->SUPER::delete(@_); -} - -=item replace OLD_RECORD - -Application of credits may not be modified. - -=cut - -sub replace { - return "Can't modify application of credit!" -} - -=item check - -Checks all fields to make sure this is a valid credit application. 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('creditbillnum') - || $self->ut_foreign_key('crednum', 'cust_credit', 'crednum') - || $self->ut_foreign_key('invnum', 'cust_bill', 'invnum' ) - || $self->ut_numbern('_date') - || $self->ut_money('amount') - ; - return $error if $error; - - return "amount must be > 0" if $self->amount <= 0; - - $self->_date(time) unless $self->_date; - - return "Cannot apply more than remaining value of credit" - unless $self->amount <= $self->cust_credit->credited; - - return "Cannot apply more than remaining value of invoice" - unless $self->amount <= $self->cust_bill->owed; - - $self->SUPER::check; -} - -=item sub cust_credit - -Returns the credit (see L<FS::cust_credit>) - -=cut - -sub cust_credit { - my $self = shift; - qsearchs( 'cust_credit', { 'crednum' => $self->crednum } ); -} - -=back - -=head1 BUGS - -The delete method. - -This probably should have been called cust_bill_credit. - -=head1 SEE ALSO - -L<FS::Record>, L<FS::cust_bill>, L<FS::cust_credit>, -schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/cust_credit_bill_pkg.pm b/FS/FS/cust_credit_bill_pkg.pm deleted file mode 100644 index 98521d6..0000000 --- a/FS/FS/cust_credit_bill_pkg.pm +++ /dev/null @@ -1,132 +0,0 @@ -package FS::cust_credit_bill_pkg; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::cust_credit_bill_pkg - Object methods for cust_credit_bill_pkg records - -=head1 SYNOPSIS - - use FS::cust_credit_bill_pkg; - - $record = new FS::cust_credit_bill_pkg \%hash; - $record = new FS::cust_credit_bill_pkg { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::cust_credit_bill_pkg object represents application of a credit (see -L<FS::cust_credit_bill>) to a specific line item within an invoice -(see L<FS::cust_bill_pkg>). FS::cust_credit_bill_pkg inherits from FS::Record. -The following fields are currently supported: - -=over 4 - -=item creditbillpkg - primary key - -=item creditbillnum - Credit application to the overall invoice (see L<FS::cust_credit::bill>) - -=item billpkgnum - Line item to which credit is applied (see L<FS::cust_bill_pkg>) - -=item amount - Amount of the credit applied to this line item. - -=item setuprecur - 'setup' or 'recur', designates whether the payment was applied to the setup or recurring portion of the line item. - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new example. To add the example to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'cust_credit_bill_pkg'; } - -=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 credit applicaiton. 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('creditbillpkgnum') - || $self->ut_foreign_key('creditbillnum', 'cust_credit_bill', 'creditbillnum') - || $self->ut_foreign_key('billpkgnum', 'cust_bill_pkg', 'billpkgnum' ) - || $self->ut_money('amount') - || $self->ut_enum('setuprecur', [ 'setup', 'recur' ] ) - ; - return $error if $error; - - $self->SUPER::check; -} - -=back - -=head1 BUGS - -B<setuprecur> field is a kludge to compensate for cust_bill_pkg having separate -setup and recur fields. It should be removed once that's fixed. - -=head1 SEE ALSO - -L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/cust_credit_refund.pm b/FS/FS/cust_credit_refund.pm deleted file mode 100644 index 36c77aa..0000000 --- a/FS/FS/cust_credit_refund.pm +++ /dev/null @@ -1,179 +0,0 @@ -package FS::cust_credit_refund; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs dbh ); -#use FS::UID qw(getotaker); -use FS::cust_credit; -use FS::cust_refund; - -@ISA = qw( FS::Record ); - -=head1 NAME - -FS::cust_credit_refund - Object methods for cust_bill_pay records - -=head1 SYNOPSIS - - use FS::cust_credit_refund; - - $record = new FS::cust_credit_refund \%hash; - $record = new FS::cust_credit_refund { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::cust_credit_refund represents the application of a refund to a specific -credit. FS::cust_credit_refund inherits from FS::Record. The following fields -are currently supported: - -=over 4 - -=item creditrefundnum - primary key (assigned automatically) - -=item crednum - Credit (see L<FS::cust_credit>) - -=item refundnum - Refund (see L<FS::cust_refund>) - -=item amount - Amount of the refund to apply to the specific credit. - -=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see -L<Time::Local> and L<Date::Parse> for conversion functions. - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new record. To add the record to the database, see L<"insert">. - -=cut - -sub table { 'cust_credit_refund'; } - -=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; - my $error = $self->SUPER::insert; - return $error if $error; - - ''; -} - -=item delete - -Currently unimplemented (accounting reasons). - -=cut - -sub delete { - return "Can't (yet?) delete cust_credit_refund records!"; -} - -=item replace OLD_RECORD - -Currently unimplemented (accounting reasons). - -=cut - -sub replace { - return "Can't (yet?) modify cust_credit_refund records!"; -} - -=item check - -Checks all fields to make sure this is a valid refund application. 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('creditrefundnum') - || $self->ut_number('crednum') - || $self->ut_number('refundnum') - || $self->ut_money('amount') - || $self->ut_numbern('_date') - ; - return $error if $error; - - return "amount must be > 0" if $self->amount <= 0; - - return "unknown cust_credit.crednum: ". $self->crednum - unless my $cust_credit = - qsearchs( 'cust_credit', { 'crednum' => $self->crednum } ); - - return "Unknown refund" - unless my $cust_refund = - qsearchs( 'cust_refund', { 'refundnum' => $self->refundnum } ); - - $self->_date(time) unless $self->_date; - - return "Cannot apply more than remaining value of credit" - unless $self->amount <= $cust_credit->credited; - - return "Cannot apply more than remaining value of refund" - unless $self->amount <= $cust_refund->unapplied; - - $self->SUPER::check; -} - -=item cust_refund - -Returns the refund (see L<FS::cust_refund>) - -=cut - -sub cust_refund { - my $self = shift; - qsearchs( 'cust_refund', { 'refundnum' => $self->refundnum } ); -} - -=item cust_credit - -Returns the credit (see L<FS::cust_credit>) - -=cut - -sub cust_credit { - my $self = shift; - qsearchs( 'cust_credit', { 'crednum' => $self->crednum } ); -} - -=back - -=head1 BUGS - -Delete and replace methods. - -the checks for over-applied refunds could be better done like the ones in -cust_bill_credit - -=head1 SEE ALSO - -L<FS::cust_credit>, L<FS::cust_refund>, L<FS::Record>, schema.html from the -base documentation. - -=cut - -1; - diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm deleted file mode 100644 index e86f399..0000000 --- a/FS/FS/cust_main.pm +++ /dev/null @@ -1,4665 +0,0 @@ -package FS::cust_main; - -use strict; -use vars qw( @ISA @EXPORT_OK $DEBUG $me $conf @encrypted_fields - $import $skip_fuzzyfiles $ignore_expired_card ); -use vars qw( $realtime_bop_decline_quiet ); #ugh -use Safe; -use Carp; -use Exporter; -BEGIN { - eval "use Time::Local;"; - die "Time::Local minimum version 1.05 required with Perl versions before 5.6" - if $] < 5.006 && !defined($Time::Local::VERSION); - #eval "use Time::Local qw(timelocal timelocal_nocheck);"; - eval "use Time::Local qw(timelocal_nocheck);"; -} -use Digest::MD5 qw(md5_base64); -use Date::Format; -use Date::Parse; -#use Date::Manip; -use String::Approx qw(amatch); -use Business::CreditCard 0.28; -use Locale::Country; -use FS::UID qw( getotaker dbh ); -use FS::Record qw( qsearchs qsearch dbdef ); -use FS::Misc qw( send_email ); -use FS::Msgcat qw(gettext); -use FS::cust_pkg; -use FS::cust_svc; -use FS::cust_bill; -use FS::cust_bill_pkg; -use FS::cust_pay; -use FS::cust_pay_void; -use FS::cust_credit; -use FS::cust_refund; -use FS::part_referral; -use FS::cust_main_county; -use FS::agent; -use FS::cust_main_invoice; -use FS::cust_credit_bill; -use FS::cust_bill_pay; -use FS::prepay_credit; -use FS::queue; -use FS::part_pkg; -use FS::part_bill_event; -use FS::cust_bill_event; -use FS::cust_tax_exempt; -use FS::cust_tax_exempt_pkg; -use FS::type_pkgs; -use FS::payment_gateway; -use FS::agent_payment_gateway; -use FS::banned_pay; - -@ISA = qw( FS::Record ); - -@EXPORT_OK = qw( smart_search ); - -$realtime_bop_decline_quiet = 0; - -# 1 is mostly method/subroutine entry and options -# 2 traces progress of some operations -# 3 is even more information including possibly sensitive data -$DEBUG = 0; -$me = '[FS::cust_main]'; - -$import = 0; -$skip_fuzzyfiles = 0; -$ignore_expired_card = 0; - -@encrypted_fields = ('payinfo', 'paycvv'); - -#ask FS::UID to run this stuff for us later -#$FS::UID::callback{'FS::cust_main'} = sub { -install_callback FS::UID sub { - $conf = new FS::Conf; - #yes, need it for stuff below (prolly should be cached) -}; - -sub _cache { - my $self = shift; - my ( $hashref, $cache ) = @_; - if ( exists $hashref->{'pkgnum'} ) { - #@{ $self->{'_pkgnum'} } = (); - my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum}); - $self->{'_pkgnum'} = $subcache; - #push @{ $self->{'_pkgnum'} }, - FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum}; - } -} - -=head1 NAME - -FS::cust_main - Object methods for cust_main records - -=head1 SYNOPSIS - - use FS::cust_main; - - $record = new FS::cust_main \%hash; - $record = new FS::cust_main { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - - @cust_pkg = $record->all_pkgs; - - @cust_pkg = $record->ncancelled_pkgs; - - @cust_pkg = $record->suspended_pkgs; - - $error = $record->bill; - $error = $record->bill %options; - $error = $record->bill 'time' => $time; - - $error = $record->collect; - $error = $record->collect %options; - $error = $record->collect 'invoice_time' => $time, - ; - -=head1 DESCRIPTION - -An FS::cust_main object represents a customer. FS::cust_main inherits from -FS::Record. The following fields are currently supported: - -=over 4 - -=item custnum - primary key (assigned automatically for new customers) - -=item agentnum - agent (see L<FS::agent>) - -=item refnum - Advertising source (see L<FS::part_referral>) - -=item first - name - -=item last - name - -=item ss - social security number (optional) - -=item company - (optional) - -=item address1 - -=item address2 - (optional) - -=item city - -=item county - (optional, see L<FS::cust_main_county>) - -=item state - (see L<FS::cust_main_county>) - -=item zip - -=item country - (see L<FS::cust_main_county>) - -=item daytime - phone (optional) - -=item night - phone (optional) - -=item fax - phone (optional) - -=item ship_first - name - -=item ship_last - name - -=item ship_company - (optional) - -=item ship_address1 - -=item ship_address2 - (optional) - -=item ship_city - -=item ship_county - (optional, see L<FS::cust_main_county>) - -=item ship_state - (see L<FS::cust_main_county>) - -=item ship_zip - -=item ship_country - (see L<FS::cust_main_county>) - -=item ship_daytime - phone (optional) - -=item ship_night - phone (optional) - -=item ship_fax - phone (optional) - -=item payby - -I<CARD> (credit card - automatic), I<DCRD> (credit card - on-demand), I<CHEK> (electronic check - automatic), I<DCHK> (electronic check - on-demand), I<LECB> (Phone bill billing), I<BILL> (billing), I<COMP> (free), or I<PREPAY> (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to I<BILL>) - -=item payinfo - -Card Number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>) - -=cut - -sub payinfo { - my($self,$payinfo) = @_; - if ( defined($payinfo) ) { - $self->paymask($payinfo); - $self->setfield('payinfo', $payinfo); # This is okay since we are the 'setter' - } else { - $payinfo = $self->getfield('payinfo'); # This is okay since we are the 'getter' - return $payinfo; - } -} - - -=item paycvv - -Card Verification Value, "CVV2" (also known as CVC2 or CID), the 3 or 4 digit number on the back (or front, for American Express) of the credit card - -=cut - -=item paymask - Masked payment type - -=over 4 - -=item Credit Cards - -Mask all but the last four characters. - -=item Checks - -Mask all but last 2 of account number and bank routing number. - -=item Others - -Do nothing, return the unmasked string. - -=back - -=cut - -sub paymask { - my($self,$value)=@_; - - # If it doesn't exist then generate it - my $paymask=$self->getfield('paymask'); - if (!defined($value) && (!defined($paymask) || $paymask eq '')) { - $value = $self->payinfo; - } - - if ( defined($value) && !$self->is_encrypted($value)) { - my $payinfo = $value; - my $payby = $self->payby; - if ($payby eq 'CARD' || $payby eq 'DCRD') { # Credit Cards (Show last four) - $paymask = 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4)); - } elsif ($payby eq 'CHEK' || - $payby eq 'DCHK' ) { # Checks (Show last 2 @ bank) - my( $account, $aba ) = split('@', $payinfo ); - $paymask = 'x'x(length($account)-2). substr($account,(length($account)-2))."@".$aba; - } else { # Tie up loose ends - $paymask = $payinfo; - } - $self->setfield('paymask', $paymask); # This is okay since we are the 'setter' - } elsif (defined($value) && $self->is_encrypted($value)) { - $paymask = 'N/A'; - } - return $paymask; -} - -=item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy - -=item paystart_month - start date month (maestro/solo cards only) - -=item paystart_year - start date year (maestro/solo cards only) - -=item payissue - issue number (maestro/solo cards only) - -=item payname - name on card or billing name - -=item payip - IP address from which payment information was received - -=item tax - tax exempt, empty or `Y' - -=item otaker - order taker (assigned automatically, see L<FS::UID>) - -=item comments - comments (optional) - -=item referral_custnum - referring customer number - -=item spool_cdr - Enable individual CDR spooling, empty or `Y' - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new customer. To add the customer to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -sub table { 'cust_main'; } - -=item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ] - -Adds this customer to the database. If there is an error, returns the error, -otherwise returns false. - -CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert -method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records -are inserted atomicly, or the transaction is rolled back. Passing an empty -hash reference is equivalent to not supplying this parameter. There should be -a better explanation of this, but until then, here's an example: - - use Tie::RefHash; - tie %hash, 'Tie::RefHash'; #this part is important - %hash = ( - $cust_pkg => [ $svc_acct ], - ... - ); - $cust_main->insert( \%hash ); - -INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will -be set as the invoicing list (see L<"invoicing_list">). Errors return as -expected and rollback the entire transaction; it is not necessary to call -check_invoicing_list first. The invoicing_list is set after the records in the -CUST_PKG_HASHREF above are inserted, so it is now possible to set an -invoicing_list destination to the newly-created svc_acct. Here's an example: - - $cust_main->insert( {}, [ $email, 'POST' ] ); - -Currently available options are: I<depend_jobnum> and I<noexport>. - -If I<depend_jobnum> is set, all provisioning jobs will have a dependancy -on the supplied jobnum (they will not run until the specific job completes). -This can be used to defer provisioning until some action completes (such -as running the customer's credit card successfully). - -The I<noexport> option is deprecated. If I<noexport> is set true, no -provisioning jobs (exports) are scheduled. (You can schedule them later with -the B<reexport> method.) - -=cut - -sub insert { - my $self = shift; - my $cust_pkgs = @_ ? shift : {}; - my $invoicing_list = @_ ? shift : ''; - my %options = @_; - warn "$me insert called with options ". - join(', ', map { "$_: $options{$_}" } keys %options ). "\n" - if $DEBUG; - - 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 $prepay_identifier = ''; - my( $amount, $seconds ) = ( 0, 0 ); - my $payby = ''; - if ( $self->payby eq 'PREPAY' ) { - - $self->payby('BILL'); - $prepay_identifier = $self->payinfo; - $self->payinfo(''); - - warn " looking up prepaid card $prepay_identifier\n" - if $DEBUG > 1; - - my $error = $self->get_prepay($prepay_identifier, \$amount, \$seconds); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - #return "error applying prepaid card (transaction rolled back): $error"; - return $error; - } - - $payby = 'PREP' if $amount; - - } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) { - - $payby = $1; - $self->payby('BILL'); - $amount = $self->paid; - - } - - warn " inserting $self\n" - if $DEBUG > 1; - - my $error = $self->SUPER::insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - #return "inserting cust_main record (transaction rolled back): $error"; - return $error; - } - - warn " setting invoicing list\n" - if $DEBUG > 1; - - if ( $invoicing_list ) { - $error = $self->check_invoicing_list( $invoicing_list ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "checking invoicing_list (transaction rolled back): $error"; - } - $self->invoicing_list( $invoicing_list ); - } - - if ( $conf->config('cust_main-skeleton_tables') - && $conf->config('cust_main-skeleton_custnum') ) { - - warn " inserting skeleton records\n" - if $DEBUG > 1; - - my $error = $self->start_copy_skel; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - } - - warn " ordering packages\n" - if $DEBUG > 1; - - $error = $self->order_pkgs($cust_pkgs, \$seconds, %options); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - if ( $seconds ) { - $dbh->rollback if $oldAutoCommit; - return "No svc_acct record to apply pre-paid time"; - } - - if ( $amount ) { - warn " inserting initial $payby payment of $amount\n" - if $DEBUG > 1; - $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "inserting payment (transaction rolled back): $error"; - } - } - - unless ( $import || $skip_fuzzyfiles ) { - warn " queueing fuzzyfiles update\n" - if $DEBUG > 1; - $error = $self->queue_fuzzyfiles_update; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "updating fuzzy search cache: $error"; - } - } - - warn " insert complete; committing transaction\n" - if $DEBUG > 1; - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - -} - -sub start_copy_skel { - my $self = shift; - - #'mg_user_preference' => {}, - #'mg_user_indicator_profile.user_indicator_profile_id' => { 'mg_profile_indicator.profile_indicator_id' => { 'mg_profile_details.profile_detail_id' }, }, - #'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' }, - #'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' }, - #'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } }, - my @tables = eval($conf->config_binary('cust_main-skeleton_tables')); - die $@ if $@; - - _copy_skel( 'cust_main', #tablename - $conf->config('cust_main-skeleton_custnum'), #sourceid - $self->custnum, #destid - @tables, #child tables - ); -} - -#recursive subroutine, not a method -sub _copy_skel { - my( $table, $sourceid, $destid, %child_tables ) = @_; - - my $primary_key; - if ( $table =~ /^(\w+)\.(\w+)$/ ) { - ( $table, $primary_key ) = ( $1, $2 ); - } else { - my $dbdef_table = dbdef->table($table); - $primary_key = $dbdef_table->primary_key - or return "$table has no primary key". - " (or do you need to run dbdef-create?)"; - } - - warn " _copy_skel: $table.$primary_key $sourceid to $destid for ". - join (', ', keys %child_tables). "\n" - if $DEBUG > 2; - - foreach my $child_table_def ( keys %child_tables ) { - - my $child_table; - my $child_pkey = ''; - if ( $child_table_def =~ /^(\w+)\.(\w+)$/ ) { - ( $child_table, $child_pkey ) = ( $1, $2 ); - } else { - $child_table = $child_table_def; - - $child_pkey = dbdef->table($child_table)->primary_key; - # or return "$table has no primary key". - # " (or do you need to run dbdef-create?)\n"; - } - - my $sequence = ''; - if ( keys %{ $child_tables{$child_table_def} } ) { - - return "$child_table has no primary key". - " (run dbdef-create or try specifying it?)\n" - unless $child_pkey; - - #false laziness w/Record::insert and only works on Pg - #refactor the proper last-inserted-id stuff out of Record::insert if this - # ever gets use for anything besides a quick kludge for one customer - my $default = dbdef->table($child_table)->column($child_pkey)->default; - $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i - or return "can't parse $child_table.$child_pkey default value ". - " for sequence name: $default"; - $sequence = $1; - - } - - my @sel_columns = grep { $_ ne $primary_key } - dbdef->table($child_table)->columns; - my $sel_columns = join(', ', @sel_columns ); - - my @ins_columns = grep { $_ ne $child_pkey } @sel_columns; - my $ins_columns = ' ( '. join(', ', $primary_key, @ins_columns ). ' ) '; - my $placeholders = ' ( ?, '. join(', ', map '?', @ins_columns ). ' ) '; - - my $sel_st = "SELECT $sel_columns FROM $child_table". - " WHERE $primary_key = $sourceid"; - warn " $sel_st\n" - if $DEBUG > 2; - my $sel_sth = dbh->prepare( $sel_st ) - or return dbh->errstr; - - $sel_sth->execute or return $sel_sth->errstr; - - while ( my $row = $sel_sth->fetchrow_hashref ) { - - warn " selected row: ". - join(', ', map { "$_=".$row->{$_} } keys %$row ). "\n" - if $DEBUG > 2; - - my $statement = - "INSERT INTO $child_table $ins_columns VALUES $placeholders"; - my $ins_sth =dbh->prepare($statement) - or return dbh->errstr; - my @param = ( $destid, map $row->{$_}, @ins_columns ); - warn " $statement: [ ". join(', ', @param). " ]\n" - if $DEBUG > 2; - $ins_sth->execute( @param ) - or return $ins_sth->errstr; - - #next unless keys %{ $child_tables{$child_table} }; - next unless $sequence; - - #another section of that laziness - my $seq_sql = "SELECT currval('$sequence')"; - my $seq_sth = dbh->prepare($seq_sql) or return dbh->errstr; - $seq_sth->execute or return $seq_sth->errstr; - my $insertid = $seq_sth->fetchrow_arrayref->[0]; - - # don't drink soap! recurse! recurse! okay! - my $error = - _copy_skel( $child_table_def, - $row->{$child_pkey}, #sourceid - $insertid, #destid - %{ $child_tables{$child_table_def} }, - ); - return $error if $error; - - } - - } - - return ''; - -} - -=item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ] - -Like the insert method on an existing record, this method orders a package -and included services atomicaly. Pass a Tie::RefHash data structure to this -method containing FS::cust_pkg and FS::svc_I<tablename> objects. There should -be a better explanation of this, but until then, here's an example: - - use Tie::RefHash; - tie %hash, 'Tie::RefHash'; #this part is important - %hash = ( - $cust_pkg => [ $svc_acct ], - ... - ); - $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 ); - -Services can be new, in which case they are inserted, or existing unaudited -services, in which case they are linked to the newly-created package. - -Currently available options are: I<depend_jobnum> and I<noexport>. - -If I<depend_jobnum> is set, all provisioning jobs will have a dependancy -on the supplied jobnum (they will not run until the specific job completes). -This can be used to defer provisioning until some action completes (such -as running the customer's credit card successfully). - -The I<noexport> option is deprecated. If I<noexport> is set true, no -provisioning jobs (exports) are scheduled. (You can schedule them later with -the B<reexport> method for each cust_pkg object. Using the B<reexport> method -on the cust_main object is not recommended, as existing services will also be -reexported.) - -=cut - -sub order_pkgs { - my $self = shift; - my $cust_pkgs = shift; - my $seconds = shift; - my %options = @_; - my %svc_options = (); - $svc_options{'depend_jobnum'} = $options{'depend_jobnum'} - if exists $options{'depend_jobnum'}; - warn "$me order_pkgs called with options ". - join(', ', map { "$_: $options{$_}" } keys %options ). "\n" - if $DEBUG; - - 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; - - local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'}; - - foreach my $cust_pkg ( keys %$cust_pkgs ) { - $cust_pkg->custnum( $self->custnum ); - my $error = $cust_pkg->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "inserting cust_pkg (transaction rolled back): $error"; - } - foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) { - if ( $svc_something->svcnum ) { - my $old_cust_svc = $svc_something->cust_svc; - my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash }; - $new_cust_svc->pkgnum( $cust_pkg->pkgnum); - $error = $new_cust_svc->replace($old_cust_svc); - } else { - $svc_something->pkgnum( $cust_pkg->pkgnum ); - if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) { - $svc_something->seconds( $svc_something->seconds + $$seconds ); - $$seconds = 0; - } - $error = $svc_something->insert(%svc_options); - } - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - #return "inserting svc_ (transaction rolled back): $error"; - return $error; - } - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; #no error -} - -=item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF ] - -Recharges this (existing) customer with the specified prepaid card (see -L<FS::prepay_credit>), specified either by I<identifier> or as an -FS::prepay_credit object. If there is an error, returns the error, otherwise -returns false. - -Optionally, two scalar references can be passed as well. They will have their -values filled in with the amount and number of seconds applied by this prepaid -card. - -=cut - -sub recharge_prepay { - my( $self, $prepay_credit, $amountref, $secondsref ) = @_; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my( $amount, $seconds ) = ( 0, 0 ); - - my $error = $self->get_prepay($prepay_credit, \$amount, \$seconds) - || $self->increment_seconds($seconds) - || $self->insert_cust_pay_prepay( $amount, - ref($prepay_credit) - ? $prepay_credit->identifier - : $prepay_credit - ); - - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - if ( defined($amountref) ) { $$amountref = $amount; } - if ( defined($secondsref) ) { $$secondsref = $seconds; } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - -} - -=item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ , AMOUNTREF, SECONDSREF - -Looks up and deletes a prepaid card (see L<FS::prepay_credit>), -specified either by I<identifier> or as an FS::prepay_credit object. - -References to I<amount> and I<seconds> scalars should be passed as arguments -and will be incremented by the values of the prepaid card. - -If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to -check or set this customer's I<agentnum>. - -If there is an error, returns the error, otherwise returns false. - -=cut - - -sub get_prepay { - my( $self, $prepay_credit, $amountref, $secondsref ) = @_; - - 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; - - unless ( ref($prepay_credit) ) { - - my $identifier = $prepay_credit; - - $prepay_credit = qsearchs( - 'prepay_credit', - { 'identifier' => $prepay_credit }, - '', - 'FOR UPDATE' - ); - - unless ( $prepay_credit ) { - $dbh->rollback if $oldAutoCommit; - return "Invalid prepaid card: ". $identifier; - } - - } - - if ( $prepay_credit->agentnum ) { - if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) { - $dbh->rollback if $oldAutoCommit; - return "prepaid card not valid for agent ". $self->agentnum; - } - $self->agentnum($prepay_credit->agentnum); - } - - my $error = $prepay_credit->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "removing prepay_credit (transaction rolled back): $error"; - } - - $$amountref += $prepay_credit->amount; - $$secondsref += $prepay_credit->seconds; - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - -} - -=item increment_seconds SECONDS - -Updates this customer's single or primary account (see L<FS::svc_acct>) by -the specified number of seconds. If there is an error, returns the error, -otherwise returns false. - -=cut - -sub increment_seconds { - my( $self, $seconds ) = @_; - warn "$me increment_seconds called: $seconds seconds\n" - if $DEBUG; - - my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') } - $self->ncancelled_pkgs; - - if ( ! @cust_pkg ) { - return 'No packages with primary or single services found'. - ' to apply pre-paid time'; - } elsif ( scalar(@cust_pkg) > 1 ) { - #maybe have a way to specify the package/account? - return 'Multiple packages found to apply pre-paid time'; - } - - my $cust_pkg = $cust_pkg[0]; - warn " found package pkgnum ". $cust_pkg->pkgnum. "\n" - if $DEBUG > 1; - - my @cust_svc = - $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') ); - - if ( ! @cust_svc ) { - return 'No account found to apply pre-paid time'; - } elsif ( scalar(@cust_svc) > 1 ) { - return 'Multiple accounts found to apply pre-paid time'; - } - - my $svc_acct = $cust_svc[0]->svc_x; - warn " found service svcnum ". $svc_acct->pkgnum. - ' ('. $svc_acct->email. ")\n" - if $DEBUG > 1; - - $svc_acct->increment_seconds($seconds); - -} - -=item insert_cust_pay_prepay AMOUNT [ PAYINFO ] - -Inserts a prepayment in the specified amount for this customer. An optional -second argument can specify the prepayment identifier for tracking purposes. -If there is an error, returns the error, otherwise returns false. - -=cut - -sub insert_cust_pay_prepay { - shift->insert_cust_pay('PREP', @_); -} - -=item insert_cust_pay_cash AMOUNT [ PAYINFO ] - -Inserts a cash payment in the specified amount for this customer. An optional -second argument can specify the payment identifier for tracking purposes. -If there is an error, returns the error, otherwise returns false. - -=cut - -sub insert_cust_pay_cash { - shift->insert_cust_pay('CASH', @_); -} - -=item insert_cust_pay_west AMOUNT [ PAYINFO ] - -Inserts a Western Union payment in the specified amount for this customer. An -optional second argument can specify the prepayment identifier for tracking -purposes. If there is an error, returns the error, otherwise returns false. - -=cut - -sub insert_cust_pay_west { - shift->insert_cust_pay('WEST', @_); -} - -sub insert_cust_pay { - my( $self, $payby, $amount ) = splice(@_, 0, 3); - my $payinfo = scalar(@_) ? shift : ''; - - my $cust_pay = new FS::cust_pay { - 'custnum' => $self->custnum, - 'paid' => sprintf('%.2f', $amount), - #'_date' => #date the prepaid card was purchased??? - 'payby' => $payby, - 'payinfo' => $payinfo, - }; - $cust_pay->insert; - -} - -=item reexport - -This method is deprecated. See the I<depend_jobnum> option to the insert and -order_pkgs methods for a better way to defer provisioning. - -Re-schedules all exports by calling the B<reexport> method of all associated -packages (see L<FS::cust_pkg>). If there is an error, returns the error; -otherwise returns false. - -=cut - -sub reexport { - my $self = shift; - - carp "WARNING: FS::cust_main::reexport is deprectated; ". - "use the depend_jobnum option to insert or order_pkgs to delay export"; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - foreach my $cust_pkg ( $self->ncancelled_pkgs ) { - my $error = $cust_pkg->reexport; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - -} - -=item delete NEW_CUSTNUM - -This deletes the customer. If there is an error, returns the error, otherwise -returns false. - -This will completely remove all traces of the customer record. This is not -what you want when a customer cancels service; for that, cancel all of the -customer's packages (see L</cancel>). - -If the customer has any uncancelled packages, you need to pass a new (valid) -customer number for those packages to be transferred to. Cancelled packages -will be deleted. Did I mention that this is NOT what you want when a customer -cancels service and that you really should be looking see L<FS::cust_pkg/cancel>? - -You can't delete a customer with invoices (see L<FS::cust_bill>), -or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or -refunds (see L<FS::cust_refund>). - -=cut - -sub delete { - my $self = shift; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - if ( $self->cust_bill ) { - $dbh->rollback if $oldAutoCommit; - return "Can't delete a customer with invoices"; - } - if ( $self->cust_credit ) { - $dbh->rollback if $oldAutoCommit; - return "Can't delete a customer with credits"; - } - if ( $self->cust_pay ) { - $dbh->rollback if $oldAutoCommit; - return "Can't delete a customer with payments"; - } - if ( $self->cust_refund ) { - $dbh->rollback if $oldAutoCommit; - return "Can't delete a customer with refunds"; - } - - my @cust_pkg = $self->ncancelled_pkgs; - if ( @cust_pkg ) { - my $new_custnum = shift; - unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) { - $dbh->rollback if $oldAutoCommit; - return "Invalid new customer number: $new_custnum"; - } - foreach my $cust_pkg ( @cust_pkg ) { - my %hash = $cust_pkg->hash; - $hash{'custnum'} = $new_custnum; - my $new_cust_pkg = new FS::cust_pkg ( \%hash ); - my $error = $new_cust_pkg->replace($cust_pkg); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - } - my @cancelled_cust_pkg = $self->all_pkgs; - foreach my $cust_pkg ( @cancelled_cust_pkg ) { - my $error = $cust_pkg->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - foreach my $cust_main_invoice ( #(email invoice destinations, not invoices) - qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } ) - ) { - my $error = $cust_main_invoice->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - my $error = $self->SUPER::delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - -} - -=item replace OLD_RECORD [ INVOICING_LIST_ARYREF ] - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will -be set as the invoicing list (see L<"invoicing_list">). Errors return as -expected and rollback the entire transaction; it is not necessary to call -check_invoicing_list first. Here's an example: - - $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] ); - -=cut - -sub replace { - my $self = shift; - my $old = shift; - my @param = @_; - warn "$me replace called\n" - if $DEBUG; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - # If the mask is blank then try to set it - if we can... - if (!defined($self->getfield('paymask')) || $self->getfield('paymask') eq '') { - $self->paymask($self->payinfo); - } - - # We absolutely have to have an old vs. new record to make this work. - if (!defined($old)) { - $old = qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); - } - - my $curuser = $FS::CurrentUser::CurrentUser; - if ( $self->payby eq 'COMP' - && $self->payby ne $old->payby - && ! $curuser->access_right('Complimentary customer') - ) - { - return "You are not permitted to create complimentary accounts."; - } - - local($ignore_expired_card) = 1 - if $old->payby =~ /^(CARD|DCRD)$/ - && $self->payby =~ /^(CARD|DCRD)$/ - && $old->payinfo eq $self->payinfo; - - 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; - } - - if ( @param ) { # INVOICING_LIST_ARYREF - my $invoicing_list = shift @param; - $error = $self->check_invoicing_list( $invoicing_list ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - $self->invoicing_list( $invoicing_list ); - } - - if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ && - grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) { - # card/check/lec info has changed, want to retry realtime_ invoice events - my $error = $self->retry_realtime; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - unless ( $import || $skip_fuzzyfiles ) { - $error = $self->queue_fuzzyfiles_update; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "updating fuzzy search cache: $error"; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - -} - -=item queue_fuzzyfiles_update - -Used by insert & replace to update the fuzzy search cache - -=cut - -sub queue_fuzzyfiles_update { - my $self = shift; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; - my $error = $queue->insert( map $self->getfield($_), - qw(first last company) - ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - - if ( $self->ship_last ) { - $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; - $error = $queue->insert( map $self->getfield("ship_$_"), - qw(first last company) - ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - -} - -=item check - -Checks all fields to make sure this is a valid customer record. If there is -an error, returns the error, otherwise returns false. Called by the insert -and replace methods. - -=cut - -sub check { - my $self = shift; - - warn "$me check BEFORE: \n". $self->_dump - if $DEBUG > 2; - - my $error = - $self->ut_numbern('custnum') - || $self->ut_number('agentnum') - || $self->ut_textn('agent_custid') - || $self->ut_number('refnum') - || $self->ut_name('last') - || $self->ut_name('first') - || $self->ut_textn('company') - || $self->ut_text('address1') - || $self->ut_textn('address2') - || $self->ut_text('city') - || $self->ut_textn('county') - || $self->ut_textn('state') - || $self->ut_country('country') - || $self->ut_anything('comments') - || $self->ut_numbern('referral_custnum') - ; - #barf. need message catalogs. i18n. etc. - $error .= "Please select an advertising source." - if $error =~ /^Illegal or empty \(numeric\) refnum: /; - return $error if $error; - - return "Unknown agent" - unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } ); - - return "Unknown refnum" - unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } ); - - return "Unknown referring custnum: ". $self->referral_custnum - unless ! $self->referral_custnum - || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } ); - - if ( $self->ss eq '' ) { - $self->ss(''); - } else { - my $ss = $self->ss; - $ss =~ s/\D//g; - $ss =~ /^(\d{3})(\d{2})(\d{4})$/ - or return "Illegal social security number: ". $self->ss; - $self->ss("$1-$2-$3"); - } - - -# bad idea to disable, causes billing to fail because of no tax rates later -# unless ( $import ) { - unless ( qsearch('cust_main_county', { - 'country' => $self->country, - 'state' => '', - } ) ) { - return "Unknown state/county/country: ". - $self->state. "/". $self->county. "/". $self->country - unless qsearch('cust_main_county',{ - 'state' => $self->state, - 'county' => $self->county, - 'country' => $self->country, - } ); - } -# } - - $error = - $self->ut_phonen('daytime', $self->country) - || $self->ut_phonen('night', $self->country) - || $self->ut_phonen('fax', $self->country) - || $self->ut_zip('zip', $self->country) - ; - return $error if $error; - - my @addfields = qw( - last first company address1 address2 city county state zip - country daytime night fax - ); - - if ( defined $self->dbdef_table->column('ship_last') ) { - if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") } - @addfields ) - && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields ) - ) - { - my $error = - $self->ut_name('ship_last') - || $self->ut_name('ship_first') - || $self->ut_textn('ship_company') - || $self->ut_text('ship_address1') - || $self->ut_textn('ship_address2') - || $self->ut_text('ship_city') - || $self->ut_textn('ship_county') - || $self->ut_textn('ship_state') - || $self->ut_country('ship_country') - ; - return $error if $error; - - #false laziness with above - unless ( qsearchs('cust_main_county', { - 'country' => $self->ship_country, - 'state' => '', - } ) ) { - return "Unknown ship_state/ship_county/ship_country: ". - $self->ship_state. "/". $self->ship_county. "/". $self->ship_country - unless qsearch('cust_main_county',{ - 'state' => $self->ship_state, - 'county' => $self->ship_county, - 'country' => $self->ship_country, - } ); - } - #eofalse - - $error = - $self->ut_phonen('ship_daytime', $self->ship_country) - || $self->ut_phonen('ship_night', $self->ship_country) - || $self->ut_phonen('ship_fax', $self->ship_country) - || $self->ut_zip('ship_zip', $self->ship_country) - ; - return $error if $error; - - } else { # ship_ info eq billing info, so don't store dup info in database - $self->setfield("ship_$_", '') - foreach qw( last first company address1 address2 city county state zip - country daytime night fax ); - } - } - - $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/ - or return "Illegal payby: ". $self->payby; - - $error = $self->ut_numbern('paystart_month') - || $self->ut_numbern('paystart_year') - || $self->ut_numbern('payissue') - ; - return $error if $error; - - if ( $self->payip eq '' ) { - $self->payip(''); - } else { - $error = $self->ut_ip('payip'); - return $error if $error; - } - - # If it is encrypted and the private key is not availaible then we can't - # check the credit card. - - my $check_payinfo = 1; - - if ($self->is_encrypted($self->payinfo)) { - $check_payinfo = 0; - } - - $self->payby($1); - - if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) { - - my $payinfo = $self->payinfo; - $payinfo =~ s/\D//g; - $payinfo =~ /^(\d{13,16})$/ - or return gettext('invalid_card'); # . ": ". $self->payinfo; - $payinfo = $1; - $self->payinfo($payinfo); - validate($payinfo) - or return gettext('invalid_card'); # . ": ". $self->payinfo; - - return gettext('unknown_card_type') - if cardtype($self->payinfo) eq "Unknown"; - - my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref); - if ( $ban ) { - return 'Banned credit card: banned on '. - time2str('%a %h %o at %r', $ban->_date). - ' by '. $ban->otaker. - ' (ban# '. $ban->bannum. ')'; - } - - if ( defined $self->dbdef_table->column('paycvv') ) { - if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) { - if ( cardtype($self->payinfo) eq 'American Express card' ) { - $self->paycvv =~ /^(\d{4})$/ - or return "CVV2 (CID) for American Express cards is four digits."; - $self->paycvv($1); - } else { - $self->paycvv =~ /^(\d{3})$/ - or return "CVV2 (CVC2/CID) is three digits."; - $self->paycvv($1); - } - } else { - $self->paycvv(''); - } - } - - my $cardtype = cardtype($payinfo); - if ( $cardtype =~ /^(Switch|Solo)$/i ) { - - return "Start date or issue number is required for $cardtype cards" - unless $self->paystart_month && $self->paystart_year or $self->payissue; - - return "Start month must be between 1 and 12" - if $self->paystart_month - and $self->paystart_month < 1 || $self->paystart_month > 12; - - return "Start year must be 1990 or later" - if $self->paystart_year - and $self->paystart_year < 1990; - - return "Issue number must be beween 1 and 99" - if $self->payissue - and $self->payissue < 1 || $self->payissue > 99; - - } else { - $self->paystart_month(''); - $self->paystart_year(''); - $self->payissue(''); - } - - } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) { - - my $payinfo = $self->payinfo; - $payinfo =~ s/[^\d\@]//g; - if ( $conf->exists('echeck-nonus') ) { - $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba'; - $payinfo = "$1\@$2"; - } else { - $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba'; - $payinfo = "$1\@$2"; - } - $self->payinfo($payinfo); - $self->paycvv('') if $self->dbdef_table->column('paycvv'); - - my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref); - if ( $ban ) { - return 'Banned ACH account: banned on '. - time2str('%a %h %o at %r', $ban->_date). - ' by '. $ban->otaker. - ' (ban# '. $ban->bannum. ')'; - } - - } elsif ( $self->payby eq 'LECB' ) { - - my $payinfo = $self->payinfo; - $payinfo =~ s/\D//g; - $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number'; - $payinfo = $1; - $self->payinfo($payinfo); - $self->paycvv('') if $self->dbdef_table->column('paycvv'); - - } elsif ( $self->payby eq 'BILL' ) { - - $error = $self->ut_textn('payinfo'); - return "Illegal P.O. number: ". $self->payinfo if $error; - $self->paycvv('') if $self->dbdef_table->column('paycvv'); - - } elsif ( $self->payby eq 'COMP' ) { - - my $curuser = $FS::CurrentUser::CurrentUser; - if ( ! $self->custnum - && ! $curuser->access_right('Complimentary customer') - ) - { - return "You are not permitted to create complimentary accounts." - } - - $error = $self->ut_textn('payinfo'); - return "Illegal comp account issuer: ". $self->payinfo if $error; - $self->paycvv('') if $self->dbdef_table->column('paycvv'); - - } elsif ( $self->payby eq 'PREPAY' ) { - - my $payinfo = $self->payinfo; - $payinfo =~ s/\W//g; #anything else would just confuse things - $self->payinfo($payinfo); - $error = $self->ut_alpha('payinfo'); - return "Illegal prepayment identifier: ". $self->payinfo if $error; - return "Unknown prepayment identifier" - unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } ); - $self->paycvv('') if $self->dbdef_table->column('paycvv'); - - } - - if ( $self->paydate eq '' || $self->paydate eq '-' ) { - return "Expiration date required" - unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/; - $self->paydate(''); - } else { - my( $m, $y ); - if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) { - ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" ); - } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) { - ( $m, $y ) = ( $3, "20$2" ); - } else { - return "Illegal expiration date: ". $self->paydate; - } - $self->paydate("$y-$m-01"); - my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900; - return gettext('expired_card') - if !$import - && !$ignore_expired_card - && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) ); - } - - if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ && - ( ! $conf->exists('require_cardname') - || $self->payby !~ /^(CARD|DCRD)$/ ) - ) { - $self->payname( $self->first. " ". $self->getfield('last') ); - } else { - $self->payname =~ /^([\w \,\.\-\'\&]+)$/ - or return gettext('illegal_name'). " payname: ". $self->payname; - $self->payname($1); - } - - foreach my $flag (qw( tax spool_cdr )) { - $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag(); - $self->$flag($1); - } - - $self->otaker(getotaker) unless $self->otaker; - - warn "$me check AFTER: \n". $self->_dump - if $DEBUG > 2; - - $self->SUPER::check; -} - -=item all_pkgs - -Returns all packages (see L<FS::cust_pkg>) for this customer. - -=cut - -sub all_pkgs { - my $self = shift; - if ( $self->{'_pkgnum'} ) { - values %{ $self->{'_pkgnum'}->cache }; - } else { - qsearch( 'cust_pkg', { 'custnum' => $self->custnum }); - } -} - -=item ncancelled_pkgs - -Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer. - -=cut - -sub ncancelled_pkgs { - my $self = shift; - if ( $self->{'_pkgnum'} ) { - grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache }; - } else { - @{ [ # force list context - qsearch( 'cust_pkg', { - 'custnum' => $self->custnum, - 'cancel' => '', - }), - qsearch( 'cust_pkg', { - 'custnum' => $self->custnum, - 'cancel' => 0, - }), - ] }; - } -} - -=item suspended_pkgs - -Returns all suspended packages (see L<FS::cust_pkg>) for this customer. - -=cut - -sub suspended_pkgs { - my $self = shift; - grep { $_->susp } $self->ncancelled_pkgs; -} - -=item unflagged_suspended_pkgs - -Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this -customer (thouse packages without the `manual_flag' set). - -=cut - -sub unflagged_suspended_pkgs { - my $self = shift; - return $self->suspended_pkgs - unless dbdef->table('cust_pkg')->column('manual_flag'); - grep { ! $_->manual_flag } $self->suspended_pkgs; -} - -=item unsuspended_pkgs - -Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for -this customer. - -=cut - -sub unsuspended_pkgs { - my $self = shift; - grep { ! $_->susp } $self->ncancelled_pkgs; -} - -=item num_cancelled_pkgs - -Returns the number of cancelled packages (see L<FS::cust_pkg>) for this -customer. - -=cut - -sub num_cancelled_pkgs { - my $self = shift; - $self->num_pkgs("cancel IS NOT NULL AND cust_pkg.cancel != 0"); -} - -sub num_pkgs { - my( $self, $sql ) = @_; - my $sth = dbh->prepare( - "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? AND $sql" - ) or die dbh->errstr; - $sth->execute($self->custnum) or die $sth->errstr; - $sth->fetchrow_arrayref->[0]; -} - -=item unsuspend - -Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs> -and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list -on success or a list of errors. - -=cut - -sub unsuspend { - my $self = shift; - grep { $_->unsuspend } $self->suspended_pkgs; -} - -=item suspend - -Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer. - -Returns a list: an empty list on success or a list of errors. - -=cut - -sub suspend { - my $self = shift; - grep { $_->suspend } $self->unsuspended_pkgs; -} - -=item suspend_if_pkgpart PKGPART [ , PKGPART ... ] - -Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed -PKGPARTs (see L<FS::part_pkg>). - -Returns a list: an empty list on success or a list of errors. - -=cut - -sub suspend_if_pkgpart { - my $self = shift; - my @pkgparts = @_; - grep { $_->suspend } - grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts } - $self->unsuspended_pkgs; -} - -=item suspend_unless_pkgpart PKGPART [ , PKGPART ... ] - -Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the -listed PKGPARTs (see L<FS::part_pkg>). - -Returns a list: an empty list on success or a list of errors. - -=cut - -sub suspend_unless_pkgpart { - my $self = shift; - my @pkgparts = @_; - grep { $_->suspend } - grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts } - $self->unsuspended_pkgs; -} - -=item cancel [ OPTION => VALUE ... ] - -Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer. - -Available options are: I<quiet>, I<reasonnum>, and I<ban> - -I<quiet> can be set true to supress email cancellation notices. - -# I<reasonnum> can be set to a cancellation reason (see L<FS::cancel_reason>) - -I<ban> can be set true to ban this customer's credit card or ACH information, -if present. - -Always returns a list: an empty list on success or a list of errors. - -=cut - -sub cancel { - my $self = shift; - my %opt = @_; - - if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) { - - #should try decryption (we might have the private key) - # and if not maybe queue a job for the server that does? - return ( "Can't (yet) ban encrypted credit cards" ) - if $self->is_encrypted($self->payinfo); - - my $ban = new FS::banned_pay $self->_banned_pay_hashref; - my $error = $ban->insert; - return ( $error ) if $error; - - } - - grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs; -} - -sub _banned_pay_hashref { - my $self = shift; - - my %payby2ban = ( - 'CARD' => 'CARD', - 'DCRD' => 'CARD', - 'CHEK' => 'CHEK', - 'DCHK' => 'CHEK' - ); - - { - 'payby' => $payby2ban{$self->payby}, - 'payinfo' => md5_base64($self->payinfo), - #'reason' => - }; -} - -=item agent - -Returns the agent (see L<FS::agent>) for this customer. - -=cut - -sub agent { - my $self = shift; - qsearchs( 'agent', { 'agentnum' => $self->agentnum } ); -} - -=item bill OPTIONS - -Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in -conjunction with the collect method. - -Options are passed as name-value pairs. - -Currently available options are: - -resetup - if set true, re-charges setup fees. - -time - bills the customer as if it were that time. Specified as a UNIX -timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and -L<Date::Parse> for conversion functions. For example: - - use Date::Parse; - ... - $cust_main->bill( 'time' => str2time('April 20th, 2001') ); - - -If there is an error, returns the error, otherwise returns false. - -=cut - -sub bill { - my( $self, %options ) = @_; - return '' if $self->payby eq 'COMP'; - warn "$me bill customer ". $self->custnum. "\n" - if $DEBUG; - - my $time = $options{'time'} || time; - - my $error; - - #put below somehow? - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - $self->select_for_update; #mutex - - #create a new invoice - #(we'll remove it later if it doesn't actually need to be generated [contains - # no line items] and we're inside a transaciton so nothing else will see it) - my $cust_bill = new FS::cust_bill ( { - 'custnum' => $self->custnum, - '_date' => $time, - #'charged' => $charged, - 'charged' => 0, - } ); - $error = $cust_bill->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "can't create invoice for customer #". $self->custnum. ": $error"; - } - my $invnum = $cust_bill->invnum; - - ### - # find the packages which are due for billing, find out how much they are - # & generate invoice database. - ### - - my( $total_setup, $total_recur ) = ( 0, 0 ); - my %tax; - my @precommit_hooks = (); - - foreach my $cust_pkg ( - qsearch('cust_pkg', { 'custnum' => $self->custnum } ) - ) { - - #NO!! next if $cust_pkg->cancel; - next if $cust_pkg->getfield('cancel'); - - warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1; - - #? to avoid use of uninitialized value errors... ? - $cust_pkg->setfield('bill', '') - unless defined($cust_pkg->bill); - - my $part_pkg = $cust_pkg->part_pkg; - - my %hash = $cust_pkg->hash; - my $old_cust_pkg = new FS::cust_pkg \%hash; - - my @details = (); - - ### - # bill setup - ### - - my $setup = 0; - if ( !$cust_pkg->setup || $options{'resetup'} ) { - - warn " bill setup\n" if $DEBUG > 1; - - $setup = eval { $cust_pkg->calc_setup( $time ) }; - if ( $@ ) { - $dbh->rollback if $oldAutoCommit; - return "$@ running calc_setup for $cust_pkg\n"; - } - - $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup; - } - - ### - # bill recurring fee - ### - - my $recur = 0; - my $sdate; - if ( $part_pkg->getfield('freq') ne '0' && - ! $cust_pkg->getfield('susp') && - ( $cust_pkg->getfield('bill') || 0 ) <= $time - ) { - - warn " bill recur\n" if $DEBUG > 1; - - # XXX shared with $recur_prog - $sdate = $cust_pkg->bill || $cust_pkg->setup || $time; - - #over two params! lets at least switch to a hashref for the rest... - my %param = ( 'precommit_hooks' => \@precommit_hooks, ); - - $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) }; - if ( $@ ) { - $dbh->rollback if $oldAutoCommit; - return "$@ running calc_recur for $cust_pkg\n"; - } - - #change this bit to use Date::Manip? CAREFUL with timezones (see - # mailing list archive) - my ($sec,$min,$hour,$mday,$mon,$year) = - (localtime($sdate) )[0,1,2,3,4,5]; - - #pro-rating magic - if $recur_prog fiddles $sdate, want to use that - # only for figuring next bill date, nothing else, so, reset $sdate again - # here - $sdate = $cust_pkg->bill || $cust_pkg->setup || $time; - $cust_pkg->last_bill($sdate) - if $cust_pkg->dbdef_table->column('last_bill'); - - if ( $part_pkg->freq =~ /^\d+$/ ) { - $mon += $part_pkg->freq; - until ( $mon < 12 ) { $mon -= 12; $year++; } - } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) { - my $weeks = $1; - $mday += $weeks * 7; - } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) { - my $days = $1; - $mday += $days; - } elsif ( $part_pkg->freq =~ /^(\d+)h$/ ) { - my $hours = $1; - $hour += $hours; - } else { - $dbh->rollback if $oldAutoCommit; - return "unparsable frequency: ". $part_pkg->freq; - } - $cust_pkg->setfield('bill', - timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year)); - } - - warn "\$setup is undefined" unless defined($setup); - warn "\$recur is undefined" unless defined($recur); - warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill); - - ### - # If $cust_pkg has been modified, update it and create cust_bill_pkg records - ### - - if ( $cust_pkg->modified ) { - - warn " package ". $cust_pkg->pkgnum. " modified; updating\n" - if $DEBUG >1; - - $error=$cust_pkg->replace($old_cust_pkg); - if ( $error ) { #just in case - $dbh->rollback if $oldAutoCommit; - return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"; - } - - $setup = sprintf( "%.2f", $setup ); - $recur = sprintf( "%.2f", $recur ); - if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) { - $dbh->rollback if $oldAutoCommit; - return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum; - } - if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) { - $dbh->rollback if $oldAutoCommit; - return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum; - } - - if ( $setup != 0 || $recur != 0 ) { - - warn " charges (setup=$setup, recur=$recur); adding line items\n" - if $DEBUG > 1; - my $cust_bill_pkg = new FS::cust_bill_pkg ({ - 'invnum' => $invnum, - 'pkgnum' => $cust_pkg->pkgnum, - 'setup' => $setup, - 'recur' => $recur, - 'sdate' => $sdate, - 'edate' => $cust_pkg->bill, - 'details' => \@details, - }); - $error = $cust_bill_pkg->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "can't create invoice line item for invoice #$invnum: $error"; - } - $total_setup += $setup; - $total_recur += $recur; - - ### - # handle taxes - ### - - unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) { - - my $prefix = - ( $conf->exists('tax-ship_address') && length($self->ship_last) ) - ? 'ship_' - : ''; - my %taxhash = map { $_ => $self->get("$prefix$_") } - qw( state county country ); - - $taxhash{'taxclass'} = $part_pkg->taxclass; - - my @taxes = qsearch( 'cust_main_county', \%taxhash ); - - unless ( @taxes ) { - $taxhash{'taxclass'} = ''; - @taxes = qsearch( 'cust_main_county', \%taxhash ); - } - - #one more try at a whole-country tax rate - unless ( @taxes ) { - $taxhash{$_} = '' foreach qw( state county ); - @taxes = qsearch( 'cust_main_county', \%taxhash ); - } - - # maybe eliminate this entirely, along with all the 0% records - unless ( @taxes ) { - $dbh->rollback if $oldAutoCommit; - return - "fatal: can't find tax rate for state/county/country/taxclass ". - join('/', ( map $self->get("$prefix$_"), - qw(state county country) - ), - $part_pkg->taxclass ). "\n"; - } - - foreach my $tax ( @taxes ) { - - my $taxable_charged = 0; - $taxable_charged += $setup - unless $part_pkg->setuptax =~ /^Y$/i - || $tax->setuptax =~ /^Y$/i; - $taxable_charged += $recur - unless $part_pkg->recurtax =~ /^Y$/i - || $tax->recurtax =~ /^Y$/i; - next unless $taxable_charged; - - if ( $tax->exempt_amount && $tax->exempt_amount > 0 ) { - #my ($mon,$year) = (localtime($sdate) )[4,5]; - my ($mon,$year) = (localtime( $sdate || $cust_bill->_date ) )[4,5]; - $mon++; - my $freq = $part_pkg->freq || 1; - if ( $freq !~ /(\d+)$/ ) { - $dbh->rollback if $oldAutoCommit; - return "daily/weekly package definitions not (yet?)". - " compatible with monthly tax exemptions"; - } - my $taxable_per_month = - sprintf("%.2f", $taxable_charged / $freq ); - - #call the whole thing off if this customer has any old - #exemption records... - my @cust_tax_exempt = - qsearch( 'cust_tax_exempt' => { custnum=> $self->custnum } ); - if ( @cust_tax_exempt ) { - $dbh->rollback if $oldAutoCommit; - return - 'this customer still has old-style tax exemption records; '. - 'run bin/fs-migrate-cust_tax_exempt?'; - } - - foreach my $which_month ( 1 .. $freq ) { - - #maintain the new exemption table now - my $sql = " - SELECT SUM(amount) - FROM cust_tax_exempt_pkg - LEFT JOIN cust_bill_pkg USING ( billpkgnum ) - LEFT JOIN cust_bill USING ( invnum ) - WHERE custnum = ? - AND taxnum = ? - AND year = ? - AND month = ? - "; - my $sth = dbh->prepare($sql) or do { - $dbh->rollback if $oldAutoCommit; - return "fatal: can't lookup exising exemption: ". dbh->errstr; - }; - $sth->execute( - $self->custnum, - $tax->taxnum, - 1900+$year, - $mon, - ) or do { - $dbh->rollback if $oldAutoCommit; - return "fatal: can't lookup exising exemption: ". dbh->errstr; - }; - my $existing_exemption = $sth->fetchrow_arrayref->[0] || 0; - - my $remaining_exemption = - $tax->exempt_amount - $existing_exemption; - if ( $remaining_exemption > 0 ) { - my $addl = $remaining_exemption > $taxable_per_month - ? $taxable_per_month - : $remaining_exemption; - $taxable_charged -= $addl; - - my $cust_tax_exempt_pkg = new FS::cust_tax_exempt_pkg ( { - 'billpkgnum' => $cust_bill_pkg->billpkgnum, - 'taxnum' => $tax->taxnum, - 'year' => 1900+$year, - 'month' => $mon, - 'amount' => sprintf("%.2f", $addl ), - } ); - $error = $cust_tax_exempt_pkg->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "fatal: can't insert cust_tax_exempt_pkg: $error"; - } - } # if $remaining_exemption > 0 - - #++ - $mon++; - #until ( $mon < 12 ) { $mon -= 12; $year++; } - until ( $mon < 13 ) { $mon -= 12; $year++; } - - } #foreach $which_month - - } #if $tax->exempt_amount - - $taxable_charged = sprintf( "%.2f", $taxable_charged); - - #$tax += $taxable_charged * $cust_main_county->tax / 100 - $tax{ $tax->taxname || 'Tax' } += - $taxable_charged * $tax->tax / 100 - - } #foreach my $tax ( @taxes ) - - } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP' - - } #if $setup != 0 || $recur != 0 - - } #if $cust_pkg->modified - - } #foreach my $cust_pkg - - unless ( $cust_bill->cust_bill_pkg ) { - $cust_bill->delete; #don't create an invoice w/o line items - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - return ''; - } - - my $charged = sprintf( "%.2f", $total_setup + $total_recur ); - - foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) { - my $tax = sprintf("%.2f", $tax{$taxname} ); - $charged = sprintf( "%.2f", $charged+$tax ); - - my $cust_bill_pkg = new FS::cust_bill_pkg ({ - 'invnum' => $invnum, - 'pkgnum' => 0, - 'setup' => $tax, - 'recur' => 0, - 'sdate' => '', - 'edate' => '', - 'itemdesc' => $taxname, - }); - $error = $cust_bill_pkg->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "can't create invoice line item for invoice #$invnum: $error"; - } - $total_setup += $tax; - - } - - $cust_bill->charged( sprintf( "%.2f", $total_setup + $total_recur ) ); - $error = $cust_bill->replace; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "can't update charged for invoice #$invnum: $error"; - } - - foreach my $hook ( @precommit_hooks ) { - eval { - &{$hook}; #($self) ? - }; - if ( $@ ) { - $dbh->rollback if $oldAutoCommit; - return "$@ running precommit hook $hook\n"; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; #no error -} - -=item collect OPTIONS - -(Attempt to) collect money for this customer's outstanding invoices (see -L<FS::cust_bill>). Usually used after the bill method. - -Depending on the value of `payby', this may print or email an invoice (I<BILL>, -I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic -check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>). - -Most actions are now triggered by invoice events; see L<FS::part_bill_event> -and the invoice events web interface. - -If there is an error, returns the error, otherwise returns false. - -Options are passed as name-value pairs. - -Currently available options are: - -invoice_time - Use this time when deciding when to print invoices and -late notices on those invoices. The default is now. It is specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> -for conversion functions. - -retry - Retry card/echeck/LEC transactions even when not scheduled by invoice -events. - -quiet - set true to surpress email card/ACH decline notices. - -freq - "1d" for the traditional, daily events (the default), or "1m" for the -new monthly events - -payby - allows for one time override of normal customer billing method - -=cut - -sub collect { - my( $self, %options ) = @_; - my $invoice_time = $options{'invoice_time'} || time; - - #put below somehow? - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - $self->select_for_update; #mutex - - my $balance = $self->balance; - warn "$me collect customer ". $self->custnum. ": balance $balance\n" - if $DEBUG; - unless ( $balance > 0 ) { #redundant????? - $dbh->rollback if $oldAutoCommit; #hmm - return ''; - } - - if ( exists($options{'retry_card'}) ) { - carp 'retry_card option passed to collect is deprecated; use retry'; - $options{'retry'} ||= $options{'retry_card'}; - } - if ( exists($options{'retry'}) && $options{'retry'} ) { - my $error = $self->retry_realtime; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - my $extra_sql = ''; - if ( defined $options{'freq'} && $options{'freq'} eq '1m' ) { - $extra_sql = " AND freq = '1m' "; - } else { - $extra_sql = " AND ( freq = '1d' OR freq IS NULL OR freq = '' ) "; - } - - foreach my $cust_bill ( $self->open_cust_bill ) { - - # don't try to charge for the same invoice if it's already in a batch - #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } ); - - last if $self->balance <= 0; - - warn " invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")\n" - if $DEBUG > 1; - - foreach my $part_bill_event ( - sort { $a->seconds <=> $b->seconds - || $a->weight <=> $b->weight - || $a->eventpart <=> $b->eventpart } - grep { $_->seconds <= ( $invoice_time - $cust_bill->_date ) - && ! qsearch( 'cust_bill_event', { - 'invnum' => $cust_bill->invnum, - 'eventpart' => $_->eventpart, - 'status' => 'done', - } ) - } - qsearch( { - 'table' => 'part_bill_event', - 'hashref' => { 'payby' => (exists($options{'payby'}) - ? $options{'payby'} - : $self->payby - ), - 'disabled' => '', }, - 'extra_sql' => $extra_sql, - } ) - ) { - - last if $cust_bill->owed <= 0 # don't run subsequent events if owed<=0 - || $self->balance <= 0; # or if balance<=0 - - warn " calling invoice event (". $part_bill_event->eventcode. ")\n" - if $DEBUG > 1; - my $cust_main = $self; #for callback - - my $error; - { - local $realtime_bop_decline_quiet = 1 if $options{'quiet'}; - local $SIG{__DIE__}; # don't want Mason __DIE__ handler active - $error = eval $part_bill_event->eventcode; - } - - my $status = ''; - my $statustext = ''; - if ( $@ ) { - $status = 'failed'; - $statustext = $@; - } elsif ( $error ) { - $status = 'done'; - $statustext = $error; - } else { - $status = 'done' - } - - #add cust_bill_event - my $cust_bill_event = new FS::cust_bill_event { - 'invnum' => $cust_bill->invnum, - 'eventpart' => $part_bill_event->eventpart, - #'_date' => $invoice_time, - '_date' => time, - 'status' => $status, - 'statustext' => $statustext, - }; - $error = $cust_bill_event->insert; - if ( $error ) { - #$dbh->rollback if $oldAutoCommit; - #return "error: $error"; - - # gah, even with transactions. - $dbh->commit if $oldAutoCommit; #well. - my $e = 'WARNING: Event run but database not updated - '. - 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum. - ', eventpart '. $part_bill_event->eventpart. - ": $error"; - warn $e; - return $e; - } - - - } - - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - -} - -=item retry_realtime - -Schedules realtime credit card / electronic check / LEC billing events for -for retry. Useful if card information has changed or manual retry is desired. -The 'collect' method must be called to actually retry the transaction. - -Implementation details: For each of this customer's open invoices, changes -the status of the first "done" (with statustext error) realtime processing -event to "failed". - -=cut - -sub retry_realtime { - my $self = shift; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - foreach my $cust_bill ( - grep { $_->cust_bill_event } - $self->open_cust_bill - ) { - my @cust_bill_event = - sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds } - grep { - #$_->part_bill_event->plan eq 'realtime-card' - $_->part_bill_event->eventcode =~ - /\$cust_bill\->realtime_(card|ach|lec)/ - && $_->status eq 'done' - && $_->statustext - } - $cust_bill->cust_bill_event; - next unless @cust_bill_event; - my $error = $cust_bill_event[0]->retry; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error scheduling invoice event for retry: $error"; - } - - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - -} - -=item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ] - -Runs a realtime credit card, ACH (electronic check) or phone bill transaction -via a Business::OnlinePayment realtime gateway. See -L<http://420.am/business-onlinepayment> for supported gateways. - -Available methods are: I<CC>, I<ECHECK> and I<LEC> - -Available options are: I<description>, I<invnum>, I<quiet> - -The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>, -I<zip>, I<payinfo> and I<paydate> are also available. Any of these options, -if set, will override the value from the customer record. - -I<description> is a free-text field passed to the gateway. It defaults to -"Internet services". - -If an I<invnum> is specified, this payment (if successful) is applied to the -specified invoice. If you don't specify an I<invnum> you might want to -call the B<apply_payments> method. - -I<quiet> can be set true to surpress email decline notices. - -(moved from cust_bill) (probably should get realtime_{card,ach,lec} here too) - -=cut - -sub realtime_bop { - my( $self, $method, $amount, %options ) = @_; - if ( $DEBUG ) { - warn "$me realtime_bop: $method $amount\n"; - warn " $_ => $options{$_}\n" foreach keys %options; - } - - $options{'description'} ||= 'Internet services'; - - eval "use Business::OnlinePayment"; - die $@ if $@; - - my $payinfo = exists($options{'payinfo'}) - ? $options{'payinfo'} - : $self->payinfo; - - ### - # select a gateway - ### - - my $taxclass = ''; - if ( $options{'invnum'} ) { - my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } ); - die "invnum ". $options{'invnum'}. " not found" unless $cust_bill; - my @taxclasses = - map { $_->part_pkg->taxclass } - grep { $_ } - map { $_->cust_pkg } - $cust_bill->cust_bill_pkg; - unless ( grep { $taxclasses[0] ne $_ } @taxclasses ) { #unless there are - #different taxclasses - $taxclass = $taxclasses[0]; - } - } - - #look for an agent gateway override first - my $cardtype; - if ( $method eq 'CC' ) { - $cardtype = cardtype($payinfo); - } elsif ( $method eq 'ECHECK' ) { - $cardtype = 'ACH'; - } else { - $cardtype = $method; - } - - my $override = - qsearchs('agent_payment_gateway', { agentnum => $self->agentnum, - cardtype => $cardtype, - taxclass => $taxclass, } ) - || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum, - cardtype => '', - taxclass => $taxclass, } ) - || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum, - cardtype => $cardtype, - taxclass => '', } ) - || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum, - cardtype => '', - taxclass => '', } ); - - my $payment_gateway = ''; - my( $processor, $login, $password, $action, @bop_options ); - if ( $override ) { #use a payment gateway override - - $payment_gateway = $override->payment_gateway; - - $processor = $payment_gateway->gateway_module; - $login = $payment_gateway->gateway_username; - $password = $payment_gateway->gateway_password; - $action = $payment_gateway->gateway_action; - @bop_options = $payment_gateway->options; - - } else { #use the standard settings from the config - - ( $processor, $login, $password, $action, @bop_options ) = - $self->default_payment_gateway($method); - - } - - ### - # massage data - ### - - my $address = exists($options{'address1'}) - ? $options{'address1'} - : $self->address1; - my $address2 = exists($options{'address2'}) - ? $options{'address2'} - : $self->address2; - $address .= ", ". $address2 if length($address2); - - my $o_payname = exists($options{'payname'}) - ? $options{'payname'} - : $self->payname; - my($payname, $payfirst, $paylast); - if ( $o_payname && $method ne 'ECHECK' ) { - ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/ - or return "Illegal payname $payname"; - ($payfirst, $paylast) = ($1, $2); - } else { - $payfirst = $self->getfield('first'); - $paylast = $self->getfield('last'); - $payname = "$payfirst $paylast"; - } - - my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list; - if ( $conf->exists('emailinvoiceauto') - || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) { - push @invoicing_list, $self->all_emails; - } - - my $email = ($conf->exists('business-onlinepayment-email-override')) - ? $conf->config('business-onlinepayment-email-override') - : $invoicing_list[0]; - - my %content = (); - - my $payip = exists($options{'payip'}) - ? $options{'payip'} - : $self->payip; - $content{customer_ip} = $payip - if length($payip); - - if ( $method eq 'CC' ) { - - $content{card_number} = $payinfo; - my $paydate = exists($options{'paydate'}) - ? $options{'paydate'} - : $self->paydate; - $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; - $content{expiration} = "$2/$1"; - - my $paycvv = exists($options{'paycvv'}) - ? $options{'paycvv'} - : $self->paycvv; - $content{cvv2} = $self->paycvv - if length($paycvv); - - my $paystart_month = exists($options{'paystart_month'}) - ? $options{'paystart_month'} - : $self->paystart_month; - - my $paystart_year = exists($options{'paystart_year'}) - ? $options{'paystart_year'} - : $self->paystart_year; - - $content{card_start} = "$paystart_month/$paystart_year" - if $paystart_month && $paystart_year; - - my $payissue = exists($options{'payissue'}) - ? $options{'payissue'} - : $self->payissue; - $content{issue_number} = $payissue if $payissue; - - $content{recurring_billing} = 'YES' - if qsearch('cust_pay', { 'custnum' => $self->custnum, - 'payby' => 'CARD', - 'payinfo' => $payinfo, - } ); - - } elsif ( $method eq 'ECHECK' ) { - ( $content{account_number}, $content{routing_code} ) = - split('@', $payinfo); - $content{bank_name} = $o_payname; - $content{account_type} = 'CHECKING'; - $content{account_name} = $payname; - $content{customer_org} = $self->company ? 'B' : 'I'; - $content{customer_ssn} = exists($options{'ss'}) - ? $options{'ss'} - : $self->ss; - } elsif ( $method eq 'LEC' ) { - $content{phone} = $payinfo; - } - - ### - # run transaction(s) - ### - - my( $action1, $action2 ) = split(/\s*\,\s*/, $action ); - - my $transaction = new Business::OnlinePayment( $processor, @bop_options ); - $transaction->content( - 'type' => $method, - 'login' => $login, - 'password' => $password, - 'action' => $action1, - 'description' => $options{'description'}, - 'amount' => $amount, - 'invoice_number' => $options{'invnum'}, - 'customer_id' => $self->custnum, - 'last_name' => $paylast, - 'first_name' => $payfirst, - 'name' => $payname, - 'address' => $address, - 'city' => ( exists($options{'city'}) - ? $options{'city'} - : $self->city ), - 'state' => ( exists($options{'state'}) - ? $options{'state'} - : $self->state ), - 'zip' => ( exists($options{'zip'}) - ? $options{'zip'} - : $self->zip ), - 'country' => ( exists($options{'country'}) - ? $options{'country'} - : $self->country ), - 'referer' => 'http://cleanwhisker.420.am/', - 'email' => $email, - 'phone' => $self->daytime || $self->night, - %content, #after - ); - $transaction->submit(); - - if ( $transaction->is_success() && $action2 ) { - my $auth = $transaction->authorization; - my $ordernum = $transaction->can('order_number') - ? $transaction->order_number - : ''; - - my $capture = - new Business::OnlinePayment( $processor, @bop_options ); - - my %capture = ( - %content, - type => $method, - action => $action2, - login => $login, - password => $password, - order_number => $ordernum, - amount => $amount, - authorization => $auth, - description => $options{'description'}, - ); - - foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code - transaction_sequence_num local_transaction_date - local_transaction_time AVS_result_code )) { - $capture{$field} = $transaction->$field() if $transaction->can($field); - } - - $capture->content( %capture ); - - $capture->submit(); - - unless ( $capture->is_success ) { - my $e = "Authorization successful but capture failed, custnum #". - $self->custnum. ': '. $capture->result_code. - ": ". $capture->error_message; - warn $e; - return $e; - } - - } - - ### - # remove paycvv after initial transaction - ### - - #false laziness w/misc/process/payment.cgi - check both to make sure working - # correctly - if ( defined $self->dbdef_table->column('paycvv') - && length($self->paycvv) - && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save') - ) { - my $error = $self->remove_cvv; - if ( $error ) { - warn "WARNING: error removing cvv: $error\n"; - } - } - - ### - # result handling - ### - - if ( $transaction->is_success() ) { - - my %method2payby = ( - 'CC' => 'CARD', - 'ECHECK' => 'CHEK', - 'LEC' => 'LECB', - ); - - my $paybatch = ''; - if ( $payment_gateway ) { # agent override - $paybatch = $payment_gateway->gatewaynum. '-'; - } - - $paybatch .= "$processor:". $transaction->authorization; - - $paybatch .= ':'. $transaction->order_number - if $transaction->can('order_number') - && length($transaction->order_number); - - my $cust_pay = new FS::cust_pay ( { - 'custnum' => $self->custnum, - 'invnum' => $options{'invnum'}, - 'paid' => $amount, - '_date' => '', - 'payby' => $method2payby{$method}, - 'payinfo' => $payinfo, - 'paybatch' => $paybatch, - } ); - my $error = $cust_pay->insert; - if ( $error ) { - $cust_pay->invnum(''); #try again with no specific invnum - my $error2 = $cust_pay->insert; - if ( $error2 ) { - # gah, even with transactions. - my $e = 'WARNING: Card/ACH debited but database not updated - '. - "error inserting payment ($processor): $error2". - " (previously tried insert with invnum #$options{'invnum'}" . - ": $error )"; - warn $e; - return $e; - } - } - return ''; #no error - - } else { - - my $perror = "$processor error: ". $transaction->error_message; - - if ( !$options{'quiet'} && !$realtime_bop_decline_quiet - && $conf->exists('emaildecline') - && grep { $_ ne 'POST' } $self->invoicing_list - && ! grep { $transaction->error_message =~ /$_/ } - $conf->config('emaildecline-exclude') - ) { - my @templ = $conf->config('declinetemplate'); - my $template = new Text::Template ( - TYPE => 'ARRAY', - SOURCE => [ map "$_\n", @templ ], - ) or return "($perror) can't create template: $Text::Template::ERROR"; - $template->compile() - or return "($perror) can't compile template: $Text::Template::ERROR"; - - my $templ_hash = { error => $transaction->error_message }; - - my $error = send_email( - 'from' => $conf->config('invoice_from'), - 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ], - 'subject' => 'Your payment could not be processed', - 'body' => [ $template->fill_in(HASH => $templ_hash) ], - ); - - $perror .= " (also received error sending decline notification: $error)" - if $error; - - } - - return $perror; - } - -} - -=item default_payment_gateway - -=cut - -sub default_payment_gateway { - my( $self, $method ) = @_; - - die "Real-time processing not enabled\n" - unless $conf->exists('business-onlinepayment'); - - #load up config - my $bop_config = 'business-onlinepayment'; - $bop_config .= '-ach' - if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach'); - my ( $processor, $login, $password, $action, @bop_options ) = - $conf->config($bop_config); - $action ||= 'normal authorization'; - pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/; - die "No real-time processor is enabled - ". - "did you set the business-onlinepayment configuration value?\n" - unless $processor; - - ( $processor, $login, $password, $action, @bop_options ) -} - -=item remove_cvv - -Removes the I<paycvv> field from the database directly. - -If there is an error, returns the error, otherwise returns false. - -=cut - -sub remove_cvv { - my $self = shift; - my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?") - or return dbh->errstr; - $sth->execute($self->custnum) - or return $sth->errstr; - $self->paycvv(''); - ''; -} - -=item realtime_refund_bop METHOD [ OPTION => VALUE ... ] - -Refunds a realtime credit card, ACH (electronic check) or phone bill transaction -via a Business::OnlinePayment realtime gateway. See -L<http://420.am/business-onlinepayment> for supported gateways. - -Available methods are: I<CC>, I<ECHECK> and I<LEC> - -Available options are: I<amount>, I<reason>, I<paynum> - -Most gateways require a reference to an original payment transaction to refund, -so you probably need to specify a I<paynum>. - -I<amount> defaults to the original amount of the payment if not specified. - -I<reason> specifies a reason for the refund. - -Implementation note: If I<amount> is unspecified or equal to the amount of the -orignal payment, first an attempt is made to "void" the transaction via -the gateway (to cancel a not-yet settled transaction) and then if that fails, -the normal attempt is made to "refund" ("credit") the transaction via the -gateway is attempted. - -#The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>, -#I<zip>, I<payinfo> and I<paydate> are also available. Any of these options, -#if set, will override the value from the customer record. - -#If an I<invnum> is specified, this payment (if successful) is applied to the -#specified invoice. If you don't specify an I<invnum> you might want to -#call the B<apply_payments> method. - -=cut - -#some false laziness w/realtime_bop, not enough to make it worth merging -#but some useful small subs should be pulled out -sub realtime_refund_bop { - my( $self, $method, %options ) = @_; - if ( $DEBUG ) { - warn "$me realtime_refund_bop: $method refund\n"; - warn " $_ => $options{$_}\n" foreach keys %options; - } - - eval "use Business::OnlinePayment"; - die $@ if $@; - - ### - # look up the original payment and optionally a gateway for that payment - ### - - my $cust_pay = ''; - my $amount = $options{'amount'}; - - my( $processor, $login, $password, @bop_options ) ; - my( $auth, $order_number ) = ( '', '', '' ); - - if ( $options{'paynum'} ) { - - warn " paynum: $options{paynum}\n" if $DEBUG > 1; - $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } ) - or return "Unknown paynum $options{'paynum'}"; - $amount ||= $cust_pay->paid; - - $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-]*)(:([\w\-]+))?$/ - or return "Can't parse paybatch for paynum $options{'paynum'}: ". - $cust_pay->paybatch; - my $gatewaynum = ''; - ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 ); - - if ( $gatewaynum ) { #gateway for the payment to be refunded - - my $payment_gateway = - qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } ); - die "payment gateway $gatewaynum not found" - unless $payment_gateway; - - $processor = $payment_gateway->gateway_module; - $login = $payment_gateway->gateway_username; - $password = $payment_gateway->gateway_password; - @bop_options = $payment_gateway->options; - - } else { #try the default gateway - - my( $conf_processor, $unused_action ); - ( $conf_processor, $login, $password, $unused_action, @bop_options ) = - $self->default_payment_gateway($method); - - return "processor of payment $options{'paynum'} $processor does not". - " match default processor $conf_processor" - unless $processor eq $conf_processor; - - } - - - } else { # didn't specify a paynum, so look for agent gateway overrides - # like a normal transaction - - my $cardtype; - if ( $method eq 'CC' ) { - $cardtype = cardtype($self->payinfo); - } elsif ( $method eq 'ECHECK' ) { - $cardtype = 'ACH'; - } else { - $cardtype = $method; - } - my $override = - qsearchs('agent_payment_gateway', { agentnum => $self->agentnum, - cardtype => $cardtype, - taxclass => '', } ) - || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum, - cardtype => '', - taxclass => '', } ); - - if ( $override ) { #use a payment gateway override - - my $payment_gateway = $override->payment_gateway; - - $processor = $payment_gateway->gateway_module; - $login = $payment_gateway->gateway_username; - $password = $payment_gateway->gateway_password; - #$action = $payment_gateway->gateway_action; - @bop_options = $payment_gateway->options; - - } else { #use the standard settings from the config - - my $unused_action; - ( $processor, $login, $password, $unused_action, @bop_options ) = - $self->default_payment_gateway($method); - - } - - } - return "neither amount nor paynum specified" unless $amount; - - my %content = ( - 'type' => $method, - 'login' => $login, - 'password' => $password, - 'order_number' => $order_number, - 'amount' => $amount, - 'referer' => 'http://cleanwhisker.420.am/', - ); - $content{authorization} = $auth - if length($auth); #echeck/ACH transactions have an order # but no auth - #(at least with authorize.net) - - #first try void if applicable - if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates? - warn " attempting void\n" if $DEBUG > 1; - my $void = new Business::OnlinePayment( $processor, @bop_options ); - $void->content( 'action' => 'void', %content ); - $void->submit(); - if ( $void->is_success ) { - my $error = $cust_pay->void($options{'reason'}); - if ( $error ) { - # gah, even with transactions. - my $e = 'WARNING: Card/ACH voided but database not updated - '. - "error voiding payment: $error"; - warn $e; - return $e; - } - warn " void successful\n" if $DEBUG > 1; - return ''; - } - } - - warn " void unsuccessful, trying refund\n" - if $DEBUG > 1; - - #massage data - my $address = $self->address1; - $address .= ", ". $self->address2 if $self->address2; - - my($payname, $payfirst, $paylast); - if ( $self->payname && $method ne 'ECHECK' ) { - $payname = $self->payname; - $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/ - or return "Illegal payname $payname"; - ($payfirst, $paylast) = ($1, $2); - } else { - $payfirst = $self->getfield('first'); - $paylast = $self->getfield('last'); - $payname = "$payfirst $paylast"; - } - - my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list; - if ( $conf->exists('emailinvoiceauto') - || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) { - push @invoicing_list, $self->all_emails; - } - - my $email = ($conf->exists('business-onlinepayment-email-override')) - ? $conf->config('business-onlinepayment-email-override') - : $invoicing_list[0]; - - my $payip = exists($options{'payip'}) - ? $options{'payip'} - : $self->payip; - $content{customer_ip} = $payip - if length($payip); - - my $payinfo = ''; - if ( $method eq 'CC' ) { - - if ( $cust_pay ) { - $content{card_number} = $payinfo = $cust_pay->payinfo; - #$self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; - #$content{expiration} = "$2/$1"; - } else { - $content{card_number} = $payinfo = $self->payinfo; - $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; - $content{expiration} = "$2/$1"; - } - - } elsif ( $method eq 'ECHECK' ) { - ( $content{account_number}, $content{routing_code} ) = - split('@', $payinfo = $self->payinfo); - $content{bank_name} = $self->payname; - $content{account_type} = 'CHECKING'; - $content{account_name} = $payname; - $content{customer_org} = $self->company ? 'B' : 'I'; - $content{customer_ssn} = $self->ss; - } elsif ( $method eq 'LEC' ) { - $content{phone} = $payinfo = $self->payinfo; - } - - #then try refund - my $refund = new Business::OnlinePayment( $processor, @bop_options ); - my %sub_content = $refund->content( - 'action' => 'credit', - 'customer_id' => $self->custnum, - 'last_name' => $paylast, - 'first_name' => $payfirst, - 'name' => $payname, - 'address' => $address, - 'city' => $self->city, - 'state' => $self->state, - 'zip' => $self->zip, - 'country' => $self->country, - 'email' => $email, - 'phone' => $self->daytime || $self->night, - %content, #after - ); - warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content ) - if $DEBUG > 1; - $refund->submit(); - - return "$processor error: ". $refund->error_message - unless $refund->is_success(); - - my %method2payby = ( - 'CC' => 'CARD', - 'ECHECK' => 'CHEK', - 'LEC' => 'LECB', - ); - - my $paybatch = "$processor:". $refund->authorization; - $paybatch .= ':'. $refund->order_number - if $refund->can('order_number') && $refund->order_number; - - while ( $cust_pay && $cust_pay->unappled < $amount ) { - my @cust_bill_pay = $cust_pay->cust_bill_pay; - last unless @cust_bill_pay; - my $cust_bill_pay = pop @cust_bill_pay; - my $error = $cust_bill_pay->delete; - last if $error; - } - - my $cust_refund = new FS::cust_refund ( { - 'custnum' => $self->custnum, - 'paynum' => $options{'paynum'}, - 'refund' => $amount, - '_date' => '', - 'payby' => $method2payby{$method}, - 'payinfo' => $payinfo, - 'paybatch' => $paybatch, - 'reason' => $options{'reason'} || 'card or ACH refund', - } ); - my $error = $cust_refund->insert; - if ( $error ) { - $cust_refund->paynum(''); #try again with no specific paynum - my $error2 = $cust_refund->insert; - if ( $error2 ) { - # gah, even with transactions. - my $e = 'WARNING: Card/ACH refunded but database not updated - '. - "error inserting refund ($processor): $error2". - " (previously tried insert with paynum #$options{'paynum'}" . - ": $error )"; - warn $e; - return $e; - } - } - - ''; #no error - -} - -=item total_owed - -Returns the total owed for this customer on all invoices -(see L<FS::cust_bill/owed>). - -=cut - -sub total_owed { - my $self = shift; - $self->total_owed_date(2145859200); #12/31/2037 -} - -=item total_owed_date TIME - -Returns the total owed for this customer on all invoices with date earlier than -TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also -see L<Time::Local> and L<Date::Parse> for conversion functions. - -=cut - -sub total_owed_date { - my $self = shift; - my $time = shift; - my $total_bill = 0; - foreach my $cust_bill ( - grep { $_->_date <= $time } - qsearch('cust_bill', { 'custnum' => $self->custnum, } ) - ) { - $total_bill += $cust_bill->owed; - } - sprintf( "%.2f", $total_bill ); -} - -=item apply_credits OPTION => VALUE ... - -Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>) -to outstanding invoice balances in chronological order (or reverse -chronological order if the I<order> option is set to B<newest>) and returns the -value of any remaining unapplied credits available for refund (see -L<FS::cust_refund>). - -=cut - -sub apply_credits { - my $self = shift; - my %opt = @_; - - return 0 unless $self->total_credited; - - my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 } - qsearch('cust_credit', { 'custnum' => $self->custnum } ) ); - - my @invoices = $self->open_cust_bill; - @invoices = sort { $b->_date <=> $a->_date } @invoices - if defined($opt{'order'}) && $opt{'order'} eq 'newest'; - - my $credit; - foreach my $cust_bill ( @invoices ) { - my $amount; - - if ( !defined($credit) || $credit->credited == 0) { - $credit = pop @credits or last; - } - - if ($cust_bill->owed >= $credit->credited) { - $amount=$credit->credited; - }else{ - $amount=$cust_bill->owed; - } - - my $cust_credit_bill = new FS::cust_credit_bill ( { - 'crednum' => $credit->crednum, - 'invnum' => $cust_bill->invnum, - 'amount' => $amount, - } ); - my $error = $cust_credit_bill->insert; - die $error if $error; - - redo if ($cust_bill->owed > 0); - - } - - return $self->total_credited; -} - -=item apply_payments - -Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>) -to outstanding invoice balances in chronological order. - - #and returns the value of any remaining unapplied payments. - -=cut - -sub apply_payments { - my $self = shift; - - #return 0 unless - - my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 } - qsearch('cust_pay', { 'custnum' => $self->custnum } ) ); - - my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 } - qsearch('cust_bill', { 'custnum' => $self->custnum } ) ); - - my $payment; - - foreach my $cust_bill ( @invoices ) { - my $amount; - - if ( !defined($payment) || $payment->unapplied == 0 ) { - $payment = pop @payments or last; - } - - if ( $cust_bill->owed >= $payment->unapplied ) { - $amount = $payment->unapplied; - } else { - $amount = $cust_bill->owed; - } - - my $cust_bill_pay = new FS::cust_bill_pay ( { - 'paynum' => $payment->paynum, - 'invnum' => $cust_bill->invnum, - 'amount' => $amount, - } ); - my $error = $cust_bill_pay->insert; - die $error if $error; - - redo if ( $cust_bill->owed > 0); - - } - - return $self->total_unapplied_payments; -} - -=item total_credited - -Returns the total outstanding credit (see L<FS::cust_credit>) for this -customer. See L<FS::cust_credit/credited>. - -=cut - -sub total_credited { - my $self = shift; - my $total_credit = 0; - foreach my $cust_credit ( qsearch('cust_credit', { - 'custnum' => $self->custnum, - } ) ) { - $total_credit += $cust_credit->credited; - } - sprintf( "%.2f", $total_credit ); -} - -=item total_unapplied_payments - -Returns the total unapplied payments (see L<FS::cust_pay>) for this customer. -See L<FS::cust_pay/unapplied>. - -=cut - -sub total_unapplied_payments { - my $self = shift; - my $total_unapplied = 0; - foreach my $cust_pay ( qsearch('cust_pay', { - 'custnum' => $self->custnum, - } ) ) { - $total_unapplied += $cust_pay->unapplied; - } - sprintf( "%.2f", $total_unapplied ); -} - -=item balance - -Returns the balance for this customer (total_owed minus total_credited -minus total_unapplied_payments). - -=cut - -sub balance { - my $self = shift; - sprintf( "%.2f", - $self->total_owed - $self->total_credited - $self->total_unapplied_payments - ); -} - -=item balance_date TIME - -Returns the balance for this customer, only considering invoices with date -earlier than TIME (total_owed_date minus total_credited minus -total_unapplied_payments). TIME is specified as a UNIX timestamp; see -L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion -functions. - -=cut - -sub balance_date { - my $self = shift; - my $time = shift; - sprintf( "%.2f", - $self->total_owed_date($time) - - $self->total_credited - - $self->total_unapplied_payments - ); -} - -=item in_transit_payments - -Returns the total of requests for payments for this customer pending in -batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch> - -=cut - -sub in_transit_payments { - my $self = shift; - my $in_transit_payments = 0; - foreach my $pay_batch ( qsearch('pay_batch', { - 'status' => 'I', - } ) ) { - foreach my $cust_pay_batch ( qsearch('cust_pay_batch', { - 'batchnum' => $pay_batch->batchnum, - 'custnum' => $self->custnum, - } ) ) { - $in_transit_payments += $cust_pay_batch->amount; - } - } - sprintf( "%.2f", $in_transit_payments ); -} - -=item paydate_monthyear - -Returns a two-element list consisting of the month and year of this customer's -paydate (credit card expiration date for CARD customers) - -=cut - -sub paydate_monthyear { - my $self = shift; - if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format - ( $2, $1 ); - } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) { - ( $1, $3 ); - } else { - ('', ''); - } -} - -=item payinfo_masked - -Returns a "masked" payinfo field appropriate to the payment type. Masked characters are replaced by 'x'es. Use this to display publicly accessable account Information. - -Credit Cards - Mask all but the last four characters. -Checks - Mask all but last 2 of account number and bank routing number. -Others - Do nothing, return the unmasked string. - -=cut - -sub payinfo_masked { - my $self = shift; - return $self->paymask; -} - -=item invoicing_list [ ARRAYREF ] - -If an arguement is given, sets these email addresses as invoice recipients -(see L<FS::cust_main_invoice>). Errors are not fatal and are not reported -(except as warnings), so use check_invoicing_list first. - -Returns a list of email addresses (with svcnum entries expanded). - -Note: You can clear the invoicing list by passing an empty ARRAYREF. You can -check it without disturbing anything by passing nothing. - -This interface may change in the future. - -=cut - -sub invoicing_list { - my( $self, $arrayref ) = @_; - - if ( $arrayref ) { - my @cust_main_invoice; - if ( $self->custnum ) { - @cust_main_invoice = - qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } ); - } else { - @cust_main_invoice = (); - } - foreach my $cust_main_invoice ( @cust_main_invoice ) { - #warn $cust_main_invoice->destnum; - unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) { - #warn $cust_main_invoice->destnum; - my $error = $cust_main_invoice->delete; - warn $error if $error; - } - } - if ( $self->custnum ) { - @cust_main_invoice = - qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } ); - } else { - @cust_main_invoice = (); - } - my %seen = map { $_->address => 1 } @cust_main_invoice; - foreach my $address ( @{$arrayref} ) { - next if exists $seen{$address} && $seen{$address}; - $seen{$address} = 1; - my $cust_main_invoice = new FS::cust_main_invoice ( { - 'custnum' => $self->custnum, - 'dest' => $address, - } ); - my $error = $cust_main_invoice->insert; - warn $error if $error; - } - } - - if ( $self->custnum ) { - map { $_->address } - qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } ); - } else { - (); - } - -} - -=item check_invoicing_list ARRAYREF - -Checks these arguements as valid input for the invoicing_list method. If there -is an error, returns the error, otherwise returns false. - -=cut - -sub check_invoicing_list { - my( $self, $arrayref ) = @_; - foreach my $address ( @{$arrayref} ) { - - if ($address eq 'FAX' and $self->getfield('fax') eq '') { - return 'Can\'t add FAX invoice destination with a blank FAX number.'; - } - - my $cust_main_invoice = new FS::cust_main_invoice ( { - 'custnum' => $self->custnum, - 'dest' => $address, - } ); - my $error = $self->custnum - ? $cust_main_invoice->check - : $cust_main_invoice->checkdest - ; - return $error if $error; - } - ''; -} - -=item set_default_invoicing_list - -Sets the invoicing list to all accounts associated with this customer, -overwriting any previous invoicing list. - -=cut - -sub set_default_invoicing_list { - my $self = shift; - $self->invoicing_list($self->all_emails); -} - -=item all_emails - -Returns the email addresses of all accounts provisioned for this customer. - -=cut - -sub all_emails { - my $self = shift; - my %list; - foreach my $cust_pkg ( $self->all_pkgs ) { - my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } ); - my @svc_acct = - map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) } - grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) } - @cust_svc; - $list{$_}=1 foreach map { $_->email } @svc_acct; - } - keys %list; -} - -=item invoicing_list_addpost - -Adds postal invoicing to this customer. If this customer is already configured -to receive postal invoices, does nothing. - -=cut - -sub invoicing_list_addpost { - my $self = shift; - return if grep { $_ eq 'POST' } $self->invoicing_list; - my @invoicing_list = $self->invoicing_list; - push @invoicing_list, 'POST'; - $self->invoicing_list(\@invoicing_list); -} - -=item invoicing_list_emailonly - -Returns the list of email invoice recipients (invoicing_list without non-email -destinations such as POST and FAX). - -=cut - -sub invoicing_list_emailonly { - my $self = shift; - grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list; -} - -=item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ] - -Returns an array of customers referred by this customer (referral_custnum set -to this custnum). If DEPTH is given, recurses up to the given depth, returning -customers referred by customers referred by this customer and so on, inclusive. -The default behavior is DEPTH 1 (no recursion). - -=cut - -sub referral_cust_main { - my $self = shift; - my $depth = @_ ? shift : 1; - my $exclude = @_ ? shift : {}; - - my @cust_main = - map { $exclude->{$_->custnum}++; $_; } - grep { ! $exclude->{ $_->custnum } } - qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } ); - - if ( $depth > 1 ) { - push @cust_main, - map { $_->referral_cust_main($depth-1, $exclude) } - @cust_main; - } - - @cust_main; -} - -=item referral_cust_main_ncancelled - -Same as referral_cust_main, except only returns customers with uncancelled -packages. - -=cut - -sub referral_cust_main_ncancelled { - my $self = shift; - grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main; -} - -=item referral_cust_pkg [ DEPTH ] - -Like referral_cust_main, except returns a flat list of all unsuspended (and -uncancelled) packages for each customer. The number of items in this list may -be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ). - -=cut - -sub referral_cust_pkg { - my $self = shift; - my $depth = @_ ? shift : 1; - - map { $_->unsuspended_pkgs } - grep { $_->unsuspended_pkgs } - $self->referral_cust_main($depth); -} - -=item referring_cust_main - -Returns the single cust_main record for the customer who referred this customer -(referral_custnum), or false. - -=cut - -sub referring_cust_main { - my $self = shift; - return '' unless $self->referral_custnum; - qsearchs('cust_main', { 'custnum' => $self->referral_custnum } ); -} - -=item credit AMOUNT, REASON - -Applies a credit to this customer. If there is an error, returns the error, -otherwise returns false. - -=cut - -sub credit { - my( $self, $amount, $reason ) = @_; - my $cust_credit = new FS::cust_credit { - 'custnum' => $self->custnum, - 'amount' => $amount, - 'reason' => $reason, - }; - $cust_credit->insert; -} - -=item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ] - -Creates a one-time charge for this customer. If there is an error, returns -the error, otherwise returns false. - -=cut - -sub charge { - my ( $self, $amount ) = ( shift, shift ); - my $pkg = @_ ? shift : 'One-time charge'; - my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount); - my $taxclass = @_ ? 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_pkg = new FS::part_pkg ( { - 'pkg' => $pkg, - 'comment' => $comment, - #'setup' => $amount, - #'recur' => '0', - 'plan' => 'flat', - 'plandata' => "setup_fee=$amount", - 'freq' => 0, - 'disabled' => 'Y', - 'taxclass' => $taxclass, - } ); - - my $error = $part_pkg->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - my $pkgpart = $part_pkg->pkgpart; - my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart ); - unless ( qsearchs('type_pkgs', \%type_pkgs ) ) { - my $type_pkgs = new FS::type_pkgs \%type_pkgs; - $error = $type_pkgs->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - my $cust_pkg = new FS::cust_pkg ( { - 'custnum' => $self->custnum, - 'pkgpart' => $pkgpart, - } ); - - $error = $cust_pkg->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - -} - -=item cust_bill - -Returns all the invoices (see L<FS::cust_bill>) for this customer. - -=cut - -sub cust_bill { - my $self = shift; - sort { $a->_date <=> $b->_date } - qsearch('cust_bill', { 'custnum' => $self->custnum, } ) -} - -=item open_cust_bill - -Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this -customer. - -=cut - -sub open_cust_bill { - my $self = shift; - grep { $_->owed > 0 } $self->cust_bill; -} - -=item cust_credit - -Returns all the credits (see L<FS::cust_credit>) for this customer. - -=cut - -sub cust_credit { - my $self = shift; - sort { $a->_date <=> $b->_date } - qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) -} - -=item cust_pay - -Returns all the payments (see L<FS::cust_pay>) for this customer. - -=cut - -sub cust_pay { - my $self = shift; - sort { $a->_date <=> $b->_date } - qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) -} - -=item cust_pay_void - -Returns all voided payments (see L<FS::cust_pay_void>) for this customer. - -=cut - -sub cust_pay_void { - my $self = shift; - sort { $a->_date <=> $b->_date } - qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } ) -} - - -=item cust_refund - -Returns all the refunds (see L<FS::cust_refund>) for this customer. - -=cut - -sub cust_refund { - my $self = shift; - sort { $a->_date <=> $b->_date } - qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) -} - -=item select_for_update - -Selects this record with the SQL "FOR UPDATE" command. This can be useful as -a mutex. - -=cut - -sub select_for_update { - my $self = shift; - qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' ); -} - -=item name - -Returns a name string for this customer, either "Company (Last, First)" or -"Last, First". - -=cut - -sub name { - my $self = shift; - my $name = $self->contact; - $name = $self->company. " ($name)" if $self->company; - $name; -} - -=item ship_name - -Returns a name string for this (service/shipping) contact, either -"Company (Last, First)" or "Last, First". - -=cut - -sub ship_name { - my $self = shift; - if ( $self->get('ship_last') ) { - my $name = $self->ship_contact; - $name = $self->ship_company. " ($name)" if $self->ship_company; - $name; - } else { - $self->name; - } -} - -=item contact - -Returns this customer's full (billing) contact name only, "Last, First" - -=cut - -sub contact { - my $self = shift; - $self->get('last'). ', '. $self->first; -} - -=item ship_contact - -Returns this customer's full (shipping) contact name only, "Last, First" - -=cut - -sub ship_contact { - my $self = shift; - $self->get('ship_last') - ? $self->get('ship_last'). ', '. $self->ship_first - : $self->contact; -} - -=item country_full - -Returns this customer's full country name - -=cut - -sub country_full { - my $self = shift; - code2country($self->country); -} - -=item status - -Returns a status string for this customer, currently: - -=over 4 - -=item prospect - No packages have ever been ordered - -=item active - One or more recurring packages is active - -=item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled) - -=item suspended - All non-cancelled recurring packages are suspended - -=item cancelled - All recurring packages are cancelled - -=back - -=cut - -sub status { - my $self = shift; - for my $status (qw( prospect active inactive suspended cancelled )) { - my $method = $status.'_sql'; - my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g; - my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr; - $sth->execute( ($self->custnum) x $numnum ) or die $sth->errstr; - return $status if $sth->fetchrow_arrayref->[0]; - } -} - -=item statuscolor - -Returns a hex triplet color string for this customer's status. - -=cut - -use vars qw(%statuscolor); -%statuscolor = ( - 'prospect' => '7e0079', #'000000', #black? naw, purple - 'active' => '00CC00', #green - 'inactive' => '0000CC', #blue - 'suspended' => 'FF9900', #yellow - 'cancelled' => 'FF0000', #red -); - -sub statuscolor { - my $self = shift; - $statuscolor{$self->status}; -} - -=back - -=head1 CLASS METHODS - -=over 4 - -=item prospect_sql - -Returns an SQL expression identifying prospective cust_main records (customers -with no packages ever ordered) - -=cut - -use vars qw($select_count_pkgs); -$select_count_pkgs = - "SELECT COUNT(*) FROM cust_pkg - WHERE cust_pkg.custnum = cust_main.custnum"; - -sub select_count_pkgs_sql { - $select_count_pkgs; -} - -sub prospect_sql { " - 0 = ( $select_count_pkgs ) -"; } - -=item active_sql - -Returns an SQL expression identifying active cust_main records (customers with -no active recurring packages, but otherwise unsuspended/uncancelled). - -=cut - -sub active_sql { " - 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " - ) -"; } - -=item inactive_sql - -Returns an SQL expression identifying inactive cust_main records (customers with -active recurring packages). - -=cut - -sub inactive_sql { " - 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) - AND - 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) -"; } - -=item susp_sql -=item suspended_sql - -Returns an SQL expression identifying suspended cust_main records. - -=cut - - -sub suspended_sql { susp_sql(@_); } -sub susp_sql { " - 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) - AND - 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) -"; } - -=item cancel_sql -=item cancelled_sql - -Returns an SQL expression identifying cancelled cust_main records. - -=cut - -sub cancelled_sql { cancel_sql(@_); } -sub cancel_sql { - - my $recurring_sql = FS::cust_pkg->recurring_sql; - #my $recurring_sql = " - # '0' != ( select freq from part_pkg - # where cust_pkg.pkgpart = part_pkg.pkgpart ) - #"; - - " - 0 < ( $select_count_pkgs ) - AND 0 = ( $select_count_pkgs AND $recurring_sql - AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) - ) - "; -} - -=item uncancel_sql -=item uncancelled_sql - -Returns an SQL expression identifying un-cancelled cust_main records. - -=cut - -sub uncancelled_sql { uncancel_sql(@_); } -sub uncancel_sql { " - ( 0 < ( $select_count_pkgs - AND ( cust_pkg.cancel IS NULL - OR cust_pkg.cancel = 0 - ) - ) - OR 0 = ( $select_count_pkgs ) - ) -"; } - -=item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ] - -Performs a fuzzy (approximate) search and returns the matching FS::cust_main -records. Currently, I<first>, I<last> and/or I<company> may be specified (the -appropriate ship_ field is also searched). - -Additional options are the same as FS::Record::qsearch - -=cut - -sub fuzzy_search { - my( $self, $fuzzy, $hash, @opt) = @_; - #$self - $hash ||= {}; - my @cust_main = (); - - check_and_rebuild_fuzzyfiles(); - foreach my $field ( keys %$fuzzy ) { - my %match = (); - $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, - ['i'], - @{ $self->all_X($field) } - ) - ); - - my @fcust = (); - foreach ( keys %match ) { - push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt); - push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt); - } - my %fsaw = (); - push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust; - } - - # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes - my %saw = (); - @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main; - - @cust_main; - -} - -=back - -=head1 SUBROUTINES - -=over 4 - -=item smart_search OPTION => VALUE ... - -Accepts the following options: I<search>, the string to search for. The string -will be searched for as a customer number, phone number, name or company name, -first searching for an exact match then fuzzy and substring matches (in some -cases - see the source code for the exact heuristics used). - -Any additional options treated as an additional qualifier on the search -(i.e. I<agentnum>). - -Returns a (possibly empty) array of FS::cust_main objects. - -=cut - -sub smart_search { - my %options = @_; - - #here is the agent virtualization - my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql; - - my @cust_main = (); - - my $search = delete $options{'search'}; - ( my $alphanum_search = $search ) =~ s/\W//g; - - if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search - - #false laziness w/Record::ut_phone - my $phonen = "$1-$2-$3"; - $phonen .= " x$4" if $4; - - push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => { %options }, - 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ). - ' ( '. - join(' OR ', map "$_ = '$phonen'", - qw( daytime night fax - ship_daytime ship_night ship_fax ) - ). - ' ) '. - " AND $agentnums_sql", #agent virtualization - } ); - - unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match - #try looking for matches with extensions unless one was specified - - push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => { %options }, - 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ). - ' ( '. - join(' OR ', map "$_ LIKE '$phonen\%'", - qw( daytime night - ship_daytime ship_night ) - ). - ' ) '. - " AND $agentnums_sql", #agent virtualization - } ); - - } - - } elsif ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search - - push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => { 'custnum' => $1, %options }, - 'extra_sql' => " AND $agentnums_sql", #agent virtualization - } ); - - } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) { - - my($company, $last, $first) = ( $1, $2, $3 ); - - # "Company (Last, First)" - #this is probably something a browser remembered, - #so just do an exact search - - foreach my $prefix ( '', 'ship_' ) { - push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => { $prefix.'first' => $first, - $prefix.'last' => $last, - $prefix.'company' => $company, - %options, - }, - 'extra_sql' => " AND $agentnums_sql", - } ); - } - - } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search - # try (ship_){last,company} - - my $value = lc($1); - - # # remove "(Last, First)" in "Company (Last, First)", otherwise the - # # full strings the browser remembers won't work - # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name - - use Lingua::EN::NameParse; - my $NameParse = new Lingua::EN::NameParse( - auto_clean => 1, - allow_reversed => 1, - ); - - my($last, $first) = ( '', '' ); - #maybe disable this too and just rely on NameParse? - if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First - - ($last, $first) = ( $1, $2 ); - - #} elsif ( $value =~ /^(.+)\s+(.+)$/ ) { - } elsif ( ! $NameParse->parse($value) ) { - - my %name = $NameParse->components; - $first = $name{'given_name_1'}; - $last = $name{'surname_1'}; - - } - - if ( $first && $last ) { - - my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) ); - - #exact - my $sql = scalar(keys %options) ? ' AND ' : ' WHERE '; - $sql .= " - ( ( LOWER(last) = $q_last AND LOWER(first) = $q_first ) - OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first ) - )"; - - push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => \%options, - 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization - } ); - - # or it just be something that was typed in... (try that in a sec) - - } - - my $q_value = dbh->quote($value); - - #exact - my $sql = scalar(keys %options) ? ' AND ' : ' WHERE '; - $sql .= " ( LOWER(last) = $q_value - OR LOWER(company) = $q_value - OR LOWER(ship_last) = $q_value - OR LOWER(ship_company) = $q_value - )"; - - push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => \%options, - 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization - } ); - - unless ( @cust_main ) { #no exact match, trying substring/fuzzy - - #still some false laziness w/ search/cust_main.cgi - - #substring - - my @hashrefs = ( - { 'company' => { op=>'ILIKE', value=>"%$value%" }, }, - { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, }, - ); - - if ( $first && $last ) { - - push @hashrefs, - { 'first' => { op=>'ILIKE', value=>"%$first%" }, - 'last' => { op=>'ILIKE', value=>"%$last%" }, - }, - { 'ship_first' => { op=>'ILIKE', value=>"%$first%" }, - 'ship_last' => { op=>'ILIKE', value=>"%$last%" }, - }, - ; - - } else { - - push @hashrefs, - { 'last' => { op=>'ILIKE', value=>"%$value%" }, }, - { 'ship_last' => { op=>'ILIKE', value=>"%$value%" }, }, - ; - } - - foreach my $hashref ( @hashrefs ) { - - push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => { %$hashref, - %options, - }, - 'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton - } ); - - } - - #fuzzy - my @fuzopts = ( - \%options, #hashref - '', #select - " AND $agentnums_sql", #extra_sql #agent virtualization - ); - - if ( $first && $last ) { - push @cust_main, FS::cust_main->fuzzy_search( - { 'last' => $last, #fuzzy hashref - 'first' => $first }, # - @fuzopts - ); - } - foreach my $field ( 'last', 'company' ) { - push @cust_main, - FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts ); - } - - } - - #eliminate duplicates - my %saw = (); - @cust_main = grep { !$saw{$_->custnum}++ } @cust_main; - - } - - @cust_main; - -} - -=item check_and_rebuild_fuzzyfiles - -=cut - -use vars qw(@fuzzyfields); -@fuzzyfields = ( 'last', 'first', 'company' ); - -sub check_and_rebuild_fuzzyfiles { - my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; - rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields -} - -=item rebuild_fuzzyfiles - -=cut - -sub rebuild_fuzzyfiles { - - use Fcntl qw(:flock); - - my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; - mkdir $dir, 0700 unless -d $dir; - - foreach my $fuzzy ( @fuzzyfields ) { - - open(LOCK,">>$dir/cust_main.$fuzzy") - or die "can't open $dir/cust_main.$fuzzy: $!"; - flock(LOCK,LOCK_EX) - or die "can't lock $dir/cust_main.$fuzzy: $!"; - - open (CACHE,">$dir/cust_main.$fuzzy.tmp") - or die "can't open $dir/cust_main.$fuzzy.tmp: $!"; - - foreach my $field ( $fuzzy, "ship_$fuzzy" ) { - my $sth = dbh->prepare("SELECT $field FROM cust_main". - " WHERE $field != '' AND $field IS NOT NULL"); - $sth->execute or die $sth->errstr; - - while ( my $row = $sth->fetchrow_arrayref ) { - print CACHE $row->[0]. "\n"; - } - - } - - close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!"; - - rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy"; - close LOCK; - } - -} - -=item all_X - -=cut - -sub all_X { - my( $self, $field ) = @_; - my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; - open(CACHE,"<$dir/cust_main.$field") - or die "can't open $dir/cust_main.$field: $!"; - my @array = map { chomp; $_; } <CACHE>; - close CACHE; - \@array; -} - -=item append_fuzzyfiles LASTNAME COMPANY - -=cut - -sub append_fuzzyfiles { - #my( $first, $last, $company ) = @_; - - &check_and_rebuild_fuzzyfiles; - - use Fcntl qw(:flock); - - my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; - - foreach my $field (qw( first last company )) { - my $value = shift; - - if ( $value ) { - - open(CACHE,">>$dir/cust_main.$field") - or die "can't open $dir/cust_main.$field: $!"; - flock(CACHE,LOCK_EX) - or die "can't lock $dir/cust_main.$field: $!"; - - print CACHE "$value\n"; - - flock(CACHE,LOCK_UN) - or die "can't unlock $dir/cust_main.$field: $!"; - close CACHE; - } - - } - - 1; -} - -=item batch_import - -=cut - -sub batch_import { - my $param = shift; - #warn join('-',keys %$param); - my $fh = $param->{filehandle}; - my $agentnum = $param->{agentnum}; - - my $refnum = $param->{refnum}; - my $pkgpart = $param->{pkgpart}; - - #my @fields = @{$param->{fields}}; - my $format = $param->{'format'}; - my @fields; - my $payby; - if ( $format eq 'simple' ) { - @fields = qw( cust_pkg.setup dayphone first last - address1 address2 city state zip comments ); - $payby = 'BILL'; - } elsif ( $format eq 'extended' ) { - @fields = qw( agent_custid refnum - last first address1 address2 city state zip country - daytime night - ship_last ship_first ship_address1 ship_address2 - ship_city ship_state ship_zip ship_country - payinfo paycvv paydate - invoicing_list - cust_pkg.pkgpart - svc_acct.username svc_acct._password - ); - $payby = 'BILL'; - } else { - die "unknown format $format"; - } - - eval "use Text::CSV_XS;"; - die $@ if $@; - - my $csv = new Text::CSV_XS; - #warn $csv; - #warn $fh; - - my $imported = 0; - #my $columns; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - #while ( $columns = $csv->getline($fh) ) { - my $line; - while ( defined($line=<$fh>) ) { - - $csv->parse($line) or do { - $dbh->rollback if $oldAutoCommit; - return "can't parse: ". $csv->error_input(); - }; - - my @columns = $csv->fields(); - #warn join('-',@columns); - - my %cust_main = ( - agentnum => $agentnum, - refnum => $refnum, - country => $conf->config('countrydefault') || 'US', - payby => $payby, #default - paydate => '12/2037', #default - ); - my $billtime = time; - my %cust_pkg = ( pkgpart => $pkgpart ); - my %svc_acct = (); - foreach my $field ( @fields ) { - - if ( $field =~ /^cust_pkg\.(pkgpart|setup|bill|susp|expire|cancel)$/ ) { - - #$cust_pkg{$1} = str2time( shift @$columns ); - if ( $1 eq 'pkgpart' ) { - $cust_pkg{$1} = shift @columns; - } elsif ( $1 eq 'setup' ) { - $billtime = str2time(shift @columns); - } else { - $cust_pkg{$1} = str2time( shift @columns ); - } - - } elsif ( $field =~ /^svc_acct\.(username|_password)$/ ) { - - $svc_acct{$1} = shift @columns; - - } else { - - #refnum interception - if ( $field eq 'refnum' && $columns[0] !~ /^\s*(\d+)\s*$/ ) { - - my $referral = $columns[0]; - my %hash = ( 'referral' => $referral, - 'agentnum' => $agentnum, - 'disabled' => '', - ); - - my $part_referral = qsearchs('part_referral', \%hash ) - || new FS::part_referral \%hash; - - unless ( $part_referral->refnum ) { - my $error = $part_referral->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "can't auto-insert advertising source: $referral: $error"; - } - } - - $columns[0] = $part_referral->refnum; - } - - #$cust_main{$field} = shift @$columns; - $cust_main{$field} = shift @columns; - } - } - - $cust_main{'payby'} = 'CARD' if length($cust_main{'payinfo'}); - - my $invoicing_list = $cust_main{'invoicing_list'} - ? [ delete $cust_main{'invoicing_list'} ] - : []; - - my $cust_main = new FS::cust_main ( \%cust_main ); - - use Tie::RefHash; - tie my %hash, 'Tie::RefHash'; #this part is important - - if ( $cust_pkg{'pkgpart'} ) { - my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ); - - my @svc_acct = (); - if ( $svc_acct{'username'} ) { - $svc_acct{svcpart} = $cust_pkg->part_pkg->svcpart( 'svc_acct' ); - push @svc_acct, new FS::svc_acct ( \%svc_acct ) - } - - $hash{$cust_pkg} = \@svc_acct; - } - - my $error = $cust_main->insert( \%hash, $invoicing_list ); - - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "can't insert customer for $line: $error"; - } - - if ( $format eq 'simple' ) { - - #false laziness w/bill.cgi - $error = $cust_main->bill( 'time' => $billtime ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "can't bill customer for $line: $error"; - } - - $cust_main->apply_payments; - $cust_main->apply_credits; - - $error = $cust_main->collect(); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "can't collect customer for $line: $error"; - } - - } - - $imported++; - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - return "Empty file!" unless $imported; - - ''; #no error - -} - -=item batch_charge - -=cut - -sub batch_charge { - my $param = shift; - #warn join('-',keys %$param); - my $fh = $param->{filehandle}; - my @fields = @{$param->{fields}}; - - eval "use Text::CSV_XS;"; - die $@ if $@; - - my $csv = new Text::CSV_XS; - #warn $csv; - #warn $fh; - - my $imported = 0; - #my $columns; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - #while ( $columns = $csv->getline($fh) ) { - my $line; - while ( defined($line=<$fh>) ) { - - $csv->parse($line) or do { - $dbh->rollback if $oldAutoCommit; - return "can't parse: ". $csv->error_input(); - }; - - my @columns = $csv->fields(); - #warn join('-',@columns); - - my %row = (); - foreach my $field ( @fields ) { - $row{$field} = shift @columns; - } - - my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } ); - unless ( $cust_main ) { - $dbh->rollback if $oldAutoCommit; - return "unknown custnum $row{'custnum'}"; - } - - if ( $row{'amount'} > 0 ) { - my $error = $cust_main->charge($row{'amount'}, $row{'pkg'}); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - $imported++; - } elsif ( $row{'amount'} < 0 ) { - my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ), - $row{'pkg'} ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - $imported++; - } else { - #hmm? - } - - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - return "Empty file!" unless $imported; - - ''; #no error - -} - -=back - -=head1 BUGS - -The delete method. - -The delete method should possibly take an FS::cust_main object reference -instead of a scalar customer number. - -Bill and collect options should probably be passed as references instead of a -list. - -There should probably be a configuration file with a list of allowed credit -card types. - -No multiple currency support (probably a larger project than just this module). - -payinfo_masked false laziness with cust_pay.pm and cust_refund.pm - -=head1 SEE ALSO - -L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit> -L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>, -L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/cust_main_Mixin.pm b/FS/FS/cust_main_Mixin.pm deleted file mode 100644 index aa4143d..0000000 --- a/FS/FS/cust_main_Mixin.pm +++ /dev/null @@ -1,147 +0,0 @@ -package FS::cust_main_Mixin; - -use strict; -use FS::cust_main; - -=head1 NAME - -FS::cust_main_Mixin - Mixin class for records that contain fields from cust_main - -=head1 SYNOPSIS - -package FS::some_table; -use vars qw(@ISA); -@ISA = qw( FS::cust_main_Mixin FS::Record ); - -=head1 DESCRIPTION - -This is a mixin class for records that contain fields from the cust_main table, -for example, from a JOINed search. See httemplate/search/ for examples. - -=head1 METHODS - -=over 4 - -=item name - -Given an object that contains fields from cust_main (say, from a JOINed -search; see httemplate/search/ for examples), returns the equivalent of the -FS::cust_main I<name> method, or "(unlinked)" if this object is not linked to -a customer. - -=cut - -sub cust_unlinked_msg { '(unlinked)'; } -sub cust_linked { $_[0]->custnum; } - -sub name { - my $self = shift; - $self->cust_linked - ? FS::cust_main::name($self) - : $self->cust_unlinked_msg; -} - -=item ship_name - -Given an object that contains fields from cust_main (say, from a JOINed -search; see httemplate/search/ for examples), returns the equivalent of the -FS::cust_main I<ship_name> method, or "(unlinked)" if this object is not -linked to a customer. - -=cut - -sub ship_name { - my $self = shift; - $self->cust_linked - ? FS::cust_main::ship_name($self) - : $self->cust_unlinked_msg; -} - -=item contact - -Given an object that contains fields from cust_main (say, from a JOINed -search; see httemplate/search/ for examples), returns the equivalent of the -FS::cust_main I<contact> method, or "(unlinked)" if this object is not linked -to a customer. - -=cut - -sub contact { - my $self = shift; - $self->cust_linked - ? FS::cust_main::contact($self) - : $self->cust_unlinked_msg; -} - -=item ship_contact - -Given an object that contains fields from cust_main (say, from a JOINed -search; see httemplate/search/ for examples), returns the equivalent of the -FS::cust_main I<ship_contact> method, or "(unlinked)" if this object is not -linked to a customer. - -=cut - -sub ship_contact { - my $self = shift; - $self->cust_linked - ? FS::cust_main::ship_contact($self) - : $self->cust_unlinked_msg; -} - -=item country_full - -Given an object that contains fields from cust_main (say, from a JOINed -search; see httemplate/search/ for examples), returns the equivalent of the -FS::cust_main I<country_full> method, or "(unlinked)" if this object is not -linked to a customer. - -=cut - -sub country_full { - my $self = shift; - $self->cust_linked - ? FS::cust_main::country_full($self) - : $self->cust_unlinked_msg; -} - -=item invoicing_list_emailonly - -Given an object that contains fields from cust_main (say, from a JOINed -search; see httemplate/search/ for examples), returns the equivalent of the -FS::cust_main I<country_full> method, or "(unlinked)" if this object is not -linked to a customer. - -=cut - -sub invoicing_list_emailonly { - my $self = shift; - warn "invoicing_list_email only called on $self, ". - "custnum ". $self->custnum. "\n"; - $self->cust_linked - ? FS::cust_main::invoicing_list_emailonly($self) - : $self->cust_unlinked_msg; -} - -#read-only -sub invoicing_list { - my $self = shift; - $self->cust_linked - ? FS::cust_main::invoicing_list($self) - : (); -} - -=cut - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::cust_main>, L<FS::Record> - -=cut - -1; - diff --git a/FS/FS/cust_main_county.pm b/FS/FS/cust_main_county.pm deleted file mode 100644 index 17f3460..0000000 --- a/FS/FS/cust_main_county.pm +++ /dev/null @@ -1,291 +0,0 @@ -package FS::cust_main_county; - -use strict; -use vars qw( @ISA @EXPORT_OK $conf - @cust_main_county %cust_main_county $countyflag ); -use Exporter; -use FS::Record qw( qsearch ); - -@ISA = qw( FS::Record ); -@EXPORT_OK = qw( regionselector ); - -@cust_main_county = (); -$countyflag = ''; - -#ask FS::UID to run this stuff for us later -$FS::UID::callback{'FS::cust_main_county'} = sub { - $conf = new FS::Conf; -}; - -=head1 NAME - -FS::cust_main_county - Object methods for cust_main_county objects - -=head1 SYNOPSIS - - use FS::cust_main_county; - - $record = new FS::cust_main_county \%hash; - $record = new FS::cust_main_county { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - - ($county_html, $state_html, $country_html) = - FS::cust_main_county::regionselector( $county, $state, $country ); - -=head1 DESCRIPTION - -An FS::cust_main_county object represents a tax rate, defined by locale. -FS::cust_main_county inherits from FS::Record. The following fields are -currently supported: - -=over 4 - -=item taxnum - primary key (assigned automatically for new tax rates) - -=item state - -=item county - -=item country - -=item tax - percentage - -=item taxclass - -=item exempt_amount - -=item taxname - if defined, printed on invoices instead of "Tax" - -=item setuptax - if 'Y', this tax does not apply to setup fees - -=item recurtax - if 'Y', this tax does not apply to recurring fees - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new tax rate. To add the tax rate to the database, see L<"insert">. - -=cut - -sub table { 'cust_main_county'; } - -=item insert - -Adds this tax rate to the database. If there is an error, returns the error, -otherwise returns false. - -=item delete - -Deletes this tax rate from the database. If there is an error, returns the -error, otherwise returns false. - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=item check - -Checks all fields to make sure this is a valid tax rate. If there is an error, -returns the error, otherwise returns false. Called by the insert and replace -methods. - -=cut - -sub check { - my $self = shift; - - $self->exempt_amount(0) unless $self->exempt_amount; - - $self->ut_numbern('taxnum') - || $self->ut_anything('state') - || $self->ut_textn('county') - || $self->ut_text('country') - || $self->ut_float('tax') - || $self->ut_textn('taxclass') # ... - || $self->ut_money('exempt_amount') - || $self->ut_textn('taxname') - || $self->ut_enum('setuptax', [ '', 'Y' ] ) - || $self->ut_enum('recurtax', [ '', 'Y' ] ) - || $self->SUPER::check - ; - -} - -sub taxname { - my $self = shift; - if ( $self->dbdef_table->column('taxname') ) { - return $self->setfield('taxname', $_[0]) if @_; - return $self->getfield('taxname'); - } - return ''; -} - -sub setuptax { - my $self = shift; - if ( $self->dbdef_table->column('setuptax') ) { - return $self->setfield('setuptax', $_[0]) if @_; - return $self->getfield('setuptax'); - } - return ''; -} - -sub recurtax { - my $self = shift; - if ( $self->dbdef_table->column('recurtax') ) { - return $self->setfield('recurtax', $_[0]) if @_; - return $self->getfield('recurtax'); - } - return ''; -} - -=back - -=head1 SUBROUTINES - -=over 4 - -=item regionselector [ COUNTY STATE COUNTRY [ PREFIX [ ONCHANGE [ DISABLED ] ] ] ] - -=cut - -sub regionselector { - my ( $selected_county, $selected_state, $selected_country, - $prefix, $onchange, $disabled ) = @_; - - $prefix = '' unless defined $prefix; - - $countyflag = 0; - -# unless ( @cust_main_county ) { #cache - @cust_main_county = qsearch('cust_main_county', {} ); - foreach my $c ( @cust_main_county ) { - $countyflag=1 if $c->county; - #push @{$cust_main_county{$c->country}{$c->state}}, $c->county; - $cust_main_county{$c->country}{$c->state}{$c->county} = 1; - } -# } - $countyflag=1 if $selected_county; - - my $script_html = <<END; - <SCRIPT> - function opt(what,value,text) { - var optionName = new Option(text, value, false, false); - var length = what.length; - what.options[length] = optionName; - } - function ${prefix}country_changed(what) { - country = what.options[what.selectedIndex].text; - for ( var i = what.form.${prefix}state.length; i >= 0; i-- ) - what.form.${prefix}state.options[i] = null; -END - #what.form.${prefix}state.options[0] = new Option('', '', false, true); - - foreach my $country ( sort keys %cust_main_county ) { - $script_html .= "\nif ( country == \"$country\" ) {\n"; - foreach my $state ( sort keys %{$cust_main_county{$country}} ) { - ( my $dstate = $state ) =~ s/[\n\r]//g; - my $text = $dstate || '(n/a)'; - $script_html .= qq!opt(what.form.${prefix}state, "$dstate", "$text");\n!; - } - $script_html .= "}\n"; - } - - $script_html .= <<END; - } - function ${prefix}state_changed(what) { -END - - if ( $countyflag ) { - $script_html .= <<END; - state = what.options[what.selectedIndex].text; - country = what.form.${prefix}country.options[what.form.${prefix}country.selectedIndex].text; - for ( var i = what.form.${prefix}county.length; i >= 0; i-- ) - what.form.${prefix}county.options[i] = null; -END - - foreach my $country ( sort keys %cust_main_county ) { - $script_html .= "\nif ( country == \"$country\" ) {\n"; - foreach my $state ( sort keys %{$cust_main_county{$country}} ) { - $script_html .= "\nif ( state == \"$state\" ) {\n"; - #foreach my $county ( sort @{$cust_main_county{$country}{$state}} ) { - foreach my $county ( sort keys %{$cust_main_county{$country}{$state}} ) { - my $text = $county || '(n/a)'; - $script_html .= - qq!opt(what.form.${prefix}county, "$county", "$text");\n!; - } - $script_html .= "}\n"; - } - $script_html .= "}\n"; - } - } - - $script_html .= <<END; - } - </SCRIPT> -END - - my $county_html = $script_html; - if ( $countyflag ) { - $county_html .= qq!<SELECT NAME="${prefix}county" onChange="$onchange" $disabled>!; - $county_html .= '</SELECT>'; - } else { - $county_html .= - qq!<INPUT TYPE="hidden" NAME="${prefix}county" VALUE="$selected_county">!; - } - - my $state_html = qq!<SELECT NAME="${prefix}state" !. - qq!onChange="${prefix}state_changed(this); $onchange" $disabled>!; - foreach my $state ( sort keys %{ $cust_main_county{$selected_country} } ) { - my $text = $state || '(n/a)'; - my $selected = $state eq $selected_state ? 'SELECTED' : ''; - $state_html .= qq(\n<OPTION $selected VALUE="$state">$text</OPTION>); - } - $state_html .= '</SELECT>'; - - $state_html .= '</SELECT>'; - - my $country_html = qq!<SELECT NAME="${prefix}country" !. - qq!onChange="${prefix}country_changed(this); $onchange" $disabled>!; - my $countrydefault = $conf->config('countrydefault') || 'US'; - foreach my $country ( - sort { ($b eq $countrydefault) <=> ($a eq $countrydefault) or $a cmp $b } - keys %cust_main_county - ) { - my $selected = $country eq $selected_country ? ' SELECTED' : ''; - $country_html .= qq(\n<OPTION$selected VALUE="$country">$country</OPTION>"); - } - $country_html .= '</SELECT>'; - - ($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<FS::Record>, L<FS::cust_main>, L<FS::cust_bill>, 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 48f47e0..0000000 --- a/FS/FS/cust_main_invoice.pm +++ /dev/null @@ -1,173 +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<FS::cust_main>) - -=item dest - Invoice destination: If numeric, a svcnum (see L<FS::svc_acct>), if string, a literal email address, `POST' to enable mailing (the default if no cust_main_invoice records exist), or `FAX' to enable faxing via a HylaFAX server. - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new invoice destination. To add the invoice destination to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -sub table { 'cust_main_invoice'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=item delete - -Delete this record from the database. - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -sub replace { - my ( $new, $old ) = ( shift, shift ); - - return "Can't change custnum!" unless $old->custnum == $new->custnum; - - $new->SUPER::replace($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 }); - - $self->SUPER::check; -} - -=item checkdest - -Checks the dest field only. - -#If it finds that the account ends in the -#same domain configured as the B<domain> configuration file, it will change the -#invoice destination from an email address to a service number (see -#L<FS::svc_acct>). - -=cut - -sub checkdest { - my $self = shift; - - my $error = $self->ut_text('dest'); - return $error if $error; - - if ( $self->dest =~ /^(POST|FAX)$/ ) { - #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); - $self->dest("$1\@$2"); - } else { - return gettext("illegal_email_invoice_address"). ': '. $self->dest; - } - - ''; #no error -} - -=item address - -Returns the literal email address for this record (or `POST' or `FAX'). - -=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 BUGS - -=head1 SEE ALSO - -L<FS::Record>, L<FS::cust_main> - -=cut - -1; - diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm deleted file mode 100644 index f057d2f..0000000 --- a/FS/FS/cust_pay.pm +++ /dev/null @@ -1,568 +0,0 @@ -package FS::cust_pay; - -use strict; -use vars qw( @ISA $conf $unsuspendauto $ignore_noapply ); -use Date::Format; -use Business::CreditCard; -use Text::Template; -use FS::Misc qw(send_email); -use FS::Record qw( dbh qsearch qsearchs ); -use FS::cust_main_Mixin; -use FS::cust_bill; -use FS::cust_bill_pay; -use FS::cust_pay_refund; -use FS::cust_main; -use FS::cust_pay_void; - -@ISA = qw( FS::cust_main_Mixin FS::Record ); - -$ignore_noapply = 0; - -#ask FS::UID to run this stuff for us later -FS::UID->install_callback( sub { - $conf = new FS::Conf; - $unsuspendauto = $conf->exists('unsuspendauto'); -} ); - -=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<FS::cust_main>) - -=item paid - Amount of this payment - -=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see -L<Time::Local> and L<Date::Parse> for conversion functions. - -=item payby - `CARD' (credit cards), `CHEK' (electronic check/ACH), -`LECB' (phone bill billing), `BILL' (billing), `PREP` (prepaid card), -`CASH' (cash), `WEST' (Western Union), `MCRD' (Manual credit card), 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'; } -sub cust_linked { $_[0]->cust_main_custnum; } -sub cust_unlinked_msg { - my $self = shift; - "WARNING: can't find cust_main.custnum ". $self->custnum. - ' (cust_pay.paynum '. $self->paynum. ')'; -} - -=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 $error = $self->check; - return $error if $error; - - my $cust_main = $self->cust_main; - my $old_balance = $cust_main->balance; - - $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 ) { - if ( $ignore_noapply ) { - warn "warning: error inserting $cust_bill_pay: $error ". - "(ignore_noapply flag set; inserting cust_pay record anyway)\n"; - } else { - $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"; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - #false laziness w/ cust_credit::insert - if ( $unsuspendauto && $old_balance && $cust_main->balance <= 0 ) { - my @errors = $cust_main->unsuspend; - #return - # side-fx with nested transactions? upstack rolls back? - warn "WARNING:Errors unsuspending customer ". $cust_main->custnum. ": ". - join(' / ', @errors) - if @errors; - } - #eslaf - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - #my $cust_main = $self->cust_main; - if ( $conf->exists('payment_receipt_email') - && grep { $_ !~ /^(POST|FAX)$/ } $cust_main->invoicing_list - ) { - - my $receipt_template = new Text::Template ( - TYPE => 'ARRAY', - SOURCE => [ map "$_\n", $conf->config('payment_receipt_email') ], - ) or do { - warn "can't create payment receipt template: $Text::Template::ERROR"; - return ''; - }; - - my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $cust_main->invoicing_list; - - my $payby = $self->payby; - my $payinfo = $self->payinfo; - $payby =~ s/^BILL$/Check/ if $payinfo; - $payinfo = $self->payinfo_masked if $payby eq 'CARD' || $payby eq 'CHEK'; - $payby =~ s/^CHEK$/Electronic check/; - - my $error = send_email( - 'from' => $conf->config('invoice_from'), #??? well as good as any - 'to' => \@invoicing_list, - 'subject' => 'Payment receipt', - 'body' => [ $receipt_template->fill_in( HASH => { - 'date' => time2str("%a %B %o, %Y", $self->_date), - 'name' => $cust_main->name, - 'paynum' => $self->paynum, - 'paid' => sprintf("%.2f", $self->paid), - 'payby' => ucfirst(lc($payby)), - 'payinfo' => $payinfo, - 'balance' => $cust_main->balance, - } ) ], - ); - if ( $error ) { - warn "can't send payment receipt: $error"; - } - - } - - ''; - -} - -=item void [ REASON ] - -Voids this payment: deletes the payment and all associated applications and -adds a record of the voided payment to the FS::cust_pay_void table. - -=cut - -sub void { - my $self = shift; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $cust_pay_void = new FS::cust_pay_void ( { - map { $_ => $self->get($_) } $self->fields - } ); - $cust_pay_void->reason(shift) if scalar(@_); - my $error = $cust_pay_void->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - $error = $self->delete; - 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<FS::cust_bill_pay>), -unless the closed flag is set. In most cases, you want to use the void -method instead to leave a record of the deleted payment. - -=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 $app ( $self->cust_bill_pay, $self->cust_pay_refund ) { - my $error = $app->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 = $self->cust_main; - - my $error = send_email( - 'from' => $conf->config('invoice_from'), #??? well as good as any - 'to' => $conf->config('deletepayments'), - 'subject' => 'FREESIDE NOTIFICATION: Payment deleted', - 'body' => [ - "This is an automatic message from your Freeside installation\n", - "informing you that the following payment has been deleted:\n", - "\n", - '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", - ], - ); - - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "can't send payment deletion notification: $error"; - } - - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; - -} - -=item replace OLD_RECORD - -You probably shouldn't modify payments... - -=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|CHEK|LECB|BILL|COMP|PREP|CASH|WEST|MCRD)$/ - 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; - } - - $self->SUPER::check; -} - -=item batch_insert CUST_PAY_OBJECT, ... - -Class method which inserts multiple payments. Takes a list of FS::cust_pay -objects. Returns a list, each element representing the status of inserting the -corresponding payment - empty. If there is an error inserting any payment, the -entire transaction is rolled back, i.e. all payments are inserted or none are. - -For example: - - my @errors = FS::cust_pay->batch_insert(@cust_pay); - my $num_errors = scalar(grep $_, @errors); - if ( $num_errors == 0 ) { - #success; all payments were inserted - } else { - #failure; no payments were inserted. - } - -=cut - -sub batch_insert { - my $self = shift; #class method - - 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 $errors = 0; - - my @errors = map { - my $error = $_->insert; - if ( $error ) { - $errors++; - } else { - $_->cust_main->apply_payments; - } - $error; - } @_; - - if ( $errors ) { - $dbh->rollback if $oldAutoCommit; - } else { - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - } - - @errors; - -} - -=item cust_bill_pay - -Returns all applications to invoices (see L<FS::cust_bill_pay>) for this -payment. - -=cut - -sub cust_bill_pay { - my $self = shift; - sort { $a->_date <=> $b->_date - || $a->invnum <=> $b->invnum } - qsearch( 'cust_bill_pay', { 'paynum' => $self->paynum } ) - ; -} - -=item cust_pay_refund - -Returns all applications of refunds (see L<FS::cust_pay_refund>) to this -payment. - -=cut - -sub cust_pay_refund { - my $self = shift; - sort { $a->_date <=> $b->_date } - qsearch( 'cust_pay_refund', { 'paynum' => $self->paynum } ) - ; -} - - -=item unapplied - -Returns the amount of this payment that is still unapplied; which is -paid minus all payment applications (see L<FS::cust_bill_pay>) and refund -applications (see L<FS::cust_pay_refund>). - -=cut - -sub unapplied { - my $self = shift; - my $amount = $self->paid; - $amount -= $_->amount foreach ( $self->cust_bill_pay ); - $amount -= $_->amount foreach ( $self->cust_pay_refund ); - sprintf("%.2f", $amount ); -} - -=item unrefunded - -Returns the amount of this payment that has not been refuned; which is -paid minus all refund applications (see L<FS::cust_pay_refund>). - -=cut - -sub unrefunded { - my $self = shift; - my $amount = $self->paid; - $amount -= $_->amount foreach ( $self->cust_pay_refund ); - sprintf("%.2f", $amount ); -} - - -=item cust_main - -Returns the parent customer object (see L<FS::cust_main>). - -=cut - -sub cust_main { - my $self = shift; - qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); -} - -=item payinfo_masked - -Returns a "masked" payinfo field with all but the last four characters replaced -by 'x'es. Useful for displaying credit cards. - -=cut - -sub payinfo_masked { - my $self = shift; - #some false laziness w/cust_main::paymask - if ( $self->payby eq 'CARD' ) { - my $payinfo = $self->payinfo; - 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4)); - } elsif ( $self->payby eq 'CHEK' ) { - my( $account, $aba ) = split('@', $self->payinfo ); - 'x'x(length($account)-2). substr($account,(length($account)-2)). "@". $aba; - } else { - $self->payinfo; - } -} - -=back - -=head1 BUGS - -Delete and replace methods. payinfo_masked false laziness with cust_main.pm -and cust_refund.pm - -=head1 SEE ALSO - -L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>, 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 e057334..0000000 --- a/FS/FS/cust_pay_batch.pm +++ /dev/null @@ -1,564 +0,0 @@ -package FS::cust_pay_batch; - -use strict; -use vars qw( @ISA $DEBUG ); -use FS::Record qw(dbh qsearch qsearchs); -use Business::CreditCard; - -@ISA = qw( FS::Record ); - -# 1 is mostly method/subroutine entry and options -# 2 traces progress of some operations -# 3 is even more information including possibly sensitive data -$DEBUG = 0; - -=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 batchnum - indentifies group in batch - -=item payby - CARD/CHEK/LECB/BILL/COMP - -=item payinfo - -=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 - -=item status - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new record. To add the record to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -sub table { 'cust_pay_batch'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=item delete - -Delete this record from the database. If there is an error, returns the error, -otherwise returns false. - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=item check - -Checks all fields to make sure this is a valid 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_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); - - $self->payby =~ /^(CARD|CHEK|LECB|BILL|COMP|PREP|CASH|WEST|MCRD)$/ - or return "Illegal payby"; - $self->payby($1); - - # FIXME - # there is no point in false laziness here - # we will effectively set "check_payinfo to 0" - # we can change that when we finish the refactor - - #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 "Expiration date required" - unless $self->payby =~ /^(CHEK|DCHK|LECB|WEST)$/; - $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, ? - - $self->SUPER::check; -} - -=item cust_main - -Returns the customer (see L<FS::cust_main>) for this batched credit card -payment. - -=cut - -sub cust_main { - my $self = shift; - qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); -} - -=back - -=head1 SUBROUTINES - -=over 4 - -=item import_results - -=cut - -sub import_results { - use Time::Local; - use FS::cust_pay; - eval "use Text::CSV_XS;"; - die $@ if $@; -# - my $param = shift; - my $fh = $param->{'filehandle'}; - my $format = $param->{'format'}; - my $paybatch = $param->{'paybatch'}; - - my $filetype; # CSV, Fixed80, Fixed264 - my @fields; - my $formatre; # for Fixed.+ - my @values; - my $begin_condition; - my $end_condition; - my $end_hook; - my $hook; - my $approved_condition; - my $declined_condition; - - if ( $format eq 'csv-td_canada_trust-merchant_pc_batch' ) { - - $filetype = "CSV"; - - @fields = ( - 'paybatchnum', # Reference#: Invoice number of the transaction - 'paid', # Amount: Amount of the transaction. Dollars and cents - # with no decimal entered. - '', # Card Type: 0 - MCrd, 1 - Visa, 2 - AMEX, 3 - Discover, - # 4 - Insignia, 5 - Diners/EnRoute, 6 - JCB - '_date', # Transaction Date: Date the Transaction was processed - 'time', # Transaction Time: Time the transaction was processed - 'payinfo', # Card Number: Card number for the transaction - '', # Expiry Date: Expiry date of the card - '', # Auth#: Authorization number entered for force post - # transaction - 'type', # Transaction Type: 0 - purchase, 40 - refund, - # 20 - force post - 'result', # Processing Result: 3 - Approval, - # 4 - Declined/Amount over limit, - # 5 - Invalid/Expired/stolen card, - # 6 - Comm Error - '', # Terminal ID: Terminal ID used to process the transaction - ); - - $end_condition = sub { - my $hash = shift; - $hash->{'type'} eq '0BC'; - }; - - $end_hook = sub { - my( $hash, $total) = @_; - $total = sprintf("%.2f", $total); - my $batch_total = sprintf("%.2f", $hash->{'paybatchnum'} / 100 ); - return "Our total $total does not match bank total $batch_total!" - if $total != $batch_total; - ''; - }; - - $hook = sub { - my $hash = shift; - $hash->{'paid'} = sprintf("%.2f", $hash->{'paid'} / 100 ); - $hash->{'_date'} = timelocal( substr($hash->{'time'}, 4, 2), - substr($hash->{'time'}, 2, 2), - substr($hash->{'time'}, 0, 2), - substr($hash->{'_date'}, 6, 2), - substr($hash->{'_date'}, 4, 2)-1, - substr($hash->{'_date'}, 0, 4)-1900, ); - }; - - $approved_condition = sub { - my $hash = shift; - $hash->{'type'} eq '0' && $hash->{'result'} == 3; - }; - - $declined_condition = sub { - my $hash = shift; - $hash->{'type'} eq '0' && ( $hash->{'result'} == 4 - || $hash->{'result'} == 5 ); - }; - - - }elsif ( $format eq 'PAP' ) { - - $filetype = "Fixed264"; - - @fields = ( - 'recordtype', # We are interested in the 'D' or debit records - 'batchnum', # Record#: batch number we used when sending the file - 'datacenter', # Where in the bowels of the bank the data was processed - 'paid', # Amount: Amount of the transaction. Dollars and cents - # with no decimal entered. - '_date', # Transaction Date: Date the Transaction was processed - 'bank', # Routing information - 'payinfo', # Account number for the transaction - 'paybatchnum', # Reference#: Invoice number of the transaction - ); - - $formatre = '^(.).{19}(.{4})(.{3})(.{10})(.{6})(.{9})(.{12}).{110}(.{19}).{71}$'; - - $end_condition = sub { - my $hash = shift; - $hash->{'recordtype'} eq 'W'; - }; - - $end_hook = sub { - my( $hash, $total) = @_; - $total = sprintf("%.2f", $total); - my $batch_total = $hash->{'datacenter'}.$hash->{'paid'}. - substr($hash->{'_date'},0,1); # YUCK! - $batch_total = sprintf("%.2f", $batch_total / 100 ); - return "Our total $total does not match bank total $batch_total!" - if $total != $batch_total; - ''; - }; - - $hook = sub { - my $hash = shift; - $hash->{'paid'} = sprintf("%.2f", $hash->{'paid'} / 100 ); - my $tmpdate = timelocal( 0,0,1,1,0,substr($hash->{'_date'}, 0, 3)+2000); - $tmpdate += 86400*(substr($hash->{'_date'}, 3, 3)-1) ; - $hash->{'_date'} = $tmpdate; - $hash->{'payinfo'} = $hash->{'payinfo'} . '@' . $hash->{'bank'}; - }; - - $approved_condition = sub { - 1; - }; - - $declined_condition = sub { - 0; - }; - - - } else { - return "Unknown format $format"; - } - - my $csv = new Text::CSV_XS; - - 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 $pay_batch = qsearchs('pay_batch',{'batchnum'=> $paybatch}); - unless ($pay_batch && $pay_batch->status eq 'I') { - $dbh->rollback if $oldAutoCommit; - return "batch $paybatch is not in transit"; - }; - - my $newbatch = new FS::pay_batch { $pay_batch->hash }; - $newbatch->status('R'); # Resolved - $newbatch->upload(time); - my $error = $newbatch->replace($pay_batch); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error - } - - my $total = 0; - my $line; - while ( defined($line=<$fh>) ) { - - next if $line =~ /^\s*$/; #skip blank lines - - if ($filetype eq "CSV") { - $csv->parse($line) or do { - $dbh->rollback if $oldAutoCommit; - return "can't parse: ". $csv->error_input(); - }; - @values = $csv->fields(); - }elsif ($filetype eq "Fixed80" || $filetype eq "Fixed264"){ - @values = $line =~ /$formatre/; - unless (@values) { - $dbh->rollback if $oldAutoCommit; - return "can't parse: ". $line; - }; - }else{ - $dbh->rollback if $oldAutoCommit; - return "Unknown file type $filetype"; - } - - my %hash; - foreach my $field ( @fields ) { - my $value = shift @values; - next unless $field; - $hash{$field} = $value; - } - - if ( &{$end_condition}(\%hash) ) { - my $error = &{$end_hook}(\%hash, $total); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - last; - } - - my $cust_pay_batch = - qsearchs('cust_pay_batch', { 'paybatchnum' => $hash{'paybatchnum'}+0 } ); - unless ( $cust_pay_batch ) { - $dbh->rollback if $oldAutoCommit; - return "unknown paybatchnum $hash{'paybatchnum'}\n"; - } - my $custnum = $cust_pay_batch->custnum, - my $payby = $cust_pay_batch->payby, - - my $new_cust_pay_batch = new FS::cust_pay_batch { $cust_pay_batch->hash }; - - &{$hook}(\%hash); - - if ( &{$approved_condition}(\%hash) ) { - - $new_cust_pay_batch->status('Approved'); - - my $cust_pay = new FS::cust_pay ( { - 'custnum' => $custnum, - 'payby' => $payby, - 'paybatch' => $paybatch, - map { $_ => $hash{$_} } (qw( paid _date payinfo )), - } ); - $error = $cust_pay->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error adding payment paybatchnum $hash{'paybatchnum'}: $error\n"; - } - $total += $hash{'paid'}; - - $cust_pay->cust_main->apply_payments; - - } elsif ( &{$declined_condition}(\%hash) ) { - - $new_cust_pay_batch->status('Declined'); - - #this should be configurable... if anybody else ever uses batches - # $cust_pay_batch->cust_main->suspend; - - foreach my $part_bill_event ( - sort { $a->seconds <=> $b->seconds - || $a->weight <=> $b->weight - || $a->eventpart <=> $b->eventpart } - grep { ! qsearch( 'cust_bill_event', { - 'invnum' => $cust_pay_batch->invnum, - 'eventpart' => $_->eventpart, - 'status' => 'done', - } ) - } - qsearch( { - 'table' => 'part_bill_event', - 'hashref' => { 'payby' => 'DCLN', - 'disabled' => '', }, - } ) - ) { - - # don't run subsequent events if balance<=0 - last if $cust_pay_batch->cust_main->balance <= 0; - - warn " calling invoice event (". $part_bill_event->eventcode. ")\n" - if $DEBUG > 1; - my $cust_main = $cust_pay_batch->cust_main; #for callback - - my $error; - { - local $SIG{__DIE__}; # don't want Mason __DIE__ handler active - $error = eval $part_bill_event->eventcode; - } - - my $status = ''; - my $statustext = ''; - if ( $@ ) { - $status = 'failed'; - $statustext = $@; - } elsif ( $error ) { - $status = 'done'; - $statustext = $error; - } else { - $status = 'done' - } - - #add cust_bill_event - my $cust_bill_event = new FS::cust_bill_event { - 'invnum' => $cust_pay_batch->invnum, - 'eventpart' => $part_bill_event->eventpart, - '_date' => time, - 'status' => $status, - 'statustext' => $statustext, - }; - $error = $cust_bill_event->insert; - if ( $error ) { - # gah, even with transactions. - $dbh->commit if $oldAutoCommit; #well. - my $e = 'WARNING: Event run but database not updated - '. - 'error inserting cust_bill_event, invnum #'. $cust_pay_batch->invnum. - ', eventpart '. $part_bill_event->eventpart. - ": $error"; - warn $e; - return $e; - } - - } - - } - - my $error = $new_cust_pay_batch->replace($cust_pay_batch); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error updating status of paybatchnum $hash{'paybatchnum'}: $error\n"; - } - - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - -} - -=back - -=head1 BUGS - -There should probably be a configuration file with a list of allowed credit -card types. - -=head1 SEE ALSO - -L<FS::cust_main>, L<FS::Record> - -=cut - -1; - diff --git a/FS/FS/cust_pay_refund.pm b/FS/FS/cust_pay_refund.pm deleted file mode 100644 index 15e0e53..0000000 --- a/FS/FS/cust_pay_refund.pm +++ /dev/null @@ -1,177 +0,0 @@ -package FS::cust_pay_refund; - -use strict; -use vars qw( @ISA ); #$conf ); -use FS::UID qw( getotaker ); -use FS::Record qw( qsearchs ); # qsearch ); -use FS::cust_main; -use FS::cust_pay; -use FS::cust_refund; - -@ISA = qw( FS::Record ); - -#ask FS::UID to run this stuff for us later -#FS::UID->install_callback( sub { -# $conf = new FS::Conf; -#} ); - -=head1 NAME - -FS::cust_pay_refund - Object methods for cust_pay_refund records - -=head1 SYNOPSIS - - use FS::cust_pay_refund; - - $record = new FS::cust_pay_refund \%hash; - $record = new FS::cust_pay_refund { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::cust_pay_refund object represents application of a refund (see -L<FS::cust_refund>) to an payment (see L<FS::cust_pay>). FS::cust_pay_refund -inherits from FS::Record. The following fields are currently supported: - -=over 4 - -=item payrefundnum - primary key - -=item paynum - credit being applied - -=item refundnum - invoice to which credit is applied (see L<FS::cust_bill>) - -=item amount - amount of the credit applied - -=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see -L<Time::Local> and L<Date::Parse> for conversion functions. - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new cust_pay_refund. To add the cust_pay_refund to the database, -see L<"insert">. - -=cut - -sub table { 'cust_pay_refund'; } - -=item insert - -Adds this cust_pay_refund to the database. If there is an error, returns the -error, otherwise returns false. - -=item delete - -=cut - -sub delete { - my $self = shift; - return "Can't apply refund to closed payment" - if $self->cust_pay->closed =~ /^Y/i; - return "Can't apply closed refund" - if $self->cust_refund->closed =~ /^Y/i; - $self->SUPER::delete(@_); -} - -=item replace OLD_RECORD - -Application of refunds to payments may not be modified. - -=cut - -sub replace { - return "Can't modify application of a refund to payment!" -} - -=item check - -Checks all fields to make sure this is a valid refund application to a payment. -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('payrefundnum') - || $self->ut_number('paynum') - || $self->ut_number('refundnum') - || $self->ut_numbern('_date') - || $self->ut_money('amount') - ; - return $error if $error; - - return "amount must be > 0" if $self->amount <= 0; - - return "Unknown payment" - unless my $cust_pay = - qsearchs( 'cust_pay', { 'paynum' => $self->paynum } ); - - return "Unknown refund" - unless my $cust_refund = - qsearchs( 'cust_refund', { 'refundnum' => $self->refundnum } ); - - $self->_date(time) unless $self->_date; - - return 'Cannot apply ($'. $self->amount. ') more than'. - ' remaining value of refund ($'. $cust_refund->unapplied. ')' - unless $self->amount <= $cust_refund->unapplied; - - return "Cannot apply more than remaining value of payment" - unless $self->amount <= $cust_pay->unapplied; - - $self->SUPER::check; -} - -=item sub cust_pay - -Returns the payment (see L<FS::cust_pay>) - -=cut - -sub cust_pay { - my $self = shift; - qsearchs( 'cust_pay', { 'paynum' => $self->paynum } ); -} - -=item cust_refund - -Returns the refund (see L<FS::cust_refund>) - -=cut - -sub cust_refund { - my $self = shift; - qsearchs( 'cust_refund', { 'refundnum' => $self->refundnum } ); -} - -=back - -=head1 BUGS - -The delete method. - -=head1 SEE ALSO - -L<FS::Record>, L<FS::cust_refund>, L<FS::cust_bill>, L<FS::cust_credit>, -schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/cust_pay_void.pm b/FS/FS/cust_pay_void.pm deleted file mode 100644 index 946d69f..0000000 --- a/FS/FS/cust_pay_void.pm +++ /dev/null @@ -1,236 +0,0 @@ -package FS::cust_pay_void; -use strict; -use vars qw( @ISA ); -use Business::CreditCard; -use FS::UID qw(getotaker); -use FS::Record qw(qsearchs dbh fields); # qsearch ); -use FS::cust_pay; -#use FS::cust_bill; -#use FS::cust_bill_pay; -#use FS::cust_pay_refund; -#use FS::cust_main; - -@ISA = qw( FS::Record ); - -=head1 NAME - -FS::cust_pay_void - Object methods for cust_pay_void objects - -=head1 SYNOPSIS - - use FS::cust_pay_void; - - $record = new FS::cust_pay_void \%hash; - $record = new FS::cust_pay_void { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::cust_pay_void object represents a voided payment. The following fields -are currently supported: - -=over 4 - -=item paynum - primary key (assigned automatically for new payments) - -=item custnum - customer (see L<FS::cust_main>) - -=item paid - Amount of this payment - -=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see -L<Time::Local> and L<Date::Parse> for conversion functions. - -=item payby - `CARD' (credit cards), `CHEK' (electronic check/ACH), -`LECB' (phone bill billing), `BILL' (billing), `CASH' (cash), -`WEST' (Western Union), `MCRD' (Manual credit card), 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' - -=item void_date - -=item reason - -=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_void'; } - -=item insert - -Adds this voided payment to the database. - -=item unvoid - -"Un-void"s this payment: Deletes the voided payment from the database and adds -back a normal payment. - -=cut - -sub unvoid { - my $self = shift; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $cust_pay = new FS::cust_pay ( { - map { $_ => $self->get($_) } fields('cust_pay') - } ); - my $error = $cust_pay->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - $error = $self->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; - -} - -=item delete - -Deletes this voided payment. You probably don't want to use this directly; see -the B<unvoid> method to add the original payment back. - -=item replace OLD_RECORD - -Currently unimplemented. - -=cut - -sub replace { - return "Can't modify voided payments!"; -} - -=item check - -Checks all fields to make sure this is a valid voided 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_number('_date') - || $self->ut_textn('paybatch') - || $self->ut_enum('closed', [ '', 'Y' ]) - || $self->ut_numbern('void_date') - || $self->ut_textn('reason') - ; - 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->void_date(time) unless $self->void_date; - - $self->payby =~ /^(CARD|CHEK|LECB|BILL|COMP|PREP|CASH|WEST|MCRD)$/ - 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; - } - - $self->otaker(getotaker); - - $self->SUPER::check; -} - -=item cust_main - -Returns the parent customer object (see L<FS::cust_main>). - -=cut - -sub cust_main { - my $self = shift; - qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); -} - -=item payinfo_masked - -Returns a "masked" payinfo field with all but the last four characters replaced -by 'x'es. Useful for displaying credit cards. - -=cut - -sub payinfo_masked { - my $self = shift; - my $payinfo = $self->payinfo; - 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4)); -} - -=back - -=head1 BUGS - -Delete and replace methods. - -=head1 SEE ALSO - -L<FS::cust_pay>, L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm deleted file mode 100644 index 4976a2d..0000000 --- a/FS/FS/cust_pkg.pm +++ /dev/null @@ -1,1419 +0,0 @@ -package FS::cust_pkg; - -use strict; -use vars qw(@ISA $disable_agentcheck @SVCDB_CANCEL_SEQ $DEBUG); -use Tie::IxHash; -use FS::UID qw( getotaker dbh ); -use FS::Misc qw( send_email ); -use FS::Record qw( qsearch qsearchs ); -use FS::cust_main_Mixin; -use FS::cust_svc; -use FS::part_pkg; -use FS::cust_main; -use FS::type_pkgs; -use FS::pkg_svc; -use FS::cust_bill_pkg; -use FS::h_cust_svc; -use FS::reg_code; - -# need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend, -# setup } -# because they load configuration by setting FS::UID::callback (see TODO) -use FS::svc_acct; -use FS::svc_domain; -use FS::svc_www; -use FS::svc_forward; - -# for sending cancel emails in sub cancel -use FS::Conf; - -@ISA = qw( FS::cust_main_Mixin FS::Record ); - -$DEBUG = 0; - -$disable_agentcheck = 0; - -# The order in which to unprovision services. -@SVCDB_CANCEL_SEQ = qw( svc_external - svc_www - svc_forward - svc_acct - svc_domain - svc_broadband ); - -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<FS::cust_main>) - -=item pkgpart - Billing item definition (see L<FS::part_pkg>) - -=item setup - date - -=item bill - date (next bill date) - -=item last_bill - last bill date - -=item susp - date - -=item expire - date - -=item cancel - date - -=item otaker - order taker (assigned automatically if null, see L<FS::UID>) - -=item manual_flag - If this field is set to 1, disables the automatic -unsuspension of this package when using the B<unsuspendauto> config file. - -=back - -Note: setup, bill, susp, expire and cancel are specified as UNIX timestamps; -see L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for -conversion functions. - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Create a new billing item. To add the item to the database, see L<"insert">. - -=cut - -sub table { 'cust_pkg'; } -sub cust_linked { $_[0]->cust_main_custnum; } -sub cust_unlinked_msg { - my $self = shift; - "WARNING: can't find cust_main.custnum ". $self->custnum. - ' (cust_pkg.pkgnum '. $self->pkgnum. ')'; -} - -=item insert [ OPTION => VALUE ... ] - -Adds this billing item to the database ("Orders" the item). If there is an -error, returns the error, otherwise returns false. - -If the additional field I<promo_code> is defined instead of I<pkgpart>, it -will be used to look up the package definition and agent restrictions will be -ignored. - -The following options are available: I<change> - -I<change>, if set true, supresses any referral credit to a referring customer. - -=cut - -sub insert { - my( $self, %options ) = @_; - - 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; - } - - #if ( $self->reg_code ) { - # my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } ); - # $error = $reg_code->delete; - # if ( $error ) { - # $dbh->rollback if $oldAutoCommit; - # return $error; - # } - #} - - my $conf = new FS::Conf; - my $cust_main = $self->cust_main; - my $part_pkg = $self->part_pkg; - if ( $conf->exists('referral_credit') - && $cust_main->referral_custnum - && ! $options{'change'} - && $part_pkg->freq !~ /^0\D?$/ - ) - { - my $referring_cust_main = $cust_main->referring_cust_main; - if ( $referring_cust_main->status ne 'cancelled' ) { - my $error; - if ( $part_pkg->freq !~ /^\d+$/ ) { - warn 'WARNING: Not crediting customer '. $cust_main->referral_custnum. - ' for package '. $self->pkgnum. - ' ( customer '. $self->custnum. ')'. - ' - One-time referral credits not (yet) available for '. - ' packages with '. $part_pkg->freq_pretty. ' frequency'; - } else { - - my $amount = sprintf( "%.2f", $part_pkg->base_recur / $part_pkg->freq ); - my $error = - $referring_cust_main->credit( $amount, - 'Referral credit for '. $cust_main->name - ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Error crediting customer ". $cust_main->referral_custnum. - " for referral: $error"; - } - - } - - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - -} - -=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<FS::cust_main>). - -suspend is normally updated by the suspend and unsuspend methods. - -cancel is normally updated by the cancel method (and also the order subroutine -in some cases). - -Calls - -=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? - - local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart; - - 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; - - #save off and freeze RADIUS attributes for any associated svc_acct records - my @svc_acct = (); - if ( $old->part_pkg->is_prepaid || $new->part_pkg->is_prepaid ) { - - #also check for specific exports? - # to avoid spurious modify export events - @svc_acct = map { $_->svc_x } - grep { $_->part_svc->svcdb eq 'svc_acct' } - $old->cust_svc; - - $_->snapshot foreach @svc_acct; - - } - - my $error = $new->SUPER::replace($old); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - #for prepaid packages, - #trigger export of new RADIUS Expiration attribute when cust_pkg.bill changes - foreach my $old_svc_acct ( @svc_acct ) { - my $new_svc_acct = new FS::svc_acct { $old_svc_acct->hash }; - my $s_error = $new_svc_acct->replace($old_svc_acct); - if ( $s_error ) { - $dbh->rollback if $oldAutoCommit; - return $s_error; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - -} - -=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_foreign_key('custnum', 'cust_main', 'custnum') - || $self->ut_numbern('pkgpart') - || $self->ut_numbern('setup') - || $self->ut_numbern('bill') - || $self->ut_numbern('susp') - || $self->ut_numbern('cancel') - ; - return $error if $error; - - if ( $self->reg_code ) { - - unless ( grep { $self->pkgpart == $_->pkgpart } - map { $_->reg_code_pkg } - qsearchs( 'reg_code', { 'code' => $self->reg_code, - 'agentnum' => $self->cust_main->agentnum }) - ) { - return "Unknown registration code"; - } - - } elsif ( $self->promo_code ) { - - my $promo_part_pkg = - qsearchs('part_pkg', { - 'pkgpart' => $self->pkgpart, - 'promo_code' => { op=>'ILIKE', value=>$self->promo_code }, - } ); - return 'Unknown promotional code' unless $promo_part_pkg; - - } else { - - unless ( $disable_agentcheck ) { - my $agent = - qsearchs( 'agent', { 'agentnum' => $self->cust_main->agentnum } ); - my $pkgpart_href = $agent->pkgpart_hashref; - return "agent ". $agent->agentnum. - " can't purchase pkgpart ". $self->pkgpart - unless $pkgpart_href->{ $self->pkgpart }; - } - - $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' ); - return $error if $error; - - } - - $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('') if $self->manual_flag eq ' '; - $self->manual_flag =~ /^([01]?)$/ - or return "Illegal manual_flag ". $self->manual_flag; - $self->manual_flag($1); - } - - $self->SUPER::check; -} - -=item cancel [ OPTION => VALUE ... ] - -Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>) -in this package, then cancels the package itself (sets the cancel field to -now). - -Available options are: I<quiet> - -I<quiet> can be set true to supress email cancellation notices. - -If there is an error, returns the error, otherwise returns false. - -=cut - -sub cancel { - my( $self, %options ) = @_; - my $error; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my %svc; - foreach my $cust_svc ( - qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) - ) { - push @{ $svc{$cust_svc->part_svc->svcdb} }, $cust_svc; - } - - foreach my $svcdb (@SVCDB_CANCEL_SEQ) { - foreach my $cust_svc (@{ $svc{$svcdb} }) { - my $error = $cust_svc->cancel; - - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Error cancelling cust_svc: $error"; - } - } - } - - # Add a credit for remaining service - my $remaining_value = $self->calc_remain(); - if ( $remaining_value > 0 ) { - my $error = $self->cust_main->credit( - $remaining_value, - 'Credit for unused time on '. $self->part_pkg->pkg, - ); - if ($error) { - $dbh->rollback if $oldAutoCommit; - return "Error crediting customer \$$remaining_value for unused time on". - $self->part_pkg->pkg. ": $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; - - my $conf = new FS::Conf; - my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list; - if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) { - my $conf = new FS::Conf; - my $error = send_email( - 'from' => $conf->config('invoice_from'), - 'to' => \@invoicing_list, - 'subject' => $conf->config('cancelsubject'), - 'body' => [ map "$_\n", $conf->config('cancelmessage') ], - ); - #should this do something on errors? - } - - ''; #no errors - -} - -=item suspend - -Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this -package, then suspends the package itself (sets the susp field to now). - -If there is an error, returns the error, otherwise returns false. - -=cut - -sub suspend { - my $self = shift; - my $error ; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - foreach my $cust_svc ( - qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) - ) { - my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } ); - - $part_svc->svcdb =~ /^([\w\-]+)$/ or do { - $dbh->rollback if $oldAutoCommit; - return "Illegal svcdb value in part_svc!"; - }; - my $svcdb = $1; - require "FS/$svcdb.pm"; - - my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } ); - if ($svc) { - $error = $svc->suspend; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - } - - unless ( $self->getfield('susp') ) { - my %hash = $self->hash; - $hash{'susp'} = time; - my $new = new FS::cust_pkg ( \%hash ); - $error = $new->replace($self); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; #no errors -} - -=item unsuspend [ OPTION => VALUE ... ] - -Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this -package, then unsuspends the package itself (clears the susp field). - -Available options are: I<adjust_next_bill>. - -I<adjust_next_bill> can be set true to adjust the next bill date forward by -the amount of time the account was inactive. This was set true by default -since 1.4.2 and 1.5.0pre6; however, starting with 1.7.0 this needs to be -explicitly requested. Price plans for which this makes sense (anniversary-date -based than prorate or subscription) could have an option to enable this -behaviour? - -If there is an error, returns the error, otherwise returns false. - -=cut - -sub unsuspend { - my( $self, %opt ) = @_; - 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; - my $inactive = time - $hash{'susp'}; - - $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive - if $opt{'adjust_next_bill'} - && $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} ); - - $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 last_bill - -Returns the last bill date, or if there is no last bill date, the setup date. -Useful for billing metered services. - -=cut - -sub last_bill { - my $self = shift; - if ( $self->dbdef_table->column('last_bill') ) { - return $self->setfield('last_bill', $_[0]) if @_; - return $self->getfield('last_bill') if $self->getfield('last_bill'); - } - my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum, - 'edate' => $self->bill, } ); - $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0; -} - -=item part_pkg - -Returns the definition for this billing item, as an FS::part_pkg object (see -L<FS::part_pkg>). - -=cut - -sub part_pkg { - my $self = shift; - #exists( $self->{'_pkgpart'} ) - $self->{'_pkgpart'} - ? $self->{'_pkgpart'} - : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } ); -} - -=item calc_setup - -Calls the I<calc_setup> of the FS::part_pkg object associated with this billing -item. - -=cut - -sub calc_setup { - my $self = shift; - $self->part_pkg->calc_setup($self, @_); -} - -=item calc_recur - -Calls the I<calc_recur> of the FS::part_pkg object associated with this billing -item. - -=cut - -sub calc_recur { - my $self = shift; - $self->part_pkg->calc_recur($self, @_); -} - -=item calc_remain - -Calls the I<calc_remain> of the FS::part_pkg object associated with this -billing item. - -=cut - -sub calc_remain { - my $self = shift; - $self->part_pkg->calc_remain($self, @_); -} - -=item calc_cancel - -Calls the I<calc_cancel> of the FS::part_pkg object associated with this -billing item. - -=cut - -sub calc_cancel { - my $self = shift; - $self->part_pkg->calc_cancel($self, @_); -} - -=item cust_svc [ SVCPART ] - -Returns the services for this package, as FS::cust_svc objects (see -L<FS::cust_svc>). If a svcpart is specified, return only the matching -services. - -=cut - -sub cust_svc { - my $self = shift; - - if ( @_ ) { - return qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum, - 'svcpart' => shift, } ); - } - - #if ( $self->{'_svcnum'} ) { - # values %{ $self->{'_svcnum'}->cache }; - #} else { - $self->_sort_cust_svc( - [ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ] - ); - #} - -} - -=item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ] - -Returns historical services for this package created before END TIMESTAMP and -(optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects -(see L<FS::h_cust_svc>). - -=cut - -sub h_cust_svc { - my $self = shift; - - $self->_sort_cust_svc( - [ qsearch( 'h_cust_svc', - { 'pkgnum' => $self->pkgnum, }, - FS::h_cust_svc->sql_h_search(@_), - ) - ] - ); -} - -sub _sort_cust_svc { - my( $self, $arrayref ) = @_; - - map { $_->[0] } - sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] } - map { - my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart, - 'svcpart' => $_->svcpart } ); - [ $_, - $pkg_svc ? $pkg_svc->primary_svc : '', - $pkg_svc ? $pkg_svc->quantity : 0, - ]; - } - @$arrayref; - -} - -=item num_cust_svc [ SVCPART ] - -Returns the number of provisioned services for this package. If a svcpart is -specified, counts only the matching services. - -=cut - -sub num_cust_svc { - my $self = shift; - my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?'; - $sql .= ' AND svcpart = ?' if @_; - my $sth = dbh->prepare($sql) or die dbh->errstr; - $sth->execute($self->pkgnum, @_) or die $sth->errstr; - $sth->fetchrow_arrayref->[0]; -} - -=item available_part_svc - -Returns a list FS::part_svc objects representing services included in this -package but not yet provisioned. Each FS::part_svc object also has an extra -field, I<num_avail>, which specifies the number of available services. - -=cut - -sub available_part_svc { - my $self = shift; - grep { $_->num_avail > 0 } - map { - my $part_svc = $_->part_svc; - $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking - $_->quantity - $self->num_cust_svc($_->svcpart); - $part_svc; - } - $self->part_pkg->pkg_svc; -} - -=item status - -Returns a short status string for this package, currently: - -=over 4 - -=item not yet billed - -=item one-time charge - -=item active - -=item suspended - -=item cancelled - -=back - -=cut - -sub status { - my $self = shift; - - my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq; - - return 'cancelled' if $self->get('cancel'); - return 'suspended' if $self->susp; - return 'not yet billed' unless $self->setup; - return 'one-time charge' if $freq =~ /^(0|$)/; - return 'active'; -} - -=item statuses - -Class method that returns the list of possible status strings for pacakges -(see L<the status method|/status>). For example: - - @statuses = FS::cust_pkg->statuses(); - -=cut - -tie my %statuscolor, 'Tie::IxHash', - 'not yet billed' => '000000', - 'one-time charge' => '000000', - 'active' => '00CC00', - 'suspended' => 'FF9900', - 'cancelled' => 'FF0000', -; - -sub statuses { - my $self = shift; #could be class... - grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway - # mayble split btw one-time vs. recur - keys %statuscolor; -} - -=item statuscolor - -Returns a hex triplet color string for this package's status. - -=cut - -sub statuscolor { - my $self = shift; - $statuscolor{$self->status}; -} - -=item labels - -Returns a list of lists, calling the label method for all services -(see L<FS::cust_svc>) of this billing item. - -=cut - -sub labels { - my $self = shift; - map { [ $_->label ] } $self->cust_svc; -} - -=item h_labels END_TIMESTAMP [ START_TIMESTAMP ] - -Like the labels method, but returns historical information on services that -were active as of END_TIMESTAMP and (optionally) not cancelled before -START_TIMESTAMP. - -Returns a list of lists, calling the label method for all (historical) services -(see L<FS::h_cust_svc>) of this billing item. - -=cut - -sub h_labels { - my $self = shift; - map { [ $_->label(@_) ] } $self->h_cust_svc(@_); -} - -=item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ] - -Like h_labels, except returns a simple flat list, and shortens long -(currently >5) lists of identical services to one line that lists the service -label and the number of individual services rather than individual items. - -=cut - -sub h_labels_short { - my $self = shift; - - my %labels; - #tie %labels, 'Tie::IxHash'; - push @{ $labels{$_->[0]} }, $_->[1] - foreach $self->h_labels(@_); - my @labels; - foreach my $label ( keys %labels ) { - my @values = @{ $labels{$label} }; - my $num = scalar(@values); - if ( $num > 5 ) { - push @labels, "$label ($num)"; - } else { - push @labels, map { "$label: $_" } @values; - } - } - - @labels; - -} - -=item cust_main - -Returns the parent customer object (see L<FS::cust_main>). - -=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<FS::svc_acct>) in this -package have been online since TIMESTAMP, according to the session monitor. - -TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see -L<Time::Local> and L<Date::Parse> 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; - -} - -=item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END - -Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this -package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END -(exclusive). - -TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see -L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion -functions. - - -=cut - -sub seconds_since_sqlradacct { - my($self, $start, $end) = @_; - - my $seconds = 0; - - foreach my $cust_svc ( - grep { - my $part_svc = $_->part_svc; - $part_svc->svcdb eq 'svc_acct' - && scalar($part_svc->part_export('sqlradius')); - } $self->cust_svc - ) { - $seconds += $cust_svc->seconds_since_sqlradacct($start, $end); - } - - $seconds; - -} - -=item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE - -Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>) -in this package for sessions ending between TIMESTAMP_START (inclusive) and -TIMESTAMP_END -(exclusive). - -TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see -L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion -functions. - -=cut - -sub attribute_since_sqlradacct { - my($self, $start, $end, $attrib) = @_; - - my $sum = 0; - - foreach my $cust_svc ( - grep { - my $part_svc = $_->part_svc; - $part_svc->svcdb eq 'svc_acct' - && scalar($part_svc->part_export('sqlradius')); - } $self->cust_svc - ) { - $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib); - } - - $sum; - -} - -=item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ] - -Transfers as many services as possible from this package to another package. - -The destination package can be specified by pkgnum by passing an FS::cust_pkg -object. The destination package must already exist. - -Services are moved only if the destination allows services with the correct -I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true. Use -this option with caution! No provision is made for export differences -between the old and new service definitions. Probably only should be used -when your exports for all service definitions of a given svcdb are identical. -(attempt a transfer without it first, to move all possible svcpart-matching -services) - -Any services that can't be moved remain in the original package. - -Returns an error, if there is one; otherwise, returns the number of services -that couldn't be moved. - -=cut - -sub transfer { - my ($self, $dest_pkgnum, %opt) = @_; - - my $remaining = 0; - my $dest; - my %target; - - if (ref ($dest_pkgnum) eq 'FS::cust_pkg') { - $dest = $dest_pkgnum; - $dest_pkgnum = $dest->pkgnum; - } else { - $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum }); - } - - return ('Package does not exist: '.$dest_pkgnum) unless $dest; - - foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) { - $target{$pkg_svc->svcpart} = $pkg_svc->quantity; - } - - foreach my $cust_svc ($dest->cust_svc) { - $target{$cust_svc->svcpart}--; - } - - my %svcpart2svcparts = (); - if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) { - warn "change_svcpart option received, creating alternates list\n" if $DEBUG; - foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) { - next if exists $svcpart2svcparts{$svcpart}; - my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } ); - $svcpart2svcparts{$svcpart} = [ - map { $_->[0] } - sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] } - map { - my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart, - 'svcpart' => $_ } ); - [ $_, - $pkg_svc ? $pkg_svc->primary_svc : '', - $pkg_svc ? $pkg_svc->quantity : 0, - ]; - } - - grep { $_ != $svcpart } - map { $_->svcpart } - qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } ) - ]; - warn "alternates for svcpart $svcpart: ". - join(', ', @{$svcpart2svcparts{$svcpart}}). "\n" - if $DEBUG; - } - } - - foreach my $cust_svc ($self->cust_svc) { - if($target{$cust_svc->svcpart} > 0) { - $target{$cust_svc->svcpart}--; - my $new = new FS::cust_svc { - svcnum => $cust_svc->svcnum, - svcpart => $cust_svc->svcpart, - pkgnum => $dest_pkgnum, - }; - my $error = $new->replace($cust_svc); - return $error if $error; - } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) { - if ( $DEBUG ) { - warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n"; - warn "alternates to consider: ". - join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n"; - } - my @alternate = grep { - warn "considering alternate svcpart $_: ". - "$target{$_} available in new package\n" - if $DEBUG; - $target{$_} > 0; - } @{$svcpart2svcparts{$cust_svc->svcpart}}; - if ( @alternate ) { - warn "alternate(s) found\n" if $DEBUG; - my $change_svcpart = $alternate[0]; - $target{$change_svcpart}--; - my $new = new FS::cust_svc { - svcnum => $cust_svc->svcnum, - svcpart => $change_svcpart, - pkgnum => $dest_pkgnum, - }; - my $error = $new->replace($cust_svc); - return $error if $error; - } else { - $remaining++; - } - } else { - $remaining++ - } - } - return $remaining; -} - -=item reexport - -This method is deprecated. See the I<depend_jobnum> option to the insert and -order_pkgs methods in FS::cust_main for a better way to defer provisioning. - -=cut - -sub reexport { - my $self = shift; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - foreach my $cust_svc ( $self->cust_svc ) { - #false laziness w/svc_Common::insert - my $svc_x = $cust_svc->svc_x; - foreach my $part_export ( $cust_svc->part_svc->part_export ) { - my $error = $part_export->export_insert($svc_x); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - -} - -=back - -=head1 CLASS METHODS - -=over 4 - -=item recurring_sql - -Returns an SQL expression identifying recurring packages. - -=cut - -sub recurring_sql { " - '0' != ( select freq from part_pkg - where cust_pkg.pkgpart = part_pkg.pkgpart ) -"; } - -=item onetime_sql - -Returns an SQL expression identifying one-time packages. - -=cut - -sub onetime_sql { " - '0' = ( select freq from part_pkg - where cust_pkg.pkgpart = part_pkg.pkgpart ) -"; } - -=item active_sql - -Returns an SQL expression identifying active packages. - -=cut - -sub active_sql { " - ". $_[0]->recurring_sql(). " - AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) - AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) -"; } - -=item inactive_sql - -Returns an SQL expression identifying inactive packages (one-time packages -that are otherwise unsuspended/uncancelled). - -=cut - -sub inactive_sql { " - ". $_[0]->onetime_sql(). " - AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) - AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) -"; } - -=item susp_sql -=item suspended_sql - -Returns an SQL expression identifying suspended packages. - -=cut - -sub suspended_sql { susp_sql(@_); } -sub susp_sql { - #$_[0]->recurring_sql(). ' AND '. - " - ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) - AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0 - "; -} - -=item cancel_sql -=item cancelled_sql - -Returns an SQL exprression identifying cancelled packages. - -=cut - -sub cancelled_sql { cancel_sql(@_); } -sub cancel_sql { - #$_[0]->recurring_sql(). ' AND '. - "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0"; -} - -=head1 SUBROUTINES - -=over 4 - -=item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ] ] - -CUSTNUM is a customer (see L<FS::cust_main>) - -PKGPARTS is a list of pkgparts specifying the the billing item definitions (see -L<FS::part_pkg>) to order for this customer. Duplicates are of course -permitted. - -REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to -remove for this customer. The services (see L<FS::cust_svc>) are moved to the -new billing items. An error is returned if this is not possible (see -L<FS::pkg_svc>). 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_pkgnum, $return_cust_pkg) = @_; - - my $conf = new FS::Conf; - - # Transactionize this whole mess - 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; - my $cust_main = qsearchs('cust_main', { custnum => $custnum }); - return "Customer not found: $custnum" unless $cust_main; - - my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) } - @$remove_pkgnum; - - my $change = scalar(@old_cust_pkg) != 0; - - my %hash = (); - if ( scalar(@old_cust_pkg) == 1 ) { - #$hash{$_} = $old_cust_pkg[0]->$_() foreach qw( last_bill bill ); - $hash{'setup'} = time; - } - - # Create the new packages. - foreach my $pkgpart (@$pkgparts) { - my $cust_pkg = new FS::cust_pkg { custnum => $custnum, - pkgpart => $pkgpart, - %hash, - }; - $error = $cust_pkg->insert( 'change' => $change ); - if ($error) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - push @$return_cust_pkg, $cust_pkg; - } - # $return_cust_pkg now contains refs to all of the newly - # created packages. - - # Transfer services and cancel old packages. - foreach my $old_pkg (@old_cust_pkg) { - - foreach my $new_pkg (@$return_cust_pkg) { - $error = $old_pkg->transfer($new_pkg); - if ($error and $error == 0) { - # $old_pkg->transfer failed. - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) { - warn "trying transfer again with change_svcpart option\n" if $DEBUG; - foreach my $new_pkg (@$return_cust_pkg) { - $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 ); - if ($error and $error == 0) { - # $old_pkg->transfer failed. - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - } - - if ($error > 0) { - # Transfers were successful, but we went through all of the - # new packages and still had services left on the old package. - # We can't cancel the package under the circumstances, so abort. - $dbh->rollback if $oldAutoCommit; - return "Unable to transfer all services from package ".$old_pkg->pkgnum; - } - $error = $old_pkg->cancel( quiet=>1 ); - if ($error) { - $dbh->rollback; - return $error; - } - } - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; -} - -=back - -=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_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are -loaded via 'use' at compile time, rather than via 'require' in sub { setup, -suspend, unsuspend, cancel } because they use %FS::UID::callback to load -configuration values. Probably need a subroutine which decides what to do -based on whether or not we've fetched the user yet, rather than a hash. See -FS::UID and the TODO. - -Now that things are transactional should the check in the insert method be -moved to check ? - -=head1 SEE ALSO - -L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>, -L<FS::pkg_svc>, schema.html from the base documentation - -=cut - -1; - diff --git a/FS/FS/cust_refund.pm b/FS/FS/cust_refund.pm deleted file mode 100644 index 8c672b8..0000000 --- a/FS/FS/cust_refund.pm +++ /dev/null @@ -1,319 +0,0 @@ -package FS::cust_refund; - -use strict; -use vars qw( @ISA ); -use Business::CreditCard; -use FS::Record qw( qsearch qsearchs dbh ); -use FS::UID qw(getotaker); -use FS::cust_credit; -use FS::cust_credit_refund; -use FS::cust_pay_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_pay>). FS::cust_refund -inherits from FS::Record. The following fields are currently supported: - -=over 4 - -=item refundnum - primary key (assigned automatically for new refunds) - -=item custnum - customer (see L<FS::cust_main>) - -=item refund - Amount of the refund - -=item reason - Reason for the refund - -=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see -L<Time::Local> and L<Date::Parse> for conversion functions. - -=item payby - `CARD' (credit cards), `CHEK' (electronic check/ACH), -`LECB' (Phone bill billing), `BILL' (billing), `CASH' (cash), -`WEST' (Western Union), `MCRD' (Manual credit card), 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<FS::UID>) - -=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. Or (this time for convenience and consistancy), if the -additional field paynum is defined, an FS::cust_pay_refund record for the full -amount of the refund will be created. In both cases, 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); - } elsif ( $self->paynum ) { - my $cust_pay = qsearchs('cust_pay', { 'paynum' => $self->paynum } ) - or do { - $dbh->rollback if $oldAutoCommit; - return "Unknown cust_pay.paynum: ". $self->paynum; - }; - $self->custnum($cust_pay->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); - } elsif ( $self->paynum ) { - my $cust_pay_refund = new FS::cust_pay_refund { - 'paynum' => $self->paynum, - 'refundnum' => $self->refundnum, - 'amount' => $self->refund, - '_date' => $self->_date, - }; - $error = $cust_pay_refund->insert; - 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_text('reason') - || $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|CHEK|LECB|BILL|COMP|CASH|WEST|MCRD)$/ - 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); - - $self->SUPER::check; -} - -=item cust_credit_refund - -Returns all applications to credits (see L<FS::cust_credit_refund>) for this -refund. - -=cut - -sub cust_credit_refund { - my $self = shift; - sort { $a->_date <=> $b->_date } - qsearch( 'cust_credit_refund', { 'refundnum' => $self->refundnum } ) - ; -} - -=item cust_pay_refund - -Returns all applications to payments (see L<FS::cust_pay_refund>) for this -refund. - -=cut - -sub cust_pay_refund { - my $self = shift; - sort { $a->_date <=> $b->_date } - qsearch( 'cust_pay_refund', { 'refundnum' => $self->refundnum } ) - ; -} - -=item unapplied - -Returns the amount of this refund that is still unapplied; which is -amount minus all credit applications (see L<FS::cust_credit_refund>) and -payment applications (see L<FS::cust_pay_refund>). - -=cut - -sub unapplied { - my $self = shift; - my $amount = $self->refund; - $amount -= $_->amount foreach ( $self->cust_credit_refund ); - $amount -= $_->amount foreach ( $self->cust_pay_refund ); - sprintf("%.2f", $amount ); -} - - - -=item payinfo_masked - -Returns a "masked" payinfo field with all but the last four characters replaced -by 'x'es. Useful for displaying credit cards. - -=cut - - -sub payinfo_masked { - my $self = shift; - my $payinfo = $self->payinfo; - 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4)); -} - - -=back - -=head1 BUGS - -Delete and replace methods. payinfo_masked false laziness with cust_main.pm -and cust_pay.pm - -=head1 SEE ALSO - -L<FS::Record>, L<FS::cust_credit>, 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 8914e8c..0000000 --- a/FS/FS/cust_svc.pm +++ /dev/null @@ -1,664 +0,0 @@ -package FS::cust_svc; - -use strict; -use vars qw( @ISA $DEBUG $ignore_quantity ); -use Carp qw( carp cluck ); -use FS::Conf; -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_domain; -use FS::svc_forward; -use FS::svc_broadband; -use FS::svc_phone; -use FS::svc_external; -use FS::domain_record; -use FS::part_export; -use FS::cdr; - -@ISA = qw( FS::Record ); - -$DEBUG = 0; - -$ignore_quantity = 0; - -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<FS::cust_pkg>) - -=item svcpart - Service definition (see L<FS::part_svc>) - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new service. To add the refund to the database, see L<"insert">. -Services are normally created by creating FS::svc_ objects (see -L<FS::svc_acct>, L<FS::svc_domain>, and L<FS::svc_forward>, 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<cancel> method instead. - -=item cancel - -Cancels the relevant service by calling the B<cancel> 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; - - if ( $new->svcpart != $old->svcpart ) { - my $svc_x = $new->svc_x; - my $new_svc_x = ref($svc_x)->new({$svc_x->hash, svcpart=>$new->svcpart }); - local($FS::Record::nowarn_identical) = 1; - my $error = $new_svc_x->replace($svc_x); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error if $error; - } - } - - my $error = $new->SUPER::replace($old); - 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, otherwise 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 $quantity = $pkg_svc ? $pkg_svc->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) >= $quantity && !$ignore_quantity; - } - - $self->SUPER::check; -} - -=item part_svc - -Returns the definition for this service, as a FS::part_svc object (see -L<FS::part_svc>). - -=cut - -sub part_svc { - my $self = shift; - $self->{'_svcpart'} - ? $self->{'_svcpart'} - : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); -} - -=item cust_pkg - -Returns the package this service belongs to, as a FS::cust_pkg object (see -L<FS::cust_pkg>). - -=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 -- svcnum - -Usage example: - - my($label, $value, $svcdb) = $cust_svc->label; - -=cut - -sub label { - my $self = shift; - carp "FS::cust_svc::label called on $self" if $DEBUG; - my $svc_x = $self->svc_x - or die "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum; - $self->_svc_label($svc_x); -} - -sub _svc_label { - my( $self, $svc_x ) = ( shift, shift ); - my $svcdb = $self->part_svc->svcdb; - - my $tag; - if ( $svcdb eq 'svc_acct' ) { - $tag = $svc_x->email(@_); - } elsif ( $svcdb eq 'svc_forward' ) { - if ( $svc_x->srcsvc ) { - my $svc_acct = $svc_x->srcsvc_acct(@_); - $tag = $svc_acct->email(@_); - } else { - $tag = $svc_x->src; - } - $tag .= '->'; - if ( $svc_x->dstsvc ) { - my $svc_acct = $svc_x->dstsvc_acct(@_); - $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_record = $svc_x->domain_record(@_); - $tag = $domain_record->zone; - } elsif ( $svcdb eq 'svc_broadband' ) { - $tag = $svc_x->ip_addr; - } elsif ( $svcdb eq 'svc_phone' ) { - $tag = $svc_x->phonenum; #XXX format it better - } elsif ( $svcdb eq 'svc_external' ) { - my $conf = new FS::Conf; - if ( $conf->config('svc_external-display_type') eq 'artera_turbo' ) { - $tag = sprintf('%010d', $svc_x->id). '-'. - substr('0000000000'.uc($svc_x->title), -10); - } else { - $tag = $svc_x->id. ': '. $svc_x->title; - } - } else { - cluck "warning: asked for label of unsupported svcdb; using svcnum"; - $tag = $svc_x->getfield('svcnum'); - } - - $self->part_svc->svc, $tag, $svcdb, $self->svcnum; - -} - -=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 { - #require "FS/$svcdb.pm"; - qsearchs( $svcdb, { 'svcnum' => $self->svcnum } ); - } -} - -=item seconds_since TIMESTAMP - -See L<FS::svc_acct/seconds_since>. Equivalent to -$cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records -where B<svcdb> 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]; -} - -=item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END - -See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to -$cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless -for records where B<svcdb> is not "svc_acct". - -=cut - -#note: implementation here, POD in FS::svc_acct -sub seconds_since_sqlradacct { - my($self, $start, $end) = @_; - - my $svc_x = $self->svc_x; - - my @part_export = $self->part_svc->part_export_usage; - die "no accounting-capable exports are enabled for ". $self->part_svc->svc. - " service definition" - unless @part_export; - #or return undef; - - my $seconds = 0; - foreach my $part_export ( @part_export ) { - - next if $part_export->option('ignore_accounting'); - - my $dbh = DBI->connect( map { $part_export->option($_) } - qw(datasrc username password) ) - or die "can't connect to sqlradius database: ". $DBI::errstr; - - #select a unix time conversion function based on database type - my $str2time; - if ( $dbh->{Driver}->{Name} =~ /^mysql(PP)?$/ ) { - $str2time = 'UNIX_TIMESTAMP('; - } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) { - $str2time = 'EXTRACT( EPOCH FROM '; - } else { - warn "warning: unknown database type ". $dbh->{Driver}->{Name}. - "; guessing how to convert to UNIX timestamps"; - $str2time = 'extract(epoch from '; - } - - my $username = $part_export->export_username($svc_x); - - my $query; - - #find closed sessions completely within the given range - my $sth = $dbh->prepare("SELECT SUM(acctsessiontime) - FROM radacct - WHERE UserName = ? - AND $str2time AcctStartTime) >= ? - AND $str2time AcctStopTime ) < ? - AND $str2time AcctStopTime ) > 0 - AND AcctStopTime IS NOT NULL" - ) or die $dbh->errstr; - $sth->execute($username, $start, $end) or die $sth->errstr; - my $regular = $sth->fetchrow_arrayref->[0]; - - #find open sessions which start in the range, count session start->range end - $query = "SELECT SUM( ? - $str2time AcctStartTime ) ) - FROM radacct - WHERE UserName = ? - AND $str2time AcctStartTime ) >= ? - AND $str2time AcctStartTime ) < ? - AND ( ? - $str2time AcctStartTime ) ) < 86400 - AND ( $str2time AcctStopTime ) = 0 - OR AcctStopTime IS NULL )"; - $sth = $dbh->prepare($query) or die $dbh->errstr; - $sth->execute($end, $username, $start, $end, $end) - or die $sth->errstr. " executing query $query"; - my $start_during = $sth->fetchrow_arrayref->[0]; - - #find closed sessions which start before the range but stop during, - #count range start->session end - $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? ) - FROM radacct - WHERE UserName = ? - AND $str2time AcctStartTime ) < ? - AND $str2time AcctStopTime ) >= ? - AND $str2time AcctStopTime ) < ? - AND $str2time AcctStopTime ) > 0 - AND AcctStopTime IS NOT NULL" - ) or die $dbh->errstr; - $sth->execute($start, $username, $start, $start, $end ) or die $sth->errstr; - my $end_during = $sth->fetchrow_arrayref->[0]; - - #find closed (not anymore - or open) sessions which start before the range - # but stop after, or are still open, count range start->range end - # don't count open sessions (probably missing stop record) - $sth = $dbh->prepare("SELECT COUNT(*) - FROM radacct - WHERE UserName = ? - AND $str2time AcctStartTime ) < ? - AND ( $str2time AcctStopTime ) >= ? - )" - # OR AcctStopTime = 0 - # OR AcctStopTime IS NULL )" - ) or die $dbh->errstr; - $sth->execute($username, $start, $end ) or die $sth->errstr; - my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0]; - - $seconds += $regular + $end_during + $start_during + $entire_range; - - } - - $seconds; - -} - -=item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE - -See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to -$cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless -for records where B<svcdb> is not "svc_acct". - -=cut - -#note: implementation here, POD in FS::svc_acct -#(false laziness w/seconds_since_sqlradacct above) -sub attribute_since_sqlradacct { - my($self, $start, $end, $attrib) = @_; - - my $svc_x = $self->svc_x; - - my @part_export = $self->part_svc->part_export_usage; - die "no accounting-capable exports are enabled for ". $self->part_svc->svc. - " service definition" - unless @part_export; - #or return undef; - - my $sum = 0; - - foreach my $part_export ( @part_export ) { - - next if $part_export->option('ignore_accounting'); - - my $dbh = DBI->connect( map { $part_export->option($_) } - qw(datasrc username password) ) - or die "can't connect to sqlradius database: ". $DBI::errstr; - - #select a unix time conversion function based on database type - my $str2time; - if ( $dbh->{Driver}->{Name} =~ /^mysql(PP)?$/ ) { - $str2time = 'UNIX_TIMESTAMP('; - } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) { - $str2time = 'EXTRACT( EPOCH FROM '; - } else { - warn "warning: unknown database type ". $dbh->{Driver}->{Name}. - "; guessing how to convert to UNIX timestamps"; - $str2time = 'extract(epoch from '; - } - - my $username = $part_export->export_username($svc_x); - - my $sth = $dbh->prepare("SELECT SUM($attrib) - FROM radacct - WHERE UserName = ? - AND $str2time AcctStopTime ) >= ? - AND $str2time AcctStopTime ) < ? - AND AcctStopTime IS NOT NULL" - ) or die $dbh->errstr; - $sth->execute($username, $start, $end) or die $sth->errstr; - - $sum += $sth->fetchrow_arrayref->[0]; - - } - - $sum; - -} - -=item get_session_history TIMESTAMP_START TIMESTAMP_END - -See L<FS::svc_acct/get_session_history>. Equivalent to -$cust_svc->svc_x->get_session_history, but more efficient. Meaningless for -records where B<svcdb> is not "svc_acct". - -=cut - -sub get_session_history { - my($self, $start, $end, $attrib) = @_; - - #$attrib ??? - - my @part_export = $self->part_svc->part_export_usage; - die "no accounting-capable exports are enabled for ". $self->part_svc->svc. - " service definition" - unless @part_export; - #or return undef; - - my @sessions = (); - - foreach my $part_export ( @part_export ) { - push @sessions, - @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) }; - } - - @sessions; - -} - -=item get_cdrs_for_update - -Returns (and SELECTs "FOR UPDATE") all unprocessed (freesidestatus NULL) CDR -objects (see L<FS::cdr>) associated with this service. - -Currently CDRs are associated with svc_acct services via a DID in the -username. This part is rather tenative and still subject to change... - -=cut - -sub get_cdrs_for_update { - my($self, %options) = @_; - - my $default_prefix = $options{'default_prefix'}; - - #CDRs are now associated with svc_phone services via svc_phone.phonenum - #return () unless $self->svc_x->isa('FS::svc_phone'); - return () unless $self->part_svc->svcdb eq 'svc_phone'; - my $number = $self->svc_x->phonenum; - - my @cdrs = - qsearch( { - 'table' => 'cdr', - 'hashref' => { 'freesidestatus' => '', - 'charged_party' => $number - }, - 'extra_sql' => 'FOR UPDATE', - } ); - - if ( length($default_prefix) ) { - push @cdrs, - qsearch( { - 'table' => 'cdr', - 'hashref' => { 'freesidestatus' => '', - 'charged_party' => "$default_prefix$number", - }, - 'extra_sql' => 'FOR UPDATE', - } ); - } - - @cdrs; -} - -=item pkg_svc - -Returns the pkg_svc record for for this service, if applicable. - -=cut - -sub pkg_svc { - my $self = shift; - my $cust_pkg = $self->cust_pkg; - return undef unless $cust_pkg; - - qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart, - 'pkgpart' => $cust_pkg->pkgpart, - } - ); -} - -=back - -=head1 BUGS - -Behaviour of changing the svcpart of cust_svc records is undefined and should -possibly be prohibited, and pkg_svc records are not checked. - -pkg_svc records are not checked in general (here). - -Deleting this record doesn't check or delete the svc_* record associated -with this record. - -In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of -a DBI database handle is not yet implemented. - -=head1 SEE ALSO - -L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>, -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 3e39887..0000000 --- a/FS/FS/cust_tax_exempt.pm +++ /dev/null @@ -1,151 +0,0 @@ -package FS::cust_tax_exempt; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); -use FS::cust_main; -use FS::cust_main_county; - -@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 record of an old-style 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<FS::cust_main>) - -=item taxnum - tax rate (see L<FS::cust_main_county>) - -=item year - -=item month - -=item amount - -=back - -=head1 NOTE - -Old-style customer tax exemptions are only useful for legacy migrations - if -you are looking for current customer tax exemption data see -L<FS::cust_tax_exempt_pkg>. - -=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<hash> 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') - || $self->SUPER::check - ; -} - -=item cust_main_county - -Returns the FS::cust_main_county object associated with this tax exemption. - -=cut - -sub cust_main_county { - my $self = shift; - qsearchs( 'cust_main_county', { 'taxnum' => $self->taxnum } ); -} - -=back - -=head1 BUGS - -Texas tax is a royal pain in the ass. - -=head1 SEE ALSO - -L<FS::cust_main_county>, L<FS::cust_main>, L<FS::Record>, schema.html from the -base documentation. - -=cut - -1; - diff --git a/FS/FS/cust_tax_exempt_pkg.pm b/FS/FS/cust_tax_exempt_pkg.pm deleted file mode 100644 index 128921b..0000000 --- a/FS/FS/cust_tax_exempt_pkg.pm +++ /dev/null @@ -1,136 +0,0 @@ -package FS::cust_tax_exempt_pkg; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); -use FS::cust_main_Mixin; -use FS::cust_bill_pkg; -use FS::cust_main_county; - -@ISA = qw( FS::cust_main_Mixin FS::Record ); - -=head1 NAME - -FS::cust_tax_exempt_pkg - Object methods for cust_tax_exempt_pkg records - -=head1 SYNOPSIS - - use FS::cust_tax_exempt_pkg; - - $record = new FS::cust_tax_exempt_pkg \%hash; - $record = new FS::cust_tax_exempt_pkg { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::cust_tax_exempt_pkg object represents a 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 exemptpkgnum - primary key - -=item billpkgnum - invoice line item (see L<FS::cust_bill_pkg>) - -=item taxnum - tax rate (see L<FS::cust_main_county>) - -=item year - -=item month - -=item amount - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new exemption record. To add the examption record to the database, -see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'cust_tax_exempt_pkg'; } - -=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 exemption 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('exemptnum') -# || $self->ut_foreign_key('custnum', 'cust_main', 'custnum') - || $self->ut_foreign_key('billpkgnum', 'cust_bill_pkg', 'billpkgnum') - || $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') - || $self->SUPER::check - ; -} - -=back - -=head1 BUGS - -Texas tax is still a royal pain in the ass. - -=head1 SEE ALSO - -L<FS::cust_main_county>, L<FS::cust_bill_pkg>, L<FS::Record>, 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 6513abf..0000000 --- a/FS/FS/domain_record.pm +++ /dev/null @@ -1,438 +0,0 @@ -package FS::domain_record; - -use strict; -use vars qw( @ISA $noserial_hack $DEBUG ); -use FS::Conf; -#use FS::Record qw( qsearch qsearchs ); -use FS::Record qw( qsearchs dbh ); -use FS::svc_domain; -use FS::svc_www; - -@ISA = qw(FS::Record); - -$DEBUG = 0; - -=head1 NAME - -FS::domain_record - Object methods for domain_record records - -=head1 SYNOPSIS - - use FS::domain_record; - - $record = new FS::domain_record \%hash; - $record = new FS::domain_record { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::domain_record object represents an entry in a DNS zone. -FS::domain_record inherits from FS::Record. The following fields are currently -supported: - -=over 4 - -=item recnum - primary key - -=item svcnum - Domain (see L<FS::svc_domain>) of this entry - -=item reczone - partial (or full) zone for this entry - -=item recaf - address family for this entry, currently only `IN' is recognized. - -=item rectype - record type for this entry (A, MX, etc.) - -=item recdata - data for this entry - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new entry. To add the entry to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -sub table { 'domain_record'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=cut - -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; - } - } - - my $conf = new FS::Conf; - if ( $self->rectype =~ /^A$/ && ! $conf->exists('disable_autoreverse') ) { - my $reverse = $self->reverse_record; - if ( $reverse && ! $reverse->recnum ) { - my $error = $reverse->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error adding corresponding reverse-ARPA record: $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; - } - } - - my $conf = new FS::Conf; - if ( $self->rectype =~ /^A$/ && ! $conf->exists('disable_autoreverse') ) { - my $reverse = $self->reverse_record; - if ( $reverse && $reverse->recnum && $reverse->recdata eq $self->zone.'.' ){ - my $error = $reverse->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error removing corresponding reverse-ARPA record: $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 entry. 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 } ); - - my $conf = new FS::Conf; - - if ( $conf->exists('zone-underscore') ) { - $self->reczone =~ /^(@|[a-z0-9_\.\-\*]+)$/i - or return "Illegal reczone: ". $self->reczone; - $self->reczone($1); - } else { - $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|TXT|_mstr)$/ - or return "Illegal rectype (only SOA NS MX A PTR CNAME TXT 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+|((\d+[WDHMS])+)) ){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' ) { - if ( $conf->exists('zone-underscore') ) { - $self->recdata =~ /^([a-z0-9_\.\-]+)$/i - or return "Illegal data for PTR record: ". $self->recdata; - $self->recdata($1); - } else { - $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 'TXT' ) { - if ( $self->recdata =~ /^((?:\S+)|(?:".+"))$/ ) { - $self->recdata($1); - } else { - $self->recdata('"'. $self->recdata. '"'); #? - } - # or return "Illegal data for TXT record: ". $self->recdata; - } 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!"; - } - - $self->SUPER::check; -} - -=item increment_serial - -=cut - -sub increment_serial { - return '' if $noserial_hack; - my $self = shift; - - my $soa = qsearchs('domain_record', { - svcnum => $self->svcnum, - reczone => '@', - recaf => 'IN', - rectype => 'SOA', } ) - || qsearchs('domain_record', { - svcnum => $self->svcnum, - reczone => $self->svc_domain->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<FS::svc_domain>) for this record. - -=cut - -sub svc_domain { - my $self = shift; - qsearchs('svc_domain', { svcnum => $self->svcnum } ); -} - -=item zone - -Returns the canonical zone name. - -=cut - -sub zone { - my $self = shift; - my $zone = $self->reczone; # or die ? - if ( $zone =~ /\.$/ ) { - $zone =~ s/\.$//; - } else { - my $svc_domain = $self->svc_domain; # or die ? - $zone .= '.'. $svc_domain->domain; - $zone =~ s/^\@\.//; - } - $zone; -} - -=item reverse_record - -Returns the corresponding reverse-ARPA record as another FS::domain_record -object. If the specific record does not exist in the database but the -reverse-ARPA zone itself does, an appropriate new record is created. If no -reverse-ARPA zone is available at all, returns false. - -(You can test whether or not record itself exists in the database or is a new -object that might need to be inserted by checking the recnum field) - -Mostly used by the insert and delete methods - probably should see them for -examples. - -=cut - -sub reverse_record { - my $self = shift; - warn "reverse_record called\n" if $DEBUG; - #should support classless reverse-ARPA ala rfc2317 too - $self->recdata =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ - or return ''; - my $domain = "$3.$2.$1.in-addr.arpa"; - my $ptr_reczone = $4; - warn "reverse_record: searching for domain: $domain\n" if $DEBUG; - my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } ) - or return ''; - warn "reverse_record: found domain: $domain\n" if $DEBUG; - my %hash = ( - 'svcnum' => $svc_domain->svcnum, - 'reczone' => $ptr_reczone, - 'recaf' => 'IN', - 'rectype' => 'PTR', - ); - qsearchs('domain_record', \%hash ) - or new FS::domain_record { %hash, 'recdata' => $self->zone.'.' }; -} - -=back - -=head1 BUGS - -The data validation doesn't check everything it could. In particular, -there is no protection against bad data that passes the regex, duplicate -SOA records, forgetting the trailing `.', impossible IP addersses, etc. Of -course, it's still better than editing the zone files directly. :) - -=head1 SEE ALSO - -L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/export_svc.pm b/FS/FS/export_svc.pm deleted file mode 100644 index 0370f5f..0000000 --- a/FS/FS/export_svc.pm +++ /dev/null @@ -1,322 +0,0 @@ -package FS::export_svc; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs dbh ); -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<FS::part_svc>) to -an export (see L<FS::part_export>). FS::export_svc inherits from FS::Record. -The following fields are currently supported: - -=over 4 - -=item exportsvcnum - primary key - -=item exportnum - export (see L<FS::part_export>) - -=item svcpart - service definition (see L<FS::part_svc>) - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new record. To add the record to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'export_svc'; } - -=item insert [ JOB, OFFSET, MULTIPLIER ] - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -TODOC: JOB, OFFSET, MULTIPLIER - -=cut - -sub insert { - my $self = shift; - my( $job, $offset, $mult ) = ( '', 0, 100); - $job = shift if @_; - $offset = shift if @_; - $mult = 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->check; - return $error if $error; - - #check for duplicates! - my @checks = (); - my $svcdb = $self->part_svc->svcdb; - if ( $svcdb eq 'svc_acct' ) { - - if ( $self->part_export->nodomain =~ /^Y/i ) { - push @checks, { - label => 'usernames', - method => 'username', - sortby => sub { $a cmp $b }, - }; - } else { - push @checks, { - label => 'username@domain', - method => 'email', - sortby => sub { - my($auser, $adomain) = split('@', $a); - my($buser, $bdomain) = split('@', $b); - $adomain cmp $bdomain || $auser cmp $buser; - }, - }; - } - - unless ( $self->part_svc->part_svc_column('uid')->columnflag eq 'F' ) { - push @checks, { - label => 'uids', - method => 'uid', - sortby => sub { $a <=> $b }, - }; - } - - } elsif ( $svcdb eq 'svc_domain' ) { - push @checks, { - label => 'domains', - method => 'domain', - sortby => sub { $a cmp $b }, - }; - } else { - warn "WARNING: No duplicate checking done on merge of $svcdb exports"; - } - - if ( @checks ) { - - my $done = 0; - my $percheck = $mult / scalar(@checks); - - foreach my $check ( @checks ) { - - if ( $job ) { - $error = $job->update_statustext(int( $offset + ($done+.33) *$percheck )); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - my @current_svc = $self->part_export->svc_x; - #warn "current: ". scalar(@current_svc). " $current_svc[0]\n"; - - if ( $job ) { - $error = $job->update_statustext(int( $offset + ($done+.67) *$percheck )); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - my @new_svc = $self->part_svc->svc_x; - #warn "new: ". scalar(@new_svc). " $new_svc[0]\n"; - - if ( $job ) { - $error = $job->update_statustext(int( $offset + ($done+1) *$percheck )); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - my $method = $check->{'method'}; - my %cur_svc = map { $_->$method() => $_ } @current_svc; - my @dup_svc = grep { $cur_svc{$_->$method()} } @new_svc; - #my @diff_customer = grep { - # $_->cust_pkg->custnum != $cur_svc{$_->$method()}->cust_pkg->custnum - # } @dup_svc; - - - - if ( @dup_svc ) { #aye, that's the rub - #error out for now, eventually accept different options of adjustments - # to make to allow us to continue forward - $dbh->rollback if $oldAutoCommit; - - my @diff_customer_svc = grep { - my $cust_pkg = $_->cust_svc->cust_pkg; - my $custnum = $cust_pkg ? $cust_pkg->custnum : 0; - my $other_cust_pkg = $cur_svc{$_->$method()}->cust_svc->cust_pkg; - my $other_custnum = $other_cust_pkg ? $other_cust_pkg->custnum : 0; - $custnum != $other_custnum; - } @dup_svc; - - my $label = $check->{'label'}; - my $sortby = $check->{'sortby'}; - return "Can't export ". - $self->part_svc->svcpart.':'.$self->part_svc->svc. " service to ". - $self->part_export->exportnum.':'.$self->part_export->exporttype. - ' on '. $self->part_export->machine. - ' : '. scalar(@dup_svc). " duplicate $label". - ' ('. scalar(@diff_customer_svc). " from different customers)". - ": ". join(', ', sort $sortby map { $_->$method() } @dup_svc ) - #": ". join(', ', sort $sortby map { $_->$method() } @diff_customer_svc ) - ; - } - - $done++; - } - - } #end of duplicate check, whew - - $error = $self->SUPER::insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - -# if ( $self->part_svc->svcdb eq 'svc_acct' ) { -# -# if ( $self->part_export->nodomain =~ /^Y/i ) { -# -# select username from svc_acct where svcpart = $svcpart -# group by username having count(*) > 1; -# -# } else { -# -# select username, domain -# from svc_acct -# join svc_domain on ( svc_acct.domsvc = svc_domain.svcnum ) -# group by username, domain having count(*) > 1; -# -# } -# -# } elsif ( $self->part_svc->svcdb eq 'svc_domain' ) { -# -# #similar but easier domain checking one -# -# } #etc.? -# -# my @services = -# map { $_->part_svc } -# grep { $_->svcpart != $self->svcpart } -# $self->part_export->export_svc; - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; #no error -} - -=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') - || $self->SUPER::check - ; -} - -=item part_export - -Returns the FS::part_export object (see L<FS::part_export>). - -=cut - -sub part_export { - my $self = shift; - qsearchs( 'part_export', { 'exportnum' => $self->exportnum } ); -} - -=item part_svc - -Returns the FS::part_svc object (see L<FS::part_svc>). - -=cut - -sub part_svc { - my $self = shift; - qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::part_export>, L<FS::part_svc>, L<FS::Record>, schema.html from the base -documentation. - -=cut - -1; - diff --git a/FS/FS/h_Common.pm b/FS/FS/h_Common.pm deleted file mode 100644 index d55da8c..0000000 --- a/FS/FS/h_Common.pm +++ /dev/null @@ -1,103 +0,0 @@ -package FS::h_Common; - -use strict; -use FS::Record qw(dbdef); -use Carp qw(confess); - -=head1 NAME - -FS::h_Common - History table "mixin" common base class - -=head1 SYNOPSIS - -package FS::h_tablename; -@ISA = qw( FS::h_Common FS::tablename ); - -sub table { 'h_table_name'; } - -sub insert { return "can't insert history records manually"; } -sub delete { return "can't delete history records"; } -sub replace { return "can't modify history records"; } - -=head1 DESCRIPTION - -FS::h_Common is intended as a "mixin" base class for history table classes to -inherit from. - -=head1 METHODS - -=over 4 - -=item sql_h_search END_TIMESTAMP [ START_TIMESTAMP ] - -Returns an a list consisting of the "SELECT" and "EXTRA_SQL" SQL fragments to -search for the appropriate history records created before END_TIMESTAMP -and (optionally) not cancelled before START_TIMESTAMP. - -=cut - -sub sql_h_search { - my( $self, $end ) = ( shift, shift ); - - my $table = $self->table; - my $real_table = ($table =~ /^h_(.*)$/) ? $1 : $table; - my $pkey = dbdef->table($real_table)->primary_key - or die "can't (yet) search history table $real_table without a primary key"; - - unless ($end) { - confess 'Called sql_h_search without END_TIMESTAMP'; - } - - my $notcancelled = ''; - if ( scalar(@_) && $_[0] ) { - $notcancelled = "AND 0 = ( SELECT COUNT(*) FROM $table as notdel - WHERE notdel.$pkey = maintable.$pkey - AND notdel.history_action = 'delete' - AND notdel.history_date > maintable.history_date - AND notdel.history_date <= $_[0] - )"; - } - - ( - "DISTINCT ON ( $pkey ) *", - - "AND history_date <= $end - AND ( history_action = 'insert' - OR history_action = 'replace_new' - ) - $notcancelled - ORDER BY $pkey ASC, history_date DESC", - - '', - - 'AS maintable', - ); - -} - -=item sql_h_searchs END_TIMESTAMP [ START_TIMESTAMP ] - -Like sql_h_search, but limited to the single most recent record (before -END_TIMESTAMP) - -=cut - -sub sql_h_searchs { - my $self = shift; - my($select, $where, $cacheobj, $as) = $self->sql_h_search(@_); - $where .= ' LIMIT 1'; - ($select, $where, $cacheobj, $as); -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::Record>, schema.html from the base documentation - -=cut - -1; - diff --git a/FS/FS/h_cust_bill.pm b/FS/FS/h_cust_bill.pm deleted file mode 100644 index 7a3d811..0000000 --- a/FS/FS/h_cust_bill.pm +++ /dev/null @@ -1,33 +0,0 @@ -package FS::h_cust_bill; - -use strict; -use vars qw( @ISA ); -use FS::h_Common; -use FS::cust_bill; - -@ISA = qw( FS::h_Common FS::cust_bill ); - -sub table { 'h_cust_bill' }; - -=head1 NAME - -FS::h_cust_bill - Historical record of customer tax changes (old-style) - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -An FS::h_cust_bill object represents historical changes to invoices. -FS::h_cust_bill inherits from FS::h_Common and FS::cust_bill. - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::cust_bill>, L<FS::h_Common>, L<FS::Record>, schema.html from the base -documentation. - -=cut - -1; - diff --git a/FS/FS/h_cust_svc.pm b/FS/FS/h_cust_svc.pm deleted file mode 100644 index af0bf60..0000000 --- a/FS/FS/h_cust_svc.pm +++ /dev/null @@ -1,107 +0,0 @@ -package FS::h_cust_svc; - -use strict; -use vars qw( @ISA $DEBUG ); -use Carp; -use FS::Record qw(qsearchs); -use FS::h_Common; -use FS::cust_svc; - -@ISA = qw( FS::h_Common FS::cust_svc ); - -$DEBUG = 0; - -sub table { 'h_cust_svc'; } - -=head1 NAME - -FS::h_cust_svc - Object method for h_cust_svc objects - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -An FS::h_cust_svc object represents a historical service. FS::h_cust_svc -inherits from FS::h_Common and FS::cust_svc. - -=head1 METHODS - -=over 4 - -=item label END_TIMESTAMP [ START_TIMESTAMP ] - -Returns a list consisting of: -- The name of this historical service (from part_svc) -- A meaningful identifier (username, domain, or mail alias) -- The table name (i.e. svc_domain) for this historical service - -=cut - -sub label { - my $self = shift; - carp "FS::h_cust_svc::label called on $self" if $DEBUG; - my $svc_x = $self->h_svc_x(@_); - my $part_svc = $self->part_svc; - - unless ($svc_x) { - carp "can't find h_". $self->part_svc->svcdb. '.svcnum '. $self->svcnum if $DEBUG; - return $part_svc->svc, 'n/a', $part_svc->svcdb; - } - - my @label; - eval { @label = $self->_svc_label($svc_x, @_); }; - - if ($@) { - carp 'while resolving history record for svcdb/svcnum ' . - $part_svc->svcdb . '/' . $self->svcnum . ': ' . $@ if $DEBUG; - return $part_svc->svc, 'n/a', $part_svc->svcdb; - } else { - return @label; - } - -} - -=item h_svc_x END_TIMESTAMP [ START_TIMESTAMP ] - -Returns the FS::h_svc_XXX object for this service as of END_TIMESTAMP (i.e. an -FS::h_svc_acct object or FS::h_svc_domain object, etc.) and (optionally) not -cancelled before START_TIMESTAMP. - -=cut - -#false laziness w/cust_pkg::h_cust_svc -sub h_svc_x { - my $self = shift; - my $svcdb = $self->part_svc->svcdb; - - warn "requiring FS/h_$svcdb.pm" if $DEBUG; - require "FS/h_$svcdb.pm"; - my $svc_x = qsearchs( - "h_$svcdb", - { 'svcnum' => $self->svcnum, }, - "FS::h_$svcdb"->sql_h_searchs(@_), - ) || $self->SUPER::svc_x; - - if ($svc_x) { - carp "Using $svcdb in place of missing h_${svcdb} record." - if ($svc_x->isa('FS::' . $svcdb) and $DEBUG); - return $svc_x; - } else { - return ''; - } - -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::h_Common>, L<FS::cust_svc>, L<FS::Record>, schema.html from the base -documentation. - -=cut - -1; - diff --git a/FS/FS/h_cust_tax_exempt.pm b/FS/FS/h_cust_tax_exempt.pm deleted file mode 100644 index 9d2318b..0000000 --- a/FS/FS/h_cust_tax_exempt.pm +++ /dev/null @@ -1,40 +0,0 @@ -package FS::h_cust_tax_exempt; - -use strict; -use vars qw( @ISA ); -use FS::h_Common; -use FS::cust_tax_exempt; - -@ISA = qw( FS::h_Common FS::cust_tax_exempt ); - -sub table { 'h_cust_tax_exempt' }; - -=head1 NAME - -FS::h_cust_tax_exempt - Historical record of customer tax changes (old-style) - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -An FS::h_cust_tax_exempt object represents historical changes to old-style -customer tax exemptions. FS::h_cust_tax_exempt inherits from FS::h_Common and -FS::cust_tax_exempt. - -=head1 NOTE - -Old-style customer tax exemptions are only useful for legacy migrations - if -you are looking for current customer tax exemption data see -L<FS::cust_tax_exempt_pkg>. - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::cust_tax_exempt>, L<FS::cust_tax_exempt_pkg>, L<FS::h_Common>, -L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/h_domain_record.pm b/FS/FS/h_domain_record.pm deleted file mode 100644 index 0ab974f..0000000 --- a/FS/FS/h_domain_record.pm +++ /dev/null @@ -1,33 +0,0 @@ -package FS::h_domain_record; - -use strict; -use vars qw( @ISA ); -use FS::h_Common; -use FS::domain_record; - -@ISA = qw( FS::h_Common FS::domain_record ); - -sub table { 'h_domain_record' }; - -=head1 NAME - -FS::h_domain_record - Historical DNS entry objects - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -An FS::h_domain_record object represents a historical entry in a DNS zone. -FS::h_domain_record inherits from FS::h_Common and FS::domain_record. - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::h_Common>, L<FS::svc_external>, L<FS::Record>, schema.html from the base -documentation. - -=cut - -1; - diff --git a/FS/FS/h_svc_acct.pm b/FS/FS/h_svc_acct.pm deleted file mode 100644 index 247d20c..0000000 --- a/FS/FS/h_svc_acct.pm +++ /dev/null @@ -1,78 +0,0 @@ -package FS::h_svc_acct; - -use strict; -use vars qw( @ISA $DEBUG ); -use Carp qw(carp); -use FS::Record qw(qsearchs); -use FS::h_Common; -use FS::svc_acct; -use FS::svc_domain; -use FS::h_svc_domain; - -@ISA = qw( FS::h_Common FS::svc_acct ); - -$DEBUG = 0; - -sub table { 'h_svc_acct' }; - -=head1 NAME - -FS::h_svc_acct - Historical account objects - -=head1 SYNOPSIS - -=head1 METHODS - -=over 4 - -=item svc_domain - -=cut - -sub svc_domain { - my $self = shift; - qsearchs( 'h_svc_domain', - { 'svcnum' => $self->domsvc }, - FS::h_svc_domain->sql_h_searchs(@_), - ); -} - -=item domain - -Returns the domain associated with this account. - -=cut - -sub domain { - my $self = shift; - die "svc_acct.domsvc is null for svcnum ". $self->svcnum unless $self->domsvc; - - my $svc_domain = $self->svc_domain(@_) || $self->SUPER::svc_domain() - or die 'no history svc_domain.svcnum for svc_acct.domsvc ' . $self->domsvc; - - carp 'Using FS::svc_acct record in place of missing FS::h_svc_acct record.' - if ($svc_domain->isa('FS::svc_acct') and $DEBUG); - - $svc_domain->domain; - -} - - -=back - -=head1 DESCRIPTION - -An FS::h_svc_acct object represents a historical account. FS::h_svc_acct -inherits from FS::h_Common and FS::svc_acct. - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::h_Common>, L<FS::svc_acct>, L<FS::Record>, schema.html from the base -documentation. - -=cut - -1; - diff --git a/FS/FS/h_svc_broadband.pm b/FS/FS/h_svc_broadband.pm deleted file mode 100644 index d6038fb..0000000 --- a/FS/FS/h_svc_broadband.pm +++ /dev/null @@ -1,33 +0,0 @@ -package FS::h_svc_broadband; - -use strict; -use vars qw( @ISA ); -use FS::h_Common; -use FS::svc_broadband; - -@ISA = qw( FS::h_Common FS::svc_broadband ); - -sub table { 'h_svc_broadband' }; - -=head1 NAME - -FS::h_svc_broadband - Historical broadband connection objects - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -An FS::h_svc_broadband object represents a historical broadband connection. -FS::h_svc_broadband inherits from FS::h_Common and FS::svc_broadband. - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::h_Common>, L<FS::svc_broadband>, L<FS::Record>, schema.html from the base -documentation. - -=cut - -1; - diff --git a/FS/FS/h_svc_domain.pm b/FS/FS/h_svc_domain.pm deleted file mode 100644 index 60d54f7..0000000 --- a/FS/FS/h_svc_domain.pm +++ /dev/null @@ -1,33 +0,0 @@ -package FS::h_svc_domain; - -use strict; -use vars qw( @ISA ); -use FS::h_Common; -use FS::svc_domain; - -@ISA = qw( FS::h_Common FS::svc_domain ); - -sub table { 'h_svc_domain' }; - -=head1 NAME - -FS::h_svc_domain - Historical domain objects - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -An FS::h_svc_domain object represents a historical domain. FS::h_svc_domain -inherits from FS::h_Common and FS::svc_domain. - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::h_Common>, L<FS::svc_domain>, L<FS::Record>, schema.html from the base -documentation. - -=cut - -1; - diff --git a/FS/FS/h_svc_external.pm b/FS/FS/h_svc_external.pm deleted file mode 100644 index 5eb7064..0000000 --- a/FS/FS/h_svc_external.pm +++ /dev/null @@ -1,33 +0,0 @@ -package FS::h_svc_external; - -use strict; -use vars qw( @ISA ); -use FS::h_Common; -use FS::svc_external; - -@ISA = qw( FS::h_Common FS::svc_external ); - -sub table { 'h_svc_external' }; - -=head1 NAME - -FS::h_svc_external - Historical externally tracked service objects - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -An FS::h_svc_external object represents a historical externally tracked service. -FS::h_svc_external inherits from FS::h_Common and FS::svc_external. - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::h_Common>, L<FS::svc_external>, L<FS::Record>, schema.html from the base -documentation. - -=cut - -1; - diff --git a/FS/FS/h_svc_forward.pm b/FS/FS/h_svc_forward.pm deleted file mode 100644 index 25b2039..0000000 --- a/FS/FS/h_svc_forward.pm +++ /dev/null @@ -1,85 +0,0 @@ -package FS::h_svc_forward; - -use strict; -use vars qw( @ISA $DEBUG ); -use FS::Record qw(qsearchs); -use FS::h_Common; -use FS::svc_forward; -use FS::svc_acct; -use FS::h_svc_acct; - -use Carp qw(carp); - -$DEBUG = 0; - -@ISA = qw( FS::h_Common FS::svc_forward ); - -sub table { 'h_svc_forward' }; - -=head1 NAME - -FS::h_svc_forward - Historical mail forwarding alias objects - -=head1 SYNOPSIS - -=head1 METHODS - -=over 4 - -=item srcsvc_acct - -=cut - -sub srcsvc_acct { - my $self = shift; - my $h_svc_acct = qsearchs( - 'h_svc_acct', - { 'svcnum' => $self->srcsvc }, - FS::h_svc_acct->sql_h_searchs(@_), - ) || $self->SUPER::srcsvc_acct - or die "no history svc_acct.svcnum for svc_forward.srcsvc ". $self->srcsvc; - - carp 'Using svc_acct in place of missing h_svc_acct record.' - if ($h_svc_acct->isa('FS::domain_record') and $DEBUG); - - return $h_svc_acct; - -} - -=item dstsvc_acct - -=cut - -sub dstsvc_acct { - my $self = shift; - my $h_svc_acct = qsearchs( - 'h_svc_acct', - { 'svcnum' => $self->dstsvc }, - FS::h_svc_acct->sql_h_searchs(@_), - ) || $self->SUPER::dstsvc_acct - or die "no history svc_acct.svcnum for svc_forward.dstsvc ". $self->dstsvc; - - carp 'Using svc_acct in place of missing h_svc_acct record.' - if ($h_svc_acct->isa('FS::domain_record') and $DEBUG); - - return $h_svc_acct; -} - -=back - -=head1 DESCRIPTION - -An FS::h_svc_forward object represents a historical mail forwarding alias. -FS::h_svc_forward inherits from FS::h_Common and FS::svc_forward. - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::h_Common>, L<FS::svc_forward>, L<FS::Record>, schema.html from the base -documentation. - -=cut - -1; - diff --git a/FS/FS/h_svc_phone.pm b/FS/FS/h_svc_phone.pm deleted file mode 100644 index 95898c7..0000000 --- a/FS/FS/h_svc_phone.pm +++ /dev/null @@ -1,33 +0,0 @@ -package FS::h_svc_phone; - -use strict; -use vars qw( @ISA ); -use FS::h_Common; -use FS::svc_phone; - -@ISA = qw( FS::h_Common FS::svc_phone ); - -sub table { 'h_svc_phone' }; - -=head1 NAME - -FS::h_svc_phone - Historical phone number objects - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -An FS::h_svc_phone object represents a historical phone number. -FS::h_svc_phone inherits from FS::h_Common and FS::svc_phone. - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::h_Common>, L<FS::svc_phone>, L<FS::Record>, schema.html from the base -documentation. - -=cut - -1; - diff --git a/FS/FS/h_svc_www.pm b/FS/FS/h_svc_www.pm deleted file mode 100644 index 2a3b6dc..0000000 --- a/FS/FS/h_svc_www.pm +++ /dev/null @@ -1,67 +0,0 @@ -package FS::h_svc_www; - -use strict; -use vars qw( @ISA $DEBUG ); -use Carp qw(carp); -use FS::Record qw(qsearchs); -use FS::h_Common; -use FS::svc_www; -use FS::h_domain_record; - -@ISA = qw( FS::h_Common FS::svc_www ); - -$DEBUG = 0; - -sub table { 'h_svc_www' }; - -=head1 NAME - -FS::h_svc_www - Historical web virtual host objects - -=head1 SYNOPSIS - -=head1 METHODS - -=over 4 - -=item domain_record - -=cut - -sub domain_record { - my $self = shift; - - carp 'Called FS::h_svc_www->domain_record on svcnum ' . $self->svcnum if $DEBUG; - - my $domain_record = qsearchs( - 'h_domain_record', - { 'recnum' => $self->recnum }, - FS::h_domain_record->sql_h_searchs(@_), - ) || $self->SUPER::domain_record - or die "no history domain_record.recnum for svc_www.recnum ". $self->domsvc; - - carp 'Using domain_record in place of missing h_domain_record record.' - if ($domain_record->isa('FS::domain_record') and $DEBUG); - - return $domain_record; - -} - -=back - -=head1 DESCRIPTION - -An FS::h_svc_www object represents a historical web virtual host. -FS::h_svc_www inherits from FS::h_Common and FS::svc_www. - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::h_Common>, L<FS::svc_www>, L<FS::Record>, schema.html from the base -documentation. - -=cut - -1; - diff --git a/FS/FS/inventory_class.pm b/FS/FS/inventory_class.pm deleted file mode 100644 index 508889b..0000000 --- a/FS/FS/inventory_class.pm +++ /dev/null @@ -1,164 +0,0 @@ -package FS::inventory_class; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( dbh qsearch qsearchs ); - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::inventory_class - Object methods for inventory_class records - -=head1 SYNOPSIS - - use FS::inventory_class; - - $record = new FS::inventory_class \%hash; - $record = new FS::inventory_class { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::inventory_class object represents a class of inventory, such as "DID -numbers" or "physical equipment serials". FS::inventory_class inherits from -FS::Record. The following fields are currently supported: - -=over 4 - -=item classnum - primary key - -=item classname - Name of this class - - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new inventory class. To add the class to the database, see -L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'inventory_class'; } - -=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 inventory class. 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('classnum') - || $self->ut_textn('classname') - ; - return $error if $error; - - $self->SUPER::check; -} - -=item num_avail - -Returns the number of available (unused/unallocated) inventory items of this -class (see L<FS::inventory_item>). - -=cut - -sub num_avail { - shift->num_sql('( svcnum IS NULL OR svcnum = 0 )'); -} - -sub num_sql { - my( $self, $sql ) = @_; - $sql = "AND $sql" if length($sql); - my $statement = - "SELECT COUNT(*) FROM inventory_item WHERE classnum = ? $sql"; - my $sth = dbh->prepare($statement) or die dbh->errstr. " preparing $statement"; - $sth->execute($self->classnum) or die $sth->errstr. " executing $statement"; - $sth->fetchrow_arrayref->[0]; -} - -=item num_used - -Returns the number of used (allocated) inventory items of this class (see -L<FS::inventory_class>). - -=cut - -sub num_used { - shift->num_sql("svcnum IS NOT NULL AND svcnum > 0 "); -} - -=item num_total - -Returns the total number of inventory items of this class (see -L<FS::inventory_class>). - -=cut - -sub num_total { - shift->num_sql(''); -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::inventory_item>, L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/inventory_item.pm b/FS/FS/inventory_item.pm deleted file mode 100644 index 7fa350f..0000000 --- a/FS/FS/inventory_item.pm +++ /dev/null @@ -1,204 +0,0 @@ -package FS::inventory_item; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( dbh qsearch qsearchs ); -use FS::cust_main_Mixin; -use FS::inventory_class; -use FS::cust_svc; - -@ISA = qw( FS::cust_main_Mixin FS::Record ); - -=head1 NAME - -FS::inventory_item - Object methods for inventory_item records - -=head1 SYNOPSIS - - use FS::inventory_item; - - $record = new FS::inventory_item \%hash; - $record = new FS::inventory_item { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::inventory_item object represents a specific piece of (real or virtual) -inventory, such as a specific DID or serial number. FS::inventory_item -inherits from FS::Record. The following fields are currently supported: - -=over 4 - -=item itemnum - primary key - -=item classnum - Inventory class (see L<FS::inventory_class>) - -=item item - Item identifier (unique within its inventory class) - -=item svcnum - Customer servcie (see L<FS::cust_svc>) - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new item. To add the item to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'inventory_item'; } - -=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 item. 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('itemnum') - || $self->ut_foreign_key('classnum', 'inventory_class', 'classnum' ) - || $self->ut_text('item') - || $self->ut_foreign_keyn('svcnum', 'cust_svc', 'svcnum' ) - ; - return $error if $error; - - $self->SUPER::check; -} - -=item cust_svc - -Returns the customer service associated with this inventory item, if the -item has been used (see L<FS::cust_svc>). - -=cut - -sub cust_svc { - my $self = shift; - return '' unless $self->svcnum; - qsearchs( 'cust_svc', { 'svcnum' => $self->svcnum } ); -} - -=back - -=head1 CLASS METHODS - -=over 4 - -=item batch_import - -=cut - -sub batch_import { - my $param = shift; - - my $fh = $param->{filehandle}; - - my $imported = 0; - - 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 $line; - while ( defined($line=<$fh>) ) { - - chomp $line; - - my $inventory_item = new FS::inventory_item { - 'classnum' => $param->{'classnum'}, - 'item' => $line, - }; - - my $error = $inventory_item->insert; - - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - - #or just skip? - #next; - } - - $imported++; - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - #might want to disable this if we skip records for any reason... - return "Empty file!" unless $imported; - - ''; - -} - -=back - -=head1 BUGS - -maybe batch_import should be a regular method in FS::inventory_class - -=head1 SEE ALSO - -L<inventory_class>, L<cust_svc>, L<FS::Record>, schema.html from the base -documentation. - -=cut - -1; - diff --git a/FS/FS/m2m_Common.pm b/FS/FS/m2m_Common.pm deleted file mode 100644 index fd8700a..0000000 --- a/FS/FS/m2m_Common.pm +++ /dev/null @@ -1,110 +0,0 @@ -package FS::m2m_Common; - -use strict; -use vars qw( @ISA $DEBUG ); -use FS::Schema qw( dbdef ); -use FS::Record qw( qsearch qsearchs ); #dbh ); - -@ISA = qw( FS::Record ); - -$DEBUG = 0; - -=head1 NAME - -FS::m2m_Common - Base class for classes in a many-to-many relationship - -=head1 SYNOPSIS - -use FS::m2m_Common; - -@ISA = qw( FS::m2m_Common ); - -=head1 DESCRIPTION - -FS::m2m_Common is intended as a base class for classes which have a -many-to-many relationship with another table (via a linking table). - -Note: It is currently assumed that the link table contains two fields -named the same as the primary keys of ths base and target tables. - -=head1 METHODS - -=over 4 - -=item process_m2m - -=cut - -sub process_m2m { - my( $self, %opt ) = @_; - - my $self_pkey = $self->dbdef_table->primary_key; - - my $link_table = $self->_load_table($opt{'link_table'}); - - my $target_table = $self->_load_table($opt{'target_table'}); - my $target_pkey = dbdef->table($target_table)->primary_key; - - foreach my $target_obj ( qsearch($target_table, {} ) ) { - - my $targetnum = $target_obj->$target_pkey(); - - my $link_obj = qsearchs( $link_table, { - $self_pkey => $self->$self_pkey(), - $target_pkey => $targetnum, - }); - - if ( $link_obj && ! $opt{'params'}->{"$target_pkey$targetnum"} ) { - - my $d_link_obj = $link_obj; #need to save $link_obj for below. - my $error = $d_link_obj->delete; - die $error if $error; - - } elsif ( $opt{'params'}->{"$target_pkey$targetnum"} && ! $link_obj ) { - - #ok to clobber it now (but bad form nonetheless?) - #$link_obj = new "FS::$link_table" ( { - $link_obj = "FS::$link_table"->new( { - $self_pkey => $self->$self_pkey(), - $target_pkey => $targetnum, - }); - my $error = $link_obj->insert; - die $error if $error; - } - - } - - ''; -} - -sub _load_table { - my( $self, $table ) = @_; - eval "use FS::$table"; - die $@ if $@; - $table; -} - -#=item target_table -# -#=cut -# -#sub target_table { -# my $self = shift; -# my $target_table = $self->_target_table; -# eval "use FS::$target_table"; -# die $@ if $@; -# $target_table; -#} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::Record> - -=cut - -1; - diff --git a/FS/FS/m2name_Common.pm b/FS/FS/m2name_Common.pm deleted file mode 100644 index 7c9637e..0000000 --- a/FS/FS/m2name_Common.pm +++ /dev/null @@ -1,95 +0,0 @@ -package FS::m2name_Common; - -use strict; -use vars qw( @ISA $DEBUG ); -use FS::Schema qw( dbdef ); -use FS::Record qw( qsearch qsearchs ); #dbh ); - -@ISA = qw( FS::Record ); - -$DEBUG = 0; - -=head1 NAME - -FS::m2name_Common - Base class for tables with a related table listing names - -=head1 SYNOPSIS - -use FS::m2name_Common; - -@ISA = qw( FS::m2name_Common ); - -=head1 DESCRIPTION - -FS::m2name_Common is intended as a base class for classes which have a -related table that lists names. - -=head1 METHODS - -=over 4 - -=item process_m2name - -=cut - -sub process_m2name { - my( $self, %opt ) = @_; - - my $self_pkey = $self->dbdef_table->primary_key; - my $link_sourcekey = $opt{'num_col'} || $self_pkey; - - my $link_table = $self->_load_table($opt{'link_table'}); - - my $link_static = $opt{'link_static'} || {}; - - foreach my $name ( @{ $opt{'names_list'} } ) { - - my $obj = qsearchs( $link_table, { - $link_sourcekey => $self->$self_pkey(), - $opt{'name_col'} => $name, - %$link_static, - }); - - if ( $obj && ! $opt{'params'}->{"$link_table.$name"} ) { - - my $d_obj = $obj; #need to save $obj for below. - my $error = $d_obj->delete; - die "error deleting $d_obj for $link_table.$name: $error" if $error; - - } elsif ( $opt{'params'}->{"$link_table.$name"} && ! $obj ) { - - #ok to clobber it now (but bad form nonetheless?) - #$obj = new "FS::$link_table" ( { - $obj = "FS::$link_table"->new( { - $link_sourcekey => $self->$self_pkey(), - $opt{'name_col'} => $name, - %$link_static, - }); - my $error = $obj->insert; - die "error inserting $obj for $link_table.$name: $error" if $error; - } - - } - - ''; -} - -sub _load_table { - my( $self, $table ) = @_; - eval "use FS::$table"; - die $@ if $@; - $table; -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::Record> - -=cut - -1; - diff --git a/FS/FS/msgcat.pm b/FS/FS/msgcat.pm deleted file mode 100644 index cbdc1d6..0000000 --- a/FS/FS/msgcat.pm +++ /dev/null @@ -1,133 +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<use> message catalogs, see L<FS::Msgcat>. - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new message catalog entry. To add the message catalog entry to the -database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { '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 message catalog entry. 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); - - $self->SUPER::check -} - -=back - -=head1 BUGS - -i18n/l10n, eek - -=head1 SEE ALSO - -L<FS::Msgcat>, L<FS::Record>, 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 97b0ea1..0000000 --- a/FS/FS/nas.pm +++ /dev/null @@ -1,150 +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<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'nas'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=cut - -# the insert method can be inherited from FS::Record - -=item delete - -Delete this record from the database. - -=cut - -# the delete method can be inherited from FS::Record - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -# the replace method can be inherited from FS::Record - -=item check - -Checks all fields to make sure this is a valid NAS. 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') - || $self->SUPER::check - ; -} - -=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 BUGS - -heartbeat method uses SQL directly and doesn't update history tables. - -=head1 SEE ALSO - -L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/option_Common.pm b/FS/FS/option_Common.pm deleted file mode 100644 index ad3c269..0000000 --- a/FS/FS/option_Common.pm +++ /dev/null @@ -1,295 +0,0 @@ -package FS::option_Common; - -use strict; -use vars qw( @ISA $DEBUG ); -use FS::Record qw( qsearch qsearchs dbh ); - -@ISA = qw( FS::Record ); - -$DEBUG = 0; - -=head1 NAME - -FS::option_Common - Base class for option sub-classes - -=head1 SYNOPSIS - -use FS::option_Common; - -@ISA = qw( FS::option_Common ); - -=head1 DESCRIPTION - -FS::option_Common is intended as a base class for classes which have a -simple one-to-many class associated with them, used to store a hash-like data -structure of keys and values. - -=head1 METHODS - -=over 4 - -=item insert [ HASHREF | OPTION => VALUE ... ] - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -If a list or hash reference of options is supplied, option records are also -created. - -=cut - -#false laziness w/queue.pm -sub insert { - my $self = shift; - my $options = - ( ref($_[0]) eq 'HASH' ) - ? shift - : { @_ }; - warn "FS::option_Common::insert called on $self with options ". - join(', ', map "$_ => ".$options->{$_}, keys %$options) - if $DEBUG; - - 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 $pkey = $self->pkey; - my $option_table = $self->option_table; - - foreach my $optionname ( keys %{$options} ) { - my $href = { - $pkey => $self->get($pkey), - 'optionname' => $optionname, - 'optionvalue' => $options->{$optionname}, - }; - - #my $option_record = eval "new FS::$option_table \$href"; - #if ( $@ ) { - # $dbh->rollback if $oldAutoCommit; - # return $@; - #} - my $option_record = "FS::$option_table"->new($href); - - $error = $option_record->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. Any associated option records are also -deleted. - -=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; - } - - my $pkey = $self->pkey; - #my $option_table = $self->option_table; - - foreach my $obj ( $self->option_objects ) { - my $error = $obj->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; - -} - -=item replace OLD_RECORD [ HASHREF | OPTION => VALUE ... ] - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -If a list hash reference of options is supplied, part_export_option records are -created or modified (see L<FS::part_export_option>). - -=cut - -sub replace { - my $self = shift; - my $old = shift; - my $options = - ( ref($_[0]) eq 'HASH' ) - ? shift - : { @_ }; - warn "FS::option_Common::insert called on $self with options ". - join(', ', map "$_ => ". $options->{$_}, keys %$options) - if $DEBUG; - - 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; - } - - my $pkey = $self->pkey; - my $option_table = $self->option_table; - - foreach my $optionname ( keys %{$options} ) { - my $old = qsearchs( $option_table, { - $pkey => $self->get($pkey), - 'optionname' => $optionname, - } ); - - my $href = { - $pkey => $self->get($pkey), - 'optionname' => $optionname, - 'optionvalue' => $options->{$optionname}, - }; - - #my $new = eval "new FS::$option_table \$href"; - #if ( $@ ) { - # $dbh->rollback if $oldAutoCommit; - # return $@; - #} - my $new = "FS::$option_table"->new($href); - - $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->option_objects - ) { - my $error = $opt->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; - -} - -=item option_objects - -Returns all options as FS::I<tablename>_option objects. - -=cut - -sub option_objects { - my $self = shift; - my $pkey = $self->pkey; - my $option_table = $self->option_table; - qsearch($option_table, { $pkey => $self->get($pkey) } ); -} - -=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->option_objects; -} - -=item option OPTIONNAME - -Returns the option value for the given name, or the empty string. - -=cut - -sub option { - my $self = shift; - my $pkey = $self->pkey; - my $option_table = $self->option_table; - my $obj = - qsearchs($option_table, { - $pkey => $self->get($pkey), - optionname => shift, - } ); - $obj ? $obj->optionvalue : ''; -} - - -sub pkey { - my $self = shift; - my $pkey = $self->dbdef_table->primary_key; -} - -sub option_table { - my $self = shift; - my $option_table = $self->table . '_option'; - eval "use FS::$option_table"; - die $@ if $@; - $option_table; -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::Record> - -=cut - -1; - diff --git a/FS/FS/part_bill_event.pm b/FS/FS/part_bill_event.pm deleted file mode 100644 index 2aef5bc..0000000 --- a/FS/FS/part_bill_event.pm +++ /dev/null @@ -1,216 +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, DCRD, CHEK, DCHK, LECB, 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 invoice event definition to -the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { '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|ach|lec)|batch_card|send)\(\);\s*$/ - - or $c =~ /^\s*\$cust_bill\->send(_if_newest)?\(\'[\w\-\s]+\'\s*(,\s*(\d+|\[\s*\d+(,\s*\d+)*\s*\])\s*,\s*'[\w\@\.\-\+]*'\s*)?\);\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 $c =~ /^\s*\$cust_main\->suspend_(if|unless)_pkgpart\([\d\,\s]*\);\s*$/ - - or $c =~ /^\s*\$cust_bill\->cust_suspend_if_balance_over\([\d\.\s]*\);\s*$/ - - or do { - #log - return "illegal eventcode: $c"; - }; - - } - - my $error = $self->ut_numbern('eventpart') - || $self->ut_enum('payby', [qw( CARD DCLN DCRD CHEK DCHK LECB 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') - ; - #|| $self->ut_snumber('seconds') - return $error if $error; - - #quelle kludge - if ( $self->plandata =~ /^(agent_)?templatename\s+(.*)$/m ) { - my $name= $2; - - foreach my $file (qw( template - latex latexnotes latexreturnaddress latexfooter - latexsmallfooter - html htmlnotes htmlreturnaddress htmlfooter - )) - { - unless ( $conf->exists("invoice_${file}_$name") ) { - $conf->set( - "invoice_${file}_$name" => - join("\n", $conf->config("invoice_$file") ) - ); - } - } - } - - $self->SUPER::check; -} - -=item templatename - -Returns the alternate invoice template name, if any, or false if there is -no alternate template for this invoice event. - -=cut - -sub templatename { - my $self = shift; - if ( $self->plan =~ /^send_(alternate|agent)$/ - && $self->plandata =~ /^(agent_)?templatename (.*)$/m - ) - { - $2; - } else { - ''; - } -} - - -=back - -=head1 BUGS - -The whole "eventcode" idea is bunk. This should be refactored with subclasses -like part_pkg/ and part_export/ - -=head1 SEE ALSO - -L<FS::cust_bill>, L<FS::cust_bill_event>, L<FS::Record>, 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 dce2d2a..0000000 --- a/FS/FS/part_export.pm +++ /dev/null @@ -1,458 +0,0 @@ -package FS::part_export; - -use strict; -use vars qw( @ISA @EXPORT_OK $DEBUG %exports ); -use Exporter; -use Tie::IxHash; -use FS::Record qw( qsearch qsearchs dbh ); -use FS::option_Common; -use FS::part_svc; -use FS::part_export_option; -use FS::export_svc; - -@ISA = qw( FS::option_Common ); -@EXPORT_OK = qw(export_info); - -$DEBUG = 0; - -=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<hash> 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<FS::part_export_option>). - -=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 $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 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; - - $self->nodomain =~ /^(Y?)$/ or return "Illegal nodomain: ". $self->nodomain; - $self->nodomain($1); - - $self->deprecated(1); #BLAH - - #check exporttype? - - $self->SUPER::check; -} - -#=item part_svc -# -#Returns the service definition (see L<FS::part_svc>) 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 svc_x - -Returns a list of associated FS::svc_* records. - -=cut - -sub svc_x { - my $self = shift; - map { $_->svc_x } $self->cust_svc; -} - -=item cust_svc - -Returns a list of associated FS::cust_svc records. - -=cut - -sub cust_svc { - my $self = shift; - map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) } - grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) } - $self->export_svc; -} - -=item export_svc - -Returns a list of associated FS::export_svc records. - -=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<FS::part_export_option>). - -=cut - -sub part_export_option { - my $self = shift; - $self->option_objects; -} - -=item options - -Returns a list of option names and values suitable for assigning to a hash. - -=item option OPTIONNAME - -Returns the option value for the given name, or the empty string. - -=item _rebless - -Reblesses the object into the FS::part_export::EXPORTTYPE class, where -EXPORTTYPE is the object's I<exporttype> field. There should be better docs -on how to create new exports, but until then, see L</NEW EXPORT CLASSES>. - -=cut - -sub _rebless { - my $self = shift; - my $exporttype = $self->exporttype; - my $class = ref($self). "::$exporttype"; - eval "use $class;"; - #die $@ if $@; - bless($self, $class) unless $@; - $self; -} - -#these should probably all go away, just let the subclasses define em - -=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; -} - -#call svcdb-specific fallbacks - -sub _export_suspend { - my $self = shift; - #warn "warning: _export_suspened unimplemented for". ref($self); - my $svc_x = shift; - my $new = $svc_x->clone_suspended; - $self->_export_replace( $new, $svc_x ); -} - -sub _export_unsuspend { - my $self = shift; - #warn "warning: _export_unsuspend unimplemented for ". ref($self); - my $svc_x = shift; - my $old = $svc_x->clone_kludge_unsuspend; - $self->_export_replace( $svc_x, $old ); -} - -=back - -=head1 SUBROUTINES - -=over 4 - -=item export_info [ SVCDB ] - -Returns a hash reference of the exports for the given I<svcdb>, or if no -I<svcdb> is specified, for all exports. The keys of the hash are -I<exporttype>s 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<svcdb> for an I<exporttype>. -# -#=cut -# -#sub exporttype2svcdb { -# my $exporttype = $_[0]; -# foreach my $svcdb ( keys %exports ) { -# return $svcdb if grep { $exporttype eq $_ } keys %{$exports{$svcdb}}; -# } -# ''; -#} - -foreach my $INC ( @INC ) { - foreach my $file ( glob("$INC/FS/part_export/*.pm") ) { - warn "attempting to load export info from $file\n" if $DEBUG; - $file =~ /\/(\w+)\.pm$/ or do { - warn "unrecognized file in $INC/FS/part_export/: $file\n"; - next; - }; - my $mod = $1; - my $info = eval "use FS::part_export::$mod; ". - "\\%FS::part_export::$mod\::info;"; - if ( $@ ) { - die "error using FS::part_export::$mod (skipping): $@\n" if $@; - next; - } - unless ( keys %$info ) { - warn "no %info hash found in FS::part_export::$mod, skipping\n" - unless $mod =~ /^(passwdfile|null)$/; #hack but what the heck - next; - } - warn "got export info from FS::part_export::$mod: $info\n" if $DEBUG; - no strict 'refs'; - foreach my $svc ( - ref($info->{'svc'}) ? @{$info->{'svc'}} : $info->{'svc'} - ) { - unless ( $svc ) { - warn "blank svc for FS::part_export::$mod (skipping)\n"; - next; - } - $exports{$svc}->{$mod} = $info; - } - } -} - -=back - -=head1 NEW EXPORT CLASSES - -A module should be added in FS/FS/part_export/ (an example may be found in -eg/export_template.pm) - -=head1 BUGS - -Hmm... cust_export class (not necessarily a database table...) ... ? - -deprecated column... - -=head1 SEE ALSO - -L<FS::part_export_option>, L<FS::export_svc>, L<FS::svc_acct>, -L<FS::svc_domain>, -L<FS::svc_forward>, L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/part_export/acct_sql.pm b/FS/FS/part_export/acct_sql.pm deleted file mode 100644 index 4b92e80..0000000 --- a/FS/FS/part_export/acct_sql.pm +++ /dev/null @@ -1,271 +0,0 @@ -package FS::part_export::acct_sql; - -use vars qw(@ISA %info); -use Tie::IxHash; -#use Digest::MD5 qw(md5_hex); -use FS::Record; #qw(qsearchs); -use FS::part_export; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'datasrc' => { label => 'DBI data source' }, - 'username' => { label => 'Database username' }, - 'password' => { label => 'Database password' }, - 'table' => { label => 'Database table' }, - 'schema' => { label => - 'Database schema mapping to Freeside methods.', - type => 'textarea', - }, - 'primary_key' => { label => 'Database primary key' }, - 'crypt' => { label => 'Password encryption', - type=>'select', options=>[qw(crypt md5)], - default=>'crypt', - }, -; - -tie my %vpopmail_map, 'Tie::IxHash', - 'pw_name' => 'username', - 'pw_domain' => 'domain', - 'pw_passwd' => 'crypt_password', - 'pw_uid' => 'uid', - 'pw_gid' => 'gid', - 'pw_gecos' => 'finger', - 'pw_dir' => 'dir', - #'pw_shell' => 'shell', - 'pw_shell' => 'quota', -; -my $vpopmail_map = join('\n', map "$_ $vpopmail_map{$_}", keys %vpopmail_map ); - -tie my %postfix_courierimap_mailbox_map, 'Tie::IxHash', - 'username' => 'email', - 'password' => '_password', - 'crypt' => 'crypt_password', - 'name' => 'finger', - 'maildir' => 'virtual_maildir', - 'domain' => 'domain', - 'svcnum' => 'svcnum', -; -my $postfix_courierimap_mailbox_map = - join('\n', map "$_ $postfix_courierimap_mailbox_map{$_}", - keys %postfix_courierimap_mailbox_map ); - -tie my %postfix_courierimap_alias_map, 'Tie::IxHash', - 'address' => 'email', - 'goto' => 'email', - 'domain' => 'domain', - 'svcnum' => 'svcnum', -; -my $postfix_courierimap_alias_map = - join('\n', map "$_ $postfix_courierimap_alias_map{$_}", - keys %postfix_courierimap_alias_map ); - -%info = ( - 'svc' => 'svc_acct', - 'desc' => 'Real-time export of accounts to SQL databases '. - '(vpopmail, Postfix+Courier IMAP, others?)', - 'options' => \%options, - 'nodomain' => '', - 'notes' => <<END -Export accounts (svc_acct records) to SQL databases. Currently has default -configurations for vpopmail and Postfix+Courier IMAP but intended to be -configurable for other schemas as well. - -<BR><BR>In contrast to sqlmail, this is intended to export just svc_acct -records only, rather than a single export for svc_acct, svc_forward and -svc_domain records, to export in "default" database schemas rather than -configure the MTA or POP/IMAP server for a Freeside-specific schema, and -to be configured for different mail server setups. - -<BR><BR>Use these buttons for some useful presets: -<UL> - <li><INPUT TYPE="button" VALUE="vpopmail" onClick=' - this.form.table.value = "vpopmail"; - this.form.schema.value = "$vpopmail_map"; - this.form.primary_key.value = "pw_name, pw_domain"; - '> - <LI><INPUT TYPE="button" VALUE="postfix_courierimap_mailbox" onClick=' - this.form.table.value = "mailbox"; - this.form.schema.value = "$postfix_courierimap_mailbox_map"; - this.form.primary_key.value = "username"; - '> - <LI><INPUT TYPE="button" VALUE="postfix_courierimap_alias" onClick=' - this.form.table.value = "alias"; - this.form.schema.value = "$postfix_courierimap_alias_map"; - this.form.primary_key.value = "address"; - '> -</UL> -END -); - -sub _map { - my $self = shift; - map { /^\s*(\S+)\s*(\S+)\s*$/ } split("\n", $self->option('schema') ); -} - -sub rebless { shift; } - -sub _export_insert { - my($self, $svc_acct) = (shift, shift); - - my %map = $self->_map; - - my %record = map { my $value = $map{$_}; - my @arg = (); - push @arg, $self->option('crypt') - if $value eq 'crypt_password' && $self->option('crypt'); - $_ => $svc_acct->$value(@arg); - } keys %map; - - my $err_or_queue = - $self->acct_sql_queue( - $svc_acct->svcnum, - 'insert', - $self->option('table'), - %record - ); - return $err_or_queue unless ref($err_or_queue); - - ''; - -} - -sub _export_replace { - my($self, $new, $old) = (shift, shift, shift); - - my %map = $self->_map; - - my @primary_key = (); - if ( $self->option('primary_key') =~ /,/ ) { - foreach my $key ( split(/\s*,\s*/, $self->option('primary_key') ) ) { - my $keymap = $map{$key}; - push @primary_key, $old->$keymap(); - } - } else { - my $keymap = $map{$self->option('primary_key')}; - push @primary_key, $old->$keymap(); - } - - my %record = map { my $value = $map{$_}; - my @arg = (); - push @arg, $self->option('crypt') - if $value eq 'crypt_password' && $self->option('crypt'); - $_ => $new->$value(@arg); - } keys %map; - - my $err_or_queue = $self->acct_sql_queue( - $new->svcnum, - 'replace', - $self->option('table'), - $self->option('primary_key'), @primary_key, - %record, - ); - return $err_or_queue unless ref($err_or_queue); - ''; -} - -sub _export_delete { - my ( $self, $svc_acct ) = (shift, shift); - - my %map = $self->_map; - - my %primary_key = (); - if ( $self->option('primary_key') =~ /,/ ) { - foreach my $key ( split(/\s*,\s*/, $self->option('primary_key') ) ) { - my $keymap = $map{$key}; - $primary_key{ $key } = $svc_acct->$keymap(); - } - } else { - my $keymap = $map{$self->option('primary_key')}; - $primary_key{ $self->option('primary_key') } = $svc_acct->$keymap(), - } - - my $err_or_queue = $self->acct_sql_queue( - $svc_acct->svcnum, - 'delete', - $self->option('table'), - %primary_key, - #$self->option('primary_key') => $svc_acct->$keymap(), - ); - return $err_or_queue unless ref($err_or_queue); - ''; -} - -sub acct_sql_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::acct_sql::acct_sql_$method", - }; - $queue->insert( - $self->option('datasrc'), - $self->option('username'), - $self->option('password'), - @_, - ) or $queue; -} - -sub acct_sql_insert { #subroutine, not method - my $dbh = acct_sql_connect(shift, shift, shift); - my( $table, %record ) = @_; - - my $sth = $dbh->prepare( - "INSERT INTO $table ( ". join(", ", keys %record). - " ) VALUES ( ". join(", ", map '?', keys %record ). " )" - ) or die $dbh->errstr; - - $sth->execute( values(%record) ) - or die "can't insert into $table table: ". $sth->errstr; - - $dbh->disconnect; -} - -sub acct_sql_delete { #subroutine, not method - my $dbh = acct_sql_connect(shift, shift, shift); - my( $table, %record ) = @_; - - my $sth = $dbh->prepare( - "DELETE FROM $table WHERE ". join(' AND ', map "$_ = ? ", keys %record ) - ) or die $dbh->errstr; - - $sth->execute( map $record{$_}, keys %record ) - or die "can't delete from $table table: ". $sth->errstr; - - $dbh->disconnect; -} - -sub acct_sql_replace { #subroutine, not method - my $dbh = acct_sql_connect(shift, shift, shift); - - my( $table, $pkey ) = ( shift, shift ); - - my %primary_key = (); - if ( $pkey =~ /,/ ) { - foreach my $key ( split(/\s*,\s*/, $pkey ) ) { - $primary_key{$key} = shift; - } - } else { - $primary_key{$pkey} = shift; - } - - my %record = @_; - - my $sth = $dbh->prepare( - "UPDATE $table". - ' SET '. join(', ', map "$_ = ?", keys %record ). - ' WHERE '. join(' AND ', map "$_ = ?", keys %primary_key ) - ) or die $dbh->errstr; - - $sth->execute( values(%record), values(%primary_key) ); - - $dbh->disconnect; -} - -sub acct_sql_connect { - #my($datasrc, $username, $password) = @_; - #DBI->connect($datasrc, $username, $password) or die $DBI::errstr; - DBI->connect(@_) or die $DBI::errstr; -} - -1; - diff --git a/FS/FS/part_export/apache.pm b/FS/FS/part_export/apache.pm deleted file mode 100644 index 35b00cc..0000000 --- a/FS/FS/part_export/apache.pm +++ /dev/null @@ -1,47 +0,0 @@ -package FS::part_export::apache; - -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::part_export::null; - -@ISA = qw(FS::part_export::null); - -tie my %options, 'Tie::IxHash', - 'user' => { label=>'Remote username', default=>'root' }, - 'httpd_conf' => { label=>'httpd.conf snippet location', - default=>'/etc/apache/httpd-freeside.conf', }, - 'restart' => { label=>'Apache restart command', - default=>'apachectl graceful', - }, - 'template' => { - label => 'Template', - type => 'textarea', - default => <<'END', -<VirtualHost $domain> #generic -#<VirtualHost ip.addr> #preferred, http://httpd.apache.org/docs/dns-caveats.html -DocumentRoot /var/www/$zone -ServerName $zone -ServerAlias *.$zone -#BandWidthModule On -#LargeFileLimit 4096 12288 -#FrontpageEnable on -</VirtualHost> - -END - }, -; - -%info = ( - 'svc' => 'svc_www', - 'desc' => 'Export an Apache httpd.conf file snippet.', - 'options' => \%options, - 'notes' => <<'END' -Batch export of an httpd.conf snippet from a template. Typically used with -something like <code>Include /etc/apache/httpd-freeside.conf</code> in -httpd.conf. <a href="http://search.cpan.org/dist/File-Rsync">File::Rsync</a> -must be installed. Run bin/apache.export to export the files. -END -); - -1; - diff --git a/FS/FS/part_export/artera_turbo.pm b/FS/FS/part_export/artera_turbo.pm deleted file mode 100644 index c006db9..0000000 --- a/FS/FS/part_export/artera_turbo.pm +++ /dev/null @@ -1,181 +0,0 @@ -package FS::part_export::artera_turbo; - -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::Record qw(qsearch); -use FS::part_export; -use FS::cust_svc; -use FS::svc_external; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'rid' => { 'label' => 'Reseller ID (RID)' }, - 'username' => { 'label' => 'Reseller username', }, - 'password' => { 'label' => 'Reseller password', }, - 'pid' => { 'label' => 'Artera Product ID', }, - 'priceid' => { 'label' => 'Artera Price ID', }, - 'agent_aid' => { 'label' => 'Export agentnum values to Artera AID', - 'type' => 'checkbox', - }, - 'aid' => { 'label' => 'Artera Agent ID to use if not using agentnum values', }, - 'production' => { 'label' => 'Production mode (leave unchecked for staging)', - 'type' => 'checkbox', - }, - 'debug' => { 'label' => 'Enable debug logging', - 'type' => 'checkbox', - }, - 'enable_edit' => { 'label' => 'Enable local editing of Artera serial numbers and key codes (note that the changes will NOT be exported to Artera)', - 'type' => 'checkbox', - }, -; - -%info = ( - 'svc' => 'svc_external', - #'svc' => [qw( svc_acct svc_forward )], - 'desc' => - 'Real-time export to Artera Turbo Reseller API', - 'options' => \%options, - #'nodomain' => 'Y', - 'notes' => <<'END' -Real-time export to <a href="http://www.arteraturbo.com/">Artera Turbo</a> -Reseller API. Requires installation of -<a href="http://search.cpan.org/dist/Net-Artera">Net::Artera</a> -from CPAN. You probably also want to: -<UL> - <LI>In the configuration UI section: set the <B>svc_external-skip_manual</B> and <B>svc_external-display_type</B> configuration values. - <LI>In the message catalog: set <B>svc_external-id</B> to <I>Artera Serial Number</I> and set <B>svc_external-title</B> to <I>Artera Key Code</I>. -</UL> -END -); - -sub rebless { shift; } - -sub _new_Artera { - my $self = shift; - - my $artera = new Net::Artera ( - map { $_ => $self->option($_) } - qw( rid username password production ) - ); -} - - -sub _export_insert { - my($self, $svc_external) = (shift, shift); - - # want the ASN (serial) and AKC (key code) right away - - eval "use Net::Artera;"; - return $@ if $@; - $Net::Artera::DEBUG = 1 if $self->option('debug'); - my $artera = $self->_new_Artera; - - my $cust_pkg = $svc_external->cust_svc->cust_pkg; - my $part_pkg = $cust_pkg->part_pkg; - my @svc_acct = grep { $_->table eq 'svc_acct' } - map { $_->svc_x } - sort { my $svcpart = $part_pkg->svcpart('svc_acct'); - ($b->svcpart==$svcpart) cmp ($a->svcpart==$svcpart); } - qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } ); - my $email = scalar(@svc_acct) ? $svc_acct[0]->email : ''; - - my $cust_main = $cust_pkg->cust_main; - - my $result = $artera->newOrder( - 'pid' => $self->option('pid'), - 'priceid' => $self->option('priceid'), - 'email' => $email, - 'cname' => $cust_main->name, - 'ref' => $svc_external->svcnum, - 'aid' => ( $self->option('agent_aid') - ? $cust_main->agentnum - : $self->option('aid') ), - 'add1' => $cust_main->address1, - 'add2' => $cust_main->address2, - 'add3' => $cust_main->city, - 'add4' => $cust_main->state, - 'zip' => $cust_main->zip, - 'cid' => $cust_main->country, - 'phone' => $cust_main->daytime || $cust_main->night, - 'fax' => $cust_main->fax, - ); - - if ( $result->{'id'} == 1 ) { - my $new = new FS::svc_external { $svc_external->hash }; - $new->id(sprintf('%010d', $result->{'ASN'})); - $new->title( substr('0000000000'.uc($result->{'AKC'}), -10) ); - $new->replace($svc_external); - } else { - $result->{'message'} || 'No response from Artera'; - } -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - return '' if $self->option('enable_edit'); - return "can't change serial number with Artera" - if $old->id != $new->id && $old->id; - return "can't change key code with Artera" - if $old->title ne $new->title && $old->title; - ''; -} - -sub _export_delete { - my( $self, $svc_external ) = (shift, shift); - $self->queue_statusChange(17, $svc_external); -} - -sub _export_suspend { - my( $self, $svc_external ) = (shift, shift); - $self->queue_statusChange(16, $svc_external); -} - -sub _export_unsuspend { - my( $self, $svc_external ) = (shift, shift); - $self->queue_statusChange(15, $svc_external); -} - -sub queue_statusChange { - my( $self, $status, $svc_external ) = @_; - - my $queue = new FS::queue { - 'svcnum' => $svc_external->svcnum, - 'job' => 'FS::part_export::artera_turbo::statusChange', - }; - $queue->insert( - ( map { $self->option($_) } - qw( rid username password production ) ), - $status, - $svc_external->id, - $svc_external->title, - $self->option('debug'), - ); -} - -sub statusChange { - my( $rid, $username, $password, $prod, $status, $id, $title, $debug ) = @_; - - eval "use Net::Artera;"; - return $@ if $@; - $Net::Artera::DEBUG = 1 if $debug; - - my $artera = new Net::Artera ( - 'rid' => $rid, - 'username' => $username, - 'password' => $password, - 'production' => $prod, - ); - - my $result = $artera->statusChange( - 'asn' => sprintf('%010d', $id), - 'akc' => substr("0000000000$title", -10), - 'statusid' => $status, - ); - - die $result->{'message'} unless $result->{'id'} == 1; - -} - -1; - diff --git a/FS/FS/part_export/bind.pm b/FS/FS/part_export/bind.pm deleted file mode 100644 index 1ef7b65..0000000 --- a/FS/FS/part_export/bind.pm +++ /dev/null @@ -1,35 +0,0 @@ -package FS::part_export::bind; - -use vars qw(@ISA %info %options); -use Tie::IxHash; -use FS::part_export::null; - -@ISA = qw(FS::part_export::null); - -tie %options, 'Tie::IxHash', - 'named_conf' => { label => 'named.conf location', - default=> '/etc/bind/named.conf' }, - 'zonepath' => { label => 'path to zone files', - default=> '/etc/bind/', }, - 'bind_release' => { label => 'ISC BIND Release', - type => 'select', - options => [qw(BIND8 BIND9)], - default => 'BIND8' }, - 'bind9_minttl' => { label => 'The minttl required by bind9 and RFC1035.', - default => '1D' }, - 'reload' => { label => 'Optional reload command. If not specified, defaults to "ndc" under BIND8 and "rndc" under BIND9.', }, -; - -%info = ( - 'svc' => 'svc_domain', - 'desc' => 'Batch export to BIND named', - 'options' => \%options, - 'notes' => <<'END' -Batch export of BIND zone and configuration files to a primary nameserver. -<a href="http://search.cpan.org/search?dist=File-Rsync">File::Rsync</a> -must be installed. Run bin/bind.export to export the files. -END -); - -1; - diff --git a/FS/FS/part_export/bind_slave.pm b/FS/FS/part_export/bind_slave.pm deleted file mode 100644 index c89325f..0000000 --- a/FS/FS/part_export/bind_slave.pm +++ /dev/null @@ -1,28 +0,0 @@ -package FS::part_export::bind_slave; - -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::part_export::null; - -@ISA = qw(FS::part_export::null); - -tie my %options, 'Tie::IxHash', - 'master' => { label=> 'Master IP address(s) (semicolon-separated)' }, - %FS::part_export::bind::options, -; -delete $options{'zonepath'}; - -%info = ( - 'svc' => 'svc_domain', - 'desc' =>'Batch export to slave BIND named', - 'options' => \%options, - 'notes' => <<'END' -Batch export of BIND configuration file to a secondary nameserver. Zones are -slaved from the listed masters. -<a href="http://search.cpan.org/dist/File-Rsync">File::Rsync</a> -must be installed. Run bin/bind.export to export the files. -END -); - -1; - diff --git a/FS/FS/part_export/bsdshell.pm b/FS/FS/part_export/bsdshell.pm deleted file mode 100644 index 7b5feb2..0000000 --- a/FS/FS/part_export/bsdshell.pm +++ /dev/null @@ -1,25 +0,0 @@ -package FS::part_export::bsdshell; - -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::part_export::passwdfile; - -@ISA = qw(FS::part_export::passwdfile); - -tie my %options, 'Tie::IxHash', %FS::part_export::passwdfile::options; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => - 'Batch export of /etc/passwd and /etc/master.passwd files (BSD)', - 'options' => \%options, - 'nodomain' => 'Y', - 'notes' => <<'END' -MD5 crypt requires installation of -<a href="http://search.cpan.org/dist/Crypt-PasswdMD5">Crypt::PasswdMD5</a> -from CPAN. Run bin/bsdshell.export to export the files. -END -); - -1; - diff --git a/FS/FS/part_export/communigate_pro.pm b/FS/FS/part_export/communigate_pro.pm deleted file mode 100644 index 6da2017..0000000 --- a/FS/FS/part_export/communigate_pro.pm +++ /dev/null @@ -1,178 +0,0 @@ -package FS::part_export::communigate_pro; - -use vars qw(@ISA %info %options); -use Tie::IxHash; -use FS::part_export; -use FS::queue; - -@ISA = qw(FS::part_export); - -tie %options, 'Tie::IxHash', - 'port' => { label=>'Port number', default=>'106', }, - 'login' => { label=>'The administrator account name. The name can contain a domain part.', }, - 'password' => { label=>'The administrator account password.', }, - 'accountType' => { label=>'Type for newly-created accounts', - type=>'select', - options=>[qw( MultiMailbox TextMailbox MailDirMailbox )], - default=>'MultiMailbox', - }, - 'externalFlag' => { label=> 'Create accounts with an external (visible for legacy mailers) INBOX.', - type=>'checkbox', - }, - 'AccessModes' => { label=>'Access modes', - default=>'Mail POP IMAP PWD WebMail WebSite', - }, -; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => 'Real-time export to a CommuniGate Pro mail server', - 'options' => \%options, - 'notes' => <<'END' -Real time export to a -<a href="http://www.stalker.com/CommuniGatePro/">CommuniGate Pro</a> -mail server. The -<a href="http://www.stalker.com/CGPerl/">CommuniGate Pro Perl Interface</a> -must be installed as CGP::CLI. -END -); - -sub rebless { shift; } - -sub export_username { - my($self, $svc_acct) = (shift, shift); - $svc_acct->email; -} - -sub _export_insert { - my( $self, $svc_acct ) = (shift, shift); - my @options = ( $svc_acct->svcnum, 'CreateAccount', - 'accountName' => $self->export_username($svc_acct), - 'accountType' => $self->option('accountType'), - 'AccessModes' => $self->option('AccessModes'), - 'RealName' => $svc_acct->finger, - 'Password' => $svc_acct->_password, - ); - push @options, 'MaxAccountSize' => $svc_acct->quota if $svc_acct->quota; - push @options, 'externalFlag' => $self->option('externalFlag') - if $self->option('externalFlag'); - - $self->communigate_pro_queue( @options ); -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - return "can't (yet) change username with CommuniGate Pro" - if $old->username ne $new->username; - return "can't (yet) change domain with CommuniGate Pro" - if $self->export_username($old) ne $self->export_username($new); - return "can't (yet) change GECOS with CommuniGate Pro" - if $old->finger ne $new->finger; - return "can't (yet) change quota with CommuniGate Pro" - if $old->quota ne $new->quota; - return '' unless $old->username ne $new->username - || $old->_password ne $new->_password - || $old->finger ne $new->finger - || $old->quota ne $new->quota; - - return '' if '*SUSPENDED* '. $old->_password eq $new->_password; - - #my $err_or_queue = $self->communigate_pro_queue( $new->svcnum,'RenameAccount', - # $old->email, $new->email ); - #return $err_or_queue unless ref($err_or_queue); - #my $jobnum = $err_or_queue->jobnum; - - $self->communigate_pro_queue( $new->svcnum, 'SetAccountPassword', - $self->export_username($new), $new->_password ) - if $new->_password ne $old->_password; - -} - -sub _export_delete { - my( $self, $svc_acct ) = (shift, shift); - $self->communigate_pro_queue( $svc_acct->svcnum, 'DeleteAccount', - $self->export_username($svc_acct), - ); -} - -sub _export_suspend { - my( $self, $svc_acct ) = (shift, shift); - $self->communigate_pro_queue( $svc_acct->svcnum, 'UpdateAccountSettings', - 'accountName' => $self->export_username($svc_acct), - 'AccessModes' => 'Mail', - ); -} - -sub _export_unsuspend { - my( $self, $svc_acct ) = (shift, shift); - $self->communigate_pro_queue( $svc_acct->svcnum, 'UpdateAccountSettings', - 'accountName' => $self->export_username($svc_acct), - 'AccessModes' => $self->option('AccessModes'), - ); -} - -sub communigate_pro_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my @kludge_methods = qw(CreateAccount UpdateAccountSettings); - my $sub = 'communigate_pro_command'; - $sub = $method if grep { $method eq $_ } @kludge_methods; - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::communigate_pro::$sub", - }; - $queue->insert( - $self->machine, - $self->option('port'), - $self->option('login'), - $self->option('password'), - $method, - @_, - ); - -} - -sub CreateAccount { - my( $machine, $port, $login, $password, $method, %args ) = @_; - my $accountName = delete $args{'accountName'}; - my $accountType = delete $args{'accountType'}; - my $externalFlag = delete $args{'externalFlag'}; - $args{'AccessModes'} = [ split(' ', $args{'AccessModes'}) ]; - my @args = ( accountName => $accountName, - accountType => $accountType, - settings => \%args, - ); - #externalFlag => $externalFlag, - push @args, externalFlag => $externalFlag if $externalFlag; - - communigate_pro_command( $machine, $port, $login, $password, $method, @args ); - -} - -sub UpdateAccountSettings { - my( $machine, $port, $login, $password, $method, %args ) = @_; - my $accountName = delete $args{'accountName'}; - $args{'AccessModes'} = [ split(' ', $args{'AccessModes'}) ]; - @args = ( $accountName, \%args ); - communigate_pro_command( $machine, $port, $login, $password, $method, @args ); -} - -sub communigate_pro_command { #subroutine, not method - my( $machine, $port, $login, $password, $method, @args ) = @_; - - eval "use CGP::CLI"; - - my $cli = new CGP::CLI( { - 'PeerAddr' => $machine, - 'PeerPort' => $port, - 'login' => $login, - 'password' => $password, - } ) or die "Can't login to CGPro: $CGP::ERR_STRING\n"; - - $cli->$method(@args) or die "CGPro error: ". $cli->getErrMessage; - - $cli->Logout or die "Can't logout of CGPro: $CGP::ERR_STRING\n"; - -} - -1; - diff --git a/FS/FS/part_export/communigate_pro_singledomain.pm b/FS/FS/part_export/communigate_pro_singledomain.pm deleted file mode 100644 index e25043f..0000000 --- a/FS/FS/part_export/communigate_pro_singledomain.pm +++ /dev/null @@ -1,37 +0,0 @@ -package FS::part_export::communigate_pro_singledomain; - -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::part_export::communigate_pro; - -@ISA = qw(FS::part_export::communigate_pro); - -tie my %options, 'Tie::IxHash', %FS::part_export::communigate_pro::options, - 'domain' => { label=>'Domain', }, -; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => - 'Real-time export to a CommuniGate Pro mail server, one domain only', - 'options' => \%options, - 'nodomain' => 'Y', - 'notes' => <<'END' -Real time export to a -<a href="http://www.stalker.com/CommuniGatePro/">CommuniGate Pro</a> -mail server. This is an unusual export to CommuniGate Pro that forces all -accounts into a single domain. As CommuniGate Pro supports multiple domains, -unless you have a specific reason for using this export, you probably want to -use the communigate_pro export instead. The -<a href="http://www.stalker.com/CGPerl/">CommuniGate Pro Perl Interface</a> -must be installed as CGP::CLI. -END -); - -sub export_username { - my($self, $svc_acct) = (shift, shift); - $svc_acct->username. '@'. $self->option('domain'); -} - -1; - diff --git a/FS/FS/part_export/cp.pm b/FS/FS/part_export/cp.pm deleted file mode 100644 index 96fa437..0000000 --- a/FS/FS/part_export/cp.pm +++ /dev/null @@ -1,161 +0,0 @@ -package FS::part_export::cp; - -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::part_export; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'port' => { label=>'Port number' }, - 'username' => { label=>'Username' }, - 'password' => { label=>'Password' }, - 'domain' => { label=>'Domain' }, - 'workgroup' => { label=>'Default Workgroup' }, -; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => 'Real-time export to Critical Path Account Provisioning Protocol', - 'options'=> \%options, - 'notes' => <<'END' -Real-time export to -<a href="http://www.cp.net/">Critial Path Account Provisioning Protocol</a>. -Requires installation of -<a href="http://search.cpan.org/dist/Net-APP">Net::APP</a> -from CPAN. -END -); - -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 "can't change username with Critical Path" #CP no longer supports this - if $old->username ne $new->username; - return '' unless $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 _export_suspend { - my( $self, $svc_acct ) = (shift, shift); - $self->cp_queue( $svc_acct->svcnum, 'set_mailbox_status', - 'Mailbox' => $svc_acct->username, - 'Domain' => $svc_acct->domain, - 'OTHER' => 'T', - 'OTHER_SUSPEND' => 'T', - ); -} - -sub _export_unsuspend { - my( $self, $svc_acct ) = (shift, shift); - $self->cp_queue( $svc_acct->svcnum, 'set_mailbox_status', - 'Mailbox' => $svc_acct->username, - 'Domain' => $svc_acct->domain, - 'PAYMENT' => 'F', - 'OTHER' => 'F', - 'OTHER_SUSPEND' => 'F', - 'OTHER_BOUNCE' => 'F', - ); -} - -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->machine, - $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, $login_domain, - # 'set_mailbox_status', - # Domain => $domain, - # Mailbox => $new_username, - # Other => $other, - # Other_Bounce => $other, - #); - - if ( $old_password ne $new_password ) { - cp_command($host, $port, $username, $password, $login_domain, - '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; - -} - -1; - diff --git a/FS/FS/part_export/cpanel.pm b/FS/FS/part_export/cpanel.pm deleted file mode 100644 index 0ad00df..0000000 --- a/FS/FS/part_export/cpanel.pm +++ /dev/null @@ -1,192 +0,0 @@ -package FS::part_export::cpanel; - -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::part_export; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'user' => { label=>'Remote access username' }, - 'accesshash' => { label=>'Remote access key', type=>'textarea' }, - 'debug' => { label=>'Enable debugging', type=>'checkbox' }, -; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => 'Real-time export to Cpanel control panel.', - 'options' => \%options, - 'nodomain' => 'Y', - 'notes' => 'Real time export to a the <a href="http://www.cpanel.net/">Cpanel</a> control panel software. Service definition names are exported as Cpanel packages. Requires installation of the Cpanel::Accounting perl module distributed with Cpanel.', -); - -sub rebless { shift; } - -sub _export_insert { - my($self, $svc_acct) = (shift, shift); - $err_or_queue = $self->cpanel_queue( $svc_acct->svcnum, 'insert', - $svc_acct->domain, - $svc_acct->username, - $svc_acct->_password, - $svc_acct->cust_svc->part_svc->svc, - ); - ref($err_or_queue) ? '' : $err_or_queue; -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - return "can't change username with cpanel" - if $old->username ne $new->username; - return "can't change password with cpanel" - if $old->_passsword ne $new->_password; - return "can't change domain with cpanel" - if $old->domain ne $new->domain; - - ''; - - ##return '' unless $old->_password ne $new->_password; - #$err_or_queue = $self->cpanel_queue( $new->svcnum, - # 'replace', $new->username, $new->_password ); - #ref($err_or_queue) ? '' : $err_or_queue; -} - -sub _export_delete { - my( $self, $svc_acct ) = (shift, shift); - $err_or_queue = $self->cpanel_queue( $svc_acct->svcnum, - 'delete', $svc_acct->username - ); - ref($err_or_queue) ? '' : $err_or_queue; -} - -sub _export_suspend { - my( $self, $svc_acct ) = (shift, shift); - $err_or_queue = $self->cpanel_queue( $svc_acct->svcnum, - 'suspend', $svc_acct->username ); - ref($err_or_queue) ? '' : $err_or_queue; -} - -sub _export_unsuspend { - my( $self, $svc_acct ) = (shift, shift); - $err_or_queue = $self->cpanel_queue( $svc_acct->svcnum, - 'unsuspend', $svc_acct->username ); - ref($err_or_queue) ? '' : $err_or_queue; -} - - -sub cpanel_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::cpanel::cpanel_$method", - }; - $queue->insert( - $self->machine, - $self->option('user'), - $self->option('accesshash'), - $self->option('debug'), - @_ - ) or $queue; -} - - -sub cpanel_insert { #subroutine, not method - my( $machine, $user, $accesshash, $debug ) = splice(@_,0,4); - -# my $whm = cpanel_connect($machine, $user, $accesshash, $debug); -# warn " cpanel->createacct ". join(', ', @_). "\n" -# if $debug; -# my $response = $whm->createacct(@_); -# die $whm->{'error'} if $whm->{'error'}; -# warn " cpanel response: $response\n" -# if $debug; - - warn "cpanel_insert: attempting web interface to add POP" - if $debug; - - my($domain, $username, $password, $svc) = @_; - - use LWP::UserAgent; - use HTTP::Request::Common qw(POST); - - my $url = - "http://$user:$accesshash\@$domain:2082/frontend/x/mail/addpop2.html"; - - my $ua = LWP::UserAgent->new(); - - #$req->authorization_basic($user, $accesshash); - - my $res = $ua->request( - POST( $url, - [ - 'email' => $username, - 'domain' => $domain, - 'password' => $password, - 'quota' => 10, #? - ] - ) - ); - - die "Error submitting data to $url: ". $res->status_line - unless $res->is_success; - - die "Username in use" - if $res->content =~ /exists/; - - die "Account not created: ". $res->content - if $res->content =~ /failure/; - -} - -#sub cpanel_replace { #subroutine, not method -#} - -sub cpanel_delete { #subroutine, not method - my( $machine, $user, $accesshash, $debug ) = splice(@_,0,4); - my $whm = cpanel_connect($machine, $user, $accesshash, $debug); - warn " cpanel->killacct ". join(', ', @_). "\n" - if $debug; - my $response = $whm->killacct(shift); - die $whm->{'error'} if $whm->{'error'}; - warn " cpanel response: $response\n" - if $debug; -} - -sub cpanel_suspend { #subroutine, not method - my( $machine, $user, $accesshash, $debug ) = splice(@_,0,4); - my $whm = cpanel_connect($machine, $user, $accesshash, $debug); - warn " cpanel->suspend ". join(', ', @_). "\n" - if $debug; - my $response = $whm->suspend(shift); - die $whm->{'error'} if $whm->{'error'}; - warn " cpanel response: $response\n" - if $debug; -} - -sub cpanel_unsuspend { #subroutine, not method - my( $machine, $user, $accesshash, $debug ) = splice(@_,0,4); - my $whm = cpanel_connect($machine, $user, $accesshash, $debug); - warn " cpanel->unsuspend ". join(', ', @_). "\n" - if $debug; - my $response = $whm->unsuspend(shift); - die $whm->{'error'} if $whm->{'error'}; - warn " cpanel response: $response\n" - if $debug; -} - -sub cpanel_connect { - my( $host, $user, $accesshash, $debug ) = @_; - - eval "use Cpanel::Accounting;"; - die $@ if $@; - - warn "creating new Cpanel::Accounting connection to $user@$host\n" - if $debug; - - my $whm = new Cpanel::Accounting; - $whm->{'host'} = $host; - $whm->{'user'} = $user; - $whm->{'accesshash'} = $accesshash; - $whm->{'usessl'} = 1; - - $whm; -} diff --git a/FS/FS/part_export/cyrus.pm b/FS/FS/part_export/cyrus.pm deleted file mode 100644 index 84c9e5a..0000000 --- a/FS/FS/part_export/cyrus.pm +++ /dev/null @@ -1,120 +0,0 @@ -package FS::part_export::cyrus; - -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::part_export; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'server' => { label=>'IMAP server' }, - 'username' => { label=>'Admin username' }, - 'password' => { label=>'Admin password' }, -; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => 'Real-time export to Cyrus IMAP server', - 'options' => \%options, - 'nodomain' => 'Y', - 'notes' => <<'END' -Integration with -<a href="http://asg.web.cmu.edu/cyrus/imapd/">Cyrus IMAP Server</a>. -Cyrus::IMAP::Admin should be installed locally and the connection to the -server secured. <B>svc_acct.quota</B>, if available, is used to set the -Cyrus quota. -END -); - -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 -#} - -1; - diff --git a/FS/FS/part_export/domain_shellcommands.pm b/FS/FS/part_export/domain_shellcommands.pm deleted file mode 100644 index 994c113..0000000 --- a/FS/FS/part_export/domain_shellcommands.pm +++ /dev/null @@ -1,165 +0,0 @@ -package FS::part_export::domain_shellcommands; - -use strict; -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::part_export; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'user' => { label=>'Remote username', default=>'root' }, - 'useradd' => { label=>'Insert command', - default=>'', - }, - 'userdel' => { label=>'Delete command', - default=>'', - }, - 'usermod' => { label=>'Modify command', - default=>'', - }, -; - -%info = ( - 'svc' => 'svc_domain', - 'desc' => 'Run remote commands via SSH, for domains (qmail, ISPMan).', - 'options' => \%options, - 'notes' => <<'END' -Run remote commands via SSH, for domains. You will need to -<a href="../docs/ssh.html">setup SSH for unattended operation</a>. -<BR><BR>Use these buttons for some useful presets: -<UL> - <LI> - <INPUT TYPE="button" VALUE="qmail catchall .qmail-domain-default maintenance" onClick=' - this.form.useradd.value = "[ \"$uid\" -a \"$gid\" -a \"$dir\" -a \"$qdomain\" ] && [ -e $dir/.qmail-$qdomain-default ] || { touch $dir/.qmail-$qdomain-default; chown $uid:$gid $dir/.qmail-$qdomain-default; }"; - this.form.userdel.value = ""; - this.form.usermod.value = ""; - '> - <LI> - <INPUT TYPE="button" VALUE="ISPMan CLI" onClick=' - this.form.useradd.value = "/usr/local/ispman/bin/ispman.addDomain -d $domain changeme"; - this.form.userdel.value = "/usr/local/ispman/bin/ispman.deleteDomain -d $domain"; - this.form.usermod.value = ""; - '> -</UL> -The following variables are available for interpolation (prefixed with <code>new_</code> or <code>old_</code> for replace operations): -<UL> - <LI><code>$domain</code> - <LI><code>$qdomain</code> - domain with periods replaced by colons - <LI><code>$uid</code> - of catchall account - <LI><code>$gid</code> - of catchall account - <LI><code>$dir</code> - home directory of catchall account - <LI>All other fields in - <a href="../docs/schema.html#svc_domain">svc_domain</a> are also available. -</UL> -END -); - -sub rebless { shift; } - -sub _export_insert { - my($self) = shift; - $self->_export_command('useradd', @_); -} - -sub _export_delete { - my($self) = shift; - $self->_export_command('userdel', @_); -} - -sub _export_command { - my ( $self, $action, $svc_domain) = (shift, shift, shift); - my $command = $self->option($action); - return '' if $command =~ /^\s*$/; - - #set variable for the command - no strict 'vars'; - { - no strict 'refs'; - ${$_} = $svc_domain->getfield($_) foreach $svc_domain->fields; - } - ( $qdomain = $domain ) =~ s/\./:/g; #see dot-qmail(5): EXTENSION ADDRESSES - - if ( $svc_domain->catchall ) { - no strict 'refs'; - my $svc_acct = $svc_domain->catchall_svc_acct; - ${$_} = $svc_acct->getfield($_) foreach qw(uid gid dir); - } else { - no strict 'refs'; - ${$_} = '' foreach qw(uid gid dir); - } - - #done setting variables for the command - - $self->shellcommands_queue( $svc_domain->svcnum, - user => $self->option('user')||'root', - host => $self->machine, - command => eval(qq("$command")), - ); -} - -sub _export_replace { - my($self, $new, $old ) = (shift, shift, shift); - my $command = $self->option('usermod'); - - #set variable for the command - no strict 'vars'; - { - no strict 'refs'; - ${"old_$_"} = $old->getfield($_) foreach $old->fields; - ${"new_$_"} = $new->getfield($_) foreach $new->fields; - } - ( $old_qdomain = $old_domain ) =~ s/\./:/g; #see dot-qmail(5): EXTENSION ADDRESSES - ( $new_qdomain = $new_domain ) =~ s/\./:/g; #see dot-qmail(5): EXTENSION ADDRESSES - - { - no strict 'refs'; - - if ( $old->catchall ) { - my $svc_acct = $old->catchall_svc_acct; - ${"old_$_"} = $svc_acct->getfield($_) foreach qw(uid gid dir); - } else { - ${"old_$_"} = '' foreach qw(uid gid dir); - } - if ( $new->catchall ) { - my $svc_acct = $new->catchall_svc_acct; - ${"new_$_"} = $svc_acct->getfield($_) foreach qw(uid gid dir); - } else { - ${"new_$_"} = '' foreach qw(uid gid dir); - } - - } - - #done setting variables for the command - - $self->shellcommands_queue( $new->svcnum, - user => $self->option('user')||'root', - host => $self->machine, - command => eval(qq("$command")), - ); -} - -#a good idea to queue anything that could fail or take any time -sub shellcommands_queue { - my( $self, $svcnum ) = (shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::domain_shellcommands::ssh_cmd", - }; - $queue->insert( @_ ); -} - -sub ssh_cmd { #subroutine, not method - use Net::SSH '0.08'; - &Net::SSH::ssh_cmd( { @_ } ); -} - -#sub shellcommands_insert { #subroutine, not method -#} -#sub shellcommands_replace { #subroutine, not method -#} -#sub shellcommands_delete { #subroutine, not method -#} - -1; - diff --git a/FS/FS/part_export/everyone_net.pm b/FS/FS/part_export/everyone_net.pm deleted file mode 100644 index e04318e..0000000 --- a/FS/FS/part_export/everyone_net.pm +++ /dev/null @@ -1,132 +0,0 @@ -package FS::part_export::everyone_net; - -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::part_export; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'clientID' => { label=>'clientID' }, - 'password' => { label=>'Password' }, - #'workgroup' => { label=>'Default Workgroup' }, - 'debug' => { label=>'Enable debugging', - type=>'checkbox' }, -; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => 'Real-time export to Everyone.net outsourced mail service', - 'options'=> \%options, - 'notes' => <<'END' -Real-time export to -<a href="http://www.cp.net/">Everyone.net</a> via the XRC Remote API. -Requires installation of -<a href="http://search.cpan.org/dist/Net-XRC">Net::XRC</a> -from CPAN. -END -); - -sub rebless { shift; } - -# experiement: want the status of these right away (don't want account to -# create or whatever and then get error in the queue from dup username or -# something), so no queueing - -sub _export_insert { - my( $self, $svc_acct ) = (shift, shift); - - eval "use Net::XRC qw(:types);"; - return $@ if $@; - - $self->_xrc_command( 'createUser', - $svc_acct->domain, - [], - string($svc_acct->username), - string($svc_acct->_password), - ); -} - -sub _xrc_command { - my( $self, $method, $domain, @args ) = @_; - - eval "use Net::XRC qw(:types);"; - return $@ if $@; - - local($Net::XRC::DEBUG) = 1 - if $self->option('debug'); - - my $xrc = new Net::XRC ( - 'clientID' => $self->option('clientID'), - 'password' => $self->option('password'), - ); - - my $dresponse = $xrc->lookupMXReadyClientIDByEmailDomain( string($domain) ); - return $dresponse->error unless $dresponse->is_success; - my $clientID = $dresponse->content; - return "clientID for domain $domain not found" - if $clientID == -1; - - my $response = $xrc->$method($clientID, @args); - return $response->error unless $response->is_success; - ''; - -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - - eval "use Net::XRC qw(:types);"; - return $@ if $@; - - return "can't change domain with Everyone.net" - if $old->domain ne $new->domain; - return "can't change username with Everyone.net" - if $old->username ne $new->username; - return '' unless $old->_password ne $new->_password; - - $self->_xrc_command( 'setUserPassword', - $new->domain, - string($new->username), - string($new->_password), - ); -} - -sub _export_delete { - my( $self, $svc_acct ) = (shift, shift); - - eval "use Net::XRC qw(:types);"; - return $@ if $@; - - $self->_xrc_command( 'deleteUser', - $svc_acct->domain, - string($svc_acct->username), - ); -} - -sub _export_suspend { - my( $self, $svc_acct ) = (shift, shift); - - eval "use Net::XRC qw(:types);"; - return $@ if $@; - - $self->_xrc_command( 'suspendUser', - $svc_acct->domain, - string($svc_acct->username), - ); -} - -sub _export_unsuspend { - my( $self, $svc_acct ) = (shift, shift); - - eval "use Net::XRC qw(:types);"; - return $@ if $@; - - $self->_xrc_command( 'unsuspendUser', - $svc_acct->domain, - string($svc_acct->username), - ); -} - -1; - diff --git a/FS/FS/part_export/forward_shellcommands.pm b/FS/FS/part_export/forward_shellcommands.pm deleted file mode 100644 index cee24e4..0000000 --- a/FS/FS/part_export/forward_shellcommands.pm +++ /dev/null @@ -1,182 +0,0 @@ -package FS::part_export::forward_shellcommands; - -use strict; -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::part_export; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'user' => { label=>'Remote username', default=>'root' }, - 'useradd' => { label=>'Insert command', - default=>'', - }, - 'userdel' => { label=>'Delete command', - default=>'', - }, - 'usermod' => { label=>'Modify command', - default=>'', - }, -; - -%info = ( - 'svc' => 'svc_forward', - 'desc' => 'Run remote commands via SSH, for forwards', - 'options' => \%options, - 'notes' => <<'END' -Run remote commands via SSH, for forwards. You will need to -<a href="../docs/ssh.html">setup SSH for unattended operation</a>. -<BR><BR>Use these buttons for some useful presets: -<UL> - <LI> - <INPUT TYPE="button" VALUE="text vpopmail maintenance" onClick=' - this.form.useradd.value = "[ -d /home/vpopmail/domains/$domain/$username ] && { echo \"$destination\" > /home/vpopmail/domains/$domain/$username/.qmail; chown vpopmail:vchkpw /home/vpopmail/domains/$domain/$username/.qmail; }"; - this.form.userdel.value = "rm /home/vpopmail/domains/$domain/$username/.qmail"; - this.form.usermod.value = "mv /home/vpopmail/domains/$old_domain/$old_username/.qmail /home/vpopmail/domains/$new_domain/$new_username; [ \"$old_destination\" != \"$new_destination\" ] && { echo \"$new_destination\" > /home/vpopmail/domains/$new_domain/$new_username/.qmail; chown vpopmail:vchkpw /home/vpopmail/domains/$new_domain/$new_username/.qmail; }"; - '> - <LI> - <INPUT TYPE="button" VALUE="ISPMan CLI" onClick=' - this.form.useradd.value = ""; - this.form.userdel.value = ""; - this.form.usermod.value = ""; - '> -</UL> -The following variables are available for interpolation (prefixed with -<code>new_</code> or <code>old_</code> for replace operations): -<UL> - <LI><code>$username</code> - username of forward source - <LI><code>$domain</code> - domain of forward source - <LI><code>$source</code> - forward source ($username@$domain) - <LI><code>$destination</code> - forward destination - <LI>All other fields in <a href="../docs/schema.html#svc_forward">svc_forward</a> are also available. -</UL> -END -); - -sub rebless { shift; } - -sub _export_insert { - my($self) = shift; - $self->_export_command('useradd', @_); -} - -sub _export_delete { - my($self) = shift; - $self->_export_command('userdel', @_); -} - -sub _export_command { - my ( $self, $action, $svc_forward ) = (shift, shift, shift); - my $command = $self->option($action); - return '' if $command =~ /^\s*$/; - - #set variable for the command - no strict 'vars'; - { - no strict 'refs'; - ${$_} = $svc_forward->getfield($_) foreach $svc_forward->fields; - } - - if ( $svc_forward->srcsvc ) { - my $srcsvc_acct = $svc_forward->srcsvc_acct; - $username = $srcsvc_acct->username; - $domain = $srcsvc_acct->domain; - $source = $srcsvc_acct->email; - } else { - $source = $svc_forward->src; - ( $username, $domain ) = split(/\@/, $source); - } - - if ($svc_forward->dstsvc) { - $destination = $svc_forward->dstsvc_acct->email; - } else { - $destination = $svc_forward->dst; - } - - #done setting variables for the command - - $self->shellcommands_queue( $svc_forward->svcnum, - user => $self->option('user')||'root', - host => $self->machine, - command => eval(qq("$command")), - ); -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - my $command = $self->option('usermod'); - - #set variable for the command - no strict 'vars'; - { - no strict 'refs'; - ${"old_$_"} = $old->getfield($_) foreach $old->fields; - ${"new_$_"} = $new->getfield($_) foreach $new->fields; - } - - if ( $old->srcsvc ) { - my $srcsvc_acct = $old->srcsvc_acct; - $old_username = $srcsvc_acct->username; - $old_domain = $srcsvc_acct->domain; - $old_source = $srcsvc_acct->email; - } else { - $old_source = $old->src; - ( $old_username, $old_domain ) = split(/\@/, $old_source); - } - - if ( $old->dstsvc ) { - $old_destination = $old->dstsvc_acct->email; - } else { - $old_destination = $old->dst; - } - - if ( $new->srcsvc ) { - my $srcsvc_acct = $new->srcsvc_acct; - $new_username = $srcsvc_acct->username; - $new_domain = $srcsvc_acct->domain; - $new_source = $srcsvc_acct->email; - } else { - $new_source = $new->src; - ( $new_username, $new_domain ) = split(/\@/, $new_source); - } - - if ( $new->dstsvc ) { - $new_destination = $new->dstsvc_acct->email; - } else { - $new_destination = $new->dst; - } - - #done setting variables for the command - - $self->shellcommands_queue( $new->svcnum, - user => $self->option('user')||'root', - host => $self->machine, - command => eval(qq("$command")), - ); -} - -#a good idea to queue anything that could fail or take any time -sub shellcommands_queue { - my( $self, $svcnum ) = (shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::forward_shellcommands::ssh_cmd", - }; - $queue->insert( @_ ); -} - -sub ssh_cmd { #subroutine, not method - use Net::SSH '0.08'; - &Net::SSH::ssh_cmd( { @_ } ); -} - -#sub shellcommands_insert { #subroutine, not method -#} -#sub shellcommands_replace { #subroutine, not method -#} -#sub shellcommands_delete { #subroutine, not method -#} - -1; - diff --git a/FS/FS/part_export/http.pm b/FS/FS/part_export/http.pm deleted file mode 100644 index 55d8329..0000000 --- a/FS/FS/part_export/http.pm +++ /dev/null @@ -1,134 +0,0 @@ -package FS::part_export::http; - -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::part_export; - -@ISA = qw(FS::part_export); - -tie my %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 { $_ !~ /^(POST|FAX)$/ } $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", - ), - }, -; - -%info = ( - 'svc' => 'svc_domain', - 'desc' => 'Send an HTTP or HTTPS GET or POST request', - 'options' => \%options, - 'notes' => <<'END' -Send an HTTP or HTTPS GET or POST to the specified URL. For HTTPS support, -<a href="http://search.cpan.org/dist/Crypt-SSLeay">Crypt::SSLeay</a> -or <a href="http://search.cpan.org/dist/IO-Socket-SSL">IO::Socket::SSL</a> -is required. -END -); - -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; - -} - -1; - diff --git a/FS/FS/part_export/infostreet.pm b/FS/FS/part_export/infostreet.pm deleted file mode 100644 index ef16c7c..0000000 --- a/FS/FS/part_export/infostreet.pm +++ /dev/null @@ -1,277 +0,0 @@ -package FS::part_export::infostreet; - -use vars qw(@ISA %info %infostreet2cust_main $DEBUG); -use Tie::IxHash; -use FS::UID qw(dbh); -use FS::part_export; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'url' => { label=>'XML-RPC Access URL', }, - 'login' => { label=>'InfoStreet login', }, - 'password' => { label=>'InfoStreet password', }, - 'groupID' => { label=>'InfoStreet groupID', }, -; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => 'Real-time export to InfoStreet streetSmartAPI', - 'options' => \%options, - 'nodomain' => 'Y', - 'notes' => <<'END' -Real-time export to -<a href="http://www.infostreet.com/">InfoStreet</a> streetSmartAPI. -Requires installation of -<a href="http://search.cpan.org/dist/Frontier-Client">Frontier::Client</a> from CPAN. -END -); - -$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 { $_ !~ /^(POST|FAX)$/ } $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); - - # If a quota has been specified set the quota because it is not the default - $err_or_queue = $self->infostreet_queueSetQuota( $svc_acct->svcnum, - $svc_acct->username, $svc_acct->quota ) if $svc_acct->quota; - return $err_or_queue unless ref($err_or_queue); - - my $error = $err_or_queue->depend_insert( $jobnum ); - return $error if $error; - - $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; - - # If the quota has changed then do the export to setQuota - my $err_or_queue = $self->infostreet_queueSetQuota( $new->svcnum, $new->username, $new->quota ) - if ( $old->quota != $new->quota ); - return $err_or_queue unless ref($err_or_queue); - - - return '' unless $old->_password ne $new->_password; - $self->infostreet_queue( $new->svcnum, - 'passwd', $new->username, $new->_password ); -} - -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_queueSetQuota { - - my( $self, $svcnum) = (shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => 'FS::part_export::infostreet::infostreet_setQuota', - }; - - $queue->insert( - $self->option('url'), - $self->option('login'), - $self->option('password'), - $self->option('groupID'), - @_, - ) or $queue; - -} - -sub infostreet_setQuota { - my($url, $is_username, $is_password, $groupID, $username, $quota) = @_; - infostreet_command($url, $is_username, $is_password, $groupID, 'setQuota', $username, [ 'int'=> $quota ] ); -} - - -sub infostreet_command { #subroutine, not method - my($url, $username, $password, $groupID, $method, @args) = @_; - - 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; -} - -1; - diff --git a/FS/FS/part_export/ldap.pm b/FS/FS/part_export/ldap.pm deleted file mode 100644 index 823d99d..0000000 --- a/FS/FS/part_export/ldap.pm +++ /dev/null @@ -1,294 +0,0 @@ -package FS::part_export::ldap; - -use vars qw(@ISA %info @saltset); -use Tie::IxHash; -use FS::Record qw( dbh ); -use FS::part_export; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'dn' => { label=>'Root DN' }, - 'password' => { label=>'Root DN password' }, - 'userdn' => { label=>'User DN' }, - 'attributes' => { label=>'Attributes', - type=>'textarea', - default=>join("\n", - 'uid $username', - 'mail $username\@$domain', - 'uidno $uid', - 'gidno $gid', - 'cn $first', - 'sn $last', - 'mailquota $quota', - 'vmail', - 'location', - 'mailtag', - 'mailhost', - 'mailmessagestore $dir', - 'userpassword $crypt_password', - 'hint', - 'answer $sec_phrase', - 'objectclass top,person,inetOrgPerson', - ), - }, - 'radius' => { label=>'Export RADIUS attributes', type=>'checkbox', }, -; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => 'Real-time export to LDAP', - 'options' => \%options, - 'notes' => <<'END' -Real-time export to arbitrary LDAP attributes. Requires installation of -<a href="http://search.cpan.org/dist/Net-LDAP">Net::LDAP</a> from CPAN. -END -); - -@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); - -sub rebless { shift; } - -sub _export_insert { - my($self, $svc_acct) = (shift, shift); - - #false laziness w/shellcommands.pm - { - no strict 'refs'; - ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields; - ${$_} = $svc_acct->$_() foreach qw( domain ); - my $cust_pkg = $svc_acct->cust_svc->cust_pkg; - if ( $cust_pkg ) { - my $cust_main = $cust_pkg->cust_main; - ${$_} = $cust_main->getfield($_) foreach qw(first last); - } - } - $crypt_password = ''; #surpress "used only once" warnings - $crypt_password = '{crypt}'. crypt( $svc_acct->_password, - $saltset[int(rand(64))].$saltset[int(rand(64))] ); - - my $username_attrib; - my %attrib = map { /^\s*(\w+)\s+(.*\S)\s*$/; - $username_attrib = $1 if $2 eq '$username'; - ( $1 => eval(qq("$2")) ); } - grep { /^\s*(\w+)\s+(.*\S)\s*$/ } - split("\n", $self->option('attributes')); - - if ( $self->option('radius') ) { - foreach my $table (qw(reply check)) { - my $method = "radius_$table"; - my %radius = $svc_acct->$method(); - foreach my $radius ( keys %radius ) { - ( my $ldap = $radius ) =~ s/\-//g; - $attrib{$ldap} = $radius{$radius}; - } - } - } - - my $err_or_queue = $self->ldap_queue( $svc_acct->svcnum, 'insert', - #$svc_acct->username, - $username_attrib, - %attrib ); - return $err_or_queue unless ref($err_or_queue); - - #groups with LDAP? - #my @groups = $svc_acct->radius_groups; - #if ( @groups ) { - # my $err_or_queue = $self->ldap_queue( - # $svc_acct->svcnum, 'usergroup_insert', - # $svc_acct->username, @groups ); - # return $err_or_queue unless ref($err_or_queue); - #} - - ''; -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - return "can't (yet?) change username with ldap" - if $old->username ne $new->username; - - return "ldap replace unimplemented"; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $jobnum = ''; - #if ( $old->username ne $new->username ) { - # my $err_or_queue = $self->ldap_queue( $new->svcnum, 'rename', - # $new->username, $old->username ); - # unless ( ref($err_or_queue) ) { - # $dbh->rollback if $oldAutoCommit; - # return $err_or_queue; - # } - # $jobnum = $err_or_queue->jobnum; - #} - - foreach my $table (qw(reply check)) { - my $method = "radius_$table"; - my %new = $new->$method(); - my %old = $old->$method(); - if ( grep { !exists $old{$_} #new attributes - || $new{$_} ne $old{$_} #changed - } keys %new - ) { - my $err_or_queue = $self->ldap_queue( $new->svcnum, 'insert', - $table, $new->username, %new ); - unless ( ref($err_or_queue) ) { - $dbh->rollback if $oldAutoCommit; - return $err_or_queue; - } - if ( $jobnum ) { - my $error = $err_or_queue->depend_insert( $jobnum ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - } - - my @del = grep { !exists $new{$_} } keys %old; - if ( @del ) { - my $err_or_queue = $self->ldap_queue( $new->svcnum, 'attrib_delete', - $table, $new->username, @del ); - unless ( ref($err_or_queue) ) { - $dbh->rollback if $oldAutoCommit; - return $err_or_queue; - } - if ( $jobnum ) { - my $error = $err_or_queue->depend_insert( $jobnum ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - } - } - - # (sorta) false laziness with FS::svc_acct::replace - my @oldgroups = @{$old->usergroup}; #uuuh - my @newgroups = $new->radius_groups; - my @delgroups = (); - foreach my $oldgroup ( @oldgroups ) { - if ( grep { $oldgroup eq $_ } @newgroups ) { - @newgroups = grep { $oldgroup ne $_ } @newgroups; - next; - } - push @delgroups, $oldgroup; - } - - if ( @delgroups ) { - my $err_or_queue = $self->ldap_queue( $new->svcnum, 'usergroup_delete', - $new->username, @delgroups ); - unless ( ref($err_or_queue) ) { - $dbh->rollback if $oldAutoCommit; - return $err_or_queue; - } - if ( $jobnum ) { - my $error = $err_or_queue->depend_insert( $jobnum ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - } - - if ( @newgroups ) { - my $err_or_queue = $self->ldap_queue( $new->svcnum, 'usergroup_insert', - $new->username, @newgroups ); - unless ( ref($err_or_queue) ) { - $dbh->rollback if $oldAutoCommit; - return $err_or_queue; - } - if ( $jobnum ) { - my $error = $err_or_queue->depend_insert( $jobnum ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; -} - -sub _export_delete { - my( $self, $svc_acct ) = (shift, shift); - return "ldap delete unimplemented"; - my $err_or_queue = $self->ldap_queue( $svc_acct->svcnum, 'delete', - $svc_acct->username ); - ref($err_or_queue) ? '' : $err_or_queue; -} - -sub ldap_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::ldap::ldap_$method", - }; - $queue->insert( - $self->machine, - $self->option('dn'), - $self->option('password'), - $self->option('userdn'), - @_, - ) or $queue; -} - -sub ldap_insert { #subroutine, not method - my $ldap = ldap_connect(shift, shift, shift); - my( $userdn, $username_attrib, %attrib ) = @_; - - $userdn = "$username_attrib=$attrib{$username_attrib}, $userdn" - if $username_attrib; - #icky hack, but should be unsurprising to the LDAPers - foreach my $key ( grep { $attrib{$_} =~ /,/ } keys %attrib ) { - $attrib{$key} = [ split(/,/, $attrib{$key}) ]; - } - - my $status = $ldap->add( $userdn, attrs => [ %attrib ] ); - die 'LDAP error: '. $status->error. "\n" if $status->is_error; - - $ldap->unbind; -} - -#sub ldap_delete { #subroutine, not method -# my $dbh = ldap_connect(shift, shift, shift); -# my $username = shift; -# -# foreach my $table (qw( radcheck radreply usergroup )) { -# my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" ); -# $sth->execute($username) -# or die "can't delete from $table table: ". $sth->errstr; -# } -# $dbh->disconnect; -#} - -sub ldap_connect { - my( $machine, $dn, $password ) = @_; - my %bind_options; - $bind_options{password} = $password if length($password); - - eval "use Net::LDAP"; - die $@ if $@; - - my $ldap = Net::LDAP->new($machine) or die $@; - my $status = $ldap->bind( $dn, %bind_options ); - die 'LDAP error: '. $status->error. "\n" if $status->is_error; - - $ldap; -} - -1; - diff --git a/FS/FS/part_export/null.pm b/FS/FS/part_export/null.pm deleted file mode 100644 index 0145af3..0000000 --- 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/passwdfile.pm b/FS/FS/part_export/passwdfile.pm deleted file mode 100644 index 2978d25..0000000 --- a/FS/FS/part_export/passwdfile.pm +++ /dev/null @@ -1,18 +0,0 @@ -package FS::part_export::passwdfile; - -use strict; -use vars qw(@ISA %options); -use Tie::IxHash; -use FS::part_export::null; - -@ISA = qw(FS::part_export::null); - -tie %options, 'Tie::IxHash', - 'crypt' => { label=>'Password encryption', - type=>'select', options=>[qw(crypt md5)], - default=>'crypt', - }, -; - -1; - diff --git a/FS/FS/part_export/postfix.pm b/FS/FS/part_export/postfix.pm deleted file mode 100644 index 4fd19ee..0000000 --- a/FS/FS/part_export/postfix.pm +++ /dev/null @@ -1,32 +0,0 @@ -package FS::part_export::postfix; - -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::part_export::null; - -@ISA = qw(FS::part_export::null); - -tie my %options, 'Tie::IxHash', - 'user' => { label=>'Remote username', default=>'root' }, - 'aliases' => { label=>'aliases file location', default=>'/etc/aliases' }, - 'virtual' => { label=>'virtual file location', default=>'/etc/postfix/virtual' }, - 'mydomain' => { label=>'local domain', default=>'' }, - 'newaliases' => { label=>'newaliases command', default=>'newaliases' }, - 'postmap' => { label=>'postmap command', - default=>'postmap hash:/etc/postfix/virtual', }, - 'reload' => { label=>'reload command', - default=>'postfix reload' }, -; - -%info = ( - 'svc' => 'svc_forward', - 'desc' => 'Postfix text files', - 'options' => \%options, - 'notes' => <<'END' -Batch export of Postfix aliases and virtual files. -<a href="http://search.cpan.org/dist/File-Rsync">File::Rsync</a> -must be installed. Run bin/postfix.export to export the files. -END -); - -1; diff --git a/FS/FS/part_export/radiator.pm b/FS/FS/part_export/radiator.pm deleted file mode 100644 index 2ac3edb..0000000 --- a/FS/FS/part_export/radiator.pm +++ /dev/null @@ -1,167 +0,0 @@ -package FS::part_export::radiator; - -use vars qw(@ISA %info $radusers); -use Tie::IxHash; -use FS::part_export::sqlradius; - -tie my %options, 'Tie::IxHash', %FS::part_export::sqlradius::options; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => 'Real-time export to RADIATOR', - 'options' => \%options, - 'nodomain' => '', - 'notes' => <<'END', -Real-time export of the <b>radusers</b> table to any SQL database in -<a href="http://www.open.com.au/radiator/">Radiator</a>-native format. -To setup accounting, see the RADIATOR documentation for hooks to update -a standard <b>radacct</b> table. -END -); - -@ISA = qw(FS::part_export::sqlradius); #for regular sqlradius accounting - -$radusers = 'RADUSERS'; #MySQL is case sensitive about table names! huh - -#sub export_username { -# my($self, $svc_acct) = (shift, shift); -# $svc_acct->email; -#} - -sub _export_insert { - my( $self, $svc_acct ) = (shift, shift); - - $self->radiator_queue( - $svc_acct->svcnum, - 'insert', - $self->_radiator_hash($svc_acct), - ); -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - -# return "can't (yet) change domain with radiator export" -# if $old->domain ne $new->domain; -# return "can't (yet) change username with radiator export" -# if $old->username ne $new->username; - - $self->radiator_queue( - $new->svcnum, - 'replace', - $self->export_username($old), - $self->_radiator_hash($new), - ); -} - -sub _export_delete { - my( $self, $svc_acct ) = (shift, shift); - - $self->radiator_queue( - $svc_acct->svcnum, - 'delete', - $self->export_username($svc_acct), - ); -} - -sub _radiator_hash { - my( $self, $svc_acct ) = @_; - my %hash = ( - 'username' => $self->export_username($svc_acct), - 'pass_word' => $svc_acct->crypt_password, - 'fullname' => $svc_acct->finger, - map { my $method = "radius_$_"; $_ => $svc_acct->$method(); } - qw( framed_filter_id framed_mtu framed_netmask framed_protocol - framed_routing login_host login_service login_tcp_port ) - ); - $hash{'timeleft'} = $svc_acct->seconds - if $svc_acct->seconds =~ /^\d+$/; - $hash{'staticaddress'} = $svc_acct->slipip - if $svc_acct->slipip =~ /^[\d\.]+$/; # and $self->slipip ne '0.0.0.0'; - - $hash{'servicename'} = ( $svc_acct->radius_groups )[0]; - - my $cust_pkg = $svc_acct->cust_svc->cust_pkg; - $hash{'validto'} = $cust_pkg->bill - if $cust_pkg && $cust_pkg->part_pkg->is_prepaid && $cust_pkg->bill; - - #some other random stuff, should probably be attributes or virtual fields - #$hash{'state'} = 0; #only inserts - #$hash{'badlogins'} = 0; #only inserts - $hash{'maxlogins'} = 1; - $hash{'addeddate'} = $cust_pkg->setup - if $cust_pkg && $cust_pkg->setup; - $hash{'validfrom'} = $cust_pkg->last_bill || $cust_pkg->setup - if $cust_pkg && ( $cust_pkg->last_bill || $cust_pkg->setup ); - $hash{'state'} = $cust_pkg->susp ? 1 : 0 - if $cust_pkg; - - %hash; -} - -sub radiator_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::radiator::radiator_$method", - }; - $queue->insert( - $self->option('datasrc'), - $self->option('username'), - $self->option('password'), - @_, - ); # or $queue; -} - -sub radiator_insert { #subroutine, not method - my $dbh = radiator_connect(shift, shift, shift); - my %hash = @_; - $hash{'state'} = 0; #see "random stuff" above - $hash{'badlogins'} = 0; #see "random stuff" above - - my $sth = $dbh->prepare( - "INSERT INTO $radusers ( ". join(', ', keys %hash ). ' ) '. - 'VALUES ( '. join(', ', map '?', keys %hash ). ' ) ' - ) or die $dbh->errstr; - $sth->execute( values %hash ) - or die $sth->errstr; - - $dbh->disconnect; - -} - -sub radiator_replace { #subroutine, not method - my $dbh = radiator_connect(shift, shift, shift); - my ( $old_username, %hash ) = @_; - - my $sth = $dbh->prepare( - "UPDATE $radusers SET ". join(', ', map " $_ = ?", keys %hash ). - ' WHERE username = ?' - ) or die $dbh->errstr; - $sth->execute( values(%hash), $old_username ) - or die $sth->errstr; - - $dbh->disconnect; -} - -sub radiator_delete { #subroutine, not method - my $dbh = radiator_connect(shift, shift, shift); - my ( $username ) = @_; - - my $sth = $dbh->prepare( - "DELETE FROM $radusers WHERE username = ?" - ) or die $dbh->errstr; - $sth->execute( $username ) - or die $sth->errstr; - - $dbh->disconnect; -} - - -sub radiator_connect { - #my($datasrc, $username, $password) = @_; - #DBI->connect($datasrc, $username, $password) or die $DBI::errstr; - DBI->connect(@_) or die $DBI::errstr; -} - -1; diff --git a/FS/FS/part_export/router.pm b/FS/FS/part_export/router.pm deleted file mode 100644 index 648a437..0000000 --- a/FS/FS/part_export/router.pm +++ /dev/null @@ -1,190 +0,0 @@ -package FS::part_export::router; - -=head1 FS::part_export::router - -This export connects to a router and transmits commands via telnet or SSH. -It requires the following custom router fields: - -=over 4 - -=item admin_address - IP address (or hostname) to connect - -=item admin_user - username for admin access - -=item admin_password - password for admin access - -=back - -The export itself needs the following options: - -=over 4 - -=item insert, replace, delete - command strings (to be interpolated) - -=item Prompt - prompt string to expect from router after successful login - -=item Timeout - time to wait for prompt string - -=back - -(Prompt and Timeout are required only for telnet connections.) - -=cut - -use vars qw(@ISA %info @saltset); -use Tie::IxHash; -use String::ShellQuote; -use FS::part_export; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'protocol' => { - label=>'Protocol', - type =>'select', - options => [qw(telnet ssh)], - default => 'telnet'}, - 'insert' => {label=>'Insert command', default=>'' }, - 'delete' => {label=>'Delete command', default=>'' }, - 'replace' => {label=>'Replace command', default=>'' }, - 'Timeout' => {label=>'Time to wait for prompt', default=>'20' }, - 'Prompt' => {label=>'Prompt string', default=>'#' } -; - -%info = ( - 'svc' => 'svc_broadband', - 'desc' => 'Send a command to a router.', - 'options' => \%options, - 'notes' => 'Installation of Net::Telnet from CPAN is required for telnet connections. ( more detailed description from Kristian / fire2wire? )', -); - -@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); - -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_suspend { - my($self) = shift; - $self->_export_command('suspend', @_); -} - -sub _export_unsuspend { - my($self) = shift; - $self->_export_command('unsuspend', @_); -} - -sub _export_command { - my ( $self, $action, $svc_broadband) = (shift, shift, shift); - my $command = $self->option($action); - return '' if $command =~ /^\s*$/; - - no strict 'vars'; - { - no strict 'refs'; - ${$_} = $svc_broadband->getfield($_) foreach $svc_broadband->fields; - } - # fetch router info - my $router = $svc_broadband->addr_block->router; - my %r; - $r{$_} = $router->getfield($_) foreach $router->virtual_fields; - #warn qq("$command"); - #warn eval(qq("$command")); - - warn "admin_address: '$r{admin_address}'"; - - if ($r{admin_address} ne '') { - $self->router_queue( $svc_broadband->svcnum, $self->option('protocol'), - user => $r{admin_user}, - password => $r{admin_password}, - host => $r{admin_address}, - Timeout => $self->option('Timeout'), - Prompt => $self->option('Prompt'), - command => eval(qq("$command")), - ); - } else { - return ''; - } -} - -sub _export_replace { - - # We don't handle the case of a svc_broadband moving between routers. - # If you want to do that, reprovision the service. - - my($self, $new, $old ) = (shift, shift, shift); - my $command = $self->option('replace'); - no strict 'vars'; - { - no strict 'refs'; - ${"old_$_"} = $old->getfield($_) foreach $old->fields; - ${"new_$_"} = $new->getfield($_) foreach $new->fields; - } - - my $router = $new->addr_block->router; - my %r; - $r{$_} = $router->getfield($_) foreach $router->virtual_fields; - - if ($r{admin_address} ne '') { - $self->router_queue( $new->svcnum, $self->option('protocol'), - user => $r{admin_user}, - password => $r{admin_password}, - host => $r{admin_address}, - Timeout => $self->option('Timeout'), - Prompt => $self->option('Prompt'), - command => eval(qq("$command")), - ); - } else { - return ''; - } -} - -#a good idea to queue anything that could fail or take any time -sub router_queue { - #warn join ':', @_; - my( $self, $svcnum, $protocol ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - }; - $queue->job ("FS::part_export::router::".$protocol."_cmd"); - $queue->insert( @_ ); -} - -sub ssh_cmd { #subroutine, not method - use Net::SSH '0.08'; - &Net::SSH::ssh_cmd( { @_ } ); -} - -sub telnet_cmd { - eval 'use Net::Telnet;'; - die $@ if $@; - - warn join(', ', @_); - - my %arg = @_; - - my $t = new Net::Telnet (Timeout => $arg{Timeout}, - Prompt => $arg{Prompt}); - $t->open($arg{host}); - $t->login($arg{user}, $arg{password}); - my @error = $t->cmd($arg{command}); - die @error if (grep /^ERROR/, @error); -} - -#sub router_insert { #subroutine, not method -#} -#sub router_replace { #subroutine, not method -#} -#sub router_delete { #subroutine, not method -#} - -1; - diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm deleted file mode 100644 index e488a52..0000000 --- a/FS/FS/part_export/shellcommands.pm +++ /dev/null @@ -1,334 +0,0 @@ -package FS::part_export::shellcommands; - -use vars qw(@ISA %info); -use Tie::IxHash; -use String::ShellQuote; -use FS::part_export; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'user' => { label=>'Remote username', default=>'root' }, - 'useradd' => { label=>'Insert command', - default=>'useradd -c $finger -d $dir -m -s $shell -u $uid -p $crypt_password $username' - #default=>'cp -pr /etc/skel $dir; chown -R $uid.$gid $dir' - }, - 'useradd_stdin' => { label=>'Insert command STDIN', - 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 -c $new_finger -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -g $new_gid -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=>'', - }, - 'usermod_pwonly' => { label=>'Disallow username, domain, uid, gid, and dir changes', #and RADIUS group changes', - type =>'checkbox', - }, - 'usermod_nousername' => { label=>'Disallow just username changes', - type =>'checkbox', - }, - 'suspend' => { label=>'Suspension command', - default=>'usermod -L $username', - }, - 'suspend_stdin' => { label=>'Suspension command STDIN', - default=>'', - }, - 'unsuspend' => { label=>'Unsuspension command', - default=>'usermod -U $username', - }, - 'unsuspend_stdin' => { label=>'Unsuspension command STDIN', - default=>'', - }, - 'crypt' => { label => 'Default password encryption', - type=>'select', options=>[qw(crypt md5)], - default => 'crypt', - }, -; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => - 'Real-time export via remote SSH (i.e. useradd, userdel, etc.)', - 'options' => \%options, - 'nodomain' => 'Y', - 'notes' => <<'END' -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 -<a href="../docs/ssh.html">setup SSH for unattended operation</a>. - -<BR><BR>Use these buttons for some useful presets: -<UL> - <LI> - <INPUT TYPE="button" VALUE="Linux" onClick=' - this.form.useradd.value = "useradd -c $finger -d $dir -m -s $shell -u $uid -p $crypt_password $username"; - this.form.useradd_stdin.value = ""; - this.form.userdel.value = "userdel -r $username"; - this.form.userdel_stdin.value=""; - this.form.usermod.value = "usermod -c $new_finger -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -g $new_gid -p $new_crypt_password $old_username"; - this.form.usermod_stdin.value = ""; - this.form.suspend.value = "usermod -L $username"; - this.form.suspend_stdin.value=""; - this.form.unsuspend.value = "usermod -U $username"; - this.form.unsuspend_stdin.value=""; - '> - <LI> - <INPUT TYPE="button" VALUE="FreeBSD before 4.10 / 5.3" onClick=' - this.form.useradd.value = "lockf /etc/passwd.lock pw useradd $username -d $dir -m -s $shell -u $uid -c $finger -h 0"; - this.form.useradd_stdin.value = "$_password\n"; - this.form.userdel.value = "lockf /etc/passwd.lock pw userdel $username -r"; this.form.userdel_stdin.value=""; - this.form.usermod.value = "lockf /etc/passwd.lock pw usermod $old_username -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -g $new_gid -c $new_finger -h 0"; - this.form.usermod_stdin.value = "$new__password\n"; this.form.suspend.value = "lockf /etc/passwd.lock pw lock $username"; - this.form.suspend_stdin.value=""; - this.form.unsuspend.value = "lockf /etc/passwd.lock pw unlock $username"; this.form.unsuspend_stdin.value=""; - '> - Note: On FreeBSD versions before 5.3 and 4.10 (4.10 is after 4.9, not - 4.1!), due to deficient locking in pw(1), you must disable the chpass(1), - chsh(1), chfn(1), passwd(1), and vipw(1) commands, or replace them with - wrappers that prepend "lockf /etc/passwd.lock". Alternatively, apply the - patch in - <A HREF="http://www.freebsd.org/cgi/query-pr.cgi?pr=23501">FreeBSD PR#23501</A> - and use the "FreeBSD 4.10 / 5.3 or later" button below. - <LI> - <INPUT TYPE="button" VALUE="FreeBSD 4.10 / 5.3 or later" onClick=' - this.form.useradd.value = "pw useradd $username -d $dir -m -s $shell -u $uid -g $gid -c $finger -h 0"; - this.form.useradd_stdin.value = "$_password\n"; - this.form.userdel.value = "pw userdel $username -r"; - this.form.userdel_stdin.value=""; - this.form.usermod.value = "pw usermod $old_username -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -g $new_gid -c $new_finger -h 0"; - this.form.usermod_stdin.value = "$new__password\n"; - this.form.suspend.value = "pw lock $username"; - this.form.suspend_stdin.value=""; - this.form.unsuspend.value = "pw unlock $username"; - this.form.unsuspend_stdin.value=""; - '> - <LI> - <INPUT TYPE="button" VALUE="NetBSD/OpenBSD" onClick=' - this.form.useradd.value = "useradd -c $finger -d $dir -m -s $shell -u $uid -p $crypt_password $username"; - this.form.useradd_stdin.value = ""; - this.form.userdel.value = "userdel -r $username"; - this.form.userdel_stdin.value=""; - this.form.usermod.value = "usermod -c $new_finger -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -g $new_gid -p $new_crypt_password $old_username"; - this.form.usermod_stdin.value = ""; - this.form.suspend.value = ""; - this.form.suspend_stdin.value=""; - this.form.unsuspend.value = ""; - this.form.unsuspend_stdin.value=""; - '> - <LI> - <INPUT TYPE="button" VALUE="Just maintain directories (use with sysvshell or bsdshell)" onClick=' - this.form.useradd.value = "cp -pr /etc/skel $dir; chown -R $uid.$gid $dir"; this.form.useradd_stdin.value = ""; - this.form.usermod.value = "[ -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 $new_uid.$new_gid $new_dir; rm -rf $old_dir )"; - this.form.usermod_stdin.value = ""; - this.form.userdel.value = "rm -rf $dir"; - this.form.userdel_stdin.value=""; - this.form.suspend.value = ""; - this.form.suspend_stdin.value=""; - this.form.unsuspend.value = ""; - this.form.unsuspend_stdin.value=""; - '> -</UL> - -The following variables are available for interpolation (prefixed with new_ or -old_ for replace operations): -<UL> - <LI><code>$username</code> - <LI><code>$_password</code> - <LI><code>$quoted_password</code> - unencrypted password, already quoted for the shell (do not add additional quotes) - <LI><code>$crypt_password</code> - encrypted password, already quoted for the shell (do not add additional quotes) - <LI><code>$uid</code> - <LI><code>$gid</code> - <LI><code>$finger</code> - GECOS, already quoted for the shell (do not add additional quotes) - <LI><code>$first</code> - First name of GECOS, already quoted for the shell (do not add additional quotes) - <LI><code>$last</code> - Last name of GECOS, already quoted for the shell (do not add additional quotes) - <LI><code>$dir</code> - home directory - <LI><code>$shell</code> - <LI><code>$quota</code> - <LI><code>@radius_groups</code> - <LI>All other fields in <a href="../docs/schema.html#svc_acct">svc_acct</a> are also available. -</UL> -END -); - -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_suspend { - my($self) = shift; - $self->_export_command_or_super('suspend', @_); -} - -sub _export_unsuspend { - my($self) = shift; - $self->_export_command_or_super('unsuspend', @_); -} - -sub _export_command_or_super { - my($self, $action) = (shift, shift); - if ( $self->option($action) =~ /^\s*$/ ) { - my $method = "SUPER::_export_$action"; - $self->$method(@_); - } else { - $self->_export_command($action, @_); - } -}; - - -sub _export_command { - my ( $self, $action, $svc_acct) = (shift, shift, shift); - my $command = $self->option($action); - return '' if $command =~ /^\s*$/; - my $stdin = $self->option($action."_stdin"); - - no strict 'vars'; - { - no strict 'refs'; - ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields; - - my $count = 1; - foreach my $acct_snarf ( $svc_acct->acct_snarf ) { - ${"snarf_$_$count"} = shell_quote( $acct_snarf->get($_) ) - foreach qw( machine username _password ); - $count++; - } - } - - my $cust_pkg = $svc_acct->cust_svc->cust_pkg; - if ( $cust_pkg ) { - $email = ( grep { $_ !~ /^(POST|FAX)$/ } $cust_pkg->cust_main->invoicing_list )[0]; - } else { - $email = ''; - } - - $finger =~ /^(.*)\s+(\S+)$/ or $finger =~ /^((.*))$/; - ($first, $last ) = ( $1, $2 ); - $first = shell_quote $first; - $last = shell_quote $last; - $finger = shell_quote $finger; - $quoted_password = shell_quote $_password; - $domain = $svc_acct->domain; - - $crypt_password = - shell_quote( $svc_acct->crypt_password( $self->option('crypt') ) ); - - @radius_groups = $svc_acct->radius_groups; - - $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 'vars'; - { - no strict 'refs'; - ${"old_$_"} = $old->getfield($_) foreach $old->fields; - ${"new_$_"} = $new->getfield($_) foreach $new->fields; - } - $new_finger =~ /^(.*)\s+(\S+)$/ or $new_finger =~ /^((.*))$/; - ($new_first, $new_last ) = ( $1, $2 ); - $new_first = shell_quote $new_first; - $new_last = shell_quote $new_last; - $new_finger = shell_quote $new_finger; - $quoted_new__password = shell_quote $new__password; #old, wrong? - $new_quoted_password = shell_quote $new__password; #new, better? - $old_domain = $old->domain; - $new_domain = $new->domain; - - $new_crypt_password = - shell_quote( $new->crypt_password( $self->option('crypt') ) ); - - @old_radius_groups = $old->radius_groups; - @new_radius_groups = $new->radius_groups; - - my $error = ''; - if ( $self->option('usermod_pwonly') || $self->option('usermod_nousername') ){ - if ( $old_username ne $new_username ) { - $error ||= "can't change username"; - } - } - if ( $self->option('usermod_pwonly') ) { - if ( $old_domain ne $new_domain ) { - $error ||= "can't change domain"; - } - if ( $old_uid != $new_uid ) { - $error ||= "can't change uid"; - } - if ( $old_gid != $new_gid ) { - $error ||= "can't change gid"; - } - if ( $old_dir ne $new_dir ) { - $error ||= "can't change dir"; - } - #if ( join("\n", sort @old_radius_groups) ne - # join("\n", sort @new_radius_groups) ) { - # $error ||= "can't change RADIUS groups"; - #} - } - return $error. ' ('. $self->exporttype. ' to '. $self->machine. ')' - if $error; - - $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.08'; - &Net::SSH::ssh_cmd( { @_ } ); -} - -#sub shellcommands_insert { #subroutine, not method -#} -#sub shellcommands_replace { #subroutine, not method -#} -#sub shellcommands_delete { #subroutine, not method -#} - -1; - diff --git a/FS/FS/part_export/shellcommands_withdomain.pm b/FS/FS/part_export/shellcommands_withdomain.pm deleted file mode 100644 index 7c5d904..0000000 --- a/FS/FS/part_export/shellcommands_withdomain.pm +++ /dev/null @@ -1,112 +0,0 @@ -package FS::part_export::shellcommands_withdomain; - -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::part_export::shellcommands; - -@ISA = qw(FS::part_export::shellcommands); - -tie my %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", - }, - 'usermod_pwonly' => { label=>'Disallow username, domain, uid, dir and RADIUS group changes', - type =>'checkbox', - }, - 'usermod_nousername' => { label=>'Disallow just username changes', - type =>'checkbox', - }, - 'suspend' => { label=>'Suspension command', - default=>'', - }, - 'suspend_stdin' => { label=>'Suspension command STDIN', - default=>'', - }, - 'unsuspend' => { label=>'Unsuspension command', - default=>'', - }, - 'unsuspend_stdin' => { label=>'Unsuspension command STDIN', - default=>'', - }, - 'crypt' => { label => 'Default password encryption', - type=>'select', options=>[qw(crypt md5)], - default => 'crypt', - }, -; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => 'Real-time export via remote SSH (vpopmail, ISPMan)', - 'options' => \%options, - 'notes' => <<'END' -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 -<a href="../docs/ssh.html">setup SSH for unattended operation</a>. - -<BR><BR>Use these buttons for some useful presets: -<UL> - <LI><INPUT TYPE="button" VALUE="vpopmail" onClick=' - this.form.useradd.value = "/home/vpopmail/bin/vadduser $username\\\@$domain $quoted_password"; - this.form.useradd_stdin.value = ""; - this.form.userdel.value = "/home/vpopmail/bin/vdeluser $username\\\@$domain"; - this.form.userdel_stdin.value=""; - this.form.usermod.value = "/home/vpopmail/bin/vpasswd $new_username\\\@$new_domain $new_quoted_password"; - this.form.usermod_stdin.value = ""; - this.form.usermod_pwonly.checked = true; - '> - <LI><INPUT TYPE="button" VALUE="ISPMan CLI" onClick=' - this.form.useradd.value = "/usr/local/ispman/bin/ispman.addUser -d $domain -f $first -l $last -q $quota -p $quoted_password $username"; - this.form.useradd_stdin.value = ""; - this.form.userdel.value = "/usr/local/ispman/bin/ispman.delUser -d $domain $username"; - this.form.userdel_stdin.value=""; - this.form.usermod.value = "/usr/local/ispman/bin/ispman.passwd.user $new_username\\\@$new_domain $new_quoted_password"; - this.form.usermod_stdin.value = ""; - this.form.usermod_pwonly.checked = true; - '> -</UL> - -The following variables are available for interpolation (prefixed with -<code>new_</code> or <code>old_</code> for replace operations): -<UL> - <LI><code>$username</code> - <LI><code>$domain</code> - <LI><code>$_password</code> - <LI><code>$quoted_password</code> - unencrypted password, already quoted for the shell (do not add additional quotes) - <LI><code>$crypt_password</code> - encrypted password, already quoted for the shell (do not add additional quotes) - <LI><code>$uid</code> - <LI><code>$gid</code> - <LI><code>$finger</code> - GECOS, already quoted for the shell (do not add additional quotes) - <LI><code>$first</code> - First name of GECOS, already quoted for the shell (do not add additional quotes) - <LI><code>$last</code> - Last name of GECOS, already quoted for the shell (do not add additional quotes) - <LI><code>$dir</code> - home directory - <LI><code>$shell</code> - <LI><code>$quota</code> - <LI><code>@radius_groups</code> - <LI>All other fields in <a href="../docs/schema.html#svc_acct">svc_acct</a> are also available. -</UL> -END -); - -1; - diff --git a/FS/FS/part_export/sqlmail.pm b/FS/FS/part_export/sqlmail.pm deleted file mode 100644 index 6d61e0e..0000000 --- a/FS/FS/part_export/sqlmail.pm +++ /dev/null @@ -1,220 +0,0 @@ -package FS::part_export::sqlmail; - -use vars qw(@ISA %info); -use Tie::IxHash; -use Digest::MD5 qw(md5_hex); -use FS::Record qw(qsearchs); -use FS::part_export; -use FS::svc_domain; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'datasrc' => { label => 'DBI data source' }, - 'username' => { label => 'Database username' }, - 'password' => { label => 'Database password' }, - 'server_type' => { - label => 'Server type', - type => 'select', - options => [qw(dovecot_plain dovecot_crypt dovecot_digest_md5 courier_plain - courier_crypt)], - default => ['dovecot_plain'], }, - 'svc_acct_table' => { label => 'User Table', default => 'user_acct' }, - 'svc_forward_table' => { label => 'Forward Table', default => 'forward' }, - 'svc_domain_table' => { label => 'Domain Table', default => 'domain' }, - 'svc_acct_fields' => { label => 'svc_acct Export Fields', - default => 'username _password domsvc svcnum' }, - 'svc_forward_fields' => { label => 'svc_forward Export Fields', - default => 'domain svcnum catchall' }, - 'svc_domain_fields' => { label => 'svc_domain Export Fields', - default => 'srcsvc dstsvc dst' }, - 'resolve_dstsvc' => { label => q{Resolve svc_forward.dstsvc to an email address and store it in dst. (Doesn't require that you also export dstsvc.)}, - type => 'checkbox' }, -; - -%info = ( - 'svc' => [qw( svc_acct svc_domain svc_forward )], - 'desc' => 'Real-time export to SQL-backed mail server', - 'options' => \%options, - 'nodomain' => '', - 'notes' => <<'END' -Database schema can be made to work with Courier IMAP, Exim and Dovecot. -Others could work but are untested. (more detailed description from -Kristian / fire2wire? ) -END -); - -sub rebless { shift; } - -sub _export_insert { - my($self, $svc) = (shift, shift); - # this is a svc_something. - - my $svcdb = $svc->cust_svc->part_svc->svcdb; - my $export_table = $self->option($svcdb . '_table') - or die('Export table not defined for svcdb: ' . $svcdb); - my @export_fields = split(/\s+/, $self->option($svcdb . '_fields')); - my $svchash = update_values($self, $svc, $svcdb); - - foreach my $key (keys(%$svchash)) { - unless (grep { $key eq $_ } @export_fields) { - delete $svchash->{$key}; - } - } - - my $error = $self->sqlmail_queue( $svc->svcnum, 'insert', - $self->option('server_type'), $export_table, - (map { ($_, $svchash->{$_}); } keys(%$svchash))); - return $error if $error; - ''; - -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - - my $svcdb = $new->cust_svc->part_svc->svcdb; - my $export_table = $self->option($svcdb . '_table') - or die('Export table not defined for svcdb: ' . $svcdb); - my @export_fields = split(/\s+/, $self->option($svcdb . '_fields')); - my $svchash = update_values($self, $new, $svcdb); - - foreach my $key (keys(%$svchash)) { - unless (grep { $key eq $_ } @export_fields) { - delete $svchash->{$key}; - } - } - - my $error = $self->sqlmail_queue( $new->svcnum, 'replace', - $old->svcnum, $self->option('server_type'), $export_table, - (map { ($_, $svchash->{$_}); } keys(%$svchash))); - return $error if $error; - ''; - -} - -sub _export_delete { - my( $self, $svc ) = (shift, shift); - - my $svcdb = $svc->cust_svc->part_svc->svcdb; - my $table = $self->option($svcdb . '_table') - or die('Export table not defined for svcdb: ' . $svcdb); - - $self->sqlmail_queue( $svc->svcnum, 'delete', $table, - $svc->svcnum ); -} - -sub sqlmail_queue { - my( $self, $svcnum, $method ) = (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( $server_type, $table ) = (shift, shift); - - my %attrs = @_; - - map { $attrs{$_} = $attrs{$_} ? qq!'$attrs{$_}'! : 'NULL'; } keys(%attrs); - my $query = sprintf("INSERT INTO %s (%s) values (%s)", - $table, join(",", keys(%attrs)), - join(',', values(%attrs))); - - $dbh->do($query) or die $dbh->errstr; - $dbh->disconnect; - - ''; -} - -sub sqlmail_delete { #subroutine, not method - my $dbh = sqlmail_connect(shift, shift, shift); - my( $table, $svcnum ) = @_; - - $dbh->do("DELETE FROM $table WHERE svcnum = $svcnum") or die $dbh->errstr; - $dbh->disconnect; - - ''; -} - -sub sqlmail_replace { - my $dbh = sqlmail_connect(shift, shift, shift); - my($oldsvcnum, $server_type, $table) = (shift, shift, shift); - - my %attrs = @_; - map { $attrs{$_} = $attrs{$_} ? qq!'$attrs{$_}'! : 'NULL'; } keys(%attrs); - - my $query = "SELECT COUNT(*) FROM $table WHERE svcnum = $oldsvcnum"; - my $result = $dbh->selectrow_arrayref($query) or die $dbh->errstr; - - if (@$result[0] == 0) { - $query = sprintf("INSERT INTO %s (%s) values (%s)", - $table, join(",", keys(%attrs)), - join(',', values(%attrs))); - $dbh->do($query) or die $dbh->errstr; - } else { - $query = sprintf('UPDATE %s SET %s WHERE svcnum = %s', - $table, join(', ', map {"$_ = $attrs{$_}"} keys(%attrs)), - $oldsvcnum); - $dbh->do($query) or die $dbh->errstr; - } - - $dbh->disconnect; - - ''; -} - -sub sqlmail_connect { - DBI->connect(@_) or die $DBI::errstr; -} - -sub update_values { - - # Update records to conform to a particular server_type. - - my ($self, $svc, $svcdb) = (shift,shift,shift); - my $svchash = { %{$svc->hashref} } or return ''; # We need a copy. - - if ($svcdb eq 'svc_acct') { - if ($self->option('server_type') eq 'courier_crypt') { - my $salt = join '', ('.', '/', 0..9,'A'..'Z', 'a'..'z')[rand 64, rand 64]; - $svchash->{_password} = crypt($svchash->{_password}, $salt); - - } elsif ($self->option('server_type') eq 'dovecot_plain') { - $svchash->{_password} = '{PLAIN}' . $svchash->{_password}; - - } elsif ($self->option('server_type') eq 'dovecot_crypt') { - my $salt = join '', ('.', '/', 0..9,'A'..'Z', 'a'..'z')[rand 64, rand 64]; - $svchash->{_password} = '{CRYPT}' . crypt($svchash->{_password}, $salt); - - } elsif ($self->option('server_type') eq 'dovecot_digest_md5') { - my $svc_domain = qsearchs('svc_domain', { svcnum => $svc->domsvc }); - die('Unable to lookup svc_domain with domsvc: ' . $svc->domsvc) - unless ($svc_domain); - - my $domain = $svc_domain->domain; - my $md5hash = '{DIGEST-MD5}' . md5_hex(join(':', $svchash->{username}, - $domain, $svchash->{_password})); - $svchash->{_password} = $md5hash; - } - } elsif ($svcdb eq 'svc_forward') { - if ($self->option('resolve_dstsvc') && $svc->dstsvc_acct) { - $svchash->{dst} = $svc->dstsvc_acct->username . '@' . - $svc->dstsvc_acct->svc_domain->domain; - } - } - - return($svchash); - -} - -1; - diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm deleted file mode 100644 index 10bccb0..0000000 --- a/FS/FS/part_export/sqlradius.pm +++ /dev/null @@ -1,552 +0,0 @@ -package FS::part_export::sqlradius; - -use vars qw(@ISA $DEBUG %info %options $notes1 $notes2); -use Tie::IxHash; -use FS::Record qw( dbh qsearch ); -use FS::part_export; -use FS::svc_acct; -use FS::export_svc; - -@ISA = qw(FS::part_export); - -$DEBUG = 0; - -tie %options, 'Tie::IxHash', - 'datasrc' => { label=>'DBI data source ' }, - 'username' => { label=>'Database username' }, - 'password' => { label=>'Database password' }, - 'ignore_accounting' => { - type => 'checkbox', - label => 'Ignore accounting records from this database' - }, - 'hide_ip' => { - type => 'checkbox', - label => 'Hide IP address information on session reports', - }, - 'hide_data' => { - type => 'checkbox', - label => 'Hide download/upload information on session reports', - }, - 'show_called_station' => { - type => 'checkbox', - label => 'Show the Called-Station-ID on session reports', - }, -; - -$notes1 = <<'END'; -Real-time export of <b>radcheck</b>, <b>radreply</b> and <b>usergroup</b> -tables to any SQL database for -<a href="http://www.freeradius.org/">FreeRADIUS</a> -or <a href="http://radius.innercite.com/">ICRADIUS</a>. -END - -$notes2 = <<'END'; -An existing RADIUS database will be updated in realtime, but you can use -<a href="../docs/man/bin/freeside-sqlradius-reset">freeside-sqlradius-reset</a> -to delete the entire RADIUS database and repopulate the tables from the -Freeside database. See the -<a href="http://search.cpan.org/dist/DBI/DBI.pm#connect">DBI documentation</a> -and the -<a href="http://search.cpan.org/search?mode=module&query=DBD%3A%3A">documentation for your DBD</a> -for the exact syntax of a DBI data source. -<ul> - <li>Using FreeRADIUS 0.9.0 with the PostgreSQL backend, the db_postgresql.sql schema and postgresql.conf queries contain incompatible changes. This is fixed in 0.9.1. Only new installs with 0.9.0 and PostgreSQL are affected - upgrades and other database backends and versions are unaffected. - <li>Using ICRADIUS, add a dummy "op" column to your database: - <blockquote><code> - ALTER TABLE radcheck ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='<br> - ALTER TABLE radreply ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='<br> - ALTER TABLE radgroupcheck ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='<br> - ALTER TABLE radgroupreply ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '==' - </code></blockquote> - <li>Using Radiator, see the - <a href="http://www.open.com.au/radiator/faq.html#38">Radiator FAQ</a> - for configuration information. -</ul> -END - -%info = ( - 'svc' => 'svc_acct', - 'desc' => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS)', - 'options' => \%options, - 'nodomain' => 'Y', - 'notes' => $notes1. - 'This export does not export RADIUS realms (see also '. - 'sqlradius_withdomain). '. - $notes2 -); - -sub rebless { shift; } - -sub export_username { - my($self, $svc_acct) = (shift, shift); - warn "export_username called on $self with arg $svc_acct" if $DEBUG; - $svc_acct->username; -} - -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, $self->export_username($svc_acct), %attrib ); - return $err_or_queue unless ref($err_or_queue); - } - my @groups = $svc_acct->radius_groups; - if ( @groups ) { - my $err_or_queue = $self->sqlradius_queue( - $svc_acct->svcnum, 'usergroup_insert', - $self->export_username($svc_acct), @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 ( $self->export_username($old) ne $self->export_username($new) ) { - my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'rename', - $self->export_username($new), $self->export_username($old) ); - 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, $self->export_username($new), %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, $self->export_username($new), @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', - $self->export_username($new), @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', - $self->export_username($new), @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', - $self->export_username($svc_acct) ); - 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 ( UserName, Attribute, op, Value ) ". - "VALUES ( ?, ?, ?, ? )" - ) or die $dbh->errstr; - $i_sth->execute( - $username, - $attribute, - ( $attribute =~ /Password/i ? '==' : ':=' ), - $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 ( 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; -} - -#-- - -=item usage_sessions TIMESTAMP_START TIMESTAMP_END [ SVC_ACCT [ IP [ PREFIX [ SQL_SELECT ] ] ] ] - -TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see -L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion -functions. - -SVC_ACCT, if specified, limits the results to the specified account. - -IP, if specified, limits the results to the specified IP address. - -PREFIX, if specified, limits the results to records with a matching -Called-Station-ID. - -#SQL_SELECT defaults to * if unspecified. It can be useful to set it to -#SUM(acctsessiontime) or SUM(AcctInputOctets), etc. - -Returns an arrayref of hashrefs with the following fields: - -=over 4 - -=item username - -=item framedipaddress - -=item acctstarttime - -=item acctstoptime - -=item acctsessiontime - -=item acctinputoctets - -=item acctoutputoctets - -=item calledstationid - -=back - -=cut - -#some false laziness w/cust_svc::seconds_since_sqlradacct - -sub usage_sessions { - my( $self, $start, $end ) = splice(@_, 0, 3); - my $svc_acct = @_ ? shift : ''; - my $ip = @_ ? shift : ''; - my $prefix = @_ ? shift : ''; - #my $select = @_ ? shift : '*'; - - $end ||= 2147483647; - - return [] if $self->option('ignore_accounting'); - - my $dbh = sqlradius_connect( map $self->option($_), - qw( datasrc username password ) ); - - #select a unix time conversion function based on database type - my $str2time; - if ( $dbh->{Driver}->{Name} =~ /^mysql(PP)?$/ ) { - $str2time = 'UNIX_TIMESTAMP('; - } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) { - $str2time = 'EXTRACT( EPOCH FROM '; - } else { - warn "warning: unknown database type ". $dbh->{Driver}->{Name}. - "; guessing how to convert to UNIX timestamps"; - $str2time = 'extract(epoch from '; - } - - my @fields = ( - qw( username realm framedipaddress - acctsessiontime acctinputoctets acctoutputoctets - calledstationid - ), - "$str2time acctstarttime ) as acctstarttime", - "$str2time acctstoptime ) as acctstoptime", - ); - - my @param = (); - my $where = ''; - - if ( $svc_acct ) { - my $username = $self->export_username($svc_acct); - if ( $svc_acct =~ /^([^@]+)\@([^@]+)$/ ) { - $where = '( UserName = ? OR ( UserName = ? AND Realm = ? ) ) AND'; - push @param, $username, $1, $2; - } else { - $where = 'UserName = ? AND'; - push @param, $username; - } - } - - if ( length($ip) ) { - $where .= ' FramedIPAddress = ? AND'; - push @param, $ip; - } - - if ( length($prefix) ) { - #assume sip: for now, else things get ugly trying to match /^\w+:$prefix/ - $where .= " CalledStationID LIKE 'sip:$prefix\%' AND"; - } - - push @param, $start, $end; - - my $sth = $dbh->prepare('SELECT '. join(', ', @fields). - " FROM radacct - WHERE $where - $str2time AcctStopTime ) >= ? - AND $str2time AcctStopTime ) <= ? - ORDER BY AcctStartTime DESC - ") or die $dbh->errstr; - $sth->execute(@param) or die $sth->errstr; - - [ map { { %$_ } } @{ $sth->fetchall_arrayref({}) } ]; - -} - -=item update_svc_acct - -=cut - -sub update_svc_acct { - my $self = shift; - - my $dbh = sqlradius_connect( map $self->option($_), - qw( datasrc username password ) ); - - my @fields = qw( radacctid username realm acctsessiontime ); - - my @param = (); - my $where = ''; - - my $sth = $dbh->prepare(" - SELECT RadAcctId, UserName, Realm, AcctSessionTime - FROM radacct - WHERE FreesideStatus IS NULL - AND AcctStopTime != 0 - ") or die $dbh->errstr; - $sth->execute() or die $sth->errstr; - - while ( my $row = $sth->fetchrow_arrayref ) { - my($RadAcctId, $UserName, $Realm, $AcctSessionTime) = @$row; - warn "processing record: ". - "$RadAcctId ($UserName\@$Realm for ${AcctSessionTime}s" - if $DEBUG; - - my %search = ( 'username' => $UserName ); - my $extra_sql = ''; - if ( ref($self) =~ /withdomain/ ) { #well... - $extra_sql = " AND '$Realm' = ( SELECT domain FROM svc_domain - WHERE svc_domain.svcnum = svc_acct.domsvc ) "; - my $svc_domain = qsearch - } - - my @svc_acct = - grep { qsearch( 'export_svc', { 'exportnum' => $self->exportnum, - 'svcpart' => $_->cust_svc->svcpart, } ) - } - qsearch( 'svc_acct', - { 'username' => $UserName }, - '', - $extra_sql - ); - - my $errinfo = "for RADIUS detail RadAcctID $RadAcctId ". - "(UserName $UserName, Realm $Realm)"; - my $status = 'skipped'; - if ( !@svc_acct ) { - warn "WARNING: no svc_acct record found $errinfo - skipping\n"; - } elsif ( scalar(@svc_acct) > 1 ) { - warn "WARNING: multiple svc_acct records found $errinfo - skipping\n"; - } else { - my $svc_acct = $svc_acct[0]; - warn "found svc_acct ". $svc_acct->svcnum. " $errinfo\n" if $DEBUG; - if ( $svc_acct->seconds !~ /^$/ ) { - warn " svc_acct.seconds found (". $svc_acct->seconds. - ") - decrementing\n" - if $DEBUG; - my $error = $svc_acct->decrement_seconds($AcctSessionTime); - die $error if $error; - $status = 'done'; - } else { - warn " no existing seconds value for svc_acct - skiping\n" if $DEBUG; - } - } - - warn "setting FreesideStatus to $status $errinfo\n" if $DEBUG; - my $psth = $dbh->prepare("UPDATE radacct - SET FreesideStatus = ? - WHERE RadAcctId = ?" - ) or die $dbh->errstr; - $psth->execute($status, $RadAcctId) or die $psth->errstr; - - } - -} - -1; - diff --git a/FS/FS/part_export/sqlradius_withdomain.pm b/FS/FS/part_export/sqlradius_withdomain.pm deleted file mode 100644 index e5a7151..0000000 --- a/FS/FS/part_export/sqlradius_withdomain.pm +++ /dev/null @@ -1,28 +0,0 @@ -package FS::part_export::sqlradius_withdomain; - -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::part_export::sqlradius; - -tie my %options, 'Tie::IxHash', %FS::part_export::sqlradius::options; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS) with realms', - 'options' => \%options, - 'nodomain' => '', - 'notes' => $FS::part_export::sqlradius::notes1. - 'This export exports domains to RADIUS realms (see also '. - 'sqlradius). '. - $FS::part_export::sqlradius::notes2 -); - -@ISA = qw(FS::part_export::sqlradius); - -sub export_username { - my($self, $svc_acct) = (shift, shift); - $svc_acct->email; -} - -1; - diff --git a/FS/FS/part_export/sysvshell.pm b/FS/FS/part_export/sysvshell.pm deleted file mode 100644 index 244c3bf..0000000 --- a/FS/FS/part_export/sysvshell.pm +++ /dev/null @@ -1,25 +0,0 @@ -package FS::part_export::sysvshell; - -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::part_export::passwdfile; - -@ISA = qw(FS::part_export::passwdfile); - -tie my %options, 'Tie::IxHash', %FS::part_export::passwdfile::options; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => - 'Batch export of /etc/passwd and /etc/shadow files (Linux, Solaris)', - 'options' => \%options, - 'nodomain' => 'Y', - 'notes' => <<'END' -MD5 crypt requires installation of -<a href="http://search.cpan.org/dist/Crypt-PasswdMD5">Crypt::PasswdMD5</a> -from CPAN. Run bin/sysvshell.export to export the files. -END -); - -1; - diff --git a/FS/FS/part_export/textradius.pm b/FS/FS/part_export/textradius.pm deleted file mode 100644 index 65936ea..0000000 --- a/FS/FS/part_export/textradius.pm +++ /dev/null @@ -1,191 +0,0 @@ -package FS::part_export::textradius; - -use vars qw(@ISA %info $prefix); -use Fcntl qw(:flock); -use Tie::IxHash; -use FS::UID qw(datasrc); -use FS::part_export; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'user' => { label=>'Remote username', default=>'root' }, - 'users' => { label=>'users file location', default=>'/etc/raddb/users' }, -; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => - 'Real-time export to a text /etc/raddb/users file (Livingston, Cistron)', - 'options' => \%options, - 'notes' => <<'END' -This will edit a text RADIUS users file in place on a remote server. -Requires installation of -<a href="http://search.cpan.org/dist/RADIUS-UserFile">RADIUS::UserFile</a> -from CPAN. If using RADIUS::UserFile 1.01, make sure to apply -<a href="http://rt.cpan.org/NoAuth/Bug.html?id=1210">this patch</a>. Also -make sure <a href="http://rsync.samba.org/">rsync</a> is installed on the -remote machine, and <a href="../docs/ssh.html">SSH is setup for unattended -operation</a>. -END -); - -$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; - -} - -1; - diff --git a/FS/FS/part_export/vpopmail.pm b/FS/FS/part_export/vpopmail.pm deleted file mode 100644 index 0fc8266..0000000 --- a/FS/FS/part_export/vpopmail.pm +++ /dev/null @@ -1,254 +0,0 @@ -package FS::part_export::vpopmail; - -use vars qw(@ISA %info @saltset $exportdir); -use Fcntl qw(:flock); -use Tie::IxHash; -use File::Path; -use FS::UID qw( datasrc ); -use FS::part_export; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - #'machine' => { label=>'vpopmail machine', }, - 'dir' => { label=>'directory', }, # ?more info? default? - 'uid' => { label=>'vpopmail uid' }, - 'gid' => { label=>'vpopmail gid' }, - 'restart' => { label=> 'vpopmail restart command', - default=> 'cd /home/vpopmail/domains; for domain in *; do /home/vpopmail/bin/vmkpasswd $domain; done; /var/qmail/bin/qmail-newu; killall -HUP qmail-send', - }, -; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => 'Real-time export to vpopmail text files', - 'options' => \%options, - 'notes' => <<'END' -This export is currently unmaintained. See shellcommands_withdomain for an -export that uses vpopmail CLI commands instead.<BR> -<BR> -Real time export to <a href="http://inter7.com/vpopmail/">vpopmail</a> text -files. <a href="http://search.cpan.org/dist/File-Rsync">File::Rsync</a> -must be installed, and you will need to -<a href="../docs/ssh.html">setup SSH for unattended operation</a> -to <b>vpopmail</b>@<i>export.host</i>. -END -); - -@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); - -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, - $svc_acct->quota, - $svc_acct->finger, - ); -} - -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, $new->quota, $new->finger ); -} - -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; - mkdir $exportdir, 0700 or die $! unless -d $exportdir; - $exportdir .= "/vpopmail"; - mkdir $exportdir, 0700 or die $! unless -d $exportdir; - $exportdir .= '/'. $self->machine; - mkdir $exportdir, 0700 or die $! unless -d $exportdir; - mkdir "$exportdir/domains", 0700 or die $! unless -d "$exportdir/domains"; - - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::vpopmail::vpopmail_$method", - }; - $queue->insert( - $exportdir, - $self->machine, - $self->option('dir'), - $self->option('uid'), - $self->option('gid'), - $self->option('restart'), - @_ - ); -} - -sub vpopmail_insert { #subroutine, not method - my( $exportdir, $machine, $dir, $uid, $gid, $restart ) = splice @_,0,6; - my( $username, $password, $domain, $quota, $finger ) = @_; - - mkdir "$exportdir/domains/$domain", 0700 or die $! - unless -d "$exportdir/domains/$domain"; - - (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', - $finger, - "$dir/domains/$domain/$username", - $quota ? $quota.'S' : 'NOQUOTA', - ), "\n"; - - flock(VPASSWD,LOCK_UN); - close(VPASSWD); - - for my $mkdir ( - grep { ! -d $_ } 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, $restart ); - -} - -sub vpopmail_replace { #subroutine, not method - my( $exportdir, $machine, $dir, $uid, $gid, $restart ) = splice @_,0,6; - my( $username, $password, $domain, $quota, $finger ) = @_; - - (open(VPASSWD, "$exportdir/domains/$domain/vpasswd") - and flock(VPASSWD,LOCK_EX) - ) 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 (<VPASSWD>) { - my ($mailbox, $pw, $vuid, $vgid, $vfinger, $vdir, $vquota, @rest) = - split(':', $_); - if ( $username ne $mailbox ) { - print VPASSWDTMP $_; - next - } - print VPASSWDTMP join (':', - $mailbox, - $password, - '1', - '0', - $finger, - "$dir/domains/$domain/$username", #$vdir - $quota ? $quota.'S' : 'NOQUOTA', - ), "\n"; - } - - 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, $restart ); - -} - -sub vpopmail_delete { #subroutine, not method - my( $exportdir, $machine, $dir, $uid, $gid, $restart ) = splice @_,0,6; - 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 (<VPASSWD>) { - 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, $restart ); -} - -sub vpopmail_sync { - my( $exportdir, $machine, $dir, $uid, $gid, $restart ) = splice @_,0,6; - - chdir $exportdir; -# my @args = ( $rsync, "-rlpt", "-e", $ssh, "domains/", -# "vpopmail\@$machine:$dir/domains/" ); -# system {$args[0]} @args; - - eval "use File::Rsync;"; - die $@ if $@; - - my $rsync = File::Rsync->new({ rsh => 'ssh' }); - - $rsync->exec( { - recursive => 1, - perms => 1, - times => 1, - src => "$exportdir/domains/", - dest => "vpopmail\@$machine:$dir/domains/", - } ); # true/false return value from exec is not working, alas - if ( $rsync->err ) { - die "error uploading to vpopmail\@$machine:$dir/domains/ : ". - 'exit status: '. $rsync->status. ', '. - 'STDERR: '. join(" / ", $rsync->err). ', '. - 'STDOUT: '. join(" / ", $rsync->out); - } - - eval "use Net::SSH qw(ssh);"; - die $@ if $@; - - ssh("vpopmail\@$machine", $restart) if $restart; -} - -1; - diff --git a/FS/FS/part_export/www_shellcommands.pm b/FS/FS/part_export/www_shellcommands.pm deleted file mode 100644 index 9d3564e..0000000 --- a/FS/FS/part_export/www_shellcommands.pm +++ /dev/null @@ -1,167 +0,0 @@ -package FS::part_export::www_shellcommands; - -use strict; -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::part_export; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'user' => { label=>'Remote username', default=>'root' }, - 'useradd' => { label=>'Insert command', - default=>'mkdir $homedir/$zone; chown $username $homedir/$zone; ln -s $homedir/$zone /var/www/$zone', - }, - 'userdel' => { label=>'Delete command', - default=>'[ -n "$zone" ] && rm -rf /var/www/$zone; rm -rf $homedir/$zone', - }, - 'usermod' => { label=>'Modify command', - default=>'[ -n "$old_zone" ] && rm /var/www/$old_zone; [ "$old_zone" != "$new_zone" -a -n "$new_zone" ] && ( mv $old_homedir/$old_zone $new_homedir/$new_zone; ln -sf $new_homedir/$new_zone /var/www/$new_zone ); [ "$old_username" != "$new_username" ] && chown -R $new_username $new_homedir/$new_zone; ln -sf $new_homedir/$new_zone /var/www/$new_zone', - }, -; - -%info = ( - 'svc' => 'svc_www', - 'desc' => 'Run remote commands via SSH, for virtual web sites (directory maintenance, FrontPage, ISPMan)', - 'options' => \%options, - 'notes' => <<'END' -Run remote commands via SSH, for virtual web sites. You will need to -<a href="../docs/ssh.html">setup SSH for unattended operation</a>. -<BR><BR>Use these buttons for some useful presets: -<UL> - <LI> - <INPUT TYPE="button" VALUE="Maintain directories" onClick=' - this.form.user.value = "root"; - this.form.useradd.value = "mkdir $homedir/$zone; chown $username $homedir/$zone; ln -s $homedir/$zone /var/www/$zone"; - this.form.userdel.value = "[ -n \"$zone\" ] && rm -rf /var/www/$zone; rm -rf $homedir/$zone"; - this.form.usermod.value = "[ -n \"$old_zone\" ] && rm /var/www/$old_zone; [ \"$old_zone\" != \"$new_zone\" -a -n \"$new_zone\" ] && ( mv $old_homedir/$old_zone $new_homedir/$new_zone; ln -sf $new_homedir/$new_zone /var/www/$new_zone ); [ \"$old_username\" != \"$new_username\" ] && chown -R $new_username $new_homedir/$new_zone; ln -sf $new_homedir/$new_zone /var/www/$new_zone"; - '> - <LI> - <INPUT TYPE="button" VALUE="FrontPage extensions" onClick=' - this.form.user.value = "root"; - this.form.useradd.value = "/usr/local/frontpage/version5.0/bin/owsadm.exe -o install -p 80 -m $zone -xu $username -xg www-data -s /etc/apache/httpd.conf -u $username -pw $_password"; - this.form.userdel.value = "/usr/local/frontpage/version5.0/bin/owsadm.exe -o uninstall -p 80 -m $zone -s /etc/apache/httpd.conf"; - this.form.usermod.value = ""; - '> - <LI> - <INPUT TYPE="button" VALUE="ISPMan CLI" onClick=' - this.form.user.value = "root"; - this.form.useradd.value = "/usr/local/ispman/bin/ispman.addvhost -d $domain $bare_zone"; - this.form.userdel.value = "/usr/local/ispman/bin/ispman.deletevhost -d $domain $bare_zone"; - this.form.usermod.value = ""; - '></UL> -The following variables are available for interpolation (prefixed with -<code>new_</code> or <code>old_</code> for replace operations): -<UL> - <LI><code>$zone</code> - fully-qualified zone of this virtual host - <LI><code>$bare_zone</code> - just the zone of this virtual host, without the domain portion - <LI><code>$domain</code> - base domain - <LI><code>$username</code> - <LI><code>$homedir</code> - <LI>All other fields in <a href="../docs/schema.html#svc_www">svc_www</a> - are also available. -</UL> -END -); - - -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); - return '' if $command =~ /^\s*$/; - - #set variable for the command - no strict 'vars'; - { - no strict 'refs'; - ${$_} = $svc_www->getfield($_) foreach $svc_www->fields; - } - my $domain_record = $svc_www->domain_record; # or die ? - my $zone = $domain_record->zone; # or die ? - my $domain = $domain_record->svc_domain->domain; - ( my $bare_zone = $zone ) =~ s/\.$domain$//; - my $svc_acct = $svc_www->svc_acct; # or die ? - my $username = $svc_acct->username; - my $_password = $svc_acct->_password; - 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 'vars'; - { - 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->zone; # or die ? - my $old_domain = $old_domain_record->svc_domain->domain; - ( my $old_bare_zone = $old_zone ) =~ s/\.$old_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->zone; # or die ? - my $new_domain = $new_domain_record->svc_domain->domain; - ( my $new_bare_zone = $new_zone ) =~ s/\.$new_domain$//; - my $new_svc_acct = $new->svc_acct; # or die ? - my $new_username = $new_svc_acct->username; - #my $new__password = $new_svc_acct->_password; - 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.08'; - &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 e759404..0000000 --- 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<FS::part_export>) - -=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<hash> 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_foreign_key('exportnum', 'part_export', '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? - - $self->SUPER::check; -} - -=back - -=head1 BUGS - -Possibly. - -=head1 SEE ALSO - -L<FS::part_export>, L<FS::Record>, 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 9de27f8..0000000 --- a/FS/FS/part_pkg.pm +++ /dev/null @@ -1,830 +0,0 @@ -package FS::part_pkg; - -use strict; -use vars qw( @ISA %plans $DEBUG ); -use Carp qw(carp cluck confess); -use Tie::IxHash; -use FS::Conf; -use FS::Record qw( qsearch qsearchs dbh dbdef ); -use FS::pkg_svc; -use FS::part_svc; -use FS::cust_pkg; -use FS::agent_type; -use FS::type_pkgs; -use FS::part_pkg_option; -use FS::pkg_class; - -@ISA = qw( FS::Record ); # FS::option_Common ); # this can use option_Common - # when all the plandata bs is - # gone - -$DEBUG = 0; - -=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 package definition. FS::part_pkg -inherits from FS::Record. The following fields are currently supported: - -=over 4 - -=item pkgpart - primary key (assigned automatically for new package definitions) - -=item pkg - Text name of this package definition (customer-viewable) - -=item comment - Text name of this package definition (non-customer-viewable) - -=item classnum - Optional package class (see L<FS::pkg_class>) - -=item promo_code - Promotional code - -=item setup - Setup fee expression (deprecated) - -=item freq - Frequency of recurring fee - -=item recur - Recurring fee expression (deprecated) - -=item setuptax - Setup fee tax exempt flag, empty or `Y' - -=item recurtax - Recurring fee tax exempt flag, empty or `Y' - -=item taxclass - Tax class - -=item plan - Price plan - -=item plandata - Price plan data (deprecated - see L<FS::part_pkg_option> instead) - -=item disabled - Disabled flag, empty or `Y' - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new package definition. To add the package definition to -the database, see L<"insert">. - -=cut - -sub table { 'part_pkg'; } - -=item clone - -An alternate constructor. Creates a new package definition by duplicating -an existing definition. A new pkgpart is assigned and `(CUSTOM) ' is prepended -to the comment field. To add the package 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 [ , OPTION => VALUE ... ] - -Adds this package definition to the database. If there is an error, -returns the error, otherwise returns false. - -Currently available options are: I<pkg_svc>, I<primary_svc>, I<cust_pkg>, -I<custnum_ref> and I<options>. - -If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as -values, appropriate FS::pkg_svc records will be inserted. - -If I<primary_svc> is set to the svcpart of the primary service, the appropriate -FS::pkg_svc record will be updated. - -If I<cust_pkg> is set to a pkgnum of a FS::cust_pkg record (or the FS::cust_pkg -record itself), the object will be updated to point to this package definition. - -In conjunction with I<cust_pkg>, if I<custnum_ref> is set to a scalar reference, -the scalar will be updated with the custnum value from the cust_pkg record. - -If I<options> is set to a hashref of options, appropriate FS::part_pkg_option -records will be inserted. - -=cut - -sub insert { - my $self = shift; - my %options = @_; - warn "FS::part_pkg::insert called on $self with options ". - join(', ', map "$_=>$options{$_}", keys %options) - if $DEBUG; - - 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; - - warn " saving legacy plandata" if $DEBUG; - my $plandata = $self->get('plandata'); - $self->set('plandata', ''); - - warn " inserting part_pkg record" if $DEBUG; - my $error = $self->SUPER::insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - if ( $plandata ) { - - warn " inserting part_pkg_option records for plandata" if $DEBUG; - foreach my $part_pkg_option ( - map { /^(\w+)=(.*)$/ or do { $dbh->rollback if $oldAutoCommit; - return "illegal plandata: $plandata"; - }; - new FS::part_pkg_option { - 'pkgpart' => $self->pkgpart, - 'optionname' => $1, - 'optionvalue' => $2, - }; - } - split("\n", $plandata) - ) { - my $error = $part_pkg_option->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - } elsif ( $options{'options'} ) { - - warn " inserting part_pkg_option records for options hashref" if $DEBUG; - foreach my $optionname ( keys %{$options{'options'}} ) { - - my $part_pkg_option = - new FS::part_pkg_option { - 'pkgpart' => $self->pkgpart, - 'optionname' => $optionname, - 'optionvalue' => $options{'options'}->{$optionname}, - }; - - my $error = $part_pkg_option->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - } - - } - - my $conf = new FS::Conf; - if ( $conf->exists('agent_defaultpkg') ) { - warn " agent_defaultpkg set; allowing all agents to purchase package" - if $DEBUG; - 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; - } - } - } - - warn " inserting pkg_svc records" if $DEBUG; - my $pkg_svc = $options{'pkg_svc'} || {}; - foreach my $part_svc ( qsearch('part_svc', {} ) ) { - my $quantity = $pkg_svc->{$part_svc->svcpart} || 0; - my $primary_svc = - ( $options{'primary_svc'} && $options{'primary_svc'}==$part_svc->svcpart ) - ? 'Y' - : ''; - - my $pkg_svc = new FS::pkg_svc( { - 'pkgpart' => $self->pkgpart, - 'svcpart' => $part_svc->svcpart, - 'quantity' => $quantity, - 'primary_svc' => $primary_svc, - } ); - my $error = $pkg_svc->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - if ( $options{'cust_pkg'} ) { - warn " updating cust_pkg record " if $DEBUG; - my $old_cust_pkg = - ref($options{'cust_pkg'}) - ? $options{'cust_pkg'} - : qsearchs('cust_pkg', { pkgnum => $options{'cust_pkg'} } ); - ${ $options{'custnum_ref'} } = $old_cust_pkg->custnum - if $options{'custnum_ref'}; - my %hash = $old_cust_pkg->hash; - $hash{'pkgpart'} = $self->pkgpart, - my $new_cust_pkg = new FS::cust_pkg \%hash; - local($FS::cust_pkg::disable_agentcheck) = 1; - my $error = $new_cust_pkg->replace($old_cust_pkg); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Error modifying cust_pkg record: $error"; - } - } - - warn " commiting transaction" if $DEBUG; - $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 [ , OPTION => VALUE ... ] - -Replaces OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -Currently available options are: I<pkg_svc> and I<primary_svc> - -If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as -values, the appropriate FS::pkg_svc records will be replace. - -If I<primary_svc> is set to the svcpart of the primary service, the appropriate -FS::pkg_svc record will be updated. - -=cut - -sub replace { - my( $new, $old ) = ( shift, shift ); - my %options = @_; - warn "FS::part_pkg::replace called on $new to replace $old ". - "with options %options" - if $DEBUG; - - 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; - - warn " saving legacy plandata" if $DEBUG; - my $plandata = $new->get('plandata'); - $new->set('plandata', ''); - - warn " deleting old part_pkg_option records" if $DEBUG; - foreach my $part_pkg_option ( $old->part_pkg_option ) { - my $error = $part_pkg_option->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - warn " replacing part_pkg record" if $DEBUG; - my $error = $new->SUPER::replace($old); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - warn " inserting part_pkg_option records for plandata" if $DEBUG; - foreach my $part_pkg_option ( - map { /^(\w+)=(.*)$/ or do { $dbh->rollback if $oldAutoCommit; - return "illegal plandata: $plandata"; - }; - new FS::part_pkg_option { - 'pkgpart' => $new->pkgpart, - 'optionname' => $1, - 'optionvalue' => $2, - }; - } - split("\n", $plandata) - ) { - my $error = $part_pkg_option->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - warn " replacing pkg_svc records" if $DEBUG; - my $pkg_svc = $options{'pkg_svc'} || {}; - foreach my $part_svc ( qsearch('part_svc', {} ) ) { - my $quantity = $pkg_svc->{$part_svc->svcpart} || 0; - my $primary_svc = $options{'primary_svc'} == $part_svc->svcpart ? 'Y' : ''; - - my $old_pkg_svc = qsearchs('pkg_svc', { - 'pkgpart' => $old->pkgpart, - 'svcpart' => $part_svc->svcpart, - } ); - my $old_quantity = $old_pkg_svc ? $old_pkg_svc->quantity : 0; - my $old_primary_svc = - ( $old_pkg_svc && $old_pkg_svc->dbdef_table->column('primary_svc') ) - ? $old_pkg_svc->primary_svc - : ''; - next unless $old_quantity != $quantity || $old_primary_svc ne $primary_svc; - - my $new_pkg_svc = new FS::pkg_svc( { - 'pkgsvcnum' => ( $old_pkg_svc ? $old_pkg_svc->pkgsvcnum : '' ), - 'pkgpart' => $new->pkgpart, - 'svcpart' => $part_svc->svcpart, - 'quantity' => $quantity, - 'primary_svc' => $primary_svc, - } ); - my $error = $old_pkg_svc - ? $new_pkg_svc->replace($old_pkg_svc) - : $new_pkg_svc->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - warn " commiting transaction" if $DEBUG; - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; -} - -=item check - -Checks all fields to make sure this is a valid package 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; - warn "FS::part_pkg::check called on $self" if $DEBUG; - - for (qw(setup recur plandata)) { - #$self->set($_=>0) if $self->get($_) =~ /^\s*$/; } - return "Use of $_ field is deprecated; set a plan and options" - if length($self->get($_)); - $self->set($_, ''); - } - - if ( $self->dbdef_table->column('freq')->type =~ /(int)/i ) { - my $error = $self->ut_number('freq'); - return $error if $error; - } else { - $self->freq =~ /^(\d+[hdw]?)$/ - or return "Illegal or empty freq: ". $self->freq; - $self->freq($1); - } - - my $error = $self->ut_numbern('pkgpart') - || $self->ut_text('pkg') - || $self->ut_text('comment') - || $self->ut_textn('promo_code') - || $self->ut_alphan('plan') - || $self->ut_enum('setuptax', [ '', 'Y' ] ) - || $self->ut_enum('recurtax', [ '', 'Y' ] ) - || $self->ut_textn('taxclass') - || $self->ut_enum('disabled', [ '', 'Y' ] ) - || $self->SUPER::check - ; - return $error if $error; - - if ( $self->classnum !~ /^$/ ) { - my $error = $self->ut_foreign_key('classnum', 'pkg_class', 'classnum'); - return $error if $error; - } else { - $self->classnum(''); - } - - return 'Unknown plan '. $self->plan - unless exists($plans{$self->plan}); - - my $conf = new FS::Conf; - return 'Taxclass is required' - if ! $self->taxclass && $conf->exists('require_taxclasses'); - - ''; -} - -=item pkg_class - -Returns the package class, as an FS::pkg_class object, or the empty string -if there is no package class. - -=cut - -sub pkg_class { - my $self = shift; - if ( $self->classnum ) { - qsearchs('pkg_class', { 'classnum' => $self->classnum } ); - } else { - return ''; - } -} - -=item classname - -Returns the package class name, or the empty string if there is no package -class. - -=cut - -sub classname { - my $self = shift; - my $pkg_class = $self->pkg_class; - $pkg_class - ? $pkg_class->classname - : ''; -} - -=item pkg_svc - -Returns all FS::pkg_svc objects (see L<FS::pkg_svc>) for this package -definition (with non-zero quantity). - -=cut - -sub pkg_svc { - my $self = shift; - #sort { $b->primary cmp $a->primary } - grep { $_->quantity } - qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } ); -} - -=item svcpart [ SVCDB ] - -Returns the svcpart of the primary service definition (see L<FS::part_svc>) -associated with this package definition (see L<FS::pkg_svc>). Returns -false if there not a primary service definition or 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 = scalar(@_) ? shift : ''; - my @svcdb_pkg_svc = - grep { ( $svcdb eq $_->part_svc->svcdb || !$svcdb ) } $self->pkg_svc; - my @pkg_svc = (); - @pkg_svc = grep { $_->primary_svc =~ /^Y/i } @svcdb_pkg_svc - if dbdef->table('pkg_svc')->column('primary_svc'); - @pkg_svc = grep {$_->quantity == 1 } @svcdb_pkg_svc - unless @pkg_svc; - return '' if scalar(@pkg_svc) != 1; - $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 is free, the single item B<BILL> is -returned, otherwise, the single item B<CARD> is returned. - -(CHEK? LEC? Probably shouldn't accept those by default, prone to abuse) - -=cut - -sub payby { - my $self = shift; - if ( $self->is_free ) { - ( 'BILL' ); - } else { - ( 'CARD' ); - } -} - -=item is_free - -Returns true if this package is free. - -=cut - -sub is_free { - my $self = shift; - unless ( $self->plan ) { - $self->setup =~ /^\s*0+(\.0*)?\s*$/ - && $self->recur =~ /^\s*0+(\.0*)?\s*$/; - } elsif ( $self->can('is_free_options') ) { - not grep { $_ !~ /^\s*0*(\.0*)?\s*$/ } - map { $self->option($_) } - $self->is_free_options; - } else { - warn "FS::part_pkg::is_free: FS::part_pkg::". $self->plan. " subclass ". - "provides neither is_free_options nor is_free method; returning false"; - 0; - } -} - - -sub freqs_href { - #method, class method or sub? #my $self = shift; - - tie my %freq, 'Tie::IxHash', - '0' => '(no recurring fee)', - '1h' => 'hourly', - '1d' => 'daily', - '1w' => 'weekly', - '2w' => 'biweekly (every 2 weeks)', - '1' => 'monthly', - '2' => 'bimonthly (every 2 months)', - '3' => 'quarterly (every 3 months)', - '6' => 'semiannually (every 6 months)', - '12' => 'annually', - '24' => 'biannually (every 2 years)', - '36' => 'triannually (every 3 years)', - '48' => '(every 4 years)', - '60' => '(every 5 years)', - '120' => '(every 10 years)', - ; - - \%freq; - -} - -=item freq_pretty - -Returns an english representation of the I<freq> field, such as "monthly", -"weekly", "semi-annually", etc. - -=cut - -sub freq_pretty { - my $self = shift; - my $freq = $self->freq; - - #my $freqs_href = $self->freqs_href; - my $freqs_href = freqs_href(); - - if ( exists($freqs_href->{$freq}) ) { - $freqs_href->{$freq}; - } else { - my $interval = 'month'; - if ( $freq =~ /^(\d+)([hdw])$/ ) { - my %interval = ( 'h' => 'hour', 'd'=>'day', 'w'=>'week' ); - $interval = $interval{$2}; - } - if ( $1 == 1 ) { - "every $interval"; - } else { - "every $freq ${interval}s"; - } - } -} - -=item plandata - -For backwards compatibility, returns the plandata field as well as all options -from FS::part_pkg_option. - -=cut - -sub plandata { - my $self = shift; - carp "plandata is deprecated"; - if ( @_ ) { - $self->SUPER::plandata(@_); - } else { - my $plandata = $self->get('plandata'); - my %options = $self->options; - $plandata .= join('', map { "$_=$options{$_}\n" } keys %options ); - $plandata; - } -} - -=item part_pkg_option - -Returns all options as FS::part_pkg_option objects (see -L<FS::part_pkg_option>). - -=cut - -sub part_pkg_option { - my $self = shift; - qsearch('part_pkg_option', { 'pkgpart' => $self->pkgpart } ); -} - -=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_pkg_option; -} - -=item option OPTIONNAME - -Returns the option value for the given name, or the empty string. - -=cut - -sub option { - my( $self, $opt, $ornull ) = @_; - my $part_pkg_option = - qsearchs('part_pkg_option', { - pkgpart => $self->pkgpart, - optionname => $opt, - } ); - return $part_pkg_option->optionvalue if $part_pkg_option; - my %plandata = map { /^(\w+)=(.*)$/; ( $1 => $2 ); } - split("\n", $self->get('plandata') ); - return $plandata{$opt} if exists $plandata{$opt}; - cluck "WARNING: (pkgpart ". $self->pkgpart. ") Package def option $opt". - "not found in options or plandata!\n" - unless $ornull; - ''; -} - -=item _rebless - -Reblesses the object into the FS::part_pkg::PLAN class (if available), where -PLAN is the object's I<plan> field. There should be better docs -on how to create new price plans, but until then, see L</NEW PLAN CLASSES>. - -=cut - -sub _rebless { - my $self = shift; - my $plan = $self->plan; - unless ( $plan ) { - confess "no price plan found for pkgpart ". $self->pkgpart. "\n" - if $DEBUG; - return $self; - } - return $self if ref($self) =~ /::$plan$/; #already blessed into plan subclass - my $class = ref($self). "::$plan"; - warn "reblessing $self into $class" if $DEBUG; - eval "use $class;"; - die $@ if $@; - bless($self, $class) unless $@; - $self; -} - -#fallbacks that eval the setup and recur fields, for backwards compat - -sub calc_setup { - my $self = shift; - warn 'no price plan class for '. $self->plan. ", eval-ing setup\n"; - $self->_calc_eval('setup', @_); -} - -sub calc_recur { - my $self = shift; - warn 'no price plan class for '. $self->plan. ", eval-ing recur\n"; - $self->_calc_eval('recur', @_); -} - -use vars qw( $sdate @details ); -sub _calc_eval { - #my( $self, $field, $cust_pkg ) = @_; - my( $self, $field, $cust_pkg, $sdateref, $detailsref ) = @_; - *sdate = $sdateref; - *details = $detailsref; - $self->$field() =~ /^(.*)$/ - or die "Illegal $field (pkgpart ". $self->pkgpart. '): '. - $self->$field(). "\n"; - my $prog = $1; - return 0 if $prog =~ /^\s*$/; - my $value = eval $prog; - die $@ if $@; - $value; -} - -#fallback that return 0 for old legacy packages with no plan - -sub calc_remain { 0; } -sub calc_cancel { 0; } - -=back - -=head1 SUBROUTINES - -=over 4 - -=item plan_info - -=cut - -my %info; -foreach my $INC ( @INC ) { - warn "globbing $INC/FS/part_pkg/*.pm\n" if $DEBUG; - foreach my $file ( glob("$INC/FS/part_pkg/*.pm") ) { - warn "attempting to load plan info from $file\n" if $DEBUG; - $file =~ /\/(\w+)\.pm$/ or do { - warn "unrecognized file in $INC/FS/part_pkg/: $file\n"; - next; - }; - my $mod = $1; - my $info = eval "use FS::part_pkg::$mod; ". - "\\%FS::part_pkg::$mod\::info;"; - if ( $@ ) { - die "error using FS::part_pkg::$mod (skipping): $@\n" if $@; - next; - } - unless ( keys %$info ) { - warn "no %info hash found in FS::part_pkg::$mod, skipping\n" - unless $mod =~ /^(passwdfile|null)$/; #hack but what the heck - next; - } - warn "got plan info from FS::part_pkg::$mod: $info\n" if $DEBUG; - if ( exists($info->{'disabled'}) && $info->{'disabled'} ) { - warn "skipping disabled plan FS::part_pkg::$mod" if $DEBUG; - next; - } - $info{$mod} = $info; - } -} - -tie %plans, 'Tie::IxHash', - map { $_ => $info{$_} } - sort { $info{$a}->{'weight'} <=> $info{$b}->{'weight'} } - keys %info; - -sub plan_info { - \%plans; -} - -=back - -=head1 NEW PLAN CLASSES - -A module should be added in FS/FS/part_pkg/ Eventually, an example may be -found in eg/plan_template.pm. Until then, it is suggested that you use the -other modules in FS/FS/part_pkg/ as a guide. - -=head1 BUGS - -The delete method is unimplemented. - -setup and recur semantics are not yet defined (and are implemented in -FS::cust_bill. hmm.). now they're deprecated and need to go. - -plandata should go - -=head1 SEE ALSO - -L<FS::Record>, L<FS::cust_pkg>, L<FS::type_pkgs>, L<FS::pkg_svc>, L<Safe>. -schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/part_pkg/flat.pm b/FS/FS/part_pkg/flat.pm deleted file mode 100644 index bed86cc..0000000 --- a/FS/FS/part_pkg/flat.pm +++ /dev/null @@ -1,81 +0,0 @@ -package FS::part_pkg::flat; - -use strict; -use vars qw(@ISA %info); -#use FS::Record qw(qsearch); -use FS::part_pkg; - -@ISA = qw(FS::part_pkg); - -%info = ( - 'name' => 'Flat rate (anniversary billing)', - 'fields' => { - 'setup_fee' => { 'name' => 'Setup fee for this package', - 'default' => 0, - }, - 'recur_fee' => { 'name' => 'Recurring fee for this package', - 'default' => 0, - }, - 'unused_credit' => { 'name' => 'Credit the customer for the unused portion'. - ' of service at cancellation', - 'type' => 'checkbox', - }, - 'externalid' => { 'name' => 'Optional External ID', - 'default' => '', - }, - }, - 'fieldorder' => [ 'setup_fee', 'recur_fee', 'unused_credit', 'externalid' ], - 'weight' => 10, -); - -sub calc_setup { - my($self, $cust_pkg ) = @_; - $self->option('setup_fee'); -} - -sub calc_recur { - my $self = shift; - $self->base_recur(@_); -} - -sub base_recur { - my($self, $cust_pkg) = @_; - $self->option('recur_fee'); -} - -sub calc_remain { - my ($self, $cust_pkg) = @_; - my $time = time; #should be able to pass this in for credit calculation - my $next_bill = $cust_pkg->getfield('bill') || 0; - my $last_bill = $cust_pkg->last_bill || 0; - return 0 if ! $self->base_recur - || ! $self->option('unused_credit', 1) - || ! $last_bill - || ! $next_bill - || $next_bill < $time; - - my %sec = ( - 'h' => 3600, # 60 * 60 - 'd' => 86400, # 60 * 60 * 24 - 'w' => 604800, # 60 * 60 * 24 * 7 - 'm' => 2629744, # 60 * 60 * 24 * 365.2422 / 12 - ); - - $self->freq =~ /^(\d+)([hdwm]?)$/ - or die 'unparsable frequency: '. $self->freq; - my $freq_sec = $1 * $sec{$2||'m'}; - return 0 unless $freq_sec; - - sprintf("%.2f", $self->base_recur * ( $next_bill - $time ) / $freq_sec ); - -} - -sub is_free_options { - qw( setup_fee recur_fee ); -} - -sub is_prepaid { - 0; #no, we're postpaid -} - -1; diff --git a/FS/FS/part_pkg/flat_comission.pm b/FS/FS/part_pkg/flat_comission.pm deleted file mode 100644 index 442415e..0000000 --- a/FS/FS/part_pkg/flat_comission.pm +++ /dev/null @@ -1,50 +0,0 @@ -package FS::part_pkg::flat_comission; - -use strict; -use vars qw(@ISA %info); -#use FS::Record qw(qsearch qsearchs); -use FS::part_pkg::flat; - -@ISA = qw(FS::part_pkg::flat); - -%info = ( - 'name' => 'Flat rate with recurring commission per (any) active package', - 'fields' => { - 'setup_fee' => { 'name' => 'Setup fee for this package', - 'default' => 0, - }, - 'recur_fee' => { 'name' => 'Recurring fee for this package', - 'default' => 0, - }, - 'unused_credit' => { 'name' => 'Credit the customer for the unused portion'. - ' of service at cancellation', - 'type' => 'checkbox', - }, - 'comission_amount' => { 'name' => 'Commission amount per month (per active package)', - 'default' => 0, - }, - 'comission_depth' => { 'name' => 'Number of layers', - 'default' => 1, - }, - }, - 'fieldorder' => [ 'setup_fee', 'recur_fee', 'unused_credit', 'comission_depth', 'comission_amount' ], - #'setup' => 'what.setup_fee.value', - #'recur' => '\'my $error = $cust_pkg->cust_main->credit( \' + what.comission_amount.value + \' * scalar($cust_pkg->cust_main->referral_cust_pkg(\' + what.comission_depth.value+ \')), "commission" ); die $error if $error; \' + what.recur_fee.value + \';\'', - 'weight' => 62, -); - -sub calc_recur { - my($self, $cust_pkg ) = @_; - - my $amount = $self->option('comission_amount'); - my $num_active = scalar( - $cust_pkg->cust_main->referral_cust_pkg( $self->option('comission_depth') ) - ); - - my $error = $cust_pkg->cust_main->credit( $amount*$num_active, "commission" ); - die $error if $error; - - $self->option('recur_fee'); -} - -1; diff --git a/FS/FS/part_pkg/flat_comission_cust.pm b/FS/FS/part_pkg/flat_comission_cust.pm deleted file mode 100644 index 4abe66a..0000000 --- a/FS/FS/part_pkg/flat_comission_cust.pm +++ /dev/null @@ -1,55 +0,0 @@ -package FS::part_pkg::flat_comission_cust; - -use strict; -use vars qw(@ISA %info); -#use FS::Record qw(qsearch qsearchs); -use FS::part_pkg::flat; - -@ISA = qw(FS::part_pkg::flat); - -%info = ( - 'name' => 'Flat rate with recurring commission per active customer', - 'fields' => { - 'setup_fee' => { 'name' => 'Setup fee for this package', - 'default' => 0, - }, - 'recur_fee' => { 'name' => 'Recurring fee for this package', - 'default' => 0, - }, - 'unused_credit' => { 'name' => 'Credit the customer for the unused portion'. - ' of service at cancellation', - 'type' => 'checkbox', - }, - 'comission_amount' => { 'name' => 'Commission amount per month (per active customer)', - 'default' => 0, - }, - 'comission_depth' => { 'name' => 'Number of layers', - 'default' => 1, - }, - }, - 'fieldorder' => [ 'setup_fee', 'recur_fee', 'unused_credit', 'comission_depth', 'comission_amount' ], - #'setup' => 'what.setup_fee.value', - #'recur' => '\'my $error = $cust_pkg->cust_main->credit( \' + what.comission_amount.value + \' * scalar($cust_pkg->cust_main->referral_cust_main_ncancelled(\' + what.comission_depth.value+ \')), "commission" ); die $error if $error; \' + what.recur_fee.value + \';\'', - 'weight' => '60', -); - -sub calc_recur { - my($self, $cust_pkg ) = @_; - - my $amount = $self->option('comission_amount'); - my $num_active = scalar( - $cust_pkg->cust_main->referral_cust_main_ncancelled( - $self->option('comission_depth') - ) - ); - - if ( $amount && $num_active ) { - my $error = - $cust_pkg->cust_main->credit( $amount*$num_active, "commission" ); - die $error if $error; - } - - $self->option('recur_fee'); -} - -1; diff --git a/FS/FS/part_pkg/flat_comission_pkg.pm b/FS/FS/part_pkg/flat_comission_pkg.pm deleted file mode 100644 index 0f4d02a..0000000 --- a/FS/FS/part_pkg/flat_comission_pkg.pm +++ /dev/null @@ -1,50 +0,0 @@ -package FS::part_pkg::flat_comission_pkg; - -use strict; -use vars qw(@ISA %info); -#use FS::Record qw(qsearch qsearchs); -use FS::part_pkg::flat; - -@ISA = qw(FS::part_pkg::flat); - -%info = ( - 'name' => 'Flat rate with recurring commission per (selected) active package', - 'fields' => { - 'setup_fee' => { 'name' => 'Setup fee for this package', - 'default' => 0, - }, - 'recur_fee' => { 'name' => 'Recurring fee for this package', - 'default' => 0, - }, - 'unused_credit' => { 'name' => 'Credit the customer for the unused portion'. - ' of service at cancellation', - 'type' => 'checkbox', - }, - 'comission_amount' => { 'name' => 'Commission amount per month (per uncancelled package)', - 'default' => 0, - }, - 'comission_depth' => { 'name' => 'Number of layers', - 'default' => 1, - }, - 'comission_pkgpart' => { 'name' => 'Applicable packages<BR><FONT SIZE="-1">(hold <b>ctrl</b> to select multiple packages)</FONT>', - 'type' => 'select_multiple', - 'select_table' => 'part_pkg', - 'select_hash' => { 'disabled' => '' } , - 'select_key' => 'pkgpart', - 'select_label' => 'pkg', - }, - }, - 'fieldorder' => [ 'setup_fee', 'recur_fee', 'unused_credit', 'comission_depth', 'comission_amount', 'comission_pkgpart' ], - #'setup' => 'what.setup_fee.value', - #'recur' => '""; var pkgparts = ""; for ( var c=0; c < document.flat_comission_pkg.comission_pkgpart.options.length; c++ ) { if (document.flat_comission_pkg.comission_pkgpart.options[c].selected) { pkgparts = pkgparts + document.flat_comission_pkg.comission_pkgpart.options[c].value + \', \'; } } what.recur.value = \'my $error = $cust_pkg->cust_main->credit( \' + what.comission_amount.value + \' * scalar( grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } ( \' + pkgparts + \' ) } $cust_pkg->cust_main->referral_cust_pkg(\' + what.comission_depth.value+ \')), "commission" ); die $error if $error; \' + what.recur_fee.value + \';\'', - #'disabled' => 1, - 'weight' => '64', -); - -# XXX this needs to be fixed!!! -sub calc_recur { - my($self, $cust_pkg ) = @_; - $self->option('recur_fee'); -} - -1; diff --git a/FS/FS/part_pkg/flat_delayed.pm b/FS/FS/part_pkg/flat_delayed.pm deleted file mode 100644 index ec11699..0000000 --- a/FS/FS/part_pkg/flat_delayed.pm +++ /dev/null @@ -1,44 +0,0 @@ -package FS::part_pkg::flat_delayed; - -use strict; -use vars qw(@ISA %info); -#use FS::Record qw(qsearch qsearchs); -use FS::part_pkg::flat; - -@ISA = qw(FS::part_pkg::flat); - -%info = ( - 'name' => 'Free (or setup fee) for X days, then flat rate'. - ' (anniversary billing)', - 'fields' => { - 'setup_fee' => { 'name' => 'Setup fee for this package', - 'default' => 0, - }, - 'free_days' => { 'name' => 'Initial free days', - 'default' => 0, - }, - 'recur_fee' => { 'name' => 'Recurring fee for this package', - 'default' => 0, - }, - 'unused_credit' => { 'name' => 'Credit the customer for the unused portion'. - ' of service at cancellation', - 'type' => 'checkbox', - }, - }, - 'fieldorder' => [ 'free_days', 'setup_fee', 'recur_fee', 'unused_credit' ], - #'setup' => '\'my $d = $cust_pkg->bill || $time; $d += 86400 * \' + what.free_days.value + \'; $cust_pkg->bill($d); $cust_pkg_mod_flag=1; \' + what.setup_fee.value', - #'recur' => 'what.recur_fee.value', - 'weight' => 50, -); - -sub calc_setup { - my($self, $cust_pkg, $time ) = @_; - - my $d = $cust_pkg->bill || $time; - $d += 86400 * $self->option('free_days'); - $cust_pkg->bill($d); - - $self->option('setup_fee'); -} - -1; diff --git a/FS/FS/part_pkg/incomplete/billoneday.pm b/FS/FS/part_pkg/incomplete/billoneday.pm deleted file mode 100644 index 8740547..0000000 --- a/FS/FS/part_pkg/incomplete/billoneday.pm +++ /dev/null @@ -1,48 +0,0 @@ -package FS::part_pkg::billoneday; - -use strict; -use vars qw(@ISA %info); -use Time::Local qw(timelocal); -#use FS::Record qw(qsearch qsearchs); -use FS::part_pkg::flat; - -@ISA = qw(FS::part_pkg::flat); - -%info = ( - 'name' => 'charge a full month every (selectable) billing day', - 'fields' => { - 'setup_fee' => { 'name' => 'Setup fee for this package', - 'default' => 0, - }, - 'recur_fee' => { 'name' => 'Recurring fee for this package', - 'default' => 0, - }, - 'cutoff_day' => { 'name' => 'billing day', - 'default' => 1, - }, - - }, - 'fieldorder' => [ 'setup_fee', 'recur_fee','cutoff_day'], - #'setup' => 'what.setup_fee.value', - #'recur' => '\'my $mnow = $sdate; my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($sdate) )[0,1,2,3,4,5]; $sdate = timelocal(0,0,0,$self->option('cutoff_day'),$mon,$year); \' + what.recur_fee.value', - 'freq' => 'm', - 'weight' => 30, -); - -sub calc_recur { - my($self, $cust_pkg, $sdate ) = @_; - - my $mnow = $$sdate; - my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($mnow) )[0,1,2,3,4,5]; - my $mstart = timelocal(0,0,0,$self->option('cutoff_day'),$mon,$year); - my $mend = timelocal(0,0,0,$self->option('cutoff_day'), $mon == 11 ? 0 : $mon+1, $year+($mon==11)); - - if($mday > $self->option('cutoff_date') and $mstart != $mnow ) { - $$sdate = timelocal(0,0,0,$self->option('cutoff_day'), $mon == 11 ? 0 : $mon+1, $year+($mon==11)); - } - else{ - $$sdate = timelocal(0,0,0,$self->option('cutoff_day'), $mon, $year); - } - $self->option('recur_fee'); -} -1; diff --git a/FS/FS/part_pkg/prepaid.pm b/FS/FS/part_pkg/prepaid.pm deleted file mode 100644 index 5e7d2ba..0000000 --- a/FS/FS/part_pkg/prepaid.pm +++ /dev/null @@ -1,28 +0,0 @@ -package FS::part_pkg::prepaid; - -use strict; -use vars qw(@ISA %info); -use FS::part_pkg::flat; - -@ISA = qw(FS::part_pkg::flat); - -%info = ( - 'name' => 'Prepaid, flat rate', - 'fields' => { - 'setup_fee' => { 'name' => 'One-time setup fee for this package', - 'default' => 0, - }, - 'recur_fee' => { 'name' => 'Initial and recharge fee for this package', - 'default' => 0, - } - }, - 'fieldorder' => [ 'setup_fee', 'recur_fee', ], - 'weight' => 25, -); - -sub is_prepaid { - 1; -} - -1; - diff --git a/FS/FS/part_pkg/prorate.pm b/FS/FS/part_pkg/prorate.pm deleted file mode 100644 index e436679..0000000 --- a/FS/FS/part_pkg/prorate.pm +++ /dev/null @@ -1,64 +0,0 @@ -package FS::part_pkg::prorate; - -use strict; -use vars qw(@ISA %info); -use Time::Local qw(timelocal); -#use FS::Record qw(qsearch qsearchs); -use FS::part_pkg::flat; - -@ISA = qw(FS::part_pkg::flat); - -%info = ( - 'name' => 'First partial month pro-rated, then flat-rate (selectable billing day)', - 'fields' => { - 'setup_fee' => { 'name' => 'Setup fee for this package', - 'default' => 0, - }, - 'recur_fee' => { 'name' => 'Recurring fee for this package', - 'default' => 0, - }, - 'unused_credit' => { 'name' => 'Credit the customer for the unused portion'. - ' of service at cancellation', - 'type' => 'checkbox', - }, - 'cutoff_day' => { 'name' => 'billing day', - 'default' => 1, - }, - #it would be better if this had to be turned on, its confusing - 'externalid' => { 'name' => 'Optional External ID', - 'default' => '', - }, - }, - 'fieldorder' => [ 'setup_fee', 'recur_fee', 'unused_credit', 'cutoff_day', - 'externalid', ], - 'freq' => 'm', - 'weight' => 20, -); - -sub calc_recur { - my($self, $cust_pkg, $sdate ) = @_; - my $cutoff_day = $self->option('cutoff_day', 1) || 1; - my $mnow = $$sdate; - my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($mnow) )[0,1,2,3,4,5]; - my $mend; - my $mstart; - - if ( $mday >= $cutoff_day ) { - $mend = - timelocal(0,0,0,$cutoff_day, $mon == 11 ? 0 : $mon+1, $year+($mon==11)); - $mstart = - timelocal(0,0,0,$cutoff_day,$mon,$year); - - } else { - $mend = timelocal(0,0,0,$cutoff_day, $mon, $year); - if ($mon==0) {$mon=11;$year--;} else {$mon--;} - $mstart= timelocal(0,0,0,$cutoff_day,$mon,$year); - } - - $$sdate = $mstart; - my $permonth = $self->option('recur_fee') / $self->freq; - - $permonth * ( ( $self->freq - 1 ) + ($mend-$mnow) / ($mend-$mstart) ); -} - -1; diff --git a/FS/FS/part_pkg/sesmon_hour.pm b/FS/FS/part_pkg/sesmon_hour.pm deleted file mode 100644 index 9843edb..0000000 --- a/FS/FS/part_pkg/sesmon_hour.pm +++ /dev/null @@ -1,56 +0,0 @@ -package FS::part_pkg::sesmon_hour; - -use strict; -use vars qw(@ISA %info); -#use FS::Record qw(qsearch qsearchs); -use FS::part_pkg::flat; - -@ISA = qw(FS::part_pkg::flat); - -%info = ( - 'name' => 'Base charge plus charge per-hour from the session monitor', - 'fields' => { - 'setup_fee' => { 'name' => 'Setup fee for this package', - 'default' => 0, - }, - 'recur_flat' => { 'name' => 'Base recurring fee for this package', - 'default' => 0, - }, - 'unused_credit' => { 'name' => 'Credit the customer for the unused portion'. - ' of service at cancellation', - 'type' => 'checkbox', - }, - 'recur_included_hours' => { 'name' => 'Hours included', - 'default' => 0, - }, - 'recur_hourly_charge' => { 'name' => 'Additional charge per hour', - 'default' => 0, - }, - }, - 'fieldorder' => [ 'setup_fee', 'recur_flat', 'unused_credit', 'recur_included_hours', 'recur_hourly_charge' ], - #'setup' => 'what.setup_fee.value', - #'recur' => '\'my $hours = $cust_pkg->seconds_since($cust_pkg->bill || 0) / 3600 - \' + what.recur_included_hours.value + \'; $hours = 0 if $hours < 0; \' + what.recur_flat.value + \' + \' + what.recur_hourly_charge.value + \' * $hours;\'', - 'weight' => 80, -); - -sub calc_recur { - my($self, $cust_pkg ) = @_; - - my $hours = $cust_pkg->seconds_since($cust_pkg->bill || 0) / 3600; - $hours -= $self->option('recur_included_hours'); - $hours = 0 if $hours < 0; - - $self->option('recur_flat') + $hours * $self->option('recur_hourly_charge'); - -} - -sub is_free_options { - qw( setup_fee recur_fee recur_hourly_charge ); -} - -sub base_recur { - my($self, $cust_pkg) = @_; - $self->option('recur_flat'); -} - -1; diff --git a/FS/FS/part_pkg/sesmon_minute.pm b/FS/FS/part_pkg/sesmon_minute.pm deleted file mode 100644 index 39516f8..0000000 --- a/FS/FS/part_pkg/sesmon_minute.pm +++ /dev/null @@ -1,55 +0,0 @@ -package FS::part_pkg::sesmon_minute; - -use strict; -use vars qw(@ISA %info); -#use FS::Record qw(qsearch qsearchs); -use FS::part_pkg::flat; - -@ISA = qw(FS::part_pkg::flat); - -%info = ( - 'name' => 'Base charge plus charge per-minute from the session monitor', - 'fields' => { - 'setup_fee' => { 'name' => 'Setup fee for this package', - 'default' => 0, - }, - 'recur_flat' => { 'name' => 'Base recurring fee for this package', - 'default' => 0, - }, - 'unused_credit' => { 'name' => 'Credit the customer for the unused portion'. - ' of service at cancellation', - 'type' => 'checkbox', - }, - 'recur_included_min' => { 'name' => 'Minutes included', - 'default' => 0, - }, - 'recur_minly_charge' => { 'name' => 'Additional charge per minute', - 'default' => 0, - }, - }, - 'fieldorder' => [ 'setup_fee', 'recur_flat', 'unused_credit', 'recur_included_min', 'recur_minly_charge' ], - #'setup' => 'what.setup_fee.value', - #'recur' => '\'my $min = $cust_pkg->seconds_since($cust_pkg->bill || 0) / 60 - \' + what.recur_included_min.value + \'; $min = 0 if $min < 0; \' + what.recur_flat.value + \' + \' + what.recur_minly_charge.value + \' * $min;\'', - 'weight' => 80, -); - - -sub calc_recur { - my( $self, $cust_pkg ) = @); - my $min = $cust_pkg->seconds_since($cust_pkg->bill || 0) / 60; - $min -= $self->option('recur_included_min'); - $min = 0 if $min < 0; - - $self->option('recur_flat') + $min * $self->option('recur_minly_charge'); -} - -sub is_free_options { - qw( setup_fee recur_fee recur_minly_charge ); -} - -sub base_recur { - my($self, $cust_pkg) = @_; - $self->option('recur_flat'); -} - -1; diff --git a/FS/FS/part_pkg/sql_external.pm b/FS/FS/part_pkg/sql_external.pm deleted file mode 100644 index ca58c4e..0000000 --- a/FS/FS/part_pkg/sql_external.pm +++ /dev/null @@ -1,76 +0,0 @@ -package FS::part_pkg::sql_external; - -use strict; -use vars qw(@ISA %info); -use DBI; -#use FS::Record qw(qsearch qsearchs); -use FS::part_pkg::flat; - -@ISA = qw(FS::part_pkg::flat); - -%info = ( - 'name' => 'Base charge plus additional fees for external services from a configurable SQL query', - 'fields' => { - 'setup_fee' => { 'name' => 'Setup fee for this package', - 'default' => 0, - }, - 'recur_flat' => { 'name' => 'Base recurring fee for this package', - 'default' => 0, - }, - 'unused_credit' => { 'name' => 'Credit the customer for the unused portion'. - ' of service at cancellation', - 'type' => 'checkbox', - }, - 'datasrc' => { 'name' => 'DBI data source', - 'default' => '', - }, - 'db_username' => { 'name' => 'Database username', - 'default' => '', - }, - 'db_password' => { 'name' => 'Database password', - 'default' => '', - }, - 'query' => { 'name' => 'SQL query', - 'default' => '', - }, - }, - 'fieldorder' => [qw( setup_fee recur_flat unused_credit datasrc db_username db_password query )], - #'setup' => 'what.setup_fee.value', - #'recur' => q!'my $dbh = DBI->connect("' + what.datasrc.value + '", "' + what.db_username.value + '", "' + what.db_password.value + '" ) or die $DBI::errstr; my $sth = $dbh->prepare("' + what.query.value + '") or die $dbh->errstr; my $price = ' + what.recur_flat.value + '; foreach my $cust_svc ( grep { $_->part_svc->svcdb eq "svc_external" } $cust_pkg->cust_svc ){ my $id = $cust_svc->svc_x->id; $sth->execute($id) or die $sth->errstr; $price += $sth->fetchrow_arrayref->[0]; } $price;'!, - 'weight' => '72', -); - -sub calc_recur { - my($self, $cust_pkg ) = @_; - - my $dbh = DBI->connect( map { $self->option($_) } - qw( datasrc db_username db_password ) - ) - or die $DBI::errstr; - - my $sth = $dbh->prepare( $self->option('query') ) - or die $dbh->errstr; - - my $price = $self->option('recur_flat'); - - foreach my $cust_svc ( - grep { $_->part_svc->svcdb eq "svc_external" } $cust_pkg->cust_svc - ) { - my $id = $cust_svc->svc_x->id; - $sth->execute($id) or die $sth->errstr; - $price += $sth->fetchrow_arrayref->[0]; - } - - $price; -} - -sub is_free { - 0; -} - -sub base_recur { - my($self, $cust_pkg) = @_; - $self->option('recur_flat'); -} - -1; diff --git a/FS/FS/part_pkg/sql_generic.pm b/FS/FS/part_pkg/sql_generic.pm deleted file mode 100644 index 0e6ab7c..0000000 --- a/FS/FS/part_pkg/sql_generic.pm +++ /dev/null @@ -1,87 +0,0 @@ -package FS::part_pkg::sql_generic; - -use strict; -use vars qw(@ISA %info); -use DBI; -#use FS::Record qw(qsearch qsearchs); -use FS::part_pkg::flat; - -@ISA = qw(FS::part_pkg::flat); - -%info = ( - 'name' => 'Base charge plus a per-domain metered rate from a configurable SQL query', - 'fields' => { - 'setup_fee' => { 'name' => 'Setup fee for this package', - 'default' => 0, - }, - 'recur_flat' => { 'name' => 'Base recurring fee for this package', - 'default' => 0, - }, - 'unused_credit' => { 'name' => 'Credit the customer for the unused portion'. - ' of service at cancellation', - 'type' => 'checkbox', - }, - 'recur_included' => { 'name' => 'Units included', - 'default' => 0, - }, - 'recur_unit_charge' => { 'name' => 'Additional charge per unit', - 'default' => 0, - }, - 'datasrc' => { 'name' => 'DBI data source', - 'default' => '', - }, - 'db_username' => { 'name' => 'Database username', - 'default' => '', - }, - 'db_password' => { 'name' => 'Database username', - 'default' => '', - }, - 'query' => { 'name' => 'SQL query', - 'default' => '', - }, - }, - 'fieldorder' => [qw( setup_fee recur_flat unused_credit recur_included recur_unit_charge datasrc db_username db_password query )], - # 'setup' => 'what.setup_fee.value', - # 'recur' => '\'my $dbh = DBI->connect(\"\' + what.datasrc.value + \'\", \"\' + what.db_username.value + \'\") or die $DBI::errstr; \'', - #'recur' => '\'my $dbh = DBI->connect(\"\' + what.datasrc.value + \'\", \"\' + what.db_username.value + \'\", \"\' + what.db_password.value + \'\" ) or die $DBI::errstr; my $sth = $dbh->prepare(\"\' + what.query.value + \'\") or die $dbh->errstr; my $units = 0; foreach my $cust_svc ( grep { $_->part_svc->svcdb eq \"svc_domain\" } $cust_pkg->cust_svc ) { my $domain = $cust_svc->svc_x->domain; $sth->execute($domain) or die $sth->errstr; $units += $sth->fetchrow_arrayref->[0]; } $units -= \' + what.recur_included.value + \'; $units = 0 if $units < 0; \' + what.recur_flat.value + \' + $units * \' + what.recur_unit_charge.value + \';\'', - #'recur' => '\'my $dbh = DBI->connect("\' + what.datasrc.value + \'", "\' + what.db_username.value + \'", "\' what.db_password.value + \'" ) or die $DBI::errstr; my $sth = $dbh->prepare("\' + what.query.value + \'") or die $dbh->errstr; my $units = 0; foreach my $cust_svc ( grep { $_->part_svc->svcdb eq "svc_domain" } $cust_pkg->cust_svc ) { my $domain = $cust_svc->svc_x->domain; $sth->execute($domain) or die $sth->errstr; $units += $sth->fetchrow_arrayref->[0]; } $units -= \' + what.recur_included.value + \'; $units = 0 if $units < 0; \' + what.recur_flat.value + \' + $units * \' + what.recur_unit_charge + \';\'', - 'weight' => '70', -); - -sub calc_recur { - my($self, $cust_pkg ) = @_; - - my $dbh = DBI->connect( map { $self->option($_) } - qw( datasrc db_username db_password ) - ) - or die $DBI::errstr; - - my $sth = $dbh->prepare( $self->option('query') ) - or die $dbh->errstr; - - my $units = 0; - foreach my $cust_svc ( - grep { $_->part_svc->svcdb eq "svc_domain" } $cust_pkg->cust_svc - ) { - my $domain = $cust_svc->svc_x->domain; - $sth->execute($domain) or die $sth->errstr; - - $units += $sth->fetchrow_arrayref->[0]; - } - - $units -= $self->option('recur_included'); - $units = 0 if $units < 0; - - $self->option('recur_flat') + $units * $self->option('recur_unit_charge'); -} - -sub is_free_options { - qw( setup_fee recur_flat recur_unit_charge ); -} - -sub base_recur { - my($self, $cust_pkg) = @_; - $self->option('recur_flat'); -} - -1; diff --git a/FS/FS/part_pkg/sqlradacct_hour.pm b/FS/FS/part_pkg/sqlradacct_hour.pm deleted file mode 100644 index e54a8a5..0000000 --- a/FS/FS/part_pkg/sqlradacct_hour.pm +++ /dev/null @@ -1,170 +0,0 @@ -package FS::part_pkg::sqlradacct_hour; - -use strict; -use vars qw(@ISA %info); -#use FS::Record qw(qsearch qsearchs); -use FS::part_pkg::flat; - -@ISA = qw(FS::part_pkg::flat); - -%info = ( - 'name' => 'Base charge plus per-hour (and for data) from an SQL RADIUS radacct table', - 'fields' => { - 'setup_fee' => { 'name' => 'Setup fee for this package', - 'default' => 0, - }, - 'recur_flat' => { 'name' => 'Base recurring fee for this package', - 'default' => 0, - }, - 'unused_credit' => { 'name' => 'Credit the customer for the unused portion'. - ' of service at cancellation', - 'type' => 'checkbox', - }, - - 'recur_included_hours' => { 'name' => 'Hours included', - 'default' => 0, - }, - 'recur_hourly_charge' => { 'name' => 'Additional charge per hour', - 'default' => 0, - }, - 'recur_hourly_cap' => { 'name' => 'Maximum overage charge for hours'. - ' (0 means no cap)', - - 'default' => 0, - }, - - 'recur_included_input' => { 'name' => 'Upload megabytes included', - 'default' => 0, - }, - 'recur_input_charge' => { 'name' => - 'Additional charge per megabyte upload', - 'default' => 0, - }, - 'recur_input_cap' => { 'name' => 'Maximum overage charge for upload'. - ' (0 means no cap)', - 'default' => 0, - }, - - 'recur_included_output' => { 'name' => 'Download megabytes included', - 'default' => 0, - }, - 'recur_output_charge' => { 'name' => - 'Additional charge per megabyte download', - 'default' => 0, - }, - 'recur_output_cap' => { 'name' => 'Maximum overage charge for download'. - ' (0 means no cap)', - 'default' => 0, - }, - - 'recur_included_total' => { 'name' => - 'Total megabytes included', - 'default' => 0, - }, - 'recur_total_charge' => { 'name' => - 'Additional charge per megabyte total', - 'default' => 0, - }, - 'recur_total_cap' => { 'name' => 'Maximum overage charge for total'. - ' megabytes (0 means no cap)', - 'default' => 0, - }, - - 'global_cap' => { 'name' => 'Global cap on all overage charges'. - ' (0 means no cap)', - 'default' => 0, - }, - - }, - 'fieldorder' => [qw( setup_fee recur_flat unused_credit recur_included_hours recur_hourly_charge recur_hourly_cap recur_included_input recur_input_charge recur_input_cap recur_included_output recur_output_charge recur_output_cap recur_included_total recur_total_charge recur_total_cap global_cap )], - #'setup' => 'what.setup_fee.value', - #'recur' => '\'my $last_bill = $cust_pkg->last_bill; my $hours = $cust_pkg->seconds_since_sqlradacct($last_bill, $sdate ) / 3600 - \' + what.recur_included_hours.value + \'; $hours = 0 if $hours < 0; my $input = $cust_pkg->attribute_since_sqlradacct($last_bill, $sdate, \"AcctInputOctets\" ) / 1048576; my $output = $cust_pkg->attribute_since_sqlradacct($last_bill, $sdate, \"AcctOutputOctets\" ) / 1048576; my $total = $input + $output - \' + what.recur_included_total.value + \'; $total = 0 if $total < 0; my $input = $input - \' + what.recur_included_input.value + \'; $input = 0 if $input < 0; my $output = $output - \' + what.recur_included_output.value + \'; $output = 0 if $output < 0; my $totalcharge = sprintf(\"%.2f\", \' + what.recur_total_charge.value + \' * $total); my $inputcharge = sprintf(\"%.2f\", \' + what.recur_input_charge.value + \' * $input); my $outputcharge = sprintf(\"%.2f\", \' + what.recur_output_charge.value + \' * $output); my $hourscharge = sprintf(\"%.2f\", \' + what.recur_hourly_charge.value + \' * $hours); if ( \' + what.recur_total_charge.value + \' > 0 ) { push @details, \"Last month\\\'s data \". sprintf(\"%.1f\", $total). \" megs: \\\$$totalcharge\" } if ( \' + what.recur_input_charge.value + \' > 0 ) { push @details, \"Last month\\\'s download \". sprintf(\"%.1f\", $input). \" megs: \\\$$inputcharge\" } if ( \' + what.recur_output_charge.value + \' > 0 ) { push @details, \"Last month\\\'s upload \". sprintf(\"%.1f\", $output). \" megs: \\\$$outputcharge\" } if ( \' + what.recur_hourly_charge.value + \' > 0 ) { push @details, \"Last month\\\'s time \". sprintf(\"%.1f\", $hours). \" hours: \\\$$hourscharge\"; } \' + what.recur_flat.value + \' + $hourscharge + $inputcharge + $outputcharge + $totalcharge ;\'', - 'weight' => 40, -); - -sub calc_recur { - my($self, $cust_pkg, $sdate, $details ) = @_; - - my $last_bill = $cust_pkg->last_bill; - my $hours = $cust_pkg->seconds_since_sqlradacct($last_bill, $$sdate ) / 3600; - $hours -= $self->option('recur_included_hours'); - $hours = 0 if $hours < 0; - - my $input = $cust_pkg->attribute_since_sqlradacct( $last_bill, - $$sdate, - 'AcctInputOctets' ) - / 1048576; - - my $output = $cust_pkg->attribute_since_sqlradacct( $last_bill, - $$sdate, - 'AcctOutputOctets' ) - / 1048576; - - my $total = $input + $output - $self->option('recur_included_total'); - $total = 0 if $total < 0; - $input = $input - $self->option('recur_included_input'); - $input = 0 if $input < 0; - $output = $output - $self->option('recur_included_output'); - $output = 0 if $output < 0; - - my $totalcharge = - $total * sprintf('%.2f', $self->option('recur_total_charge')); - $totalcharge = $self->option('recur_total_cap') - if $self->option('recur_total_cap') - && $totalcharge > $self->option('recur_total_cap'); - - my $inputcharge = - $input * sprintf('%.2f', $self->option('recur_input_charge')); - $inputcharge = $self->option('recur_input_cap') - if $self->option('recur_input_cap') - && $inputcharge > $self->option('recur_input_cap'); - - my $outputcharge = - $output * sprintf('%.2f', $self->option('recur_output_charge')); - $outputcharge = $self->option('recur_output_cap') - if $self->option('recur_output_cap') - && $outputcharge > $self->option('recur_output_cap'); - - my $hourscharge = - $hours * sprintf('%.2f', $self->option('recur_hourly_charge')); - $hourscharge = $self->option('recur_hours_cap') - if $self->option('recur_hours_cap') - && $hourscharge > $self->option('recur_hours_cap'); - - if ( $self->option('recur_total_charge') > 0 ) { - push @$details, "Last month's data ". - sprintf('%.1f', $total). " megs: $totalcharge"; - } - if ( $self->option('recur_input_charge') > 0 ) { - push @$details, "Last month's download ". - sprintf('%.1f', $input). " megs: $inputcharge"; - } - if ( $self->option('recur_output_charge') > 0 ) { - push @$details, "Last month's upload ". - sprintf('%.1f', $output). " megs: $outputcharge"; - } - if ( $self->option('recur_hourly_charge') > 0 ) { - push @$details, "Last month\'s time ". - sprintf('%.1f', $hours). " hours: $hourscharge"; - } - - my $charges = $hourscharge + $inputcharge + $outputcharge + $totalcharge; - if ( $self->option('global_cap') && $charges > $self->option('global_cap') ) { - $charges = $self->option('global_cap'); - push @$details, "Usage charges capped at: $charges"; - } - - $self->option('recur_flat') + $charges; -} - -sub is_free_options { - qw( setup_fee recur_flat recur_hourly_charge - recur_input_charge recur_output_charge recur_total_charge ); -} - -sub base_recur { - my($self, $cust_pkg) = @_; - $self->option('recur_flat'); -} - -1; diff --git a/FS/FS/part_pkg/subscription.pm b/FS/FS/part_pkg/subscription.pm deleted file mode 100644 index 6b5da5c..0000000 --- a/FS/FS/part_pkg/subscription.pm +++ /dev/null @@ -1,50 +0,0 @@ -package FS::part_pkg::subscription; - -use strict; -use vars qw(@ISA %info); -use Time::Local qw(timelocal); -#use FS::Record qw(qsearch qsearchs); -use FS::part_pkg::flat; - -@ISA = qw(FS::part_pkg::flat); - -%info = ( - 'name' => 'First partial month full charge, then flat-rate (selectable billing day)', - 'fields' => { - 'setup_fee' => { 'name' => 'Setup fee for this package', - 'default' => 0, - }, - 'recur_fee' => { 'name' => 'Recurring fee for this package', - 'default' => 0, - }, - 'cutoff_day' => { 'name' => 'billing day', - 'default' => 1, - }, - #it would be better if this had to be turned on, its confusing - 'externalid' => { 'name' => 'Optional External ID', - 'default' => '', - }, - }, - 'fieldorder' => [ 'setup_fee', 'recur_fee', 'cutoff_day', 'externalid' ], - 'fieldorder' => [ 'setup_fee', 'recur_fee','cutoff_day'], - 'freq' => 'm', - 'weight' => 30, -); - -sub calc_recur { - my($self, $cust_pkg, $sdate ) = @_; - my $cutoff_day = $self->option('cutoff_day', 1) || 1; - my $mnow = $$sdate; - my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($mnow) )[0,1,2,3,4,5]; - - if ( $mday < $cutoff_day ) { - if ($mon==0) {$mon=11;$year--;} - else {$mon--;} - } - - $$sdate = timelocal(0,0,0,$cutoff_day,$mon,$year); - - $self->option('recur_fee'); -} - -1; diff --git a/FS/FS/part_pkg/voip_cdr.pm b/FS/FS/part_pkg/voip_cdr.pm deleted file mode 100644 index 500a1b0..0000000 --- a/FS/FS/part_pkg/voip_cdr.pm +++ /dev/null @@ -1,353 +0,0 @@ -package FS::part_pkg::voip_cdr; - -use strict; -use vars qw(@ISA $DEBUG %info); -use Date::Format; -use Tie::IxHash; -use FS::Conf; -use FS::Record qw(qsearchs qsearch); -use FS::part_pkg::flat; -#use FS::rate; -#use FS::rate_prefix; - -@ISA = qw(FS::part_pkg::flat); - -$DEBUG = 1; - -tie my %rating_method, 'Tie::IxHash', - 'prefix' => 'Rate calls by using destination prefix to look up a region and rate according to the internal prefix and rate tables', - 'upstream' => 'Rate calls based on upstream data: If the call type is "1", map the upstream rate ID directly to an internal rate (rate_detail), otherwise, pass the upstream price through directly.', -; - -#tie my %cdr_location, 'Tie::IxHash', -# 'internal' => 'Internal: CDR records imported into the internal CDR table', -# 'external' => 'External: CDR records queried directly from an external '. -# 'Asterisk (or other?) CDR table', -#; - -%info = ( - 'name' => 'VoIP rating by plan of CDR records in an internal (or external?) SQL table', - 'fields' => { - 'setup_fee' => { 'name' => 'Setup fee for this package', - 'default' => 0, - }, - 'recur_flat' => { 'name' => 'Base recurring fee for this package', - 'default' => 0, - }, - 'unused_credit' => { 'name' => 'Credit the customer for the unused portion'. - ' of service at cancellation', - 'type' => 'checkbox', - }, - 'ratenum' => { 'name' => 'Rate plan', - 'type' => 'select', - 'select_table' => 'rate', - 'select_key' => 'ratenum', - 'select_label' => 'ratename', - }, - 'rating_method' => { 'name' => 'Region rating method', - 'type' => 'select', - 'select_options' => \%rating_method, - }, - - 'default_prefix' => { 'name' => 'Default prefix optionally prepended to customer DID numbers when searching for CDR records', - 'default' => '+1', - }, - - #XXX also have option for an external db?? -# 'cdr_location' => { 'name' => 'CDR database location' -# 'type' => 'select', -# 'select_options' => \%cdr_location, -# 'select_callback' => { -# 'external' => { -# 'enable' => [ 'datasrc', 'username', 'password' ], -# }, -# 'internal' => { -# 'disable' => [ 'datasrc', 'username', 'password' ], -# } -# }, -# }, -# 'datasrc' => { 'name' => 'DBI data source for external CDR table', -# 'disabled' => 'Y', -# }, -# 'username' => { 'name' => 'External database username', -# 'disabled' => 'Y', -# }, -# 'password' => { 'name' => 'External database password', -# 'disabled' => 'Y', -# }, - - }, - 'fieldorder' => [qw( setup_fee recur_flat unused_credit ratenum rating_method default_prefix )], - 'weight' => 40, -); - -sub calc_setup { - my($self, $cust_pkg ) = @_; - $self->option('setup_fee'); -} - -#false laziness w/voip_sqlradacct... resolve it if that one ever gets used again -sub calc_recur { - my($self, $cust_pkg, $sdate, $details, $param ) = @_; - - my $last_bill = $cust_pkg->last_bill; - - my $ratenum = $cust_pkg->part_pkg->option('ratenum'); - - my $spool_cdr = $cust_pkg->cust_main->spool_cdr; - - my %included_min = (); - - my $charges = 0; - - my $downstream_cdr = ''; - - foreach my $cust_svc ( - grep { $_->part_svc->svcdb eq 'svc_phone' } $cust_pkg->cust_svc - ) { - - foreach my $cdr ( - $cust_svc->get_cdrs_for_update() # $last_bill, $$sdate ) - ) { - if ( $DEBUG > 1 ) { - warn "rating CDR $cdr\n". - join('', map { " $_ => ". $cdr->{$_}. "\n" } keys %$cdr ); - } - - my $rate_detail; - my( $rate_region, $regionnum ); - my $pretty_destnum; - my $charge = 0; - my @call_details = (); - if ( $self->option('rating_method') eq 'prefix' - || ! $self->option('rating_method') - ) - { - - ### - # look up rate details based on called station id - # (or calling station id for toll free calls) - ### - - my( $to_or_from, $number ); - if ( $cdr->dst =~ /^(\+?1)?8[02-8]{2}/ ) { #tollfree call - $to_or_from = 'from'; - $number = $cdr->src; - } else { #regular call - $to_or_from = 'to'; - $number = $cdr->dst; - } - - #remove non-phone# stuff and whitespace - $number =~ s/\s//g; -# my $proto = ''; -# $dest =~ s/^(\w+):// and $proto = $1; #sip: -# my $siphost = ''; -# $dest =~ s/\@(.*)$// and $siphost = $1; # @10.54.32.1, @sip.example.com - - #determine the country code - my $countrycode; - if ( $number =~ /^011(((\d)(\d))(\d))(\d+)$/ - || $number =~ /^\+(((\d)(\d))(\d))(\d+)$/ - ) - { - - my( $three, $two, $one, $u1, $u2, $rest ) = ( $1,$2,$3,$4,$5,$6 ); - #first look for 1 digit country code - if ( qsearch('rate_prefix', { 'countrycode' => $one } ) ) { - $countrycode = $one; - $number = $u1.$u2.$rest; - } elsif ( qsearch('rate_prefix', { 'countrycode' => $two } ) ) { #or 2 - $countrycode = $two; - $number = $u2.$rest; - } else { #3 digit country code - $countrycode = $three; - $number = $rest; - } - - } else { - $countrycode = '1'; - $number =~ s/^1//;# if length($number) > 10; - } - - warn "rating call $to_or_from +$countrycode $number\n" if $DEBUG; - $pretty_destnum = "+$countrycode $number"; - - #find a rate prefix, first look at most specific (4 digits) then 3, etc., - # finally trying the country code only - my $rate_prefix = ''; - for my $len ( reverse(1..6) ) { - $rate_prefix = qsearchs('rate_prefix', { - 'countrycode' => $countrycode, - #'npa' => { op=> 'LIKE', value=> substr($number, 0, $len) } - 'npa' => substr($number, 0, $len), - } ) and last; - } - $rate_prefix ||= qsearchs('rate_prefix', { - 'countrycode' => $countrycode, - 'npa' => '', - }); - - # - die "Can't find rate for call $to_or_from +$countrycode $\numbern" - unless $rate_prefix; - - $regionnum = $rate_prefix->regionnum; - $rate_detail = qsearchs('rate_detail', { - 'ratenum' => $ratenum, - 'dest_regionnum' => $regionnum, - } ); - - $rate_region = $rate_prefix->rate_region; - - warn " found rate for regionnum $regionnum ". - "and rate detail $rate_detail\n" - if $DEBUG; - - } elsif ( $self->option('rating_method') eq 'upstream' ) { - - if ( $cdr->cdrtypenum == 1 ) { #rate based on upstream rateid - - $rate_detail = $cdr->cdr_upstream_rate->rate_detail; - - $regionnum = $rate_detail->dest_regionnum; - $rate_region = $rate_detail->dest_region; - - $pretty_destnum = $cdr->dst; - - warn " found rate for regionnum $regionnum and ". - "rate detail $rate_detail\n" - if $DEBUG; - - } else { #pass upstream price through - - $charge = sprintf('%.2f', $cdr->upstream_price); - - @call_details = ( - #time2str("%Y %b %d - %r", $cdr->calldate_unix ), - time2str("%c", $cdr->calldate_unix), #XXX this should probably be a config option dropdown so they can select US vs- rest of world dates or whatnot - 'N/A', #minutes... - '$'.$charge, - #$pretty_destnum, - $cdr->description, #$rate_region->regionname, - ); - - } - - } else { - die "don't know how to rate CDRs using method: ". - $self->option('rating_method'). "\n"; - } - - ### - # find the price and add detail to the invoice - ### - - # if $rate_detail is not found, skip this CDR... i.e. - # don't add it to invoice, don't set its status to NULL, - # don't call downstream_csv or something on it... - # but DO emit a warning... - if ( ! $rate_detail && ! scalar(@call_details) ) { - - warn "no rate_detail found for CDR.acctid: ". $cdr->acctid. - "; skipping\n" - - } else { # there *is* a rate_detail (or call_details), proceed... - - unless ( @call_details ) { - - $included_min{$regionnum} = $rate_detail->min_included - unless exists $included_min{$regionnum}; - - my $granularity = $rate_detail->sec_granularity; - my $seconds = $cdr->billsec; # |ength($cdr->billsec) ? $cdr->billsec : $cdr->duration; - $seconds += $granularity - ( $seconds % $granularity ); - my $minutes = sprintf("%.1f", $seconds / 60); - $minutes =~ s/\.0$// if $granularity == 60; - - $included_min{$regionnum} -= $minutes; - - if ( $included_min{$regionnum} < 0 ) { - my $charge_min = 0 - $included_min{$regionnum}; - $included_min{$regionnum} = 0; - $charge = sprintf('%.2f', $rate_detail->min_charge * $charge_min ); - $charges += $charge; - } - - # this is why we need regionnum/rate_region.... - warn " (rate region $rate_region)\n" if $DEBUG; - - @call_details = ( - #time2str("%Y %b %d - %r", $cdr->calldate_unix ), - time2str("%c", $cdr->calldate_unix), #XXX this should probably be a config option dropdown so they can select US vs- rest of world dates or whatnot - $minutes.'m', - '$'.$charge, - $pretty_destnum, - $rate_region->regionname, - ); - - } - - warn " adding details on charge to invoice: ". - join(' - ', @call_details ) - if $DEBUG; - - push @$details, join(' - ', @call_details); #\@call_details, - - # if the customer flag is on, call "downstream_csv" or something - # like it to export the call downstream! - # XXX price plan option to pick format, or something... - $downstream_cdr .= $cdr->downstream_csv( 'format' => 'convergent' ) - if $spool_cdr; - - my $error = $cdr->set_status_and_rated_price('done', $charge); - die $error if $error; - - } - - } # $cdr - - } # $cust_svc - - if ( $spool_cdr && length($downstream_cdr) ) { - - use FS::UID qw(datasrc); - my $dir = '/usr/local/etc/freeside/export.'. datasrc. '/cdr'; - mkdir $dir, 0700 unless -d $dir; - $dir .= '/'. $cust_pkg->custnum. - mkdir $dir, 0700 unless -d $dir; - my $filename = time2str("$dir/CDR%Y%m%d-spool.CSV", time); #XXX invoice date instead? would require changing the order things are generated in cust_main::bill insert cust_bill first - with transactions it could be done though - - push @{ $param->{'precommit_hooks'} }, - sub { - #lock the downstream spool file and append the records - use Fcntl qw(:flock); - use IO::File; - my $spool = new IO::File ">>$filename" - or die "can't open $filename: $!\n"; - flock( $spool, LOCK_EX) - or die "can't lock $filename: $!\n"; - seek($spool, 0, 2) - or die "can't seek to end of $filename: $!\n"; - print $spool $downstream_cdr; - flock( $spool, LOCK_UN ); - close $spool; - }; - - } #if ( $spool_cdr && length($downstream_cdr) ) - - $self->option('recur_flat') + $charges; - -} - -sub is_free { - 0; -} - -sub base_recur { - my($self, $cust_pkg) = @_; - $self->option('recur_flat'); -} - -1; - diff --git a/FS/FS/part_pkg/voip_sqlradacct.pm b/FS/FS/part_pkg/voip_sqlradacct.pm deleted file mode 100644 index bf18003..0000000 --- a/FS/FS/part_pkg/voip_sqlradacct.pm +++ /dev/null @@ -1,192 +0,0 @@ -package FS::part_pkg::voip_sqlradacct; - -use strict; -use vars qw(@ISA $DEBUG %info); -use Date::Format; -use FS::Record qw(qsearchs qsearch); -use FS::part_pkg::flat; -#use FS::rate; -use FS::rate_prefix; - -@ISA = qw(FS::part_pkg::flat); - -$DEBUG = 1; - -%info = ( - 'name' => 'VoIP rating by plan of CDR records in an SQL RADIUS radacct table', - 'fields' => { - 'setup_fee' => { 'name' => 'Setup fee for this package', - 'default' => 0, - }, - 'recur_flat' => { 'name' => 'Base recurring fee for this package', - 'default' => 0, - }, - 'unused_credit' => { 'name' => 'Credit the customer for the unused portion'. - ' of service at cancellation', - 'type' => 'checkbox', - }, - 'ratenum' => { 'name' => 'Rate plan', - 'type' => 'select', - 'select_table' => 'rate', - 'select_key' => 'ratenum', - 'select_label' => 'ratename', - }, - }, - 'fieldorder' => [qw( setup_fee recur_flat unused_credit ratenum ignore_unrateable )], - 'weight' => 40, -); - -sub calc_setup { - my($self, $cust_pkg ) = @_; - $self->option('setup_fee'); -} - -#false laziness w/voip_cdr... resolve it if this one ever gets used again -sub calc_recur { - my($self, $cust_pkg, $sdate, $details ) = @_; - - my $last_bill = $cust_pkg->last_bill; - - my $ratenum = $cust_pkg->part_pkg->option('ratenum'); - - my %included_min = (); - - my $charges = 0; - - foreach my $cust_svc ( - grep { $_->part_svc->svcdb eq 'svc_acct' } $cust_pkg->cust_svc - ) { - - foreach my $session ( - $cust_svc->get_session_history( $last_bill, $$sdate ) - ) { - if ( $DEBUG > 1 ) { - warn "rating session $session\n". - join('', map { " $_ => ". $session->{$_}. "\n" } keys %$session ); - } - - ### - # look up rate details based on called station id - ### - - my $dest = $session->{'calledstationid'}; - - #remove non-phone# stuff and whitespace - $dest =~ s/\s//g; - my $proto = ''; - $dest =~ s/^(\w+):// and $proto = $1; #sip: - my $siphost = ''; - $dest =~ s/\@(.*)$// and $siphost = $1; # @10.54.32.1, @sip.example.com - - #determine the country code - my $countrycode; - if ( $dest =~ /^011(((\d)(\d))(\d))(\d+)$/ ) { - - my( $three, $two, $one, $u1, $u2, $rest ) = ( $1, $2, $3, $4, $5, $6 ); - #first look for 1 digit country code - if ( qsearch('rate_prefix', { 'countrycode' => $one } ) ) { - $countrycode = $one; - $dest = $u1.$u2.$rest; - } elsif ( qsearch('rate_prefix', { 'countrycode' => $two } ) ) { #or 2 - $countrycode = $two; - $dest = $u2.$rest; - } else { #3 digit country code - $countrycode = $three; - $dest = $rest; - } - - } else { - $countrycode = '1'; - $dest =~ s/^1//;# if length($dest) > 10; - } - - warn "rating call to +$countrycode $dest\n" if $DEBUG; - - #find a rate prefix, first look at most specific (4 digits) then 3, etc., - # finally trying the country code only - my $rate_prefix = ''; - for my $len ( reverse(1..6) ) { - $rate_prefix = qsearchs('rate_prefix', { - 'countrycode' => $countrycode, - #'npa' => { op=> 'LIKE', value=> substr($dest, 0, $len) } - 'npa' => substr($dest, 0, $len), - } ) and last; - } - $rate_prefix ||= qsearchs('rate_prefix', { - 'countrycode' => $countrycode, - 'npa' => '', - }); - - die "Can't find rate for call to +$countrycode $dest\n" - unless $rate_prefix; - - my $regionnum = $rate_prefix->regionnum; - my $rate_detail = qsearchs('rate_detail', { - 'ratenum' => $ratenum, - 'dest_regionnum' => $regionnum, - } ); - - warn " found rate for regionnum $regionnum ". - "and rate detail $rate_detail\n" - if $DEBUG; - - ### - # find the price and add detail to the invoice - ### - - $included_min{$regionnum} = $rate_detail->min_included - unless exists $included_min{$regionnum}; - - my $granularity = $rate_detail->sec_granularity; - my $seconds = $session->{'acctsessiontime'}; - $seconds += $granularity - ( $seconds % $granularity ); - my $minutes = sprintf("%.1f", $seconds / 60); - $minutes =~ s/\.0$// if $granularity == 60; - - $included_min{$regionnum} -= $minutes; - - my $charge = 0; - if ( $included_min{$regionnum} < 0 ) { - my $charge_min = 0 - $included_min{$regionnum}; - $included_min{$regionnum} = 0; - $charge = sprintf('%.2f', $rate_detail->min_charge * $charge_min ); - $charges += $charge; - } - - my $rate_region = $rate_prefix->rate_region; - warn " (rate region $rate_region)\n" if $DEBUG; - - my @call_details = ( - #time2str("%Y %b %d - %r", $session->{'acctstarttime'}), - time2str("%c", $session->{'acctstarttime'}), - $minutes.'m', - '$'.$charge, - "+$countrycode $dest", - $rate_region->regionname, - ); - - warn " adding details on charge to invoice: ". - join(' - ', @call_details ) - if $DEBUG; - - push @$details, join(' - ', @call_details); #\@call_details, - - } # $session - - } # $cust_svc - - $self->option('recur_flat') + $charges; - -} - -sub is_free { - 0; -} - -sub base_recur { - my($self, $cust_pkg) = @_; - $self->option('recur_flat'); -} - -1; - diff --git a/FS/FS/part_pkg_option.pm b/FS/FS/part_pkg_option.pm deleted file mode 100644 index c2f609e..0000000 --- a/FS/FS/part_pkg_option.pm +++ /dev/null @@ -1,131 +0,0 @@ -package FS::part_pkg_option; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); -use FS::part_pkg; - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::part_pkg_option - Object methods for part_pkg_option records - -=head1 SYNOPSIS - - use FS::part_pkg_option; - - $record = new FS::part_pkg_option \%hash; - $record = new FS::part_pkg_option { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::part_pkg_option object represents an package definition option. -FS::part_pkg_option inherits from FS::Record. The following fields are -currently supported: - -=over 4 - -=item optionnum - primary key - -=item pkgpart - package definition (see L<FS::part_pkg>) - -=item optionname - option name - -=item optionvalue - option value - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new package definition option. To add the package definition 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<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'part_pkg_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 package definition 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_foreign_key('pkgpart', 'part_pkg', 'pkgpart') - || $self->ut_alpha('optionname') - || $self->ut_anything('optionvalue') - ; - return $error if $error; - - #check options & values? - - $self->SUPER::check; -} - -=back - -=head1 BUGS - -Possibly. - -=head1 SEE ALSO - -L<FS::part_pkg>, L<FS::Record>, 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 01c59df..0000000 --- a/FS/FS/part_pop_local.pm +++ /dev/null @@ -1,113 +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<FS::svc_acct_pop>) 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<FS::svc_acct_pop> - -=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') - or $self->SUPER::check - ; - -} - -=back - -=head1 BUGS - -US/CA-centric. - -=head1 SEE ALSO - -L<FS::Record>, L<FS::svc_acct_pop>, 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 87bc87c..0000000 --- a/FS/FS/part_referral.pm +++ /dev/null @@ -1,204 +0,0 @@ -package FS::part_referral; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs dbh ); -use FS::agent; - -@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 - -=item disabled - Disabled flag, empty or 'Y' - -=item agentnum - Optional agentnum (see L<FS::agent>) - -=back - -=head1 NOTE - -These were called B<referrals> 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; - - my $error = $self->ut_numbern('refnum') - || $self->ut_text('referral') - || $self->ut_enum('disabled', [ '', 'Y' ] ) - #|| $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum') - || $self->ut_agentnum_acl('agentnum', 'Edit global advertising sources') - ; - return $error if $error; - - $self->SUPER::check; -} - -=item agent - -Returns the associated agent for this referral, if any, as an FS::agent object. - -=cut - -sub agent { - my $self = shift; - qsearchs('agent', { 'agentnum' => $self->agentnum } ); -} - -=back - -=head1 CLASS METHODS - -=over 4 - -=item acl_agentnum_sql [ INCLUDE_GLOBAL_BOOL ] - -Returns an SQL fragment for searching for part_referral records allowed by the -current users's agent ACLs (and "Edit global advertising sources" right). - -Pass a true value to include global advertising sources (for example, when -simply using rather than editing advertising sources). - -=cut - -sub acl_agentnum_sql { - my $self = shift; - - my $curuser = $FS::CurrentUser::CurrentUser; - my $sql = $curuser->agentnums_sql; - $sql = " ( $sql OR agentnum IS NULL ) " - if $curuser->access_right('Edit global advertising sources') - or defined($_[0]) && $_[0]; - - $sql; - -} - -=item all_part_referral [ INCLUDE_GLOBAL_BOOL ] - -Returns all part_referral records allowed by the current users's agent ACLs -(and "Edit global advertising sources" right). - -Pass a true value to include global advertising sources (for example, when -simply using rather than editing advertising sources). - -=cut - -sub all_part_referral { - my $self = shift; - - qsearch({ - 'table' => 'part_referral', - 'extra_sql' => ' WHERE '. $self->acl_agentnum_sql(@_). ' ORDER BY refnum ', - }); - -} - -=item num_part_referral [ INCLUDE_GLOBAL_BOOL ] - -Returns the number of part_referral records allowed by the current users's -agent ACLs (and "Edit global advertising sources" right). - -=cut - -sub num_part_referral { - my $self = shift; - - my $sth = dbh->prepare( - 'SELECT COUNT(*) FROM part_referral WHERE '. $self->acl_agentnum_sql(@_) - ) or die dbh->errstr; - $sth->execute() or die $sth->errstr; - $sth->fetchrow_arrayref->[0]; -} - -=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<FS::Record>, L<FS::cust_main>, 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 2587347..0000000 --- a/FS/FS/part_svc.pm +++ /dev/null @@ -1,662 +0,0 @@ -package FS::part_svc; - -use strict; -use vars qw( @ISA $DEBUG ); -use FS::Record qw( qsearch qsearchs fields dbh ); -use FS::Schema qw( dbdef ); -use FS::part_svc_column; -use FS::part_export; -use FS::export_svc; -use FS::cust_svc; - -@ISA = qw(FS::Record); - -$DEBUG = 1; - -=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 = $record->insert( [ 'pseudofield' ] ); - $error = $record->insert( [ 'pseudofield' ], \%exportnums ); - - $error = $new_record->replace($old_record); - $error = $new_record->replace($old_record, '1.3-COMPAT', [ 'pseudofield' ] ); - $error = $new_record->replace($old_record, '1.3-COMPAT', [ 'pseudofield' ], \%exportnums ); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::part_svc represents a service definition. FS::part_svc inherits from -FS::Record. The following fields are currently supported: - -=over 4 - -=item svcpart - primary key (assigned automatically for new service definitions) - -=item svc - text name of this service definition - -=item svcdb - table used for this service. See L<FS::svc_acct>, -L<FS::svc_domain>, and L<FS::svc_forward>, 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 [ , EXPORTNUMS_HASHREF [ , JOB ] ] ] - -Adds this service definition to the database. If there is an error, returns -the error, otherwise returns false. - -The following pseudo-fields may be defined, and will be maintained in -the part_svc_column table appropriately (see L<FS::part_svc_column>). - -=over 4 - -=item I<svcdb>__I<field> - Default or fixed value for I<field> in I<svcdb>. - -=item I<svcdb>__I<field>_flag - defines I<svcdb>__I<field> action: null or empty (no default), `D' for default, `F' for fixed (unchangeable), `M' for manual selection from inventory, or `A' for automatic selection from inventory. For virtual fields, can also be 'X' for excluded. - -=back - -If you want to add part_svc_column records for fields that do not exist as -(real or virtual) fields in the I<svcdb> table, make sure to list then in -EXTRA_FIELDS_ARRAYREF also. - -If EXPORTNUMS_HASHREF is specified (keys are exportnums and values are -boolean), the appopriate export_svc records will be inserted. - -TODOC: JOB - -=cut - -sub insert { - my $self = shift; - my @fields = (); - my @exportnums = (); - @fields = @{shift(@_)} if @_; - if ( @_ ) { - my $exportnums = shift; - @exportnums = grep $exportnums->{$_}, keys %$exportnums; - } - my $job = ''; - $job = 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; - } - - # add part_svc_column records - - 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) =~ /^([DFMAX])$/ ) { - if ( uc($flag) =~ /^([A-Z])$/ ) { #part_svc_column will test it - $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; - } - - } - - # add export_svc records - my $slice = 100/scalar(@exportnums) if @exportnums; - my $done = 0; - foreach my $exportnum ( @exportnums ) { - my $export_svc = new FS::export_svc ( { - 'exportnum' => $exportnum, - 'svcpart' => $self->svcpart, - } ); - $error = $export_svc->insert($job, $slice*$done++, $slice); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; -} - -=item delete - -Currently unimplemented. Set the "disabled" field instead. - -=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 [ , EXPORTNUMS_HASHREF [ , JOB ] ] ] ] - -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 (same as insert method) - -TODOC: JOB - -=cut - -sub replace { - my ( $new, $old ) = ( shift, shift ); - my $compat = ''; - my @fields = (); - my $exportnums; - my $job = ''; - if ( @_ && $_[0] eq '1.3-COMPAT' ) { - shift; - $compat = '1.3'; - @fields = @{shift(@_)} if @_; - $exportnums = @_ ? shift : ''; - $job = shift if @_; - } else { - return 'non-1.3-COMPAT interface not yet written'; - #not yet implemented - } - - 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 ( $compat eq '1.3' ) { - - # maintain part_svc_column records - - 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) =~ /^([DFMAX])$/ ) { - if ( uc($flag) =~ /^([A-Z])$/ ) { #part_svc_column will test it - $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; - } - } - - # maintain export_svc records - - if ( $exportnums ) { - - #false laziness w/ edit/process/agent_type.cgi - my @new_export_svc = (); - foreach my $part_export ( qsearch('part_export', {}) ) { - my $exportnum = $part_export->exportnum; - my $hashref = { - 'exportnum' => $exportnum, - 'svcpart' => $new->svcpart, - }; - my $export_svc = qsearchs('export_svc', $hashref); - - if ( $export_svc && ! $exportnums->{$exportnum} ) { - $error = $export_svc->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } elsif ( ! $export_svc && $exportnums->{$exportnum} ) { - push @new_export_svc, new FS::export_svc ( $hashref ); - } - - } - - my $slice = 100/scalar(@new_export_svc) if @new_export_svc; - my $done = 0; - foreach my $export_svc (@new_export_svc) { - $error = $export_svc->insert($job, $slice*$done++, $slice); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - if ( $job ) { - $error = $job->update_statustext( int( $slice * $done ) ); - 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 $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( $self->svcdb ) }; #might die - return "Unknown svcdb: ". $self->svcdb. " (Error: $@)" - unless @fields; - - $self->SUPER::check; -} - -=item part_svc_column COLUMNNAME - -Returns the part_svc_column object (see L<FS::part_svc_column>) for the given -COLUMNNAME, or a new part_svc_column object if none exists. - -=cut - -sub part_svc_column { - my( $self, $columnname) = @_; - $self->svcpart && - qsearchs('part_svc_column', { - 'svcpart' => $self->svcpart, - 'columnname' => $columnname, - } - ) or new FS::part_svc_column { - 'svcpart' => $self->svcpart, - 'columnname' => $columnname, - }; -} - -=item all_part_svc_column - -=cut - -sub all_part_svc_column { - my $self = shift; - qsearch('part_svc_column', { 'svcpart' => $self->svcpart } ); -} - -=item part_export [ EXPORTTYPE ] - -Returns a list of all exports (see L<FS::part_export>) for this service, or, -if an export type is specified, only returns exports of the given type. - -=cut - -sub part_export { - my $self = shift; - my %search; - $search{'exporttype'} = shift if @_; - map { qsearchs('part_export', { 'exportnum' => $_->exportnum, %search } ) } - qsearch('export_svc', { 'svcpart' => $self->svcpart } ); -} - -=item part_export_usage - -Returns a list of any exports (see L<FS::part_export>) for this service that -are capable of reporting usage information. - -=cut - -sub part_export_usage { - my $self = shift; - grep $_->can('usage_sessions'), $self->part_export; -} - -=item cust_svc [ PKGPART ] - -Returns a list of associated customer services (FS::cust_svc records). - -If a PKGPART is specified, returns the customer services which are contained -within packages of that type (see L<FS::part_pkg>). If PKGPARTis specified as -B<0>, returns unlinked customer services. - -=cut - -sub cust_svc { - my $self = shift; - - my $hashref = { 'svcpart' => $self->svcpart }; - - my( $addl_from, $extra_sql ) = ( '', '' ); - if ( @_ ) { - my $pkgpart = shift; - if ( $pkgpart =~ /^(\d+)$/ ) { - $addl_from = 'LEFT JOIN cust_pkg USING ( pkgnum )'; - $extra_sql = "AND pkgpart = $1"; - } elsif ( $pkgpart eq '0' ) { - $hashref->{'pkgnum'} = ''; - } - } - - qsearch({ - 'table' => 'cust_svc', - 'addl_from' => $addl_from, - 'hashref' => $hashref, - 'extra_sql' => $extra_sql, - }); -} - -=item num_cust_svc [ PKGPART ] - -Returns the number of associated customer services (FS::cust_svc records). - -If a PKGPART is specified, returns the number of customer services which are -contained within packages of that type (see L<FS::part_pkg>). If PKGPART -is specified as B<0>, returns the number of unlinked customer services. - -=cut - -sub num_cust_svc { - my $self = shift; - - my @param = ( $self->svcpart ); - - my( $join, $and ) = ( '', '' ); - if ( @_ ) { - my $pkgpart = shift; - if ( $pkgpart ) { - $join = 'LEFT JOIN cust_pkg USING ( pkgnum )'; - $and = 'AND pkgpart = ?'; - push @param, $pkgpart; - } elsif ( $pkgpart eq '0' ) { - $and = 'AND pkgnum IS NULL'; - } - } - - my $sth = dbh->prepare( - "SELECT COUNT(*) FROM cust_svc $join WHERE svcpart = ? $and" - ) or die dbh->errstr; - $sth->execute(@param) - or die $sth->errstr; - $sth->fetchrow_arrayref->[0]; -} - -=item svc_x - -Returns a list of associated FS::svc_* records. - -=cut - -sub svc_x { - my $self = shift; - map { $_->svc_x } $self->cust_svc; -} - - -=back - -=head1 SUBROUTINES - -=over 4 - -=item process - -Job-queue processor for web interface adds/edits - -=cut - -use Storable qw(thaw); -use Data::Dumper; -use MIME::Base64; -sub process { - my $job = shift; - - my $param = thaw(decode_base64(shift)); - warn Dumper($param) if $DEBUG; - - my $old = qsearchs('part_svc', { 'svcpart' => $param->{'svcpart'} }) - if $param->{'svcpart'}; - - $param->{'svc_acct__usergroup'} = - ref($param->{'svc_acct__usergroup'}) - ? join(',', @{$param->{'svc_acct__usergroup'}} ) - : $param->{'svc_acct__usergroup'}; - - my $new = new FS::part_svc ( { - map { - $_ => $param->{$_}; - # } qw(svcpart svc svcdb) - } ( fields('part_svc'), - map { my $svcdb = $_; - my @fields = fields($svcdb); - push @fields, 'usergroup' if $svcdb eq 'svc_acct'; #kludge - - map { - if ( $param->{ $svcdb.'__'.$_.'_flag' } =~ /^[MA]$/ ) { - $param->{ $svcdb.'__'.$_ } = - delete( $param->{ $svcdb.'__'.$_.'_classnum' } ); - } - ( $svcdb.'__'.$_, $svcdb.'__'.$_.'_flag' ); - } - @fields; - - } grep defined( dbdef->table($_) ), - qw( svc_acct svc_domain svc_forward svc_www svc_broadband - svc_phone svc_external - ) - ) - } ); - - my %exportnums = - map { $_->exportnum => ( $param->{'exportnum'.$_->exportnum} || '') } - qsearch('part_export', {} ); - - my $error; - if ( $param->{'svcpart'} ) { - $error = $new->replace( $old, - '1.3-COMPAT', - [ 'usergroup' ], - \%exportnums, - $job - ); - } else { - $error = $new->insert( [ 'usergroup' ], - \%exportnums, - $job, - ); - $param->{'svcpart'} = $new->getfield('svcpart'); - } - - die "$error\n" if $error; -} - -=item process_bulk_cust_svc - -Job-queue processor for web interface bulk customer service changes - -=cut - -use Storable qw(thaw); -use Data::Dumper; -use MIME::Base64; -sub process_bulk_cust_svc { - my $job = shift; - - my $param = thaw(decode_base64(shift)); - warn Dumper($param) if $DEBUG; - - my $old_part_svc = - qsearchs('part_svc', { 'svcpart' => $param->{'old_svcpart'} } ); - - die "Must select a new service definition\n" unless $param->{'new_svcpart'}; - - #the rest should be abstracted out to to its own subroutine? - - 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; - - local( $FS::cust_svc::ignore_quantity ) = 1; - - my $total = $old_part_svc->num_cust_svc( $param->{'pkgpart'} ); - - my $n = 0; - foreach my $old_cust_svc ( $old_part_svc->cust_svc( $param->{'pkgpart'} ) ) { - - my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash }; - - $new_cust_svc->svcpart( $param->{'new_svcpart'} ); - my $error = $new_cust_svc->replace($old_cust_svc); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - die "$error\n" if $error; - } - - $error = $job->update_statustext( int( 100 * ++$n / $total ) ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - die $error if $error; - } - - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; - -} - -=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 methods should be documented - -=head1 SEE ALSO - -L<FS::Record>, L<FS::part_svc_column>, L<FS::part_pkg>, L<FS::pkg_svc>, -L<FS::cust_svc>, L<FS::svc_acct>, L<FS::svc_forward>, L<FS::svc_domain>, -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 fb08eaa..0000000 --- a/FS/FS/part_svc_column.pm +++ /dev/null @@ -1,120 +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<FS::part_svc>) - -=item columnname - column name in part_svc.svcdb table - -=item columnvalue - default or fixed value for the column - -=item columnflag - null or empty (no default), `D' for default, `F' for fixed (unchangeable), `M' for manual selection from inventory, or `A' for automatic selection from inventory. For virtual fields, can also be 'X' for excluded. - -=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 =~ /^([DFMAX])$/ - or return "illegal columnflag ". $self->columnflag; - $self->columnflag(uc($1)); - - if ( $self->columnflag =~ /^[MA]$/ ) { - $error = - $self->ut_foreign_key( 'columnvalue', 'inventory_class', 'classnum' ); - return $error if $error; - } - - $self->SUPER::check; -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::Record>, L<FS::part_svc>, L<FS::part_pkg>, L<FS::pkg_svc>, -L<FS::cust_svc>, L<FS::svc_acct>, L<FS::svc_forward>, L<FS::svc_domain>, -schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/part_svc_router.pm b/FS/FS/part_svc_router.pm deleted file mode 100755 index df04cc9..0000000 --- a/FS/FS/part_svc_router.pm +++ /dev/null @@ -1,33 +0,0 @@ -package FS::part_svc_router; - -use strict; -use vars qw( @ISA ); -use FS::Record qw(qsearchs); -use FS::router; -use FS::part_svc; - -@ISA = qw(FS::Record); - -sub table { 'part_svc_router'; } - -sub check { - my $self = shift; - my $error = - $self->ut_numbern('svcrouternum') - || $self->ut_foreign_key('svcpart', 'part_svc', 'svcpart') - || $self->ut_foreign_key('routernum', 'router', 'routernum'); - return $error if $error; - ''; #no error -} - -sub router { - my $self = shift; - return qsearchs('router', { routernum => $self->routernum }); -} - -sub part_svc { - my $self = shift; - return qsearchs('part_svc', { svcpart => $self->svcpart }); -} - -1; diff --git a/FS/FS/part_virtual_field.pm b/FS/FS/part_virtual_field.pm deleted file mode 100755 index 992d449..0000000 --- a/FS/FS/part_virtual_field.pm +++ /dev/null @@ -1,300 +0,0 @@ -package FS::part_virtual_field; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearchs qsearch ); -use FS::Schema qw( dbdef ); - -@ISA = qw( FS::Record ); - -=head1 NAME - -FS::part_virtual_field - Object methods for part_virtual_field records - -=head1 SYNOPSIS - - use FS::part_virtual_field; - - $record = new FS::part_virtual_field \%hash; - $record = new FS::part_virtual_field { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::part_virtual_field object represents the definition of a virtual field -(see the BACKGROUND section). FS::part_virtual_field contains the name and -base table of the field, as well as validation rules and UI hints about the -display of the field. The actual data is stored in FS::virtual_field; see -its manpage for details. - -FS::part_virtual_field inherits from FS::Record. The following fields are -currently supported: - -=over 2 - -=item vfieldpart - primary key (assigned automatically) - -=item name - name of the field - -=item dbtable - table for which this virtual field is defined - -=item check_block - Perl code to validate/normalize data - -=item list_source - Perl code to generate a list of values (UI hint) - -=item length - expected length of the value (UI hint) - -=item label - descriptive label for the field (UI hint) - -=item sequence - sort key (UI hint; unimplemented) - -=back - -=head1 BACKGROUND - -"Form is none other than emptiness, - and emptiness is none other than form." --- Heart Sutra - -The virtual field mechanism allows site admins to make trivial changes to -the Freeside database schema without modifying the code. Specifically, the -user can add custom-defined 'fields' to the set of data tracked by Freeside -about objects such as customers and services. These fields are not associated -with any logic in the core Freeside system, but may be referenced in peripheral -code such as exports, price calculations, or alternate interfaces, or may just -be stored in the database for future reference. - -This system was originally devised for svc_broadband, which (by necessity) -comprises such a wide range of access technologies that no static set of fields -could contain all the information needed by the exports. In an appalling -display of False Laziness, a parallel mechanism was implemented for the -router table, to store properties such as passwords to configure routers. - -The original system treated svc_broadband custom fields (sb_fields) as records -in a completely separate table. Any code that accessed or manipulated these -fields had to be aware that they were I<not> fields in svc_broadband, but -records in sb_field. For example, code that inserted a svc_broadband with -several custom fields had to create an FS::svc_broadband object, call its -insert() method, and then create several FS::sb_field objects and call I<their> -insert() methods. - -This created a problem for exports. The insert method on any FS::svc_Common -object (including svc_broadband) automatically triggers exports after the -record has been inserted. However, at this point, the sb_fields had not yet -been inserted, so the export could not rely on their presence, which was the -original purpose of sb_fields. - -Hence the new system. Virtual fields are appended to the field list of every -record at the FS::Record level, whether the object is created ex nihilo with -new() or fetched with qsearch(). The fields() method now returns a list of -both real and virtual fields. The insert(), replace(), and delete() methods -now update both the base table and the virtual fields, in a single transaction. - -A new method is provided, virtual_fields(), which gives only the virtual -fields. UI code that dynamically generates form widgets to edit virtual field -data should use this to figure out what fields are defined. (See below.) - -Subclasses may override virtual_fields() to restrict the set of virtual -fields available. Some discipline and sanity on the part of the programmer -are required; in particular, this function should probably not depend on any -fields in the record other than the primary key, since the others may change -after the object is instantiated. (Making it depend on I<virtual> fields is -just asking for pain.) One use of this is seen in FS::svc_Common; another -possibility is field-level access control based on FS::UID::getotaker(). - -As a trivial case, a subclass may opt out of supporting virtual fields with -the following code: - -sub virtual_fields { () } - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Create a new record. To add the record to the database, see "insert". - -=cut - -sub table { 'part_virtual_field'; } -sub virtual_fields { () } - -=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 - -If there is an error, returns the error, otherwise returns false. -Called by the insert and replace methods. - -=back - -=cut - -sub check { - my $self = shift; - - my $error = $self->ut_text('name') || - $self->ut_text('dbtable') || - $self->ut_number('length') - ; - return $error if $error; - - # Make sure it's a real table with a numeric primary key - my ($table, $pkey); - if($table = dbdef->table($self->dbtable)) { - if($pkey = $table->primary_key) { - if($table->column($pkey)->type =~ /int/i) { - # this is what it should be - } else { - $error = "$table.$pkey is not an integer"; - } - } else { - $error = "$table does not have a single-field primary key"; - } - } else { - $error = "$table does not exist in the schema"; - } - return $error if $error; - - # Possibly some sanity checks for check_block and list_source? - - $self->SUPER::check; -} - -=item list - -Evaluates list_source. - -=cut - -sub list { - my $self = shift; - return () unless $self->list_source; - - my @opts = eval($self->list_source); - if($@) { - warn $@; - return (); - } else { - return @opts; - } -} - -=item widget UI_TYPE MODE [ VALUE ] - -Generates UI code for a widget suitable for editing/viewing the field, based on -list_source and length. - -The only UI_TYPE currently supported is 'HTML', and the only MODE is 'view'. -Others will be added later. - -In HTML, all widgets are assumed to be table rows. View widgets look like -<TR><TD ALIGN="right">Label</TD><TD BGCOLOR="#ffffff">Value</TD></TR> - -(Most of the display style stuff, such as the colors, should probably go into -a separate module specific to the UI. That can wait, though. The API for -this function won't change.) - -VALUE (optional) is the current value of the field. - -=cut - -sub widget { - my $self = shift; - my ($ui_type, $mode, $value) = @_; - my $text; - my $label = $self->label || $self->name; - - if ($ui_type eq 'HTML') { - if ($mode eq 'view') { - $text = q!<TR><TD ALIGN="right">! . $label . - q!</TD><TD BGCOLOR="#ffffff">! . $value . - q!</TD></TR>! . "\n"; - } elsif ($mode eq 'edit') { - $text = q!<TR><TD ALIGN="right">! . $label . - q!</TD><TD>!; - if ($self->list_source) { - $text .= q!<SELECT NAME="! . $self->name . - q!" SIZE=1>! . "\n"; - foreach ($self->list) { - $text .= q!<OPTION VALUE="! . $_ . q!"!; - $text .= ' SELECTED' if ($_ eq $value); - $text .= '>' . $_ . '</OPTION>' . "\n"; - } - } else { - $text .= q!<INPUT NAME="! . $self->name . - q!" VALUE="! . $value . q!"!; - if ($self->length) { - $text .= q! SIZE="! . $self->length . q!"!; - } - $text .= '>'; - } - $text .= q!</TD></TR>! . "\n"; - } else { - return ''; - } - } else { - return ''; - } - return $text; -} - -=head1 NOTES - -=head2 Semantics of check_block: - -This has been changed from the sb_field implementation to make check_blocks -simpler and more natural to Perl programmers who work on things other than -Freeside. - -The check_block is eval'd with the (proposed) new value of the field in $_, -and the object to be updated in $self. Its return value is ignored. The -check_block may change the value of $_ to override the proposed value, or -call die() (with an appropriate error message) to reject the update entirely; -the error string will be returned as the output of the check() method. - -This makes check_blocks like - -C<s/foo/bar/> - -do what you expect. - -The check_block is expected NOT to do anything freaky to $self, like modifying -other fields or calling $self->check(). You have been warned. - -(FIXME: Rewrite some of the warnings from part_sb_field and insert here.) - -=head1 BUGS - -None. It's absolutely falwless. - -=head1 SEE ALSO - -L<FS::Record>, L<FS::virtual_field> - -=cut - -1; - - diff --git a/FS/FS/pay_batch.pm b/FS/FS/pay_batch.pm deleted file mode 100644 index 7d9d9fb..0000000 --- a/FS/FS/pay_batch.pm +++ /dev/null @@ -1,125 +0,0 @@ -package FS::pay_batch; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::pay_batch - Object methods for pay_batch records - -=head1 SYNOPSIS - - use FS::pay_batch; - - $record = new FS::pay_batch \%hash; - $record = new FS::pay_batch { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::pay_batch object represents an example. FS::pay_batch inherits from -FS::Record. The following fields are currently supported: - -=over 4 - -=item batchnum - primary key - -=item status - - -=item download - - -=item upload - - - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new example. To add the example to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'pay_batch'; } - -=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('batchnum') - || $self->ut_enum('status', [ 'O', 'I', 'R' ]) - ; - return $error if $error; - - $self->SUPER::check; -} - -=back - -=head1 BUGS - -status is somewhat redundant now that download and upload exist - -=head1 SEE ALSO - -L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/payby.pm b/FS/FS/payby.pm deleted file mode 100644 index 72a8766..0000000 --- a/FS/FS/payby.pm +++ /dev/null @@ -1,131 +0,0 @@ -package FS::payby; - -use strict; -use vars qw(%hash); -use Tie::IxHash; - -=head1 NAME - -FS::payby - Object methods for payment type records - -=head1 SYNOPSIS - - use FS::payby; - - #for now... - - my @payby = FS::payby->payby; - - tie my %payby, 'Tie::IxHash', FS::payby->payby2longname - - my @cust_payby = FS::payby->cust_payby; - - tie my %payby, 'Tie::IxHash', FS::payby->cust_payby2longname - -=head1 DESCRIPTION - -Payment types. - -=head1 METHODS - -=over 4 - -=item - -=cut - -tie %hash, 'Tie::IxHash', - 'CARD' => { - tinyname => 'card', - shortname => 'Credit card', - longname => 'Credit card (automatic)', - }, - 'DCRD' => { - tinyname => 'card', - shortname => 'Credit card', - longname => 'Credit card (on-demand)', - cust_pay => 'CARD', #this is a customer type only, payments are CARD... - }, - 'CHEK' => { - tinyname => 'check', - shortname => 'Electronic check', - longname => 'Electronic check (automatic)', - }, - 'DCHK' => { - tinyname => 'check', - shortname => 'Electronic check', - longname => 'Electronic check (on-demand)', - cust_pay => 'CHEK', #this is a customer type only, payments are CHEK... - }, - 'LECB' => { - tinyname => 'phone bill', - shortname => 'Phone bill billing', - longname => 'Phone bill billing', - }, - 'BILL' => { - tinyname => 'billing', - shortname => 'Billing', - longname => 'Billing', - }, - 'CASH' => { - tinyname => 'cash', - shortname => 'Cash', # initial payment, then billing - longname => 'Cash', - cust_main => 'BILL', #this is a payment type only, customers go to BILL... - }, - 'WEST' => { - tinyname => 'western union', - shortname => 'Western Union', # initial payment, then billing - longname => 'Western Union', - cust_main => 'BILL', #this is a payment type only, customers go to BILL... - }, - 'MCRD' => { #not the same as DCRD - tinyname => 'card', - shortname => 'Manual credit card', # initial payment, then billing - longname => 'Manual credit card', - cust_main => 'BILL', #this is a payment type only, customers go to BILL... - }, - 'COMP' => { - tinyname => 'comp', - shortname => 'Complimentary', - longname => 'Complimentary', - }, - 'DCLN' => { # This is only an event. - tinyname => 'declined', - shortname => 'Declined payment', - longname => 'Declined payment', - }, -; - -sub payby { - keys %hash; -} - -sub payby2longname { - my $self = shift; - map { $_ => $hash{$_}->{longname} } $self->payby; -} - -sub cust_payby { - my $self = shift; - grep { ! exists $hash{$_}->{cust_main} } $self->payby; -} - -sub cust_payby2longname { - my $self = shift; - map { $_ => $hash{$_}->{longname} } $self->cust_payby; -} - -=back - -=head1 BUGS - -This should eventually be an actual database table, and all tables that -currently have a char payby field should have a foreign key into here instead. - -=head1 SEE ALSO - -=cut - -1; - diff --git a/FS/FS/payment_gateway.pm b/FS/FS/payment_gateway.pm deleted file mode 100644 index a5cdd9d..0000000 --- a/FS/FS/payment_gateway.pm +++ /dev/null @@ -1,147 +0,0 @@ -package FS::payment_gateway; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); -use FS::option_Common; - -@ISA = qw( FS::option_Common ); - -=head1 NAME - -FS::payment_gateway - Object methods for payment_gateway records - -=head1 SYNOPSIS - - use FS::payment_gateway; - - $record = new FS::payment_gateway \%hash; - $record = new FS::payment_gateway { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::payment_gateway object represents an payment gateway. -FS::payment_gateway inherits from FS::Record. The following fields are -currently supported: - -=over 4 - -=item gatewaynum - primary key - -=item gateway_module - Business::OnlinePayment:: module name - -=item gateway_username - payment gateway username - -=item gateway_password - payment gateway password - -=item gateway_action - optional action or actions (multiple actions are separated with `,': for example: `Authorization Only, Post Authorization'). Defaults to `Normal Authorization'. - -=item disabled - Disabled flag, empty or 'Y' - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new payment gateway. To add the payment gateway to the database, see -L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'payment_gateway'; } - -=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 payment gateway. 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('gatewaynum') - || $self->ut_alpha('gateway_module') - || $self->ut_textn('gateway_username') - || $self->ut_anything('gateway_password') - || $self->ut_enum('disabled', [ '', 'Y' ] ) - #|| $self->ut_textn('gateway_action') - ; - return $error if $error; - - if ( $self->gateway_action ) { - my @actions = split(/,\s*/, $self->gateway_action); - $self->gateway_action( - join( ',', map { /^(Normal Authorization|Authorization Only|Credit|Post Authorization)$/ - or return "Unknown action $_"; - $1 - } - @actions - ) - ); - } else { - $self->gateway_action('Normal Authorization'); - } - - $self->SUPER::check; -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/payment_gateway_option.pm b/FS/FS/payment_gateway_option.pm deleted file mode 100644 index 0576022..0000000 --- a/FS/FS/payment_gateway_option.pm +++ /dev/null @@ -1,126 +0,0 @@ -package FS::payment_gateway_option; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::payment_gateway_option - Object methods for payment_gateway_option records - -=head1 SYNOPSIS - - use FS::payment_gateway_option; - - $record = new FS::payment_gateway_option \%hash; - $record = new FS::payment_gateway_option { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::payment_gateway_option object represents an option key and value for -a payment gateway. FS::payment_gateway_option inherits from -FS::Record. The following fields are currently supported: - -=over 4 - -=item optionnum - primary key - -=item gatewaynum - - -=item optionname - - -=item optionvalue - - - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new option. To add the 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<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'payment_gateway_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 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_foreign_key('gatewaynum', 'payment_gateway', 'gatewaynum') - || $self->ut_text('optionname') - || $self->ut_textn('optionvalue') - ; - return $error if $error; - - $self->SUPER::check; -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/pkg_class.pm b/FS/FS/pkg_class.pm deleted file mode 100644 index 0fa6e48..0000000 --- a/FS/FS/pkg_class.pm +++ /dev/null @@ -1,111 +0,0 @@ -package FS::pkg_class; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch ); -use FS::part_pkg; - -@ISA = qw( FS::Record ); - -=head1 NAME - -FS::pkg_class - Object methods for pkg_class records - -=head1 SYNOPSIS - - use FS::pkg_class; - - $record = new FS::pkg_class \%hash; - $record = new FS::pkg_class { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::pkg_class object represents an package class. Every package definition -(see L<FS::part_pkg>) has, optionally, a package class. FS::pkg_class inherits -from FS::Record. The following fields are currently supported: - -=over 4 - -=item classnum - primary key (assigned automatically for new package classes) - -=item classname - Text name of this package class - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new package class. To add the package class to the database, see -L<"insert">. - -=cut - -sub table { 'pkg_class'; } - -=item insert - -Adds this package class to the database. If there is an error, returns the -error, otherwise returns false. - -=item delete - -Deletes this package class from the database. Only package classes with no -associated package definitions can be deleted. If there is an error, returns -the error, otherwise returns false. - -=cut - -sub delete { - my $self = shift; - - return "Can't delete an pkg_class with part_pkg records!" - if qsearch( 'part_pkg', { 'classnum' => $self->classnum } ); - - $self->SUPER::delete; -} - -=item replace OLD_RECORD - -Replaces OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=item check - -Checks all fields to make sure this is a valid package class. 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('classnum') - or $self->ut_text('classname') - or $self->SUPER::check; - -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::Record>, L<FS::part_pkg>, 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 065ddbe..0000000 --- a/FS/FS/pkg_svc.pm +++ /dev/null @@ -1,158 +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<FS::part_pkg>) to -a service definition (see L<FS::part_svc>). FS::pkg_svc inherits from -FS::Record. The following fields are currently supported: - -=over 4 - -=item pkgsvcnum - primary key - -=item pkgpart - Billing item definition (see L<FS::part_pkg>) - -=item svcpart - Service definition (see L<FS::part_svc>) - -=item quantity - Quantity of this service definition that this billing item -definition includes - -=item primary_svc - primary flag, empty or 'Y' - -=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_numbern('pkgsvcnum') - || $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; - - if ( $self->dbdef_table->column('primary_svc') ) { - $error = $self->ut_enum('primary_svc', [ '', 'Y' ] ); - return $error if $error; - } - - $self->SUPER::check; -} - -=item part_pkg - -Returns the FS::part_pkg object (see L<FS::part_pkg>). - -=cut - -sub part_pkg { - my $self = shift; - qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } ); -} - -=item part_svc - -Returns the FS::part_svc object (see L<FS::part_svc>). - -=cut - -sub part_svc { - my $self = shift; - qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::Record>, L<FS::part_pkg>, L<FS::part_svc>, 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 c26ca85..0000000 --- a/FS/FS/port.pm +++ /dev/null @@ -1,154 +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<FS::nas> - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new port. To add the port to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'port'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=cut - -# the insert method can be inherited from FS::Record - -=item delete - -Delete this record from the database. - -=cut - -# the delete method can be inherited from FS::Record - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -# the replace method can be inherited from FS::Record - -=item check - -Checks all fields to make sure this is a valid port. 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 } ); - $self->SUPER::check; -} - -=item session - -Returns the currently open session on this port, or if no session is currently -open, the most recent session. See L<FS::session>. - -=cut - -sub session { - my $self = shift; - qsearchs('session', { 'portnum' => $self->portnum }, '*', - 'ORDER BY login DESC LIMIT 1' ); -} - -=back - -=head1 BUGS - -The session method won't deal well if you have multiple open sessions on a -port, for example if your RADIUS server drops B<stop> records. Suggestions for -how to deal with this sort of lossage welcome; should we close the session -when we get a new session on that port? Tag it as invalid somehow? Close it -one second after it was opened? *sigh* Maybe FS::session shouldn't let you -create overlapping sessions, at least folks will find out their logging is -dropping records. - -If you think the above refers multiple user logins you need to read the -manpages again. - -=head1 SEE ALSO - -L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/prepay_credit.pm b/FS/FS/prepay_credit.pm deleted file mode 100644 index 38e87ad..0000000 --- a/FS/FS/prepay_credit.pm +++ /dev/null @@ -1,191 +0,0 @@ -package FS::prepay_credit; - -use strict; -use vars qw( @ISA ); -use FS::Record qw(qsearchs dbh); -use FS::agent; - -@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::prepay_credit object represents a pre-paid 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<FS::svc_acct/seconds>) - -=item agentnum - optional agent (see L<FS::agent>) for this prepaid card - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new pre-paid credit. To add the pre-paid credit to the database, see -L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -sub table { 'prepay_credit'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=cut - -=item delete - -Delete this record from the database. - -=cut - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -=item check - -Checks all fields to make sure this is a valid pre-paid credit. If there is -an error, returns the error, otherwise returns false. Called by the insert -and replace methods. - -=cut - -sub check { - my $self = shift; - - my $identifier = $self->identifier; - $identifier =~ s/\W//g; #anything else would just confuse things - $self->identifier($identifier); - - $self->ut_numbern('prepaynum') - || $self->ut_alpha('identifier') - || $self->ut_money('amount') - || $self->ut_numbern('seconds') - || $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum') - || $self->SUPER::check - ; - -} - -=item agent - -Returns the agent (see L<FS::agent>) for this prepaid card, if any. - -=cut - -sub agent { - my $self = shift; - qsearchs('agent', { 'agentnum' => $self->agentnum } ); -} - -=back - -=head1 SUBROUTINES - -=over 4 - -=item generate NUM TYPE HASHREF - -Generates the specified number of prepaid cards. Returns an array reference of -the newly generated card identifiers, or a scalar error message. - -=cut - -#false laziness w/agent::generate_reg_codes -sub generate { - my( $num, $type, $hashref ) = @_; - - my @codeset = (); - push @codeset, ( 'A'..'Z' ) if $type =~ /alpha/; - push @codeset, ( '1'..'9' ) if $type =~ /numeric/; - - 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 @cards = (); - for ( 1 ... $num ) { - my $prepay_credit = new FS::prepay_credit { - 'identifier' => join('', map($codeset[int(rand $#codeset)], (0..7) ) ), - %$hashref, - }; - my $error = $prepay_credit->check || $prepay_credit->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "(inserting prepay_credit) $error"; - } - push @cards, $prepay_credit->identifier; - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - \@cards; - -} - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::svc_acct>, L<FS::Record>, 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 5f8bf11..0000000 --- a/FS/FS/queue.pm +++ /dev/null @@ -1,465 +0,0 @@ -package FS::queue; - -use strict; -use vars qw( @ISA @EXPORT_OK $DEBUG $conf $jobnums); -use Exporter; -use FS::UID qw(myconnect); -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 ); - -$DEBUG = 0; - -$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<FS::cust_svc>) - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new job. To add the job to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { '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<FS::queue_arg>). - -=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; - } - } - - if ( $jobnums ) { - warn "jobnums global is active: $jobnums\n" if $DEBUG; - push @$jobnums, $self->jobnum; - } - - $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; - - $self->SUPER::check; -} - -=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. -(Dependancies that must complete before this job can be run). - -=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; -} - -=item queue_depended - -Returns the FS::queue_depend objects that associate other jobs with this job, -if any. (The jobs that are waiting for this job to complete before they can -run). - -=cut - -sub queue_depended { - my $self = shift; - qsearch('queue_depend', { 'depend_jobnum' => $self->jobnum } ); -} - -=item depended_delete - -Deletes the other queued jobs (FS::queue objects) that are waiting for this -job, if any. If there is an error, returns the error, otherwise returns false. - -=cut - -sub depended_delete { - my $self = shift; - my $error; - foreach my $job ( - map { qsearchs('queue', { 'jobnum' => $_->jobnum } ) } $self->queue_depended - ) { - $error = $job->depended_delete; - return $error if $error; - $error = $job->delete; - return $error if $error - } -} - -=item update_statustext VALUE - -Updates the statustext value of this job to supplied value, in the database. -If there is an error, returns the error, otherwise returns false. - -=cut - -use vars qw($_update_statustext_dbh); -sub update_statustext { - my( $self, $statustext ) = @_; - return '' if $statustext eq $self->statustext; - warn "updating statustext for $self to $statustext" if $DEBUG; - - $_update_statustext_dbh ||= myconnect; - - my $sth = $_update_statustext_dbh->prepare( - 'UPDATE queue set statustext = ? WHERE jobnum = ?' - ) or return $_update_statustext_dbh->errstr; - - $sth->execute($statustext, $self->jobnum) or return $sth->errstr; - $_update_statustext_dbh->commit or die $_update_statustext_dbh->errstr; - $self->statustext($statustext); - ''; - - #my $new = new FS::queue { $self->hash }; - #$new->statustext($statustext); - #my $error = $new->replace($self); - #return $error if $error; - #$self->statustext($statustext); - #''; -} - -=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!<FORM ACTION="$p/misc/queue.cgi" METHOD="POST">!. - FS::CGI::table(). <<END; - <TR> - <TH COLSPAN=2>Job</TH> - <TH>Args</TH> - <TH>Date</TH> - <TH>Status</TH> -END - $html .= '<TH>Account</TH>' unless $hashref->{svcnum}; - $html .= '</TR>'; - - 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(' ', $queue->args) ); - } 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! ( <A HREF="$p/misc/queue.cgi?jobnum=$jobnum&action=new">retry</A> |!. - qq! <A HREF="$p/misc/queue.cgi?jobnum=$jobnum&action=del">remove</A> )!; - } - my $cust_svc = $queue->cust_svc; - - $html .= <<END; - <TR> - <TD>$jobnum</TD> - <TD>$queue_hashref->{job}</TD> - <TD>$args</TD> - <TD>$date</TD> - <TD>$status</TD> -END - - unless ( $hashref->{svcnum} ) { - my $account; - if ( $cust_svc ) { - my $table = $cust_svc->part_svc->svcdb; - my $label = ( $cust_svc->label )[1]; - $account = qq!<A HREF="../view/$table.cgi?!. $queue->svcnum. - qq!">$label</A>!; - } else { - $account = ''; - } - $html .= "<TD>$account</TD>"; - } - - if ( $changable ) { - $areboxes=1; - $html .= - qq!<TD><INPUT NAME="jobnum$jobnum" TYPE="checkbox" VALUE="1"></TD>!; - - } - - $html .= '</TR>'; - -} - - $html .= '</TABLE>'; - - if ( $areboxes ) { - $html .= '<BR><INPUT TYPE="submit" NAME="action" VALUE="retry selected">'. - '<INPUT TYPE="submit" NAME="action" VALUE="remove selected"><BR>'; - } - - $html; - -} - -=back - -=head1 BUGS - -$jobnums global - -=head1 SEE ALSO - -L<FS::Record>, 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 c96ff12..0000000 --- a/FS/FS/queue_arg.pm +++ /dev/null @@ -1,117 +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<FS::queue> - -=item arg - argument - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new argument. To add the argument to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { '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; - - $self->SUPER::check; -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::queue>, L<FS::Record>, 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 99a22c5..0000000 --- a/FS/FS/queue_depend.pm +++ /dev/null @@ -1,121 +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<FS::queue>). - -=item depend_jobnum - dependancy jobnum (see L<FS::queue>) - -=back - -The job specified by B<jobnum> depends on the job specified B<depend_jobnum> - -the B<jobnum> job will not be run until the B<depend_jobnum> job has completed -successfully (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<hash> 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') - || $self->SUPER::check - ; -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::queue>, L<FS::Record>, 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 506b325..0000000 --- a/FS/FS/raddb.pm +++ /dev/null @@ -1,1912 +0,0 @@ -package FS::raddb; -use vars qw(%attrib); - -%attrib = ( - '3com_user_access_level' => '3Com-User-Access-Level', - '3gpp2_accounting_contain' => '3GPP2-Accounting-Container', - '3gpp2_acct_stop_trigger' => '3GPP2-Acct-Stop-Trigger', - '3gpp2_active_time' => '3GPP2-Active-Time', - '3gpp2_airlink_priority' => '3GPP2-Airlink-Priority', - '3gpp2_airlink_record_typ' => '3GPP2-Airlink-Record-Type', - '3gpp2_airlink_sequence_n' => '3GPP2-Airlink-Sequence-Number', - '3gpp2_allowed_diffserv_m' => '3GPP2-Allowed-Diffserv-Marking', - '3gpp2_allowed_persistent' => '3GPP2-Allowed-Persistent-TFTs', - '3gpp2_bad_ppp_frame_coun' => '3GPP2-Bad-PPP-Frame-Count', - '3gpp2_begin_session' => '3GPP2-Begin-Session', - '3gpp2_bsid' => '3GPP2-BSID', - '3gpp2_compulsory_tunnel_' => '3GPP2-Compulsory-Tunnel-Indicator', - '3gpp2_correlation_id' => '3GPP2-Correlation-Id', - '3gpp2_dcch_frame_size' => '3GPP2-DCCH-Frame-Size', - '3gpp2_diffserv_class_opt' => '3GPP2-Diffserv-Class-Option', - '3gpp2_disconnect_reason' => '3GPP2-Disconnect-Reason', - '3gpp2_dns_update_capabil' => '3GPP2-DNS-Update-Capability', - '3gpp2_dns_update_require' => '3GPP2-DNS-Update-Required', - '3gpp2_esn' => '3GPP2-ESN', - '3gpp2_fch_frame_size' => '3GPP2-FCH-Frame-Size', - '3gpp2_foreign_agent_addr' => '3GPP2-Foreign-Agent-Address', - '3gpp2_forward_dcch_mux_o' => '3GPP2-Forward-DCCH-Mux-Option', - '3gpp2_forward_dcch_rc' => '3GPP2-Forward-DCCH-RC', - '3gpp2_forward_fch_mux_op' => '3GPP2-Forward-FCH-Mux-Option', - '3gpp2_forward_fch_rc' => '3GPP2-Forward-FCH-RC', - '3gpp2_forward_pdch_rc' => '3GPP2-Forward-PDCH-RC', - '3gpp2_forward_traffic_ty' => '3GPP2-Forward-Traffic-Type', - '3gpp2_home_agent_ip_addr' => '3GPP2-Home-Agent-IP-Address', - '3gpp2_ike_preshared_secr' => '3GPP2-Ike-Preshared-Secret-Request', - '3gpp2_inbound_mobile_ip_' => '3GPP2-Inbound-Mobile-IP-Sig-Octets', - '3gpp2_ip_qos' => '3GPP2-IP-QoS', - '3gpp2_ip_technology' => '3GPP2-IP-Technology', - '3gpp2_keyid' => '3GPP2-KeyID', - '3gpp2_last_user_activity' => '3GPP2-Last-User-Activity-Time', - '3gpp2_mip_lifetime' => '3GPP2-MIP-Lifetime', - '3gpp2_mn_aaa_removal_ind' => '3GPP2-MN-AAA-Removal-Indication', - '3gpp2_mn_ha_shared_key' => '3GPP2-MN-HA-Shared-Key', - '3gpp2_mn_ha_spi' => '3GPP2-MN-HA-SPI', - '3gpp2_module_orig_term_i' => '3GPP2-Module-Orig-Term-Indicator', - '3gpp2_number_active_tran' => '3GPP2-Number-Active-Transitions', - '3gpp2_originating_number' => '3GPP2-Originating-Number-SDBs', - '3gpp2_originating_sdb_oc' => '3GPP2-Originating-SDB-OCtet-Count', - '3gpp2_outbound_mobile_ip' => '3GPP2-Outbound-Mobile-IP-Sig-Octets', - '3gpp2_pcf_ip_address' => '3GPP2-PCF-IP-Address', - '3gpp2_pre_shared_secret' => '3GPP2-Pre-Shared-Secret', - '3gpp2_prepaid_acct_capab' => '3GPP2-Prepaid-acct-Capability', - '3gpp2_prepaid_acct_quota' => '3GPP2-Prepaid-Acct-Quota', - '3gpp2_prepaid_tariff_swi' => '3GPP2-PrePaid-Tariff-Switching', - '3gpp2_received_hdlc_octe' => '3GPP2-Received-HDLC-Octets', - '3gpp2_release_indicator' => '3GPP2-Release-Indicator', - '3gpp2_remote_address_tab' => '3GPP2-Remote-Address-Table-Index', - '3gpp2_remote_ip_address' => '3GPP2-Remote-IP-Address', - '3gpp2_remote_ipv4_addr_o' => '3GPP2-Remote-IPv4-Addr-Octet-Count', - '3gpp2_remote_ipv6_addres' => '3GPP2-Remote-IPv6-Address', - '3gpp2_remote_ipv6_octet_' => '3GPP2-Remote-IPv6-Octet-Count', - '3gpp2_reverse_dcch_mux_o' => '3GPP2-Reverse-DCCH-Mux-Option', - '3gpp2_reverse_dhhc_rc' => '3GPP2-Reverse-DHHC-RC', - '3gpp2_reverse_fch_mux_op' => '3GPP2-Reverse-FCH-Mux-Option', - '3gpp2_reverse_fch_rc' => '3GPP2-Reverse-FCH-RC', - '3gpp2_reverse_traffic_ty' => '3GPP2-Reverse-Traffic-Type', - '3gpp2_reverse_tunnel_spe' => '3GPP2-Reverse-Tunnel-Spec', - '3gpp2_rn_packet_data_ina' => '3GPP2-RN-Packet-Data-Inactivity-Timer', - '3gpp2_s_key' => '3GPP2-S-Key', - '3gpp2_s_lifetime' => '3GPP2-S-Lifetime', - '3gpp2_s_request' => '3GPP2-S-Request', - '3gpp2_security_level' => '3GPP2-Security-Level', - '3gpp2_service_option' => '3GPP2-Service-Option', - '3gpp2_service_option_pro' => '3GPP2-Service-Option-Profile', - '3gpp2_service_reference_' => '3GPP2-Service-Reference-Id', - '3gpp2_session_continue' => '3GPP2-Session-Continue', - '3gpp2_session_terminatio' => '3GPP2-Session-Termination-Capability', - '3gpp2_terminating_number' => '3GPP2-Terminating-Number-SDBs', - '3gpp2_terminating_sdb_oc' => '3GPP2-Terminating-SDB-Octet-Count', - '3gpp2_user_id' => '3GPP2-User-Id', - '3gpp_charging_characteri' => '3GPP-Charging-Characteristics', - '3gpp_charging_gateway_ad' => '3GPP-Charging-Gateway-Address', - '3gpp_charging_gateway_ip' => '3GPP-Charging-Gateway-IPv6-Address', - '3gpp_charging_id' => '3GPP-Charging-ID', - '3gpp_ggsn_address' => '3GPP-GGSN-Address', - '3gpp_ggsn_ipv6_address' => '3GPP-GGSN-IPv6-Address', - '3gpp_ggsn_mcc_mnc' => '3GPP-GGSN-MCC-MNC', - '3gpp_gprs_negotiated_qos' => '3GPP-GPRS-Negotiated-QoS-profile', - '3gpp_imsi' => '3GPP-IMSI', - '3gpp_imsi_mcc_mnc' => '3GPP-IMSI-MCC-MNC', - '3gpp_ipv6_dns_servers' => '3GPP-IPv6-DNS-Servers', - '3gpp_nsapi' => '3GPP-NSAPI', - '3gpp_pdp_type' => '3GPP-PDP-Type', - '3gpp_selection_mode' => '3GPP-Selection-Mode', - '3gpp_session_stop_indica' => '3GPP-Session-Stop-Indicator', - '3gpp_sgsn_address' => '3GPP-SGSN-Address', - '3gpp_sgsn_ipv6_address' => '3GPP-SGSN-IPv6-Address', - 'aat_assign_ip_pool' => 'AAT-Assign-IP-Pool', - 'aat_atm_direct' => 'AAT-ATM-Direct', - 'aat_atm_traffic_profile' => 'AAT-ATM-Traffic-Profile', - 'aat_atm_vci' => 'AAT-ATM-VCI', - 'aat_atm_vpi' => 'AAT-ATM-VPI', - 'aat_client_primary_dns' => 'AAT-Client-Primary-DNS', - 'aat_client_primary_wins_' => 'AAT-Client-Primary-WINS-NBNS', - 'aat_client_secondary_win' => 'AAT-Client-Secondary-WINS-NBNS', - 'aat_data_filter' => 'AAT-Data-Filter', - 'aat_input_octets_diff' => 'AAT-Input-Octets-Diff', - 'aat_ip_pool_definition' => 'AAT-IP-Pool-Definition', - 'aat_ip_tos' => 'AAT-IP-TOS', - 'aat_ip_tos_apply_to' => 'AAT-IP-TOS-Apply-To', - 'aat_ip_tos_precedence' => 'AAT-IP-TOS-Precedence', - 'aat_mcast_client' => 'AAT-MCast-Client', - 'aat_output_octets_diff' => 'AAT-Output-Octets-Diff', - 'aat_ppp_address' => 'AAT-PPP-Address', - 'aat_require_auth' => 'AAT-Require-Auth', - 'aat_source_ip_check' => 'AAT-Source-IP-Check', - 'aat_user_mac_address' => 'AAT-User-MAC-Address', - 'aat_vrouter_name' => 'AAT-Vrouter-Name', - 'acc_access_community' => 'Acc-Access-Community', - 'acc_access_partition' => 'Acc-Access-Partition', - 'acc_acct_on_off_reason' => 'Acc-Acct-On-Off-Reason', - 'acc_ace_token' => 'Acc-Ace-Token', - 'acc_ace_token_ttl' => 'Acc-Ace-Token-Ttl', - 'acc_apsm_oversubscribed' => 'Acc-Apsm-Oversubscribed', - 'acc_bridging_support' => 'Acc-Bridging-Support', - 'acc_callback_cbcp_type' => 'Acc-Callback-CBCP-Type', - 'acc_callback_delay' => 'Acc-Callback-Delay', - 'acc_callback_mode' => 'Acc-Callback-Mode', - 'acc_callback_num_valid' => 'Acc-Callback-Num-Valid', - 'acc_ccp_option' => 'Acc-Ccp-Option', - 'acc_clearing_cause' => 'Acc-Clearing-Cause', - 'acc_clearing_location' => 'Acc-Clearing-Location', - 'acc_connect_rx_speed' => 'Acc-Connect-Rx-Speed', - 'acc_connect_tx_speed' => 'Acc-Connect-Tx-Speed', - 'acc_customer_id' => 'Acc-Customer-Id', - 'acc_dial_port_index' => 'Acc-Dial-Port-Index', - 'acc_dialout_auth_mode' => 'Acc-Dialout-Auth-Mode', - 'acc_dialout_auth_passwor' => 'Acc-Dialout-Auth-Password', - 'acc_dialout_auth_usernam' => 'Acc-Dialout-Auth-Username', - 'acc_dns_server_pri' => 'Acc-Dns-Server-Pri', - 'acc_dns_server_sec' => 'Acc-Dns-Server-Sec', - 'acc_igmp_admin_state' => 'Acc-Igmp-Admin-State', - 'acc_igmp_version' => 'Acc-Igmp-Version', - 'acc_input_errors' => 'Acc-Input-Errors', - 'acc_ip_compression' => 'Acc-Ip-Compression', - 'acc_ip_gateway_pri' => 'Acc-Ip-Gateway-Pri', - 'acc_ip_gateway_sec' => 'Acc-Ip-Gateway-Sec', - 'acc_ip_pool_name' => 'Acc-Ip-Pool-Name', - 'acc_ipx_compression' => 'Acc-Ipx-Compression', - 'acc_ml_call_threshold' => 'Acc-ML-Call-Threshold', - 'acc_ml_clear_threshold' => 'Acc-ML-Clear-Threshold', - 'acc_ml_damping_factor' => 'Acc-ML-Damping-Factor', - 'acc_ml_mlx_admin_state' => 'Acc-ML-MLX-Admin-State', - 'acc_modem_error_protocol' => 'Acc-Modem-Error-Protocol', - 'acc_modem_modulation_typ' => 'Acc-Modem-Modulation-Type', - 'acc_nbns_server_pri' => 'Acc-Nbns-Server-Pri', - 'acc_nbns_server_sec' => 'Acc-Nbns-Server-Sec', - 'acc_output_errors' => 'Acc-Output-Errors', - 'acc_reason_code' => 'Acc-Reason-Code', - 'acc_request_type' => 'Acc-Request-Type', - 'acc_route_policy' => 'Acc-Route-Policy', - 'acc_service_profile' => 'Acc-Service-Profile', - 'acc_tunnel_port' => 'Acc-Tunnel-Port', - 'acc_tunnel_secret' => 'Acc-Tunnel-Secret', - 'acc_vpsm_reject_cause' => 'Acc-Vpsm-Reject-Cause', - 'acct_authentic' => 'Acct-Authentic', - 'acct_delay_time' => 'Acct-Delay-Time', - 'acct_dyn_ac_ent' => 'Acct_Dyn_Ac_Ent', - 'acct_dyn_ac_enu' => 'Acct-Dyn-Ac-Ent', - 'acct_input_gigawords' => 'Acct-Input-Gigawords', - 'acct_input_octets' => 'Acct-Input-Octets', - 'acct_input_octets_64' => 'Acct_Input_Octets_64', - 'acct_input_octets_65' => 'Acct-Input-Octets-64', - 'acct_input_packets' => 'Acct-Input-Packets', - 'acct_input_packets_64' => 'Acct_Input_Packets_64', - 'acct_input_packets_65' => 'Acct-Input-Packets-64', - 'acct_interim_interval' => 'Acct-Interim-Interval', - 'acct_link_count' => 'Acct-Link-Count', - 'acct_mcast_in_octets' => 'Acct_Mcast_In_Octets', - 'acct_mcast_in_octett' => 'Acct-Mcast-In-Octets', - 'acct_mcast_in_packets' => 'Acct_Mcast_In_Packets', - 'acct_mcast_in_packett' => 'Acct-Mcast-In-Packets', - 'acct_mcast_out_octets' => 'Acct_Mcast_Out_Octets', - 'acct_mcast_out_octett' => 'Acct-Mcast-Out-Octets', - 'acct_mcast_out_packets' => 'Acct_Mcast_Out_Packets', - 'acct_mcast_out_packett' => 'Acct-Mcast-Out-Packets', - 'acct_multi_session_id' => 'Acct-Multi-Session-Id', - 'acct_output_gigawords' => 'Acct-Output-Gigawords', - 'acct_output_octets' => 'Acct-Output-Octets', - 'acct_output_octets_64' => 'Acct_Output_Octets_64', - 'acct_output_octets_65' => 'Acct-Output-Octets-64', - 'acct_output_packets' => 'Acct-Output-Packets', - 'acct_output_packets_64' => 'Acct_Output_Packets_64', - 'acct_output_packets_65' => 'Acct-Output-Packets-64', - 'acct_session_gigawords' => 'Acct-Session-Gigawords', - 'acct_session_id' => 'Acct-Session-Id', - 'acct_session_input_gigaw' => 'Acct-Session-Input-Gigawords', - 'acct_session_input_octet' => 'Acct-Session-Input-Octets', - 'acct_session_octets' => 'Acct-Session-Octets', - 'acct_session_output_giga' => 'Acct-Session-Output-Gigawords', - 'acct_session_output_octe' => 'Acct-Session-Output-Octets', - 'acct_session_start_time' => 'Acct-Session-Start-Time', - 'acct_session_time' => 'Acct-Session-Time', - 'acct_status_type' => 'Acct-Status-Type', - 'acct_terminate_cause' => 'Acct-Terminate-Cause', - 'acct_tunnel_connection' => 'Acct-Tunnel-Connection', - 'acct_tunnel_packets_lost' => 'Acct-Tunnel-Packets-Lost', - 'acct_type' => 'Acct-Type', - 'acct_unique_session_id' => 'Acct-Unique-Session-Id', - 'add_prefix' => 'Add-Prefix', - 'add_suffix' => 'Add-Suffix', - 'alteon_service_type' => 'Alteon-Service-Type', - 'altiga_access_hours_g_u' => 'Altiga-Access-Hours-G/U', - 'altiga_allow_alpha_only_' => 'Altiga-Allow-Alpha-Only-Passwords-G', - 'altiga_ipsec_allow_passw' => 'Altiga-IPSec-Allow-Passwd-Store-G/U', - 'altiga_ipsec_authenticat' => 'Altiga-IPSec-Authentication-G', - 'altiga_ipsec_banner_g' => 'Altiga-IPSec-Banner-G', - 'altiga_ipsec_default_dom' => 'Altiga-IPSec-Default-Domain-G', - 'altiga_ipsec_l2l_keepali' => 'Altiga-IPSec-L2L-Keepalives-G', - 'altiga_ipsec_mode_config' => 'Altiga-IPSec-Mode-Config-G', - 'altiga_ipsec_over_nat_g' => 'Altiga-IPSec-Over-NAT-G', - 'altiga_ipsec_over_nat_po' => 'Altiga-IPSec-Over-NAT-Port-Num-G', - 'altiga_ipsec_sec_associa' => 'Altiga-IPSec-Sec-Association-G/U', - 'altiga_ipsec_secondary_d' => 'Altiga-IPSec-Secondary-Domains-G', - 'altiga_ipsec_split_tunne' => 'Altiga-IPSec-Split-Tunnel-List-G', - 'altiga_ipsec_tunnel_type' => 'Altiga-IPSec-Tunnel-Type-G', - 'altiga_ipsec_user_group_' => 'Altiga-IPSec-User-Group-Lock-G', - 'altiga_l2tp_encryption_g' => 'Altiga-L2TP-Encryption-G', - 'altiga_l2tp_min_authenti' => 'Altiga-L2TP-Min-Authentication-G/U', - 'altiga_min_password_leng' => 'Altiga-Min-Password-Length-G', - 'altiga_pptp_encryption_g' => 'Altiga-PPTP-Encryption-G', - 'altiga_pptp_min_authenti' => 'Altiga-PPTP-Min-Authentication-G/U', - 'altiga_primary_dns_g' => 'Altiga-Primary-DNS-G', - 'altiga_primary_wins_g' => 'Altiga-Primary-WINS-G', - 'altiga_priority_on_sep_g' => 'Altiga-Priority-on-SEP-G/U', - 'altiga_secondary_dns_g' => 'Altiga-Secondary-DNS-G', - 'altiga_secondary_wins_g' => 'Altiga-Secondary-WINS-G', - 'altiga_sep_card_assignme' => 'Altiga-SEP-Card-Assignment-G/U', - 'altiga_simultaneous_logi' => 'Altiga-Simultaneous-Logins-G/U', - 'altiga_tunneling_protoco' => 'Altiga-Tunneling-Protocols-G/U', - 'altiga_use_client_addres' => 'Altiga-Use-Client-Address-G/U', - 'annex_acct_servers' => 'Annex-Acct-Servers', - 'annex_addr_resolution_pr' => 'Annex-Addr-Resolution-Protocol', - 'annex_addr_resolution_se' => 'Annex-Addr-Resolution-Servers', - 'annex_audit_level' => 'Annex-Audit-Level', - 'annex_authen_servers' => 'Annex-Authen-Servers', - 'annex_begin_modulation' => 'Annex-Begin-Modulation', - 'annex_begin_receive_line' => 'Annex-Begin-Receive-Line-Level', - 'annex_callback_portlist' => 'Annex-Callback-Portlist', - 'annex_cli_command' => 'Annex-CLI-Command', - 'annex_cli_filter' => 'Annex-CLI-Filter', - 'annex_compression_protoc' => 'Annex-Compression-Protocol', - 'annex_connect_progress' => 'Annex-Connect-Progress', - 'annex_disconnect_reason' => 'Annex-Disconnect-Reason', - 'annex_domain_name' => 'Annex-Domain-Name', - 'annex_edo' => 'Annex-EDO', - 'annex_end_modulation' => 'Annex-End-Modulation', - 'annex_end_receive_line_l' => 'Annex-End-Receive-Line-Level', - 'annex_error_correction_p' => 'Annex-Error-Correction-Prot', - 'annex_filter' => 'Annex-Filter', - 'annex_host_allow' => 'Annex-Host-Allow', - 'annex_host_restrict' => 'Annex-Host-Restrict', - 'annex_input_filter' => 'Annex-Input-Filter', - 'annex_keypress_timeout' => 'Annex-Keypress-Timeout', - 'annex_local_ip_address' => 'Annex-Local-IP-Address', - 'annex_local_username' => 'Annex-Local-Username', - 'annex_logical_channel_nu' => 'Annex-Logical-Channel-Number', - 'annex_maximum_call_durat' => 'Annex-Maximum-Call-Duration', - 'annex_modem_disc_reason' => 'Annex-Modem-Disc-Reason', - 'annex_mrru' => 'Annex-MRRU', - 'annex_multicast_rate_lim' => 'Annex-Multicast-Rate-Limit', - 'annex_multilink_id' => 'Annex-Multilink-Id', - 'annex_num_in_multilink' => 'Annex-Num-In-Multilink', - 'annex_output_filter' => 'Annex-Output-Filter', - 'annex_pool_id' => 'Annex-Pool-Id', - 'annex_port' => 'Annex-Port', - 'annex_ppp_trace_level' => 'Annex-PPP-Trace-Level', - 'annex_pre_input_octets' => 'Annex-Pre-Input-Octets', - 'annex_pre_input_packets' => 'Annex-Pre-Input-Packets', - 'annex_pre_output_octets' => 'Annex-Pre-Output-Octets', - 'annex_pre_output_packets' => 'Annex-Pre-Output-Packets', - 'annex_primary_dns_server' => 'Annex-Primary-DNS-Server', - 'annex_primary_nbns_serve' => 'Annex-Primary-NBNS-Server', - 'annex_product_name' => 'Annex-Product-Name', - 'annex_rate_reneg_req_rcv' => 'Annex-Rate-Reneg-Req-Rcvd', - 'annex_rate_reneg_req_sen' => 'Annex-Rate-Reneg-Req-Sent', - 'annex_re_chap_timeout' => 'Annex-Re-CHAP-Timeout', - 'annex_receive_speed' => 'Annex-Receive-Speed', - 'annex_retrain_requests_r' => 'Annex-Retrain-Requests-Rcvd', - 'annex_retrain_requests_s' => 'Annex-Retrain-Requests-Sent', - 'annex_retransmitted_pack' => 'Annex-Retransmitted-Packets', - 'annex_sec_profile_index' => 'Annex-Sec-Profile-Index', - 'annex_secondary_dns_serv' => 'Annex-Secondary-DNS-Server', - 'annex_secondary_nbns_ser' => 'Annex-Secondary-NBNS-Server', - 'annex_signal_to_noise_ra' => 'Annex-Signal-to-Noise-Ratio', - 'annex_sw_version' => 'Annex-SW-Version', - 'annex_syslog_tap' => 'Annex-Syslog-Tap', - 'annex_system_disc_reason' => 'Annex-System-Disc-Reason', - 'annex_transmit_speed' => 'Annex-Transmit-Speed', - 'annex_transmitted_packet' => 'Annex-Transmitted-Packets', - 'annex_tunnel_authen_mode' => 'Annex-Tunnel-Authen-Mode', - 'annex_tunnel_authen_type' => 'Annex-Tunnel-Authen-Type', - 'annex_unauthenticated_ti' => 'Annex-Unauthenticated-Time', - 'annex_user_level' => 'Annex-User-Level', - 'annex_user_server_locati' => 'Annex-User-Server-Location', - 'annex_wan_number' => 'Annex-Wan-Number', - 'arap_challenge_response' => 'ARAP-Challenge-Response', - 'arap_features' => 'ARAP-Features', - 'arap_password' => 'ARAP-Password', - 'arap_security' => 'ARAP-Security', - 'arap_security_data' => 'ARAP-Security-Data', - 'arap_zone_access' => 'ARAP-Zone-Access', - 'ascend_access_intercept_' => 'Ascend-Access-Intercept-LEA', - 'ascend_access_intercepta' => 'Ascend-Access-Intercept-Log', - 'ascend_add_seconds' => 'Ascend-Add-Seconds', - 'ascend_appletalk_peer_mo' => 'Ascend-Appletalk-Peer-Mode', - 'ascend_appletalk_route' => 'Ascend-Appletalk-Route', - 'ascend_ara_pw' => 'Ascend-Ara-PW', - 'ascend_assign_ip_client' => 'Ascend-Assign-IP-Client', - 'ascend_assign_ip_global_' => 'Ascend-Assign-IP-Global-Pool', - 'ascend_assign_ip_pool' => 'Ascend-Assign-IP-Pool', - 'ascend_assign_ip_server' => 'Ascend-Assign-IP-Server', - 'ascend_atm_connect_group' => 'Ascend-ATM-Connect-Group', - 'ascend_atm_connect_vci' => 'Ascend-ATM-Connect-Vci', - 'ascend_atm_connect_vpi' => 'Ascend-ATM-Connect-Vpi', - 'ascend_atm_direct' => 'Ascend-ATM-Direct', - 'ascend_atm_direct_profil' => 'Ascend-ATM-Direct-Profile', - 'ascend_atm_fault_managem' => 'Ascend-ATM-Fault-Management', - 'ascend_atm_group' => 'Ascend-ATM-Group', - 'ascend_atm_loopback_cell' => 'Ascend-ATM-Loopback-Cell-Loss', - 'ascend_atm_vci' => 'Ascend-ATM-Vci', - 'ascend_atm_vpi' => 'Ascend-ATM-Vpi', - 'ascend_auth_delay' => 'Ascend-Auth-Delay', - 'ascend_auth_type' => 'Ascend-Auth-Type', - 'ascend_authen_alias' => 'Ascend-Authen-Alias', - 'ascend_backup' => 'Ascend-Backup', - 'ascend_bacp_enable' => 'Ascend-BACP-Enable', - 'ascend_base_channel_coun' => 'Ascend-Base-Channel-Count', - 'ascend_bi_directional_au' => 'Ascend-Bi-Directional-Auth', - 'ascend_billing_number' => 'Ascend-Billing-Number', - 'ascend_bir_bridge_group' => 'Ascend-BIR-Bridge-Group', - 'ascend_bir_enable' => 'Ascend-BIR-Enable', - 'ascend_bir_proxy' => 'Ascend-BIR-Proxy', - 'ascend_bridge' => 'Ascend-Bridge', - 'ascend_bridge_address' => 'Ascend-Bridge-Address', - 'ascend_bridge_non_pppoe' => 'Ascend-Bridge-Non-PPPoE', - 'ascend_cache_refresh' => 'Ascend-Cache-Refresh', - 'ascend_cache_time' => 'Ascend-Cache-Time', - 'ascend_call_attempt_limi' => 'Ascend-Call-Attempt-Limit', - 'ascend_call_block_durati' => 'Ascend-Call-Block-Duration', - 'ascend_call_by_call' => 'Ascend-Call-By-Call', - 'ascend_call_direction' => 'Ascend-Call-Direction', - 'ascend_call_filter' => 'Ascend-Call-Filter', - 'ascend_call_type' => 'Ascend-Call-Type', - 'ascend_callback' => 'Ascend-Callback', - 'ascend_callback_delay' => 'Ascend-Callback-Delay', - 'ascend_calling_id_number' => 'Ascend-Calling-Id-Number-Plan', - 'ascend_calling_id_presen' => 'Ascend-Calling-Id-Presentatn', - 'ascend_calling_id_screen' => 'Ascend-Calling-Id-Screening', - 'ascend_calling_id_type_o' => 'Ascend-Calling-Id-Type-Of-Num', - 'ascend_calling_subaddres' => 'Ascend-Calling-Subaddress', - 'ascend_cbcp_delay' => 'Ascend-CBCP-Delay', - 'ascend_cbcp_enable' => 'Ascend-CBCP-Enable', - 'ascend_cbcp_mode' => 'Ascend-CBCP-Mode', - 'ascend_cbcp_trunk_group' => 'Ascend-CBCP-Trunk-Group', - 'ascend_cir_timer' => 'Ascend-CIR-Timer', - 'ascend_ckt_type' => 'Ascend-Ckt-Type', - 'ascend_client_assign_dns' => 'Ascend-Client-Assign-DNS', - 'ascend_client_assign_win' => 'Ascend-Client-Assign-WINS', - 'ascend_client_gateway' => 'Ascend-Client-Gateway', - 'ascend_client_primary_dn' => 'Ascend-Client-Primary-DNS', - 'ascend_client_primary_wi' => 'Ascend-Client-Primary-WINS', - 'ascend_client_secondary_' => 'Ascend-Client-Secondary-WINS', - 'ascend_client_secondarya' => 'Ascend-Client-Secondary-DNS', - 'ascend_connect_progress' => 'Ascend-Connect-Progress', - 'ascend_data_filter' => 'Ascend-Data-Filter', - 'ascend_data_rate' => 'Ascend-Data-Rate', - 'ascend_data_svc' => 'Ascend-Data-Svc', - 'ascend_dba_monitor' => 'Ascend-DBA-Monitor', - 'ascend_dec_channel_count' => 'Ascend-Dec-Channel-Count', - 'ascend_destination_nas_p' => 'Ascend-Destination-Nas-Port', - 'ascend_dhcp_maximum_leas' => 'Ascend-DHCP-Maximum-Leases', - 'ascend_dhcp_pool_number' => 'Ascend-DHCP-Pool-Number', - 'ascend_dhcp_reply' => 'Ascend-DHCP-Reply', - 'ascend_dial_number' => 'Ascend-Dial-Number', - 'ascend_dialed_number' => 'Ascend-Dialed-Number', - 'ascend_dialout_allowed' => 'Ascend-Dialout-Allowed', - 'ascend_disconnect_cause' => 'Ascend-Disconnect-Cause', - 'ascend_dropped_octets' => 'Ascend-Dropped-Octets', - 'ascend_dropped_packets' => 'Ascend-Dropped-Packets', - 'ascend_dsl_cir_recv_limi' => 'Ascend-Dsl-CIR-Recv-Limit', - 'ascend_dsl_cir_xmit_limi' => 'Ascend-Dsl-CIR-Xmit-Limit', - 'ascend_dsl_downstream_li' => 'Ascend-Dsl-Downstream-Limit', - 'ascend_dsl_rate_mode' => 'Ascend-Dsl-Rate-Mode', - 'ascend_dsl_rate_type' => 'Ascend-Dsl-Rate-Type', - 'ascend_dsl_upstream_limi' => 'Ascend-Dsl-Upstream-Limit', - 'ascend_egress_enabled' => 'Ascend-Egress-Enabled', - 'ascend_endpoint_disc' => 'Ascend-Endpoint-Disc', - 'ascend_event_type' => 'Ascend-Event-Type', - 'ascend_expect_callback' => 'Ascend-Expect-Callback', - 'ascend_fcp_parameter' => 'Ascend-FCP-Parameter', - 'ascend_filter' => 'Ascend-Filter', - 'ascend_filter_required' => 'Ascend-Filter-Required', - 'ascend_first_dest' => 'Ascend-First-Dest', - 'ascend_force_56' => 'Ascend-Force-56', - 'ascend_fr_08_mode' => 'Ascend-FR-08-Mode', - 'ascend_fr_circuit_name' => 'Ascend-FR-Circuit-Name', - 'ascend_fr_dce_n392' => 'Ascend-FR-DCE-N392', - 'ascend_fr_dce_n393' => 'Ascend-FR-DCE-N393', - 'ascend_fr_direct' => 'Ascend-FR-Direct', - 'ascend_fr_direct_dlci' => 'Ascend-FR-Direct-DLCI', - 'ascend_fr_direct_profile' => 'Ascend-FR-Direct-Profile', - 'ascend_fr_dlci' => 'Ascend-FR-DLCI', - 'ascend_fr_dte_n392' => 'Ascend-FR-DTE-N392', - 'ascend_fr_dte_n393' => 'Ascend-FR-DTE-N393', - 'ascend_fr_link_mgt' => 'Ascend-FR-Link-Mgt', - 'ascend_fr_link_status_dl' => 'Ascend-FR-Link-Status-DLCI', - 'ascend_fr_linkup' => 'Ascend-FR-LinkUp', - 'ascend_fr_n391' => 'Ascend-FR-N391', - 'ascend_fr_nailed_grp' => 'Ascend-FR-Nailed-Grp', - 'ascend_fr_profile_name' => 'Ascend-FR-Profile-Name', - 'ascend_fr_svc_addr' => 'Ascend-FR-SVC-Addr', - 'ascend_fr_t391' => 'Ascend-FR-T391', - 'ascend_fr_t392' => 'Ascend-FR-T392', - 'ascend_fr_type' => 'Ascend-FR-Type', - 'ascend_ft1_caller' => 'Ascend-FT1-Caller', - 'ascend_global_call_id' => 'Ascend-Global-Call-Id', - 'ascend_group' => 'Ascend-Group', - 'ascend_h323_conference_i' => 'Ascend-H323-Conference-Id', - 'ascend_h323_dialed_time' => 'Ascend-H323-Dialed-Time', - 'ascend_h323_fegw_address' => 'Ascend-H323-Fegw-Address', - 'ascend_h323_gatekeeper' => 'Ascend-H323-Gatekeeper', - 'ascend_handle_ipx' => 'Ascend-Handle-IPX', - 'ascend_history_weigh_typ' => 'Ascend-History-Weigh-Type', - 'ascend_home_agent_ip_add' => 'Ascend-Home-Agent-IP-Addr', - 'ascend_home_agent_passwo' => 'Ascend-Home-Agent-Password', - 'ascend_home_agent_udp_po' => 'Ascend-Home-Agent-UDP-Port', - 'ascend_home_network_name' => 'Ascend-Home-Network-Name', - 'ascend_host_info' => 'Ascend-Host-Info', - 'ascend_idle_limit' => 'Ascend-Idle-Limit', - 'ascend_if_netmask' => 'Ascend-IF-Netmask', - 'ascend_inc_channel_count' => 'Ascend-Inc-Channel-Count', - 'ascend_inter_arrival_jit' => 'Ascend-Inter-Arrival-Jitter', - 'ascend_ip_direct' => 'Ascend-IP-Direct', - 'ascend_ip_pool_chaining' => 'Ascend-IP-Pool-Chaining', - 'ascend_ip_pool_definitio' => 'Ascend-IP-Pool-Definition', - 'ascend_ip_tos' => 'Ascend-IP-TOS', - 'ascend_ip_tos_apply_to' => 'Ascend-IP-TOS-Apply-To', - 'ascend_ip_tos_precedence' => 'Ascend-IP-TOS-Precedence', - 'ascend_ipsec_profile' => 'Ascend-IPSEC-Profile', - 'ascend_ipx_alias' => 'Ascend-IPX-Alias', - 'ascend_ipx_header_compre' => 'Ascend-IPX-Header-Compression', - 'ascend_ipx_node_addr' => 'Ascend-IPX-Node-Addr', - 'ascend_ipx_peer_mode' => 'Ascend-IPX-Peer-Mode', - 'ascend_ipx_route' => 'Ascend-IPX-Route', - 'ascend_link_compression' => 'Ascend-Link-Compression', - 'ascend_max_shared_users' => 'Ascend-Max-Shared-Users', - 'ascend_maximum_call_dura' => 'Ascend-Maximum-Call-Duration', - 'ascend_maximum_channels' => 'Ascend-Maximum-Channels', - 'ascend_maximum_time' => 'Ascend-Maximum-Time', - 'ascend_menu_item' => 'Ascend-Menu-Item', - 'ascend_menu_selector' => 'Ascend-Menu-Selector', - 'ascend_metric' => 'Ascend-Metric', - 'ascend_minimum_channels' => 'Ascend-Minimum-Channels', - 'ascend_modem_portno' => 'Ascend-Modem-PortNo', - 'ascend_modem_shelfno' => 'Ascend-Modem-ShelfNo', - 'ascend_modem_slotno' => 'Ascend-Modem-SlotNo', - 'ascend_mpp_idle_percent' => 'Ascend-MPP-Idle-Percent', - 'ascend_mtu' => 'Ascend-MTU', - 'ascend_multicast_client' => 'Ascend-Multicast-Client', - 'ascend_multicast_gleave_' => 'Ascend-Multicast-GLeave-Delay', - 'ascend_multicast_rate_li' => 'Ascend-Multicast-Rate-Limit', - 'ascend_multilink_id' => 'Ascend-Multilink-ID', - 'ascend_nas_port_format' => 'Ascend-NAS-Port-Format', - 'ascend_netware_timeout' => 'Ascend-Netware-timeout', - 'ascend_num_in_multilink' => 'Ascend-Num-In-Multilink', - 'ascend_number_sessions' => 'Ascend-Number-Sessions', - 'ascend_numbering_plan_id' => 'Ascend-Numbering-Plan-ID', - 'ascend_owner_ip_addr' => 'Ascend-Owner-IP-Addr', - 'ascend_port_redir_portnu' => 'Ascend-Port-Redir-Portnum', - 'ascend_port_redir_protoc' => 'Ascend-Port-Redir-Protocol', - 'ascend_port_redir_server' => 'Ascend-Port-Redir-Server', - 'ascend_ppp_address' => 'Ascend-PPP-Address', - 'ascend_ppp_async_map' => 'Ascend-PPP-Async-Map', - 'ascend_ppp_vj_1172' => 'Ascend-PPP-VJ-1172', - 'ascend_ppp_vj_slot_comp' => 'Ascend-PPP-VJ-Slot-Comp', - 'ascend_pppoe_enable' => 'Ascend-PPPoE-Enable', - 'ascend_pre_input_octets' => 'Ascend-Pre-Input-Octets', - 'ascend_pre_input_packets' => 'Ascend-Pre-Input-Packets', - 'ascend_pre_output_octets' => 'Ascend-Pre-Output-Octets', - 'ascend_pre_output_packet' => 'Ascend-Pre-Output-Packets', - 'ascend_preempt_limit' => 'Ascend-Preempt-Limit', - 'ascend_presession_time' => 'Ascend-PreSession-Time', - 'ascend_pri_number_type' => 'Ascend-PRI-Number-Type', - 'ascend_primary_home_agen' => 'Ascend-Primary-Home-Agent', - 'ascend_private_route' => 'Ascend-Private-Route', - 'ascend_private_route_req' => 'Ascend-Private-Route-Required', - 'ascend_private_route_tab' => 'Ascend-Private-Route-Table-ID', - 'ascend_pw_lifetime' => 'Ascend-PW-Lifetime', - 'ascend_pw_warntime' => 'Ascend-PW-Warntime', - 'ascend_qos_downstream' => 'Ascend-QOS-Downstream', - 'ascend_qos_upstream' => 'Ascend-QOS-Upstream', - 'ascend_receive_secret' => 'Ascend-Receive-Secret', - 'ascend_recv_name' => 'Ascend-Recv-Name', - 'ascend_redirect_number' => 'Ascend-Redirect-Number', - 'ascend_remote_addr' => 'Ascend-Remote-Addr', - 'ascend_remote_fw' => 'Ascend-Remote-FW', - 'ascend_remove_seconds' => 'Ascend-Remove-Seconds', - 'ascend_require_auth' => 'Ascend-Require-Auth', - 'ascend_route_appletalk' => 'Ascend-Route-Appletalk', - 'ascend_route_ip' => 'Ascend-Route-IP', - 'ascend_route_ipx' => 'Ascend-Route-IPX', - 'ascend_secondary_home_ag' => 'Ascend-Secondary-Home-Agent', - 'ascend_seconds_of_histor' => 'Ascend-Seconds-Of-History', - 'ascend_send_auth' => 'Ascend-Send-Auth', - 'ascend_send_passwd' => 'Ascend-Send-Passwd', - 'ascend_send_secret' => 'Ascend-Send-Secret', - 'ascend_service_type' => 'Ascend-Service-Type', - 'ascend_session_svr_key' => 'Ascend-Session-Svr-Key', - 'ascend_session_type' => 'Ascend-Session-Type', - 'ascend_shared_profile_en' => 'Ascend-Shared-Profile-Enable', - 'ascend_source_auth' => 'Ascend-Source-Auth', - 'ascend_source_ip_check' => 'Ascend-Source-IP-Check', - 'ascend_svc_enabled' => 'Ascend-SVC-Enabled', - 'ascend_target_util' => 'Ascend-Target-Util', - 'ascend_telnet_profile' => 'Ascend-Telnet-Profile', - 'ascend_temporary_rtes' => 'Ascend-Temporary-Rtes', - 'ascend_third_prompt' => 'Ascend-Third-Prompt', - 'ascend_token_expiry' => 'Ascend-Token-Expiry', - 'ascend_token_idle' => 'Ascend-Token-Idle', - 'ascend_token_immediate' => 'Ascend-Token-Immediate', - 'ascend_traffic_shaper' => 'Ascend-Traffic-Shaper', - 'ascend_transit_number' => 'Ascend-Transit-Number', - 'ascend_ts_idle_limit' => 'Ascend-TS-Idle-Limit', - 'ascend_ts_idle_mode' => 'Ascend-TS-Idle-Mode', - 'ascend_tunnel_vrouter_na' => 'Ascend-Tunnel-VRouter-Name', - 'ascend_tunneling_protoco' => 'Ascend-Tunneling-Protocol', - 'ascend_user_acct_base' => 'Ascend-User-Acct-Base', - 'ascend_user_acct_host' => 'Ascend-User-Acct-Host', - 'ascend_user_acct_key' => 'Ascend-User-Acct-Key', - 'ascend_user_acct_port' => 'Ascend-User-Acct-Port', - 'ascend_user_acct_time' => 'Ascend-User-Acct-Time', - 'ascend_user_acct_type' => 'Ascend-User-Acct-Type', - 'ascend_uu_info' => 'Ascend-UU-Info', - 'ascend_vrouter_name' => 'Ascend-VRouter-Name', - 'ascend_x25_cug' => 'Ascend-X25-Cug', - 'ascend_x25_nui' => 'Ascend-X25-Nui', - 'ascend_x25_nui_password_' => 'Ascend-X25-Nui-Password-Prompt', - 'ascend_x25_nui_prompt' => 'Ascend-X25-Nui-Prompt', - 'ascend_x25_pad_alias_1' => 'Ascend-X25-Pad-Alias-1', - 'ascend_x25_pad_alias_2' => 'Ascend-X25-Pad-Alias-2', - 'ascend_x25_pad_alias_3' => 'Ascend-X25-Pad-Alias-3', - 'ascend_x25_pad_banner' => 'Ascend-X25-Pad-Banner', - 'ascend_x25_pad_prompt' => 'Ascend-X25-Pad-Prompt', - 'ascend_x25_pad_x3_parame' => 'Ascend-X25-Pad-X3-Parameters', - 'ascend_x25_pad_x3_profil' => 'Ascend-X25-Pad-X3-Profile', - 'ascend_x25_profile_name' => 'Ascend-X25-Profile-Name', - 'ascend_x25_reverse_charg' => 'Ascend-X25-Reverse-Charging', - 'ascend_x25_rpoa' => 'Ascend-X25-Rpoa', - 'ascend_x25_x121_address' => 'Ascend-X25-X121-Address', - 'ascend_xmit_rate' => 'Ascend-Xmit-Rate', - 'assigned_ip_address' => 'Assigned_IP_Address', - 'assigned_ip_addrest' => 'Assigned-IP-Address', - 'auth_type' => 'Auth-Type', - 'autz_type' => 'Autz-Type', - 'bg_aging_time' => 'BG_Aging_Time', - 'bg_aging_timf' => 'BG-Aging-Time', - 'bg_path_cost' => 'BG_Path_Cost', - 'bg_path_cosu' => 'BG-Path-Cost', - 'bg_span_dis' => 'BG_Span_Dis', - 'bg_span_dit' => 'BG-Span-Dis', - 'bg_trans_bpdu' => 'BG_Trans_BPDU', - 'bg_trans_bpdv' => 'BG-Trans-BPDU', - 'bind_auth_context' => 'Bind_Auth_Context', - 'bind_auth_contexu' => 'Bind-Auth-Context', - 'bind_auth_max_sessions' => 'Bind_Auth_Max_Sessions', - 'bind_auth_max_sessiont' => 'Bind-Auth-Max-Sessions', - 'bind_auth_protocol' => 'Bind_Auth_Protocol', - 'bind_auth_protocom' => 'Bind-Auth-Protocol', - 'bind_auth_service_grp' => 'Bind_Auth_Service_Grp', - 'bind_auth_service_grq' => 'Bind-Auth-Service-Grp', - 'bind_bypass_bypass' => 'Bind_Bypass_Bypass', - 'bind_bypass_bypast' => 'Bind-Bypass-Bypass', - 'bind_bypass_context' => 'Bind_Bypass_Context', - 'bind_bypass_contexu' => 'Bind-Bypass-Context', - 'bind_dot1q_port' => 'Bind_Dot1q_Port', - 'bind_dot1q_poru' => 'Bind-Dot1q-Port', - 'bind_dot1q_slot' => 'Bind_Dot1q_Slot', - 'bind_dot1q_slou' => 'Bind-Dot1q-Slot', - 'bind_dot1q_vlan_tag_id' => 'Bind_Dot1q_Vlan_Tag_Id', - 'bind_dot1q_vlan_tag_ie' => 'Bind-Dot1q-Vlan-Tag-Id', - 'bind_int_context' => 'Bind_Int_Context', - 'bind_int_contexu' => 'Bind-Int-Context', - 'bind_int_interface_name' => 'Bind_Int_Interface_Name', - 'bind_int_interface_namf' => 'Bind-Int-Interface-Name', - 'bind_l2tp_flow_control' => 'Bind_L2TP_Flow_Control', - 'bind_l2tp_flow_controm' => 'Bind-L2TP-Flow-Control', - 'bind_l2tp_tunnel_name' => 'Bind_L2TP_Tunnel_Name', - 'bind_l2tp_tunnel_namf' => 'Bind-L2TP-Tunnel-Name', - 'bind_ses_context' => 'Bind_Ses_Context', - 'bind_ses_contexu' => 'Bind-Ses-Context', - 'bind_sub_password' => 'Bind_Sub_Password', - 'bind_sub_passwore' => 'Bind-Sub-Password', - 'bind_sub_user_at_context' => 'Bind_Sub_User_At_Context', - 'bind_sub_user_at_contexu' => 'Bind-Sub-User-At-Context', - 'bind_tun_context' => 'Bind_Tun_Context', - 'bind_tun_contexu' => 'Bind-Tun-Context', - 'bind_type' => 'Bind_Type', - 'bind_typf' => 'Bind-Type', - 'bintec_bibodialtable' => 'BinTec-biboDialTable', - 'bintec_biboppptable' => 'BinTec-biboPPPTable', - 'bintec_ipextiftable' => 'BinTec-ipExtIfTable', - 'bintec_ipextrttable' => 'BinTec-ipExtRtTable', - 'bintec_ipfiltertable' => 'BinTec-ipFilterTable', - 'bintec_ipnatpresettable' => 'BinTec-ipNatPresetTable', - 'bintec_ipqostable' => 'BinTec-ipQoSTable', - 'bintec_iproutetable' => 'BinTec-ipRouteTable', - 'bintec_ipxcirctable' => 'BinTec-ipxCircTable', - 'bintec_ipxstaticroutetab' => 'BinTec-ipxStaticRouteTable', - 'bintec_ipxstaticservtabl' => 'BinTec-ipxStaticServTable', - 'bintec_ospfiftable' => 'BinTec-ospfIfTable', - 'bintec_pppextiftable' => 'BinTec-pppExtIfTable', - 'bintec_qosiftable' => 'BinTec-qosIfTable', - 'bintec_qospolicytable' => 'BinTec-qosPolicyTable', - 'bintec_ripcirctable' => 'BinTec-ripCircTable', - 'bintec_sapcirctable' => 'BinTec-sapCircTable', - 'bridge_group' => 'Bridge_Group', - 'bridge_grouq' => 'Bridge-Group', - 'cabletron_protocol_calla' => 'Cabletron-Protocol-Callable', - 'cabletron_protocol_enabl' => 'Cabletron-Protocol-Enable', - 'call_id' => 'call-id', - 'callback_id' => 'Callback-Id', - 'callback_number' => 'Callback-Number', - 'called_station_id' => 'Called-Station-Id', - 'caller_id' => 'Caller-ID', - 'calling_station_id' => 'Calling-Station-Id', - 'cbbsm_bandwidth' => 'CBBSM-Bandwidth', - 'challenge_state' => 'Challenge-State', - 'chap_challenge' => 'CHAP-Challenge', - 'chap_password' => 'CHAP-Password', - 'char_noecho' => 'Char-Noecho', - 'cisco_abort_cause' => 'Cisco-Abort-Cause', - 'cisco_account_info' => 'Cisco-Account-Info', - 'cisco_assign_ip_pool' => 'Cisco-Assign-IP-Pool', - 'cisco_avpair' => 'Cisco-AVPair', - 'cisco_call_filter' => 'Cisco-Call-Filter', - 'cisco_call_type' => 'Cisco-Call-Type', - 'cisco_command_code' => 'Cisco-Command-Code', - 'cisco_control_info' => 'Cisco-Control-Info', - 'cisco_data_filter' => 'Cisco-Data-Filter', - 'cisco_data_rate' => 'Cisco-Data-Rate', - 'cisco_disconnect_cause' => 'Cisco-Disconnect-Cause', - 'cisco_email_server_ack_f' => 'Cisco-Email-Server-Ack-Flag', - 'cisco_email_server_addre' => 'Cisco-Email-Server-Address', - 'cisco_fax_account_id_ori' => 'Cisco-Fax-Account-Id-Origin', - 'cisco_fax_auth_status' => 'Cisco-Fax-Auth-Status', - 'cisco_fax_connect_speed' => 'Cisco-Fax-Connect-Speed', - 'cisco_fax_coverpage_flag' => 'Cisco-Fax-Coverpage-Flag', - 'cisco_fax_dsn_address' => 'Cisco-Fax-Dsn-Address', - 'cisco_fax_dsn_flag' => 'Cisco-Fax-Dsn-Flag', - 'cisco_fax_mdn_address' => 'Cisco-Fax-Mdn-Address', - 'cisco_fax_mdn_flag' => 'Cisco-Fax-Mdn-Flag', - 'cisco_fax_modem_time' => 'Cisco-Fax-Modem-Time', - 'cisco_fax_msg_id' => 'Cisco-Fax-Msg-Id', - 'cisco_fax_pages' => 'Cisco-Fax-Pages', - 'cisco_fax_process_abort_' => 'Cisco-Fax-Process-Abort-Flag', - 'cisco_fax_recipient_coun' => 'Cisco-Fax-Recipient-Count', - 'cisco_gateway_id' => 'Cisco-Gateway-Id', - 'cisco_idle_limit' => 'Cisco-Idle-Limit', - 'cisco_ip_direct' => 'Cisco-IP-Direct', - 'cisco_ip_pool_definition' => 'Cisco-IP-Pool-Definition', - 'cisco_link_compression' => 'Cisco-Link-Compression', - 'cisco_maximum_channels' => 'Cisco-Maximum-Channels', - 'cisco_maximum_time' => 'Cisco-Maximum-Time', - 'cisco_multilink_id' => 'Cisco-Multilink-ID', - 'cisco_nas_port' => 'Cisco-NAS-Port', - 'cisco_num_in_multilink' => 'Cisco-Num-In-Multilink', - 'cisco_port_used' => 'Cisco-Port-Used', - 'cisco_ppp_async_map' => 'Cisco-PPP-Async-Map', - 'cisco_ppp_vj_slot_comp' => 'Cisco-PPP-VJ-Slot-Comp', - 'cisco_pre_input_octets' => 'Cisco-Pre-Input-Octets', - 'cisco_pre_input_packets' => 'Cisco-Pre-Input-Packets', - 'cisco_pre_output_octets' => 'Cisco-Pre-Output-Octets', - 'cisco_pre_output_packets' => 'Cisco-Pre-Output-Packets', - 'cisco_presession_time' => 'Cisco-PreSession-Time', - 'cisco_pw_lifetime' => 'Cisco-PW-Lifetime', - 'cisco_route_ip' => 'Cisco-Route-IP', - 'cisco_service_info' => 'Cisco-Service-Info', - 'cisco_target_util' => 'Cisco-Target-Util', - 'cisco_xmit_rate' => 'Cisco-Xmit-Rate', - 'class' => 'Class', - 'client_dns_pri' => 'Client_DNS_Pri', - 'client_dns_prj' => 'Client-DNS-Pri', - 'client_dns_sec' => 'Client_DNS_Sec', - 'client_dns_sed' => 'Client-DNS-Sec', - 'client_id' => 'Client-Id', - 'client_ip_address' => 'Client-IP-Address', - 'client_port_dnis' => 'Client-Port-DNIS', - 'client_port_id' => 'Client-Port-Id', - 'colubris_avpair' => 'Colubris-AVPair', - 'configuration_token' => 'Configuration-Token', - 'connect_info' => 'Connect-Info', - 'connect_rate' => 'Connect-Rate', - 'context_name' => 'Context_Name', - 'context_namf' => 'Context-Name', - 'crypt_password' => 'Crypt-Password', - 'current_time' => 'Current-Time', - 'cvpn3000_access_hours' => 'CVPN3000-Access-Hours', - 'cvpn3000_allow_network_e' => 'CVPN3000-Allow-Network-Extension-Mode', - 'cvpn3000_auth_server_pas' => 'CVPN3000-Auth-Server-Password', - 'cvpn3000_auth_server_pri' => 'CVPN3000-Auth-Server-Priority', - 'cvpn3000_auth_server_typ' => 'CVPN3000-Auth-Server-Type', - 'cvpn3000_authd_user_idle' => 'CVPN3000-Authd-User-Idle-Timeout', - 'cvpn3000_cisco_ip_phone_' => 'CVPN3000-Cisco-IP-Phone-Bypass', - 'cvpn3000_dhcp_network_sc' => 'CVPN3000-DHCP-Network-Scope', - 'cvpn3000_ike_keep_alives' => 'CVPN3000-IKE-Keep-Alives', - 'cvpn3000_ipsec_allow_pas' => 'CVPN3000-IPSec-Allow-Passwd-Store', - 'cvpn3000_ipsec_auth_on_r' => 'CVPN3000-IPSec-Auth-On-Rekey', - 'cvpn3000_ipsec_authentic' => 'CVPN3000-IPSec-Authentication', - 'cvpn3000_ipsec_authoriza' => 'CVPN3000-IPSec-Authorization-Type', - 'cvpn3000_ipsec_authorizb' => 'CVPN3000-IPSec-Authorization-Required', - 'cvpn3000_ipsec_backup_se' => 'CVPN3000-IPSec-Backup-Servers', - 'cvpn3000_ipsec_backup_sf' => 'CVPN3000-IPSec-Backup-Server-List', - 'cvpn3000_ipsec_banner1' => 'CVPN3000-IPSec-Banner1', - 'cvpn3000_ipsec_banner2' => 'CVPN3000-IPSec-Banner2', - 'cvpn3000_ipsec_client_fw' => 'CVPN3000-IPSec-Client-Fw-Filter-Name', - 'cvpn3000_ipsec_client_fx' => 'CVPN3000-IPSec-Client-Fw-Filter-Opt', - 'cvpn3000_ipsec_confidenc' => 'CVPN3000-IPSec-Confidence-Level', - 'cvpn3000_ipsec_default_d' => 'CVPN3000-IPSec-Default-Domain', - 'cvpn3000_ipsec_dn_field' => 'CVPN3000-IPSec-DN-Field', - 'cvpn3000_ipsec_group_nam' => 'CVPN3000-IPSec-Group-Name', - 'cvpn3000_ipsec_ike_peer_' => 'CVPN3000-IPSec-IKE-Peer-ID-Check', - 'cvpn3000_ipsec_ip_compre' => 'CVPN3000-IPSec-IP-Compression', - 'cvpn3000_ipsec_ltl_keepa' => 'CVPN3000-IPSec-LTL-Keepalives', - 'cvpn3000_ipsec_mode_conf' => 'CVPN3000-IPSec-Mode-Config', - 'cvpn3000_ipsec_over_udp' => 'CVPN3000-IPSec-Over-UDP', - 'cvpn3000_ipsec_over_udp_' => 'CVPN3000-IPSec-Over-UDP-Port', - 'cvpn3000_ipsec_reqrd_cli' => 'CVPN3000-IPSec-Reqrd-Client-Fw-Cap', - 'cvpn3000_ipsec_sec_assoc' => 'CVPN3000-IPSec-Sec-Association', - 'cvpn3000_ipsec_split_dns' => 'CVPN3000-IPSec-Split-DNS-Names', - 'cvpn3000_ipsec_split_tun' => 'CVPN3000-IPSec-Split-Tunnel-List', - 'cvpn3000_ipsec_split_tuo' => 'CVPN3000-IPSec-Split-Tunneling-Policy', - 'cvpn3000_ipsec_tunnel_ty' => 'CVPN3000-IPSec-Tunnel-Type', - 'cvpn3000_ipsec_user_grou' => 'CVPN3000-IPSec-User-Group-Lock', - 'cvpn3000_l2tp_encryption' => 'CVPN3000-L2TP-Encryption', - 'cvpn3000_l2tp_min_auth_p' => 'CVPN3000-L2TP-Min-Auth-Protocol', - 'cvpn3000_l2tp_mppc_compr' => 'CVPN3000-L2TP-MPPC-Compression', - 'cvpn3000_leap_bypass' => 'CVPN3000-LEAP-Bypass', - 'cvpn3000_ms_client_icpt_' => 'CVPN3000-MS-Client-Icpt-DHCP-Conf-Msg', - 'cvpn3000_ms_client_subne' => 'CVPN3000-MS-Client-Subnet-Mask', - 'cvpn3000_partition_max_s' => 'CVPN3000-Partition-Max-Sessions', - 'cvpn3000_partition_mobil' => 'CVPN3000-Partition-Mobile-IP-Key', - 'cvpn3000_partition_mobim' => 'CVPN3000-Partition-Mobile-IP-Address', - 'cvpn3000_partition_mobin' => 'CVPN3000-Partition-Mobile-IP-SPI', - 'cvpn3000_partition_premi' => 'CVPN3000-Partition-Premise-Router', - 'cvpn3000_partition_prima' => 'CVPN3000-Partition-Primary-DHCP', - 'cvpn3000_partition_secon' => 'CVPN3000-Partition-Secondary-DHCP', - 'cvpn3000_pptp_encryption' => 'CVPN3000-PPTP-Encryption', - 'cvpn3000_pptp_min_auth_p' => 'CVPN3000-PPTP-Min-Auth-Protocol', - 'cvpn3000_pptp_mppc_compr' => 'CVPN3000-PPTP-MPPC-Compression', - 'cvpn3000_primary_dns' => 'CVPN3000-Primary-DNS', - 'cvpn3000_primary_wins' => 'CVPN3000-Primary-WINS', - 'cvpn3000_priority_on_sep' => 'CVPN3000-Priority-On-SEP', - 'cvpn3000_reqrd_client_fw' => 'CVPN3000-Reqrd-Client-Fw-Vendor-Code', - 'cvpn3000_reqrd_client_fx' => 'CVPN3000-Reqrd-Client-Fw-Product-Code', - 'cvpn3000_reqrd_client_fy' => 'CVPN3000-Reqrd-Client-Fw-Description', - 'cvpn3000_request_auth_ve' => 'CVPN3000-Request-Auth-Vector', - 'cvpn3000_require_hw_clie' => 'CVPN3000-Require-HW-Client-Auth', - 'cvpn3000_require_individ' => 'CVPN3000-Require-Individual-User-Auth', - 'cvpn3000_secondary_dns' => 'CVPN3000-Secondary-DNS', - 'cvpn3000_secondary_wins' => 'CVPN3000-Secondary-WINS', - 'cvpn3000_sep_card_assign' => 'CVPN3000-SEP-Card-Assignment', - 'cvpn3000_simultaneous_lo' => 'CVPN3000-Simultaneous-Logins', - 'cvpn3000_strip_realm' => 'CVPN3000-Strip-Realm', - 'cvpn3000_tunneling_proto' => 'CVPN3000-Tunneling-Protocols', - 'cvpn3000_use_client_addr' => 'CVPN3000-Use-Client-Address', - 'cvpn3000_user_auth_serve' => 'CVPN3000-User-Auth-Server-Name', - 'cvpn3000_user_auth_servf' => 'CVPN3000-User-Auth-Server-Port', - 'cvpn3000_user_auth_servg' => 'CVPN3000-User-Auth-Server-Secret', - 'cvpn5000_client_assigned' => 'CVPN5000-Client-Assigned-IP', - 'cvpn5000_client_assignee' => 'CVPN5000-Client-Assigned-IPX', - 'cvpn5000_client_real_ip' => 'CVPN5000-Client-Real-IP', - 'cvpn5000_echo' => 'CVPN5000-Echo', - 'cvpn5000_tunnel_throughp' => 'CVPN5000-Tunnel-Throughput', - 'cvpn5000_vpn_groupinfo' => 'CVPN5000-VPN-GroupInfo', - 'cvpn5000_vpn_password' => 'CVPN5000-VPN-Password', - 'cvx_assign_ip_pool' => 'CVX-Assign-IP-Pool', - 'cvx_client_assign_dns' => 'CVX-Client-Assign-DNS', - 'cvx_data_filter' => 'CVX-Data-Filter', - 'cvx_data_rate' => 'CVX-Data-Rate', - 'cvx_disconnect_cause' => 'CVX-Disconnect-Cause', - 'cvx_identification' => 'CVX-Identification', - 'cvx_idle_limit' => 'CVX-Idle-Limit', - 'cvx_ipsvc_aznlvl' => 'CVX-IPSVC-AZNLVL', - 'cvx_ipsvc_mask' => 'CVX-IPSVC-Mask', - 'cvx_maximum_channels' => 'CVX-Maximum-Channels', - 'cvx_modem_begin_modulati' => 'CVX-Modem-Begin-Modulation', - 'cvx_modem_begin_recv_lin' => 'CVX-Modem-Begin-Recv-Line-Lvl', - 'cvx_modem_data_compressi' => 'CVX-Modem-Data-Compression', - 'cvx_modem_end_modulation' => 'CVX-Modem-End-Modulation', - 'cvx_modem_end_recv_line_' => 'CVX-Modem-End-Recv-Line-Lvl', - 'cvx_modem_error_correcti' => 'CVX-Modem-Error-Correction', - 'cvx_modem_local_rate_neg' => 'CVX-Modem-Local-Rate-Negs', - 'cvx_modem_local_retrains' => 'CVX-Modem-Local-Retrains', - 'cvx_modem_remote_rate_ne' => 'CVX-Modem-Remote-Rate-Negs', - 'cvx_modem_remote_retrain' => 'CVX-Modem-Remote-Retrains', - 'cvx_modem_retx_packets' => 'CVX-Modem-ReTx-Packets', - 'cvx_modem_snr' => 'CVX-Modem-SNR', - 'cvx_modem_tx_packets' => 'CVX-Modem-Tx-Packets', - 'cvx_multicast_client' => 'CVX-Multicast-Client', - 'cvx_multicast_rate_limit' => 'CVX-Multicast-Rate-Limit', - 'cvx_multilink_group_numb' => 'CVX-Multilink-Group-Number', - 'cvx_multilink_match_info' => 'CVX-Multilink-Match-Info', - 'cvx_ppp_address' => 'CVX-PPP-Address', - 'cvx_ppp_log_mask' => 'CVX-PPP-Log-Mask', - 'cvx_presession_time' => 'CVX-PreSession-Time', - 'cvx_primary_dns' => 'CVX-Primary-DNS', - 'cvx_radius_redirect' => 'CVX-Radius-Redirect', - 'cvx_secondary_dns' => 'CVX-Secondary-DNS', - 'cvx_ss7_session_id_type' => 'CVX-SS7-Session-ID-Type', - 'cvx_vpop_id' => 'CVX-VPOP-ID', - 'cvx_xmit_rate' => 'CVX-Xmit-Rate', - 'dhcp_max_leases' => 'DHCP_Max_Leases', - 'dhcp_max_leaset' => 'DHCP-Max-Leases', - 'dialback_name' => 'Dialback-Name', - 'dialback_no' => 'Dialback-No', - 'digest_algorithm' => 'Digest-Algorithm', - 'digest_attributes' => 'Digest-Attributes', - 'digest_body_digest' => 'Digest-Body-Digest', - 'digest_cnonce' => 'Digest-CNonce', - 'digest_method' => 'Digest-Method', - 'digest_nonce' => 'Digest-Nonce', - 'digest_nonce_count' => 'Digest-Nonce-Count', - 'digest_qop' => 'Digest-QOP', - 'digest_realm' => 'Digest-Realm', - 'digest_response' => 'Digest-Response', - 'digest_uri' => 'Digest-URI', - 'digest_user_name' => 'Digest-User-Name', - 'eap_code' => 'EAP-Code', - 'eap_id' => 'EAP-Id', - 'eap_md5_password' => 'EAP-MD5-Password', - 'eap_message' => 'EAP-Message', - 'eap_sim_any_id_req' => 'EAP-Sim-ANY_ID_REQ', - 'eap_sim_checkcode' => 'EAP-Sim-CHECKCODE', - 'eap_sim_counter' => 'EAP-Sim-COUNTER', - 'eap_sim_counter_too_smal' => 'EAP-Sim-COUNTER_TOO_SMALL', - 'eap_sim_encr_data' => 'EAP-Sim-ENCR_DATA', - 'eap_sim_extra' => 'EAP-Sim-EXTRA', - 'eap_sim_fullauth_id_req' => 'EAP-Sim-FULLAUTH_ID_REQ', - 'eap_sim_hmac' => 'EAP-Sim-HMAC', - 'eap_sim_identity' => 'EAP-Sim-IDENTITY', - 'eap_sim_imsi' => 'EAP-Sim-IMSI', - 'eap_sim_iv' => 'EAP-Sim-IV', - 'eap_sim_kc1' => 'EAP-Sim-KC1', - 'eap_sim_kc2' => 'EAP-Sim-KC2', - 'eap_sim_kc3' => 'EAP-Sim-KC3', - 'eap_sim_key' => 'EAP-Sim-KEY', - 'eap_sim_mac' => 'EAP-Sim-MAC', - 'eap_sim_next_pseudonum' => 'EAP-Sim-NEXT_PSEUDONUM', - 'eap_sim_next_reauth_id' => 'EAP-Sim-NEXT_REAUTH_ID', - 'eap_sim_nonce_mt' => 'EAP-Sim-NONCE_MT', - 'eap_sim_nonce_s' => 'EAP-Sim-NONCE_S', - 'eap_sim_notification' => 'EAP-Sim-NOTIFICATION', - 'eap_sim_padding' => 'EAP-Sim-PADDING', - 'eap_sim_permanent_id_req' => 'EAP-Sim-PERMANENT_ID_REQ', - 'eap_sim_rand' => 'EAP-Sim-RAND', - 'eap_sim_rand1' => 'EAP-Sim-Rand1', - 'eap_sim_rand2' => 'EAP-Sim-Rand2', - 'eap_sim_rand3' => 'EAP-Sim-Rand3', - 'eap_sim_selected_version' => 'EAP-Sim-SELECTED_VERSION', - 'eap_sim_sres1' => 'EAP-Sim-SRES1', - 'eap_sim_sres2' => 'EAP-Sim-SRES2', - 'eap_sim_sres3' => 'EAP-Sim-SRES3', - 'eap_sim_state' => 'EAP-Sim-State', - 'eap_sim_subtype' => 'EAP-Sim-Subtype', - 'eap_sim_version_list' => 'EAP-Sim-VERSION_LIST', - 'eap_tls_require_client_c' => 'EAP-TLS-Require-Client-Cert', - 'eap_type' => 'EAP-Type', - 'eap_type_gtc' => 'EAP-Type-GTC', - 'eap_type_identity' => 'EAP-Type-Identity', - 'eap_type_leap' => 'EAP-Type-LEAP', - 'eap_type_md5' => 'EAP-Type-MD5', - 'eap_type_nak' => 'EAP-Type-NAK', - 'eap_type_notification' => 'EAP-Type-Notification', - 'eap_type_otp' => 'EAP-Type-OTP', - 'eap_type_peap' => 'EAP-Type-PEAP', - 'eap_type_sim' => 'EAP-Type-SIM', - 'eap_type_sim2' => 'EAP-Type-SIM2', - 'eap_type_tls' => 'EAP-Type-TLS', - 'eap_type_ttls' => 'EAP-Type-TTLS', - 'error_cause' => 'Error-Cause', - 'erx_address_pool_name' => 'ERX-Address-Pool-Name', - 'erx_alternate_cli_access' => 'ERX-Alternate-Cli-Access-Level', - 'erx_alternate_cli_vroute' => 'ERX-Alternate-Cli-Vrouter-Name', - 'erx_atm_mbs' => 'ERX-Atm-MBS', - 'erx_atm_pcr' => 'ERX-Atm-PCR', - 'erx_atm_scr' => 'ERX-Atm-SCR', - 'erx_atm_service_category' => 'ERX-Atm-Service-Category', - 'erx_bearer_type' => 'ERX-Bearer-Type', - 'erx_cli_allow_all_vr_acc' => 'ERX-Cli-Allow-All-VR-Access', - 'erx_cli_initial_access_l' => 'ERX-Cli-Initial-Access-Level', - 'erx_dial_out_number' => 'ERX-Dial-Out-Number', - 'erx_egress_policy_name' => 'ERX-Egress-Policy-Name', - 'erx_egress_statistics' => 'ERX-Egress-Statistics', - 'erx_framed_ip_route_tag' => 'ERX-Framed-Ip-Route-Tag', - 'erx_igmp_enable' => 'ERX-Igmp-Enable', - 'erx_ingress_policy_name' => 'ERX-Ingress-Policy-Name', - 'erx_ingress_statistics' => 'ERX-Ingress-Statistics', - 'erx_input_gigapkts' => 'ERX-Input-Gigapkts', - 'erx_ipv6_local_interface' => 'ERX-IpV6-Local-Interface', - 'erx_ipv6_primary_dns' => 'ERX-Ipv6-Primary-Dns', - 'erx_ipv6_secondary_dns' => 'ERX-Ipv6-Secondary-Dns', - 'erx_ipv6_virtual_router' => 'ERX-IpV6-Virtual-Router', - 'erx_local_loopback_inter' => 'ERX-Local-Loopback-Interface', - 'erx_maximum_bps' => 'ERX-Maximum-BPS', - 'erx_minimum_bps' => 'ERX-Minimum-BPS', - 'erx_output_gigapkts' => 'ERX-Output-Gigapkts', - 'erx_ppp_auth_protocol' => 'ERX-PPP-Auth-Protocol', - 'erx_ppp_password' => 'ERX-PPP-Password', - 'erx_ppp_username' => 'ERX-PPP-Username', - 'erx_pppoe_description' => 'ERX-Pppoe-Description', - 'erx_pppoe_max_sessions' => 'ERX-Pppoe-Max-Sessions', - 'erx_pppoe_url' => 'ERX-Pppoe-Url', - 'erx_primary_dns' => 'ERX-Primary-Dns', - 'erx_primary_wins' => 'ERX-Primary-Wins', - 'erx_qos_profile_interfac' => 'ERX-Qos-Profile-Interface-Type', - 'erx_qos_profile_name' => 'ERX-Qos-Profile-Name', - 'erx_redirect_vr_name' => 'ERX-Redirect-VR-Name', - 'erx_sa_validate' => 'ERX-Sa-Validate', - 'erx_secondary_dns' => 'ERX-Secondary-Dns', - 'erx_secondary_wins' => 'ERX-Secondary-Wins', - 'erx_service_bundle' => 'ERX-Service-Bundle', - 'erx_tunnel_interface_id' => 'ERX-Tunnel-Interface-Id', - 'erx_tunnel_maximum_sessi' => 'ERX-Tunnel-Maximum-Sessions', - 'erx_tunnel_nas_port_meth' => 'ERX-Tunnel-Nas-Port-Method', - 'erx_tunnel_password' => 'ERX-Tunnel-Password', - 'erx_tunnel_tos' => 'ERX-Tunnel-Tos', - 'erx_tunnel_virtual_route' => 'ERX-Tunnel-Virtual-Router', - 'erx_virtual_router_name' => 'ERX-Virtual-Router-Name', - 'event_timestamp' => 'Event-Timestamp', - 'exec_program' => 'Exec-Program', - 'exec_program_wait' => 'Exec-Program-Wait', - 'expiration' => 'Expiration', - 'extreme_netlogin_only' => 'Extreme-Netlogin-Only', - 'extreme_netlogin_url' => 'Extreme-Netlogin-Url', - 'extreme_netlogin_url_des' => 'Extreme-Netlogin-Url-Desc', - 'extreme_netlogin_vlan' => 'Extreme-Netlogin-Vlan', - 'fall_through' => 'Fall-Through', - 'filter_id' => 'Filter-Id', - 'foundry_command_exceptio' => 'Foundry-Command-Exception-Flag', - 'foundry_command_string' => 'Foundry-Command-String', - 'foundry_inm_privilege' => 'Foundry-INM-Privilege', - 'foundry_privilege_level' => 'Foundry-Privilege-Level', - 'framed_address' => 'Framed-Address', - 'framed_appletalk_link' => 'Framed-AppleTalk-Link', - 'framed_appletalk_network' => 'Framed-AppleTalk-Network', - 'framed_appletalk_zone' => 'Framed-AppleTalk-Zone', - 'framed_callback_id' => 'Framed-Callback-Id', - 'framed_compression' => 'Framed-Compression', - 'framed_filter_id' => 'Framed-Filter-Id', - 'framed_interface_id' => 'Framed-Interface-Id', - 'framed_ip_address' => 'Framed-IP-Address', - 'framed_ip_netmask' => 'Framed-IP-Netmask', - 'framed_ipv6_pool' => 'Framed-IPv6-Pool', - 'framed_ipv6_prefix' => 'Framed-IPv6-Prefix', - 'framed_ipv6_route' => 'Framed-IPv6-Route', - 'framed_ipx_network' => 'Framed-IPX-Network', - 'framed_mtu' => 'Framed-MTU', - 'framed_netmask' => 'Framed-Netmask', - 'framed_pool' => 'Framed-Pool', - 'framed_protocol' => 'Framed-Protocol', - 'framed_route' => 'Framed-Route', - 'framed_routing' => 'Framed-Routing', - 'freeradius_proxied_to' => 'FreeRADIUS-Proxied-To', - 'gandalf_around_the_corne' => 'Gandalf-Around-The-Corner', - 'gandalf_authentication_s' => 'Gandalf-Authentication-String', - 'gandalf_calling_line_id_' => 'Gandalf-Calling-Line-ID-1', - 'gandalf_calling_line_ida' => 'Gandalf-Calling-Line-ID-2', - 'gandalf_channel_group_na' => 'Gandalf-Channel-Group-Name-1', - 'gandalf_channel_group_nb' => 'Gandalf-Channel-Group-Name-2', - 'gandalf_compression_stat' => 'Gandalf-Compression-Status', - 'gandalf_dial_prefix_name' => 'Gandalf-Dial-Prefix-Name-1', - 'gandalf_dial_prefix_namf' => 'Gandalf-Dial-Prefix-Name-2', - 'gandalf_fwd_broadcast_in' => 'Gandalf-Fwd-Broadcast-In', - 'gandalf_fwd_broadcast_ou' => 'Gandalf-Fwd-Broadcast-Out', - 'gandalf_fwd_multicast_in' => 'Gandalf-Fwd-Multicast-In', - 'gandalf_fwd_multicast_ou' => 'Gandalf-Fwd-Multicast-Out', - 'gandalf_fwd_unicast_in' => 'Gandalf-Fwd-Unicast-In', - 'gandalf_fwd_unicast_out' => 'Gandalf-Fwd-Unicast-Out', - 'gandalf_hunt_group' => 'Gandalf-Hunt-Group', - 'gandalf_ipx_spoofing_sta' => 'Gandalf-IPX-Spoofing-State', - 'gandalf_ipx_watchdog_spo' => 'Gandalf-IPX-Watchdog-Spoof', - 'gandalf_min_outgoing_bea' => 'Gandalf-Min-Outgoing-Bearer', - 'gandalf_modem_mode' => 'Gandalf-Modem-Mode', - 'gandalf_modem_required_1' => 'Gandalf-Modem-Required-1', - 'gandalf_modem_required_2' => 'Gandalf-Modem-Required-2', - 'gandalf_operational_mode' => 'Gandalf-Operational-Modes', - 'gandalf_phone_number_1' => 'Gandalf-Phone-Number-1', - 'gandalf_phone_number_2' => 'Gandalf-Phone-Number-2', - 'gandalf_ppp_authenticati' => 'Gandalf-PPP-Authentication', - 'gandalf_ppp_ncp_type' => 'Gandalf-PPP-NCP-Type', - 'gandalf_remote_lan_name' => 'Gandalf-Remote-LAN-Name', - 'gandalf_sap_group_name_1' => 'Gandalf-SAP-Group-Name-1', - 'gandalf_sap_group_name_2' => 'Gandalf-SAP-Group-Name-2', - 'gandalf_sap_group_name_3' => 'Gandalf-SAP-Group-Name-3', - 'gandalf_sap_group_name_4' => 'Gandalf-SAP-Group-Name-4', - 'gandalf_sap_group_name_5' => 'Gandalf-SAP-Group-Name-5', - 'garderos_location_name' => 'Garderos-Location-Name', - 'garderos_service_name' => 'Garderos-Service-Name', - 'group' => 'Group', - 'group_name' => 'Group-Name', - 'gw_final_xlated_cdn' => 'gw-final-xlated-cdn', - 'gw_rxd_cdn' => 'gw-rxd-cdn', - 'h323_billing_model' => 'h323-billing-model', - 'h323_call_origin' => 'h323-call-origin', - 'h323_call_type' => 'h323-call-type', - 'h323_conf_id' => 'h323-conf-id', - 'h323_connect_time' => 'h323-connect-time', - 'h323_credit_amount' => 'h323-credit-amount', - 'h323_credit_time' => 'h323-credit-time', - 'h323_currency' => 'h323-currency', - 'h323_disconnect_cause' => 'h323-disconnect-cause', - 'h323_disconnect_time' => 'h323-disconnect-time', - 'h323_gw_id' => 'h323-gw-id', - 'h323_incoming_conf_id' => 'h323-incoming-conf-id', - 'h323_preferred_lang' => 'h323-preferred-lang', - 'h323_prompt_id' => 'h323-prompt-id', - 'h323_redirect_ip_address' => 'h323-redirect-ip-address', - 'h323_redirect_number' => 'h323-redirect-number', - 'h323_remote_address' => 'h323-remote-address', - 'h323_return_code' => 'h323-return-code', - 'h323_setup_time' => 'h323-setup-time', - 'h323_time_and_day' => 'h323-time-and-day', - 'h323_voice_quality' => 'h323-voice-quality', - 'hint' => 'Hint', - 'huntgroup_name' => 'Huntgroup-Name', - 'idle_timeout' => 'Idle-Timeout', - 'incoming_req_uri' => 'incoming-req-uri', - 'initial_modulation_type' => 'Initial-Modulation-Type', - 'ip3_ip_option' => 'IP3-IP-Option', - 'ip3_rdata_rate' => 'IP3-RData-Rate', - 'ip3_xdata_rate' => 'IP3-XData-Rate', - 'ip_address_pool_name' => 'Ip_Address_Pool_Name', - 'ip_address_pool_namf' => 'Ip-Address-Pool-Name', - 'ip_host_addr' => 'Ip_Host_Addr', - 'ip_host_adds' => 'Ip-Host-Addr', - 'ip_tos_field' => 'IP_TOS_Field', - 'ip_tos_fiele' => 'IP-TOS-Field', - 'itk_acct_serv_ip' => 'ITK-Acct-Serv-IP', - 'itk_acct_serv_prot' => 'ITK-Acct-Serv-Prot', - 'itk_auth_req_type' => 'ITK-Auth-Req-Type', - 'itk_auth_serv_ip' => 'ITK-Auth-Serv-IP', - 'itk_auth_serv_prot' => 'ITK-Auth-Serv-Prot', - 'itk_banner' => 'ITK-Banner', - 'itk_channel_binding' => 'ITK-Channel-Binding', - 'itk_ddi' => 'ITK-DDI', - 'itk_dest_no' => 'ITK-Dest-No', - 'itk_dialout_type' => 'ITK-Dialout-Type', - 'itk_filter_rule' => 'ITK-Filter-Rule', - 'itk_ftp_auth_ip' => 'ITK-Ftp-Auth-IP', - 'itk_ip_pool' => 'ITK-IP-Pool', - 'itk_isdn_prot' => 'ITK-ISDN-Prot', - 'itk_modem_init_string' => 'ITK-Modem-Init-String', - 'itk_modem_pool_id' => 'ITK-Modem-Pool-Id', - 'itk_nas_name' => 'ITK-NAS-Name', - 'itk_password_prompt' => 'ITK-Password-Prompt', - 'itk_ppp_auth_type' => 'ITK-PPP-Auth-Type', - 'itk_ppp_client_server_mo' => 'ITK-PPP-Client-Server-Mode', - 'itk_ppp_compression_prot' => 'ITK-PPP-Compression-Prot', - 'itk_prompt' => 'ITK-Prompt', - 'itk_provider_id' => 'ITK-Provider-Id', - 'itk_start_delay' => 'ITK-Start-Delay', - 'itk_tunnel_ip' => 'ITK-Tunnel-IP', - 'itk_tunnel_prot' => 'ITK-Tunnel-Prot', - 'itk_usergroup' => 'ITK-Usergroup', - 'itk_username' => 'ITK-Username', - 'itk_username_prompt' => 'ITK-Username-Prompt', - 'itk_users_default_entry' => 'ITK-Users-Default-Entry', - 'itk_users_default_pw' => 'ITK-Users-Default-Pw', - 'itk_welcome_message' => 'ITK-Welcome-Message', - 'juniper_allow_commands' => 'Juniper-Allow-Commands', - 'juniper_allow_configurat' => 'Juniper-Allow-Configuration', - 'juniper_deny_commands' => 'Juniper-Deny-Commands', - 'juniper_deny_configurati' => 'Juniper-Deny-Configuration', - 'juniper_local_user_name' => 'Juniper-Local-User-Name', - 'karlnet_turbocell_name' => 'KarlNet-TurboCell-Name', - 'karlnet_turbocell_opmode' => 'KarlNet-TurboCell-OpMode', - 'karlnet_turbocell_opstat' => 'KarlNet-TurboCell-OpState', - 'karlnet_turbocell_txrate' => 'KarlNet-TurboCell-TxRate', - 'lac_port' => 'LAC_Port', - 'lac_port_type' => 'LAC_Port_Type', - 'lac_port_typf' => 'LAC-Port-Type', - 'lac_poru' => 'LAC-Port', - 'lac_real_port' => 'LAC_Real_Port', - 'lac_real_port_type' => 'LAC_Real_Port_Type', - 'lac_real_port_typf' => 'LAC-Real-Port-Type', - 'lac_real_poru' => 'LAC-Real-Port', - 'ldap_group' => 'Ldap-Group', - 'ldap_userdn' => 'Ldap-UserDn', - 'le_admin_group' => 'LE-Admin-Group', - 'le_advice_of_charge' => 'LE-Advice-of-Charge', - 'le_connect_detail' => 'LE-Connect-Detail', - 'le_ip_gateway' => 'LE-IP-Gateway', - 'le_ip_pool' => 'LE-IP-Pool', - 'le_ipsec_active_profile' => 'LE-IPSec-Active-Profile', - 'le_ipsec_deny_action' => 'LE-IPSec-Deny-Action', - 'le_ipsec_log_options' => 'LE-IPSec-Log-Options', - 'le_ipsec_outsource_profi' => 'LE-IPSec-Outsource-Profile', - 'le_ipsec_passive_profile' => 'LE-IPSec-Passive-Profile', - 'le_modem_info' => 'LE-Modem-Info', - 'le_multicast_client' => 'LE-Multicast-Client', - 'le_nat_inmap' => 'LE-NAT-Inmap', - 'le_nat_log_options' => 'LE-NAT-Log-Options', - 'le_nat_other_session_tim' => 'LE-NAT-Other-Session-Timeout', - 'le_nat_outmap' => 'LE-NAT-Outmap', - 'le_nat_outsource_inmap' => 'LE-NAT-Outsource-Inmap', - 'le_nat_outsource_outmap' => 'LE-NAT-Outsource-Outmap', - 'le_nat_sess_dir_fail_act' => 'LE-NAT-Sess-Dir-Fail-Action', - 'le_nat_tcp_session_timeo' => 'LE-NAT-TCP-Session-Timeout', - 'le_terminate_detail' => 'LE-Terminate-Detail', - 'lm_password' => 'LM-Password', - 'local_web_acct_duration' => 'Local-Web-Acct-Duration', - 'local_web_acct_interim_r' => 'Local-Web-Acct-Interim-Rx-Bytes', - 'local_web_acct_interim_s' => 'Local-Web-Acct-Interim-Rx-Gigawords', - 'local_web_acct_interim_t' => 'Local-Web-Acct-Interim-Tx-Bytes', - 'local_web_acct_interim_u' => 'Local-Web-Acct-Interim-Tx-Gigawords', - 'local_web_acct_interim_v' => 'Local-Web-Acct-Interim-Tx-Mgmt', - 'local_web_acct_interim_w' => 'Local-Web-Acct-Interim-Rx-Mgmt', - 'local_web_acct_rx_mgmt' => 'Local-Web-Acct-Rx-Mgmt', - 'local_web_acct_time' => 'Local-Web-Acct-Time', - 'local_web_acct_tx_mgmt' => 'Local-Web-Acct-Tx-Mgmt', - 'local_web_border_router' => 'Local-Web-Border-Router', - 'local_web_client_ip' => 'Local-Web-Client-Ip', - 'local_web_reauth_counter' => 'Local-Web-Reauth-Counter', - 'local_web_rx_limit' => 'Local-Web-Rx-Limit', - 'local_web_tx_limit' => 'Local-Web-Tx-Limit', - 'login_callback_number' => 'Login-Callback-Number', - 'login_host' => 'Login-Host', - 'login_ip_host' => 'Login-IP-Host', - 'login_ipv6_host' => 'Login-IPv6-Host', - 'login_lat_group' => 'Login-LAT-Group', - 'login_lat_node' => 'Login-LAT-Node', - 'login_lat_port' => 'Login-LAT-Port', - 'login_lat_service' => 'Login-LAT-Service', - 'login_port' => 'Login-Port', - 'login_service' => 'Login-Service', - 'login_tcp_port' => 'Login-TCP-Port', - 'login_time' => 'Login-Time', - 'mcast_maxgroups' => 'Mcast_MaxGroups', - 'mcast_maxgroupt' => 'Mcast-MaxGroups', - 'mcast_receive' => 'Mcast_Receive', - 'mcast_receivf' => 'Mcast-Receive', - 'mcast_send' => 'Mcast_Send', - 'mcast_sene' => 'Mcast-Send', - 'medium_type' => 'Medium_Type', - 'medium_typf' => 'Medium-Type', - 'menu' => 'Menu', - 'merit_proxy_action' => 'Merit-Proxy-Action', - 'merit_user_id' => 'Merit-User-Id', - 'merit_user_realm' => 'Merit-User-Realm', - 'message_authenticator' => 'Message-Authenticator', - 'method' => 'method', - 'mikrotik_group' => 'Mikrotik-Group', - 'mikrotik_recv_limit' => 'Mikrotik-Recv-Limit', - 'mikrotik_xmit_limit' => 'Mikrotik-Xmit-Limit', - 'module_failure_message' => 'Module-Failure-Message', - 'module_success_message' => 'Module-Success-Message', - 'motorola_canopy_cirenabl' => 'Motorola-Canopy-CIRENABLE', - 'motorola_canopy_dlba' => 'Motorola-Canopy-DLBA', - 'motorola_canopy_enable' => 'Motorola-Canopy-Enable', - 'motorola_canopy_higherbw' => 'Motorola-Canopy-HIGHERBW', - 'motorola_canopy_hpcenabl' => 'Motorola-Canopy-HPCENABLE', - 'motorola_canopy_hpsdldr' => 'Motorola-Canopy-HPSDLDR', - 'motorola_canopy_hpsuldr' => 'Motorola-Canopy-HPSULDR', - 'motorola_canopy_lpsdldr' => 'Motorola-Canopy-LPSDLDR', - 'motorola_canopy_lpsuldr' => 'Motorola-Canopy-LPSULDR', - 'motorola_canopy_sdldr' => 'Motorola-Canopy-SDLDR', - 'motorola_canopy_shared_s' => 'Motorola-Canopy-Shared-Secret', - 'motorola_canopy_suldr' => 'Motorola-Canopy-SULDR', - 'motorola_canopy_ulba' => 'Motorola-Canopy-ULBA', - 'ms_acct_auth_type' => 'MS-Acct-Auth-Type', - 'ms_acct_eap_type' => 'MS-Acct-EAP-Type', - 'ms_arap_pw_change_reason' => 'MS-ARAP-PW-Change-Reason', - 'ms_bap_usage' => 'MS-BAP-Usage', - 'ms_chap2_cpw' => 'MS-CHAP2-CPW', - 'ms_chap2_response' => 'MS-CHAP2-Response', - 'ms_chap2_success' => 'MS-CHAP2-Success', - 'ms_chap_challenge' => 'MS-CHAP-Challenge', - 'ms_chap_cpw_1' => 'MS-CHAP-CPW-1', - 'ms_chap_cpw_2' => 'MS-CHAP-CPW-2', - 'ms_chap_domain' => 'MS-CHAP-Domain', - 'ms_chap_error' => 'MS-CHAP-Error', - 'ms_chap_lm_enc_pw' => 'MS-CHAP-LM-Enc-PW', - 'ms_chap_mppe_keys' => 'MS-CHAP-MPPE-Keys', - 'ms_chap_nt_enc_pw' => 'MS-CHAP-NT-Enc-PW', - 'ms_chap_response' => 'MS-CHAP-Response', - 'ms_chap_use_ntlm_auth' => 'MS-CHAP-Use-NTLM-Auth', - 'ms_filter' => 'MS-Filter', - 'ms_link_drop_time_limit' => 'MS-Link-Drop-Time-Limit', - 'ms_link_utilization_thre' => 'MS-Link-Utilization-Threshold', - 'ms_mppe_encryption_polic' => 'MS-MPPE-Encryption-Policy', - 'ms_mppe_encryption_type' => 'MS-MPPE-Encryption-Type', - 'ms_mppe_encryption_types' => 'MS-MPPE-Encryption-Types', - 'ms_mppe_recv_key' => 'MS-MPPE-Recv-Key', - 'ms_mppe_send_key' => 'MS-MPPE-Send-Key', - 'ms_new_arap_password' => 'MS-New-ARAP-Password', - 'ms_old_arap_password' => 'MS-Old-ARAP-Password', - 'ms_primary_dns_server' => 'MS-Primary-DNS-Server', - 'ms_primary_nbns_server' => 'MS-Primary-NBNS-Server', - 'ms_ras_vendor' => 'MS-RAS-Vendor', - 'ms_ras_version' => 'MS-RAS-Version', - 'ms_secondary_dns_server' => 'MS-Secondary-DNS-Server', - 'ms_secondary_nbns_server' => 'MS-Secondary-NBNS-Server', - 'multi_link_flag' => 'Multi-Link-Flag', - 'nas_identifier' => 'NAS-Identifier', - 'nas_ip_address' => 'NAS-IP-Address', - 'nas_ipv6_address' => 'NAS-IPv6-Address', - 'nas_port' => 'NAS-Port', - 'nas_port_id' => 'NAS-Port-Id', - 'nas_port_type' => 'NAS-Port-Type', - 'nas_real_port' => 'NAS_Real_Port', - 'nas_real_poru' => 'NAS-Real-Port', - 'navini_avpair' => 'Navini-AVPair', - 'next_hop_dn' => 'next-hop-dn', - 'next_hop_ip' => 'next-hop-ip', - 'nn_data_rate' => 'NN-Data-Rate', - 'nn_data_rate_ceiling' => 'NN-Data-Rate-Ceiling', - 'nn_homenode' => 'NN-Homenode', - 'nn_homeservice' => 'NN-Homeservice', - 'nn_homeservice_name' => 'NN-Homeservice-Name', - 'no_such_attribute' => 'No-Such-Attribute', - 'nokia_charging_id' => 'Nokia-Charging-Id', - 'nokia_ggsn_ip_address' => 'Nokia-GGSN-IP-Address', - 'nokia_imsi' => 'Nokia-IMSI', - 'nokia_prepaid_ind' => 'Nokia-Prepaid-Ind', - 'nokia_sgsn_ip_address' => 'Nokia-SGSN-IP-Address', - 'nomadix_bw_down' => 'Nomadix-Bw-Down', - 'nomadix_bw_up' => 'Nomadix-Bw-Up', - 'nomadix_config_url' => 'Nomadix-Config-URL', - 'nomadix_endofsession' => 'Nomadix-EndofSession', - 'nomadix_expiration' => 'Nomadix-Expiration', - 'nomadix_goodbye_url' => 'Nomadix-Goodbye-URL', - 'nomadix_ip_upsell' => 'Nomadix-IP-Upsell', - 'nomadix_logoff_url' => 'Nomadix-Logoff-URL', - 'nomadix_maxbytesdown' => 'Nomadix-MaxBytesDown', - 'nomadix_maxbytesup' => 'Nomadix-MaxBytesUp', - 'nomadix_net_vlan' => 'Nomadix-Net-VLAN', - 'nomadix_subnet' => 'Nomadix-Subnet', - 'nomadix_url_redirection' => 'Nomadix-URL-Redirection', - 'ns_admin_privilege' => 'NS-Admin-Privilege', - 'ns_mta_md5_password' => 'NS-MTA-MD5-Password', - 'ns_primary_dns' => 'NS-Primary-DNS', - 'ns_primary_wins' => 'NS-Primary-WINS', - 'ns_secondary_dns' => 'NS-Secondary-DNS', - 'ns_secondary_wins' => 'NS-Secondary-WINS', - 'ns_user_group' => 'NS-User-Group', - 'ns_vsys_name' => 'NS-VSYS-Name', - 'nt_password' => 'NT-Password', - 'ntlm_user_name' => 'NTLM-User-Name', - 'old_password' => 'Old-Password', - 'outgoing_req_uri' => 'outgoing-req-uri', - 'packet_dst_port' => 'Packet-Dst-Port', - 'packet_type' => 'Packet-Type', - 'pam_auth' => 'Pam-Auth', - 'password' => 'Password', - 'password_retry' => 'Password-Retry', - 'police_burst' => 'Police_Burst', - 'police_bursu' => 'Police-Burst', - 'police_rate' => 'Police_Rate', - 'police_ratf' => 'Police-Rate', - 'pool_name' => 'Pool-Name', - 'port_limit' => 'Port-Limit', - 'port_message' => 'Port-Message', - 'post_auth_type' => 'Post-Auth-Type', - 'post_proxy_type' => 'Post-Proxy-Type', - 'postauth_type' => 'PostAuth-Type', - 'pppoe_motm' => 'PPPOE_MOTM', - 'pppoe_motn' => 'PPPOE-MOTM', - 'pppoe_url' => 'PPPOE_URL', - 'pppoe_urm' => 'PPPOE-URL', - 'pre_acct_type' => 'Pre-Acct-Type', - 'pre_proxy_type' => 'Pre-Proxy-Type', - 'prefix' => 'Prefix', - 'prev_hop_ip' => 'prev-hop-ip', - 'prev_hop_via' => 'prev-hop-via', - 'prompt' => 'Prompt', - 'propel_accelerate' => 'Propel-Accelerate', - 'propel_client_ip_address' => 'Propel-Client-IP-Address', - 'propel_client_nas_ip_add' => 'Propel-Client-NAS-IP-Address', - 'propel_client_source_id' => 'Propel-Client-Source-ID', - 'propel_dialed_digits' => 'Propel-Dialed-Digits', - 'proxy_state' => 'Proxy-State', - 'proxy_to_realm' => 'Proxy-To-Realm', - 'pvc_circuit_padding' => 'PVC_Circuit_Padding', - 'pvc_circuit_paddinh' => 'PVC-Circuit-Padding', - 'pvc_encapsulation_type' => 'PVC_Encapsulation_Type', - 'pvc_encapsulation_typf' => 'PVC-Encapsulation-Type', - 'pvc_profile_name' => 'PVC_Profile_Name', - 'pvc_profile_namf' => 'PVC-Profile-Name', - 'quintum_avpair' => 'Quintum-AVPair', - 'quintum_h323_billing_mod' => 'Quintum-h323-billing-model', - 'quintum_h323_call_origin' => 'Quintum-h323-call-origin', - 'quintum_h323_call_type' => 'Quintum-h323-call-type', - 'quintum_h323_conf_id' => 'Quintum-h323-conf-id', - 'quintum_h323_connect_tim' => 'Quintum-h323-connect-time', - 'quintum_h323_credit_amou' => 'Quintum-h323-credit-amount', - 'quintum_h323_credit_time' => 'Quintum-h323-credit-time', - 'quintum_h323_currency_ty' => 'Quintum-h323-currency-type', - 'quintum_h323_disconnect_' => 'Quintum-h323-disconnect-time', - 'quintum_h323_disconnecta' => 'Quintum-h323-disconnect-cause', - 'quintum_h323_gw_id' => 'Quintum-h323-gw-id', - 'quintum_h323_incoming_co' => 'Quintum-h323-incoming-conf-id', - 'quintum_h323_preferred_l' => 'Quintum-h323-preferred-lang', - 'quintum_h323_prompt_id' => 'Quintum-h323-prompt-id', - 'quintum_h323_redirect_ip' => 'Quintum-h323-redirect-ip-address', - 'quintum_h323_redirect_nu' => 'Quintum-h323-redirect-number', - 'quintum_h323_remote_addr' => 'Quintum-h323-remote-address', - 'quintum_h323_return_code' => 'Quintum-h323-return-code', - 'quintum_h323_setup_time' => 'Quintum-h323-setup-time', - 'quintum_h323_time_and_da' => 'Quintum-h323-time-and-day', - 'quintum_h323_voice_quali' => 'Quintum-h323-voice-quality', - 'quintum_nas_port' => 'Quintum-NAS-Port', - 'rate_limit_burst' => 'Rate_Limit_Burst', - 'rate_limit_bursu' => 'Rate-Limit-Burst', - 'rate_limit_rate' => 'Rate_Limit_Rate', - 'rate_limit_ratf' => 'Rate-Limit-Rate', - 'realm' => 'Realm', - 'redcreek_tunneled_dns_se' => 'RedCreek-Tunneled-DNS-Server', - 'redcreek_tunneled_domain' => 'RedCreek-Tunneled-DomainName', - 'redcreek_tunneled_gatewa' => 'RedCreek-Tunneled-Gateway', - 'redcreek_tunneled_hostna' => 'RedCreek-Tunneled-HostName', - 'redcreek_tunneled_ip_add' => 'RedCreek-Tunneled-IP-Addr', - 'redcreek_tunneled_ip_net' => 'RedCreek-Tunneled-IP-Netmask', - 'redcreek_tunneled_search' => 'RedCreek-Tunneled-Search-List', - 'redcreek_tunneled_wins_s' => 'RedCreek-Tunneled-WINS-Server1', - 'redcreek_tunneled_wins_t' => 'RedCreek-Tunneled-WINS-Server2', - 'replicate_to_realm' => 'Replicate-To-Realm', - 'reply_message' => 'Reply-Message', - 'response_packet_type' => 'Response-Packet-Type', - 'rewrite_rule' => 'Rewrite-Rule', - 'sdx_service_name' => 'Sdx-Service-Name', - 'sdx_session_volume_quota' => 'Sdx-Session-Volume-Quota', - 'sdx_tunnel_disconnect_ca' => 'Sdx-Tunnel-Disconnect-Cause-Info', - 'service_type' => 'Service-Type', - 'session' => 'Session', - 'session_error_code' => 'Session_Error_Code', - 'session_error_codf' => 'Session-Error-Code', - 'session_error_msg' => 'Session_Error_Msg', - 'session_error_msh' => 'Session-Error-Msg', - 'session_protocol' => 'session-protocol', - 'session_timeout' => 'Session-Timeout', - 'session_type' => 'Session-Type', - 'shasta_service_profile' => 'Shasta-Service-Profile', - 'shasta_user_privilege' => 'Shasta-User-Privilege', - 'shasta_vpn_name' => 'Shasta-VPN-Name', - 'shiva_acct_serv_switch' => 'Shiva-Acct-Serv-Switch', - 'shiva_called_number' => 'Shiva-Called-Number', - 'shiva_calling_number' => 'Shiva-Calling-Number', - 'shiva_compression_type' => 'Shiva-Compression-Type', - 'shiva_connect_reason' => 'Shiva-Connect-Reason', - 'shiva_customer_id' => 'Shiva-Customer-Id', - 'shiva_disconnect_reason' => 'Shiva-Disconnect-Reason', - 'shiva_event_flags' => 'Shiva-Event-Flags', - 'shiva_function' => 'Shiva-Function', - 'shiva_link_protocol' => 'Shiva-Link-Protocol', - 'shiva_link_speed' => 'Shiva-Link-Speed', - 'shiva_links_in_bundle' => 'Shiva-Links-In-Bundle', - 'shiva_network_protocols' => 'Shiva-Network-Protocols', - 'shiva_session_id' => 'Shiva-Session-Id', - 'shiva_type_of_service' => 'Shiva-Type-Of-Service', - 'shiva_user_attributes' => 'Shiva-User-Attributes', - 'simultaneous_use' => 'Simultaneous-Use', - 'sip_from' => 'Sip-From', - 'sip_hdr' => 'sip-hdr', - 'sip_method' => 'Sip-Method', - 'sip_to' => 'Sip-To', - 'sip_translated_request_u' => 'Sip-Translated-Request-URI', - 'smb_account_ctrl' => 'SMB-Account-CTRL', - 'smb_account_ctrl_text' => 'SMB-Account-CTRL-TEXT', - 'sonicwall_user_group' => 'SonicWall-User-Group', - 'sonicwall_user_privilege' => 'SonicWall-User-Privilege', - 'source_validation' => 'Source_Validation', - 'source_validatioo' => 'Source-Validation', - 'sql_group' => 'Sql-Group', - 'sql_user_name' => 'SQL-User-Name', - 'ss3_firewall_user_privil' => 'SS3-Firewall-User-Privilege', - 'st_acct_vc_connection_id' => 'ST-Acct-VC-Connection-Id', - 'st_policy_name' => 'ST-Policy-Name', - 'st_primary_dns_server' => 'ST-Primary-DNS-Server', - 'st_primary_nbns_server' => 'ST-Primary-NBNS-Server', - 'st_secondary_dns_server' => 'ST-Secondary-DNS-Server', - 'st_secondary_nbns_server' => 'ST-Secondary-NBNS-Server', - 'st_service_domain' => 'ST-Service-Domain', - 'st_service_name' => 'ST-Service-Name', - 'state' => 'State', - 'strip_user_name' => 'Strip-User-Name', - 'stripped_user_name' => 'Stripped-User-Name', - 'subscriber' => 'subscriber', - 'suffix' => 'Suffix', - 'telebit_accounting_info' => 'Telebit-Accounting-Info', - 'telebit_activate_command' => 'Telebit-Activate-Command', - 'telebit_login_command' => 'Telebit-Login-Command', - 'telebit_port_name' => 'Telebit-Port-Name', - 'termination_action' => 'Termination-Action', - 'termination_menu' => 'Termination-Menu', - 'trapeze_encryption_type' => 'Trapeze-Encryption-Type', - 'trapeze_end_date' => 'Trapeze-End-Date', - 'trapeze_mobility_profile' => 'Trapeze-Mobility-Profile', - 'trapeze_ssid' => 'Trapeze-SSID', - 'trapeze_start_date' => 'Trapeze-Start-Date', - 'trapeze_time_of_day' => 'Trapeze-Time-Of-Day', - 'trapeze_url' => 'Trapeze-URL', - 'trapeze_vlan_name' => 'Trapeze-VLAN-Name', - 'tty_level_max' => 'TTY_Level_Max', - 'tty_level_may' => 'TTY-Level-Max', - 'tty_level_start' => 'TTY_Level_Start', - 'tty_level_staru' => 'TTY-Level-Start', - 'tunnel_algorithm' => 'Tunnel_Algorithm', - 'tunnel_algorithn' => 'Tunnel-Algorithm', - 'tunnel_assignment_id' => 'Tunnel-Assignment-Id', - 'tunnel_client_auth_id' => 'Tunnel-Client-Auth-Id', - 'tunnel_client_endpoint' => 'Tunnel-Client-Endpoint', - 'tunnel_cmd_timeout' => 'Tunnel_Cmd_Timeout', - 'tunnel_cmd_timeouu' => 'Tunnel-Cmd-Timeout', - 'tunnel_connection_id' => 'Tunnel-Connection-Id', - 'tunnel_context' => 'Tunnel_Context', - 'tunnel_contexu' => 'Tunnel-Context', - 'tunnel_deadtime' => 'Tunnel_Deadtime', - 'tunnel_deadtimf' => 'Tunnel-Deadtime', - 'tunnel_dnis' => 'Tunnel_DNIS', - 'tunnel_dnit' => 'Tunnel-DNIS', - 'tunnel_domain' => 'Tunnel_Domain', - 'tunnel_domaio' => 'Tunnel-Domain', - 'tunnel_function' => 'Tunnel_Function', - 'tunnel_functioo' => 'Tunnel-Function', - 'tunnel_group' => 'Tunnel_Group', - 'tunnel_grouq' => 'Tunnel-Group', - 'tunnel_l2f_second_passwo' => 'Tunnel_L2F_Second_Password', - 'tunnel_l2f_second_passwp' => 'Tunnel-L2F-Second-Password', - 'tunnel_local_name' => 'Tunnel_Local_Name', - 'tunnel_local_namf' => 'Tunnel-Local-Name', - 'tunnel_max_sessions' => 'Tunnel_Max_Sessions', - 'tunnel_max_sessiont' => 'Tunnel-Max-Sessions', - 'tunnel_max_tunnels' => 'Tunnel_Max_Tunnels', - 'tunnel_max_tunnelt' => 'Tunnel-Max-Tunnels', - 'tunnel_medium_type' => 'Tunnel-Medium-Type', - 'tunnel_password' => 'Tunnel-Password', - 'tunnel_police_burst' => 'Tunnel_Police_Burst', - 'tunnel_police_bursu' => 'Tunnel-Police-Burst', - 'tunnel_police_rate' => 'Tunnel_Police_Rate', - 'tunnel_police_ratf' => 'Tunnel-Police-Rate', - 'tunnel_preference' => 'Tunnel-Preference', - 'tunnel_private_group_id' => 'Tunnel-Private-Group-Id', - 'tunnel_rate_limit_burst' => 'Tunnel_Rate_Limit_Burst', - 'tunnel_rate_limit_bursu' => 'Tunnel-Rate-Limit-Burst', - 'tunnel_rate_limit_rate' => 'Tunnel_Rate_Limit_Rate', - 'tunnel_rate_limit_ratf' => 'Tunnel-Rate-Limit-Rate', - 'tunnel_remote_name' => 'Tunnel_Remote_Name', - 'tunnel_remote_namf' => 'Tunnel-Remote-Name', - 'tunnel_retransmit' => 'Tunnel_Retransmit', - 'tunnel_retransmiu' => 'Tunnel-Retransmit', - 'tunnel_server_auth_id' => 'Tunnel-Server-Auth-Id', - 'tunnel_server_endpoint' => 'Tunnel-Server-Endpoint', - 'tunnel_session_auth' => 'Tunnel_Session_Auth', - 'tunnel_session_auth_ctx' => 'Tunnel_Session_Auth_Ctx', - 'tunnel_session_auth_cty' => 'Tunnel-Session-Auth-Ctx', - 'tunnel_session_auth_serv' => 'Tunnel_Session_Auth_Service_Grp', - 'tunnel_session_auth_serw' => 'Tunnel-Session-Auth-Service-Grp', - 'tunnel_session_auti' => 'Tunnel-Session-Auth', - 'tunnel_type' => 'Tunnel-Type', - 'tunnel_window' => 'Tunnel_Window', - 'tunnel_windox' => 'Tunnel-Window', - 'unix_ftp_gid' => 'Unix-FTP-GID', - 'unix_ftp_group_ids' => 'Unix-FTP-Group-Ids', - 'unix_ftp_group_names' => 'Unix-FTP-Group-Names', - 'unix_ftp_home' => 'Unix-FTP-Home', - 'unix_ftp_shell' => 'Unix-FTP-Shell', - 'unix_ftp_uid' => 'Unix-FTP-UID', - 'user_category' => 'User-Category', - 'user_name' => 'User-Name', - 'user_name_is_star' => 'User-Name-Is-Star', - 'user_password' => 'User-Password', - 'user_profile' => 'User-Profile', - 'user_service_type' => 'User-Service-Type', - 'usr_accm_type' => 'USR-ACCM-Type', - 'usr_acct_reason_code' => 'USR-Acct-Reason-Code', - 'usr_actual_voltage' => 'USR-Actual-Voltage', - 'usr_appletalk' => 'USR-Appletalk', - 'usr_appletalk_network_ra' => 'USR-Appletalk-Network-Range', - 'usr_at_call_input_filter' => 'USR-AT-Call-Input-Filter', - 'usr_at_call_output_filte' => 'USR-AT-Call-Output-Filter', - 'usr_at_input_filter' => 'USR-AT-Input-Filter', - 'usr_at_output_filter' => 'USR-AT-Output-Filter', - 'usr_at_rtmp_input_filter' => 'USR-AT-RTMP-Input-Filter', - 'usr_at_rtmp_output_filte' => 'USR-AT-RTMP-Output-Filter', - 'usr_at_zip_input_filter' => 'USR-AT-Zip-Input-Filter', - 'usr_at_zip_output_filter' => 'USR-AT-Zip-Output-Filter', - 'usr_auth_mode' => 'USR-Auth-Mode', - 'usr_back_channel_data_ra' => 'USR-Back-Channel-Data-Rate', - 'usr_bearer_capabilities' => 'USR-Bearer-Capabilities', - 'usr_block_error_count_li' => 'USR-Block-Error-Count-Limit', - 'usr_blocks_received' => 'USR-Blocks-Received', - 'usr_blocks_resent' => 'USR-Blocks-Resent', - 'usr_blocks_sent' => 'USR-Blocks-Sent', - 'usr_bridging' => 'USR-Bridging', - 'usr_call_arrival_in_gmt' => 'USR-Call-Arrival-in-GMT', - 'usr_call_arrival_time' => 'USR-Call-Arrival-Time', - 'usr_call_connect_in_gmt' => 'USR-Call-Connect-in-GMT', - 'usr_call_connecting_time' => 'USR-Call-Connecting-Time', - 'usr_call_end_date_time' => 'USR-Call-End-Date-Time', - 'usr_call_end_time' => 'USR-Call-End-Time', - 'usr_call_error_code' => 'USR-Call-Error-Code', - 'usr_call_event_code' => 'USR-Call-Event-Code', - 'usr_call_reference_numbe' => 'USR-Call-Reference-Number', - 'usr_call_start_date_time' => 'USR-Call-Start-Date-Time', - 'usr_call_terminate_in_gm' => 'USR-Call-Terminate-in-GMT', - 'usr_call_type' => 'USR-Call-Type', - 'usr_callback_type' => 'USR-Callback-Type', - 'usr_called_party_number' => 'USR-Called-Party-Number', - 'usr_calling_party_number' => 'USR-Calling-Party-Number', - 'usr_card_type' => 'USR-Card-Type', - 'usr_ccp_algorithm' => 'USR-CCP-Algorithm', - 'usr_cdma_call_reference_' => 'USR-CDMA-Call-Reference-Number', - 'usr_channel' => 'USR-Channel', - 'usr_channel_connected_to' => 'USR-Channel-Connected-To', - 'usr_channel_decrement' => 'USR-Channel-Decrement', - 'usr_channel_expansion' => 'USR-Channel-Expansion', - 'usr_characters_received' => 'USR-Characters-Received', - 'usr_characters_sent' => 'USR-Characters-Sent', - 'usr_chassis_call_channel' => 'USR-Chassis-Call-Channel', - 'usr_chassis_call_slot' => 'USR-Chassis-Call-Slot', - 'usr_chassis_call_span' => 'USR-Chassis-Call-Span', - 'usr_chassis_slot' => 'USR-Chassis-Slot', - 'usr_chassis_temp_thresho' => 'USR-Chassis-Temp-Threshold', - 'usr_chassis_temperature' => 'USR-Chassis-Temperature', - 'usr_chat_script_name' => 'USR-Chat-Script-Name', - 'usr_compression_algorith' => 'USR-Compression-Algorithm', - 'usr_compression_reset_mo' => 'USR-Compression-Reset-Mode', - 'usr_compression_type' => 'USR-Compression-Type', - 'usr_connect_speed' => 'USR-Connect-Speed', - 'usr_connect_term_reason' => 'USR-Connect-Term-Reason', - 'usr_connect_time' => 'USR-Connect-Time', - 'usr_connect_time_limit' => 'USR-Connect-Time-Limit', - 'usr_cusr_hat_script_rule' => 'USR-CUSR-hat-Script-Rules', - 'usr_default_dte_data_rat' => 'USR-Default-DTE-Data-Rate', - 'usr_device_connected_to' => 'USR-Device-Connected-To', - 'usr_disconnect_cause_ind' => 'USR-Disconnect-Cause-Indicator', - 'usr_dnis_reauthenticatio' => 'USR-DNIS-ReAuthentication', - 'usr_ds0' => 'USR-DS0', - 'usr_ds0s' => 'USR-DS0s', - 'usr_dte_data_idle_timout' => 'USR-DTE-Data-Idle-Timout', - 'usr_dte_ring_no_answer_l' => 'USR-DTE-Ring-No-Answer-Limit', - 'usr_dtr_false_timeout' => 'USR-DTR-False-Timeout', - 'usr_dtr_true_timeout' => 'USR-DTR-True-Timeout', - 'usr_end_time' => 'USR-End-Time', - 'usr_equalization_type' => 'USR-Equalization-Type', - 'usr_esn' => 'USR-ESN', - 'usr_et_bridge_call_outpu' => 'USR-ET-Bridge-Call-Output-Filte', - 'usr_et_bridge_input_filt' => 'USR-ET-Bridge-Input-Filter', - 'usr_et_bridge_output_fil' => 'USR-ET-Bridge-Output-Filter', - 'usr_event_date_time' => 'USR-Event-Date-Time', - 'usr_event_id' => 'USR-Event-Id', - 'usr_expansion_algorithm' => 'USR-Expansion-Algorithm', - 'usr_expected_voltage' => 'USR-Expected-Voltage', - 'usr_failure_to_connect_r' => 'USR-Failure-to-Connect-Reason', - 'usr_fallback_enabled' => 'USR-Fallback-Enabled', - 'usr_fallback_limit' => 'USR-Fallback-Limit', - 'usr_filter_zones' => 'USR-Filter-Zones', - 'usr_final_rx_link_data_r' => 'USR-Final-Rx-Link-Data-Rate', - 'usr_final_tx_link_data_r' => 'USR-Final-Tx-Link-Data-Rate', - 'usr_framed_ip_address_po' => 'USR-Framed_IP_Address_Pool_Name', - 'usr_framed_ipx_route' => 'USR-Framed-IPX-Route', - 'usr_gateway_ip_address' => 'USR-Gateway-IP-Address', - 'usr_harc_disconnect_code' => 'USR-HARC-Disconnect-Code', - 'usr_host_type' => 'USR-Host-Type', - 'usr_ids0_call_type' => 'USR-IDS0-Call-Type', - 'usr_igmp_maximum_respons' => 'USR-IGMP-Maximum-Response-Time', - 'usr_igmp_query_interval' => 'USR-IGMP-Query-Interval', - 'usr_igmp_robustness' => 'USR-IGMP-Robustness', - 'usr_igmp_routing' => 'USR-IGMP-Routing', - 'usr_igmp_version' => 'USR-IGMP-Version', - 'usr_imsi' => 'USR-IMSI', - 'usr_initial_rx_link_data' => 'USR-Initial-Rx-Link-Data-Rate', - 'usr_initial_tx_link_data' => 'USR-Initial-Tx-Link-Data-Rate', - 'usr_interface_index' => 'USR-Interface-Index', - 'usr_ip' => 'USR-IP', - 'usr_ip_call_input_filter' => 'USR-IP-Call-Input-Filter', - 'usr_ip_call_output_filte' => 'USR-IP-Call-Output-Filter', - 'usr_ip_default_route_opt' => 'USR-IP-Default-Route-Option', - 'usr_ip_rip_input_filter' => 'USR-IP-RIP-Input-Filter', - 'usr_ip_rip_output_filter' => 'USR-IP-RIP-Output-Filter', - 'usr_ip_rip_policies' => 'USR-IP-RIP-Policies', - 'usr_ip_rip_simple_auth_p' => 'USR-IP-RIP-Simple-Auth-Password', - 'usr_ip_saa_filter' => 'USR-IP-SAA-Filter', - 'usr_ipx' => 'USR-IPX', - 'usr_ipx_call_input_filte' => 'USR-IPX-Call-Input-Filter', - 'usr_ipx_call_output_filt' => 'USR-IPX-Call-Output-Filter', - 'usr_ipx_rip_input_filter' => 'USR-IPX-RIP-Input-Filter', - 'usr_ipx_rip_output_filte' => 'USR-IPX-RIP-Output-Filter', - 'usr_ipx_routing' => 'USR-IPX-Routing', - 'usr_ipx_wan' => 'USR-IPX-WAN', - 'usr_iwf_call_identifier' => 'USR-IWF-Call-Identifier', - 'usr_iwf_ip_address' => 'USR-IWF-IP-Address', - 'usr_keypress_timeout' => 'USR-Keypress-Timeout', - 'usr_last_callers_number_' => 'USR-Last-Callers-Number-ANI', - 'usr_last_number_dialed_i' => 'USR-Last-Number-Dialed-In-DNIS', - 'usr_last_number_dialed_o' => 'USR-Last-Number-Dialed-Out', - 'usr_line_reversals' => 'USR-Line-Reversals', - 'usr_local_framed_ip_addr' => 'USR-Local-Framed-IP-Addr', - 'usr_local_ip_address' => 'USR-Local-IP-Address', - 'usr_log_filter_packets' => 'USR-Log-Filter-Packets', - 'usr_max_channels' => 'USR-Max-Channels', - 'usr_mbi_ct_bchannel_used' => 'USR-Mbi_Ct_BChannel_Used', - 'usr_mbi_ct_pri_card_slot' => 'USR-Mbi_Ct_PRI_Card_Slot', - 'usr_mbi_ct_pri_card_span' => 'USR-Mbi_Ct_PRI_Card_Span_Line', - 'usr_mbi_ct_tdm_time_slot' => 'USR-Mbi_Ct_TDM_Time_Slot', - 'usr_mic' => 'USR-MIC', - 'usr_min_compression_size' => 'USR-Min-Compression-Size', - 'usr_mobile_ip_address' => 'USR-Mobile-IP-Address', - 'usr_mobile_numbytes_rxed' => 'USR-Mobile-NumBytes-Rxed', - 'usr_mobile_numbytes_txed' => 'USR-Mobile-NumBytes-Txed', - 'usr_mobileip_home_agent_' => 'USR-MobileIP-Home-Agent-Address', - 'usr_modem_group' => 'USR-Modem-Group', - 'usr_modem_setup_time' => 'USR-Modem-Setup-Time', - 'usr_modem_training_time' => 'USR-Modem-Training-Time', - 'usr_modulation_type' => 'USR-Modulation-Type', - 'usr_mp_edo' => 'USR-MP-EDO', - 'usr_mp_edo_hiper' => 'USR-MP-EDO-HIPER', - 'usr_mp_mrru' => 'USR-MP-MRRU', - 'usr_mpip_tunnel_originat' => 'USR-MPIP-Tunnel-Originator', - 'usr_multicast_forwarding' => 'USR-Multicast-Forwarding', - 'usr_multicast_proxy' => 'USR-Multicast-Proxy', - 'usr_multicast_receive' => 'USR-Multicast-Receive', - 'usr_nas_type' => 'USR-NAS-Type', - 'usr_nfas_id' => 'USR-NFAS-ID', - 'usr_num_fax_pages_proces' => 'USR-Num-Fax-Pages-Processed', - 'usr_number_of_blers' => 'USR-Number-of-Blers', - 'usr_number_of_characters' => 'USR-Number-Of-Characters-Lost', - 'usr_number_of_fallbacks' => 'USR-Number-of-Fallbacks', - 'usr_number_of_link_naks' => 'USR-Number-of-Link-NAKs', - 'usr_number_of_link_timeo' => 'USR-Number-of-Link-Timeouts', - 'usr_number_of_rings_limi' => 'USR-Number-of-Rings-Limit', - 'usr_number_of_upshifts' => 'USR-Number-of-Upshifts', - 'usr_orig_nas_type' => 'USR-Orig-NAS-Type', - 'usr_originate_answer_mod' => 'USR-Originate-Answer-Mode', - 'usr_ospf_addressless_ind' => 'USR-OSPF-Addressless-Index', - 'usr_packet_bus_session' => 'USR-Packet-Bus-Session', - 'usr_physical_state' => 'USR-Physical-State', - 'usr_port_tap' => 'USR-Port-Tap', - 'usr_port_tap_address' => 'USR-Port-Tap-Address', - 'usr_port_tap_facility' => 'USR-Port-Tap-Facility', - 'usr_port_tap_format' => 'USR-Port-Tap-Format', - 'usr_port_tap_output' => 'USR-Port-Tap-Output', - 'usr_port_tap_priority' => 'USR-Port-Tap-Priority', - 'usr_power_supply_number' => 'USR-Power-Supply-Number', - 'usr_primary_dns_server' => 'USR-Primary_DNS_Server', - 'usr_primary_nbns_server' => 'USR-Primary_NBNS_Server', - 'usr_pw_cutoff' => 'USR-PW_Cutoff', - 'usr_pw_framed_routing_v2' => 'USR-PW_Framed_Routing_V2', - 'usr_pw_index' => 'USR-PW_Index', - 'usr_pw_packet' => 'USR-PW_Packet', - 'usr_pw_tunnel_authentica' => 'USR-PW_Tunnel_Authentication', - 'usr_pw_usr_ifilter_ip' => 'USR-PW_USR_IFilter_IP', - 'usr_pw_usr_ifilter_ipx' => 'USR-PW_USR_IFilter_IPX', - 'usr_pw_usr_ofilter_ip' => 'USR-PW_USR_OFilter_IP', - 'usr_pw_usr_ofilter_ipx' => 'USR-PW_USR_OFilter_IPX', - 'usr_pw_usr_ofilter_sap' => 'USR-PW_USR_OFilter_SAP', - 'usr_pw_vpn_gateway' => 'USR-PW_VPN_Gateway', - 'usr_pw_vpn_id' => 'USR-PW_VPN_ID', - 'usr_pw_vpn_name' => 'USR-PW_VPN_Name', - 'usr_pw_vpn_neighbor' => 'USR-PW_VPN_Neighbor', - 'usr_q931_call_reference_' => 'USR-Q931-Call-Reference-Value', - 'usr_rad_dvmrp_metric' => 'USR-Rad-Dvmrp-Metric', - 'usr_rad_location_type' => 'USR-Rad-Location-Type', - 'usr_rad_multicast_routin' => 'USR-Rad-Multicast-Routing-Ttl', - 'usr_rad_multicast_routio' => 'USR-Rad-Multicast-Routing-RtLim', - 'usr_rad_multicast_routip' => 'USR-Rad-Multicast-Routing-Proto', - 'usr_rad_multicast_routiq' => 'USR-Rad-Multicast-Routing-Bound', - 'usr_re_chap_timeout' => 'USR-Re-Chap-Timeout', - 'usr_receive_acc_map' => 'USR-Receive-Acc-Map', - 'usr_reply_script1' => 'USR-Reply-Script1', - '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', - 'usr_request_type' => 'USR-Request-Type', - 'usr_retrains_granted' => 'USR-Retrains-Granted', - 'usr_retrains_requested' => 'USR-Retrains-Requested', - 'usr_rmmie_firmware_build' => 'USR-RMMIE-Firmware-Build-Date', - 'usr_rmmie_firmware_versi' => 'USR-RMMIE-Firmware-Version', - 'usr_rmmie_last_update_ev' => 'USR-RMMIE-Last-Update-Event', - 'usr_rmmie_last_update_ti' => 'USR-RMMIE-Last-Update-Time', - 'usr_rmmie_manufacturer_i' => 'USR-RMMIE-Manufacturer-ID', - 'usr_rmmie_num_of_updates' => 'USR-RMMIE-Num-Of-Updates', - 'usr_rmmie_planned_discon' => 'USR-RMMIE-Planned-Disconnect', - 'usr_rmmie_product_code' => 'USR-RMMIE-Product-Code', - 'usr_rmmie_pwrlvl_farecho' => 'USR-RMMIE-PwrLvl-FarEcho-Canc', - 'usr_rmmie_pwrlvl_nearech' => 'USR-RMMIE-PwrLvl-NearEcho-Canc', - 'usr_rmmie_pwrlvl_noise_l' => 'USR-RMMIE-PwrLvl-Noise-Lvl', - 'usr_rmmie_pwrlvl_xmit_lv' => 'USR-RMMIE-PwrLvl-Xmit-Lvl', - 'usr_rmmie_rcv_pwrlvl_330' => 'USR-RMMIE-Rcv-PwrLvl-3300Hz', - 'usr_rmmie_rcv_pwrlvl_375' => 'USR-RMMIE-Rcv-PwrLvl-3750Hz', - 'usr_rmmie_rcv_tot_pwrlvl' => 'USR-RMMIE-Rcv-Tot-PwrLvl', - 'usr_rmmie_serial_number' => 'USR-RMMIE-Serial-Number', - 'usr_rmmie_status' => 'USR-RMMIE-Status', - 'usr_rmmie_x2_status' => 'USR-RMMIE-x2-Status', - 'usr_routing_protocol' => 'USR-Routing-Protocol', - 'usr_sap_filter_in' => 'USR-SAP-Filter-In', - 'usr_secondary_dns_server' => 'USR-Secondary_DNS_Server', - 'usr_secondary_nbns_serve' => 'USR-Secondary_NBNS_Server', - 'usr_security_login_limit' => 'USR-Security-Login-Limit', - 'usr_security_resp_limit' => 'USR-Security-Resp-Limit', - 'usr_send_name' => 'USR-Send-Name', - 'usr_send_password' => 'USR-Send-Password', - 'usr_send_script1' => 'USR-Send-Script1', - 'usr_send_script2' => 'USR-Send-Script2', - 'usr_send_script3' => 'USR-Send-Script3', - 'usr_send_script4' => 'USR-Send-Script4', - 'usr_send_script5' => 'USR-Send-Script5', - 'usr_send_script6' => 'USR-Send-Script6', - 'usr_server_time' => 'USR-Server-Time', - 'usr_service_option' => 'USR-Service-Option', - 'usr_simplified_mnp_level' => 'USR-Simplified-MNP-Levels', - 'usr_simplified_v42bis_us' => 'USR-Simplified-V42bis-Usage', - 'usr_slot_connected_to' => 'USR-Slot-Connected-To', - 'usr_speed_of_connection' => 'USR-Speed-Of-Connection', - 'usr_spoofing' => 'USR-Spoofing', - 'usr_start_time' => 'USR-Start-Time', - 'usr_supports_tags' => 'USR-Supports-Tags', - 'usr_sync_async_mode' => 'USR-Sync-Async-Mode', - 'usr_syslog_tap' => 'USR-Syslog-Tap', - 'usr_terminal_type' => 'USR-Terminal-Type', - 'usr_transmit_acc_map' => 'USR-Transmit-Acc-Map', - 'usr_tunnel_auth_hostname' => 'USR-Tunnel-Auth-Hostname', - 'usr_tunnel_security' => 'USR-Tunnel-Security', - 'usr_tunnel_switch_endpoi' => 'USR-Tunnel-Switch-Endpoint', - 'usr_tunneled_mlpp' => 'USR-Tunneled-MLPP', - 'usr_unauthenticated_time' => 'USR-Unauthenticated-Time', - 'usr_vpn_encrypter' => 'USR-VPN-Encrypter', - 'usr_vpn_gw_location_id' => 'USR-VPN-GW-Location-Id', - 'usr_vts_session_key' => 'USR-VTS-Session-Key', - 'vendor_specific' => 'Vendor-Specific', - 'versanet_termination_cau' => 'Versanet-Termination-Cause', - 'vnc_pppoe_cbq_rx' => 'VNC-PPPoE-CBQ-RX', - 'vnc_pppoe_cbq_rx_fallbac' => 'VNC-PPPoE-CBQ-RX-Fallback', - 'vnc_pppoe_cbq_tx' => 'VNC-PPPoE-CBQ-TX', - 'vnc_pppoe_cbq_tx_fallbac' => 'VNC-PPPoE-CBQ-TX-Fallback', - 'vnc_splash' => 'VNC-Splash', - 'wispr_bandwidth_max_down' => 'WISPr-Bandwidth-Max-Down', - 'wispr_bandwidth_max_up' => 'WISPr-Bandwidth-Max-Up', - 'wispr_bandwidth_min_down' => 'WISPr-Bandwidth-Min-Down', - 'wispr_bandwidth_min_up' => 'WISPr-Bandwidth-Min-Up', - 'wispr_billing_class_of_s' => 'WISPr-Billing-Class-Of-Service', - 'wispr_location_id' => 'WISPr-Location-ID', - 'wispr_location_name' => 'WISPr-Location-Name', - 'wispr_logoff_url' => 'WISPr-Logoff-URL', - 'wispr_redirection_url' => 'WISPr-Redirection-URL', - 'wispr_session_terminate_' => 'WISPr-Session-Terminate-Time', - 'wispr_session_terminatea' => 'WISPr-Session-Terminate-End-Of-Day', - 'x_ascend_add_seconds' => 'X-Ascend-Add-Seconds', - 'x_ascend_ara_pw' => 'X-Ascend-Ara-PW', - 'x_ascend_assign_ip_clien' => 'X-Ascend-Assign-IP-Client', - 'x_ascend_assign_ip_globa' => 'X-Ascend-Assign-IP-Global-Pool', - 'x_ascend_assign_ip_pool' => 'X-Ascend-Assign-IP-Pool', - 'x_ascend_assign_ip_serve' => 'X-Ascend-Assign-IP-Server', - 'x_ascend_authen_alias' => 'X-Ascend-Authen-Alias', - 'x_ascend_backup' => 'X-Ascend-Backup', - 'x_ascend_bacp_enable' => 'X-Ascend-BACP-Enable', - 'x_ascend_base_channel_co' => 'X-Ascend-Base-Channel-Count', - 'x_ascend_billing_number' => 'X-Ascend-Billing-Number', - 'x_ascend_bridge' => 'X-Ascend-Bridge', - 'x_ascend_bridge_address' => 'X-Ascend-Bridge-Address', - 'x_ascend_call_attempt_li' => 'X-Ascend-Call-Attempt-Limit', - 'x_ascend_call_block_dura' => 'X-Ascend-Call-Block-Duration', - 'x_ascend_call_by_call' => 'X-Ascend-Call-By-Call', - 'x_ascend_call_filter' => 'X-Ascend-Call-Filter', - 'x_ascend_call_type' => 'X-Ascend-Call-Type', - 'x_ascend_callback' => 'X-Ascend-Callback', - 'x_ascend_client_assign_d' => 'X-Ascend-Client-Assign-DNS', - 'x_ascend_client_gateway' => 'X-Ascend-Client-Gateway', - 'x_ascend_client_primary_' => 'X-Ascend-Client-Primary-DNS', - 'x_ascend_client_secondar' => 'X-Ascend-Client-Secondary-DNS', - 'x_ascend_connect_progres' => 'X-Ascend-Connect-Progress', - 'x_ascend_data_filter' => 'X-Ascend-Data-Filter', - 'x_ascend_data_rate' => 'X-Ascend-Data-Rate', - 'x_ascend_data_svc' => 'X-Ascend-Data-Svc', - 'x_ascend_dba_monitor' => 'X-Ascend-DBA-Monitor', - 'x_ascend_dec_channel_cou' => 'X-Ascend-Dec-Channel-Count', - 'x_ascend_dhcp_maximum_le' => 'X-Ascend-DHCP-Maximum-Leases', - 'x_ascend_dhcp_pool_numbe' => 'X-Ascend-DHCP-Pool-Number', - 'x_ascend_dhcp_reply' => 'X-Ascend-DHCP-Reply', - 'x_ascend_dial_number' => 'X-Ascend-Dial-Number', - 'x_ascend_dialout_allowed' => 'X-Ascend-Dialout-Allowed', - 'x_ascend_disconnect_caus' => 'X-Ascend-Disconnect-Cause', - 'x_ascend_event_type' => 'X-Ascend-Event-Type', - 'x_ascend_expect_callback' => 'X-Ascend-Expect-Callback', - 'x_ascend_fcp_parameter' => 'X-Ascend-FCP-Parameter', - 'x_ascend_first_dest' => 'X-Ascend-First-Dest', - 'x_ascend_force_56' => 'X-Ascend-Force-56', - 'x_ascend_fr_circuit_name' => 'X-Ascend-FR-Circuit-Name', - 'x_ascend_fr_dce_n392' => 'X-Ascend-FR-DCE-N392', - 'x_ascend_fr_dce_n393' => 'X-Ascend-FR-DCE-N393', - 'x_ascend_fr_direct' => 'X-Ascend-FR-Direct', - 'x_ascend_fr_direct_dlci' => 'X-Ascend-FR-Direct-DLCI', - 'x_ascend_fr_direct_profi' => 'X-Ascend-FR-Direct-Profile', - 'x_ascend_fr_dlci' => 'X-Ascend-FR-DLCI', - 'x_ascend_fr_dte_n392' => 'X-Ascend-FR-DTE-N392', - 'x_ascend_fr_dte_n393' => 'X-Ascend-FR-DTE-N393', - 'x_ascend_fr_link_mgt' => 'X-Ascend-FR-Link-Mgt', - 'x_ascend_fr_linkup' => 'X-Ascend-FR-LinkUp', - 'x_ascend_fr_n391' => 'X-Ascend-FR-N391', - 'x_ascend_fr_nailed_grp' => 'X-Ascend-FR-Nailed-Grp', - 'x_ascend_fr_profile_name' => 'X-Ascend-FR-Profile-Name', - 'x_ascend_fr_t391' => 'X-Ascend-FR-T391', - 'x_ascend_fr_t392' => 'X-Ascend-FR-T392', - 'x_ascend_fr_type' => 'X-Ascend-FR-Type', - 'x_ascend_ft1_caller' => 'X-Ascend-FT1-Caller', - 'x_ascend_group' => 'X-Ascend-Group', - 'x_ascend_handle_ipx' => 'X-Ascend-Handle-IPX', - 'x_ascend_history_weigh_t' => 'X-Ascend-History-Weigh-Type', - 'x_ascend_home_agent_ip_a' => 'X-Ascend-Home-Agent-IP-Addr', - 'x_ascend_home_agent_pass' => 'X-Ascend-Home-Agent-Password', - 'x_ascend_home_agent_udp_' => 'X-Ascend-Home-Agent-UDP-Port', - 'x_ascend_home_network_na' => 'X-Ascend-Home-Network-Name', - 'x_ascend_host_info' => 'X-Ascend-Host-Info', - 'x_ascend_idle_limit' => 'X-Ascend-Idle-Limit', - 'x_ascend_if_netmask' => 'X-Ascend-IF-Netmask', - 'x_ascend_inc_channel_cou' => 'X-Ascend-Inc-Channel-Count', - 'x_ascend_ip_direct' => 'X-Ascend-IP-Direct', - 'x_ascend_ip_pool_definit' => 'X-Ascend-IP-Pool-Definition', - 'x_ascend_ipx_alias' => 'X-Ascend-IPX-Alias', - 'x_ascend_ipx_node_addr' => 'X-Ascend-IPX-Node-Addr', - 'x_ascend_ipx_peer_mode' => 'X-Ascend-IPX-Peer-Mode', - 'x_ascend_ipx_route' => 'X-Ascend-IPX-Route', - 'x_ascend_link_compressio' => 'X-Ascend-Link-Compression', - 'x_ascend_maximum_call_du' => 'X-Ascend-Maximum-Call-Duration', - 'x_ascend_maximum_channel' => 'X-Ascend-Maximum-Channels', - 'x_ascend_maximum_time' => 'X-Ascend-Maximum-Time', - 'x_ascend_menu_item' => 'X-Ascend-Menu-Item', - 'x_ascend_menu_selector' => 'X-Ascend-Menu-Selector', - 'x_ascend_metric' => 'X-Ascend-Metric', - 'x_ascend_minimum_channel' => 'X-Ascend-Minimum-Channels', - 'x_ascend_modem_portno' => 'X-Ascend-Modem-PortNo', - 'x_ascend_modem_shelfno' => 'X-Ascend-Modem-ShelfNo', - 'x_ascend_modem_slotno' => 'X-Ascend-Modem-SlotNo', - 'x_ascend_mpp_idle_percen' => 'X-Ascend-MPP-Idle-Percent', - 'x_ascend_multicast_clien' => 'X-Ascend-Multicast-Client', - 'x_ascend_multicast_rate_' => 'X-Ascend-Multicast-Rate-Limit', - 'x_ascend_multilink_id' => 'X-Ascend-Multilink-ID', - 'x_ascend_netware_timeout' => 'X-Ascend-Netware-timeout', - 'x_ascend_num_in_multilin' => 'X-Ascend-Num-In-Multilink', - 'x_ascend_number_sessions' => 'X-Ascend-Number-Sessions', - 'x_ascend_ppp_address' => 'X-Ascend-PPP-Address', - 'x_ascend_ppp_async_map' => 'X-Ascend-PPP-Async-Map', - 'x_ascend_ppp_vj_1172' => 'X-Ascend-PPP-VJ-1172', - 'x_ascend_ppp_vj_slot_com' => 'X-Ascend-PPP-VJ-Slot-Comp', - 'x_ascend_pre_input_octet' => 'X-Ascend-Pre-Input-Octets', - 'x_ascend_pre_input_packe' => 'X-Ascend-Pre-Input-Packets', - 'x_ascend_pre_output_octe' => 'X-Ascend-Pre-Output-Octets', - 'x_ascend_pre_output_pack' => 'X-Ascend-Pre-Output-Packets', - 'x_ascend_preempt_limit' => 'X-Ascend-Preempt-Limit', - 'x_ascend_presession_time' => 'X-Ascend-PreSession-Time', - 'x_ascend_pri_number_type' => 'X-Ascend-PRI-Number-Type', - 'x_ascend_primary_home_ag' => 'X-Ascend-Primary-Home-Agent', - 'x_ascend_pw_lifetime' => 'X-Ascend-PW-Lifetime', - 'x_ascend_pw_warntime' => 'X-Ascend-PW-Warntime', - 'x_ascend_receive_secret' => 'X-Ascend-Receive-Secret', - 'x_ascend_remote_addr' => 'X-Ascend-Remote-Addr', - 'x_ascend_remove_seconds' => 'X-Ascend-Remove-Seconds', - 'x_ascend_require_auth' => 'X-Ascend-Require-Auth', - 'x_ascend_route_ip' => 'X-Ascend-Route-IP', - 'x_ascend_route_ipx' => 'X-Ascend-Route-IPX', - 'x_ascend_secondary_home_' => 'X-Ascend-Secondary-Home-Agent', - 'x_ascend_seconds_of_hist' => 'X-Ascend-Seconds-Of-History', - 'x_ascend_send_auth' => 'X-Ascend-Send-Auth', - 'x_ascend_send_passwd' => 'X-Ascend-Send-Passwd', - 'x_ascend_send_secret' => 'X-Ascend-Send-Secret', - 'x_ascend_session_svr_key' => 'X-Ascend-Session-Svr-Key', - 'x_ascend_shared_profile_' => 'X-Ascend-Shared-Profile-Enable', - 'x_ascend_target_util' => 'X-Ascend-Target-Util', - 'x_ascend_temporary_rtes' => 'X-Ascend-Temporary-Rtes', - 'x_ascend_third_prompt' => 'X-Ascend-Third-Prompt', - 'x_ascend_token_expiry' => 'X-Ascend-Token-Expiry', - 'x_ascend_token_idle' => 'X-Ascend-Token-Idle', - 'x_ascend_token_immediate' => 'X-Ascend-Token-Immediate', - 'x_ascend_transit_number' => 'X-Ascend-Transit-Number', - 'x_ascend_ts_idle_limit' => 'X-Ascend-TS-Idle-Limit', - 'x_ascend_ts_idle_mode' => 'X-Ascend-TS-Idle-Mode', - 'x_ascend_tunneling_proto' => 'X-Ascend-Tunneling-Protocol', - 'x_ascend_user_acct_base' => 'X-Ascend-User-Acct-Base', - 'x_ascend_user_acct_host' => 'X-Ascend-User-Acct-Host', - 'x_ascend_user_acct_key' => 'X-Ascend-User-Acct-Key', - 'x_ascend_user_acct_port' => 'X-Ascend-User-Acct-Port', - 'x_ascend_user_acct_time' => 'X-Ascend-User-Acct-Time', - 'x_ascend_user_acct_type' => 'X-Ascend-User-Acct-Type', - 'x_ascend_xmit_rate' => 'X-Ascend-Xmit-Rate', - 'xedia_address_pool' => 'Xedia-Address-Pool', - 'xedia_client_access_netw' => 'Xedia-Client-Access-Network', - 'xedia_dns_server' => 'Xedia-DNS-Server', - 'xedia_netbios_server' => 'Xedia-NetBios-Server', - 'xedia_ppp_echo_interval' => 'Xedia-PPP-Echo-Interval', - 'xedia_ssh_privileges' => 'Xedia-SSH-Privileges', - - #NETC.NET.AU (RADIATOR?) - 'authentication_type' => 'Authentication-Type', - - #wtxs (dunno) - #'radius_operator' => 'Radius-Operator', - -); - -1; diff --git a/FS/FS/radius_usergroup.pm b/FS/FS/radius_usergroup.pm deleted file mode 100644 index 9bba057..0000000 --- a/FS/FS/radius_usergroup.pm +++ /dev/null @@ -1,131 +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<FS::svc_acct>) 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<FS::svc_acct>). - -=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<hash> 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') - || $self->SUPER::check - ; -} - -=item svc_acct - -Returns the account associated with this record (see L<FS::svc_acct>). - -=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<svc_acct>, L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/rate.pm b/FS/FS/rate.pm deleted file mode 100644 index a471e2e..0000000 --- a/FS/FS/rate.pm +++ /dev/null @@ -1,379 +0,0 @@ -package FS::rate; - -use strict; -use vars qw( @ISA $DEBUG ); -use FS::Record qw( qsearch qsearchs dbh fields ); -use FS::rate_detail; - -@ISA = qw(FS::Record); - -$DEBUG = 1; - -=head1 NAME - -FS::rate - Object methods for rate records - -=head1 SYNOPSIS - - use FS::rate; - - $record = new FS::rate \%hash; - $record = new FS::rate { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::rate object represents an rate plan. FS::rate inherits from -FS::Record. The following fields are currently supported: - -=over 4 - -=item ratenum - primary key - -=item ratename - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new rate plan. To add the rate plan to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'rate'; } - -=item insert [ , OPTION => VALUE ... ] - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -Currently available options are: I<rate_detail> - -If I<rate_detail> is set to an array reference of FS::rate_detail objects, the -objects will have their ratenum field set and will be inserted after this -record. - -=cut - -sub insert { - my $self = shift; - my %options = @_; - - 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; - - $error = $self->SUPER::insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - if ( $options{'rate_detail'} ) { - - my( $num, $last, $min_sec ) = (0, time, 5); #progressbar foo - - foreach my $rate_detail ( @{$options{'rate_detail'}} ) { - - $rate_detail->ratenum($self->ratenum); - $error = $rate_detail->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - if ( $options{'job'} ) { - $num++; - if ( time - $min_sec > $last ) { - my $error = $options{'job'}->update_statustext( - int( 100 * $num / scalar( @{$options{'rate_detail'}} ) ) - ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - $last = time; - } - } - - } - } - - $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 [ , OPTION => VALUE ... ] - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -Currently available options are: I<rate_detail> - -If I<rate_detail> is set to an array reference of FS::rate_detail objects, the -objects will have their ratenum field set and will be inserted after this -record. Any existing rate_detail records associated with this record will be -deleted. - -=cut - -sub replace { - my ($new, $old) = (shift, shift); - my %options = @_; - - 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 @old_rate_detail = (); -# @old_rate_detail = $old->rate_detail if $options{'rate_detail'}; - - my $error = $new->SUPER::replace($old); - if ($error) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - -# foreach my $old_rate_detail ( @old_rate_detail ) { -# -# my $error = $old_rate_detail->delete; -# if ($error) { -# $dbh->rollback if $oldAutoCommit; -# return $error; -# } -# -# if ( $options{'job'} ) { -# $num++; -# if ( time - $min_sec > $last ) { -# my $error = $options{'job'}->update_statustext( -# int( 50 * $num / scalar( @old_rate_detail ) ) -# ); -# if ( $error ) { -# $dbh->rollback if $oldAutoCommit; -# return $error; -# } -# $last = time; -# } -# } -# -# } - if ( $options{'rate_detail'} ) { - my $sth = $dbh->prepare('DELETE FROM rate_detail WHERE ratenum = ?') or do { - $dbh->rollback if $oldAutoCommit; - return $dbh->errstr; - }; - - $sth->execute($old->ratenum) or do { - $dbh->rollback if $oldAutoCommit; - return $sth->errstr; - }; - - my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo -# $num = 0; - foreach my $rate_detail ( @{$options{'rate_detail'}} ) { - - $rate_detail->ratenum($new->ratenum); - $error = $rate_detail->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - if ( $options{'job'} ) { - $num++; - if ( time - $min_sec > $last ) { - my $error = $options{'job'}->update_statustext( - int( 100 * $num / scalar( @{$options{'rate_detail'}} ) ) - ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - $last = time; - } - } - - } - - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - -} - -=item check - -Checks all fields to make sure this is a valid rate plan. 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('ratenum') - || $self->ut_text('ratename') - ; - return $error if $error; - - $self->SUPER::check; -} - -=item dest_detail REGIONNUM | RATE_REGION_OBJECTD - -Returns the rate detail (see L<FS::rate_detail>) for this rate to the -specificed destination. - -=cut - -sub dest_detail { - my $self = shift; - my $regionnum = ref($_[0]) ? shift->regionnum : shift; - qsearchs( 'rate_detail', { 'ratenum' => $self->ratenum, - 'dest_regionnum' => $regionnum, } ); -} - -=item rate_detail - -Returns all region-specific details (see L<FS::rate_detail>) for this rate. - -=cut - -sub rate_detail { - my $self = shift; - qsearch( 'rate_detail', { 'ratenum' => $self->ratenum } ); -} - - -=back - -=head1 SUBROUTINES - -=over 4 - -=item process - -Experimental job-queue processor for web interface adds/edits - -=cut - -use Storable qw(thaw); -use Data::Dumper; -use MIME::Base64; -sub process { - my $job = shift; - - my $param = thaw(decode_base64(shift)); - warn Dumper($param) if $DEBUG; - - my $old = qsearchs('rate', { 'ratenum' => $param->{'ratenum'} } ) - if $param->{'ratenum'}; - - my @rate_detail = map { - - my $regionnum = $_->regionnum; - if ( $param->{"sec_granularity$regionnum"} ) { - - new FS::rate_detail { - 'dest_regionnum' => $regionnum, - map { $_ => $param->{"$_$regionnum"} } - qw( min_included min_charge sec_granularity ) - }; - - } else { - - new FS::rate_detail { - 'dest_regionnum' => $regionnum, - 'min_included' => 0, - 'min_charge' => 0, - 'sec_granularity' => '60' - }; - - } - - } qsearch('rate_region', {} ); - - my $rate = new FS::rate { - map { $_ => $param->{$_} } - fields('rate') - }; - - my $error = ''; - if ( $param->{'ratenum'} ) { - warn "$rate replacing $old (". $param->{'ratenum'}. ")\n" if $DEBUG; - $error = $rate->replace( $old, - 'rate_detail' => \@rate_detail, - 'job' => $job, - ); - } else { - warn "inserting $rate\n" if $DEBUG; - $error = $rate->insert( 'rate_detail' => \@rate_detail, - 'job' => $job, - ); - #$ratenum = $rate->getfield('ratenum'); - } - - die "$error\n" if $error; - -} - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/rate_detail.pm b/FS/FS/rate_detail.pm deleted file mode 100644 index 6f023f5..0000000 --- a/FS/FS/rate_detail.pm +++ /dev/null @@ -1,165 +0,0 @@ -package FS::rate_detail; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); -use FS::rate; -use FS::rate_region; - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::rate_detail - Object methods for rate_detail records - -=head1 SYNOPSIS - - use FS::rate_detail; - - $record = new FS::rate_detail \%hash; - $record = new FS::rate_detail { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::rate_detail object represents an call plan rate. FS::rate_detail -inherits from FS::Record. The following fields are currently supported: - -=over 4 - -=item ratedetailnum - primary key - -=item ratenum - rate plan (see L<FS::rate>) - -=item orig_regionnum - call origination region - -=item dest_regionnum - call destination region - -=item min_included - included minutes - -=item min_charge - charge per minute - -=item sec_granularity - granularity in seconds, i.e. 6 or 60 - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new call plan rate. To add the call plan rate to the database, see -L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'rate_detail'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=cut - -# the insert method can be inherited from FS::Record - -=item delete - -Delete this record from the database. - -=cut - -# the delete method can be inherited from FS::Record - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -# the replace method can be inherited from FS::Record - -=item check - -Checks all fields to make sure this is a valid call plan rate. 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('ratedetailnum') - || $self->ut_foreign_key('ratenum', 'rate', 'ratenum') - || $self->ut_foreign_keyn('orig_regionnum', 'rate_region', 'regionnum' ) - || $self->ut_foreign_key('dest_regionnum', 'rate_region', 'regionnum' ) - || $self->ut_number('min_included') - - #|| $self->ut_money('min_charge') - #good enough for now... - || $self->ut_float('min_charge') - - || $self->ut_number('sec_granularity') - ; - return $error if $error; - - $self->SUPER::check; -} - -=item orig_region - -Returns the origination region (see L<FS::rate_region>) associated with this -call plan rate. - -=cut - -sub orig_region { - my $self = shift; - qsearchs('rate_region', { 'regionnum' => $self->orig_regionnum } ); -} - -=item dest_region - -Returns the destination region (see L<FS::rate_region>) associated with this -call plan rate. - -=cut - -sub dest_region { - my $self = shift; - qsearchs('rate_region', { 'regionnum' => $self->dest_regionnum } ); -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::rate>, L<FS::rate_region>, L<FS::Record>, -schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/rate_prefix.pm b/FS/FS/rate_prefix.pm deleted file mode 100644 index 42b004f..0000000 --- a/FS/FS/rate_prefix.pm +++ /dev/null @@ -1,139 +0,0 @@ -package FS::rate_prefix; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); -use FS::rate_region; - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::rate_prefix - Object methods for rate_prefix records - -=head1 SYNOPSIS - - use FS::rate_prefix; - - $record = new FS::rate_prefix \%hash; - $record = new FS::rate_prefix { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::rate_prefix object represents an call rating prefix. FS::rate_prefix -inherits from FS::Record. The following fields are currently supported: - -=over 4 - -=item prefixnum - primary key - -=item regionnum - call ration region (see L<FS::rate_region>) - -=item countrycode - -=item npa - -=item nxx - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new prefix. To add the prefix to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'rate_prefix'; } - -=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 prefix. 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('prefixnum') - || $self->ut_foreign_key('regionnum', 'rate_region', 'regionnum' ) - || $self->ut_number('countrycode') - || $self->ut_numbern('npa') - || $self->ut_numbern('nxx') - ; - return $error if $error; - - $self->SUPER::check; -} - -=item rate_region - -Returns the rate region (see L<FS::rate_region>) for this prefix. - -=cut - -sub rate_region { - my $self = shift; - qsearchs('rate_region', { 'regionnum' => $self->regionnum } ); -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::rate_region>, L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/rate_region.pm b/FS/FS/rate_region.pm deleted file mode 100644 index 65dfd2a..0000000 --- a/FS/FS/rate_region.pm +++ /dev/null @@ -1,313 +0,0 @@ -package FS::rate_region; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs dbh ); -use FS::rate_prefix; -use FS::rate_detail; - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::rate_region - Object methods for rate_region records - -=head1 SYNOPSIS - - use FS::rate_region; - - $record = new FS::rate_region \%hash; - $record = new FS::rate_region { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::rate_region object represents an call rating region. FS::rate_region -inherits from FS::Record. The following fields are currently supported: - -=over 4 - -=item regionnum - primary key - -=item regionname - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new region. To add the region to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'rate_region'; } - -=item insert [ , OPTION => VALUE ... ] - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -Currently available options are: I<rate_prefix> and I<dest_detail> - -If I<rate_prefix> is set to an array reference of FS::rate_prefix objects, the -objects will have their regionnum field set and will be inserted after this -record. - -If I<dest_detail> is set to an array reference of FS::rate_detail objects, the -objects will have their dest_regionnum field set and will be inserted after -this record. - - -=cut - -sub insert { - my $self = shift; - my %options = @_; - - 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; - - $error = $self->SUPER::insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - if ( $options{'rate_prefix'} ) { - foreach my $rate_prefix ( @{$options{'rate_prefix'}} ) { - $rate_prefix->regionnum($self->regionnum); - $error = $rate_prefix->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - } - - if ( $options{'dest_detail'} ) { - foreach my $rate_detail ( @{$options{'dest_detail'}} ) { - $rate_detail->dest_regionnum($self->regionnum); - $error = $rate_detail->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 - -# the delete method can be inherited from FS::Record - -=item replace OLD_RECORD [ , OPTION => VALUE ... ] - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -Currently available options are: I<rate_prefix> and I<dest_detail> - -If I<rate_prefix> is set to an array reference of FS::rate_prefix objects, the -objects will have their regionnum field set and will be inserted after this -record. Any existing rate_prefix records associated with this record will be -deleted. - -If I<dest_detail> is set to an array reference of FS::rate_detail objects, the -objects will have their dest_regionnum field set and will be inserted after -this record. Any existing rate_detail records associated with this record will -be deleted. - -=cut - -sub replace { - my ($new, $old) = (shift, shift); - my %options = @_; - - 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 @old_rate_prefix = (); - @old_rate_prefix = $old->rate_prefix if $options{'rate_prefix'}; - my @old_dest_detail = (); - @old_dest_detail = $old->dest_detail if $options{'dest_detail'}; - - my $error = $new->SUPER::replace($old); - if ($error) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - foreach my $old_rate_prefix ( @old_rate_prefix ) { - my $error = $old_rate_prefix->delete; - if ($error) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - foreach my $old_dest_detail ( @old_dest_detail ) { - my $error = $old_dest_detail->delete; - if ($error) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - foreach my $rate_prefix ( @{$options{'rate_prefix'}} ) { - $rate_prefix->regionnum($new->regionnum); - $error = $rate_prefix->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - foreach my $rate_detail ( @{$options{'dest_detail'}} ) { - $rate_detail->dest_regionnum($new->regionnum); - $error = $rate_detail->insert; - 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 region. 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('regionnum') - || $self->ut_text('regionname') - ; - return $error if $error; - - $self->SUPER::check; -} - -=item rate_prefix - -Returns all prefixes (see L<FS::rate_prefix>) for this region. - -=cut - -sub rate_prefix { - my $self = shift; - - sort { $a->countrycode cmp $b->countrycode - or $a->npa cmp $b->npa - or $a->nxx cmp $b->nxx - } - qsearch( 'rate_prefix', { 'regionnum' => $self->regionnum } ); -} - -=item dest_detail - -Returns all rate details (see L<FS::rate_detail>) for this region as a -destionation. - -=cut - -sub dest_detail { - my $self = shift; - qsearch( 'rate_detail', { 'dest_regionnum' => $self->regionnum, } ); -} - -=item prefixes_short - -Returns a string representing all the prefixes for this region. - -=cut - -sub prefixes_short { - my $self = shift; - - my $countrycode = ''; - my $out = ''; - - foreach my $rate_prefix ( $self->rate_prefix ) { - if ( $countrycode ne $rate_prefix->countrycode ) { - $out =~ s/, $//; - $countrycode = $rate_prefix->countrycode; - $out.= " +$countrycode "; - } - my $npa = $rate_prefix->npa; - if ( $countrycode eq '1' ) { - $out .= '('. substr( $npa, 0, 3 ). ')'; - $out .= ' '. substr( $npa, 3 ) if length($npa) > 3; - } else { - $out .= $rate_prefix->npa; - } - $out .= ', '; - } - $out =~ s/, $//; - - $out; -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/reg_code.pm b/FS/FS/reg_code.pm deleted file mode 100644 index f48ccf0..0000000 --- a/FS/FS/reg_code.pm +++ /dev/null @@ -1,223 +0,0 @@ -package FS::reg_code; - -use strict; -use vars qw( @ISA ); -use FS::Record qw(qsearch dbh); -use FS::agent; -use FS::reg_code_pkg; - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::reg_code - One-time registration codes - -=head1 SYNOPSIS - - use FS::reg_code; - - $record = new FS::reg_code \%hash; - $record = new FS::reg_code { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::reg_code object is a one-time registration code. FS::reg_code inherits -from FS::Record. The following fields are currently supported: - -=over 4 - -=item codenum - primary key - -=item code - registration code string - -=item agentnum - Agent (see L<FS::agent>) - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new registration code. To add the code to the database, see -L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'reg_code'; } - -=item insert [ PKGPART_ARRAYREF ] - -Adds this record to the database. If an arrayref of pkgparts -(see L<FS::part_pkg>) is specified, the appropriate reg_code_pkg records -(see L<FS::reg_code_pkg>) will be inserted. - -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; - } - - if ( @_ ) { - my $pkgparts = shift; - foreach my $pkgpart ( @$pkgparts ) { - my $reg_code_pkg = new FS::reg_code_pkg ( { - 'codenum' => $self->codenum, - 'pkgpart' => $pkgpart, - } ); - $error = $reg_code_pkg->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - -} - -=item delete - -Delete this record (and all associated reg_code_pkg records) from the database. - -=cut - -sub delete { - my $self = shift; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - foreach my $reg_code_pkg ( $self->reg_code_pkg ) { - my $error = $reg_code_pkg->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - my $error = $self->SUPER::delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - -} - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -# the replace method can be inherited from FS::Record - -=item check - -Checks all fields to make sure this is a valid registration code. 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('codenum') - || $self->ut_alpha('code') - || $self->ut_foreign_key('agentnum', 'agent', 'agentnum') - ; - return $error if $error; - - $self->SUPER::check; -} - -=item part_pkg - -Returns all package definitions (see L<FS::part_pkg> for this registration -code. - -=cut - -sub part_pkg { - my $self = shift; - map { $_->part_pkg } $self->reg_code_pkg; -} - -=item reg_code_pkg - -Returns all FS::reg_code_pkg records for this registration code. - -=cut - -sub reg_code_pkg { - my $self = shift; - qsearch('reg_code_pkg', { 'codenum' => $self->codenum } ); -} - - -=back - -=head1 BUGS - -Feeping creaturitis. - -=head1 SEE ALSO - -L<FS::reg_code_pkg>, L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - - diff --git a/FS/FS/reg_code_pkg.pm b/FS/FS/reg_code_pkg.pm deleted file mode 100644 index 837b755..0000000 --- a/FS/FS/reg_code_pkg.pm +++ /dev/null @@ -1,139 +0,0 @@ -package FS::reg_code_pkg; - -use strict; -use vars qw( @ISA ); -use FS::Record qw(qsearchs); -use FS::reg_code; -use FS::part_pkg; - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::reg_code_pkg - Class linking registration codes (see L<FS::reg_code>) with package definitions (see L<FS::part_pkg>) - -=head1 SYNOPSIS - - use FS::reg_code_pkg; - - $record = new FS::reg_code_pkg \%hash; - $record = new FS::reg_code_pkg { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::reg_code_pkg object links a registration code to a package definition. -FS::table_name inherits from FS::Record. The following fields are currently -supported: - -=over 4 - -=item codepkgnum - primary key - -=item codenum - registration code (see L<FS::reg_code>) - -=item pkgpart - package definition (see L<FS::part_pkg>) - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new registration code. To add the registration code to the database, -see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'reg_code_pkg'; } - -=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; - - my $error = - $self->ut_numbern('codepkgnum') - || $self->ut_foreign_key('codenum', 'reg_code', 'codenum') - || $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart') - ; - return $error if $error; - - $self->SUPER::check; -} - -=item part_pkg - -Returns the package definition (see L<FS::part_pkg>) - -=cut - -sub part_pkg { - my $self = shift; - qsearchs('part_pkg', { 'pkgpart' => $self->pkgpart } ); -} - -=back - -=head1 BUGS - -Feeping creaturitis. - -=head1 SEE ALSO - -L<FS::reg_code_pkg>, L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - - diff --git a/FS/FS/router.pm b/FS/FS/router.pm deleted file mode 100755 index 88ba990..0000000 --- a/FS/FS/router.pm +++ /dev/null @@ -1,140 +0,0 @@ -package FS::router; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearchs qsearch ); -use FS::addr_block; - -@ISA = qw( FS::Record ); - -=head1 NAME - -FS::router - Object methods for router records - -=head1 SYNOPSIS - - use FS::router; - - $record = new FS::router \%hash; - $record = new FS::router { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::router record describes a broadband router, such as a DSLAM or a wireless - access point. FS::router inherits from FS::Record. The following -fields are currently supported: - -=over 4 - -=item routernum - primary key - -=item routername - descriptive name for the router - -=item svcnum - svcnum of the owning FS::svc_broadband, if appropriate - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Create a new record. To add the record to the database, see "insert". - -=cut - -sub table { 'router'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=item delete - -Deletes this record from the database. If there is an error, returns the -error, otherwise returns false. - -=item replace OLD_RECORD - -Replaces OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=item check - -Checks all fields to make sure this is a valid record. If there is an error, -returns the error, otherwise returns false. Called by the insert and replace -methods. - -=cut - -sub check { - my $self = shift; - - my $error = - $self->ut_numbern('routernum') - || $self->ut_text('routername'); - return $error if $error; - - $self->SUPER::check; -} - -=item addr_block - -Returns a list of FS::addr_block objects (address blocks) associated -with this object. - -=cut - -sub addr_block { - my $self = shift; - return qsearch('addr_block', { routernum => $self->routernum }); -} - -=item part_svc_router - -Returns a list of FS::part_svc_router objects associated with this -object. This is unlikely to be useful for any purpose other than retrieving -the associated FS::part_svc objects. See below. - -=cut - -sub part_svc_router { - my $self = shift; - return qsearch('part_svc_router', { routernum => $self->routernum }); -} - -=item part_svc - -Returns a list of FS::part_svc objects associated with this object. - -=cut - -sub part_svc { - my $self = shift; - return map { qsearchs('part_svc', { svcpart => $_->svcpart }) } - $self->part_svc_router; -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -FS::svc_broadband, FS::router, FS::addr_block, FS::part_svc, -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 615c8ae..0000000 --- a/FS/FS/session.pm +++ /dev/null @@ -1,265 +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<FS::port> - -=item svcnum - User for this session - see L<FS::svc_acct> - -=item login - timestamp indicating the beginning of this user session. - -=item logout - timestamp indicating the end of this user session. May be null, - which indicates a currently open session. - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new session. To add the session to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'session'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. If the `login' field is empty, it is replaced with -the current time. - -=cut - -sub insert { - my $self = shift; - my $error; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - $error = $self->check; - return $error if $error; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - if ( qsearchs('session', { 'portnum' => $self->portnum, 'logout' => '' } ) ) { - $dbh->rollback if $oldAutoCommit; - return "a session on that port is already open!"; - } - - $self->setfield('login', time()) unless $self->getfield('login'); - - $error = $self->SUPER::insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - $self->nas_heartbeat($self->getfield('login')); - - #session-starting callback - #redundant with heartbeat, yuck - my $port = qsearchs('port',{'portnum'=>$self->portnum}); - my $nas = qsearchs('nas',{'nasnum'=>$port->nasnum}); - #kcuy - my( $ip, $nasip, $nasfqdn ) = ( $port->ip, $nas->nasip, $nas->nasfqdn ); - system( eval qq("$start") ) if $start; - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - -} - -=item delete - -Delete this record from the database. - -=cut - -# the delete method can be inherited from FS::Record - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. If the `logout' field is empty, -it is replaced with the current time. - -=cut - -sub replace { - my($self, $old) = @_; - my $error; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - $error = $self->check; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - $self->setfield('logout', time()) unless $self->getfield('logout'); - - $error = $self->SUPER::replace($old); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - $self->nas_heartbeat($self->getfield('logout')); - - #session-ending callback - #redundant with heartbeat, yuck - my $port = qsearchs('port',{'portnum'=>$self->portnum}); - my $nas = qsearchs('nas',{'nasnum'=>$port->nasnum}); - #kcuy - my( $ip, $nasip, $nasfqdn ) = ( $port->ip, $nas->nasip, $nas->nasfqdn ); - system( eval qq("$stop") ) if $stop; - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; -} - -=item check - -Checks all fields to make sure this is a valid session. If there is -an error, returns the error, otherwise returns false. Called by the insert -and replace methods. - -=cut - -# the check method should currently be supplied - FS::Record contains some -# data checking routines - -sub check { - my $self = shift; - my $error = - $self->ut_numbern('sessionnum') - || $self->ut_number('portnum') - || $self->ut_number('svcnum') - || $self->ut_numbern('login') - || $self->ut_numbern('logout') - ; - return $error if $error; - return "Unknown svcnum" - unless qsearchs('svc_acct', { 'svcnum' => $self->svcnum } ); - $self->SUPER::check; -} - -=item nas_heartbeat - -Heartbeats the nas associated with this session (see L<FS::nas>). - -=cut - -sub nas_heartbeat { - my $self = shift; - my $port = qsearchs('port',{'portnum'=>$self->portnum}); - my $nas = qsearchs('nas',{'nasnum'=>$port->nasnum}); - $nas->heartbeat(shift); -} - -=item svc_acct - -Returns the svc_acct record associated with this session (see L<FS::svc_acct>). - -=cut - -sub svc_acct { - my $self = shift; - qsearchs('svc_acct', { 'svcnum' => $self->svcnum } ); -} - -=back - -=head1 BUGS - -Maybe you shouldn't be able to insert a session if there's currently an open -session on that port. Or maybe the open session on that port should be flagged -as problematic? autoclosed? *sigh* - -Hmm, sessions refer to current svc_acct records... probably need to constrain -deletions to svc_acct records such that no svc_acct records are deleted which -have a session (even if long-closed). - -=head1 SEE ALSO - -L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/svc_Common.pm b/FS/FS/svc_Common.pm deleted file mode 100644 index 907f35f..0000000 --- a/FS/FS/svc_Common.pm +++ /dev/null @@ -1,779 +0,0 @@ -package FS::svc_Common; - -use strict; -use vars qw( @ISA $noexport_hack $DEBUG ); -use Carp; -use FS::Record qw( qsearch qsearchs fields dbh ); -use FS::cust_main_Mixin; -use FS::cust_svc; -use FS::part_svc; -use FS::queue; -use FS::cust_main; -use FS::inventory_item; -use FS::inventory_class; - -@ISA = qw( FS::cust_main_Mixin FS::Record ); - -$DEBUG = 1; - -=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 - -=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'}; - } - - #$self->{'Hash'} = shift; - my $newhash = shift; - $self->{'Hash'} = { map { $_ => $newhash->{$_} } qw(svcnum svcpart) }; - - $self->setdefault( $self->_fieldhandlers ) - unless $self->svcnum; - - $self->{'Hash'}{$_} = $newhash->{$_} - foreach grep { defined($newhash->{$_}) && length($newhash->{$_}) } - keys %$newhash; - - foreach my $field ( grep !defined($self->{'Hash'}{$_}), $self->fields ) { - $self->{'Hash'}{$field}=''; - } - - $self->_rebless if $self->can('_rebless'); - - $self->{'modified'} = 0; - - $self->_cache($self->{'Hash'}, shift) if $self->can('_cache') && @_; - - $self; -} - -#empty default -sub _fieldhandlers { {}; } - -sub virtual_fields { - - # This restricts the fields based on part_svc_column and the svcpart of - # the service. There are four possible cases: - # 1. svcpart passed as part of the svc_x hash. - # 2. svcpart fetched via cust_svc based on svcnum. - # 3. No svcnum or svcpart. In this case, return ALL the fields with - # dbtable eq $self->table. - # 4. Called via "fields('svc_acct')" or something similar. In this case - # there is no $self object. - - my $self = shift; - my $svcpart; - my @vfields = $self->SUPER::virtual_fields; - - return @vfields unless (ref $self); # Case 4 - - if ($self->svcpart) { # Case 1 - $svcpart = $self->svcpart; - } elsif ( $self->svcnum - && qsearchs('cust_svc',{'svcnum'=>$self->svcnum} ) - ) { #Case 2 - $svcpart = $self->cust_svc->svcpart; - } else { # Case 3 - $svcpart = ''; - } - - if ($svcpart) { #Cases 1 and 2 - my %flags = map { $_->columnname, $_->columnflag } ( - qsearch ('part_svc_column', { svcpart => $svcpart } ) - ); - return grep { not ($flags{$_} eq 'X') } @vfields; - } else { # Case 3 - return @vfields; - } - return (); -} - -=item check - -Checks the validity of fields in this record. - -At present, this does nothing but call FS::Record::check (which, in turn, -does nothing but run virtual field checks). - -=cut - -sub check { - my $self = shift; - $self->SUPER::check; -} - -=item insert [ , OPTION => VALUE ... ] - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be -defined. An FS::cust_svc record will be created and inserted. - -Currently available options are: I<jobnums>, I<child_objects> and -I<depend_jobnum>. - -If I<jobnum> is set to an array reference, the jobnums of any export jobs will -be added to the referenced array. - -If I<child_objects> is set to an array reference of FS::tablename objects (for -example, FS::acct_snarf objects), they will have their svcnum field set and -will be inserted after this record, but before any exports are run. Each -element of the array can also optionally be a two-element array reference -containing the child object and the name of an alternate field to be filled in -with the newly-inserted svcnum, for example C<[ $svc_forward, 'srcsvc' ]> - -If I<depend_jobnum> is set (to a scalar jobnum or an array reference of -jobnums), all provisioning jobs will have a dependancy on the supplied -jobnum(s) (they will not run until the specific job(s) complete(s)). - -=cut - -sub insert { - my $self = shift; - my %options = @_; - warn "FS::svc_Common::insert called with options ". - join(', ', map { "$_: $options{$_}" } keys %options ). "\n" - if $DEBUG; - - my @jobnums = (); - local $FS::queue::jobnums = \@jobnums; - warn "FS::svc_Common::insert: set \$FS::queue::jobnums to $FS::queue::jobnums" - if $DEBUG; - my $objects = $options{'child_objects'} || []; - my $depend_jobnums = $options{'depend_jobnum'} || []; - $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums); - 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 = $svcnum ? qsearchs('cust_svc',{'svcnum'=>$self->svcnum}) : ''; - #unless ( $svcnum ) { - if ( !$svcnum or !$cust_svc ) { - $cust_svc = new FS::cust_svc ( { - #hua?# 'svcnum' => $svcnum, - 'svcnum' => $self->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->set_auto_inventory; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - $error = $self->SUPER::insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - foreach my $object ( @$objects ) { - my($field, $obj); - if ( ref($object) eq 'ARRAY' ) { - ($obj, $field) = @$object; - } else { - $obj = $object; - $field = 'svcnum'; - } - $obj->$field($self->svcnum); - $error = $obj->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - #new-style exports! - unless ( $noexport_hack ) { - - warn "FS::svc_Common::insert: \$FS::queue::jobnums is $FS::queue::jobnums" - if $DEBUG; - - 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"; - } - } - - foreach my $depend_jobnum ( @$depend_jobnums ) { - warn "inserting dependancies on supplied job $depend_jobnum\n" - if $DEBUG; - foreach my $jobnum ( @jobnums ) { - my $queue = qsearchs('queue', { 'jobnum' => $jobnum } ); - warn "inserting dependancy for job $jobnum on $depend_jobnum\n" - if $DEBUG; - my $error = $queue->depend_insert($depend_jobnum); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error queuing job dependancy: $error"; - } - } - } - - } - - if ( exists $options{'jobnums'} ) { - push @{ $options{'jobnums'} }, @jobnums; - } - - $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 ) { - $error = $part_export->export_delete($self); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "exporting to ". $part_export->exporttype. - " (transaction rolled back): $error"; - } - } - } - - $error = $self->return_inventory; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error returning inventory: $error"; - } - - my $cust_svc = $self->cust_svc; - $error = $cust_svc->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. 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->set_auto_inventory; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - $error = $new->SUPER::replace($old); - if ($error) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - #new-style exports! - unless ( $noexport_hack ) { - - #not quite false laziness, but same pattern as FS::svc_acct::replace and - #FS::part_export::sqlradius::_export_replace. List::Compare or something - #would be useful but too much of a pain in the ass to deploy - - my @old_part_export = $old->cust_svc->part_svc->part_export; - my %old_exportnum = map { $_->exportnum => 1 } @old_part_export; - my @new_part_export = - $new->svcpart - ? qsearchs('part_svc', { svcpart=>$new->svcpart } )->part_export - : $new->cust_svc->part_svc->part_export; - my %new_exportnum = map { $_->exportnum => 1 } @new_part_export; - - foreach my $delete_part_export ( - grep { ! $new_exportnum{$_->exportnum} } @old_part_export - ) { - my $error = $delete_part_export->export_delete($old); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error deleting, export to ". $delete_part_export->exporttype. - " (transaction rolled back): $error"; - } - } - - foreach my $replace_part_export ( - grep { $old_exportnum{$_->exportnum} } @new_part_export - ) { - my $error = $replace_part_export->export_replace($new,$old); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error exporting to ". $replace_part_export->exporttype. - " (transaction rolled back): $error"; - } - } - - foreach my $insert_part_export ( - grep { ! $old_exportnum{$_->exportnum} } @new_part_export - ) { - my $error = $insert_part_export->export_insert($new); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error inserting export to ". $insert_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<FS::part_svc>). If there is an -error, returns the error, otherwise returns the FS::part_svc object (use ref() -to test the return). Usually called by the check method. - -=cut - -sub setfixed { - my $self = shift; - $self->setx('F', @_); -} - -=item setdefault - -Sets all fields to their defaults (see L<FS::part_svc>), overriding their -current values. If there is an error, returns the error, otherwise returns -the FS::part_svc object (use ref() to test the return). - -=cut - -sub setdefault { - my $self = shift; - $self->setx('D', @_ ); -} - -=item set_default_and_fixed - -=cut - -sub set_default_and_fixed { - my $self = shift; - $self->setx( [ 'D', 'F' ], @_ ); -} - -=item setx FLAG | FLAG_ARRAYREF , [ CALLBACK_HASHREF ] - -Sets fields according to the passed in flag or arrayref of flags. - -Optionally, a hashref of field names and callback coderefs can be passed. -If a coderef exists for a given field name, instead of setting the field, -the coderef is called with the column value (part_svc_column.columnvalue) -as the single parameter. - -=cut - -sub setx { - my $self = shift; - my $x = shift; - my @x = ref($x) ? @$x : ($x); - my $coderef = scalar(@_) ? shift : $self->_fieldhandlers; - - my $error = - $self->ut_numbern('svcnum') - ; - return $error if $error; - - my $part_svc = $self->part_svc; - return "Unkonwn svcpart" unless $part_svc; - - #set default/fixed/whatever fields from part_svc - - foreach my $part_svc_column ( - grep { my $f = $_->columnflag; grep { $f eq $_ } @x } #columnflag in @x - $part_svc->all_part_svc_column - ) { - - my $columnname = $part_svc_column->columnname; - my $columnvalue = $part_svc_column->columnvalue; - - $columnvalue = &{ $coderef->{$columnname} }( $self, $columnvalue ) - if exists( $coderef->{$columnname} ); - $self->setfield( $columnname, $columnvalue ); - - } - - $part_svc; - -} - -sub part_svc { - my $self = shift; - - #get part_svc - my $svcpart; - if ( $self->get('svcpart') ) { - $svcpart = $self->get('svcpart'); - } elsif ( $self->svcnum && qsearchs('cust_svc', {'svcnum'=>$self->svcnum}) ) { - my $cust_svc = $self->cust_svc; - return "Unknown svcnum" unless $cust_svc; - $svcpart = $cust_svc->svcpart; - } - - qsearchs( 'part_svc', { 'svcpart' => $svcpart } ); - -} - -=item set_auto_inventory - -Sets any fields which auto-populate from inventory (see L<FS::part_svc>). -If there is an error, returns the error, otherwise returns false. - -=cut - -sub set_auto_inventory { - my $self = shift; - - my $error = - $self->ut_numbern('svcnum') - ; - return $error if $error; - - my $part_svc = $self->part_svc; - return "Unkonwn svcpart" unless $part_svc; - - 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; - - #set default/fixed/whatever fields from part_svc - my $table = $self->table; - foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) { - my $part_svc_column = $part_svc->part_svc_column($field); - if ( $part_svc_column->columnflag eq 'A' && $self->$field() eq '' ) { - - my $classnum = $part_svc_column->columnvalue; - my $inventory_item = qsearchs({ - 'table' => 'inventory_item', - 'hashref' => { 'classnum' => $classnum, - 'svcnum' => '', - }, - 'extra_sql' => 'LIMIT 1 FOR UPDATE', - }); - - unless ( $inventory_item ) { - $dbh->rollback if $oldAutoCommit; - my $inventory_class = - qsearchs('inventory_class', { 'classnum' => $classnum } ); - return "Can't find inventory_class.classnum $classnum" - unless $inventory_class; - return "Out of ". $inventory_class->classname. "s\n"; #Lingua:: BS - #for pluralizing - } - - $inventory_item->svcnum( $self->svcnum ); - my $ierror = $inventory_item->replace(); - if ( $ierror ) { - $dbh->rollback if $oldAutoCommit; - return "Error provisioning inventory: $ierror"; - - } - - $self->setfield( $field, $inventory_item->item ); - - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; - -} - -=item return_inventory - -=cut - -sub return_inventory { - my $self = shift; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - foreach my $inventory_item ( $self->inventory_item ) { - $inventory_item->svcnum(''); - my $error = $inventory_item->replace(); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Error returning inventory: $error"; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; -} - -=item inventory_item - -Returns the inventory items associated with this svc_ record, as -FS::inventory_item objects (see L<FS::inventory_item>. - -=cut - -sub inventory_item { - my $self = shift; - qsearch({ - 'table' => 'inventory_item', - 'hashref' => { 'svcnum' => $self->svcnum, }, - }); -} - -=item cust_svc - -Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc -object (see L<FS::cust_svc>). - -=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<FS::cust_pkg>). - -=cut - -sub cancel { ''; } - -=item clone_suspended - -Constructor used by FS::part_export::_export_suspend fallback. Stub returning -same object for svc_ classes which don't implement a suspension fallback -(everything except svc_acct at the moment). Document better. - -=cut - -sub clone_suspended { - shift; -} - -=item clone_kludge_unsuspend - -Constructor used by FS::part_export::_export_unsuspend fallback. Stub returning -same object for svc_ classes which don't implement a suspension fallback -(everything except svc_acct at the moment). Document better. - -=cut - -sub clone_kludge_unsuspend { - shift; -} - -=back - -=head1 BUGS - -The setfixed method return value. - -=head1 SEE ALSO - -L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html -from the base documentation. - -=cut - -1; - diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm deleted file mode 100644 index b201f23..0000000 --- a/FS/FS/svc_acct.pm +++ /dev/null @@ -1,1761 +0,0 @@ -package FS::svc_acct; - -use strict; -use vars qw( @ISA $DEBUG $me $conf $skip_fuzzyfiles - $dir_prefix @shells $usernamemin - $usernamemax $passwordmin $passwordmax - $username_ampersand $username_letter $username_letterfirst - $username_noperiod $username_nounderscore $username_nodash - $username_uppercase $username_percent - $password_noampersand $password_noexclamation - $welcome_template $welcome_from $welcome_subject $welcome_mimetype - $smtpmachine - $radius_password $radius_ip - $dirhash - @saltset @pw_set ); -use Carp; -use Fcntl qw(:flock); -use Date::Format; -use Crypt::PasswdMD5 1.2; -use Data::Dumper; -use FS::UID qw( datasrc ); -use FS::Conf; -use FS::Record qw( qsearch qsearchs fields dbh dbdef ); -use FS::Msgcat qw(gettext); -use FS::svc_Common; -use FS::cust_svc; -use FS::part_svc; -use FS::svc_acct_pop; -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::svc_forward; -use FS::svc_www; -use FS::cdr; - -@ISA = qw( FS::svc_Common ); - -$DEBUG = 0; -$me = '[FS::svc_acct]'; - -#ask FS::UID to run this stuff for us later -$FS::UID::callback{'FS::svc_acct'} = sub { - $conf = new FS::Conf; - $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'); - $username_percent = $conf->exists('username-percent'); - $password_noampersand = $conf->exists('password-noexclamation'); - $password_noexclamation = $conf->exists('password-noexclamation'); - $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 = ''; - $welcome_from = ''; - $welcome_subject = ''; - $welcome_mimetype = ''; - } - $smtpmachine = $conf->config('smtpmachine'); - $radius_password = $conf->config('radius-password') || 'Password'; - $radius_ip = $conf->config('radius-ip') || 'Framed-IP-Address'; -}; - -@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); -@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<FS::svc_acct_pop>) - -=item uid - -=item gid - -=item finger - GECOS - -=item dir - set automatically if blank (and uid is not) - -=item shell - -=item quota - (unimplementd) - -=item slipip - IP address - -=item seconds - - -=item domsvc - svcnum from svc_domain - -=item radius_I<Radius_Attribute> - I<Radius-Attribute> (reply) - -=item rc_I<Radius_Attribute> - I<Radius-Attribute> (check) - -=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'; } - -sub _fieldhandlers { - { - #false laziness with edit/svc_acct.cgi - 'usergroup' => sub { - my( $self, $groups ) = @_; - if ( ref($groups) eq 'ARRAY' ) { - $groups; - } elsif ( length($groups) ) { - [ split(/\s*,\s*/, $groups) ]; - } else { - []; - } - }, - }; -} - -=item insert [ , OPTION => VALUE ... ] - -Adds this account to the database. If there is an error, returns the error, -otherwise returns false. - -The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be -defined. An FS::cust_svc record will be created and inserted. - -The additional field I<usergroup> can optionally be defined; if so it should -contain an arrayref of group names. See L<FS::radius_usergroup>. - -The additional field I<child_objects> can optionally be defined; if so it -should contain an arrayref of FS::tablename objects. They will have their -svcnum fields set and will be inserted after this record, but before any -exports are run. Each element of the array can also optionally be a -two-element array reference containing the child object and the name of an -alternate field to be filled in with the newly-inserted svcnum, for example -C<[ $svc_forward, 'srcsvc' ]> - -Currently available options are: I<depend_jobnum> - -If I<depend_jobnum> is set (to a scalar jobnum or an array reference of -jobnums), all provisioning jobs will have a dependancy on the supplied -jobnum(s) (they will not run until the specific job(s) complete(s)). - -(TODOC: L<FS::queue> and L<freeside-queued>) - -(TODOC: new exports!) - -=cut - -sub insert { - my $self = shift; - my %options = @_; - - if ( $DEBUG ) { - warn "[$me] insert called on $self: ". Dumper($self). - "\nwith options: ". Dumper(%options); - } - - 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; - - if ( $self->svcnum && qsearchs('cust_svc',{'svcnum'=>$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); - } - - $error = $self->_check_duplicate; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - my @jobnums; - $error = $self->SUPER::insert( - 'jobnums' => \@jobnums, - 'child_objects' => $self->child_objects, - %options, - ); - 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; - } - } - } - - unless ( $skip_fuzzyfiles ) { - $error = $self->queue_fuzzyfiles_update; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "updating fuzzy search cache: $error"; - } - } - - my $cust_pkg = $self->cust_svc->cust_pkg; - - if ( $cust_pkg ) { - my $cust_main = $cust_pkg->cust_main; - - if ( $conf->exists('emailinvoiceauto') ) { - my @invoicing_list = $cust_main->invoicing_list; - push @invoicing_list, $self->email; - $cust_main->invoicing_list(\@invoicing_list); - } - - #welcome email - my $to = ''; - if ( $welcome_template && $cust_pkg ) { - my $to = join(', ', grep { $_ !~ /^(POST|FAX)$/ } $cust_main->invoicing_list ); - if ( $to ) { - my $wqueue = new FS::queue { - 'svcnum' => $self->svcnum, - 'job' => 'FS::svc_acct::send_email' - }; - my $error = $wqueue->insert( - 'to' => $to, - 'from' => $welcome_from, - 'subject' => $welcome_subject, - 'mimetype' => $welcome_mimetype, - 'body' => $welcome_template->fill_in( HASH => { - 'custnum' => $self->custnum, - 'username' => $self->username, - 'password' => $self->_password, - 'first' => $cust_main->first, - 'last' => $cust_main->getfield('last'), - 'pkg' => $cust_pkg->part_pkg->pkg, - } ), - ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error queuing welcome email: $error"; - } - - if ( $options{'depend_jobnum'} ) { - warn "$me depend_jobnum found; adding to welcome email dependancies" - if $DEBUG; - if ( ref($options{'depend_jobnum'}) ) { - warn "$me adding jobs ". join(', ', @{$options{'depend_jobnum'}} ). - "to welcome email dependancies" - if $DEBUG; - push @jobnums, @{ $options{'depend_jobnum'} }; - } else { - warn "$me adding job $options{'depend_jobnum'} ". - "to welcome email dependancies" - if $DEBUG; - push @jobnums, $options{'depend_jobnum'}; - } - } - - foreach my $jobnum ( @jobnums ) { - my $error = $wqueue->depend_insert($jobnum); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error queuing welcome email job dependancy: $error"; - } - } - - } - - } - - } # if ( $cust_pkg ) - - $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!) - -=cut - -sub delete { - my $self = shift; - - return "can't delete system account" if $self->_check_system; - - 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->svcnum } ); - - # 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<usergroup> can optionally be defined; if so it should -contain an arrayref of group names. See L<FS::radius_usergroup>. - - -=cut - -sub replace { - my ( $new, $old ) = ( shift, shift ); - my $error; - warn "$me replacing $old with $new\n" if $DEBUG; - - # We absolutely have to have an old vs. new record to make this work. - if (!defined($old)) { - $old = qsearchs( 'svc_acct', { 'svcnum' => $new->svcnum } ); - } - - return "can't modify system account" if $old->_check_system; - - { - #no warnings 'numeric'; #alas, a 5.006-ism - local($^W) = 0; - - foreach my $xid (qw( uid gid )) { - - return "Can't change $xid!" - if ! $conf->exists("svc_acct-edit_$xid") - && $old->$xid() != $new->$xid() - && $new->cust_svc->part_svc->part_svc_column($xid)->columnflag ne 'F' - } - - } - - #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; - - # redundant, but so $new->usergroup gets set - $error = $new->check; - return $error if $error; - - $old->usergroup( [ $old->radius_groups ] ); - if ( $DEBUG ) { - warn $old->email. " old groups: ". join(' ',@{$old->usergroup}). "\n"; - warn $new->email. "new groups: ". join(' ',@{$new->usergroup}). "\n"; - } - 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"; - } - } - - } - - if ( $old->username ne $new->username || $old->domsvc != $new->domsvc ) { - $new->svcpart( $new->cust_svc->svcpart ) unless $new->svcpart; - $error = $new->_check_duplicate; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - $error = $new->SUPER::replace($old); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error if $error; - } - - if ( $new->username ne $old->username && ! $skip_fuzzyfiles ) { - $error = $new->queue_fuzzyfiles_update; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "updating fuzzy search cache: $error"; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; #no error -} - -=item queue_fuzzyfiles_update - -Used by insert & replace to update the fuzzy search cache - -=cut - -sub queue_fuzzyfiles_update { - my $self = shift; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $queue = new FS::queue { - 'svcnum' => $self->svcnum, - 'job' => 'FS::svc_acct::append_fuzzyfiles' - }; - my $error = $queue->insert($self->username); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - -} - - -=item suspend - -Suspends this account by calling export-specific suspend hooks. If there is -an error, returns the error, otherwise returns false. - -Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>). - -=cut - -sub suspend { - my $self = shift; - return "can't suspend system account" if $self->_check_system; - $self->SUPER::suspend; -} - -=item unsuspend - -Unsuspends this account by by calling export-specific suspend hooks. If there -is an error, returns the error, otherwise returns false. - -Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>). - -=cut - -sub unsuspend { - my $self = shift; - my %hash = $self->hash; - if ( $hash{_password} =~ /^\*SUSPENDED\* (.*)$/ ) { - $hash{_password} = $1; - my $new = new FS::svc_acct ( \%hash ); - my $error = $new->replace($self); - return $error if $error; - } - - $self->SUPER::unsuspend; -} - -=item cancel - -Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>). - -If the B<auto_unset_catchall> configuration option is set, this method will -automatically remove any references to the canceled service in the catchall -field of svc_domain. This allows packages that contain both a svc_domain and -its catchall svc_acct to be canceled in one step. - -=cut - -sub cancel { - # Only one thing to do at this level - my $self = shift; - foreach my $svc_domain ( - qsearch( 'svc_domain', { catchall => $self->svcnum } ) ) { - if($conf->exists('auto_unset_catchall')) { - my %hash = $svc_domain->hash; - $hash{catchall} = ''; - my $new = new FS::svc_domain ( \%hash ); - my $error = $new->replace($svc_domain); - return $error if $error; - } else { - return "cannot unprovision svc_acct #".$self->svcnum. - " while assigned as catchall for svc_domain #".$svc_domain->svcnum; - } - } - - $self->SUPER::cancel; -} - - -=item check - -Checks all fields to make sure this is a valid service. If there is an error, -returns the error, otherwise returns false. Called by the insert and replace -methods. - -Sets any fixed values; see L<FS::part_svc>. - -=cut - -sub check { - my $self = shift; - - my($recref) = $self->hashref; - - my $x = $self->setfixed( $self->_fieldhandlers ); - 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_foreign_key('domsvc', 'svc_domain', 'svcnum' ) - || $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'); - } - if ( $password_noampersand ) { - $recref->{_password} =~ /\&/ and return gettext('illegal_password'); - } - if ( $password_noexclamation ) { - $recref->{_password} =~ /\!/ and return gettext('illegal_password'); - } - unless ( $username_percent ) { - $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} !~ /^(root|toor|smtp)$/; - - 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'; - } - - } else { - $recref->{gid} ne '' ? - return "Can't have gid without uid" : ( $recref->{gid}='' ); - #$recref->{dir} ne '' ? - # return "Can't have directory without uid" : ( $recref->{dir}='' ); - $recref->{shell} ne '' ? - return "Can't have shell without uid" : ( $recref->{shell}='' ); - } - - unless ( $part_svc->part_svc_column('dir')->columnflag eq 'F' ) { - - $recref->{dir} =~ /^([\/\w\-\.\&]*)$/ - or return "Illegal directory: ". $recref->{dir}; - $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}; - ; - } - - } - - # $error = $self->ut_textn('finger'); - # return $error if $error; - if ( $self->getfield('finger') eq '' ) { - my $cust_pkg = $self->svcnum - ? $self->cust_svc->cust_pkg - : qsearchs('cust_pkg', { 'pkgnum' => $self->getfield('pkgnum') } ); - if ( $cust_pkg ) { - my $cust_main = $cust_pkg->cust_main; - $self->setfield('finger', $cust_main->first.' '.$cust_main->get('last') ); - } - } - $self->getfield('finger') =~ - /^([\w \t\!\@\#\$\%\&\(\)\-\+\;\'\"\,\.\?\/\*\<\>]*)$/ - or return "Illegal finger: ". $self->getfield('finger'); - $self->setfield('finger', $1); - - $recref->{quota} =~ /^(\w*)$/ or return "Illegal quota"; - $recref->{quota} = $1; - - unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) { - if ( $recref->{slipip} eq '' ) { - $recref->{slipip} = ''; - } elsif ( $recref->{slipip} eq '0e0' ) { - $recref->{slipip} = '0e0'; - } else { - $recref->{slipip} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/ - or return "Illegal slipip: ". $self->slipip; - $recref->{slipip} = $1; - } - - } - - #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,60})$/ ) { - $recref->{_password} = $1.$3; - } elsif ( $recref->{_password} eq '*' ) { - $recref->{_password} = '*'; - } 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}; - } - - $self->SUPER::check; -} - -=item _check_system - -Internal function to check the username against the list of system usernames -from the I<system_usernames> configuration value. Returns true if the username -is listed on the system username list. - -=cut - -sub _check_system { - my $self = shift; - scalar( grep { $self->username eq $_ || $self->email eq $_ } - $conf->config('system_usernames') - ); -} - -=item _check_duplicate - -Internal function to check for duplicates usernames, username@domain pairs and -uids. - -If the I<global_unique-username> configuration value is set to B<username> or -B<username@domain>, enforces global username or username@domain uniqueness. - -In all cases, check for duplicate uids and usernames or username@domain pairs -per export and with identical I<svcpart> values. - -=cut - -sub _check_duplicate { - my $self = shift; - - my $global_unique = $conf->config('global_unique-username') || 'none'; - return '' if $global_unique eq 'disabled'; - - #this is Pg-specific. what to do for mysql etc? - # ( mysql LOCK TABLES certainly isn't equivalent or useful here :/ ) - warn "$me locking svc_acct table for duplicate search" if $DEBUG; - dbh->do("LOCK TABLE svc_acct IN SHARE ROW EXCLUSIVE MODE") - or die dbh->errstr; - warn "$me acquired svc_acct table lock for duplicate search" if $DEBUG; - - my $part_svc = qsearchs('part_svc', { 'svcpart' => $self->svcpart } ); - unless ( $part_svc ) { - return 'unknown svcpart '. $self->svcpart; - } - - my @dup_user = grep { !$self->svcnum || $_->svcnum != $self->svcnum } - qsearch( 'svc_acct', { 'username' => $self->username } ); - return gettext('username_in_use') - if $global_unique eq 'username' && @dup_user; - - my @dup_userdomain = grep { !$self->svcnum || $_->svcnum != $self->svcnum } - qsearch( 'svc_acct', { 'username' => $self->username, - 'domsvc' => $self->domsvc } ); - return gettext('username_in_use') - if $global_unique eq 'username@domain' && @dup_userdomain; - - my @dup_uid; - if ( $part_svc->part_svc_column('uid')->columnflag ne 'F' - && $self->username !~ /^(toor|(hyla)?fax)$/ ) { - @dup_uid = grep { !$self->svcnum || $_->svcnum != $self->svcnum } - 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; - my %conflict_userdomain_svcpart = ( $self->svcpart => 'SELF', ); - - foreach my $part_export ( $part_svc->part_export ) { - - #this will catch to the same exact export - my @svcparts = map { $_->svcpart } $part_export->export_svc; - - #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'}; - #silly kludge to avoid uninitialized value errors - my $nodomain = exists( $exports->{$part_export->exporttype}{'nodomain'} ) - ? $exports->{$part_export->exporttype}{'nodomain'} - : ''; - if ( $nodomain =~ /^Y/i ) { - $conflict_user_svcpart{$_} = $part_export->exportnum - foreach @svcparts; - } else { - $conflict_userdomain_svcpart{$_} = $part_export->exportnum - foreach @svcparts; - } - } - - foreach my $dup_user ( @dup_user ) { - my $dup_svcpart = $dup_user->cust_svc->svcpart; - if ( exists($conflict_user_svcpart{$dup_svcpart}) ) { - return "duplicate username: conflicts with svcnum ". $dup_user->svcnum. - " via exportnum ". $conflict_user_svcpart{$dup_svcpart}; - } - } - - foreach my $dup_userdomain ( @dup_userdomain ) { - my $dup_svcpart = $dup_userdomain->cust_svc->svcpart; - if ( exists($conflict_userdomain_svcpart{$dup_svcpart}) ) { - 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}) ) { - return "duplicate uid: conflicts with svcnum ". $dup_uid->svcnum. - " via exportnum ". $conflict_user_svcpart{$dup_svcpart} - || $conflict_userdomain_svcpart{$dup_svcpart}; - } - } - - } - - return ''; - -} - -=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; - - return %{ $self->{'radius_reply'} } - if exists $self->{'radius_reply'}; - - 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{$radius_ip} = $self->slipip; - } - - if ( $self->seconds !~ /^$/ ) { - $reply{'Session-Timeout'} = $self->seconds; - } - - %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; - - return %{ $self->{'radius_check'} } - if exists $self->{'radius_check'}; - - my %check = - 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 ); - - my $password = $self->_password; - my $pw_attrib = length($password) <= 12 ? $radius_password : 'Crypt-Password'; $check{$pw_attrib} = $password; - - my $cust_svc = $self->cust_svc; - die "FATAL: no cust_svc record for svc_acct.svcnum ". $self->svcnum. "\n" - unless $cust_svc; - my $cust_pkg = $cust_svc->cust_pkg; - if ( $cust_pkg && $cust_pkg->part_pkg->is_prepaid && $cust_pkg->bill ) { - $check{'Expiration'} = time2str('%B %e %Y %T', $cust_pkg->bill ); #http://lists.cistron.nl/pipermail/freeradius-users/2005-January/040184.html - } - - %check; - -} - -=item snapshot - -This method instructs the object to "snapshot" or freeze RADIUS check and -reply attributes to the current values. - -=cut - -#bah, my english is too broken this morning -#Of note is the "Expiration" attribute, which, for accounts in prepaid packages, is typically defined on-the-fly as the associated packages cust_pkg.bill. (This is used by -#the FS::cust_pkg's replace method to trigger the correct export updates when -#package dates change) - -sub snapshot { - my $self = shift; - - $self->{$_} = { $self->$_() } - foreach qw( radius_reply radius_check ); - -} - -=item forget_snapshot - -This methos instructs the object to forget any previously snapshotted -RADIUS check and reply attributes. - -=cut - -sub forget_snapshot { - my $self = shift; - - delete $self->{$_} - foreach qw( radius_reply radius_check ); - -} - -=item domain - -Returns the domain associated with this account. - -=cut - -sub domain { - my $self = shift; - die "svc_acct.domsvc is null for svcnum ". $self->svcnum unless $self->domsvc; - my $svc_domain = $self->svc_domain(@_) - or die "no svc_domain.svcnum for svc_acct.domsvc ". $self->domsvc; - $svc_domain->domain; -} - -=item svc_domain - -Returns the FS::svc_domain record for this account's domain (see -L<FS::svc_domain>). - -=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<FS::cust_svc>). - -=cut - -#inherited from svc_Common - -=item email - -Returns an email address associated with the account. - -=cut - -sub email { - my $self = shift; - $self->username. '@'. $self->domain(@_); -} - -=item acct_snarf - -Returns an array of FS::acct_snarf records associated with the account. -If the acct_snarf table does not exist or there are no associated records, -an empty list is returned - -=cut - -sub acct_snarf { - my $self = shift; - return () unless dbdef->table('acct_snarf'); - eval "use FS::acct_snarf;"; - die $@ if $@; - qsearch('acct_snarf', { 'svcnum' => $self->svcnum } ); -} - -=item decrement_seconds SECONDS - -Decrements the I<seconds> field of this record by the given amount. If there -is an error, returns the error, otherwise returns false. - -=cut - -sub decrement_seconds { - shift->_op_seconds('-', @_); -} - -=item increment_seconds SECONDS - -Increments the I<seconds> field of this record by the given amount. If there -is an error, returns the error, otherwise returns false. - -=cut - -sub increment_seconds { - shift->_op_seconds('+', @_); -} - - -my %op2action = ( - '-' => 'suspend', - '+' => 'unsuspend', -); -my %op2condition = ( - '-' => sub { my($self, $seconds) = @_; - $self->seconds - $seconds <= 0; - }, - '+' => sub { my($self, $seconds) = @_; - $self->seconds + $seconds > 0; - }, -); - -sub _op_seconds { - my( $self, $op, $seconds ) = @_; - warn "$me _op_seconds called for svcnum ". $self->svcnum. - ' ('. $self->email. "): $op $seconds\n" - if $DEBUG; - - 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 $sql = "UPDATE svc_acct SET seconds = ". - " CASE WHEN seconds IS NULL THEN 0 ELSE seconds END ". #$seconds||0 - " $op ? WHERE svcnum = ?"; - warn "$me $sql\n" - if $DEBUG; - - my $sth = $dbh->prepare( $sql ) - or die "Error preparing $sql: ". $dbh->errstr; - my $rv = $sth->execute($seconds, $self->svcnum); - die "Error executing $sql: ". $sth->errstr - unless defined($rv); - die "Can't update seconds for svcnum". $self->svcnum - if $rv == 0; - - my $action = $op2action{$op}; - - if ( $conf->exists("svc_acct-usage_$action") - && &{$op2condition{$op}}($self, $seconds) ) { - #my $error = $self->$action(); - my $error = $self->cust_svc->cust_pkg->$action(); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Error ${action}ing: $error"; - } - } - - warn "$me update successful; committing\n" - if $DEBUG; - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - -} - - -=item seconds_since TIMESTAMP - -Returns the number of seconds this account has been online since TIMESTAMP, -according to the session monitor (see L<FS::Session>). - -TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see -L<Time::Local> and L<Date::Parse> for conversion functions. - -=cut - -#note: POD here, implementation in FS::cust_svc -sub seconds_since { - my $self = shift; - $self->cust_svc->seconds_since(@_); -} - -=item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END - -Returns the numbers of seconds this account has been online between -TIMESTAMP_START (inclusive) and TIMESTAMP_END (exclusive), according to an -external SQL radacct table, specified via sqlradius export. Sessions which -started in the specified range but are still open are counted from session -start to the end of the range (unless they are over 1 day old, in which case -they are presumed missing their stop record and not counted). Also, sessions -which end in the range but started earlier are counted from the start of the -range to session end. Finally, sessions which start before the range but end -after are counted for the entire range. - -TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see -L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion -functions. - -=cut - -#note: POD here, implementation in FS::cust_svc -sub seconds_since_sqlradacct { - my $self = shift; - $self->cust_svc->seconds_since_sqlradacct(@_); -} - -=item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE - -Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>) -in this package for sessions ending between TIMESTAMP_START (inclusive) and -TIMESTAMP_END (exclusive). - -TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see -L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion -functions. - -=cut - -#note: POD here, implementation in FS::cust_svc -sub attribute_since_sqlradacct { - my $self = shift; - $self->cust_svc->attribute_since_sqlradacct(@_); -} - -=item get_session_history TIMESTAMP_START TIMESTAMP_END - -Returns an array of hash references of this customers login history for the -given time range. (document this better) - -=cut - -sub get_session_history { - my $self = shift; - $self->cust_svc->get_session_history(@_); -} - -=item get_cdrs TIMESTAMP_START TIMESTAMP_END [ 'OPTION' => 'VALUE ... ] - -=cut - -sub get_cdrs { - my($self, $start, $end, %opt ) = @_; - - my $did = $self->username; #yup - - my $prefix = $opt{'default_prefix'}; #convergent.au '+61' - - my $for_update = $opt{'for_update'} ? 'FOR UPDATE' : ''; - - #SELECT $for_update * FROM cdr - # WHERE calldate >= $start #need a conversion - # AND calldate < $end #ditto - # AND ( charged_party = "$did" - # OR charged_party = "$prefix$did" #if length($prefix); - # OR ( ( charged_party IS NULL OR charged_party = '' ) - # AND - # ( src = "$did" OR src = "$prefix$did" ) # if length($prefix) - # ) - # ) - # AND ( freesidestatus IS NULL OR freesidestatus = '' ) - - my $charged_or_src; - if ( length($prefix) ) { - $charged_or_src = - " AND ( charged_party = '$did' - OR charged_party = '$prefix$did' - OR ( ( charged_party IS NULL OR charged_party = '' ) - AND - ( src = '$did' OR src = '$prefix$did' ) - ) - ) - "; - } else { - $charged_or_src = - " AND ( charged_party = '$did' - OR ( ( charged_party IS NULL OR charged_party = '' ) - AND - src = '$did' - ) - ) - "; - - } - - qsearch( - 'select' => "$for_update *", - 'table' => 'cdr', - 'hashref' => { - #( freesidestatus IS NULL OR freesidestatus = '' ) - 'freesidestatus' => '', - }, - 'extra_sql' => $charged_or_src, - - ); - -} - -=item radius_groups - -Returns all RADIUS groups for this account (see L<FS::radius_usergroup>). - -=cut - -sub radius_groups { - my $self = shift; - if ( $self->usergroup ) { - confess "explicitly specified usergroup not an arrayref: ". $self->usergroup - unless ref($self->usergroup) eq 'ARRAY'; - #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 } ); - } -} - -=item clone_suspended - -Constructor used by FS::part_export::_export_suspend fallback. Document -better. - -=cut - -sub clone_suspended { - my $self = shift; - my %hash = $self->hash; - $hash{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) ); - new FS::svc_acct \%hash; -} - -=item clone_kludge_unsuspend - -Constructor used by FS::part_export::_export_unsuspend fallback. Document -better. - -=cut - -sub clone_kludge_unsuspend { - my $self = shift; - my %hash = $self->hash; - $hash{_password} = ''; - new FS::svc_acct \%hash; -} - -=item check_password - -Checks the supplied password against the (possibly encrypted) password in the -database. Returns true for a successful authentication, false for no match. - -Currently supported encryptions are: classic DES crypt() and MD5 - -=cut - -sub check_password { - my($self, $check_password) = @_; - - #remove old-style SUSPENDED kludge, they should be allowed to login to - #self-service and pay up - ( my $password = $self->_password ) =~ s/^\*SUSPENDED\* //; - - #eventually should check a "password-encoding" field - if ( $password =~ /^(\*|!!?)$/ ) { #no self-service login - return 0; - } elsif ( length($password) < 13 ) { #plaintext - $check_password eq $password; - } elsif ( length($password) == 13 ) { #traditional DES crypt - crypt($check_password, $password) eq $password; - } elsif ( $password =~ /^\$1\$/ ) { #MD5 crypt - unix_md5_crypt($check_password, $password) eq $password; - } elsif ( $password =~ /^\$2a?\$/ ) { #Blowfish - warn "Can't check password: Blowfish encryption not yet supported, svcnum". - $self->svcnum. "\n"; - 0; - } else { - warn "Can't check password: Unrecognized encryption for svcnum ". - $self->svcnum. "\n"; - 0; - } - -} - -=item crypt_password [ DEFAULT_ENCRYPTION_TYPE ] - -Returns an encrypted password, either by passing through an encrypted password -in the database or by encrypting a plaintext password from the database. - -The optional DEFAULT_ENCRYPTION_TYPE parameter can be set to I<crypt> (classic -UNIX DES crypt), I<md5> (md5 crypt supported by most modern Linux and BSD -distrubtions), or (eventually) I<blowfish> (blowfish hashing supported by -OpenBSD, SuSE, other Linux distibutions with pam_unix2, etc.). The default -encryption type is only used if the password is not already encrypted in the -database. - -=cut - -sub crypt_password { - my $self = shift; - #eventually should check a "password-encoding" field - if ( length($self->_password) == 13 - || $self->_password =~ /^\$(1|2a?)\$/ - || $self->_password =~ /^(\*|NP|\*LK\*|!!?)$/ - ) - { - $self->_password; - } else { - my $encryption = ( scalar(@_) && $_[0] ) ? shift : 'crypt'; - if ( $encryption eq 'crypt' ) { - crypt( - $self->_password, - $saltset[int(rand(64))].$saltset[int(rand(64))] - ); - } elsif ( $encryption eq 'md5' ) { - unix_md5_crypt( $self->_password ); - } elsif ( $encryption eq 'blowfish' ) { - die "unknown encryption method $encryption"; - } else { - die "unknown encryption method $encryption"; - } - } -} - -=item virtual_maildir - -Returns $domain/maildirs/$username/ - -=cut - -sub virtual_maildir { - my $self = shift; - $self->domain. '/maildirs/'. $self->username. '/'; -} - -=back - -=head1 SUBROUTINES - -=over 4 - -=item send_email - -This is the FS::svc_acct job-queue-able version. It still uses -FS::Misc::send_email under-the-hood. - -=cut - -sub send_email { - my %opt = @_; - - eval "use FS::Misc qw(send_email)"; - die $@ if $@; - - $opt{mimetype} ||= 'text/plain'; - $opt{mimetype} .= '; charset="iso-8859-1"' unless $opt{mimetype} =~ /charset/; - - my $error = send_email( - 'from' => $opt{from}, - 'to' => $opt{to}, - 'subject' => $opt{subject}, - 'content-type' => $opt{mimetype}, - 'body' => [ map "$_\n", split("\n", $opt{body}) ], - ); - die $error if $error; -} - -=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; $_; } <USERNAMECACHE>; - 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 = <<END; - <SCRIPT> - 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 = ""; - } - </SCRIPT> - <SELECT MULTIPLE NAME="$selectname"> -END - - foreach my $group ( @all_groups ) { - $html .= qq(<OPTION VALUE="$group"); - if ( $sel_groups{$group} ) { - $html .= ' SELECTED'; - $sel_groups{$group} = 0; - } - $html .= ">$group</OPTION>\n"; - } - foreach my $group ( grep { $sel_groups{$_} } keys %sel_groups ) { - $html .= qq(<OPTION VALUE="$group" SELECTED>$group</OPTION>\n); - }; - $html .= '</SELECT>'; - - $html .= qq!<BR><INPUT TYPE="text" NAME="${selectname}_add">!. - qq!<INPUT TYPE="button" VALUE="Add new group" onClick="${selectname}_doadd(this.form)">!; - - $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... - -insertion of RADIUS group stuff in insert could be done with child_objects now -(would probably clean up export of them too) - -=head1 SEE ALSO - -L<FS::svc_Common>, edit/part_svc.cgi from an installed web interface, -export.html from the base documentation, L<FS::Record>, L<FS::Conf>, -L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, L<FS::queue>, -L<freeside-queued>), L<FS::svc_acct_pop>, -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 de41f5b..0000000 --- a/FS/FS/svc_acct_pop.pm +++ /dev/null @@ -1,206 +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') - or $self->SUPER::check - ; - -} - -=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 = <<END; - <SCRIPT> - 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; - what.form.popnum.options.length = 0 - 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</SCRIPT>\n"; - - $text .= - qq!<SELECT NAME="popstate" SIZE=1 onChange="popstate_changed(this)">!. - qq!<OPTION> !; - $text .= "<OPTION>$_" foreach sort { $a cmp $b } keys %svc_acct_pop; - $text .= '</SELECT>'; #callback? return 3 html pieces? #'</TD><TD>'; - - $text .= qq!<SELECT NAME="popnum" SIZE=1><OPTION> !; - my @initial_select; - if ( scalar(@svc_acct_pop) > 100 ) { - @initial_select = qsearchs( 'svc_acct_pop', { 'popnum' => $popnum } ); - } else { - @initial_select = @svc_acct_pop; - } - foreach my $pop ( @initial_select ) { - $text .= qq!<OPTION VALUE="!. $pop->popnum. '"'. - ( ( $popnum && $pop->popnum == $popnum ) ? ' SELECTED' : '' ). ">". - $pop->text; - } - $text .= '</SELECT>'; - - $text; - -} - -=back - -=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<FS::Record>, L<FS::svc_acct>, L<FS::part_pop_local>, schema.html from the -base documentation. - -=cut - -1; - diff --git a/FS/FS/svc_broadband.pm b/FS/FS/svc_broadband.pm deleted file mode 100755 index aaac891..0000000 --- a/FS/FS/svc_broadband.pm +++ /dev/null @@ -1,243 +0,0 @@ -package FS::svc_broadband; - -use strict; -use vars qw(@ISA $conf); -use FS::Record qw( qsearchs qsearch dbh ); -use FS::svc_Common; -use FS::cust_svc; -use FS::addr_block; -use NetAddr::IP; - -@ISA = qw( FS::svc_Common ); - -$FS::UID::callback{'FS::svc_broadband'} = sub { - $conf = new FS::Conf; -}; - -=head1 NAME - -FS::svc_broadband - Object methods for svc_broadband records - -=head1 SYNOPSIS - - use FS::svc_broadband; - - $record = new FS::svc_broadband \%hash; - $record = new FS::svc_broadband { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - - $error = $record->suspend; - - $error = $record->unsuspend; - - $error = $record->cancel; - -=head1 DESCRIPTION - -An FS::svc_broadband object represents a 'broadband' Internet connection, such -as a DSL, cable modem, or fixed wireless link. These services are assumed to -have the following properties: - -FS::svc_broadband inherits from FS::svc_Common. The following fields are -currently supported: - -=over 4 - -=item svcnum - primary key - -=item blocknum - see FS::addr_block - -=item -speed_up - maximum upload speed, in bits per second. If set to zero, upload -speed will be unlimited. Exports that do traffic shaping should handle this -correctly, and not blindly set the upload speed to zero and kill the customer's -connection. - -=item -speed_down - maximum download speed, as above - -=item ip_addr - the customer's IP address. If the customer needs more than one -IP address, set this to the address of the customer's router. As a result, the -customer's router will have the same address for both its internal and external -interfaces thus saving address space. This has been found to work on most NAT -routers available. - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new svc_broadband. To add the record to the database, see -"insert". - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -sub table { 'svc_broadband'; } - -=item insert [ , OPTION => VALUE ... ] - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -The additional fields pkgnum and svcpart (see FS::cust_svc) should be -defined. An FS::cust_svc record will be created and inserted. - -Currently available options are: I<depend_jobnum> - -If I<depend_jobnum> is set (to a scalar jobnum or an array reference of -jobnums), all provisioning jobs will have a dependancy on the supplied -jobnum(s) (they will not run until the specific job(s) complete(s)). - -=cut - -# Standard FS::svc_Common::insert - -=item delete - -Delete this record from the database. - -=cut - -# Standard FS::svc_Common::delete - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -# Standard FS::svc_Common::replace - -=item suspend - -Called by the suspend method of FS::cust_pkg (see FS::cust_pkg). - -=item unsuspend - -Called by the unsuspend method of FS::cust_pkg (see FS::cust_pkg). - -=item cancel - -Called by the cancel method of FS::cust_pkg (see FS::cust_pkg). - -=item check - -Checks all fields to make sure this is a valid broadband service. If there is -an error, returns the error, otherwise returns false. Called by the insert -and replace methods. - -=cut - -sub check { - my $self = shift; - my $x = $self->setfixed; - - return $x unless ref($x); - - my $error = - $self->ut_numbern('svcnum') - || $self->ut_foreign_key('blocknum', 'addr_block', 'blocknum') - || $self->ut_number('speed_up') - || $self->ut_number('speed_down') - || $self->ut_ipn('ip_addr') - ; - return $error if $error; - - if($self->speed_up < 0) { return 'speed_up must be positive'; } - if($self->speed_down < 0) { return 'speed_down must be positive'; } - - if (not($self->ip_addr) or $self->ip_addr eq '0.0.0.0') { - my $next_addr = $self->addr_block->next_free_addr; - if ($next_addr) { - $self->ip_addr($next_addr->addr); - } else { - return "No free addresses in addr_block (blocknum: ".$self->blocknum.")"; - } - } - - # This should catch errors in the ip_addr. If it doesn't, - # they'll almost certainly not map into the block anyway. - my $self_addr = $self->NetAddr; #netmask is /32 - return ('Cannot parse address: ' . $self->ip_addr) unless $self_addr; - - my $block_addr = $self->addr_block->NetAddr; - unless ($block_addr->contains($self_addr)) { - return 'blocknum '.$self->blocknum.' does not contain address '.$self->ip_addr; - } - - my $router = $self->addr_block->router - or return 'Cannot assign address from unallocated block:'.$self->addr_block->blocknum; - if(grep { $_->routernum == $router->routernum} $self->allowed_routers) { - } # do nothing - else { - return 'Router '.$router->routernum.' cannot provide svcpart '.$self->svcpart; - } - - $self->SUPER::check; -} - -=item NetAddr - -Returns a NetAddr::IP object containing the IP address of this service. The netmask -is /32. - -=cut - -sub NetAddr { - my $self = shift; - return new NetAddr::IP ($self->ip_addr); -} - -=item addr_block - -Returns the FS::addr_block record (i.e. the address block) for this broadband service. - -=cut - -sub addr_block { - my $self = shift; - - return qsearchs('addr_block', { blocknum => $self->blocknum }); -} - -=back - -=item allowed_routers - -Returns a list of allowed FS::router objects. - -=cut - -sub allowed_routers { - my $self = shift; - - return map { $_->router } qsearch('part_svc_router', { svcpart => $self->svcpart }); -} - -=head1 BUGS - -The business with sb_field has been 'fixed', in a manner of speaking. - -=head1 SEE ALSO - -FS::svc_Common, FS::Record, FS::addr_block, -FS::part_svc, 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 bdaf79b..0000000 --- a/FS/FS/svc_domain.pm +++ /dev/null @@ -1,451 +0,0 @@ -package FS::svc_domain; - -use strict; -use vars qw( @ISA $whois_hack $conf - @defaultrecords $soadefaultttl $soaemail $soaexpire $soamachine - $soarefresh $soaretry -); -use Carp; -use Date::Format; -#use Net::Whois::Raw; -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; - - @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'); - -}; - -=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 [ , OPTION => VALUE ... ] - -Adds this domain to the database. If there is an error, returns the error, -otherwise returns false. - -The additional fields I<pkgnum> and I<svcpart> (see L<FS::cust_svc>) should be -defined. An FS::cust_svc record will be created and inserted. - -The additional field I<action> should be set to I<N> for new domains or I<M> -for transfers. - -A registration or transfer email will be submitted unless -$FS::svc_domain::whois_hack is true. - -The additional field I<email> can be used to manually set the admin contact -email address on this email. Otherwise, the svc_acct records for this package -(see L<FS::cust_pkg>) are searched. If there is exactly one svc_acct record -in the same package, it is automatically used. Otherwise an error is returned. - -If any I<soamachine> configuration file exists, an SOA record is added to -the domain_record table (see <FS::domain_record>). - -If any records are defined in the I<defaultrecords> configuration file, -appropriate records are added to the domain_record table (see -L<FS::domain_record>). - -Currently available options are: I<depend_jobnum> - -If I<depend_jobnum> is set (to a scalar jobnum or an array reference of -jobnums), all provisioning jobs will have a dependancy on the supplied -jobnum(s) (they will not run until the specific job(s) complete(s)). - -=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; - - ''; #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 (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; - - foreach my $domain_record ( reverse $self->domain_record ) { - my $error = $domain_record->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "can't delete DNS entry: ". - join(' ', map $domain_record->$_(), - qw( reczone recaf rectype recdata ) - ). - ":$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. - -=cut - -sub replace { - my ( $new, $old ) = ( shift, shift ); - - return "Can't change domain - reorder." - if $old->getfield('domain') ne $new->getfield('domain'); - - # Better to do it here than to force the caller to remember that svc_domain is weird. - $new->setfield(action => 'M'); - 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<FS::cust_pkg>). - -=item unsuspend - -Just returns false (no error) for now. - -Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>). - -=item cancel - -Just returns false (no error) for now. - -Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>). - -=item check - -Checks all fields to make sure this is a valid domain. If there is an error, -returns the error, otherwise returns false. Called by the insert and replace -methods. - -Sets any fixed values; see L<FS::part_svc>. - -=cut - -sub check { - my $self = shift; - - my $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,63})\.(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}; - $recref->{action} = $1; - - if ( $recref->{catchall} ne '' ) { - my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $recref->{catchall} } ); - return "Unknown catchall" unless $svc_acct; - } - - $self->ut_textn('purpose') - or $self->SUPER::check; - -} - -=item domain_record - -=cut - -sub domain_record { - my $self = shift; - - my %order = ( - 'SOA' => 1, - 'NS' => 2, - 'MX' => 3, - 'CNAME' => 4, - 'A' => 5, - 'TXT' => 6, - 'PTR' => 7, - ); - - sort { $order{$a->rectype} <=> $order{$b->rectype} } - qsearch('domain_record', { svcnum => $self->svcnum } ); - -} - -sub catchall_svc_acct { - my $self = shift; - if ( $self->catchall ) { - qsearchs( 'svc_acct', { 'svcnum' => $self->catchall } ); - } else { - ''; - } -} - -=item whois - -# Returns the Net::Whois::Domain object (see L<Net::Whois>) for this domain, or -# undef if the domain is not found in whois. - -(If $FS::svc_domain::whois_hack is true, returns that in all cases instead.) - -=cut - -sub whois { - #$whois_hack or new Net::Whois::Domain $_[0]->domain; - $whois_hack or die "whois_hack not set...\n"; -} - -=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 BUGS - -Delete doesn't send a registration template. - -All registries should be supported. - -Should change action to a real field. - -The $recref stuff in sub check should be cleaned up. - -=head1 SEE ALSO - -L<FS::svc_Common>, L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>, -L<FS::part_svc>, L<FS::cust_pkg>, L<Net::Whois>, schema.html from the base -documentation, config.html from the base documentation. - -=cut - -1; - - diff --git a/FS/FS/svc_external.pm b/FS/FS/svc_external.pm deleted file mode 100644 index 79eec97..0000000 --- a/FS/FS/svc_external.pm +++ /dev/null @@ -1,180 +0,0 @@ -package FS::svc_external; - -use strict; -use vars qw(@ISA); # $conf -use FS::UID; -#use FS::Record qw( qsearch qsearchs dbh); -use FS::svc_Common; - -@ISA = qw( FS::svc_Common ); - -#FS::UID::install_callback( sub { -# $conf = new FS::Conf; -#}; - -=head1 NAME - -FS::svc_external - Object methods for svc_external records - -=head1 SYNOPSIS - - use FS::svc_external; - - $record = new FS::svc_external \%hash; - $record = new FS::svc_external { '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_external object represents a externally tracked service. -FS::svc_external inherits from FS::svc_Common. The following fields are -currently supported: - -=over 4 - -=item svcnum - primary key - -=item id - unique number of external record - -=item title - for invoice line items - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new external service. To add the external service to the database, -see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -sub table { 'svc_external'; } - -=item insert [ , OPTION => VALUE ... ] - -Adds this external service to the database. If there is an error, returns the -error, otherwise returns false. - -The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be -defined. An FS::cust_svc record will be created and inserted. - -Currently available options are: I<depend_jobnum> - -If I<depend_jobnum> is set (to a scalar jobnum or an array reference of -jobnums), all provisioning jobs will have a dependancy on the supplied -jobnum(s) (they will not run until the specific job(s) complete(s)). - -=cut - -#sub insert { -# my $self = shift; -# my $error; -# -# $error = $self->SUPER::insert(@_); -# return $error if $error; -# -# ''; -#} - -=item delete - -Delete this record from the database. - -=cut - -#sub delete { -# my $self = shift; -# my $error; -# -# $error = $self->SUPER::delete; -# return $error if $error; -# -# ''; -#} - - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -#sub replace { -# my ( $new, $old ) = ( shift, shift ); -# my $error; -# -# $error = $new->SUPER::replace($old); -# return $error if $error; -# -# ''; -#} - -=item suspend - -Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>). - -=item unsuspend - -Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>). - -=item cancel - -Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>). - -=item check - -Checks all fields to make sure this is a valid external service. 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_numbern('id') - || $self->ut_textn('title') - ; - - $self->SUPER::check; -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::svc_Common>, L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, -L<FS::cust_pkg>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/svc_forward.pm b/FS/FS/svc_forward.pm deleted file mode 100644 index ab24d32..0000000 --- a/FS/FS/svc_forward.pm +++ /dev/null @@ -1,312 +0,0 @@ -package FS::svc_forward; - -use strict; -use vars qw( @ISA ); -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 ); - -=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<FS::svc_acct>) - -=item src - literal source (username or full email address) - -=item dstsvc - svcnum of the destination of the forward (see L<FS::svc_acct>) - -=item dst - literal destination (username or full email address) - -=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 [ , OPTION => VALUE ... ] - -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<FS::cust_svc>) should be -defined. An FS::cust_svc record will be created and inserted. - -Currently available options are: I<depend_jobnum> - -If I<depend_jobnum> is set (to a scalar jobnum or an array reference of -jobnums), all provisioning jobs will have a dependancy on the supplied -jobnum(s) (they will not run until the specific job(s) complete(s)). - -=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; - } - - $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. - -=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; - } - - $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 ); - - 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; - } - - $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<FS::cust_pkg>). - -=item unsuspend - -Just returns false (no error) for now. - -Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>). - -=item cancel - -Just returns false (no error) for now. - -Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>). - -=item check - -Checks all fields to make sure this is a valid 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<FS::part_svc>. - -=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('srcsvc') - || $self->ut_numbern('dstsvc') - ; - return $error if $error; - - return "Both srcsvc and src were defined; only one can be specified" - if $self->srcsvc && $self->src; - - return "one of srcsvc or src is required" - unless $self->srcsvc || $self->src; - - return "Unknown srcsvc: ". $self->srcsvc - unless ! $self->srcsvc || $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: ". $self->dstsvc - unless ! $self->dstsvc || $self->dstsvc_acct; - #return "Unknown dstsvc" - # unless qsearchs('svc_acct', { 'svcnum' => $self->dstsvc } ) - # || ! $self->dstsvc; - - if ( $self->src ) { - $self->src =~ /^([\w\.\-\&]*)(\@([\w\-]+\.)+\w+)$/ - or return "Illegal src: ". $self->src; - $self->src("$1$2"); - } else { - $self->src(''); - } - - if ( $self->dst ) { - my $conf = new FS::Conf; - if ( $conf->exists('svc_forward-arbitrary_dst') ) { - my $error = $self->ut_textn('dst'); - return $error if $error; - } else { - $self->dst =~ /^([\w\.\-\&]*)(\@([\w\-]+\.)+\w+)$/ - or return "Illegal dst: ". $self->dst; - $self->dst("$1$2"); - } - } else { - $self->dst(''); - } - - $self->SUPER::check; -} - -=item srcsvc_acct - -Returns the FS::svc_acct object referenced by the srcsvc column, or false for -literally specified forwards. - -=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 -literally specified forwards. - -=cut - -sub dstsvc_acct { - my $self = shift; - qsearchs('svc_acct', { 'svcnum' => $self->dstsvc } ); -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, -L<FS::svc_acct>, L<FS::svc_domain>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/svc_phone.pm b/FS/FS/svc_phone.pm deleted file mode 100644 index fca3369..0000000 --- a/FS/FS/svc_phone.pm +++ /dev/null @@ -1,146 +0,0 @@ -package FS::svc_phone; - -use strict; -use vars qw( @ISA ); -#use FS::Record qw( qsearch qsearchs ); -use FS::svc_Common; - -@ISA = qw( FS::svc_Common ); - -=head1 NAME - -FS::svc_phone - Object methods for svc_phone records - -=head1 SYNOPSIS - - use FS::svc_phone; - - $record = new FS::svc_phone \%hash; - $record = new FS::svc_phone { '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_phone object represents a phone number. FS::svc_phone inherits -from FS::Record. The following fields are currently supported: - -=over 4 - -=item svcnum - primary key - -=item countrycode - - -=item phonenum - - -=item pin - - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new phone number. To add the number to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'svc_phone'; } - -=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 suspend - -Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>). - -=item unsuspend - -Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>). - -=item cancel - -Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>). - -=item check - -Checks all fields to make sure this is a valid phone number. 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('svcnum') - || $self->ut_numbern('countrycode') - || $self->ut_number('phonenum') - || $self->ut_numbern('pin') - ; - return $error if $error; - - $self->countrycode(1) unless $self->countrycode; - - $self->SUPER::check; -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::svc_Common>, L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, -L<FS::cust_pkg>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/svc_www.pm b/FS/FS/svc_www.pm deleted file mode 100644 index 12d7e92..0000000 --- a/FS/FS/svc_www.pm +++ /dev/null @@ -1,286 +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<FS::domain_record>) - -=item usersvc - account (see L<FS::svc_acct>) corresponding to this web virtual host. - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new web virtual host. To add the record to the database, see -L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -sub table { 'svc_www'; } - -=item insert [ , OPTION => VALUE ... ] - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be -defined. An FS::cust_svc record will be created and inserted. - -Currently available options are: I<depend_jobnum> - -If I<depend_jobnum> is set (to a scalar jobnum or an array reference of -jobnums), all provisioning jobs will have a dependancy on the supplied -jobnum(s) (they will not run until the specific job(s) complete(s)). - - -=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<FS::cust_pkg>). - -=item unsuspend - -Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>). - -=item cancel - -Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>). - -=item check - -Checks all fields to make sure this is a valid 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_numbern('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; - } - - if ( $self->usersvc ) { - return "Unknown usersvc0 (svc_acct.svcnum): ". $self->usersvc - unless qsearchs('svc_acct', { 'svcnum' => $self->usersvc } ); - } - - $self->SUPER::check; - -} - -=item domain_record - -Returns the FS::domain_record record for this web virtual host's zone (see -L<FS::domain_record>). - -=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<FS::svc_acct>). - -=cut - -sub svc_acct { - my $self = shift; - qsearchs('svc_acct', { 'svcnum' => $self->usersvc } ); -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::svc_Common>, L<FS::Record>, L<FS::domain_record>, L<FS::cust_svc>, -L<FS::part_svc>, L<FS::cust_pkg>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/type_pkgs.pm b/FS/FS/type_pkgs.pm deleted file mode 100644 index bf34e7c..0000000 --- a/FS/FS/type_pkgs.pm +++ /dev/null @@ -1,125 +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<FS::agent_type>) to a -billing item definition (see L<FS::part_pkg>). FS::type_pkgs inherits from -FS::Record. The following fields are currently supported: - -=over 4 - -=item typepkgnum - primary key - -=item typenum - Agent type, see L<FS::agent_type> - -=item pkgpart - Billing item definition, see L<FS::part_pkg> - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Create a new record. To add the record to the database, see L<"insert">. - -=cut - -sub table { 'type_pkgs'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=item delete - -Deletes this record from the database. If there is an error, returns the -error, otherwise returns false. - -=item replace OLD_RECORD - -Replaces OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=item check - -Checks all fields to make sure this is a valid record. If there is an error, -returns the error, otherwise returns false. Called by the insert and replace -methods. - -=cut - -sub check { - my $self = shift; - - my $error = - $self->ut_numbern('typepkgnum') - || $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 } ); - - $self->SUPER::check; -} - -=item part_pkg - -Returns the FS::part_pkg object associated with this record. - -=cut - -sub part_pkg { - my $self = shift; - qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } ); -} - -=cut - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::Record>, L<FS::agent_type>, L<FS::part_pkgs>, schema.html from the base -documentation. - -=cut - -1; - diff --git a/FS/MANIFEST b/FS/MANIFEST deleted file mode 100644 index 10f9ffa..0000000 --- a/FS/MANIFEST +++ /dev/null @@ -1,356 +0,0 @@ -Changes -MANIFEST -MANIFEST.SKIP -Makefile.PL -README -bin/freeside-addoutsource -bin/freeside-addoutsourceuser -bin/freeside-addgroup -bin/freeside-adduser -bin/freeside-apply-credits -bin/freeside-bill -bin/freeside-count-active-customers -bin/freeside-daily -bin/freeside-deloutsource -bin/freeside-deloutsourceuser -bin/freeside-deluser -bin/freeside-email -bin/freeside-expiration-alerter -bin/freeside-queued -bin/freeside-radgroup -bin/freeside-reexport -bin/freeside-selfservice-server -bin/freeside-setinvoice -bin/freeside-setup -bin/freeside-sqlradius-radacctd -bin/freeside-sqlradius-reset -bin/freeside-sqlradius-seconds -FS.pm -FS/AccessRight.pm -FS/CGI.pm -FS/InitHandler.pm -FS/ClientAPI.pm -FS/ClientAPI_SessionCache.pm -FS/ClientAPI/passwd.pm -FS/ClientAPI/MyAccount.pm -FS/Conf.pm -FS/ConfItem.pm -FS/Cron/backup.pm -FS/Cron/bill.pm -FS/Cron/vacuum.pm -FS/Daemon.pm -FS/Misc.pm -FS/Record.pm -FS/Report.pm -FS/Report/Table.pm -FS/Report/Table/Monthly.pm -FS/SearchCache.pm -FS/UI/Web.pm -FS/UID.pm -FS/Msgcat.pm -FS/Pony.pm -FS/acct_snarf.pm -FS/agent.pm -FS/agent_type.pm -FS/cust_bill.pm -FS/cust_bill_pkg.pm -FS/cust_bill_pkg_detail.pm -FS/cust_credit.pm -FS/cust_credit_bill.pm -FS/cust_main.pm -FS/cust_main_Mixin.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_pay_refund.pm -FS/cust_pkg.pm -FS/cust_refund.pm -FS/cust_credit_refund.pm -FS/cust_svc.pm -FS/h_Common.pm -FS/h_cust_bill.pm -FS/h_cust_svc.pm -FS/h_cust_tax_exempt.pm -FS/h_domain_record.pm -FS/h_svc_acct.pm -FS/h_svc_broadband.pm -FS/h_svc_domain.pm -FS/h_svc_external.pm -FS/h_svc_forward.pm -FS/h_svc_www.pm -FS/part_bill_event.pm -FS/export_svc.pm -FS/part_export.pm -FS/part_export_option.pm -FS/part_export/acct_sql.pm -FS/part_export/apache.pm -FS/part_export/bind.pm -FS/part_export/bind_slave.pm -FS/part_export/bsdshell.pm -FS/part_export/communigate_pro.pm -FS/part_export/communigate_pro_singledomain.pm -FS/part_export/cp.pm -FS/part_export/cyrus.pm -FS/part_export/domain_shellcommands.pm -FS/part_export/forward_shellcommands.pm -FS/part_export/http.pm -FS/part_export/infostreet.pm -FS/part_export/ldap.pm -FS/part_export/null.pm -FS/part_export/radiator.pm -FS/part_export/router.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_pkg_option.pm -FS/part_pkg/flat.pm -FS/part_pkg/flat_comission.pm -FS/part_pkg/flat_comission_cust.pm -FS/part_pkg/flat_comission_pkg.pm -FS/part_pkg/flat_delayed.pm -FS/part_pkg/prorate.pm -FS/part_pkg/sesmon_hour.pm -FS/part_pkg/sesmon_minute.pm -FS/part_pkg/sql_external.pm -FS/part_pkg/sql_generic.pm -FS/part_pkg/sqlradacct_hour.pm -FS/part_pkg/subscription.pm -FS/part_pkg/voip_sqlradacct.pm -FS/part_pkg/voip_cdr.pm -FS/part_pop_local.pm -FS/part_referral.pm -FS/part_svc.pm -FS/part_svc_column.pm -FS/part_svc_router.pm -FS/part_virtual_field.pm -FS/payby.pm -FS/pkg_class.pm -FS/pkg_svc.pm -FS/rate.pm -FS/rate_detail.pm -FS/rate_region.pm -FS/rate_prefix.pm -FS/reg_code.pm -FS/reg_code_pkg.pm -FS/svc_Common.pm -FS/svc_acct.pm -FS/svc_acct_pop.pm -FS/svc_broadband.pm -FS/svc_domain.pm -FS/svc_external.pm -FS/router.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 -FS/cust_tax_exempt_pkg.pm -FS/clientapi_session.pm -FS/clientapi_session_field.pm -t/agent.t -t/agent_type.t -t/AccessRight.t -t/CGI.t -t/InitHandler.t -t/ClientAPI.t -t/ClientAPI_SessionCache.t -t/Conf.t -t/ConfItem.t -t/Cron-backup.t -t/Cron-bill.t -t/Cron-vacuum.t -t/Daemon.t -t/Misc.t -t/Record.t -t/Report.t -t/Report-Table.t -t/Report-Table-Monthly.t -t/UID.t -t/Msgcat.t -t/SearchCache.t -t/cust_bill.t -t/cust_bill_event.t -t/cust_bill_pay.t -t/cust_bill_pkg.t -t/cust_bill_pkg_detail.t -t/cust_credit.t -t/cust_credit_bill.t -t/cust_credit_refund.t -t/cust_main.t -t/cust_main_Mixin.t -t/cust_main_county.t -t/cust_main_invoice.t -t/cust_pay.t -t/cust_pay_batch.t -t/cust_pay_refund.t -t/cust_pkg.t -t/cust_refund.t -t/cust_svc.t -t/h_cust_bill.t -t/h_cust_svc.t -t/h_cust_tax_exempt.t -t/h_Common.t -t/h_cust_svc.t -t/h_domain_record.t -t/h_svc_acct.t -t/h_svc_broadband.t -t/h_svc_domain.t -t/h_svc_external.t -t/h_svc_forward.t -t/h_svc_www.t -t/cust_tax_exempt.t -t/cust_tax_exempt_pkg.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-acct_sql.t -t/part_export-apache.t -t/part_export-bind.t -t/part_export-bind_slave.t -t/part_export-bsdshell.t -t/part_export-communigate_pro.t -t/part_export-communigate_pro_singledomain.t -t/part_export-cp.t -t/part_export-cyrus.t -t/part_export-domain_shellcommands.t -t/part_export-forward_shellcommands.t -t/part_export-http.t -t/part_export-infostreet.t -t/part_export-ldap.t -t/part_export-null.t -t/part_export-passwdfile.t -t/part_export-postfix.t -t/part_export-radiator.t -t/part_export-router.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_pkg_option.t -t/part_pkg-flat.t -t/part_pkg-flat_comission.t -t/part_pkg-flat_comission_cust.t -t/part_pkg-flat_comission_pkg.t -t/part_pkg-flat_delayed.t -t/part_pkg-prorate.t -t/part_pkg-sesmon_hour.t -t/part_pkg-sesmon_minute.t -t/part_pkg-sql_external.t -t/part_pkg-sql_generic.t -t/part_pkg-sqlradacct_hour.t -t/part_pkg-subscription.t -t/part_pkg-voip_sqlradacct.t -t/part_pkg-voip_cdr.t -t/part_pop_local.t -t/part_referral.t -t/part_svc.t -t/part_svc_column.t -t/payby.t -t/pkg_class.t -t/pkg_svc.t -t/port.t -t/prepay_credit.t -t/rate.t -t/rate_detail.t -t/rate_region.t -t/rate_prefix.t -t/radius_usergroup.t -t/reg_code.t -t/reg_code_pkg.t -t/session.t -t/svc_acct.t -t/svc_acct_pop.t -t/svc_broadband.t -t/svc_Common.t -t/svc_domain.t -t/svc_external.t -t/svc_forward.t -t/svc_www.t -t/type_pkgs.t -t/queue.t -t/queue_arg.t -t/queue_depend.t -t/msgcat.t -t/raddb.t -t/clientapi_session.t -t/clientapi_session_field.t -FS/payment_gateway.pm -t/payment_gateway.t -FS/payment_gateway_option.pm -t/payment_gateway_option.t -FS/option_Common.pm -t/option_Common.t -FS/agent_payment_gateway.pm -t/agent_payment_gateway.t -FS/banned_pay.pm -t/banned_pay.t -FS/cancel_reason.pm -t/cancel_reason.t -bin/freeside-prepaidd -FS/cdr.pm -t/cdr.t -FS/cdr_calltype.pm -t/cdr_calltype.t -FS/cdr_type.pm -t/cdr_type.t -FS/cdr_carrier.pm -t/cdr_carrier.t -FS/inventory_class.pm -t/inventory_class.t -FS/inventory_item.pm -t/inventory_item.t -FS/cdr_upstream_rate.pm -t/cdr_upstream_rate.t -FS/access_user.pm -t/access_user.t -FS/access_user_pref.pm -t/access_user_pref.t -FS/access_group.pm -t/access_group.t -FS/access_usergroup.pm -t/access_usergroup.t -FS/access_groupagent.pm -t/access_groupagent.t -FS/access_right.pm -t/access_right.t -FS/m2m_Common.pm -FS/pay_batch.pm -t/pay_batch.t -FS/ConfDefaults.pm -t/ConfDefaults.t -FS/m2name_Common.pm -FS/CurrentUser.pm -FS/svc_phone.pm -t/svc_phone.t -FS/h_svc_phone.pm -FS/cust_bill_pay_pkg.pm -t/cust_bill_pay_pkg.t -FS/cust_credit_bill_pkg.pm -t/cust_credit_bill_pkg.t diff --git a/FS/MANIFEST.SKIP b/FS/MANIFEST.SKIP deleted file mode 100644 index ae335e7..0000000 --- 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 1647f8e..0000000 --- a/FS/Makefile.PL +++ /dev/null @@ -1,10 +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/*' ], - 'INSTALLSCRIPT' => '/usr/local/bin', - 'INSTALLSITEBIN' => '/usr/local/bin', -); diff --git a/FS/README b/FS/README deleted file mode 100644 index d4c35ac..0000000 --- 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-addgroup b/FS/bin/freeside-addgroup deleted file mode 100755 index 7b30f7d..0000000 --- a/FS/bin/freeside-addgroup +++ /dev/null @@ -1,50 +0,0 @@ -#!/usr/bin/perl - -use strict; -use vars qw($opt_s); -use Getopt::Std; -use FS::UID qw(adminsuidsetup); -use FS::Record qw(qsearch); -use FS::CurrentUser; -use FS::AccessRight; -use FS::access_group; -use FS::access_right; -use FS::access_groupagent; - -getopts("s"); -my $user = shift or die &usage; #just for adminsuidsetup -my $group = shift or die &usage; - -$FS::CurrentUser::upgrade_hack = 1; -#adminsuidsetup $rootuser; -adminsuidsetup $user; - -my $access_group = new FS::access_group { 'groupname' => $group }; -my $error = $access_group->insert; -die $error if $error; - -if ( $opt_s ) { - foreach my $rightname ( FS::AccessRight->rights ) { - my $access_right = new FS::access_right { - 'righttype' => 'FS::access_group', - 'rightobjnum' => $access_group->groupnum, - 'rightname' => $rightname, - }; - my $ar_error = $access_right->insert; - die $ar_error if $ar_error; - } - - foreach my $agent ( qsearch('agent', {} ) ) { - my $access_groupagent = new FS::access_groupagent { - 'groupnum' => $access_group->groupnum, - 'agentnum' => $agent->agentnum, - }; - my $aga_error = $access_groupagent->insert; - die $aga_error if $aga_error; - } -} - -sub usage { - die "Usage:\n\n freeside-addgroup [ -s ] username groupname" -} - diff --git a/FS/bin/freeside-addoutsource b/FS/bin/freeside-addoutsource deleted file mode 100644 index db4e7a3..0000000 --- a/FS/bin/freeside-addoutsource +++ /dev/null @@ -1,24 +0,0 @@ -#!/bin/sh - -domain=$1 - -createdb $domain && \ -\ -mkdir /usr/local/etc/freeside/conf.DBI:Pg:dbname=$domain && \ -\ -chown freeside /usr/local/etc/freeside/conf.DBI:Pg:dbname=$domain && \ -\ -cp /home/ivan/freeside/conf/[a-z]* /usr/local/etc/freeside/conf.DBI:Pg:dbname=$domain && \ -\ -touch /usr/local/etc/freeside/conf.DBI:Pg:dbname=$domain/secrets && \ -\ -chown freeside /usr/local/etc/freeside/conf.DBI:Pg:dbname=$domain/secrets && \ -\ -chmod 600 /usr/local/etc/freeside/conf.DBI:Pg:dbname=$domain/secrets && \ -\ -echo -e "DBI:Pg:dbname=$domain\nfreeside\n" >/usr/local/etc/freeside/conf.DBI:Pg:dbname=$domain/secrets && \ -\ -mkdir /usr/local/etc/freeside/counters.DBI:Pg:dbname=$domain && \ -mkdir /usr/local/etc/freeside/cache.DBI:Pg:dbname=$domain && \ -mkdir /usr/local/etc/freeside/export.DBI:Pg:dbname=$domain - diff --git a/FS/bin/freeside-addoutsourceuser b/FS/bin/freeside-addoutsourceuser deleted file mode 100644 index 02a4351..0000000 --- a/FS/bin/freeside-addoutsourceuser +++ /dev/null @@ -1,15 +0,0 @@ -#!/bin/sh - -username=$1 -domain=$2 -password=$3 -realdomain=$4 - -freeside-adduser -h /usr/local/etc/freeside/htpasswd \ - -s conf.DBI:Pg:dbname=$domain/secrets \ - -b \ - $username $password 2>/dev/null - -[ -e /usr/local/etc/freeside/dbdef.DBI:Pg:dbname=$domain ] \ - || ( freeside-setup -d $realdomain $username 2>/dev/null ) - diff --git a/FS/bin/freeside-adduser b/FS/bin/freeside-adduser deleted file mode 100644 index b955902..0000000 --- a/FS/bin/freeside-adduser +++ /dev/null @@ -1,115 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use vars qw($opt_s $opt_h $opt_b $opt_c $opt_g $opt_n); -use Fcntl qw(:flock); -use Getopt::Std; - -my $FREESIDE_CONF = "/usr/local/etc/freeside"; - -getopts("s:bch:g:n"); -die &usage if $opt_c && ! $opt_h; -my $user = shift or die &usage; - -#if ( -e "$FREESIDE_CONF/mapsecrets" ) { -# open(MAPSECRETS,"<$FREESIDE_CONF/mapsecrets") -# or die "can't open $FREESIDE_CONF/mapsecrets: $!"; -# while (<MAPSECRETS>) { -# /^(\S+) / or die "unparsable line in mapsecrets: $_"; -# die "user $user already exists\n" if $user eq $1; -# } -# close MAPSECRETS; -#} - -if ( $opt_h ) { - my @args = ( 'htpasswd' ); - push @args, '-b' if $opt_b; - push @args, '-c' if $opt_c; - push @args, $opt_h, $user; - push @args, shift if $opt_b; - #warn join(', ', @args)."\n"; - system(@args) == 0 or die "htpasswd failed: $?"; -} - -if ( $opt_s ) { - open(MAPSECRETS,">>$FREESIDE_CONF/mapsecrets") - and flock(MAPSECRETS,LOCK_EX) - or die "can't open $FREESIDE_CONF/mapsecrets: $!"; - print MAPSECRETS "$user $opt_s\n"; - close MAPSECRETS or die "can't close $FREESIDE_CONF/mapsecrets: $!"; -} - -### - -exit if $opt_n; - -### - -use FS::UID qw(adminsuidsetup); -use FS::CurrentUser; -use FS::access_user; -use FS::access_usergroup; - -$FS::CurrentUser::upgrade_hack = 1; -#adminsuidsetup $rootuser; -adminsuidsetup $user; - -my $access_user = new FS::access_user { - 'username' => $user, - '_password' => 'notyet', - 'first' => 'Firstname', # $opt_f || - 'last' => 'Lastname', # $opt_l || -}; -my $au_error = $access_user->insert; -die $au_error if $au_error; - -if ( $opt_g ) { - - my $access_usergroup = new FS::access_usergroup { - 'usernum' => $access_user->usernum, - 'groupnum' => $opt_g, - }; - my $aug_error = $access_usergroup->insert; - die $aug_error if $aug_error; - -} - -### - -sub usage { - die "Usage:\n\n freeside-adduser [ -h htpasswd_file [ -c ] [ -b ] ] [ -g groupnum ] username [ password ]" -} - -=head1 NAME - -freeside-adduser - Command line interface to add (freeside) users. - -=head1 SYNOPSIS - - freeside-adduser [ -n ] [ -h htpasswd_file [ -c ] [ -b ] ] [ -g groupnum ] username [ password ] - -=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(1) - - -b: same as htpasswd(1), probably insecure, not recommended - - -g: initial groupnum - - Development/multi-DB options: - - -s: alternate secrets file - - -n: no ACL added, for bootstrapping - -=head1 SEE ALSO - -L<htpasswd>(1), base Freeside documentation - -=cut - diff --git a/FS/bin/freeside-apply-credits b/FS/bin/freeside-apply-credits deleted file mode 100755 index ea6a7bd..0000000 --- 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 49ad4a7..0000000 --- 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<FS::cust_main>. - - -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<freeside-daily>, L<FS::cust_main>, config.html from the base documentation - -=cut - diff --git a/FS/bin/freeside-count-active-customers b/FS/bin/freeside-count-active-customers deleted file mode 100755 index 759085a..0000000 --- a/FS/bin/freeside-count-active-customers +++ /dev/null @@ -1,17 +0,0 @@ -#!/bin/sh - -domain=$1 - -echo "\t -select count(*) from cust_main where - 0 < ( SELECT COUNT(*) FROM cust_pkg - WHERE cust_pkg.custnum = cust_main.custnum - AND ( cust_pkg.cancel IS NULL - OR cust_pkg.cancel = 0 - ) - ) - OR 0 = ( SELECT COUNT(*) FROM cust_pkg - WHERE cust_pkg.custnum = cust_main.custnum - ); -" | psql -U freeside -q $domain | head -1 - diff --git a/FS/bin/freeside-daily b/FS/bin/freeside-daily deleted file mode 100755 index b9742c4..0000000 --- a/FS/bin/freeside-daily +++ /dev/null @@ -1,89 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use Getopt::Std; -use FS::UID qw(adminsuidsetup); - -&untaint_argv; #what it sounds like (eww) -#use vars qw($opt_d $opt_v $opt_p $opt_a $opt_s $opt_y); -use vars qw(%opt); -getopts("p:a:d:vsy:", \%opt); - -my $user = shift or die &usage; -adminsuidsetup $user; - -use FS::Cron::bill qw(bill); -bill(%opt); - -use FS::Cron::vacuum qw(vacuum); -vacuum(); - -use FS::Cron::backup qw(backup_scp); -backup_scp(); - -### -# 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"; -} - -### -# documentation -### - -=head1 NAME - -freeside-daily - Run daily billing and invoice collection events. - -=head1 SYNOPSIS - - freeside-daily [ -d 'date' ] [ -y days ] [ -p 'payby' ] [ -a agentnum ] [ -s ] [ -v ] user [ custnum custnum ... ] - -=head1 DESCRIPTION - -Bills customers and runs invoice collection events. Should be run from -crontab daily. - -Bills customers. Searches for customers who are due for billing and calls -the bill and collect methods of a cust_main object. See L<FS::cust_main>. - - -d: Pretend it's 'date'. Date is in any format Date::Parse is happy with, - but be careful. - - -y: In addition to -d, which specifies an absolute date, the -y switch - specifies an offset, in days. For example, "-y 15" would increment the - "pretend date" 15 days from whatever was specified by the -d switch - (or now, if no -d switch was given). - - -p: Only process customers with the specified payby (I<CARD>, I<DCRD>, I<CHEK>, I<DCHK>, I<BILL>, I<COMP>, I<LECB>) - - -a: Only process customers with the specified agentnum - - -s: re-charge setup fees - - -v: enable debugging - -user: From the mapsecrets file - see config.html from the base documentation - -custnum: if one or more customer numbers are specified, only bills those -customers. Otherwise, bills all customers. - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::cust_main>, config.html from the base documentation - -=cut - diff --git a/FS/bin/freeside-deloutsource b/FS/bin/freeside-deloutsource deleted file mode 100644 index 5618535..0000000 --- a/FS/bin/freeside-deloutsource +++ /dev/null @@ -1,11 +0,0 @@ -#!/bin/sh - -domain=$1 - -dropdb $domain && \ -rm -rf /usr/local/etc/freeside/conf.DBI:Pg:host=localhost\;dbname=$domain && \ -rm -rf /usr/local/etc/freeside/counters.DBI:Pg:host=localhost\;dbname=$domain && \ -rm -rf /usr/local/etc/freeside/cache.DBI:Pg:host=localhost\;dbname=$domain && \ -rm -rf /usr/local/etc/freeside/export.DBI:Pg:host=localhost\;dbname=$domain && \ -rm /usr/local/etc/freeside/dbdef.DBI:Pg:host=localhost\;dbname=$domain - diff --git a/FS/bin/freeside-deloutsourceuser b/FS/bin/freeside-deloutsourceuser deleted file mode 100644 index 96871e5..0000000 --- a/FS/bin/freeside-deloutsourceuser +++ /dev/null @@ -1,6 +0,0 @@ -#!/bin/sh - -username=$1 - -freeside-deluser -h /usr/local/etc/freeside/htpasswd $username 2>/dev/null - diff --git a/FS/bin/freeside-deluser b/FS/bin/freeside-deluser deleted file mode 100644 index 57d6ce1..0000000 --- a/FS/bin/freeside-deluser +++ /dev/null @@ -1,64 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use vars qw($opt_h); -use Fcntl qw(:flock); -use Getopt::Std; - -my $FREESIDE_CONF = "/usr/local/etc/freeside"; - -getopts("h:"); -my $user = shift or die &usage; - -if ( $opt_h ) { - open(HTPASSWD,"<$opt_h") - and flock(HTPASSWD,LOCK_EX) - or die "can't open $opt_h: $!"; - open(HTPASSWD_TMP,">$opt_h.tmp") or die "can't open $opt_h.tmp: $!"; - while (<HTPASSWD>) { - print HTPASSWD_TMP $_ unless /^$user:/; - } - close HTPASSWD_TMP; - rename "$opt_h.tmp", "$opt_h" or die $!; - flock(HTPASSWD,LOCK_UN); - close HTPASSWD; -} - -open(MAPSECRETS,"<$FREESIDE_CONF/mapsecrets") - and flock(MAPSECRETS,LOCK_EX) - or die "can't open $FREESIDE_CONF/mapsecrets: $!"; -open(MAPSECRETS_TMP,">>$FREESIDE_CONF/mapsecrets.tmp") - or die "can't open $FREESIDE_CONF/mapsecrets.tmp: $!"; -while (<MAPSECRETS>) { - print MAPSECRETS_TMP $_ unless /^$user\s/; -} -close MAPSECRETS_TMP; -rename "$FREESIDE_CONF/mapsecrets.tmp", "$FREESIDE_CONF/mapsecrets" or die $!; -flock(MAPSECRETS,LOCK_UN); -close MAPSECRETS; - -sub usage { - die "Usage:\n\n freeside-deluser [ -h htpasswd_file ] username" -} - -=head1 NAME - -freeside-deluser - Command line interface to add (freeside) users. - -=head1 SYNOPSIS - - freeside-deluser [ -h htpasswd_file ] username - -=head1 DESCRIPTION - -Adds a user to the Freeside billing system. This is for adding users (internal -sales/tech folks) to the web interface, not for adding customer accounts. - - -h: Also delete from the given htpasswd filename - -=head1 SEE ALSO - -L<freeside-adduser>, L<htpasswd>(1), base Freeside documentation - -=cut - diff --git a/FS/bin/freeside-email b/FS/bin/freeside-email deleted file mode 100755 index 400dc2a..0000000 --- a/FS/bin/freeside-email +++ /dev/null @@ -1,59 +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 @svc_acct = qsearch('svc_acct', {}); -my @emails = map $_->email, @svc_acct; - -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.2 2002-09-18 22:50:44 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 691fd3a..0000000 --- a/FS/bin/freeside-expiration-alerter +++ /dev/null @@ -1,226 +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 $paydate = $customer->getfield('paydate'); - next if $paydate =~ /^\s*$/; #skip empty expiration dates - - my $custnum = $customer->getfield('custnum'); - my $first = $customer->getfield('first'); - my $last = $customer->getfield('last'); - my $company = $customer->getfield('company'); - my $payby = $customer->getfield('payby'); - my $payinfo = $customer->getfield('payinfo'); - my $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' || $payby eq 'DCRD') { - ($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' || $payby eq 'DCRD') { - $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.5 2003-04-21 20:53:57 ivan Exp $ - -=head1 BUGS - -Yes..... Use at your own risk. No guarantees or warrantees of any -kind apply to this program. Parts of this program are hacked from -other GNU licensed software created mainly by Ivan Kohler. - -This is released under the GNU Public License. See www.gnu.org -for more information regarding this license. - -=head1 SEE ALSO - -L<FS::cust_main>, config.html from the base documentation - -=head1 AUTHOR - -Jeff Finucane <jeff@cmh.net> - -=cut - - diff --git a/FS/bin/freeside-monthly b/FS/bin/freeside-monthly deleted file mode 100755 index a6c75e7..0000000 --- a/FS/bin/freeside-monthly +++ /dev/null @@ -1,91 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use Getopt::Std; -use FS::UID qw(adminsuidsetup); - -&untaint_argv; #what it sounds like (eww) -#use vars qw($opt_d $opt_v $opt_p $opt_a $opt_s $opt_y); -use vars qw(%opt); -getopts("p:a:d:vsy:", \%opt); - -my $user = shift or die &usage; -adminsuidsetup $user; - -use FS::Cron::bill qw(bill); -bill(%opt, 'freq'=>'1m' ); - -### -# 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-monthly [ -d 'date' ] user [ custnum custnum ... ]\n"; -} - -### -# documentation -### - -=head1 NAME - -freeside-monthly - Run monthly billing and invoice collection events. - -=head1 SYNOPSIS - - freeside-monthly [ -d 'date' ] [ -y days ] [ -p 'payby' ] [ -a agentnum ] [ -s ] [ -v ] user [ custnum custnum ... ] - -=head1 DESCRIPTION - -Bills customers and runs invoice collection events, for the alternate monthly -event chain. If you have defined monthly event checks, should be run from -crontab monthly. - -Bills customers. Searches for customers who are due for billing and calls -the bill and collect methods of a cust_main object. See L<FS::cust_main>. - - -d: Pretend it's 'date'. Date is in any format Date::Parse is happy with, - but be careful. - - -y: In addition to -d, which specifies an absolute date, the -y switch - specifies an offset, in days. For example, "-y 15" would increment the - "pretend date" 15 days from whatever was specified by the -d switch - (or now, if no -d switch was given). - - -p: Only process customers with the specified payby (I<CARD>, I<DCRD>, I<CHEK>, I<DCHK>, I<BILL>, I<COMP>, I<LECB>) - - -a: Only process customers with the specified agentnum - - -s: re-charge setup fees - - -v: enable debugging - -user: From the mapsecrets file - see config.html from the base documentation - -custnum: if one or more customer numbers are specified, only bills those -customers. Otherwise, bills all customers. - -=head1 NOTE - -In most cases, you would use freeside-daily only and not freeside-monthly. -freeside-monthly would only be used in cases where you have events that can -only be run once each month, for example, batching invoices to a third-party -print/mail provider. - -=head1 BUGS - -=head1 SEE ALSO - -L<freeside-daily>, L<FS::cust_main>, config.html from the base documentation - -=cut - diff --git a/FS/bin/freeside-prepaidd b/FS/bin/freeside-prepaidd deleted file mode 100644 index e51a563..0000000 --- a/FS/bin/freeside-prepaidd +++ /dev/null @@ -1,75 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use FS::Daemon qw(daemonize1 drop_root logfile daemonize2 sigint sigterm); -use FS::UID qw(adminsuidsetup); -use FS::Record qw(qsearch); # qsearchs); -use FS::cust_pkg; - -my $user = shift or die &usage; - -#daemonize1('freeside-sprepaidd', $user); #keep unique pid files w/multi installs -daemonize1('freeside-prepaidd'); - -drop_root(); - -adminsuidsetup($user); - -logfile( "/usr/local/etc/freeside/prepaidd-log.". $FS::UID::datasrc ); - -daemonize2(); - -#-- - -while (1) { - - foreach my $cust_pkg ( - qsearch( { - 'select' => 'cust_pkg.*, part_pkg.plan', - 'table' => 'cust_pkg', - 'addl_from' => 'LEFT JOIN part_pkg USING ( pkgpart )', - #'hashref' => { 'plan' => 'prepaid' },#should check part_pkg::is_prepaid - #'extra_sql' => "AND bill < ". time. - 'hashref' => {}, - 'extra_sql' => "WHERE plan = 'prepaid' AND bill < ". time. - " AND bill IS NOT NULL". - " AND ( susp IS NULL OR susp = 0)". - " AND ( cancel IS NULL OR cancel = 0)" - } ) - ) { - my $error = $cust_pkg->suspend; - warn "Error suspended package ". $cust_pkg->pkgnum. - " for custnum ". $cust_pkg->custnum. - ": $error\n" - if $error; - } - - die "exiting" if sigterm() || sigint(); - sleep 5; - -} - -#-- - -sub usage { - die "Usage:\n\n freeside-prepaidd user\n"; -} - -=head1 NAME - -freeside-prepaidd - Real-time daemon for prepaid packages - -=head1 SYNOPSIS - - freeside-prepaidd - -=head1 DESCRIPTION - -Runs continuously and suspendes any prepaid customer packages which have -passed their renewal date (next bill date). - -=head1 SEE ALSO - -=cut - -1; diff --git a/FS/bin/freeside-queued b/FS/bin/freeside-queued deleted file mode 100644 index 3a0a9b4..0000000 --- a/FS/bin/freeside-queued +++ /dev/null @@ -1,253 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use vars qw( $DEBUG $kids $max_kids %kids ); -use POSIX qw(:sys_wait_h); -use IO::File; -use FS::UID qw(adminsuidsetup forksuidsetup driver_name dbh myconnect); -use FS::Daemon qw(daemonize1 drop_root logfile daemonize2 sigint sigterm); -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.07; -use FS::part_export; - -$DEBUG = 0; - -$max_kids = '10'; #guess it should be a config file... -$kids = 0; - -my $user = shift or die &usage; - -warn "starting daemonization (forking)\n" if $DEBUG; -#daemonize1('freeside-queued',$user); #to keep pid files unique w/multi installs -daemonize1('freeside-queued'); - -warn "dropping privledges\n" if $DEBUG; -drop_root(); - - -$ENV{HOME} = (getpwuid($>))[7]; #for ssh - -warn "connecting to database\n" if $DEBUG; -$@ = 'not connected'; -while ( $@ ) { - eval { adminsuidsetup $user; }; - if ( $@ ) { - warn $@; - warn "sleeping for reconnect...\n"; - sleep 5; - } -} - -logfile( "/usr/local/etc/freeside/queuelog.". $FS::UID::datasrc ); - -warn "completing daemonization (detaching))\n" if $DEBUG; -daemonize2(); - -#-- - -my $warnkids=0; -while (1) { - - &reap_kids; - #prevent runaway forking - if ( $kids >= $max_kids ) { - warn "WARNING: maximum $kids children reached\n" unless $warnkids++; - &reap_kids; - sleep 1; #waiting for signals is cheap - next; - } - $warnkids=0; - - unless ( dbh && dbh->ping ) { - warn "WARNING: connection to database lost, reconnecting...\n"; - - eval { $FS::UID::dbh = myconnect; }; - - unless ( !$@ && dbh && dbh->ping ) { - warn "WARNING: still no connection to database, sleeping for retry...\n"; - sleep 10; - next; - } else { - warn "WARNING: reconnected to database\n"; - } - } - - #my($job, $ljob); - #{ - # my $oldAutoCommit = $FS::UID::AutoCommit; - # local $FS::UID::AutoCommit = 0; - $FS::UID::AutoCommit = 0; - - #assuming mysql 4.1 w/subqueries now - #my $nodepend = driver_name eq 'mysql' - # ? '' - # : 'AND 0 = ( SELECT COUNT(*) FROM queue_depend'. - # ' WHERE queue_depend.jobnum = queue.jobnum ) '; - my $nodepend = 'AND 0 = ( SELECT COUNT(*) FROM queue_depend'. - ' WHERE queue_depend.jobnum = queue.jobnum ) '; - - 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 { - # if $oldAutoCommit { - dbh->commit or do { - warn "WARNING: database error, closing connection: ". dbh->errstr; - undef $FS::UID::dbh; - next; - }; - # } - sleep 5; #connecting to db is expensive - next; - }; - - #assuming mysql 4.1 w/subqueries now - #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); - if ( $error ) { - warn "WARNING: database error locking job, closing connection: ". - dbh->errstr; - undef $FS::UID::dbh; - next; - } - - # if $oldAutoCommit { - dbh->commit or do { - warn "WARNING: database error, closing connection: ". dbh->errstr; - undef $FS::UID::dbh; - next; - }; - # } - - $FS::UID::AutoCommit = 1; - #} - - my @args = $ljob->args; - splice @args, 0, 1, $ljob if $args[0] eq '_JOB'; - - 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++; - $kids{$pid} = 1; - } else { #kid time - - #get new db handle - $FS::UID::dbh->{InactiveDestroy} = 1; - - forksuidsetup($user); - - #auto-use classes... - #if ( $ljob->job =~ /(FS::part_export::\w+)::/ ) { - if ( $ljob->job =~ /(FS::part_export::\w+)::/ - || $ljob->job =~ /(FS::\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 "&'. $ljob->job. '('. join(', ', @args). ")\n" if $DEBUG; - 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 reap_kids { - foreach my $pid ( keys %kids ) { - my $kid = waitpid($pid, WNOHANG); - if ( $kid > 0 ) { - $kids--; - delete $kids{$kid}; - } - } -} - -=head1 NAME - -freeside-queued - Job queue daemon - -=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-radgroup b/FS/bin/freeside-radgroup deleted file mode 100644 index ed85626..0000000 --- a/FS/bin/freeside-radgroup +++ /dev/null @@ -1,76 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use FS::UID qw(adminsuidsetup); -use FS::Record qw(qsearch); -use FS::cust_svc; -use FS::svc_acct; - -&untaint_argv; #what it sounds like (eww) - -my($user, $action, $groupname, $svcpart) = @ARGV; - -adminsuidsetup $user; - -my @svc_acct = map { $_->svc_x } qsearch('cust_svc', { svcpart => $svcpart } ); - -if ( lc($action) eq 'add' ) { - foreach my $svc_acct ( @svc_acct ) { - my @groups = $svc_acct->radius_groups; - next if grep { $_ eq $groupname } @groups; - push @groups, $groupname; - my %hash = $svc_acct->hash; - $hash{usergroup} = \@groups; - my $new = new FS::svc_acct \%hash; - my $error = $new->replace($svc_acct); - die $error if $error; - } -} else { - die &usage; -} - -# subroutines - -sub untaint_argv { - foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV - $ARGV[$_] =~ /^(.*)$/ || die "Illegal arguement \"$ARGV[$_]\""; - $ARGV[$_]=$1; - } -} - -sub usage { - die "Usage:\n\n freeside-radgroup user action groupname svcpart\n"; -} - -=head1 NAME - -freeside-radgroup - Command line utility to manipulate radius groups - -=head1 SYNOPSIS - - freeside-addgroup user action groupname svcpart - -=head1 DESCRIPTION - - B<user> is a freeside user as added with freeside-adduser. - - B<command> is the action to take. Available actions are: I<add> - - B<groupname> is the group to add (or remove, etc.) - - B<svcpart> specifies which accounts will be updated. - -=head1 EXAMPLES - -freeside-radgroup freesideuser add groupname 3 - -Adds I<groupname> to all accounts with service definition 3. - -=head1 BUGS - -=head1 SEE ALSO - -L<freeside-adduser>, L<FS::svc_acct>, L<FS::part_svc> - -=cut - diff --git a/FS/bin/freeside-reexport b/FS/bin/freeside-reexport deleted file mode 100644 index 54af9dd..0000000 --- a/FS/bin/freeside-reexport +++ /dev/null @@ -1,71 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use vars qw($opt_s $opt_u $opt_p); -use Getopt::Std; -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"; -} - -getopts('s:u:p:'); - -my @svc_x = (); -if ( $opt_s ) { - my $cust_svc = qsearchs('cust_svc', { svcnum=>$opt_s } ) - or die "svcnum $opt_s not found\n"; - push @svc_x, $cust_svc->svc_x; -} elsif ( $opt_u ) { - my $svc_x = qsearchs('svc_acct', { username=>$opt_u } ) - or die "username $opt_u not found\n"; - push @svc_x, $svc_x; -} elsif ( $opt_p ) { - push @svc_x, map { $_->svc_x } qsearch('cust_svc', { svcpart=>$opt_p } ); - die "no services with svcpart $opt_p found\n" unless @svc_x; -} - -foreach my $part_export ( @part_export ) { - foreach my $svc_x ( @svc_x ) { - my $error = $part_export->export_insert($svc_x); - die $error if $error; - } -} - - -sub usage { - die "Usage:\n\n freeside-reexport user exportnum|exporttype [ -s svcnum | -u username | -p svcpart ]\n"; -} - -=head1 NAME - -freeside-reexport - Command line tool to re-trigger export jobs for existing services - -=head1 SYNOPSIS - - freeside-reexport user exportnum|exporttype [ -s svcnum | -u username | -p svcpart ] - -=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<freeside-sqlradius-reset>, L<FS::part_export> - -=cut - diff --git a/FS/bin/freeside-selfservice-server b/FS/bin/freeside-selfservice-server deleted file mode 100644 index 6026fd1..0000000 --- a/FS/bin/freeside-selfservice-server +++ /dev/null @@ -1,227 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use vars qw( $Debug %kids $kids $max_kids $ssh_pid %old_ssh_pid $keepalives ); -use subs qw( lock_write unlock_write myshutdown usage ); -use Fcntl qw(:flock); -use POSIX qw(:sys_wait_h); -use IO::Handle; -use IO::Select; -use IO::File; -use Storable 2.09 qw(nstore_fd fd_retrieve); -use Net::SSH qw(sshopen2); -use FS::Daemon qw(daemonize1 drop_root logfile daemonize2 sigint sigterm); -use FS::UID qw(adminsuidsetup forksuidsetup); -use FS::ClientAPI; - -use FS::Conf; -use FS::cust_bill; -use FS::cust_pkg; - -$Debug = 1; # 2 will turn on more logging - # 3 will log packet contents, including passwords - -$max_kids = '10'; #? -$keepalives = 0; #let clientd turn it on, so we don't barf on old ones -$kids = 0; - -my $user = shift or die &usage; -my $machine = shift or die &usage; -my $tag = scalar(@ARGV) ? shift : ''; - -my $lock_file = "/usr/local/etc/freeside/selfservice.$machine.writelock"; - - -# to keep pid files unique w/multi machines (and installs!) -# $FS::UID::datasrc not posible -daemonize1("freeside-selfservice-server","$user.$machine"); - -#false laziness w/Daemon::drop_root -my $freeside_gid = scalar(getgrnam('freeside')) - or die "can't find freeside group\n"; - -open(LOCKFILE,">$lock_file") or die "can't open $lock_file: $!"; -chown $FS::UID::freeside_uid, $freeside_gid, $lock_file; - -drop_root(); - -$ENV{HOME} = (getpwuid($>))[7]; #for ssh - -adminsuidsetup $user; - -#logfile("/usr/local/etc/freeside/selfservice.". $FS::UID::datasrc); #MACHINE -logfile("/usr/local/etc/freeside/selfservice.$machine.log"); - -daemonize2(); - - -my $conf = new FS::Conf; - -my $clientd = "/usr/local/sbin/freeside-selfservice-clientd"; #better name? - -my $warnkids=0; -while (1) { - my($writer,$reader,$error) = (new IO::Handle, new IO::Handle, new IO::Handle); - warn "connecting to $machine\n" if $Debug; - - $ssh_pid = sshopen2($machine,$reader,$writer,$clientd,$tag); - -# nstore_fd(\*writer, {'hi'=>'there'}); - - warn "entering main loop\n" if $Debug; - my $undisp = 0; - my $keepalive_count = 0; - my $s = IO::Select->new( $reader ); - while (1) { - - &reap_kids; - - warn "waiting for packet from client\n" if $Debug && !$undisp; - $undisp = 1; - my @handles = $s->can_read(5); - unless ( @handles ) { - myshutdown() if sigint() || sigterm(); - if ( $keepalives && $keepalive_count++ > 10 ) { - $keepalive_count = 0; - lock_write; - nstore_fd( { _token => '_keepalive' }, $writer ); - unlock_write; - } - next; - } - - $undisp = 0; - - warn "receiving packet from client\n" if $Debug; - - my $packet = eval { fd_retrieve($reader); }; - if ( $@ ) { - warn "Storable error receiving packet from client". - " (assuming lost connection): $@\n" - if $Debug; - if ( $ssh_pid ) { - warn "sending TERM signal to ssh process $ssh_pid\n" if $Debug; - kill 'TERM', $ssh_pid; - $old_ssh_pid{$ssh_pid} = 1; - $ssh_pid = 0; - } - last; - } - warn "packet received\n". - join('', map { " $_=>$packet->{$_}\n" } keys %$packet ) - if $Debug > 2; - - if ( $packet->{_packet} eq '_enable_keepalive' ) { - warn "enabling keep alives\n" if $Debug; - $keepalives=1; - next; - } - - #prevent runaway forking - my $warnkids = 0; - while ( $kids >= $max_kids ) { - warn "WARNING: maximum $kids children reached\n" unless $warnkids++; - &reap_kids; - sleep 1; - } - - warn "forking child\n" if $Debug; - defined( my $pid = fork ) or die "can't fork: $!"; - if ( $pid ) { - $kids++; - $kids{$pid} = 1; - warn "child $pid spawned\n" if $Debug; - } else { #kid time - - ##get new db handle - #$FS::UID::dbh->{InactiveDestroy} = 1; - #forksuidsetup($user); - - #get db handle - adminsuidsetup($user); - - my $type = $packet->{_packet}; - warn "calling $type handler\n" if $Debug; - my $rv = eval { FS::ClientAPI->dispatch($type, $packet); }; - if ( $@ ) { - warn my $error = "WARNING: error dispatching $type: $@"; - $rv = { _error => $error }; - } - $rv->{_token} = $packet->{_token}; #identifier - - open(LOCKFILE,">$lock_file") or die "can't open $lock_file: $!"; - lock_write; - warn "sending response\n" if $Debug; - nstore_fd($rv, $writer) or die "FATAL: can't send response: $!"; - $writer->flush or die "FATAL: can't flush: $!"; - unlock_write; - - warn "child exiting\n" if $Debug; - exit; #end-of-kid - } - - } - - myshutdown if sigint() || sigterm(); - warn "connection lost, reconnecting\n" if $Debug; - sleep 3; - -} - -### -# utility subroutines -### - -sub reap_kids { - #warn "reaping kids\n"; - foreach my $pid ( keys %kids ) { - my $kid = waitpid($pid, WNOHANG); - if ( $kid > 0 ) { - $kids--; - delete $kids{$kid}; - } - } - - foreach my $pid ( keys %old_ssh_pid ) { - waitpid($pid, WNOHANG) and delete $old_ssh_pid{$pid}; - } - #warn "done reaping\n"; -} - -sub myshutdown { - &reap_kids; - my $wait = 12; #wait up to 1 minute - while ( $kids > 0 && $wait-- ) { - warn "waiting for $kids children to terminate"; - sleep 5; - &reap_kids; - } - warn "abandoning $kids children" if $kids; - kill 'TERM', $ssh_pid if $ssh_pid; - die "exiting"; -} - -sub lock_write { - warn "locking $lock_file mutex for write to write stream\n" if $Debug > 1; - - #broken on freebsd? - #flock($writer, LOCK_EX) or die "FATAL: can't lock write stream: $!"; - - flock(LOCKFILE, LOCK_EX) or die "FATAL: can't lock $lock_file: $!"; - -} - -sub unlock_write { - warn "unlocking $lock_file mutex\n" if $Debug > 1; - - #broken on freebsd? - #flock($writer, LOCK_UN) or die "WARNING: can't release write lock: $!"; - - flock(LOCKFILE, LOCK_UN) or die "FATAL: can't unlock $lock_file: $!"; - -} - -sub usage { - die "Usage:\n\n freeside-selfservice-server user machine\n"; -} - diff --git a/FS/bin/freeside-setinvoice b/FS/bin/freeside-setinvoice deleted file mode 100644 index 708e2fa..0000000 --- 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-setup b/FS/bin/freeside-setup deleted file mode 100755 index 2ba717c..0000000 --- a/FS/bin/freeside-setup +++ /dev/null @@ -1,127 +0,0 @@ -#!/usr/bin/perl -Tw - -#to delay loading dbdef until we're ready -BEGIN { $FS::Schema::setup_hack = 1; } - -use strict; -use vars qw($opt_s $opt_d $opt_v); -use Getopt::Std; -use FS::UID qw(adminsuidsetup datasrc checkeuid getsecrets); -use FS::CurrentUser; -use FS::Schema qw( dbdef_dist reload_dbdef ); -use FS::Record; -#use FS::raddb; -use FS::Setup qw(create_initial_data); - -die "Not running uid freeside!" unless checkeuid(); - -#my %attrib2db = -# map { lc($FS::raddb::attrib{$_}) => $_ } keys %FS::raddb::attrib; - -getopts("svd:"); -#my $user = shift or die &usage; -getsecrets(); #$user); - -#needs to match FS::Record -my($dbdef_file) = "/usr/local/etc/freeside/dbdef.". datasrc; - -### - -#print "\nEnter the maximum username length: "; -#my($username_len)=&getvalue; -my $username_len = 32; #usernamemax config file - -#print "\n\n", <<END, ":"; -#Freeside tracks the RADIUS User-Name, check attribute Password and -#reply attribute Framed-IP-Address for each user. You can specify additional -#check and reply attributes (or you can add them later with the -#fs-radius-add-check and fs-radius-add-reply programs). -# -#First enter any additional RADIUS check attributes you need to track for each -#user, separated by whitespace. -#END -#my @check_attributes = map { $attrib2db{lc($_)} or die "unknown attribute $_"; } -# split(" ",&getvalue); -# -#print "\n\n", <<END, ":"; -#Now enter any additional reply attributes you need to track for each user, -#separated by whitespace. -#END -#my @attributes = map { $attrib2db{lc($_)} or die "unknown attribute $_"; } -# split(" ",&getvalue); -# -#print "\n\n", <<END, ":"; -#Do you wish to enable the tracking of a second, separate shipping/service -#address? -#END -#my $ship = &_yesno; -# -#sub getvalue { -# my($x)=scalar(<STDIN>); -# chop $x; -# $x; -#} -# -#sub _yesno { -# print " [y/N]:"; -# my $x = scalar(<STDIN>); -# $x =~ /^y/i; -#} - -#my @check_attributes = (); #add later -#my @attributes = (); #add later -#my $ship = $opt_s; - -### -# create a dbdef object from the old data structure -### - -my $dbdef = dbdef_dist; - -#important -$dbdef->save($dbdef_file); -&FS::Schema::reload_dbdef($dbdef_file); - -### -# create 'em -### - -$FS::CurrentUser::upgrade_hack = 1; -my $dbh = adminsuidsetup; #$user; - -#create tables -$|=1; - -foreach my $statement ( $dbdef->sql($dbh) ) { - warn $statement if $statement =~ /TABLE cdr/; - $dbh->do( $statement ) - or die "CREATE error: ". $dbh->errstr. "\ndoing statement: $statement"; -} - -#now go back and reverse engineer the db -#so we pick up the correct column DEFAULTs for #oidless inserts -dbdef_create($dbh, $dbdef_file); -delete $FS::Schema::dbdef_cache{$dbdef_file}; #force an actual reload -reload_dbdef($dbdef_file); - -create_initial_data('domain' => $opt_d); - -warn "Freeside database initialized - commiting transaction\n" if $opt_v; - -$dbh->commit or die $dbh->errstr; -$dbh->disconnect or die $dbh->errstr; - -warn "Database initialization committed successfully\n" if $opt_v; - -sub dbdef_create { # reverse engineer the schema from the DB and save to file - my( $dbh, $file ) = @_; - my $dbdef = new_native DBIx::DBSchema $dbh; - $dbdef->save($file); -} - -sub usage { - die "Usage:\n freeside-setup -d domain.name [ -v ] user\n"; -} - -1; - diff --git a/FS/bin/freeside-sqlradius-radacctd b/FS/bin/freeside-sqlradius-radacctd deleted file mode 100644 index e98eaa0..0000000 --- a/FS/bin/freeside-sqlradius-radacctd +++ /dev/null @@ -1,150 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use vars qw( @part_export ); -use subs qw(myshutdown); -use POSIX qw(:sys_wait_h); -#use IO::File; -use FS::Daemon qw(daemonize1 drop_root logfile daemonize2 sigint sigterm); -use FS::UID qw(adminsuidsetup); #forksuidsetup driver_name dbh myconnect); -use FS::Record qw(qsearch); # qsearchs); -use FS::part_export; -#use FS::svc_acct; -#use FS::cust_svc; - -my $user = shift or die &usage; - -#daemonize1('freeside-sqlradius-radacctd', $user); #keep unique pid files w/multi installs -daemonize1('freeside-sqlradius-radacctd'); - -drop_root(); - -#$ENV{HOME} = (getpwuid($>))[7]; #for ssh - -adminsuidsetup $user; - -logfile( "/usr/local/etc/freeside/sqlradius-radacctd-log.". $FS::UID::datasrc ); - -daemonize2(); - -#-- - -#don't just look for ->can('usage_sessions'), we're sqlradius-specific -# (radiator is supposed to be setup with a radacct table) - -@part_export = - qsearch('part_export', { 'exporttype' => 'sqlradius' } ); -push @part_export, - qsearch('part_export', { 'exporttype' => 'sqlradius_withdomain' } ); -push @part_export, - qsearch('part_export', { 'exporttype' => 'radiator' } ); - -@part_export = grep { ! $_->option('ignore_accounting') } @part_export; - -die "no sqlradius, sqlradius_withdomain or radiator exports without". - " ignore_accounting" - unless @part_export; - -while (1) { - - #fork off one kid per export (machine) - # _>{'_radacct_kid'} is an evil kludge - foreach my $part_export ( grep ! $_->{'_radacct_kid'}, @part_export ) { - - defined( my $pid = fork ) or do { - warn "WARNING: can't fork to spawn child for ". $part_export->machine; - next; - }; - - if ( $pid ) { - $part_export->{'_radacct_kid'} = $pid; - warn "child $pid spawned for ". $part_export->machine; - } else { #kid time - - adminsuidsetup($user); #get our own db handle - - until ( sigint || sigterm ) { - $part_export->update_svc_acct(); - sleep 1; - } - - warn "child for ". $part_export->machine. " done"; - exit; - - } #eo kid - - } - - #reap up any kids that died... - &reap_kids; - - myshutdown() if sigterm() || sigint(); - - sleep 5; -} - -#-- - -sub myshutdown { - &reap_kids; - - #kill all the kids - kill 'TERM', $_ foreach grep $_, map $_->{'_radacct_kid'}, @part_export; - - my $wait = 12; #wait up to 1 minute - while ( ( grep $_->{'_radacct_kid'}, @part_export ) && $wait-- ) { - warn "waiting for children to terminate"; - sleep 5; - &reap_kids; - } - warn "abandoning children" if grep $_->{'_radacct_kid'}, @part_export; - die "exiting"; -} - -sub reap_kids { - #warn "reaping kids\n"; - foreach my $part_export ( grep $_->{'_radacct_kid'}, @part_export ) { - my $pid = $part_export->{'_radacct_kid'}; - my $kid = waitpid($pid, WNOHANG); - if ( $kid > 0 ) { - $part_export->{'_radacct_kid'} = ''; - } - } - #warn "done reaping\n"; -} - -sub usage { - die "Usage:\n\n freeside-sqlradius-radacctd user\n"; -} - -=head1 NAME - -freeside-sqlradius-radacctd - Real-time radacct import daemon - -=head1 SYNOPSIS - - freeside-sqlradius-radacctd username - -=head1 DESCRIPTION - -Imports records from an the SQL radacct tables of all sqlradius, -sqlradius_withdomain and radiator exports (except those with the -ignore_accounting flag) and updates the svc_acct.seconds for each account. -Runs as a daemon and updates the database in real-time. - -B<username> is a username added by freeside-adduser. - -=head1 RADIUS DATABASE CHANGES - -ALTER TABLE radacct ADD COLUMN FreesideStatus varchar(32) NULL; - -If you want to ignore the existing accountg records, also do: - -UPDATE radacct SET FreesideStatus = 'done' WHERE FreesideStatus IS NULL; - -=head1 SEE ALSO - -=cut - -1; - diff --git a/FS/bin/freeside-sqlradius-reset b/FS/bin/freeside-sqlradius-reset deleted file mode 100755 index 2ac5012..0000000 --- a/FS/bin/freeside-sqlradius-reset +++ /dev/null @@ -1,88 +0,0 @@ -#!/usr/bin/perl -w - -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 = (); -if ( @ARGV ) { - foreach my $exportnum ( @ARGV ) { - foreach my $exporttype (qw( sqlradius sqlradius_withdomain )) { - push @exports, qsearch('part_export', { exportnum => $exportnum, - exporttype => $exporttype, } ); - } - } - } else { - @exports = qsearch('part_export', { exporttype=>'sqlradius' } ); - push @exports, qsearch('part_export', { exporttype=>'sqlradius_withdomain' } ); -} - -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 ) { - - $svc_acct->check; #set any fixed usergroup so it'll export even if all - #svc_acct records don't have the group yet - - #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 freeside-sqlradius-reset user [ exportnum, ... ]\n"; -} - -=head1 NAME - -freeside-sqlradius-reset - Command line interface to reset and recreate RADIUS SQL tables - -=head1 SYNOPSIS - - freeside-sqlradius-reset username [ EXPORTNUM, ... ] - -=head1 DESCRIPTION - -Deletes the radcheck, radreply and usergroup tables and repopulates them from -the Freeside database, for the specified exports, or, if no exports are -specified, for all sqlradius and sqlradius_withdomain exports. - -B<username> is a username added by freeside-adduser. - -=head1 SEE ALSO - -L<freeside-reexport>, L<FS::part_export>, L<FS::part_export::sqlradius> - -=cut - - - diff --git a/FS/bin/freeside-sqlradius-seconds b/FS/bin/freeside-sqlradius-seconds deleted file mode 100644 index 1c978fa..0000000 --- a/FS/bin/freeside-sqlradius-seconds +++ /dev/null @@ -1,58 +0,0 @@ -#!/usr/bin/perl -Tw - -use strict; -use Date::Parse; -use FS::UID qw(adminsuidsetup); -use FS::Record qw(qsearchs); -use FS::svc_acct; - -my $fs_user = shift or die &usage; -adminsuidsetup( $fs_user ); - -my $target_user = shift or die &usage; -my $start = shift or die &usage; -$start = str2time($start); -my $stop = scalar(@ARGV) ? str2time(shift) : time; - -my $svc_acct = qsearchs( 'svc_acct', { 'username' => $target_user } ); -die "username $target_user not found\n" unless $svc_acct; - -print $svc_acct->seconds_since_sqlradacct( $start, $stop ). "\n"; - -sub usage { - die "Usage:\n\n freeside-sqlradius-seconds freeside_username target_username start_date stop_date\n"; -} - - -=head1 NAME - -freeside-sqlradius-seconds - Real-time radacct import daemon - -=head1 SYNOPSIS - - freeside-sqlradius-seconds freeside_username target_username start_date [ stop_date ] - -=head1 DESCRIPTION - -Returns the number of seconds the specified username has been online between -start_date (inclusive) and stop_date (exclusive). -See L<FS::svc_acct/seconds_since_sqlradacct> - -B<freeside_username> is a username added by freeside-adduser. -B<target_username> is the username of the user account to query. -B<start_date> and B<stop_date> are in any format Date::Parse is happy with. -B<stop_date> defaults to now if not specified. - -=head1 BUGS - -Selection of the account in question is rather simplistic in that -B<target_username> doesn't necessarily identify a unique account (and wouldn't -even if a domain was specified), and no sqlradius export is checked for. - -=head1 SEE ALSO - -L<FS::svc_acct/seconds_since_sqlradacct> - -=cut - -1; diff --git a/FS/bin/freeside-upgrade b/FS/bin/freeside-upgrade deleted file mode 100755 index a1212ae..0000000 --- a/FS/bin/freeside-upgrade +++ /dev/null @@ -1,49 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use vars qw($DEBUG $DRY_RUN); -use Term::ReadKey; -use DBIx::DBSchema 0.31; -use FS::UID qw(adminsuidsetup checkeuid datasrc ); #getsecrets); -use FS::CurrentUser; -use FS::Schema qw( dbdef dbdef_dist reload_dbdef ); - -$DEBUG = 1; - -die "Not running uid freeside!" unless checkeuid(); - -my $user = shift or die &usage; -$FS::CurrentUser::upgrade_hack = 1; -my $dbh = adminsuidsetup($user); - -#needs to match FS::Schema... -my $dbdef_file = "/usr/local/etc/freeside/dbdef.". datasrc; - -dbdef_create($dbh, $dbdef_file); - -delete $FS::Schema::dbdef_cache{$dbdef_file}; #force an actual reload -reload_dbdef($dbdef_file); - -$DBIx::DBSchema::DEBUG = $DEBUG; -$DBIx::DBSchema::Table::DEBUG = $DEBUG; -dbdef->update_schema( dbdef_dist, $dbh ); - -$dbh->commit or die $dbh->errstr; - -dbdef_create($dbh, $dbdef_file); - -$dbh->disconnect or die $dbh->errstr; - -### - -sub dbdef_create { # reverse engineer the schema from the DB and save to file - my( $dbh, $file ) = @_; - my $dbdef = new_native DBIx::DBSchema $dbh; - $dbdef->save($file); -} - -sub usage { - die "Usage:\n freeside-upgrade user\n"; -} - -1; diff --git a/FS/t/AccessRight.t b/FS/t/AccessRight.t deleted file mode 100644 index a966842..0000000 --- a/FS/t/AccessRight.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::AccessRight; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/CGI.t b/FS/t/CGI.t deleted file mode 100644 index 1b4e238..0000000 --- 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 973d8da..0000000 --- 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/ClientAPI_SessionCache.t b/FS/t/ClientAPI_SessionCache.t deleted file mode 100644 index 605803e..0000000 --- a/FS/t/ClientAPI_SessionCache.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::ClientAPI_SessionCache; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/Conf.t b/FS/t/Conf.t deleted file mode 100644 index a9f7653..0000000 --- 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/ConfDefaults.t b/FS/t/ConfDefaults.t deleted file mode 100644 index 433555a..0000000 --- a/FS/t/ConfDefaults.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::ConfDefaults; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/ConfItem.t b/FS/t/ConfItem.t deleted file mode 100644 index c7932d7..0000000 --- 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/Cron-backup.t b/FS/t/Cron-backup.t deleted file mode 100644 index 847d41a..0000000 --- a/FS/t/Cron-backup.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::Cron::backup; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/Cron-bill.t b/FS/t/Cron-bill.t deleted file mode 100644 index 42c7b4f..0000000 --- a/FS/t/Cron-bill.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::Cron::bill; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/Cron-vacuum.t b/FS/t/Cron-vacuum.t deleted file mode 100644 index eaa6b76..0000000 --- a/FS/t/Cron-vacuum.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::Cron::vacuum; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/Daemon.t b/FS/t/Daemon.t deleted file mode 100644 index 24893fd..0000000 --- a/FS/t/Daemon.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::Daemon; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/InitHandler.t b/FS/t/InitHandler.t deleted file mode 100644 index 0ce60c8..0000000 --- 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/Misc.t b/FS/t/Misc.t deleted file mode 100644 index cc7751a..0000000 --- a/FS/t/Misc.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::Misc; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/Msgcat.t b/FS/t/Msgcat.t deleted file mode 100644 index 29e71b3..0000000 --- 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 00de1ed..0000000 --- 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/Report-Table-Monthly.t b/FS/t/Report-Table-Monthly.t deleted file mode 100644 index 6ff365d..0000000 --- a/FS/t/Report-Table-Monthly.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::Report::Table::Monthly; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/Report-Table.t b/FS/t/Report-Table.t deleted file mode 100644 index 866d498..0000000 --- a/FS/t/Report-Table.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::Report::Table; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/Report.t b/FS/t/Report.t deleted file mode 100644 index 76d6ea4..0000000 --- a/FS/t/Report.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::Report; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/SearchCache.t b/FS/t/SearchCache.t deleted file mode 100644 index 3c26f35..0000000 --- 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 9f7da4e..0000000 --- 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/access_group.t b/FS/t/access_group.t deleted file mode 100644 index be14109..0000000 --- a/FS/t/access_group.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::access_group; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/access_groupagent.t b/FS/t/access_groupagent.t deleted file mode 100644 index aff1f25..0000000 --- a/FS/t/access_groupagent.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::access_groupagent; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/access_right.t b/FS/t/access_right.t deleted file mode 100644 index 66cd362..0000000 --- a/FS/t/access_right.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::access_right; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/access_user.t b/FS/t/access_user.t deleted file mode 100644 index cab679d..0000000 --- a/FS/t/access_user.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::access_user; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/access_user_pref.t b/FS/t/access_user_pref.t deleted file mode 100644 index 2822098..0000000 --- a/FS/t/access_user_pref.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::access_user_pref; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/access_usergroup.t b/FS/t/access_usergroup.t deleted file mode 100644 index 383a7cf..0000000 --- a/FS/t/access_usergroup.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::access_usergroup; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/acct_snarf.t b/FS/t/acct_snarf.t deleted file mode 100644 index 642760f..0000000 --- a/FS/t/acct_snarf.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::acct_snarf; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/agent.t b/FS/t/agent.t deleted file mode 100644 index 769cce2..0000000 --- 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_payment_gateway.t b/FS/t/agent_payment_gateway.t deleted file mode 100644 index af78a9a..0000000 --- a/FS/t/agent_payment_gateway.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::agent_payment_gateway; -$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 99c66a1..0000000 --- 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/banned_pay.t b/FS/t/banned_pay.t deleted file mode 100644 index bef1ff2..0000000 --- a/FS/t/banned_pay.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::banned_pay; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/cancel_reason.t b/FS/t/cancel_reason.t deleted file mode 100644 index a5948f6..0000000 --- a/FS/t/cancel_reason.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::cancel_reason; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/cdr.t b/FS/t/cdr.t deleted file mode 100644 index 1d1f3eb..0000000 --- a/FS/t/cdr.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::cdr; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/cdr_calltype.t b/FS/t/cdr_calltype.t deleted file mode 100644 index d4e1394..0000000 --- a/FS/t/cdr_calltype.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::cdr_calltype; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/cdr_carrier.t b/FS/t/cdr_carrier.t deleted file mode 100644 index 1e21615..0000000 --- a/FS/t/cdr_carrier.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::cdr_carrier; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/cdr_type.t b/FS/t/cdr_type.t deleted file mode 100644 index 9dff15a..0000000 --- a/FS/t/cdr_type.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::cdr_type; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/cdr_upstream_rate.t b/FS/t/cdr_upstream_rate.t deleted file mode 100644 index f9458c5..0000000 --- a/FS/t/cdr_upstream_rate.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::cdr_upstream_rate; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/clientapi_session.t b/FS/t/clientapi_session.t deleted file mode 100644 index a6414c3..0000000 --- a/FS/t/clientapi_session.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::clientapi_session; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/clientapi_session_field.t b/FS/t/clientapi_session_field.t deleted file mode 100644 index a9d4fa9..0000000 --- a/FS/t/clientapi_session_field.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::clientapi_session_field; -$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 b43f08e..0000000 --- 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_ApplicationCommon.t b/FS/t/cust_bill_ApplicationCommon.t deleted file mode 100644 index fa03d34..0000000 --- a/FS/t/cust_bill_ApplicationCommon.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_ApplicationCommon; -$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 0e2ca3e..0000000 --- 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 001eed0..0000000 --- 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_pay_pkg.t b/FS/t/cust_bill_pay_pkg.t deleted file mode 100644 index b8fcddb..0000000 --- a/FS/t/cust_bill_pay_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_pay_pkg; -$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 0e45bdb..0000000 --- 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_bill_pkg_detail.t b/FS/t/cust_bill_pkg_detail.t deleted file mode 100644 index ea6e3d1..0000000 --- a/FS/t/cust_bill_pkg_detail.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_detail; -$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 cddf75c..0000000 --- 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 0ef54c3..0000000 --- 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_bill_pkg.t b/FS/t/cust_credit_bill_pkg.t deleted file mode 100644 index 4eb84c3..0000000 --- a/FS/t/cust_credit_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_credit_bill_pkg; -$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 6b2b599..0000000 --- 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 b0ffbdb..0000000 --- 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_Mixin.t b/FS/t/cust_main_Mixin.t deleted file mode 100644 index c8b9291..0000000 --- a/FS/t/cust_main_Mixin.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_Mixin; -$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 dd61199..0000000 --- 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 9661620..0000000 --- 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 f6d0b75..0000000 --- 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 02b572c..0000000 --- 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_pay_refund.t b/FS/t/cust_pay_refund.t deleted file mode 100644 index 85d6c23..0000000 --- a/FS/t/cust_pay_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_pay_refund; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/cust_pay_void.t b/FS/t/cust_pay_void.t deleted file mode 100644 index dca9bec..0000000 --- a/FS/t/cust_pay_void.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_void; -$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 c6a6860..0000000 --- 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 91583da..0000000 --- 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 267d731..0000000 --- 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 8af13e3..0000000 --- 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 8af13e3..0000000 --- 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/cust_tax_exempt_pkg.t b/FS/t/cust_tax_exempt_pkg.t deleted file mode 100644 index 099a0ce..0000000 --- a/FS/t/cust_tax_exempt_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_tax_exempt_pkg; -$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 794518c..0000000 --- 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 773c5de..0000000 --- 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/h_Common.t b/FS/t/h_Common.t deleted file mode 100644 index 174bb99..0000000 --- a/FS/t/h_Common.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::h_Common; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/h_cust_bill.t b/FS/t/h_cust_bill.t deleted file mode 100644 index ceccb2a..0000000 --- a/FS/t/h_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::h_cust_bill; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/h_cust_svc.t b/FS/t/h_cust_svc.t deleted file mode 100644 index a7dabbe..0000000 --- a/FS/t/h_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::h_cust_svc; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/h_cust_tax_exempt.t b/FS/t/h_cust_tax_exempt.t deleted file mode 100644 index 432238a..0000000 --- a/FS/t/h_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::h_cust_tax_exempt; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/h_domain_record.t b/FS/t/h_domain_record.t deleted file mode 100644 index f48e72e..0000000 --- a/FS/t/h_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::h_domain_record; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/h_svc_acct.t b/FS/t/h_svc_acct.t deleted file mode 100644 index 9c94d08..0000000 --- a/FS/t/h_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::h_svc_acct; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/h_svc_broadband.t b/FS/t/h_svc_broadband.t deleted file mode 100644 index b8e5c7c..0000000 --- a/FS/t/h_svc_broadband.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::h_svc_broadband; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/h_svc_domain.t b/FS/t/h_svc_domain.t deleted file mode 100644 index 87d2a09..0000000 --- a/FS/t/h_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::h_svc_domain; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/h_svc_external.t b/FS/t/h_svc_external.t deleted file mode 100644 index 5248f87..0000000 --- a/FS/t/h_svc_external.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::h_svc_external; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/h_svc_forward.t b/FS/t/h_svc_forward.t deleted file mode 100644 index 64731d5..0000000 --- a/FS/t/h_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::h_svc_forward; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/h_svc_www.t b/FS/t/h_svc_www.t deleted file mode 100644 index 07558ce..0000000 --- a/FS/t/h_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::h_svc_www; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/inventory_class.t b/FS/t/inventory_class.t deleted file mode 100644 index 80b2fa2..0000000 --- a/FS/t/inventory_class.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::inventory_class; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/inventory_item.t b/FS/t/inventory_item.t deleted file mode 100644 index 8ce9d67..0000000 --- a/FS/t/inventory_item.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::inventory_item; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/msgcat.t b/FS/t/msgcat.t deleted file mode 100644 index c38c639..0000000 --- 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 6f8ae36..0000000 --- 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/option_Common.t b/FS/t/option_Common.t deleted file mode 100644 index ad26141..0000000 --- a/FS/t/option_Common.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::option_Common; -$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 5626a9f..0000000 --- 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-acct_sql.t b/FS/t/part_export-acct_sql.t deleted file mode 100644 index 9eed472..0000000 --- a/FS/t/part_export-acct_sql.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::acct_sql; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_export-apache.t b/FS/t/part_export-apache.t deleted file mode 100644 index b999508..0000000 --- a/FS/t/part_export-apache.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::apache; -$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 d0c96be..0000000 --- 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 c6a0386..0000000 --- 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 eaf417a..0000000 --- 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-communigate_pro.t b/FS/t/part_export-communigate_pro.t deleted file mode 100644 index 88b8b64..0000000 --- a/FS/t/part_export-communigate_pro.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::communigate_pro; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_export-communigate_pro_singledomain.t b/FS/t/part_export-communigate_pro_singledomain.t deleted file mode 100644 index 6f8a64e..0000000 --- a/FS/t/part_export-communigate_pro_singledomain.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::communigate_pro_singledomain; -$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 bbefa6c..0000000 --- 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 e0b3f35..0000000 --- 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-domain_shellcommands.t b/FS/t/part_export-domain_shellcommands.t deleted file mode 100644 index a2a44fb..0000000 --- a/FS/t/part_export-domain_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::domain_shellcommands; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_export-forward_shellcommands.t b/FS/t/part_export-forward_shellcommands.t deleted file mode 100644 index 78ca68d..0000000 --- a/FS/t/part_export-forward_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::forward_shellcommands; -$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 ea41b93..0000000 --- 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 1b33418..0000000 --- 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-ldap.t b/FS/t/part_export-ldap.t deleted file mode 100644 index 826c341..0000000 --- a/FS/t/part_export-ldap.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::ldap; -$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 055cdce..0000000 --- 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-passwdfile.t b/FS/t/part_export-passwdfile.t deleted file mode 100644 index 0f18f30..0000000 --- a/FS/t/part_export-passwdfile.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::passwdfile; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_export-postfix.t b/FS/t/part_export-postfix.t deleted file mode 100644 index 9518caa..0000000 --- a/FS/t/part_export-postfix.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::postfix; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_export-radiator.t b/FS/t/part_export-radiator.t deleted file mode 100644 index 546e9de..0000000 --- a/FS/t/part_export-radiator.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::radiator; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_export-router.t b/FS/t/part_export-router.t deleted file mode 100644 index 54e4b63..0000000 --- a/FS/t/part_export-router.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::router; -$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 7bb47d3..0000000 --- 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 c0bd1bb..0000000 --- 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 b048a75..0000000 --- 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 5fb23a5..0000000 --- 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-sqlradius_withdomain.t b/FS/t/part_export-sqlradius_withdomain.t deleted file mode 100644 index 504bf67..0000000 --- a/FS/t/part_export-sqlradius_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::sqlradius_withdomain; -$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 7fc24ac..0000000 --- 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 d8a48a0..0000000 --- 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 2e37114..0000000 --- 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 2ea79cf..0000000 --- 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 26b3987..0000000 --- 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 13200c2..0000000 --- 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-flat.t b/FS/t/part_pkg-flat.t deleted file mode 100644 index 3eee7a7..0000000 --- a/FS/t/part_pkg-flat.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::flat; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_pkg-flat_comission.t b/FS/t/part_pkg-flat_comission.t deleted file mode 100644 index fefa57e..0000000 --- a/FS/t/part_pkg-flat_comission.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::flat_comission; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_pkg-flat_comission_cust.t b/FS/t/part_pkg-flat_comission_cust.t deleted file mode 100644 index 05d3ac4..0000000 --- a/FS/t/part_pkg-flat_comission_cust.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::flat_comission_cust; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_pkg-flat_comission_pkg.t b/FS/t/part_pkg-flat_comission_pkg.t deleted file mode 100644 index 851b58d..0000000 --- a/FS/t/part_pkg-flat_comission_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::flat_comission_pkg; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_pkg-flat_delayed.t b/FS/t/part_pkg-flat_delayed.t deleted file mode 100644 index ed63846..0000000 --- a/FS/t/part_pkg-flat_delayed.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::flat_delayed; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_pkg-prorate.t b/FS/t/part_pkg-prorate.t deleted file mode 100644 index d32b1c0..0000000 --- a/FS/t/part_pkg-prorate.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::prorate; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_pkg-sesmon_hour.t b/FS/t/part_pkg-sesmon_hour.t deleted file mode 100644 index 4f02cfc..0000000 --- a/FS/t/part_pkg-sesmon_hour.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::sesmon_hour; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_pkg-sesmon_minute.t b/FS/t/part_pkg-sesmon_minute.t deleted file mode 100644 index 6ceaa3c..0000000 --- a/FS/t/part_pkg-sesmon_minute.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::sesmon_minute; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_pkg-sql_external.t b/FS/t/part_pkg-sql_external.t deleted file mode 100644 index 366ed01..0000000 --- a/FS/t/part_pkg-sql_external.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::sql_external; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_pkg-sql_generic.t b/FS/t/part_pkg-sql_generic.t deleted file mode 100644 index 299a7c6..0000000 --- a/FS/t/part_pkg-sql_generic.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::sql_generic; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_pkg-sqlradacct_hour.t b/FS/t/part_pkg-sqlradacct_hour.t deleted file mode 100644 index 2a4ed79..0000000 --- a/FS/t/part_pkg-sqlradacct_hour.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::sqlradacct_hour; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_pkg-subscription.t b/FS/t/part_pkg-subscription.t deleted file mode 100644 index 10b4479..0000000 --- a/FS/t/part_pkg-subscription.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::subscription; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_pkg-voip_cdr.t b/FS/t/part_pkg-voip_cdr.t deleted file mode 100644 index 2d988a3..0000000 --- a/FS/t/part_pkg-voip_cdr.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::voip_cdr; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_pkg-voip_sqlradacct.t b/FS/t/part_pkg-voip_sqlradacct.t deleted file mode 100644 index 8d54204..0000000 --- a/FS/t/part_pkg-voip_sqlradacct.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::voip_sqlradacct; -$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 fd96073..0000000 --- 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_pkg_option.t b/FS/t/part_pkg_option.t deleted file mode 100644 index 6239b2d..0000000 --- a/FS/t/part_pkg_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_pkg_option; -$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 4e4ad17..0000000 --- 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 d20b979..0000000 --- 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 bdb2a7a..0000000 --- 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 467025c..0000000 --- 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/pay_batch.t b/FS/t/pay_batch.t deleted file mode 100644 index c43133d..0000000 --- a/FS/t/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::pay_batch; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/payby.t b/FS/t/payby.t deleted file mode 100644 index 7430bc8..0000000 --- a/FS/t/payby.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::payby; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/payment_gateway.t b/FS/t/payment_gateway.t deleted file mode 100644 index 4bcc781..0000000 --- a/FS/t/payment_gateway.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::payment_gateway; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/payment_gateway_option.t b/FS/t/payment_gateway_option.t deleted file mode 100644 index 19e6451..0000000 --- a/FS/t/payment_gateway_option.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::payment_gateway_option; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/pkg_class.t b/FS/t/pkg_class.t deleted file mode 100644 index fb3774f..0000000 --- a/FS/t/pkg_class.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::pkg_class; -$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 77d3429..0000000 --- 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 46377aa..0000000 --- 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 e7626bd..0000000 --- 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 43e3373..0000000 --- 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 cf3f91d..0000000 --- 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 8eaa2cd..0000000 --- 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 ac28d07..0000000 --- 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 325742c..0000000 --- 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/rate.t b/FS/t/rate.t deleted file mode 100644 index ae9c8bb..0000000 --- a/FS/t/rate.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::rate; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/rate_detail.t b/FS/t/rate_detail.t deleted file mode 100644 index 163972e..0000000 --- a/FS/t/rate_detail.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::rate_detail; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/rate_prefix.t b/FS/t/rate_prefix.t deleted file mode 100644 index d4bd513..0000000 --- a/FS/t/rate_prefix.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::rate_prefix; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/rate_region.t b/FS/t/rate_region.t deleted file mode 100644 index 6e0db8f..0000000 --- a/FS/t/rate_region.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::rate_region; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/reg_code.t b/FS/t/reg_code.t deleted file mode 100644 index 4b95990..0000000 --- a/FS/t/reg_code.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::reg_code; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/reg_code_pkg.t b/FS/t/reg_code_pkg.t deleted file mode 100644 index 7f89ffa..0000000 --- a/FS/t/reg_code_pkg.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::reg_code_pkg; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/session.t b/FS/t/session.t deleted file mode 100644 index c4b714e..0000000 --- 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 ed49e1e..0000000 --- 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 9ca78c9..0000000 --- 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 e612c40..0000000 --- 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_broadband.t b/FS/t/svc_broadband.t deleted file mode 100644 index 02dc112..0000000 --- a/FS/t/svc_broadband.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::svc_broadband; -$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 4d91898..0000000 --- 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_external.t b/FS/t/svc_external.t deleted file mode 100644 index 20a6767..0000000 --- a/FS/t/svc_external.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::svc_external; -$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 d653d34..0000000 --- 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_phone.t b/FS/t/svc_phone.t deleted file mode 100644 index 15b9ca2..0000000 --- a/FS/t/svc_phone.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::svc_phone; -$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 eb4e83f..0000000 --- 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 9840180..0000000 --- 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"; |