diff options
Diffstat (limited to 'FS')
228 files changed, 15134 insertions, 4643 deletions
@@ -3,7 +3,7 @@ package FS; use strict; use vars qw($VERSION); -$VERSION = '%%%VERSION%%%'; +$VERSION = '3.0git'; #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 @@ -95,6 +95,8 @@ L<FS::access_usergroup> - Employee group membership L<FS::access_groupagent> - Group reseller access +L<FS::access_groupsales> - Group sales access + L<FS::access_right> - Access rights L<FS::svc_acct_pop> - POP (Point of Presence, not Post @@ -212,6 +214,8 @@ L<FS::inventory_item> - Inventory items L<FS::part_svc> - Service definition class +L<FS::part_svc_class> - Service class class + L<FS::part_svc_column> - Column constraint class L<FS::export_svc> - Class linking service definitions (see L<FS::part_svc>) @@ -262,8 +266,12 @@ L<FS::rate_tier_details> - Rater tier details for call billing L<FS::usage_class> - Usage class class +L<FS::sales> - Sales person class + L<FS::agent> - Agent (reseller) class +L<FS::agent_pkg_class> - Agent (reseller) package class commission 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>) @@ -276,6 +284,10 @@ L<FS::agent_payment_gateway> - Agent payment gateway class L<FS::cust_svc> - Service class +L<FS::part_export_machine> - Export hostname choice class + +L<FS::svc_export_machine> - Customer export hostname class + L<FS::cust_pkg> - Customer package class L<FS::cust_pkg_option> - Customer package option class @@ -546,11 +558,35 @@ Commercial support is available; see =head1 AUTHORS -Primarily Ivan Kohler, with help from many kind folks, including core -contributors Jeff Finucane, Kristian Hoffman, Jason Hall and Peter Bowen. +=head2 CORE TEAM + +Jeremy Davis + +Ivan Kohler + +Mark Wells + +=head2 CORE EMERITUS + +Peter Bowen + +Jeff Finucane + +Jason Hall + +Kristian Hoffman + +Erik Levinson + +Brian McCane + +Richard Siddall + +Matt Simerson + +=head2 CONTRIBUTORS -See the CREDITS file in the Freeside distribution for a (hopefully) complete -list and the individal files for details. +See httemplate/docs/credits.html =head1 SEE ALSO diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm index d2417f069..b38c2671d 100644 --- a/FS/FS/AccessRight.pm +++ b/FS/FS/AccessRight.pm @@ -98,6 +98,7 @@ tie my %rights, 'Tie::IxHash', #'New contact', #'View customer contacts', #'List contacts', + 'Generate quotation', ], ### @@ -111,9 +112,12 @@ tie my %rights, 'Tie::IxHash', 'Edit customer tags', 'Edit referring customer', 'View customer history', + 'Suspend customer', + 'Unsuspend customer', 'Cancel customer', 'Complimentary customer', #aka users-allow_comp 'Merge customer', + 'Merge customer across agents', { rightname=>'Delete customer', desc=>"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 customer's packages if they cancel service." }, #aka. deletecustomers 'Bill customer now', #NEW 'Bulk send customer notices', #NEW @@ -138,6 +142,7 @@ tie my %rights, 'Tie::IxHash', 'Unsuspend customer package', 'Cancel customer package immediately', 'Cancel customer package later', + 'Un-cancel customer package', 'Delay suspension events', 'Add on-the-fly cancel reason', #NEW 'Add on-the-fly suspend reason', #NEW @@ -173,7 +178,9 @@ tie my %rights, 'Tie::IxHash', 'Customer invoice / financial info rights' => [ 'View invoices', 'Resend invoices', #NEWNEW - 'Delete invoices', #new, but no need to phase in + 'Void invoices', + 'Unvoid invoices', + 'Delete invoices', 'View customer tax exemptions', #yow 'Add customer tax adjustment', #new, but no need to phase in 'View customer batched payments', #NEW @@ -188,6 +195,7 @@ tie my %rights, 'Tie::IxHash', 'Customer payment rights' => [ 'View payments', { rightname=>'Post payment', desc=>'Make check or cash payments.' }, + { rightname=>'Backdate payment', desc=>'Enable payments to be posted for days other than today.' }, 'Post check payment', 'Post cash payment', 'Post payment batch', @@ -222,11 +230,11 @@ tie my %rights, 'Tie::IxHash', ### # customer voiding rights.. ### - 'Customer void rights' => [ + 'Customer payment void rights' => [ { rightname=>'Credit card void', desc=>'Enable local-only voiding of echeck payments in addition to refunds against the payment gateway.' }, #aka. cc-void { rightname=>'Echeck void', desc=>'Enable local-only voiding of echeck payments in addition to refunds against the payment gateway.' }, #aka. echeck-void - 'Regular void', - { rightname=>'Unvoid', desc=>'Enable unvoiding of voided payments' }, #aka. unvoid + 'Void payments', + { rightname=>'Unvoid payments', desc=>'Enable unvoiding of voided payments' }, #aka. unvoid ], @@ -254,7 +262,9 @@ tie my %rights, 'Tie::IxHash', 'Reporting/listing rights' => [ 'List customers', 'List all customers', + 'Advanced customer search', 'List zip codes', #NEW + 'List quotations', 'List invoices', 'List packages', 'Summarize packages', @@ -269,6 +279,27 @@ tie my %rights, 'Tie::IxHash', { rightname=>'View email logs', global=>1 }, 'Download report data', + 'Services: Accounts', + 'Services: Accounts: Advanced search', + 'Services: Domains', + 'Services: Certificates', + 'Services: Mail forwards', + 'Services: Virtual hosting services', + 'Services: Wireless broadband services', + 'Services: Wireless broadband services: Advanced search', + 'Services: DSLs', + 'Services: Dish services', + 'Services: Hardware', + 'Services: Hardware: Advanced search', + 'Services: Phone numbers', + 'Services: PBXs', + 'Services: Ports', + 'Services: Mailing lists', + 'Services: External services', + 'Usage: RADIUS sessions', + 'Usage: Call Detail Records (CDRs)', + 'Usage: Unrateable CDRs', + 'Usage: Time worked', #{ rightname => 'List customers of all agents', global=>1 }, ], @@ -310,6 +341,8 @@ tie my %rights, 'Tie::IxHash', 'Edit billing events', { rightname=>'Edit global billing events', global=>1 }, + 'View templates', + { rightname=>'View global templates', global=>1 }, 'Edit templates', { rightname=>'Edit global templates', global=>1 }, @@ -367,6 +400,7 @@ sub default_superuser_rights { 'Delete refund', #? 'Edit customer package dates', 'Time queue', + 'Usage: Time worked', 'Redownload resolved batches', 'Raw SQL', 'Configuration download', @@ -375,6 +409,7 @@ sub default_superuser_rights { 'Edit usage', 'Credit card void', 'Echeck void', + 'Edit customer package dates', ); no warnings 'uninitialized'; diff --git a/FS/FS/ClientAPI/MasonComponent.pm b/FS/FS/ClientAPI/MasonComponent.pm index 37cf7ef20..c4094ffe0 100644 --- a/FS/FS/ClientAPI/MasonComponent.pm +++ b/FS/FS/ClientAPI/MasonComponent.pm @@ -26,6 +26,7 @@ my %allowed_comps = map { $_=>1 } qw( my %session_comps = map { $_=>1 } qw( /elements/location.html + /elements/tr-amount_fee.html /edit/cust_main/first_pkg/select-part_pkg.html ); @@ -36,11 +37,34 @@ my %session_callbacks = ( my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ) or return "unknown custnum $custnum"; my %args = @$argsref; - $args{object} = $cust_main; + $args{object} = $cust_main->bill_location; @$argsref = ( %args ); return ''; #no error }, + '/elements/tr-amount_fee.html' => sub { + my( $custnum, $argsref ) = @_; + + my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ) + or return "unknown custnum $custnum"; + + my $conf = new FS::Conf; + + my %args = @$argsref; + %args = ( + %args, + 'process-pkgpart' => + scalar($conf->config('selfservice_process-pkgpart', $cust_main->agentnum)), + 'process-display' => scalar($conf->config('selfservice_process-display')), + 'process-skip_first' => $conf->exists('selfservice_process-skip_first'), + 'num_payments' => scalar($cust_main->cust_pay), + 'surcharge_percentage' => scalar($conf->config('credit-card-surcharge-percentage')), + ); + @$argsref = ( %args ); + + return ''; #no error + }, + '/edit/cust_main/first_pkg/select-part_pkg.html' => sub { my( $custnum, $argsref ) = @_; my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ) diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm index 7bc3011d2..3f7c00432 100644 --- a/FS/FS/ClientAPI/MyAccount.pm +++ b/FS/FS/ClientAPI/MyAccount.pm @@ -14,6 +14,7 @@ use Business::CreditCard; use HTML::Entities; use Text::CSV_XS; use Spreadsheet::WriteExcel; +use OLE::Storage_Lite; use FS::UI::Web::small_custview qw(small_custview); #less doh use FS::UI::Web; use FS::UI::bytecount qw( display_bytecount ); @@ -38,6 +39,7 @@ use FS::cust_main; use FS::cust_bill; use FS::legacy_cust_bill; use FS::cust_main_county; +use FS::part_pkg; use FS::cust_pkg; use FS::payby; use FS::acct_rt_transaction; @@ -46,18 +48,17 @@ use FS::msg_template; $DEBUG = 0; $me = '[FS::ClientAPI::MyAccount]'; -use vars qw( @cust_main_editable_fields ); +use vars qw( @cust_main_editable_fields @location_editable_fields ); @cust_main_editable_fields = qw( - first last company address1 address2 city - county state zip country - daytime night fax mobile - ship_first ship_last ship_company ship_address1 ship_address2 ship_city - ship_state ship_zip ship_country - ship_daytime ship_night ship_fax ship_mobile + first last daytime night fax mobile locale payby payinfo payname paystart_month paystart_year payissue payip ss paytype paystate stateid stateid_state ); +@location_editable_fields = qw( + address1 address2 city county state zip country +); + BEGIN { #preload to reduce time customer_info takes if ( $FS::TicketSystem::system ) { @@ -115,7 +116,7 @@ sub skin_info { ( map { $_ => scalar( $conf->config($_, $agentnum) ) } qw( company_name date_format ) ), ( map { $_ => scalar( $conf->config("selfservice-$_", $agentnum ) ) } - qw( body_bgcolor box_bgcolor + qw( body_bgcolor box_bgcolor stripe1_bgcolor stripe2_bgcolor text_color link_color vlink_color hlink_color alink_color font title_color title_align title_size menu_bgcolor menu_fontsize ) @@ -381,10 +382,16 @@ sub customer_info { my $cust_main = qsearchs('cust_main', $search ) or return { 'error' => "unknown custnum $custnum" }; + $return{display_custnum} = $cust_main->display_custnum; + if ( $session->{'pkgnum'} ) { $return{balance} = $cust_main->balance_pkgnum( $session->{'pkgnum'} ); + #next_bill_date from cust_pkg? } else { $return{balance} = $cust_main->balance; + $return{next_bill_date} = $cust_main->next_bill_date; + $return{next_bill_date_pretty} = + time2str('%m/%d/%Y', $return{next_bill_date} ); } my @tickets = $cust_main->tickets; @@ -416,21 +423,45 @@ sub customer_info { }; } $cust_main->open_cust_bill; $return{open_invoices} = \@open; + + my $sql = 'SELECT MAX(_date) FROM cust_bill WHERE custnum = ?'; + my $sth = dbh->prepare($sql) or die dbh->errstr; + $sth->execute($custnum) or die $sth->errstr; + $return{'last_invoice_date'} = $sth->fetchrow_arrayref->[0]; + $return{'last_invoice_date_pretty'} = + time2str('%m/%d/%Y', $return{'last_invoice_date'} ); } + $return{countrydefault} = scalar($conf->config('countrydefault')); + $return{small_custview} = small_custview( $cust_main, - scalar($conf->config('countrydefault')), + $return{countrydefault}, ( $session->{'pkgnum'} ? 1 : 0 ), #nobalance ); $return{name} = $cust_main->first. ' '. $cust_main->get('last'); - $return{ship_name} = $cust_main->ship_first. ' '. $cust_main->get('ship_last'); + + $return{has_ship_address} = $cust_main->has_ship_address; + $return{status} = $cust_main->status; + $return{statuscolor} = $cust_main->statuscolor; for (@cust_main_editable_fields) { $return{$_} = $cust_main->get($_); } + for (@location_editable_fields) { + $return{$_} = $cust_main->bill_location->get($_); + $return{'ship_'.$_} = $cust_main->ship_location->get($_); + } + $return{has_ship_address} = $cust_main->has_ship_address; + # compatibility: some places in selfservice use this to determine + # if there's a ship address + if ( $return{has_ship_address} ) { + $return{ship_last} = $cust_main->last; + $return{ship_first} = $cust_main->first; + } + if ( $cust_main->payby =~ /^(CARD|DCRD)$/ ) { $return{payinfo} = $cust_main->paymask; @return{'month', 'year'} = $cust_main->paydate_monthyear; @@ -444,7 +475,7 @@ sub customer_info { if (scalar($conf->config('support_packages'))) { my @support_services = (); foreach ($cust_main->support_services) { - my $seconds = $_->svc_x->seconds; + my $seconds = $_->svc_x->seconds || 0; my $time_remaining = (($seconds < 0) ? '-' : '' ). int(abs($seconds)/3600)."h". sprintf("%02d",(abs($seconds)%3600)/60)."m"; @@ -485,8 +516,8 @@ sub customer_info { } - return { 'error' => '', - 'custnum' => $custnum, + return { 'error' => '', + 'custnum' => $custnum, %return, }; @@ -509,14 +540,17 @@ sub customer_info_short { my $cust_main = qsearchs('cust_main', $search ) or return { 'error' => "unknown custnum $custnum" }; + $return{display_custnum} = $cust_main->display_custnum; + + $return{countrydefault} = scalar($conf->config('countrydefault')); + $return{small_custview} = small_custview( $cust_main, - scalar($conf->config('countrydefault')), + $return{countrydefault}, 1, ##nobalance ); $return{name} = $cust_main->first. ' '. $cust_main->get('last'); - $return{ship_name} = $cust_main->ship_first. ' '. $cust_main->get('ship_last'); $return{payby} = $cust_main->payby; @@ -524,7 +558,12 @@ sub customer_info_short { for (@cust_main_editable_fields) { $return{$_} = $cust_main->get($_); } - + #maybe a little more expensive, but it should be cached by now + for (@location_editable_fields) { + $return{$_} = $cust_main->bill_location->get($_); + $return{'ship_'.$_} = $cust_main->ship_location->get($_); + } + if ( $cust_main->payby =~ /^(CARD|DCRD)$/ ) { $return{payinfo} = $cust_main->paymask; @return{'month', 'year'} = $cust_main->paydate_monthyear; @@ -558,6 +597,103 @@ sub customer_info_short { }; } +sub billing_history { + my $p = shift; + + my($context, $session, $custnum) = _custoragent_session_custnum($p); + return { 'error' => $session } if $context eq 'error'; + + return { 'error' => 'No customer' } unless $custnum; + + 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 %return = (); + + if ( $session->{'pkgnum'} ) { + #$return{balance} = $cust_main->balance_pkgnum( $session->{'pkgnum'} ); + #next_bill_date from cust_pkg? + return { 'error' => 'No history for package' }; + } + + $return{balance} = $cust_main->balance; + $return{next_bill_date} = $cust_main->next_bill_date; + $return{next_bill_date_pretty} = + time2str('%m/%d/%Y', $return{next_bill_date} ); + + my @history = (); + + my $conf = new FS::Conf; + + if ( $conf->exists('selfservice-billing_history-line_items') ) { + + foreach my $cust_bill ( $cust_main->cust_bill ) { + + push @history, { + 'type' => 'Line item', + 'description' => $_->desc. ( $_->sdate && $_->edate + ? ' '. time2str('%d-%b-%Y', $_->sdate). + ' To '. time2str('%d-%b-%Y', $_->edate) + : '' + ), + 'amount' => sprintf('%.2f', $_->setup + $_->recur ), + 'date' => $cust_bill->_date, + 'date_pretty' => time2str('%m/%d/%Y', $cust_bill->_date ), + } + foreach $cust_bill->cust_bill_pkg; + + } + + } else { + + push @history, { + 'type' => 'Invoice', + 'description' => 'Invoice #'. $_->display_invnum, + 'amount' => sprintf('%.2f', $_->charged ), + 'date' => $_->_date, + 'date_pretty' => time2str('%m/%d/%Y', $_->_date ), + } + foreach $cust_main->cust_bill; + + } + + push @history, { + 'type' => 'Payment', + 'description' => 'Payment', #XXX type + 'amount' => sprintf('%.2f', 0 - $_->paid ), + 'date' => $_->_date, + 'date_pretty' => time2str('%m/%d/%Y', $_->_date ), + } + foreach $cust_main->cust_pay; + + push @history, { + 'type' => 'Credit', + 'description' => 'Credit', #more info? + 'amount' => sprintf('%.2f', 0 -$_->amount ), + 'date' => $_->_date, + 'date_pretty' => time2str('%m/%d/%Y', $_->_date ), + } + foreach $cust_main->cust_credit; + + push @history, { + 'type' => 'Refund', + 'description' => 'Refund', #more info? type, like payment? + 'amount' => $_->refund, + 'date' => $_->_date, + 'date_pretty' => time2str('%m/%d/%Y', $_->_date ), + } + foreach $cust_main->cust_refund; + + @history = sort { $b->{'date'} <=> $a->{'date'} } @history; + + $return{'history'} = \@history; + + return \%return; + +} + sub edit_info { my $p = shift; my $session = _cache->get($p->{'session_id'}) @@ -570,9 +706,32 @@ sub edit_info { 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 ( exists($p->{address1}) ) { + my $bill_location = FS::cust_location->new({ + map { $_ => $p->{$_} } @location_editable_fields + }); + # if this is unchanged from before, cust_main::replace will ignore it + $new->set('bill_location' => $bill_location); + } + + if ( exists($p->{ship_address1}) ) { + my $ship_location = FS::cust_location->new({ + map { $_ => $p->{"ship_$_"} } @location_editable_fields + }); + if ( !grep { length($p->{"ship_$_"}) } @location_editable_fields ) { + # Selfservice unfortunately tries to indicate "same as billing + # address" by sending all fields empty. Did this ever work? + $ship_location = $cust_main->bill_location; + } + $new->set('ship_location' => $ship_location); + } + # but if it hasn't been passed in at all, leave ship_location alone-- + # DON'T change it to match bill_location. + my $payby = ''; if (exists($p->{'payby'})) { $p->{'payby'} =~ /^([A-Z]{4})$/ @@ -710,7 +869,8 @@ sub payment_info { $return{payname} = $cust_main->payname || ( $cust_main->first. ' '. $cust_main->get('last') ); - $return{$_} = $cust_main->get($_) for qw(address1 address2 city state zip); + $return{$_} = $cust_main->bill_location->get($_) + for qw(address1 address2 city state zip); $return{payby} = $cust_main->payby; $return{stateid_state} = $cust_main->stateid_state; @@ -729,7 +889,7 @@ sub payment_info { $return{payinfo2} = $payinfo2; $return{paytype} = $cust_main->paytype; $return{paystate} = $cust_main->paystate; - + $return{payname} = $cust_main->payname; # override 'first/last name' default from above, if any. Is instution-name here. (#15819) } if ( $conf->config('prepayment_discounts-credit_type') ) { @@ -766,6 +926,21 @@ sub validate_payment { my $amount = $1; return { error => 'Amount must be greater than 0' } unless $amount > 0; + #false laziness w/tr-amount_fee.html, but we don't want selfservice users + #changing the hidden form values + my $conf = new FS::Conf; + my $fee_display = $conf->config('selfservice_process-display') || 'add'; + my $fee_pkgpart = $conf->config('selfservice_process-pkgpart', $cust_main->agentnum); + my $fee_skip_first = $conf->exists('selfservice_process-skip_first'); + if ( $fee_display eq 'add' + and $fee_pkgpart + and ! $fee_skip_first || scalar($cust_main->cust_pay) + ) + { + my $fee_pkg = qsearchs('part_pkg', { pkgpart=>$fee_pkgpart } ); + $amount = sprintf('%.2f', $amount + $fee_pkg->option('setup_fee') ); + } + $p->{'discount_term'} =~ /^\s*(\d*)\s*$/ or return { 'error' => gettext('illegal_discount_term'). ': '. $p->{'discount_term'} }; my $discount_term = $1; @@ -852,6 +1027,8 @@ sub validate_payment { 'card_type' => $card_type, 'paydate' => $p->{'year'}. '-'. $p->{'month'}. '-01', 'paydate_pretty' => $p->{'month'}. ' / '. $p->{'year'}, + 'month' => $p->{'month'}, + 'year' => $p->{'year'}, 'payname' => $payname, 'paybatch' => $paybatch, #this doesn't actually do anything 'paycvv' => $paycvv, @@ -876,7 +1053,9 @@ sub store_payment { _cache->set( 'payment_'.$p->{'session_id'}, $validate, $timeout ); +{ map { $_=>$validate->{$_} } - qw( card_type paymask payname paydate_pretty amount ) + qw( card_type paymask payname paydate_pretty month year amount + address1 address2 city state zip country + ) }; } @@ -921,15 +1100,42 @@ sub do_process_payment { ); return { 'error' => $error } if $error; + #no error, so order the fee package if applicable... + my $conf = new FS::Conf; + my $fee_pkgpart = $conf->config('selfservice_process-pkgpart', $cust_main->agentnum); + my $fee_skip_first = $conf->exists('selfservice_process-skip_first'); + + if ( $fee_pkgpart and ! $fee_skip_first || scalar($cust_main->cust_pay) ) { + + my $cust_pkg = new FS::cust_pkg { 'pkgpart' => $fee_pkgpart }; + + $error = $cust_main->order_pkg( 'cust_pkg' => $cust_pkg ); + return { 'error' => "payment processed successfully, but error ordering fee: $error" } + if $error; + + #and generate an invoice for it now too + $error = $cust_main->bill( 'pkg_list' => [ $cust_pkg ] ); + return { 'error' => "payment processed and fee ordered sucessfully, but error billing fee: $error" } + if $error; + + } + $cust_main->apply_payments; if ( $validate->{'save'} ) { my $new = new FS::cust_main { $cust_main->hash }; if ($payby eq 'CARD' || $payby eq 'DCRD') { $new->set( $_ => $validate->{$_} ) - foreach qw( payname paystart_month paystart_year payissue payip - address1 address2 city state zip country ); + foreach qw( payname paystart_month paystart_year payissue payip ); $new->set( 'payby' => $validate->{'auto'} ? 'CARD' : 'DCRD' ); + + my $bill_location = FS::cust_location->new({ + map { $_ => $validate->{$_} } + qw(address1 address2 city state country zip) + }); # county? + $new->set('bill_location' => $bill_location); + # but don't allow the service address to change this way. + } elsif ($payby eq 'CHEK' || $payby eq 'DCHK') { $new->set( $_ => $validate->{$_} ) foreach qw( payname payip paytype paystate @@ -1375,6 +1581,7 @@ sub list_pkgs { my $primary_cust_svc = $_->primary_cust_svc; +{ $_->hash, $_->part_pkg->hash, + pkg_label => $_->pkg_label, status => $_->status, part_svc => [ map $_->hashref, $_->available_part_svc ], @@ -1467,12 +1674,14 @@ sub list_svcs { my $part_pkg = $cust_pkg->part_pkg; my %hash = ( - 'svcnum' => $_->svcnum, - 'svcdb' => $svcdb, - 'label' => $label, - 'value' => $value, - 'pkg_status' => $cust_pkg->status, - 'readonly' => ( $part_svc->selfservice_access eq 'readonly' ), + 'svcnum' => $_->svcnum, + 'display_svcnum' => $_->display_svcnum, + 'svcdb' => $svcdb, + 'label' => $label, + 'value' => $value, + 'pkg_label' => $cust_pkg->pkg_label, + 'pkg_status' => $cust_pkg->status, + 'readonly' => ($part_svc->selfservice_access eq 'readonly'), ); if ( $svcdb eq 'svc_acct' ) { @@ -1770,6 +1979,8 @@ sub list_support_usage { sub _list_cdr_usage { # XXX CDR type support... + # XXX any way to do a paged search on this? + # we have to return the results all at once... my($svc_phone, $begin, $end, %opt) = @_; map [ $_->downstream_csv(%opt, 'keeparray' => 1) ], $svc_phone->get_cdrs( 'begin'=>$begin, 'end'=>$end, ); diff --git a/FS/FS/ClientAPI/SGNG.pm b/FS/FS/ClientAPI/SGNG.pm deleted file mode 100644 index 7f784dcd0..000000000 --- a/FS/FS/ClientAPI/SGNG.pm +++ /dev/null @@ -1,277 +0,0 @@ -#this stuff is SG-specific (i.e. multi-customer company username hack) - -package FS::ClientAPI::SGNG; - -use strict; -use vars qw( $cache $DEBUG ); -use Time::Local qw(timelocal timelocal_nocheck); -use Business::CreditCard; -use FS::Record qw( qsearch qsearchs ); -use FS::Conf; -use FS::cust_main; -use FS::cust_pkg; -use FS::ClientAPI::MyAccount; #qw( payment_info process_payment ) - -$DEBUG = 0; - -sub _cache { - $cache ||= new FS::ClientAPI_SessionCache( { - 'namespace' => 'FS::ClientAPI::MyAccount', #yes, share session_ids - } ); -} - -sub ping { - #my $p = shift; - - return { 'pong' => '1' }; - -} - -#this might almost be general-purpose -sub decompify_pkgs { - 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" }; - - return { 'error' => 'Not a complimentary customer' } - unless $cust_main->payby eq 'COMP'; - - my $paydate = - $cust_main->paydate =~ /^\S+$/ ? $cust_main->paydate : '2037-12-31'; - - my ($payyear,$paymonth,$payday) = split (/-/,$paydate); - - my $date = timelocal(0,0,0,$payday,--$paymonth,$payyear); - - foreach my $cust_pkg ( - qsearch({ 'table' => 'cust_pkg', - 'hashref' => { 'custnum' => $custnum, - 'bill' => '', - }, - 'extra_sql' => ' AND '. FS::cust_pkg->active_sql, - }) - ) { - $cust_pkg->set('bill', $date); - my $error = $cust_pkg->replace; - return { 'error' => $error } if $error; - } - - return { 'error' => '' }; - -} - -#find old payment info -# (should work just like MyAccount::payment_info, except returns previous info -# too) -# definitly sg-specific, no one else stores past customer records like this -sub previous_payment_info { - my $p = shift; - - my $session = _cache->get($p->{'session_id'}) - or return { 'error' => "Can't resume session" }; #better error message - - my $payment_info = FS::ClientAPI::MyAccount::payment_info($p); - - my $custnum = $session->{'custnum'}; - - my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ) - or return { 'error' => "unknown custnum $custnum" }; - - #? - return $payment_info if $cust_main->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/; - - foreach my $prev_cust_main ( - reverse _previous_cust_main( 'custnum' => $custnum, - 'username' => $cust_main->company, - 'with_payments' => 1, - ) - ) { - - next unless $prev_cust_main->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/; - - if ( $prev_cust_main->payby =~ /^(CARD|DCRD)$/ ) { - - #card expired? - my ($payyear,$paymonth,$payday) = split (/-/, $cust_main->paydate); - - my $expdate = timelocal_nocheck(0,0,0,1,$paymonth,$payyear); - - next if $expdate < time; - - } elsif ( $prev_cust_main->payby =~ /^(CHEK|DCHK)$/ ) { - - #any check? or just skip these in favor of cards? - - } - - return { %$payment_info, - #$prev_cust_main->payment_info - _cust_main_payment_info( $prev_cust_main ), - 'previous_custnum' => $prev_cust_main->custnum, - }; - - } - - #still nothing? return an error? - return $payment_info; - -} - -#this is really FS::cust_main::payment_info, but here for now -sub _cust_main_payment_info { - my $self = shift; - - my %return = (); - - $return{balance} = $self->balance; - - $return{payname} = $self->payname - || ( $self->first. ' '. $self->get('last') ); - - $return{$_} = $self->get($_) for qw(address1 address2 city state zip); - - $return{payby} = $self->payby; - $return{stateid_state} = $self->stateid_state; - - if ( $self->payby =~ /^(CARD|DCRD)$/ ) { - $return{card_type} = cardtype($self->payinfo); - $return{payinfo} = $self->paymask; - - @return{'month', 'year'} = $self->paydate_monthyear; - - } - - if ( $self->payby =~ /^(CHEK|DCHK)$/ ) { - my ($payinfo1, $payinfo2) = split '@', $self->paymask; - $return{payinfo1} = $payinfo1; - $return{payinfo2} = $payinfo2; - $return{paytype} = $self->paytype; - $return{paystate} = $self->paystate; - - } - - #doubleclick protection - my $_date = time; - $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32; - - %return; - -} - -#find old cust_main records (with payments) -sub _previous_cust_main { - - #safety check! return nothing unless we're enabled explicitly - return () unless FS::Conf->new->exists('sg-multicustomer_hack'); - - my %opt = @_; - my $custnum = $opt{'custnum'}; - my $username = $opt{'username'}; - - my %search = (); - if ( $opt{'with_payments'} ) { - $search{'extra_sql'} = - ' AND 0 < ( SELECT COUNT(*) FROM cust_pay - WHERE cust_pay.custnum = cust_main.custnum - ) - '; - } - - qsearch( { - 'table' => 'cust_main', - 'hashref' => { 'company' => { op => 'ILIKE', value => $opt{'username'} }, - 'custnum' => { op => '!=', value => $opt{'custnum'} }, - }, - 'order_by' => 'ORDER BY custnum', - %search, - } ); - -} - -#since we could be passing masked old CC data, need to look that up and -#replace it (like regular process_payment does) w/info from old customer record -sub previous_process_payment { - my $p = shift; - - return FS::ClientAPI::MyAccount::process_payment($p) - unless $p->{'previous_custnum'} - && ( ( $p->{'payby'} =~ /^(CARD|DCRD)$/ && $p->{'payinfo'} =~ /x/i ) - || ( $p->{'payby'} =~ /^(CHEK|DCHK)$/ && $p->{'payinfo1'} =~ /x/i ) - ); - - 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" }; - - #make sure this is really a previous custnum of this customer - my @previous_cust_main = - grep { $_->custnum == $p->{'previous_custnum'} } - _previous_cust_main( 'custnum' => $custnum, - 'username' => $cust_main->company, - 'with_payments' => 1, - ); - - my $previous_cust_main = $previous_cust_main[0]; - - #causes problems with old data w/old masking method - #if $previous_cust_main->paymask eq $payinfo; - - if ( $p->{'payby'} =~ /^(CHEK|DCHK)$/ && $p->{'payinfo1'} =~ /x/i ) { - ( $p->{'payinfo1'}, $p->{'payinfo2'} ) = - split('@', $previous_cust_main->payinfo); - } elsif ( $p->{'payby'} =~ /^(CARD|DCRD)$/ && $p->{'payinfo'} =~ /x/i ) { - $p->{'payinfo'} = $previous_cust_main->payinfo; - } - - FS::ClientAPI::MyAccount::process_payment($p); - -} - -sub previous_payment_info_renew_info { - my $p = shift; - my $renew_info = renew_info($p); - my $payment_info = previous_payment_info($p); - return { %$renew_info, - %$payment_info, - }; -} - -sub previous_process_payment_order_pkg { - my $p = shift; - - my $hr = previous_process_payment($p); - return $hr if $hr->{'error'}; - - order_pkg($p); -} - -sub previous_process_payment_change_pkg { - my $p = shift; - - my $hr = previous_process_payment($p); - return $hr if $hr->{'error'}; - - change_pkg($p); -} - -sub previous_process_payment_order_renew { - my $p = shift; - - my $hr = previous_process_payment($p); - return $hr if $hr->{'error'}; - - order_renew($p); -} - -1; - diff --git a/FS/FS/ClientAPI/Signup.pm b/FS/FS/ClientAPI/Signup.pm index f17752a45..b7dcdbb64 100644 --- a/FS/FS/ClientAPI/Signup.pm +++ b/FS/FS/ClientAPI/Signup.pm @@ -405,8 +405,8 @@ sub signup_info { && $agent->agent_cust_main ) { my $cust_main = $agent->agent_cust_main; - my $prefix = length($cust_main->ship_last) ? 'ship_' : ''; - $signup_info_cache_agent->{"ship_$_"} = $cust_main->get("$prefix$_") + my $location = $cust_main->ship_location; + $signup_info_cache_agent->{"ship_$_"} = $location->get($_) foreach qw( address1 city county state zip country ); } @@ -509,6 +509,13 @@ sub new_customer { || $conf->config('signup_server-default_agentnum'); } + my ($bill_hash, $ship_hash); + foreach my $f (FS::cust_main->location_fields) { + # avoid having to change this in front-end code + $bill_hash->{$f} = $packet->{"bill_$f"} || $packet->{$f}; + $ship_hash->{$f} = $packet->{"ship_$f"}; + } + #shares some stuff with htdocs/edit/process/cust_main.cgi... take any # common that are still here and library them. my $template_custnum = $conf->config('signup_server-prepaid-template-custnum'); @@ -517,6 +524,7 @@ sub new_customer { my $template_cust = qsearchs('cust_main', { 'custnum' => $template_custnum } ); return { 'error' => 'Configuration error' } unless $template_cust; + #XXX Copy template customer's locations $cust_main = new FS::cust_main ( { 'agentnum' => $agentnum, 'refnum' => $packet->{refnum} @@ -556,41 +564,48 @@ sub new_customer { || $conf->config('signup_server-default_refnum'), map { $_ => $packet->{$_} } qw( - - last first ss company address1 address2 - city county state zip country + last first ss company daytime night fax stateid stateid_state - - 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 paystate paytype paystart_month paystart_year payissue payip override_ban_warn - referral_custnum comments - ) + ), } ); } + my $bill_location = FS::cust_location->new($bill_hash); + my $ship_location; my $agent = qsearchs('agent', { 'agentnum' => $agentnum } ); if ( $conf->exists('agent-ship_address', $agentnum) && $agent->agent_custnum ) { my $agent_cust_main = $agent->agent_cust_main; my $prefix = length($agent_cust_main->ship_last) ? 'ship_' : ''; - $cust_main->set("ship_$_", $agent_cust_main->get("$prefix$_") ) - foreach qw( address1 city county state zip country ); - - $cust_main->set("ship_$_", $cust_main->get($_)) - foreach qw( last first ); + $ship_location = FS::cust_location->new({ + $agent_cust_main->ship_location->location_hash + }); } + # we don't have an equivalent of the "same" checkbox in selfservice + # so is there a ship address, and if so, is it different from the billing + # address? + elsif ( length($ship_hash->{address1}) > 0 and + grep { $bill_hash->{$_} ne $ship_hash->{$_} } keys(%$ship_hash) + ) { + + $ship_location = FS::cust_location->new( $ship_hash ); + + } + else { + $ship_location = $bill_location; + } + $cust_main->set('bill_location' => $bill_location); + $cust_main->set('ship_location' => $ship_location); return { 'error' => "Illegal payment type" } unless grep { $_ eq $packet->{'payby'} } diff --git a/FS/FS/ClientAPI_XMLRPC.pm b/FS/FS/ClientAPI_XMLRPC.pm index 98e1910c3..7dd20c652 100644 --- a/FS/FS/ClientAPI_XMLRPC.pm +++ b/FS/FS/ClientAPI_XMLRPC.pm @@ -104,6 +104,7 @@ sub ss2clientapi { 'switch_acct' => 'MyAccount/switch_acct', 'customer_info' => 'MyAccount/customer_info', 'customer_info_short' => 'MyAccount/customer_info_short', + 'billing_history' => 'MyAccount/billing_history', 'edit_info' => 'MyAccount/edit_info', #add to ss cgi! 'invoice' => 'MyAccount/invoice', 'invoice_pdf' => 'MyAccount/invoice_pdf', @@ -176,22 +177,6 @@ sub ss2clientapi { 'call_time' => 'PrepaidPhone/call_time', 'call_time_nanpa' => 'PrepaidPhone/call_time_nanpa', 'phonenum_balance' => 'PrepaidPhone/phonenum_balance', - #izoom - #'bulk_processrow' => 'Bulk/processrow', - #conflicts w/Agentone# 'check_username' => 'Bulk/check_username', - #sg - 'ping' => 'SGNG/ping', - 'decompify_pkgs' => 'SGNG/decompify_pkgs', - 'previous_payment_info' => 'SGNG/previous_payment_info', - 'previous_payment_info_renew_info' - => 'SGNG/previous_payment_info_renew_info', - 'previous_process_payment' => 'SGNG/previous_process_payment', - 'previous_process_payment_order_pkg' - => 'SGNG/previous_process_payment_order_pkg', - 'previous_process_payment_change_pkg' - => 'SGNG/previous_process_payment_change_pkg', - 'previous_process_payment_order_renew' - => 'SGNG/previous_process_payment_order_renew', }; } diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 63fc8869c..43521ce19 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -13,6 +13,7 @@ use FS::payby; use FS::conf; use FS::Record qw(qsearch qsearchs); use FS::UID qw(dbh datasrc use_confcompat); +use FS::Misc::Invoicing qw( spool_formats ); use FS::Misc::Geo; $base_dir = '%%%FREESIDE_CONF%%%'; @@ -183,7 +184,7 @@ sub exists { my $self = shift; return $self->_usecompat('exists', @_) if use_confcompat; - my($name, $agentnum)=@_; + #my($name, $agentnum)=@_; carp "FS::Conf->exists(". join(', ', @_). ") called" if $DEBUG > 1; @@ -191,6 +192,54 @@ sub exists { defined($self->_config(@_)); } +#maybe this should just be the new exists instead of getting a method of its +#own, but i wanted to avoid possible fallout + +sub config_bool { + my $self = shift; + return $self->_usecompat('exists', @_) if use_confcompat; + + my($name,$agentnum,$agentonly) = @_; + + carp "FS::Conf->config_bool(". join(', ', @_). ") called" + if $DEBUG > 1; + + #defined($self->_config(@_)); + + #false laziness w/_config + my $hashref = { 'name' => $name }; + local $FS::Record::conf = undef; # XXX evil hack prevents recursion + my $cv; + my @a = ( + ($agentnum || ()), + ($agentonly && $agentnum ? () : '') + ); + my @l = ( + ($self->{locale} || ()), + ($self->{localeonly} && $self->{locale} ? () : '') + ); + # try with the agentnum first, then fall back to no agentnum if allowed + foreach my $a (@a) { + $hashref->{agentnum} = $a; + foreach my $l (@l) { + $hashref->{locale} = $l; + $cv = FS::Record::qsearchs('conf', $hashref); + if ( $cv ) { + if ( $cv->value eq '0' + && ($hashref->{agentnum} || $hashref->{locale} ) + ) + { + return 0; #an explicit false override, don't continue looking + } else { + return 1; + } + } + } + } + return 0; + +} + =item config_orbase KEY SUFFIX Returns the configuration value or values (depending on context) for @@ -269,8 +318,13 @@ sub touch { return $self->_usecompat('touch', @_) if use_confcompat; my($name, $agentnum) = @_; - unless ( $self->exists($name, $agentnum) ) { - $self->set($name, '', $agentnum); + #unless ( $self->exists($name, $agentnum) ) { + unless ( $self->config_bool($name, $agentnum) ) { + if ( $agentnum && $self->exists($name) && $self->config($name,$agentnum) eq '0' ) { + $self->delete($name, $agentnum); + } else { + $self->set($name, '', $agentnum); + } } } @@ -357,6 +411,31 @@ sub delete { } } +#maybe this should just be the new delete instead of getting a method of its +#own, but i wanted to avoid possible fallout + +sub delete_bool { + my $self = shift; + return $self->_usecompat('delete', @_) if use_confcompat; + + my($name, $agentnum) = @_; + + warn "[FS::Conf] DELETE $name\n" if $DEBUG; + + my $cv = FS::Record::qsearchs('conf', { name => $name, + agentnum => $agentnum, + locale => $self->{locale}, + }); + + if ( $cv ) { + my $error = $cv->delete; + die $error if $error; + } elsif ( $agentnum ) { + $self->set($name, '0', $agentnum); + } + +} + =item import_config_item CONFITEM DIR Imports the item specified by the CONFITEM (see L<FS::ConfItem>) into @@ -611,12 +690,6 @@ my %msg_template_options = ( 'per_agent' => 1, ); -my $_gateway_name = sub { - my $g = shift; - return '' if !$g; - ($g->gateway_username . '@' . $g->gateway_module); -}; - my %payment_gateway_options = ( 'type' => 'select-sub', 'options_sub' => sub { @@ -624,11 +697,24 @@ my %payment_gateway_options = ( 'table' => 'payment_gateway', 'hashref' => { 'disabled' => '' }, }); - map { $_->gatewaynum, $_gateway_name->($_) } @gateways; + map { $_->gatewaynum, $_->label } @gateways; }, 'option_sub' => sub { my $gateway = FS::payment_gateway->by_key(shift); - $_gateway_name->($gateway); + $gateway ? $gateway->label : '' + }, +); + +my %batch_gateway_options = ( + %payment_gateway_options, + 'options_sub' => sub { + my @gateways = qsearch('payment_gateway', + { + 'disabled' => '', + 'gateway_namespace' => 'Business::BatchPayment', + } + ); + map { $_->gatewaynum, $_->label } @gateways; }, ); @@ -753,6 +839,13 @@ sub reason_type_options { }, { + 'key' => 'cust_main-select-prorate_day', + 'section' => 'billing', + 'description' => 'When used with prorate or anniversary packages, allows the selection of the prorate day of month, on a per-customer basis', + 'type' => 'checkbox', + }, + + { 'key' => 'encryption', 'section' => 'billing', 'description' => 'Enable encryption of credit cards and echeck numbers', @@ -884,6 +977,13 @@ sub reason_type_options { }, { + 'key' => 'business-batchpayment-test_transaction', + 'section' => 'billing', + 'description' => 'Turns on the Business::BatchPayment test_mode flag. Note that not all gateway modules support this flag; if yours does not, using the batch gateway will fail.', + 'type' => 'checkbox', + }, + + { 'key' => 'countrydefault', 'section' => 'UI', 'description' => 'Default two-letter country code (if not supplied, the default is `US\')', @@ -1104,7 +1204,15 @@ sub reason_type_options { { 'key' => 'invoice_html', 'section' => 'invoicing', - 'description' => 'Optional HTML template for invoices. See the <a href="http://www.freeside.biz/mediawiki/index.php/Freeside:2.1:Documentation:Administration#HTML_invoice_templates">billing documentation</a> for details.', + 'description' => 'HTML template for invoices. See the <a href="http://www.freeside.biz/mediawiki/index.php/Freeside:2.1:Documentation:Administration#HTML_invoice_templates">billing documentation</a> for details.', + + 'type' => 'textarea', + }, + + { + 'key' => 'quotation_html', + 'section' => '', + 'description' => 'HTML template for quotations.', 'type' => 'textarea', }, @@ -1152,6 +1260,13 @@ sub reason_type_options { }, { + 'key' => 'quotation_latex', + 'section' => '', + 'description' => 'LaTeX template for typeset PostScript quotations.', + 'type' => 'textarea', + }, + + { 'key' => 'invoice_latextopmargin', 'section' => 'invoicing', 'description' => 'Optional LaTeX invoice topmargin setting. Include units.', @@ -1210,6 +1325,15 @@ and customer address. Include units.', }, { + 'key' => 'quotation_latexnotes', + 'section' => '', + 'description' => 'Notes section for LaTeX typeset PostScript quotations.', + 'type' => 'textarea', + 'per_agent' => 1, + 'per_locale' => 1, + }, + + { 'key' => 'invoice_latexfooter', 'section' => 'invoicing', 'description' => 'Footer for LaTeX typeset PostScript invoices.', @@ -1239,7 +1363,7 @@ and customer address. Include units.', { 'key' => 'invoice_latexextracouponspace', 'section' => 'invoicing', - 'description' => 'Optional LaTeX invoice textheight space to reserve for a tear off coupon. Include units.', + 'description' => 'Optional LaTeX invoice textheight space to reserve for a tear off coupon. Include units. Default is 3.6cm', 'type' => 'text', 'per_agent' => 1, 'validate' => sub { shift =~ @@ -1420,6 +1544,7 @@ and customer address. Include units.', 'description' => 'Send payment receipts.', 'type' => 'checkbox', 'per_agent' => 1, + 'agent_bool' => 1, }, { @@ -1846,6 +1971,13 @@ and customer address. Include units.', }, { + 'key' => 'unmask_ss', + 'section' => 'UI', + 'description' => "Don't mask social security numbers in the web interface.", + 'type' => 'checkbox', + }, + + { 'key' => 'show_stateid', 'section' => 'UI', 'description' => "Turns on display/collection of driver's license/state issued id numbers in the web interface. Sometimes required by electronic check (ACH) processors.", @@ -1853,6 +1985,14 @@ and customer address. Include units.', }, { + 'key' => 'national_id-country', + 'section' => 'UI', + 'description' => 'Track a national identification number, for specific countries.', + 'type' => 'select', + 'select_enum' => [ '', 'MY' ], + }, + + { 'key' => 'show_bankstate', 'section' => 'UI', 'description' => "Turns on display/collection of state for bank accounts in the web interface. Sometimes required by electronic check (ACH) processors.", @@ -2413,8 +2553,9 @@ and customer address. Include units.', { 'key' => 'manual_process-pkgpart', 'section' => 'billing', - 'description' => 'Package to add to each manual credit card and ACH payments entered from the backend. Enabling this option may be in violation of your merchant agreement(s), so please check them carefully before enabling this option.', + 'description' => 'Package to add to each manual credit card and ACH payment entered by employees from the backend. Enabling this option may be in violation of your merchant agreement(s), so please check it(/them) carefully before enabling this option.', 'type' => 'select-part_pkg', + 'per_agent' => 1, }, { @@ -2436,6 +2577,57 @@ and customer address. Include units.', }, { + 'key' => 'selfservice_process-pkgpart', + 'section' => 'billing', + 'description' => 'Package to add to each manual credit card and ACH payment entered by the customer themselves in the self-service interface. Enabling this option may be in violation of your merchant agreement(s), so please check it(/them) carefully before enabling this option.', + 'type' => 'select-part_pkg', + 'per_agent' => 1, + }, + + { + 'key' => 'selfservice_process-display', + 'section' => 'billing', + 'description' => 'When using selfservice_process-pkgpart, add the fee to the amount entered (default), or subtract the fee from the amount entered.', + 'type' => 'select', + 'select_hash' => [ + 'add' => 'Add fee to amount entered', + 'subtract' => 'Subtract fee from amount entered', + ], + }, + + { + 'key' => 'selfservice_process-skip_first', + 'section' => 'billing', + 'description' => "When using selfservice_process-pkgpart, omit the fee if it is the customer's first payment.", + 'type' => 'checkbox', + }, + +# { +# 'key' => 'auto_process-pkgpart', +# 'section' => 'billing', +# 'description' => 'Package to add to each automatic credit card and ACH payment processed by billing events. Enabling this option may be in violation of your merchant agreement(s), so please check them carefully before enabling this option.', +# 'type' => 'select-part_pkg', +# }, +# +## { +## 'key' => 'auto_process-display', +## 'section' => 'billing', +## 'description' => 'When using auto_process-pkgpart, add the fee to the amount entered (default), or subtract the fee from the amount entered.', +## 'type' => 'select', +## 'select_hash' => [ +## 'add' => 'Add fee to amount entered', +## 'subtract' => 'Subtract fee from amount entered', +## ], +## }, +# +# { +# 'key' => 'auto_process-skip_first', +# 'section' => 'billing', +# 'description' => "When using auto_process-pkgpart, omit the fee if it is the customer's first payment.", +# 'type' => 'checkbox', +# }, + + { 'key' => 'allow_negative_charges', 'section' => 'billing', 'description' => 'Allow negative charges. Normally not used unless importing data from a legacy system that requires this.', @@ -2955,7 +3147,7 @@ and customer address. Include units.', 'section' => 'invoicing', 'description' => 'Enable FTP of raw invoice data - format.', 'type' => 'select', - 'select_enum' => [ '', 'default', 'oneline', 'billco', ], + 'options' => [ spool_formats() ], }, { @@ -2991,7 +3183,7 @@ and customer address. Include units.', 'section' => 'invoicing', 'description' => 'Enable spooling of raw invoice data - format.', 'type' => 'select', - 'select_enum' => [ '', 'default', 'oneline', 'billco', ], + 'options' => [ spool_formats() ], }, { @@ -3002,6 +3194,32 @@ and customer address. Include units.', }, { + 'key' => 'bridgestone-batch_counter', + 'section' => '', + 'description' => 'Batch counter for spool files. Increments every time a spool file is uploaded.', + 'type' => 'text', + 'per_agent' => 1, + }, + + { + 'key' => 'bridgestone-prefix', + 'section' => '', + 'description' => 'Agent identifier for uploading to BABT printing service.', + 'type' => 'text', + 'per_agent' => 1, + }, + + { + 'key' => 'bridgestone-confirm_template', + 'section' => '', + 'description' => 'Confirmation email template for uploading to BABT service. Text::Template format, with variables "$zipfile" (name of the zipped file), "$seq" (sequence number), "$prefix" (user ID string), and "$rows" (number of records in the file). Should include Subject: and To: headers, separated from the rest of the message by a blank line.', + # this could use a true message template, but it's hard to see how that + # would make the world a better place + 'type' => 'textarea', + 'per_agent' => 1, + }, + + { 'key' => 'svc_acct-usage_suspend', 'section' => 'billing', 'description' => 'Suspends the package an account belongs to when svc_acct.seconds or a bytecount is decremented to 0 or below (accounts with an empty seconds and up|down|totalbytes value are ignored). Typically used in conjunction with prepaid packages and freeside-sqlradius-radacctd.', @@ -3052,6 +3270,16 @@ and customer address. Include units.', }, { + 'key' => 'cust_location-label_prefix', + 'section' => 'UI', + 'description' => 'Optional "site ID" to show in the location label', + 'type' => 'select', + 'select_hash' => [ '' => '', + 'CoStAg' => 'CoStAgXXXXX (country, state, agent name, locationnum)', + ], + }, + + { '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.', @@ -3075,7 +3303,7 @@ and customer address. Include units.', { 'key' => 'cust_pkg-show_fcc_voice_grade_equivalent', 'section' => 'UI', - 'description' => "Show a field on package definitions for assigning a DS0 equivalency number suitable for use on FCC form 477.", + 'description' => "Show fields on package definitions for FCC Form 477 classification", 'type' => 'checkbox', }, @@ -3212,7 +3440,7 @@ and customer address. Include units.', { 'key' => 'invoice-unitprice', 'section' => 'invoicing', - 'description' => 'Enable unit pricing on invoices.', + 'description' => 'Enable unit pricing on invoices and quantities on packages.', 'type' => 'checkbox', }, @@ -3241,7 +3469,7 @@ and customer address. Include units.', { 'key' => 'postal_invoice-recurring_only', 'section' => 'billing', - 'description' => 'The postal invoice fee is omitted on invoices without reucrring charges when this is set.', + 'description' => 'The postal invoice fee is omitted on invoices without recurring charges when this is set.', 'type' => 'checkbox', }, @@ -3280,6 +3508,47 @@ and customer address. Include units.', ] }, + { 'key' => 'batch-gateway-CARD', + 'section' => 'billing', + 'description' => 'Business::BatchPayment gateway for credit card batches.', + %batch_gateway_options, + }, + + { 'key' => 'batch-gateway-CHEK', + 'section' => 'billing', + 'description' => 'Business::BatchPayment gateway for check batches.', + %batch_gateway_options, + }, + + { + 'key' => 'batch-reconsider', + 'section' => 'billing', + 'description' => 'Allow imported batch results to change the status of payments from previous imports. Enable this only if your gateway is known to send both positive and negative results for the same batch.', + 'type' => 'checkbox', + }, + + { + 'key' => 'batch-auto_resolve_days', + 'section' => 'billing', + 'description' => 'Automatically resolve payment batches this many days after they were first downloaded.', + 'type' => 'text', + }, + + { + 'key' => 'batch-auto_resolve_status', + 'section' => 'billing', + 'description' => 'When automatically resolving payment batches, take this action for payments of unknown status.', + 'type' => 'select', + 'select_enum' => [ 'approve', 'decline' ], + }, + + { + 'key' => 'batch-errors_to', + 'section' => 'billing', + 'description' => 'Email errors when processing batches to this address. If unspecified, batch processing will stop immediately on error.', + 'type' => 'text', + }, + #lists could be auto-generated from pay_batch info { 'key' => 'batch-fixed_format-CARD', @@ -3446,7 +3715,21 @@ and customer address. Include units.', { 'key' => 'cust_main-enable_birthdate', 'section' => 'UI', - 'descritpion' => 'Enable tracking of a birth date with each customer record', + 'description' => 'Enable tracking of a birth date with each customer record', + 'type' => 'checkbox', + }, + + { + 'key' => 'cust_main-enable_spouse_birthdate', + 'section' => 'UI', + 'description' => 'Enable tracking of a spouse birth date with each customer record', + 'type' => 'checkbox', + }, + + { + 'key' => 'cust_main-enable_anniversary_date', + 'section' => 'UI', + 'description' => 'Enable tracking of an anniversary date with each customer record', 'type' => 'checkbox', }, @@ -3726,7 +4009,7 @@ and customer address. Include units.', { 'key' => 'disable_previous_balance', 'section' => 'invoicing', - 'description' => 'Disable inclusion of previous balance, payment, and credit lines on invoices', + 'description' => 'Disable inclusion of previous balance, payment, and credit lines on invoices.', 'type' => 'checkbox', 'per_agent' => 1, }, @@ -3753,6 +4036,13 @@ and customer address. Include units.', }, { + 'key' => 'previous_balance-show_on_statements', + 'section' => 'invoicing', + 'description' => 'Show previous invoices on statements, without itemized charges.', + 'type' => 'checkbox', + }, + + { 'key' => 'balance_due_below_line', 'section' => 'invoicing', 'description' => 'Place the balance due message below a line. Only meaningful when when invoice_sections is false.', @@ -3984,6 +4274,13 @@ and customer address. Include units.', }, { + 'key' => 'unsuspend_email_admin', + 'section' => '', + 'description' => 'Destination admin email address to enable unsuspension notices', + 'type' => 'text', + }, + + { 'key' => 'email_report-subject', 'section' => '', 'description' => 'Subject for reports emailed by freeside-fetch. Defaults to "Freeside report".', @@ -4033,6 +4330,22 @@ and customer address. Include units.', }, { + 'key' => 'selfservice-stripe1_bgcolor', + 'section' => 'self-service', + 'description' => 'HTML color for self-service interface lists (primary stripe), for example, #FFFFFF', + 'type' => 'text', + 'per_agent' => 1, + }, + + { + 'key' => 'selfservice-stripe2_bgcolor', + 'section' => 'self-service', + 'description' => 'HTML color for self-service interface lists (alternate stripe), for example, #DDDDDD', + 'type' => 'text', + 'per_agent' => 1, + }, + + { 'key' => 'selfservice-text_color', 'section' => 'self-service', 'description' => 'HTML text color for the self-service interface, for example, #000000', @@ -4393,34 +4706,6 @@ and customer address. Include units.', }, { - 'key' => 'sg-multicustomer_hack', - 'section' => '', - 'description' => "Don't use this.", - 'type' => 'checkbox', - }, - - { - 'key' => 'sg-ping_username', - 'section' => '', - 'description' => "Don't use this.", - 'type' => 'text', - }, - - { - 'key' => 'sg-ping_password', - 'section' => '', - 'description' => "Don't use this.", - 'type' => 'text', - }, - - { - 'key' => 'sg-login_username', - 'section' => '', - 'description' => "Don't use this.", - 'type' => 'text', - }, - - { 'key' => 'mc-outbound_packages', 'section' => '', 'description' => "Don't use this.", @@ -4525,6 +4810,13 @@ and customer address. Include units.', }, { + 'key' => 'tax-cust_exempt-groups-require_individual_nums', + 'section' => '', + 'description' => 'When using tax-cust_exempt-groups, require an individual tax exemption number for each exemption from different taxes.', + 'type' => 'checkbox', + }, + + { 'key' => 'cust_main-default_view', 'section' => 'UI', 'description' => 'Default customer view, for users who have not selected a default view in their preferences.', @@ -4572,14 +4864,14 @@ and customer address. Include units.', { 'key' => 'cust_main-edit_signupdate', 'section' => 'UI', - 'descritpion' => 'Enable manual editing of the signup date.', + 'description' => 'Enable manual editing of the signup date.', 'type' => 'checkbox', }, { 'key' => 'svc_acct-disable_access_number', 'section' => 'UI', - 'descritpion' => 'Disable access number selection.', + 'description' => 'Disable access number selection.', 'type' => 'checkbox', }, @@ -4682,6 +4974,13 @@ and customer address. Include units.', }, { + 'key' => 'cust_main-custom_content', + 'section' => 'UI', + 'description' => 'As an alternative to cust_main-custom_link (leave it blank), the contant to display on this customer page, one item per line. Available iems are: small_custview, birthdate, spouse_birthdate, svc_acct, svc_phone and svc_external.', + 'type' => 'textarea', + }, + + { 'key' => 'cust_main-custom_title', 'section' => 'UI', 'description' => 'Title for the "Custom" tab in the View Customer page.', @@ -4889,6 +5188,13 @@ and customer address. Include units.', }, 'option_sub' => sub { FS::Locales->description(shift) }, }, + + { + 'key' => 'cust_main-require_locale', + 'section' => 'UI', + 'description' => 'Require an explicit locale to be chosen for new customers.', + 'type' => 'checkbox', + }, { 'key' => 'translate-auto-insert', @@ -4941,6 +5247,44 @@ and customer address. Include units.', 'type' => 'select-agent', }, + { + 'key' => 'cust_class-tax_exempt', + 'section' => 'billing', + 'description' => 'Control the tax exemption flag per customer class rather than per indivual customer.', + 'type' => 'checkbox', + }, + + { + 'key' => 'selfservice-billing_history-line_items', + 'section' => 'self-service', + 'description' => 'Return line item billing detail for the self-service billing_history API call.', + 'type' => 'checkbox', + }, + + { + 'key' => 'logout-timeout', + 'section' => 'UI', + 'description' => 'If set, automatically log users out of the backoffice after this many minutes.', + 'type' => 'text', + }, + + { + 'key' => 'spreadsheet_format', + 'section' => 'UI', + 'description' => 'Default format for spreadsheet download.', + 'type' => 'select', + 'select_hash' => [ + 'XLS' => 'XLS (Excel 97/2000/XP)', + 'XLSX' => 'XLSX (Excel 2007+)', + ], + }, + + { + 'key' => 'agent-email_day', + 'section' => '', + 'description' => 'On this day of each month, agents with master customer records containing email addresses will be emailed a list of their customers and balances.', + 'type' => 'text', + }, { key => "apacheroot", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, { key => "apachemachine", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, diff --git a/FS/FS/Conf_compat17.pm b/FS/FS/Conf_compat17.pm index 6685935d3..2e4bb055f 100644 --- a/FS/FS/Conf_compat17.pm +++ b/FS/FS/Conf_compat17.pm @@ -2458,6 +2458,13 @@ httemplate/docs/config.html }, { + 'key' => 'unsuspend_email_admin', + 'section' => '', + 'description' => 'Destination admin email address to enable unsuspension notices', + 'type' => 'text', + }, + + { 'key' => 'email_report-subject', 'section' => '', 'description' => 'Subject for reports emailed by freeside-fetch. Defaults to "Freeside report".', diff --git a/FS/FS/Cron/agent_email.pm b/FS/FS/Cron/agent_email.pm new file mode 100644 index 000000000..992aa35a2 --- /dev/null +++ b/FS/FS/Cron/agent_email.pm @@ -0,0 +1,79 @@ +package FS::Cron::agent_email; +use base qw( Exporter ); + +use strict; +use vars qw( @EXPORT_OK $DEBUG ); +use Date::Simple qw(today); +use URI::Escape; +use FS::Mason qw( mason_interps ); +use FS::Conf; +use FS::Misc qw(send_email); +use FS::Record qw(qsearch);# qsearchs); +use FS::agent; + +@EXPORT_OK = qw ( agent_email ); +$DEBUG = 0; + +sub agent_email { + my %opt = @_; + + my $conf = new FS::Conf; + + my $day = $conf->config('agent-email_day') or return; + return unless $day == today->day; + + if ( 1 ) { #XXX if ( %%%RT_ENABLED%%% ) { + require RT; + RT::LoadConfig(); + RT::Init(); + RT::ConnectToDatabase(); + } + + my $from = $conf->config('invoice_from'); + + my $outbuf = '';; + my( $fs_interp, $rt_interp ) = mason_interps('standalone', 'outbuf'=>\$outbuf); + + my $comp = '/search/cust_main.html'; + my %args = ( + 'cust_fields' => 'Cust# | Cust. Status | Customer | Current Balance', + '_type' => 'html-print', + ); + my $query = join('&', map "$_=".uri_escape($args{$_}), keys %args ); + + my $extra_sql = $opt{a} ? " AND agentnum IN ( $opt{a} ) " : ''; + + foreach my $agent ( qsearch({ + 'table' => 'agent', + 'hashref' => { + 'disabled' => '', + 'agent_custnum' => { op=>'!=', value=>'' }, + }, + 'extra_sql' => $extra_sql, + }) + ) + { + + $FS::Mason::Request::QUERY_STRING = $query. '&agentnum='. $agent->agentnum; + $fs_interp->exec($comp); + + my @email = $agent->agent_cust_main->invoicing_list or next; + + warn "emailing ". join(',',@email). " for agent ". $agent->agent. "\n" + if $DEBUG; + send_email( + 'from' => $from, + 'to' => \@email, + 'subject' => 'Customer report', + 'body' => $outbuf, + 'content-type' => 'text/html', + #'content-encoding' + ); + + $outbuf = ''; + + } + +} + +1; diff --git a/FS/FS/Cron/bill.pm b/FS/FS/Cron/bill.pm index 8d1223b80..a9df376dc 100644 --- a/FS/FS/Cron/bill.pm +++ b/FS/FS/Cron/bill.pm @@ -200,15 +200,15 @@ sub bill_where { # select * from cust_main where my $where_pkg = <<"END"; EXISTS( - SELECT 1 FROM cust_pkg + SELECT 1 FROM cust_pkg LEFT JOIN part_pkg USING ( pkgpart ) WHERE cust_main.custnum = cust_pkg.custnum AND ( cancel IS NULL OR cancel = 0 ) - AND ( ( ( setup IS NULL OR setup = 0 ) + AND ( ( ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 ) AND ( start_date IS NULL OR start_date = 0 OR ( start_date IS NOT NULL AND start_date <= $^T ) ) ) - OR bill IS NULL OR bill <= $billtime + OR ( freq != '0' AND ( bill IS NULL OR bill <= $billtime ) ) OR ( expire IS NOT NULL AND expire <= $^T ) OR ( adjourn IS NOT NULL AND adjourn <= $^T ) OR ( resume IS NOT NULL AND resume <= $^T ) diff --git a/FS/FS/Cron/check.pm b/FS/FS/Cron/check.pm index 9d3ffbdbd..75247fbaf 100644 --- a/FS/FS/Cron/check.pm +++ b/FS/FS/Cron/check.pm @@ -16,7 +16,6 @@ use FS::cust_pay_pending; @ISA = qw( Exporter ); @EXPORT_OK = qw( check_queued check_selfservice check_apache check_bop_failures - check_sg check_sg_login check_sgng alert error_msg ); @@ -48,79 +47,6 @@ sub check_selfservice { return 1; } -sub check_sg { - my $conf = new FS::Conf; - #different trigger if they ever stop using multicustomer_hack ? - return 1 unless $conf->exists('sg-multicustomer_hack'); - - my $ua = new LWP::UserAgent; - $ua->agent("FreesideCronCheck/0.1 " . $ua->agent); - - my $USER = $conf->config('sg-ping_username'); - my $PASS = $conf->config('sg-ping_password'); - my $req = new HTTP::Request GET=>"https://$USER:$PASS\@localhost/sg/ping.cgi"; - my $res = $ua->request($req); - - return 1 if $res->is_success - && $res->content =~ /OK/ - && $res->content !~ /error/i; #doh, the error message includes "OK" - - $error_msg = $res->is_success ? $res->content : $res->status_line; - return 0; -} - -sub check_sg_login { - my $conf = new FS::Conf; - #different trigger if they ever stop using multicustomer_hack ? - return 1 unless $conf->exists('sg-multicustomer_hack'); - - my $ua = new LWP::UserAgent; - $ua->agent("FreesideCronCheck/0.1 " . $ua->agent); - - my $USER = $conf->config('sg-ping_username'); - my $PASS = $conf->config('sg-ping_password'); - my $USERNAME = $conf->config('sg-login_username'); - my $req = new HTTP::Request - GET=>"https://$USER:$PASS\@localhost/sg/start.cgi?". - 'username='. uri_escape($USERNAME); - my $res = $ua->request($req); - - return 1 if $res->is_success - && $res->content =~ /[\da-f]{32}/i #session_id - && $res->content !~ /error/i; - - $error_msg = $res->is_success ? $res->content : $res->status_line; - return 0; -} - -sub check_sgng { - my $conf = new FS::Conf; - #different trigger if they ever stop using multicustomer_hack ? - return 1 unless $conf->exists('sg-multicustomer_hack'); - - eval 'use RPC::XML; use RPC::XML::Client;'; - if ($@) { $error_msg = $@; return 0; }; - - my $cli = RPC::XML::Client->new('https://localhost/selfservice/xmlrpc.cgi'); - my $resp = $cli->send_request('FS.SelfService.XMLRPC.ping'); - - return 1 if ref($resp) - && ! $resp->is_fault - && ref($resp->value) - && $resp->value->{'pong'} == 1; - - #hua - $error_msg = ref($resp) - ? ( $resp->is_fault - ? $resp->string - : ( ref($resp->value) ? $resp->value->{'error'} - : $resp->value - ) - ) - : $resp; - return 0; -} - sub _check_fsproc { my $arg = shift; _check_pidfile( "freeside-$arg.pid" ); diff --git a/FS/FS/Cron/pay_batch.pm b/FS/FS/Cron/pay_batch.pm new file mode 100644 index 000000000..0ab37dd13 --- /dev/null +++ b/FS/FS/Cron/pay_batch.pm @@ -0,0 +1,129 @@ +package FS::Cron::pay_batch; + +use strict; +use vars qw( @ISA @EXPORT_OK $me $DEBUG ); +use Exporter; +use Date::Format; +use FS::UID qw(dbh); +use FS::Record qw( qsearch qsearchs ); +use FS::Conf; +use FS::queue; +use FS::agent; + +@ISA = qw( Exporter ); +@EXPORT_OK = qw ( batch_submit batch_receive ); +$DEBUG = 0; +$me = '[FS::Cron::pay_batch]'; + +#freeside-daily %opt: +# -v: enable debugging +# -l: debugging level +# -m: Experimental multi-process mode uses the job queue for multi-process and/or multi-machine billing. +# -r: Multi-process mode dry run option +# -a: Only process customers with the specified agentnum + +sub batch_submit { + my %opt = @_; + local $DEBUG = ($opt{l} || 1) if $opt{v}; + # if anything goes wrong, don't try to roll back previously submitted batches + local $FS::UID::AutoCommit = 1; + + my $dbh = dbh; + + warn "$me batch_submit\n" if $DEBUG; + my $conf = FS::Conf->new; + + # need to respect -a somehow, but for now none of this is per-agent + if ( $opt{a} ) { + warn "Payment batch processing skipped in per-agent mode.\n" if $DEBUG; + return; + } + my %gateways; + foreach my $payby ('CARD', 'CHEK') { + my $gatewaynum = $conf->config("batch-gateway-$payby"); + next if !$gatewaynum; + my $gateway = FS::payment_gateway->by_key($gatewaynum) + or die "payment_gateway '$gatewaynum' not found\n"; + + if ( $gateway->batch_processor->can('default_transport') ) { + + foreach my $pay_batch ( + qsearch('pay_batch', { status => 'O', payby => $payby }) + ) { + + warn "Exporting batch ".$pay_batch->batchnum."\n" if $DEBUG; + eval { $pay_batch->export_to_gateway( $gateway, debug => $DEBUG ); }; + + if ( $@ ) { + # warn the error and continue. rolling back the transaction once + # we've started sending batches is bad. + warn "error submitting batch ".$pay_batch->batchnum." to gateway '". + $gateway->label."\n$@\n"; + } + } + + } else { #can't(default_transport) + warn "Payment gateway '".$gateway->label. + "' doesn't support automatic transport; skipped.\n"; + } + } #$payby + + 1; +} + +sub batch_receive { + my %opt = @_; + local $DEBUG = ($opt{l} || 1) if $opt{v}; + local $FS::UID::AutoCommit = 0; + + my $dbh = dbh; + my $error; + + warn "$me batch_receive\n" if $DEBUG; + my $conf = FS::Conf->new; + + # need to respect -a somehow, but for now none of this is per-agent + if ( $opt{a} ) { + warn "Payment batch processing skipped in per-agent mode.\n" if $DEBUG; + return; + } + my %gateways; + foreach my $payby ('CARD', 'CHEK') { + my $gatewaynum = $conf->config("batch-gateway-$payby"); + next if !$gatewaynum; + # If the same gateway is selected for both paybys, only import it once + $gateways{$gatewaynum} = FS::payment_gateway->by_key($gatewaynum); + if ( !$gateways{$gatewaynum} ) { + $dbh->rollback; + die "batch-gateway-$payby gateway $gatewaynum not found\n"; + } + } + + foreach my $gateway (values %gateways) { + if ( $gateway->batch_processor->can('default_transport') ) { + warn "Importing results from '".$gateway->label."'\n" if $DEBUG; + $error = eval { + FS::pay_batch->import_from_gateway( gateway =>$gateway, debug => $DEBUG ) + } || $@; + if ( $error ) { + # this we can roll back + $dbh->rollback; + die "error receiving from gateway '".$gateway->label."':\n$error\n"; + } + } + # else we already warned about it above + } #$gateway + + # resolve batches if we can + foreach my $pay_batch (qsearch('pay_batch', { status => 'I' })) { + warn "Trying to resolve batch ".$pay_batch->batchnum."\n" if $DEBUG; + $error = $pay_batch->try_to_resolve; + if ( $error ) { + $dbh->rollback; + die "unable to resolve batch ".$pay_batch->batchnum.":\n$error\n"; + } + } + + $dbh->commit; +} +1; diff --git a/FS/FS/Cron/upload.pm b/FS/FS/Cron/upload.pm index dceead6b3..51e0d6868 100644 --- a/FS/FS/Cron/upload.pm +++ b/FS/FS/Cron/upload.pm @@ -9,6 +9,8 @@ use FS::Record qw( qsearch qsearchs ); use FS::Conf; use FS::queue; use FS::agent; +use FS::Misc qw( send_email ); #for bridgestone +use FS::ftp_target; use LWP::UserAgent; use HTTP::Request; use HTTP::Request::Common; @@ -39,42 +41,78 @@ sub upload { warn "$me upload called\n" if $DEBUG; - my $conf = new FS::Conf; - my @agent = grep { $conf->config( 'billco-username', $_->agentnum, 1 ) } - grep { $conf->config( 'billco-password', $_->agentnum, 1 ) } - qsearch( 'agent', {} ); + my @tasks; my $date = time2str('%Y%m%d%H%M%S', $^T); # more? - @agent = grep { $_ == $opt{'a'} } @agent if $opt{'a'}; + my $conf = new FS::Conf; + + my @agents = $opt{'a'} ? FS::agent->by_key($opt{'a'}) : qsearch('agent', {}); + + my %task = ( + 'date' => $date, + 'l' => $opt{'l'}, + 'm' => $opt{'m'}, + 'v' => $opt{'v'}, + ); + + my @agentnums = ('', map {$_->agentnum} @agents); + + foreach my $target (qsearch('ftp_target', {})) { + # We don't know here if it's spooled on a per-agent basis or not. + # (It could even be both, via different events.) So queue up an + # upload for each agent, plus one with null agentnum, and we'll + # upload as many files as we find. + foreach my $a (@agentnums) { + push @tasks, { + %task, + 'agentnum' => $a, + 'targetnum' => $target->targetnum, + 'handling' => $target->handling, + }; + } + } - foreach my $agent ( @agent ) { + # deprecated billco method + foreach (@agents) { + my $agentnum = $_->agentnum; + + if ( $conf->config( 'billco-username', $agentnum, 1 ) ) { + my $username = $conf->config('billco-username', $agentnum, 1); + my $password = $conf->config('billco-password', $agentnum, 1); + my $clicode = $conf->config('billco-clicode', $agentnum, 1); + my $url = $conf->config('billco-url', $agentnum); + push @tasks, { + %task, + 'agentnum' => $agentnum, + 'username' => $username, + 'password' => $password, + 'url' => $url, + 'clicode' => $clicode, + 'handling' => 'billco', + }; + } + } # foreach @agents - my $agentnum = $agent->agentnum; + foreach (@tasks) { + + my $agentnum = $_->{agentnum}; if ( $opt{'m'} ) { if ( $opt{'r'} ) { warn "DRY RUN: would add agent $agentnum for queued upload\n"; } else { - my $queue = new FS::queue { - 'job' => 'FS::Cron::upload::billco_upload', + 'job' => 'FS::Cron::upload::spool_upload', }; - my $error = $queue->insert( - 'agentnum' => $agentnum, - 'date' => $date, - 'l' => $opt{'l'} || '', - 'm' => $opt{'m'} || '', - 'v' => $opt{'v'} || '', - ); - + my $error = $queue->insert( %$_ ); } } else { - eval "&billco_upload( 'agentnum' => $agentnum, 'date' => $date );"; - warn "billco_upload failed: $@\n" + eval { spool_upload(%$_) }; + warn "spool_upload failed: $@\n" if $@; } @@ -83,26 +121,14 @@ sub upload { } -sub billco_upload { +sub spool_upload { my %opt = @_; - warn "$me billco_upload called\n" if $DEBUG; + warn "$me spool_upload called\n" if $DEBUG; my $conf = new FS::Conf; my $dir = '%%%FREESIDE_EXPORT%%%/export.'. $FS::UID::datasrc. '/cust_bill'; - my $agentnum = $opt{agentnum} or die "no agentnum provided\n"; - my $url = $conf->config( 'billco-url', $agentnum ) - or die "no url for agent $agentnum\n"; - $url =~ s/^\s+//; $url =~ s/\s+$//; - my $username = $conf->config( 'billco-username', $agentnum, 1 ) - or die "no username for agent $agentnum\n"; - my $password = $conf->config( 'billco-password', $agentnum, 1 ) - or die "no password for agent $agentnum\n"; - my $clicode = $conf->config( 'billco-clicode', $agentnum, 1 ); - #or die "no clicode for agent $agentnum\n"; - - die "no date provided\n" unless $opt{date}; - my $zipfile = "$dir/agentnum$agentnum-$opt{date}.zip"; + my $date = $opt{date} or die "no date provided\n"; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -115,86 +141,228 @@ sub billco_upload { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $agent = qsearchs( 'agent', { agentnum => $agentnum } ) - or die "no such agent: $agentnum"; - $agent->select_for_update; #mutex - - unless ( -f "$dir/agentnum$agentnum-header.csv" || - -f "$dir/agentnum$agentnum-detail.csv" ) - { - warn "$me neither $dir/agentnum$agentnum-header.csv nor ". - "$dir/agentnum$agentnum-detail.csv found\n" if $DEBUG; - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - return; + my $agentnum = $opt{agentnum}; + my $agent; + if ( $agentnum ) { + $agent = qsearchs( 'agent', { agentnum => $agentnum } ) + or die "no such agent: $agentnum"; + $agent->select_for_update; #mutex } - # a better way? - if ($opt{m}) { - my $sql = "SELECT count(*) FROM queue LEFT JOIN cust_main USING(custnum) ". - "WHERE queue.job='FS::cust_main::queued_bill' AND cust_main.agentnum = ?"; - my $sth = $dbh->prepare($sql) or die $dbh->errstr; - while (1) { - $sth->execute( $agentnum ) - or die "Unexpected error executing statement $sql: ". $sth->errstr; - last if $sth->fetchow_arrayref->[0]; - sleep 300; + if ( $opt{'handling'} eq 'billco' ) { + + my $file = "agentnum$agentnum"; + my $zipfile = "$dir/$file-$date.zip"; + + unless ( -f "$dir/$file-header.csv" || + -f "$dir/$file-detail.csv" ) + { + warn "$me neither $dir/$file-header.csv nor ". + "$dir/$file-detail.csv found\n" if $DEBUG > 1; + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + return; } - } - foreach ( qw ( header detail ) ) { - rename "$dir/agentnum$agentnum-$_.csv", - "$dir/agentnum$agentnum-$opt{date}-$_.csv"; - } + my $url = $opt{url} or die "no url for agent $agentnum\n"; + $url =~ s/^\s+//; $url =~ s/\s+$//; + + my $username = $opt{username} or die "no username for agent $agentnum\n"; + my $password = $opt{password} or die "no password for agent $agentnum\n"; + + # a better way? + if ($opt{m}) { + my $sql = "SELECT count(*) FROM queue LEFT JOIN cust_main USING(custnum) ". + "WHERE queue.job='FS::cust_main::queued_bill' AND cust_main.agentnum = ?"; + my $sth = $dbh->prepare($sql) or die $dbh->errstr; + while (1) { + $sth->execute( $agentnum ) + or die "Unexpected error executing statement $sql: ". $sth->errstr; + last if $sth->fetchrow_arrayref->[0]; + sleep 300; + } + } - my $command = "cd $dir; zip $zipfile ". - "agentnum$agentnum-$opt{date}-header.csv ". - "agentnum$agentnum-$opt{date}-detail.csv"; + foreach ( qw ( header detail ) ) { + rename "$dir/$file-$_.csv", + "$dir/$file-$date-$_.csv"; + } - system($command) and die "$command failed\n"; + my $command = "cd $dir; zip $zipfile ". + "$file-$date-header.csv ". + "$file-$date-detail.csv"; - unlink "agentnum$agentnum-$opt{date}-header.csv", - "agentnum$agentnum-$opt{date}-detail.csv"; + system($command) and die "$command failed\n"; - if ( $url =~ /^http/i ) { + unlink "$file-$date-header.csv", + "$file-$date-detail.csv"; - my $ua = new LWP::UserAgent; - my $res = $ua->request( POST( $url, - 'Content_Type' => 'form-data', - 'Content' => [ 'username' => $username, - 'pass' => $password, - 'custid' => $username, - 'clicode' => $clicode, - 'file1' => [ $zipfile ], - ], - ) - ); + if ( $url =~ /^http/i ) { - die "upload failed: ". $res->status_line. "\n" - unless $res->is_success; + my $ua = new LWP::UserAgent; + my $res = $ua->request( POST( $url, + 'Content_Type' => 'form-data', + 'Content' => [ 'username' => $username, + 'pass' => $password, + 'custid' => $username, + 'clicode' => $opt{clicode}, + 'file1' => [ $zipfile ], + ], + ) + ); - } elsif ( $url =~ /^ftp:\/\/([\w\.]+)(\/.*)$/i ) { + die "upload failed: ". $res->status_line. "\n" + unless $res->is_success; - my($hostname, $path) = ($1, $2); + } elsif ( $url =~ /^ftp:\/\/([\w\.]+)(\/.*)$/i ) { - my $ftp = new Net::FTP($hostname) #, Passive=>1 ) - or die "can't connect to $hostname: $@\n"; - $ftp->login($username, $password) - or die "can't login to $hostname: ". $ftp->message."\n"; - unless ( $ftp->cwd($path) ) { - my $msg = "can't cd $path on $hostname: ". $ftp->message. "\n"; - ( $path eq '/' ) ? warn $msg : die $msg; - } - $ftp->binary - or die "can't set binary mode on $hostname\n"; + my($hostname, $path) = ($1, $2); + + my $ftp = new Net::FTP($hostname, Passive=>1) + or die "can't connect to $hostname: $@\n"; + $ftp->login($username, $password) + or die "can't login to $hostname: ". $ftp->message."\n"; + unless ( $ftp->cwd($path) ) { + my $msg = "can't cd $path on $hostname: ". $ftp->message. "\n"; + ( $path eq '/' ) ? warn $msg : die $msg; + } + $ftp->binary + or die "can't set binary mode on $hostname\n"; - $ftp->put($zipfile) - or die "can't put $zipfile: ". $ftp->message. "\n"; + $ftp->put($zipfile) + or die "can't put $zipfile: ". $ftp->message. "\n"; - $ftp->quit; + $ftp->quit; + + } else { + die "unknown scheme in URL $url\n"; + } - } else { - die "unknown scheme in URL $url\n"; } + else { #not billco + + my $targetnum = $opt{targetnum}; + my $ftp_target = FS::ftp_target->by_key($targetnum) + or die "FTP target $targetnum not found\n"; + + $dir .= "/target$targetnum"; + chdir($dir); + + my $file = $agentnum ? "agentnum$agentnum" : 'spool'; #.csv + + unless ( -f "$dir/$file.csv" ) { + warn "$me $dir/$file.csv not found\n" if $DEBUG > 1; + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + return; + } + + rename "$dir/$file.csv", "$dir/$file-$date.csv"; + + if ( $opt{'handling'} eq 'bridgestone' ) { + + my $prefix = $conf->config('bridgestone-prefix', $agentnum); + unless ( $prefix ) { + warn "$me agent $agentnum has no bridgestone-prefix, skipped\n"; + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + return; + } + + my $seq = $conf->config('bridgestone-batch_counter', $agentnum) || 1; + + # extract zip code + join(' ',$conf->config('company_address', $agentnum)) =~ + /(\d{5}(\-\d{4})?)\s*$/; + my $ourzip = $1 || ''; #could be an explicit option if really needed + $ourzip =~ s/\D//; + my $newfile = sprintf('%s_%s_%0.6d.dat', + $prefix, + time2str('%Y%m%d', time), + $seq); + warn "copying spool to $newfile\n" if $DEBUG; + + my ($in, $out); + open $in, '<', "$dir/$file-$date.csv" + or die "unable to read $file-$date.csv\n"; + open $out, '>', "$dir/$newfile" or die "unable to write $newfile\n"; + #header--not sure how much of this generalizes at all + my $head = sprintf( + "%-6s%-4s%-27s%-6s%0.6d%-5s%-9s%-9s%-7s%0.8d%-7s%0.6d\n", + ' COMP:', 'VISP', '', ',SEQ#:', $seq, ',ZIP:', $ourzip, ',VERS:1.1', + ',RUNDT:', time2str('%m%d%Y', $^T), + ',RUNTM:', time2str('%H%M%S', $^T), + ); + warn "HEADER: $head" if $DEBUG; + print $out $head; + + my $rows = 0; + while( <$in> ) { + print $out $_; + $rows++; + } + + #trailer + my $trail = sprintf( + "%-6s%-4s%-27s%-6s%0.6d%-7s%0.9d%-9s%0.9d\n", + ' COMP:', 'VISP', '', ',SEQ:', $seq, + ',LINES:', $rows+2, ',LETTERS:', $rows, + ); + warn "TRAILER: $trail" if $DEBUG; + print $out $trail; + + close $in; + close $out; + + my $zipfile = sprintf('%s_%0.6d.zip', $prefix, $seq); + my $command = "cd $dir; zip $zipfile $newfile"; + warn "compressing to $zipfile\n$command\n" if $DEBUG; + system($command) and die "$command failed\n"; + + my $connection = $ftp_target->connect; # dies on error + $connection->put($zipfile); + + my $template = join("\n",$conf->config('bridgestone-confirm_template')); + if ( $template ) { + my $tmpl_obj = Text::Template->new( + TYPE => 'STRING', SOURCE => $template + ); + my $content = $tmpl_obj->fill_in( HASH => + { + zipfile => $zipfile, + prefix => $prefix, + seq => $seq, + rows => $rows, + } + ); + my ($head, $body) = split("\n\n", $content, 2); + $head =~ /^subject:\s*(.*)$/im; + my $subject = $1; + + $head =~ /^to:\s*(.*)$/im; + my $to = $1; + + send_email( + to => $to, + from => $conf->config('invoice_from', $agentnum), + subject => $subject, + body => $body, + ); + } else { #!$template + warn "$me agent $agentnum has no bridgestone-confirm_template, no email sent\n"; + } + + $seq++; + warn "setting batch counter to $seq\n" if $DEBUG; + $conf->set('bridgestone-batch_counter', $seq, $agentnum); + + } else { # not bridgestone + + # this is the usual case + + my $connection = $ftp_target->connect; # dies on error + $connection->put("$file-$date.csv"); + + } + + } #opt{handling} $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm index a45be3fb6..ad3aa5943 100644 --- a/FS/FS/Mason.pm +++ b/FS/FS/Mason.pm @@ -69,7 +69,7 @@ if ( -e $addl_handler_use_file ) { Lingua::EN::Inflect::classical names=>0; #Categorys use Tie::IxHash; use URI; - use URI::Escape; + use URI::Escape 3.31; use HTML::Entities; use HTML::TreeBuilder; use HTML::TableExtract qw(tree); @@ -91,6 +91,10 @@ if ( -e $addl_handler_use_file ) { use Text::CSV_XS; use Spreadsheet::WriteExcel; use Spreadsheet::WriteExcel::Utility; + use OLE::Storage_Lite; + use Excel::Writer::XLSX; + #use Excel::Writer::XLSX::Utility; #redundant with above + use Business::CreditCard 0.30; #for mask-aware cardtype() use NetAddr::IP; use Net::Ping; @@ -122,6 +126,7 @@ if ( -e $addl_handler_use_file ) { use FS::UID qw( getotaker dbh datasrc driver_name ); use FS::Record qw( qsearch qsearchs fields dbdef str2time_sql str2time_sql_closing + midnight_sql ); use FS::Conf; use FS::CGI qw(header menubar table itable ntable idiot @@ -303,7 +308,24 @@ if ( -e $addl_handler_use_file ) { use FS::discount_plan; use FS::tower; use FS::tower_sector; + use FS::sales; + use FS::access_groupsales; use FS::contact_class; + use FS::part_svc_class; + use FS::ftp_target; + use FS::quotation; + use FS::quotation_pkg; + use FS::quotation_pkg_discount; + use FS::cust_bill_void; + use FS::cust_bill_pkg_void; + use FS::cust_bill_pkg_detail_void; + use FS::cust_bill_pkg_display_void; + use FS::cust_bill_pkg_tax_location_void; + use FS::cust_bill_pkg_tax_rate_location_void; + use FS::cust_tax_exempt_pkg_void; + use FS::cust_bill_pkg_discount_void; + use FS::agent_pkg_class; + use FS::svc_export_machine; use FS::GeocodeCache; # Sammath Naur @@ -348,7 +370,7 @@ if ( -e $addl_handler_use_file ) { use RT::Interface::Web::Request; - #nother undeclared web UI dep (for ticket links graph) + #another undeclared web UI dep (for ticket links graph) use IPC::Run::SafeHandles; #slow, unreliable, segfaults and is optional @@ -507,28 +529,7 @@ sub mason_interps { RT::LoadConfig(); } - # A hook supporting strange legacy ways people (well, SG) have added stuff on - - my @addl_comp_root = (); - my $addl_comp_root_file = '%%%FREESIDE_CONF%%%/addl_comp_root.pl'; - if ( -e $addl_comp_root_file ) { - warn "reading $addl_comp_root_file\n"; - my $text = slurp( $addl_comp_root_file ); - my @addl = eval $text; - if ( @addl && ! $@ ) { - @addl_comp_root = @addl; - } elsif ($@) { - warn "error parsing $addl_comp_root_file: $@\n"; - } - } - - my $fs_comp_root = - scalar(@addl_comp_root) - ? [ - [ 'freeside'=>'%%%FREESIDE_DOCUMENT_ROOT%%%' ], - @addl_comp_root, - ] - : '%%%FREESIDE_DOCUMENT_ROOT%%%'; + my $fs_comp_root = '%%%FREESIDE_DOCUMENT_ROOT%%%'; my %interp = ( request_class => $request_class, @@ -575,11 +576,13 @@ sub mason_interps { [ 'freeside' => '%%%FREESIDE_DOCUMENT_ROOT%%%' ], ], escape_flags => { 'h' => \&RT::Interface::Web::EscapeUTF8, + 'u' => \&RT::Interface::Web::EscapeURI, + 'j' => \&RT::Interface::Web::EscapeJS, 'js_string' => $js_string_sub, }, compiler => HTML::Mason::Compiler::ToObject->new( default_escape_flags => 'h', - allow_globals => [qw(%session)], + allow_globals => [qw(%session $DECODED_ARGS)], ), ); diff --git a/FS/FS/Mason/Request.pm b/FS/FS/Mason/Request.pm index d8fd77a66..36c46dc41 100644 --- a/FS/FS/Mason/Request.pm +++ b/FS/FS/Mason/Request.pm @@ -4,6 +4,7 @@ use strict; use warnings; use vars qw( $FSURL $QUERY_STRING ); use base 'HTML::Mason::Request'; +use FS::Trace; $FSURL = 'http://Set/FS_Mason_Request_FSURL/in_standalone_mode/'; $QUERY_STRING = ''; @@ -11,21 +12,27 @@ $QUERY_STRING = ''; sub new { my $class = shift; + FS::Trace->log('creating new FS::Mason::Request object'); + my $superclass = $HTML::Mason::ApacheHandler::VERSION ? 'HTML::Mason::Request::ApacheHandler' : $HTML::Mason::CGIHandler::VERSION ? 'HTML::Mason::Request::CGI' : 'HTML::Mason::Request'; + FS::Trace->log(' altering superclass'); $class->alter_superclass( $superclass ); + FS::Trace->log(' setting valid params'); #huh... shouldn't alter_superclass take care of this for us? __PACKAGE__->valid_params( %{ $superclass->valid_params() } ); + FS::Trace->log(' freeside_setup'); my %opt = @_; my $mode = $superclass =~ /Apache/i ? 'apache' : 'standalone'; $class->freeside_setup($opt{'comp'}, $mode); + FS::Trace->log(' SUPER::new'); $class->SUPER::new(@_); } @@ -33,11 +40,34 @@ sub new { #override alter_superclass ala RT::Interface::Web::Request ?? # for Mason 1.39 vs. Perl 5.10.0 +my $protect_fds; + sub freeside_setup { my( $class, $filename, $mode ) = @_; + FS::Trace->log(' protecting fds'); + + #from rt/bin/webmux.pl(.in) + if ( !$protect_fds && $ENV{'MOD_PERL'} && exists $ENV{'MOD_PERL_API_VERSION'} + && $ENV{'MOD_PERL_API_VERSION'} >= 2 + ) { + # under mod_perl2, STDIN and STDOUT get closed and re-opened, + # however they are not on FD 0 and 1. In this case, the next + # socket that gets opened will occupy one of these FDs, and make + # all system() and open "|-" calls dangerous; for example, the + # DBI handle can get this FD, which later system() calls will + # close by putting garbage into the socket. + $protect_fds = []; + push @{$protect_fds}, IO::Handle->new_from_fd(0, "r") + if fileno(STDIN) != 0; + push @{$protect_fds}, IO::Handle->new_from_fd(1, "w") + if fileno(STDOUT) != 1; + } + if ( $filename =~ qr(/REST/\d+\.\d+/NoAuth/) ) { + FS::Trace->log(' handling RT REST/NoAuth file'); + package HTML::Mason::Commands; #? use FS::UID qw( adminsuidsetup ); @@ -46,10 +76,13 @@ sub freeside_setup { ##old installs w/fs_selfs or selfserv?? #&adminsuidsetup('fs_selfservice'); + FS::Trace->log(' adminsuidsetup fs_queue'); &adminsuidsetup('fs_queue'); } else { + FS::Trace->log(' handling regular file'); + package HTML::Mason::Commands; use vars qw( $cgi $p $fsurl ); # $lh ); #not using /mt use Encode; @@ -58,6 +91,7 @@ sub freeside_setup { if ( $mode eq 'apache' ) { $cgi = new CGI; + FS::Trace->log(' cgisuidsetup'); &cgisuidsetup($cgi); #&cgisuidsetup($r); $fsurl = rooturl(); @@ -72,6 +106,7 @@ sub freeside_setup { die "unknown mode $mode"; } + FS::Trace->log(' UTF-8-decoding form data'); # foreach my $param ( $cgi->param ) { my @values = $cgi->param($param); @@ -83,6 +118,8 @@ sub freeside_setup { } + FS::Trace->log(' done'); + } sub callback { diff --git a/FS/FS/Misc/Geo.pm b/FS/FS/Misc/Geo.pm index 733c298f9..b727fa7e9 100644 --- a/FS/FS/Misc/Geo.pm +++ b/FS/FS/Misc/Geo.pm @@ -7,7 +7,7 @@ use LWP::UserAgent; use HTTP::Request; use HTTP::Request::Common qw( GET POST ); use HTML::TokeParser; -use URI::Escape; +use URI::Escape 3.31; use Data::Dumper; FS::UID->install_callback( sub { diff --git a/FS/FS/Misc/Invoicing.pm b/FS/FS/Misc/Invoicing.pm new file mode 100644 index 000000000..2fc52a99b --- /dev/null +++ b/FS/FS/Misc/Invoicing.pm @@ -0,0 +1,26 @@ +package FS::Misc::Invoicing; +use base qw( Exporter ); + +use vars qw( @EXPORT_OK ); +@EXPORT_OK = qw( spool_formats ); + +=head1 NAME + +FS::Misc::Invoicing - Invoice subroutines + +=head1 SYNOPSIS + +use FS::Misc::Invoicing qw( spool_formats ); + +=item spool_formats + +Returns a list of the invoice spool formats. + +=cut + +sub spool_formats { + qw(default oneline billco bridgestone) +} + +1; + diff --git a/FS/FS/PagedSearch.pm b/FS/FS/PagedSearch.pm new file mode 100644 index 000000000..09d05c4e6 --- /dev/null +++ b/FS/FS/PagedSearch.pm @@ -0,0 +1,189 @@ +package FS::PagedSearch; + +use strict; +use vars qw($DEBUG $default_limit @EXPORT_OK); +use base qw( Exporter ); +use FS::Record qw(qsearch dbdef); +use Data::Dumper; + +$DEBUG = 0; +$default_limit = 100; + +@EXPORT_OK = 'psearch'; + +=head1 NAME + +FS::PagedSearch - Iterator for querying large data sets + +=head1 SYNOPSIS + +use FS::PagedSearch qw(psearch); + +my $search = psearch('table', { field => 'value' ... }); +$search->limit(100); #optional +while ( my $row = $search->fetch ) { +... +} + +=head1 SUBROUTINES + +=over 4 + +=item psearch ARGUMENTS + +A wrapper around L<FS::Record::qsearch>. Accepts all the same arguments +as qsearch, except for the arrayref union query mode, and returns an +FS::PagedSearch object to access the rows of the query one at a time. +If the query doesn't contain an ORDER BY clause already, it will be ordered +by the table's primary key. + +=cut + +sub psearch { + # deep-copy qsearch args + my $q; + if ( ref($_[0]) eq 'ARRAY' ) { + die "union query not supported with psearch"; #yet + } + elsif ( ref($_[0]) eq 'HASH' ) { + %$q = %{ $_[0] }; + } + else { + $q = { + 'table' => shift, + 'hashref' => shift, + 'select' => shift, + 'extra_sql' => shift, + 'cache_obj' => shift, + 'addl_from' => shift, + }; + } + warn Dumper($q) if $DEBUG > 1; + + # clean up query + my $dbdef = dbdef->table($q->{table}); + # qsearch just appends order_by to extra_sql, so do that ourselves + $q->{extra_sql} ||= ''; + $q->{extra_sql} .= ' '.$q->{order_by} if $q->{order_by}; + $q->{order_by} = ''; + # and impose an ordering if needed + if ( not $q->{extra_sql} =~ /order by/i ) { + $q->{extra_sql} .= ' ORDER BY '.$dbdef->primary_key; + } + # and then we'll use order_by for LIMIT/OFFSET + + my $self = { + query => $q, + buffer => [], + offset => 0, + limit => $default_limit, + increment => 1, + }; + bless $self, 'FS::PagedSearch'; + + $self; +} + +=back + +=head1 METHODS + +=over 4 + +=item fetch + +Fetch the next row from the search results and remove it from the buffer. +Returns undef if there are no more rows. + +=cut + +sub fetch { + my $self = shift; + my $b = $self->{buffer}; + $self->refill if @$b == 0; + $self->{offset} += $self->{increment} if @$b; + return shift @$b; +} + +=item adjust ROWS + +Add ROWS to the offset counter. This won't cause rows to be skipped in the +current buffer but will affect the starting point of the next refill. + +=cut + +sub adjust { + my $self = shift; + my $r = shift; + $self->{offset} += $r; +} + +=item limit [ VALUE ] + +Set/get the number of rows to retrieve per page. The default is 100. + +=cut + +sub limit { + my $self = shift; + my $new_limit = shift; + if ( defined($new_limit) ) { + $self->{limit} = $new_limit; + } + $self->{limit}; +} + +=item increment [ VALUE ] + +Set/get the number of rows to increment the offset for each row that's +retrieved. Defaults to 1. If the rows are being modified in a way that +removes them from the result set of the query, it's probably wise to set +this to zero. Setting it to anything else is probably nonsense. + +=cut + +sub increment { + my $self = shift; + my $new_inc = shift; + if ( defined($new_inc) ) { + $self->{increment} = $new_inc; + } + $self->{increment}; +} + + +=item refill + +Run the query, skipping a number of rows set by the row offset, and replace +the contents of the buffer with the result. If there are no more rows, +this will just empty the buffer. Called automatically as needed; don't call +this from outside. + +=cut + +sub refill { + my $self = shift; + my $b = $self->{buffer}; + warn "refilling (limit ".$self->{limit}.", offset ".$self->{offset}.")\n" + if $DEBUG; + warn "discarding ".scalar(@$b)." rows\n" if $DEBUG and @$b; + if ( $self->{limit} > 0 ) { + $self->{query}->{order_by} = 'LIMIT ' . $self->{limit} . + ' OFFSET ' . $self->{offset}; + } + @$b = qsearch( $self->{query} ); + my $rows = scalar @$b; + warn "$rows returned\n" if $DEBUG; + + $rows; +} + +=back + +=head1 SEE ALSO + +L<FS::Record> + +=cut + +1; diff --git a/FS/FS/Quotable_Mixin.pm b/FS/FS/Quotable_Mixin.pm new file mode 100644 index 000000000..dfd3ddd83 --- /dev/null +++ b/FS/FS/Quotable_Mixin.pm @@ -0,0 +1,13 @@ +package FS::Quotable_Mixin; + +use strict; +use FS::Record qw( qsearch ); #qsearchs ); +use FS::quotation; + +sub quotation { + my $self = shift; + my $pk = $self->primary_key; + qsearch('quotation', { $pk => $self->$pk() } ); +} + +1; diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index dfc2abfc4..ca68c3596 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -39,6 +39,7 @@ use Tie::IxHash; @EXPORT_OK = qw( dbh fields hfields qsearch qsearchs dbdef jsearch str2time_sql str2time_sql_closing regexp_sql not_regexp_sql concat_sql + midnight_sql ); $DEBUG = 0; @@ -2420,10 +2421,9 @@ sub ut_coordn { } - =item ut_domain COLUMN -Check/untaint host and domain names. +Check/untaint host and domain names. May not be null. =cut @@ -2431,11 +2431,27 @@ sub ut_domain { my( $self, $field ) = @_; #$self->getfield($field) =~/^(\w+\.)*\w+$/ $self->getfield($field) =~/^(([\w\-]+\.)*\w+)$/ - or return "Illegal (domain) $field: ". $self->getfield($field); + or return "Illegal (hostname) $field: ". $self->getfield($field); $self->setfield($field,$1); ''; } +=item ut_domainn COLUMN + +Check/untaint host and domain names. May be null. + +=cut + +sub ut_domainn { + my( $self, $field ) = @_; + if ( $self->getfield($field) =~ /^()$/ ) { + $self->setfield($field,''); + ''; + } else { + $self->ut_domain($field); + } +} + =item ut_name COLUMN Check/untaint proper names; allows alphanumerics, spaces and the following @@ -2562,6 +2578,22 @@ sub ut_enumn { : ''; } +=item ut_flag COLUMN + +Check/untaint a column if it contains either an empty string or 'Y'. This +is the standard form for boolean flags in Freeside. + +=cut + +sub ut_flag { + my( $self, $field ) = @_; + my $value = uc($self->getfield($field)); + if ( $value eq '' or $value eq 'Y' ) { + $self->setfield($field, $value); + return ''; + } + return "Illegal (flag) field $field: $value"; +} =item ut_foreign_key COLUMN FOREIGN_TABLE FOREIGN_COLUMN @@ -3030,7 +3062,7 @@ sub not_regexp_sql { =item concat_sql [ DRIVER_NAME ] ITEMS_ARRAYREF -Returns the items concatendated based on database type, using "CONCAT()" for +Returns the items concatenated based on database type, using "CONCAT()" for mysql and " || " for Pg and other databases. You can pass an optional driver name such as "Pg", "mysql" or @@ -3051,6 +3083,24 @@ sub concat_sql { } +=item midnight_sql DATE + +Returns an SQL expression to convert DATE (a unix timestamp) to midnight +on that day in the system timezone, using the default driver name. + +=cut + +sub midnight_sql { + my $driver = driver_name; + my $expr = shift; + if ( $driver =~ /^mysql/i ) { + "UNIX_TIMESTAMP(DATE(FROM_UNIXTIME($expr)))"; + } + else { + "EXTRACT( EPOCH FROM DATE(TO_TIMESTAMP($expr)) )"; + } +} + =back =head1 BUGS diff --git a/FS/FS/Report/FCC_477.pm b/FS/FS/Report/FCC_477.pm index 4c94fff2e..49bb8a852 100644 --- a/FS/FS/Report/FCC_477.pm +++ b/FS/FS/Report/FCC_477.pm @@ -45,8 +45,8 @@ Documentation. ); @technology = ( - 'Asymetric xDSL', - 'Symetric xDSL', + 'Asymmetric xDSL', + 'Symmetric xDSL', 'Other Wireline', 'Cable Modem', 'Optical Carrier', diff --git a/FS/FS/Report/Table.pm b/FS/FS/Report/Table.pm index b0e911f84..73eed6e0c 100644 --- a/FS/FS/Report/Table.pm +++ b/FS/FS/Report/Table.pm @@ -72,8 +72,8 @@ sub invoiced { #invoiced SELECT SUM(charged) FROM cust_bill LEFT JOIN cust_main USING ( custnum ) - WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum) - . (%opt ? $self->for_custnum(%opt) : '') + WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum). + $self->for_opts(%opt) ); } @@ -85,8 +85,8 @@ sub invoiced { #invoiced sub netsales { #net sales my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_; - $self->invoiced($speriod,$eperiod,$agentnum,%opt) - - $self->netcredits($speriod,$eperiod,$agentnum,%opt); + $self->invoiced( $speriod, $eperiod, $agentnum, %opt) + - $self->netcredits($speriod, $eperiod, $agentnum, %opt); } =item cashflow: payments - refunds @@ -105,10 +105,10 @@ sub cashflow { =cut sub netcashflow { - my( $self, $speriod, $eperiod, $agentnum ) = @_; + my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_; - $self->receipts($speriod, $eperiod, $agentnum) - - $self->netrefunds( $speriod, $eperiod, $agentnum); + $self->receipts( $speriod, $eperiod, $agentnum, %opt) + - $self->netrefunds( $speriod, $eperiod, $agentnum, %opt); } =item payments: The sum of payments received in the period. @@ -121,8 +121,8 @@ sub payments { SELECT SUM(paid) FROM cust_pay LEFT JOIN cust_main USING ( custnum ) - WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum) - . (%opt ? $self->for_custnum(%opt) : '') + WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum). + $self->for_opts(%opt) ); } @@ -131,12 +131,13 @@ sub payments { =cut sub credits { - my( $self, $speriod, $eperiod, $agentnum ) = @_; + my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_; $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) + WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum). + $self->for_opts(%opt) ); } @@ -150,8 +151,8 @@ sub refunds { SELECT SUM(refund) FROM cust_refund LEFT JOIN cust_main USING ( custnum ) - WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum) - . (%opt ? $self->for_custnum(%opt) : '') + WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum). + $self->for_opts(%opt) ); } @@ -170,8 +171,8 @@ sub netcredits { $eperiod, $agentnum, 'cust_bill._date' - ) - . (%opt ? $self->for_custnum(%opt) : '') + ). + $self->for_opts(%opt) ); } @@ -180,7 +181,7 @@ sub netcredits { =cut sub receipts { #net payments - my( $self, $speriod, $eperiod, $agentnum ) = @_; + my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_; $self->scalar_sql(" SELECT SUM(cust_bill_pay.amount) FROM cust_bill_pay @@ -190,7 +191,8 @@ sub receipts { #net payments $eperiod, $agentnum, 'cust_bill._date' - ) + ). + $self->for_opts(%opt) ); } @@ -199,7 +201,7 @@ sub receipts { #net payments =cut sub netrefunds { - my( $self, $speriod, $eperiod, $agentnum ) = @_; + my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_; $self->scalar_sql(" SELECT SUM(cust_credit_refund.amount) FROM cust_credit_refund @@ -209,7 +211,8 @@ sub netrefunds { $eperiod, $agentnum, 'cust_credit._date' - ) + ). + $self->for_opts(%opt) ); } @@ -416,6 +419,8 @@ sub cust_bill_pkg_setup { $self->in_time_period_and_agent($speriod, $eperiod, $agentnum), ); + push @where, 'cust_main.refnum = '. $opt{'refnum'} if $opt{'refnum'}; + my $total_sql = "SELECT COALESCE(SUM(cust_bill_pkg.setup),0) FROM cust_bill_pkg $cust_bill_pkg_join @@ -436,6 +441,8 @@ sub cust_bill_pkg_recur { $self->with_classnum($opt{'classnum'}, $opt{'use_override'}), ); + push @where, 'cust_main.refnum = '. $opt{'refnum'} if $opt{'refnum'}; + # subtract all usage from the line item regardless of date my $item_usage; if ( $opt{'project'} ) { @@ -489,6 +496,8 @@ sub cust_bill_pkg_detail { my @where = ( "cust_bill_pkg.pkgnum != 0" ); + push @where, 'cust_main.refnum = '. $opt{'refnum'} if $opt{'refnum'}; + $agentnum ||= $opt{'agentnum'}; push @where, @@ -619,10 +628,16 @@ sub in_time_period_and_agent { $sql; } -sub for_custnum { +sub for_opts { my ( $self, %opt ) = @_; - return '' unless $opt{'custnum'}; - $opt{'custnum'} =~ /^\d+$/ ? " and custnum = $opt{custnum} " : ''; + my $sql = ''; + if ( $opt{'custnum'} =~ /^(\d+)$/ ) { + $sql .= " and custnum = $1 "; + } + if ( $opt{'refnum'} =~ /^(\d+)$/ ) { + $sql .= " and refnum = $1 "; + } + $sql; } sub with_classnum { diff --git a/FS/FS/Report/Table/Monthly.pm b/FS/FS/Report/Table/Monthly.pm index 87c13a8ca..86ab19b74 100644 --- a/FS/FS/Report/Table/Monthly.pm +++ b/FS/FS/Report/Table/Monthly.pm @@ -24,6 +24,7 @@ FS::Report::Table::Monthly - Tables of report data, indexed monthly 'end_year' => 2020, #opt 'agentnum' => 54 + 'refnum' => 54 'params' => [ [ 'paramsfor', 'item_one' ], [ 'item', 'two' ] ], # ... 'remove_empty' => 1, #collapse empty rows, default 0 'item_labels' => [ ], #useful with remove_empty @@ -59,6 +60,7 @@ sub data { } my $agentnum = $self->{'agentnum'}; + my $refnum = $self->{'refnum'}; if ( $projecting ) { @@ -110,11 +112,13 @@ sub data { my $item = $items[$i]; my @param = $self->{'params'} ? @{ $self->{'params'}[$i] }: (); push @param, 'project', $projecting; + push @param, 'refnum' => $refnum if $refnum; my $value = $self->$item($speriod, $eperiod, $agentnum, @param); push @{$data{data}->[$col]}, $value; $item = $items[$i+1]; @param = $self->{'params'} ? @{ $self->{'params'}[++$i] }: (); push @param, 'project', $projecting; + push @param, 'refnum' => $refnum if $refnum; $value = $self->$item($speriod, $eperiod, $agentnum, @param); push @{$data{data}->[$col++]}, $value; } @@ -122,6 +126,7 @@ sub data { my $item = $items[$i]; my @param = $self->{'params'} ? @{ $self->{'params'}[$col] }: (); push @param, 'project', $projecting; + push @param, 'refnum' => $refnum if $refnum; my $value = $self->$item($speriod, $eperiod, $agentnum, @param); push @{$data{data}->[$col++]}, $value; } diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index e69b0bc2c..2c9af0ae2 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -445,7 +445,7 @@ sub tables_hashref { my @taxrate_type = ( 'decimal', '', '14,8' ); # requires pg 8 for my @taxrate_typen = ( 'decimal', 'NULL', '14,8' ); # fs-upgrade to work - my $username_len = 32; #usernamemax config file + my $username_len = 64; #usernamemax config file # name type nullability length default local @@ -473,6 +473,18 @@ sub tables_hashref { 'index' => [ ['typenum'], ['disabled'], ['agent_custnum'] ], }, + 'agent_pkg_class' => { + 'columns' => [ + 'agentpkgclassnum', 'serial', '', '', '', '', + 'agentnum', 'int', '', '', '', '', + 'classnum', 'int', 'NULL', '', '', '', + 'commission_percent', 'decimal', '', '7,4', '', '', + ], + 'primary_key' => 'agentpkgclassnum', + 'unique' => [ [ 'agentnum', 'classnum' ], ], + 'index' => [], + }, + 'agent_type' => { 'columns' => [ 'typenum', 'serial', '', '', '', '', @@ -494,6 +506,18 @@ sub tables_hashref { 'index' => [ ['typenum'] ], }, + 'sales' => { + 'columns' => [ + 'salesnum', 'serial', '', '', '', '', + 'salesperson', 'varchar', '', $char_d, '', '', + 'agentnum', 'int', 'NULL', '', '', '', + 'disabled', 'char', 'NULL', 1, '', '', + ], + 'primary_key' => 'salesnum', + 'unique' => [], + 'index' => [ ['salesnum'], ['disabled'] ], + }, + 'cust_attachment' => { 'columns' => [ 'attachnum', 'serial', '', '', '', '', @@ -539,6 +563,35 @@ sub tables_hashref { 'index' => [ ['custnum'], ['_date'], ['statementnum'], ['agent_invid'] ], }, + 'cust_bill_void' => { + 'columns' => [ + #regular fields + 'invnum', 'int', '', '', '', '', + 'custnum', 'int', '', '', '', '', + '_date', @date_type, '', '', + 'charged', @money_type, '', '', + 'invoice_terms', 'varchar', 'NULL', $char_d, '', '', + + #customer balance info at invoice generation time + 'previous_balance', @money_typen, '', '', #eventually not nullable + 'billing_balance', @money_typen, '', '', #eventually not nullable + + #specific use cases + 'closed', 'char', 'NULL', 1, '', '', #not yet used much + 'statementnum', 'int', 'NULL', '', '', '', #invoice aggregate statements + 'agent_invid', 'int', 'NULL', '', '', '', #(varchar?) importing legacy + 'promised_date', @date_type, '', '', + + #void fields + 'void_date', @date_type, '', '', + 'reason', 'varchar', 'NULL', $char_d, '', '', + 'void_usernum', 'int', 'NULL', '', '', '', + ], + 'primary_key' => 'invnum', + 'unique' => [ [ 'custnum', 'agent_invid' ] ], #agentnum? huh + 'index' => [ ['custnum'], ['_date'], ['statementnum'], ['agent_invid'], [ 'void_usernum' ] ], + }, + #for importing invoices from a legacy system for display purposes only # no effect upon balance 'legacy_cust_bill' => { @@ -775,6 +828,101 @@ sub tables_hashref { 'index' => [ [ 'billpkgnum' ], [ 'taxnum' ], [ 'taxratelocationnum' ] ], }, + 'cust_bill_pkg_void' => { + 'columns' => [ + 'billpkgnum', 'int', '', '', '', '', + 'invnum', 'int', '', '', '', '', + 'pkgnum', 'int', '', '', '', '', + 'pkgpart_override', 'int', 'NULL', '', '', '', + 'setup', @money_type, '', '', + 'recur', @money_type, '', '', + 'sdate', @date_type, '', '', + 'edate', @date_type, '', '', + 'itemdesc', 'varchar', 'NULL', $char_d, '', '', + 'itemcomment', 'varchar', 'NULL', $char_d, '', '', + 'section', 'varchar', 'NULL', $char_d, '', '', + 'freq', 'varchar', 'NULL', $char_d, '', '', + 'quantity', 'int', 'NULL', '', '', '', + 'unitsetup', @money_typen, '', '', + 'unitrecur', @money_typen, '', '', + 'hidden', 'char', 'NULL', 1, '', '', + #void fields + 'void_date', @date_type, '', '', + 'reason', 'varchar', 'NULL', $char_d, '', '', + 'void_usernum', 'int', 'NULL', '', '', '', + ], + 'primary_key' => 'billpkgnum', + 'unique' => [], + 'index' => [ ['invnum'], [ 'pkgnum' ], [ 'itemdesc' ], [ 'void_usernum' ], ], + }, + + 'cust_bill_pkg_detail_void' => { + 'columns' => [ + 'detailnum', 'int', '', '', '', '', + 'billpkgnum', 'int', 'NULL', '', '', '', # should not be nullable + 'pkgnum', 'int', 'NULL', '', '', '', # deprecated + 'invnum', 'int', 'NULL', '', '', '', # deprecated + 'amount', 'decimal', 'NULL', '10,4', '', '', + 'format', 'char', 'NULL', 1, '', '', + 'classnum', 'int', 'NULL', '', '', '', + 'duration', 'int', 'NULL', '', 0, '', + 'phonenum', 'varchar', 'NULL', 15, '', '', + 'accountcode', 'varchar', 'NULL', 20, '', '', + 'startdate', @date_type, '', '', + 'regionname', 'varchar', 'NULL', $char_d, '', '', + 'detail', 'varchar', '', 255, '', '', + ], + 'primary_key' => 'detailnum', + 'unique' => [], + 'index' => [ [ 'billpkgnum' ], [ 'classnum' ], [ 'pkgnum', 'invnum' ] ], + }, + + 'cust_bill_pkg_display_void' => { + 'columns' => [ + 'billpkgdisplaynum', 'int', '', '', '', '', + 'billpkgnum', 'int', '', '', '', '', + 'section', 'varchar', 'NULL', $char_d, '', '', + #'unitsetup', @money_typen, '', '', #override the linked real one? + #'unitrecur', @money_typen, '', '', #this too? + 'post_total', 'char', 'NULL', 1, '', '', + 'type', 'char', 'NULL', 1, '', '', + 'summary', 'char', 'NULL', 1, '', '', + ], + 'primary_key' => 'billpkgdisplaynum', + 'unique' => [], + 'index' => [ ['billpkgnum'], ], + }, + + 'cust_bill_pkg_tax_location_void' => { + 'columns' => [ + 'billpkgtaxlocationnum', 'int', '', '', '', '', + 'billpkgnum', 'int', '', '', '', '', + 'taxnum', 'int', '', '', '', '', + 'taxtype', 'varchar', '', $char_d, '', '', + 'pkgnum', 'int', '', '', '', '', + 'locationnum', 'int', '', '', '', '', #redundant? + 'amount', @money_type, '', '', + ], + 'primary_key' => 'billpkgtaxlocationnum', + 'unique' => [], + 'index' => [ [ 'billpkgnum' ], [ 'taxnum' ], [ 'pkgnum' ], [ 'locationnum' ] ], + }, + + 'cust_bill_pkg_tax_rate_location_void' => { + 'columns' => [ + 'billpkgtaxratelocationnum', 'int', '', '', '', '', + 'billpkgnum', 'int', '', '', '', '', + 'taxnum', 'int', '', '', '', '', + 'taxtype', 'varchar', '', $char_d, '', '', + 'locationtaxid', 'varchar', 'NULL', $char_d, '', '', + 'taxratelocationnum', 'int', '', '', '', '', + 'amount', @money_type, '', '', + ], + 'primary_key' => 'billpkgtaxratelocationnum', + 'unique' => [], + 'index' => [ [ 'billpkgnum' ], [ 'taxnum' ], [ 'taxratelocationnum' ] ], + }, + 'cust_credit' => { 'columns' => [ 'crednum', 'serial', '', '', '', '', @@ -789,6 +937,7 @@ sub tables_hashref { 'closed', 'char', 'NULL', 1, '', '', 'pkgnum', 'int', 'NULL', '', '', '', #desired pkgnum for pkg-balances 'eventnum', 'int', 'NULL', '', '', '', #triggering event for commission + #'commission_agentnum', 'int', 'NULL', '', '', '', # ], 'primary_key' => 'crednum', 'unique' => [], @@ -844,17 +993,20 @@ sub tables_hashref { 'ss', 'varchar', 'NULL', 11, '', '', 'stateid', 'varchar', 'NULL', $char_d, '', '', 'stateid_state', 'varchar', 'NULL', $char_d, '', '', + 'national_id', 'varchar', 'NULL', $char_d, '', '', 'birthdate' ,@date_type, '', '', + 'spouse_birthdate' ,@date_type, '', '', + 'anniversary_date' ,@date_type, '', '', 'signupdate',@date_type, '', '', 'dundate', @date_type, '', '', 'company', 'varchar', 'NULL', $char_d, '', '', - 'address1', 'varchar', '', $char_d, '', '', + 'address1', 'varchar', 'NULL', $char_d, '', '', 'address2', 'varchar', 'NULL', $char_d, '', '', - 'city', 'varchar', '', $char_d, '', '', + 'city', 'varchar', 'NULL', $char_d, '', '', 'county', 'varchar', 'NULL', $char_d, '', '', 'state', 'varchar', 'NULL', $char_d, '', '', 'zip', 'varchar', 'NULL', 10, '', '', - 'country', 'char', '', 2, '', '', + 'country', 'char', 'NULL', 2, '', '', 'latitude', 'decimal', 'NULL', '10,7', '', '', 'longitude','decimal', 'NULL', '10,7', '', '', 'coord_auto', 'char', 'NULL', 1, '', '', @@ -885,7 +1037,7 @@ sub tables_hashref { 'payby', 'char', '', 4, '', '', 'payinfo', 'varchar', 'NULL', 512, '', '', 'paycvv', 'varchar', 'NULL', 512, '', '', - 'paymask', 'varchar', 'NULL', $char_d, '', '', + 'paymask', 'varchar', 'NULL', $char_d, '', '', #'paydate', @date_type, '', '', 'paydate', 'varchar', 'NULL', 10, '', '', 'paystart_month', 'int', 'NULL', '', '', '', @@ -914,9 +1066,13 @@ sub tables_hashref { 'email_csv_cdr', 'char', 'NULL', 1, '', '', 'accountcode_cdr', 'char', 'NULL', 1, '', '', 'billday', 'int', 'NULL', '', '', '', + 'prorate_day', 'int', 'NULL', '', '', '', 'edit_subject', 'char', 'NULL', 1, '', '', 'locale', 'varchar', 'NULL', 16, '', '', 'calling_list_exempt', 'char', 'NULL', 1, '', '', + 'invoice_noemail', 'char', 'NULL', 1, '', '', + 'bill_locationnum', 'int', 'NULL', '', '', '', + 'ship_locationnum', 'int', 'NULL', '', '', '', ], 'primary_key' => 'custnum', 'unique' => [ [ 'agentnum', 'agent_custid' ] ], @@ -927,16 +1083,6 @@ sub tables_hashref { [ 'referral_custnum' ], [ 'payby' ], [ 'paydate' ], [ 'archived' ], - #billing - [ 'last' ], [ 'company' ], - [ 'county' ], [ 'state' ], [ 'country' ], - [ 'zip' ], - [ 'daytime' ], [ 'night' ], [ 'fax' ], [ 'mobile' ], - #shipping - [ 'ship_last' ], [ 'ship_company' ], - [ 'ship_county' ], [ 'ship_state' ], [ 'ship_country' ], - [ 'ship_zip' ], - [ 'ship_daytime' ], [ 'ship_night' ], [ 'ship_fax' ], [ 'ship_mobile' ] ], }, @@ -989,7 +1135,7 @@ sub tables_hashref { # 'middle', 'varchar', 'NULL', $char_d, '', '', 'first', 'varchar', '', $char_d, '', '', 'title', 'varchar', 'NULL', $char_d, '', '', #eg Head Bottle Washer - 'comment', 'varchar', 'NULL', $char_d, '', '', + 'comment', 'varchar', 'NULL', 255, '', '', 'disabled', 'char', 'NULL', 1, '', '', ], 'primary_key' => 'contactnum', @@ -1050,8 +1196,50 @@ sub tables_hashref { 'index' => [ [ 'company' ], [ 'agentnum' ], [ 'disabled' ] ], }, - #eventually use for billing & ship from cust_main too - #for now, just cust_pkg locations + 'quotation' => { + 'columns' => [ + #regular fields + 'quotationnum', 'serial', '', '', '', '', + 'prospectnum', 'int', 'NULL', '', '', '', + 'custnum', 'int', 'NULL', '', '', '', + '_date', @date_type, '', '', + 'disabled', 'char', 'NULL', 1, '', '', + 'usernum', 'int', 'NULL', '', '', '', + #'total', @money_type, '', '', + #'quotation_term', 'varchar', 'NULL', $char_d, '', '', + ], + 'primary_key' => 'quotationnum', + 'unique' => [], + 'index' => [ [ 'prospectnum' ], ['custnum'], ], + }, + + 'quotation_pkg' => { + 'columns' => [ + 'quotationpkgnum', 'serial', '', '', '', '', + 'pkgpart', 'int', '', '', '', '', + 'locationnum', 'int', 'NULL', '', '', '', + 'start_date', @date_type, '', '', + 'contract_end', @date_type, '', '', + 'quantity', 'int', 'NULL', '', '', '', + 'waive_setup', 'char', 'NULL', 1, '', '', + ], + 'primary_key' => 'quotationpkgnum', + 'unique' => [], + 'index' => [ ['pkgpart'], ], + }, + + 'quotation_pkg_discount' => { + 'columns' => [ + 'quotationpkgdiscountnum', 'serial', '', '', '', '', + 'quotationpkgnum', 'int', '', '', '', '', + 'discountnum', 'int', '', '', '', '', + #'end_date', @date_type, '', '', + ], + 'primary_key' => 'quotationpkgdiscountnum', + 'unique' => [], + 'index' => [ [ 'quotationpkgnum' ], ], #[ 'discountnum' ] ], + }, + 'cust_location' => { #'location' now that its prospects too, but... 'columns' => [ 'locationnum', 'serial', '', '', '', '', @@ -1070,6 +1258,8 @@ sub tables_hashref { 'country', 'char', '', 2, '', '', 'geocode', 'varchar', 'NULL', 20, '', '', 'district', 'varchar', 'NULL', 20, '', '', + 'censustract', 'varchar', 'NULL', 20, '', '', + 'censusyear', 'char', 'NULL', 4, '', '', 'location_type', 'varchar', 'NULL', 20, '', '', 'location_number', 'varchar', 'NULL', 20, '', '', 'location_kind', 'char', 'NULL', 1, '', '', @@ -1079,6 +1269,7 @@ sub tables_hashref { 'unique' => [], 'index' => [ [ 'prospectnum' ], [ 'custnum' ], [ 'county' ], [ 'state' ], [ 'country' ], [ 'zip' ], + [ 'city' ], [ 'district' ] ], }, @@ -1133,10 +1324,11 @@ sub tables_hashref { 'cust_class' => { 'columns' => [ - 'classnum', 'serial', '', '', '', '', - 'classname', 'varchar', '', $char_d, '', '', - 'categorynum', 'int', 'NULL', '', '', '', - 'disabled', 'char', 'NULL', 1, '', '', + 'classnum', 'serial', '', '', '', '', + 'classname', 'varchar', '', $char_d, '', '', + 'categorynum', 'int', 'NULL', '', '', '', + 'tax', 'char', 'NULL', 1, '', '', + 'disabled', 'char', 'NULL', 1, '', '', ], 'primary_key' => 'classnum', 'unique' => [], @@ -1169,9 +1361,10 @@ sub tables_hashref { 'cust_main_exemption' => { 'columns' => [ - 'exemptionnum', 'serial', '', '', '', '', - 'custnum', 'int', '', '', '', '', - 'taxname', 'varchar', '', $char_d, '', '', + 'exemptionnum', 'serial', '', '', '', '', + 'custnum', 'int', '', '', '', '', + 'taxname', 'varchar', '', $char_d, '', '', + 'exempt_number', 'varchar', 'NULL', $char_d, '', '', #start/end dates? for reporting? ], 'primary_key' => 'exemptionnum', @@ -1357,6 +1550,7 @@ sub tables_hashref { 'depositor', 'varchar', 'NULL', $char_d, '', '', 'account', 'varchar', 'NULL', 20, '', '', 'teller', 'varchar', 'NULL', 20, '', '', + 'batchnum', 'int', 'NULL', '', '', '', #pay_batch foreign key ], 'primary_key' => 'paynum', #i guess not now, with cust_pay_pending, if we actually make it here, we _do_ want to record it# 'unique' => [ [ 'payunique' ] ], @@ -1367,20 +1561,29 @@ sub tables_hashref { 'columns' => [ 'paynum', 'int', '', '', '', '', 'custnum', 'int', '', '', '', '', - 'paid', @money_type, '', '', '_date', @date_type, '', '', + 'paid', @money_type, '', '', + 'otaker', 'varchar', 'NULL', 32, '', '', + 'usernum', 'int', 'NULL', '', '', '', 'payby', 'char', '', 4, '', '', # CARD/BILL/COMP, should be # index into payby table # eventually 'payinfo', 'varchar', 'NULL', 512, '', '', #see cust_main above 'paymask', 'varchar', 'NULL', $char_d, '', '', + #'paydate' ? 'paybatch', 'varchar', 'NULL', $char_d, '', '', #for auditing purposes. 'closed', 'char', 'NULL', 1, '', '', 'pkgnum', 'int', 'NULL', '', '', '', #desired pkgnum for pkg-balances + # cash/check deposit info fields + 'bank', 'varchar', 'NULL', $char_d, '', '', + 'depositor', 'varchar', 'NULL', $char_d, '', '', + 'account', 'varchar', 'NULL', 20, '', '', + 'teller', 'varchar', 'NULL', 20, '', '', + 'batchnum', 'int', 'NULL', '', '', '', #pay_batch foreign key + + #void fields 'void_date', @date_type, '', '', 'reason', 'varchar', 'NULL', $char_d, '', '', - 'otaker', 'varchar', 'NULL', 32, '', '', - 'usernum', 'int', 'NULL', '', '', '', 'void_usernum', 'int', 'NULL', '', '', '', ], 'primary_key' => 'paynum', @@ -1436,10 +1639,11 @@ sub tables_hashref { 'columns' => [ 'batchnum', 'serial', '', '', '', '', 'agentnum', 'int', 'NULL', '', '', '', - 'payby', 'char', '', 4, '', '', # CARD/CHEK + 'payby', 'char', '', 4, '', '', # CARD/CHEK 'status', 'char', 'NULL', 1, '', '', 'download', @date_type, '', '', 'upload', @date_type, '', '', + 'title', 'varchar', 'NULL',255, '', '', ], 'primary_key' => 'batchnum', 'unique' => [], @@ -1502,6 +1706,8 @@ sub tables_hashref { 'adjourn', @date_type, '', '', 'resume', @date_type, '', '', 'cancel', @date_type, '', '', + 'uncancel', @date_type, '', '', + 'uncancel_pkgnum', 'int', 'NULL', '', '', '', 'expire', @date_type, '', '', 'contract_end', @date_type, '', '', 'dundate', @date_type, '', '', @@ -1596,6 +1802,19 @@ sub tables_hashref { 'index' => [ [ 'billpkgnum' ], [ 'pkgdiscountnum' ] ], }, + 'cust_bill_pkg_discount_void' => { + 'columns' => [ + 'billpkgdiscountnum', 'int', '', '', '', '', + 'billpkgnum', 'int', '', '', '', '', + 'pkgdiscountnum', 'int', '', '', '', '', + 'amount', @money_type, '', '', + 'months', 'decimal', 'NULL', '7,4', '', '', + ], + 'primary_key' => 'billpkgdiscountnum', + 'unique' => [], + 'index' => [ [ 'billpkgnum' ], [ 'pkgdiscountnum' ] ], + }, + 'discount' => { 'columns' => [ 'discountnum', 'serial', '', '', '', '', @@ -1651,14 +1870,15 @@ sub tables_hashref { 'cust_svc' => { 'columns' => [ - 'svcnum', 'serial', '', '', '', '', - 'pkgnum', 'int', 'NULL', '', '', '', - 'svcpart', 'int', '', '', '', '', - 'overlimit', @date_type, '', '', + 'svcnum', 'serial', '', '', '', '', + 'pkgnum', 'int', 'NULL', '', '', '', + 'svcpart', 'int', '', '', '', '', + 'agent_svcid', 'int', 'NULL', '', '', '', + 'overlimit', @date_type, '', '', ], 'primary_key' => 'svcnum', 'unique' => [], - 'index' => [ ['svcnum'], ['pkgnum'], ['svcpart'] ], + 'index' => [ ['svcnum'], ['pkgnum'], ['svcpart'], [ 'agent_svcid' ] ], }, 'cust_svc_option' => { @@ -1673,6 +1893,30 @@ sub tables_hashref { 'index' => [ [ 'svcnum' ], [ 'optionname' ] ], }, + 'svc_export_machine' => { + 'columns' => [ + 'svcexportmachinenum', 'serial', '', '', '', '', + 'svcnum', 'int', '', '', '', '', + 'exportnum', 'int', '', '', '', '', + 'machinenum', 'int', '', '', '', '', + ], + 'primary_key' => 'svcexportmachinenum', + 'unique' => [ ['svcnum', 'exportnum'] ], + 'index' => [], + }, + + 'part_export_machine' => { + 'columns' => [ + 'machinenum', 'serial', '', '', '', '', + 'exportnum', 'int', '', '', '', '', + 'machine', 'varchar', 'NULL', $char_d, '', '', + 'disabled', 'char', 'NULL', 1, '', '', + ], + 'primary_key' => 'machinenum', + 'unique' => [ [ 'exportnum', 'machine' ] ], + 'index' => [ [ 'exportnum' ] ], + }, + 'part_pkg' => { 'columns' => [ 'pkgpart', 'serial', '', '', '', '', @@ -1695,6 +1939,7 @@ sub tables_hashref { 'credit_weight', 'real', 'NULL', '', '', '', 'agentnum', 'int', 'NULL', '', '', '', 'fcc_ds0s', 'int', 'NULL', '', '', '', + 'fcc_voip_class','char', 'NULL', 1, '', '', 'no_auto', 'char', 'NULL', 1, '', '', 'recur_show_zero', 'char', 'NULL', 1, '', '', 'setup_show_zero', 'char', 'NULL', 1, '', '', @@ -1835,6 +2080,7 @@ sub tables_hashref { 'disabled', 'char', 'NULL', 1, '', '', 'preserve', 'char', 'NULL', 1, '', '', 'selfservice_access', 'varchar', 'NULL', $char_d, '', '', + 'classnum', 'int', 'NULL', '', '', '', ], 'primary_key' => 'svcpart', 'unique' => [], @@ -1843,18 +2089,29 @@ sub tables_hashref { 'part_svc_column' => { 'columns' => [ - 'columnnum', 'serial', '', '', '', '', - 'svcpart', 'int', '', '', '', '', - 'columnname', 'varchar', '', 64, '', '', + 'columnnum', 'serial', '', '', '', '', + 'svcpart', 'int', '', '', '', '', + 'columnname', 'varchar', '', 64, '', '', 'columnlabel', 'varchar', 'NULL', $char_d, '', '', - 'columnvalue', 'varchar', 'NULL', $char_d, '', '', - 'columnflag', 'char', 'NULL', 1, '', '', + 'columnvalue', 'varchar', 'NULL', 512, '', '', + 'columnflag', 'char', 'NULL', 1, '', '', ], 'primary_key' => 'columnnum', 'unique' => [ [ 'svcpart', 'columnname' ] ], 'index' => [ [ 'svcpart' ] ], }, + 'part_svc_class' => { + 'columns' => [ + 'classnum', 'serial', '', '', '', '', + 'classname', 'varchar', '', $char_d, '', '', + 'disabled', 'char', 'NULL', 1, '', '', + ], + 'primary_key' => 'classnum', + 'unique' => [], + 'index' => [ ['disabled'] ], + }, + #(this should be renamed to part_pop) 'svc_acct_pop' => { 'columns' => [ @@ -2393,11 +2650,11 @@ sub tables_hashref { 'part_export' => { 'columns' => [ - 'exportnum', 'serial', '', '', '', '', + 'exportnum', 'serial', '', '', '', '', 'exportname', 'varchar', 'NULL', $char_d, '', '', - 'machine', 'varchar', '', $char_d, '', '', - 'exporttype', 'varchar', '', $char_d, '', '', - 'nodomain', 'char', 'NULL', 1, '', '', + 'machine', 'varchar', 'NULL', $char_d, '', '', + 'exporttype', 'varchar', '', $char_d, '', '', + 'nodomain', 'char', 'NULL', 1, '', '', ], 'primary_key' => 'exportnum', 'unique' => [], @@ -2434,6 +2691,8 @@ sub tables_hashref { 'groupname', 'varchar', '', $char_d, '', '', 'description', 'varchar', 'NULL', $char_d, '', '', 'priority', 'int', '', '', '1', '', + 'speed_up', 'int', 'NULL', '', '', '', + 'speed_down', 'int', 'NULL', '', '', '', ], 'primary_key' => 'groupnum', 'unique' => [ ['groupname'] ], @@ -2442,16 +2701,16 @@ sub tables_hashref { 'radius_attr' => { 'columns' => [ - 'attrnum', 'serial', '', '', '', '', - 'groupnum', 'int', '', '', '', '', + 'attrnum', 'serial', '', '', '', '', + 'groupnum', 'int', '', '', '', '', 'attrname', 'varchar', '', $char_d, '', '', - 'value', 'varchar', '', $char_d, '', '', - 'attrtype', 'char', '', 1, '', '', - 'op', 'char', '', 2, '', '', + 'value', 'varchar', '', 255, '', '', + 'attrtype', 'char', '', 1, '', '', + 'op', 'char', '', 2, '', '', ], 'primary_key' => 'attrnum', - 'unique' => [ ['groupnum','attrname'] ], #? - 'index' => [], + 'unique' => [], + 'index' => [ ['groupnum'], ], }, 'msgcat' => { @@ -2486,10 +2745,42 @@ sub tables_hashref { #'custnum', 'int', '', '', '', '' 'billpkgnum', 'int', '', '', '', '', 'taxnum', 'int', '', '', '', '', - 'year', 'int', '', '', '', '', - 'month', 'int', '', '', '', '', + 'year', 'int', 'NULL', '', '', '', + 'month', 'int', 'NULL', '', '', '', 'creditbillpkgnum', 'int', 'NULL', '', '', '', 'amount', @money_type, '', '', + # exemption type flags + 'exempt_cust', 'char', 'NULL', 1, '', '', + 'exempt_setup', 'char', 'NULL', 1, '', '', + 'exempt_recur', 'char', 'NULL', 1, '', '', + 'exempt_cust_taxname', 'char', 'NULL', 1, '', '', + 'exempt_monthly', 'char', 'NULL', 1, '', '', + ], + 'primary_key' => 'exemptpkgnum', + 'unique' => [], + 'index' => [ [ 'taxnum', 'year', 'month' ], + [ 'billpkgnum' ], + [ 'taxnum' ], + [ 'creditbillpkgnum' ], + ], + }, + + 'cust_tax_exempt_pkg_void' => { + 'columns' => [ + 'exemptpkgnum', 'int', '', '', '', '', + #'custnum', 'int', '', '', '', '' + 'billpkgnum', 'int', '', '', '', '', + 'taxnum', 'int', '', '', '', '', + 'year', 'int', 'NULL', '', '', '', + 'month', 'int', 'NULL', '', '', '', + 'creditbillpkgnum', 'int', 'NULL', '', '', '', + 'amount', @money_type, '', '', + # exemption type flags + 'exempt_cust', 'char', 'NULL', 1, '', '', + 'exempt_setup', 'char', 'NULL', 1, '', '', + 'exempt_recur', 'char', 'NULL', 1, '', '', + 'exempt_cust_taxname', 'char', 'NULL', 1, '', '', + 'exempt_monthly', 'char', 'NULL', 1, '', '', ], 'primary_key' => 'exemptpkgnum', 'unique' => [], @@ -2558,7 +2849,7 @@ sub tables_hashref { 'plan_id', 'varchar', 'NULL', $char_d, '', '', ], 'primary_key' => 'svcnum', - 'unique' => [ [ 'mac_addr' ] ], + 'unique' => [ [ 'ip_addr' ], [ 'mac_addr' ] ], 'index' => [], }, @@ -2996,7 +3287,6 @@ sub tables_hashref { ### 'upstream_currency', 'char', 'NULL', 3, '', '', - 'upstream_price', 'decimal', 'NULL', '10,4', '', '', 'upstream_rateplanid', 'int', 'NULL', '', '', '', #? # how it was rated internally... @@ -3021,6 +3311,10 @@ sub tables_hashref { 'charged_party', 'varchar', 'NULL', $char_d, '', '', + 'upstream_price', 'decimal', 'NULL', '10,4', '', '', + 'upstream_src_regionname', 'varchar', 'NULL', $char_d, '', '', + 'upstream_dst_regionname', 'varchar', 'NULL', $char_d, '', '', + # how it was rated internally... 'rated_pretty_dst', 'varchar', 'NULL', $char_d, '', '', 'rated_regionname', 'varchar', 'NULL', $char_d, '', '', @@ -3156,11 +3450,12 @@ sub tables_hashref { 'inventory_item' => { 'columns' => [ - 'itemnum', 'serial', '', '', '', '', - 'classnum', 'int', '', '', '', '', - 'agentnum', 'int', 'NULL', '', '', '', - 'item', 'varchar', '', $char_d, '', '', - 'svcnum', 'int', 'NULL', '', '', '', + 'itemnum', 'serial', '', '', '', '', + 'classnum', 'int', '', '', '', '', + 'agentnum', 'int', 'NULL', '', '', '', + 'item', 'varchar', '', $char_d, '', '', + 'svcnum', 'int', 'NULL', '', '', '', + 'svc_field', 'varchar', 'NULL', $char_d, '', '', ], 'primary_key' => 'itemnum', 'unique' => [ [ 'classnum', 'item' ] ], @@ -3237,6 +3532,17 @@ sub tables_hashref { 'index' => [ [ 'groupnum' ] ], }, + 'access_groupsales' => { + 'columns' => [ + 'groupsalesnum', 'serial', '', '', '', '', + 'groupnum', 'int', '', '', '', '', + 'salesnum', 'int', '', '', '', '', + ], + 'primary_key' => 'groupsalesnum', + 'unique' => [ [ 'groupnum', 'salesnum' ] ], + 'index' => [ [ 'groupnum' ] ], + }, + 'access_right' => { 'columns' => [ 'rightnum', 'serial', '', '', '', '', @@ -3420,6 +3726,8 @@ sub tables_hashref { 'reason_type', 'int', '', '', '', '', 'reason', 'text', '', '', '', '', 'disabled', 'char', 'NULL', 1, '', '', + 'unsuspend_pkgpart', 'int', 'NULL', '', '', '', + 'unsuspend_hold','char', 'NULL', 1, '', '', ], 'primary_key' => 'reasonnum', 'unique' => [], @@ -3642,6 +3950,23 @@ sub tables_hashref { 'index' => [ [ 'upgrade' ] ], }, + 'ftp_target' => { + 'columns' => [ + 'targetnum', 'serial', '', '', '', '', + 'agentnum', 'int', 'NULL', '', '', '', + 'hostname', 'varchar', '', $char_d, '', '', + 'port', 'int', '', '', '', '', + 'username', 'varchar', '', $char_d, '', '', + 'password', 'varchar', '', $char_d, '', '', + 'path', 'varchar', '', $char_d, '', '', + 'secure', 'char', 'NULL', 1, '', '', + 'handling', 'varchar', 'NULL', $char_d, '', '', + ], + 'primary_key' => 'targetnum', + 'unique' => [ [ 'targetnum' ] ], + 'index' => [], + }, + %{ tables_hashref_torrus() }, # tables of ours for doing torrus virtual port combining diff --git a/FS/FS/Setup.pm b/FS/FS/Setup.pm index e2c5a5a2c..e27b66fc5 100644 --- a/FS/FS/Setup.pm +++ b/FS/FS/Setup.pm @@ -209,6 +209,14 @@ sub populate_initial_data { sub initial_data { my %opt = @_; + my $cust_location = FS::cust_location->new({ + 'address1' => '1234 System Lane', + 'city' => 'Systemtown', + 'state' => 'CA', + 'zip' => '54321', + 'country' => 'US', + }); + #tie my %hash, 'Tie::DxHash', tie my %hash, 'Tie::IxHash', @@ -351,14 +359,11 @@ sub initial_data { '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', + 'bill_location' => $cust_location, + 'ship_location' => $cust_location, }, ], diff --git a/FS/FS/TemplateItem_Mixin.pm b/FS/FS/TemplateItem_Mixin.pm new file mode 100644 index 000000000..6d7ea26bc --- /dev/null +++ b/FS/FS/TemplateItem_Mixin.pm @@ -0,0 +1,317 @@ +package FS::TemplateItem_Mixin; + +use strict; +use vars qw( $DEBUG $me ); # but NOT $conf +use Carp; +use FS::UID; +use FS::Record qw( qsearch qsearchs dbh ); +use FS::part_pkg; +use FS::cust_pkg; + +$DEBUG = 0; +$me = '[FS::TemplateItem_Mixin]'; + +=item cust_pkg + +Returns the package (see L<FS::cust_pkg>) for this invoice line item. + +=cut + +sub cust_pkg { + my $self = shift; + carp "$me $self -> cust_pkg" if $DEBUG; + qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } ); +} + +=item part_pkg + +Returns the package definition for this invoice line item. + +=cut + +sub part_pkg { + my $self = shift; + if ( $self->pkgpart_override ) { + qsearchs('part_pkg', { 'pkgpart' => $self->pkgpart_override } ); + } else { + my $part_pkg; + my $cust_pkg = $self->cust_pkg; + $part_pkg = $cust_pkg->part_pkg if $cust_pkg; + $part_pkg; + } + +} + +=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->itemdesc || $self->part_pkg->pkg; + } else { + my $desc = $self->itemdesc || 'Tax'; + $desc .= ' '. $self->itemcomment if $self->itemcomment =~ /\S/; + $desc; + } +} + +=item details [ OPTION => VALUE ... ] + +Returns an array of detail information for the invoice line item. + +Currently available options are: I<format>, I<escape_function> and +I<format_function>. + +If I<format> is set to html or latex then the array members are improved +for tabular appearance in those environments if possible. + +If I<escape_function> is set then the array members are processed by this +function before being returned. + +I<format_function> overrides the normal HTML or LaTeX function for returning +formatted CDRs. It can be set to a subroutine which returns an empty list +to skip usage detail: + + 'format_function' => sub { () }, + +=cut + +sub details { + my ( $self, %opt ) = @_; + my $escape_function = $opt{escape_function} || sub { shift }; + + my $csv = new Text::CSV_XS; + + if ( $opt{format_function} ) { + + #this still expects to be passed a cust_bill_pkg_detail object as the + #second argument, which is expensive + carp "deprecated format_function passed to cust_bill_pkg->details"; + my $format_sub = $opt{format_function} if $opt{format_function}; + + map { ( $_->format eq 'C' + ? &{$format_sub}( $_->detail, $_ ) + : &{$escape_function}( $_->detail ) + ) + } + qsearch ({ 'table' => $self->detail_table, + 'hashref' => { 'billpkgnum' => $self->billpkgnum }, + 'order_by' => 'ORDER BY detailnum', + }); + + } elsif ( $opt{'no_usage'} ) { + + my $sql = "SELECT detail FROM ". $self->detail_table. + " WHERE billpkgnum = ". $self->billpkgnum. + " AND ( format IS NULL OR format != 'C' ) ". + " ORDER BY detailnum"; + my $sth = dbh->prepare($sql) or die dbh->errstr; + $sth->execute or die $sth->errstr; + + map &{$escape_function}( $_->[0] ), @{ $sth->fetchall_arrayref }; + + } else { + + my $format_sub; + my $format = $opt{format} || ''; + if ( $format eq 'html' ) { + + $format_sub = sub { my $detail = shift; + $csv->parse($detail) or return "can't parse $detail"; + join('</TD><TD>', map { &$escape_function($_) } + $csv->fields + ); + }; + + } elsif ( $format eq 'latex' ) { + + $format_sub = sub { + my $detail = shift; + $csv->parse($detail) or return "can't parse $detail"; + #join(' & ', map { '\small{'. &$escape_function($_). '}' } + # $csv->fields ); + my $result = ''; + my $column = 1; + foreach ($csv->fields) { + $result .= ' & ' if $column > 1; + if ($column > 6) { # KLUDGE ALERT! + $result .= '\multicolumn{1}{l}{\scriptsize{'. + &$escape_function($_). '}}'; + }else{ + $result .= '\scriptsize{'. &$escape_function($_). '}'; + } + $column++; + } + $result; + }; + + } else { + + $format_sub = sub { my $detail = shift; + $csv->parse($detail) or return "can't parse $detail"; + join(' - ', map { &$escape_function($_) } + $csv->fields + ); + }; + + } + + my $sql = "SELECT format, detail FROM ". $self->detail_table. + " WHERE billpkgnum = ". $self->billpkgnum. + " ORDER BY detailnum"; + my $sth = dbh->prepare($sql) or die dbh->errstr; + $sth->execute or die $sth->errstr; + + #avoid the fetchall_arrayref and loop for less memory usage? + + map { (defined($_->[0]) && $_->[0] eq 'C') + ? &{$format_sub}( $_->[1] ) + : &{$escape_function}( $_->[1] ); + } + @{ $sth->fetchall_arrayref }; + + } + +} + +=item details_header [ OPTION => VALUE ... ] + +Returns a list representing an invoice line item detail header, if any. +This relies on the behavior of voip_cdr in that it expects the header +to be the first CSV formatted detail (as is expected by invoice generation +routines). Returns the empty list otherwise. + +=cut + +sub details_header { + my $self = shift; + + my $csv = new Text::CSV_XS; + + my @detail = + qsearch ({ 'table' => $self->detail_table, + 'hashref' => { 'billpkgnum' => $self->billpkgnum, + 'format' => 'C', + }, + 'order_by' => 'ORDER BY detailnum LIMIT 1', + }); + return() unless scalar(@detail); + $csv->parse($detail[0]->detail) or return (); + $csv->fields; +} + +=item quantity + +=cut + +sub quantity { + my( $self, $value ) = @_; + if ( defined($value) ) { + $self->setfield('quantity', $value); + } + $self->getfield('quantity') || 1; +} + +=item unitsetup + +=cut + +sub unitsetup { + my( $self, $value ) = @_; + if ( defined($value) ) { + $self->setfield('unitsetup', $value); + } + $self->getfield('unitsetup') eq '' + ? $self->getfield('setup') + : $self->getfield('unitsetup'); +} + +=item unitrecur + +=cut + +sub unitrecur { + my( $self, $value ) = @_; + if ( defined($value) ) { + $self->setfield('unitrecur', $value); + } + $self->getfield('unitrecur') eq '' + ? $self->getfield('recur') + : $self->getfield('unitrecur'); +} + +=item cust_bill_pkg_display [ type => TYPE ] + +Returns an array of display information for the invoice line item optionally +limited to 'TYPE'. + +=cut + +sub cust_bill_pkg_display { + my ( $self, %opt ) = @_; + + my $class = 'FS::'. $self->display_table; + + my $default = $class->new( { billpkgnum =>$self->billpkgnum } ); + + my $type = $opt{type} if exists $opt{type}; + my @result; + + if ( $self->get('display') ) { + @result = grep { defined($type) ? ($type eq $_->type) : 1 } + @{ $self->get('display') }; + } else { + my $hashref = { 'billpkgnum' => $self->billpkgnum }; + $hashref->{type} = $type if defined($type); + + @result = qsearch ({ 'table' => $self->display_table, + 'hashref' => { 'billpkgnum' => $self->billpkgnum }, + 'order_by' => 'ORDER BY billpkgdisplaynum', + }); + } + + push @result, $default unless ( scalar(@result) || $type ); + + @result; + +} + +=item cust_bill_pkg_detail [ CLASSNUM ] + +Returns the list of associated cust_bill_pkg_detail objects +The optional CLASSNUM argument will limit the details to the specified usage +class. + +=cut + +sub cust_bill_pkg_detail { + my $self = shift; + my $classnum = shift || ''; + + my %hash = ( 'billpkgnum' => $self->billpkgnum ); + $hash{classnum} = $classnum if $classnum; + + qsearch( $self->detail_table, \%hash ), + +} + +=item cust_bill_pkg_discount + +Returns the list of associated cust_bill_pkg_discount objects. + +=cut + +sub cust_bill_pkg_discount { + my $self = shift; + qsearch( $self->discount_table, { 'billpkgnum' => $self->billpkgnum } ); +} + +1; diff --git a/FS/FS/Template_Mixin.pm b/FS/FS/Template_Mixin.pm new file mode 100644 index 000000000..d35fd55f2 --- /dev/null +++ b/FS/FS/Template_Mixin.pm @@ -0,0 +1,2560 @@ +package FS::Template_Mixin; + +use strict; +use vars qw( $DEBUG $me + $money_char $date_format $rdate_format $date_format_long ); + # but NOT $conf +use vars qw( $invoice_lines @buf ); #yuck +use List::Util qw(sum); +use Date::Format; +use Date::Language; +use Text::Template 1.20; +use File::Temp 0.14; +use HTML::Entities; +use Locale::Country; +use Cwd; +use FS::UID; +use FS::Record qw( qsearch qsearchs ); +use FS::Misc qw( generate_ps generate_pdf ); +use FS::pkg_category; +use FS::pkg_class; +use FS::L10N; + +$DEBUG = 0; +$me = '[FS::Template_Mixin]'; +FS::UID->install_callback( sub { + my $conf = new FS::Conf; #global + $money_char = $conf->config('money_char') || '$'; + $date_format = $conf->config('date_format') || '%x'; #/YY + $rdate_format = $conf->config('date_format') || '%m/%d/%Y'; #/YYYY + $date_format_long = $conf->config('date_format_long') || '%b %o, %Y'; +} ); + +=item print_text HASHREF | [ TIME [ , TEMPLATE [ , OPTION => VALUE ... ] ] ] + +Returns an text invoice, as a list of lines. + +Options can be passed as a hashref (recommended) or as a list of time, template +and then any key/value pairs for any other options. + +I<time>, if specified, is 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. + +I<template>, if specified, is the name of a suffix for alternate invoices. + +I<notice_name>, if specified, overrides "Invoice" as the name of the sent document (templates from 10/2009 or newer required) + +=cut + +sub print_text { + my $self = shift; + my( $today, $template, %opt ); + if ( ref($_[0]) ) { + %opt = %{ shift() }; + $today = delete($opt{'time'}) || ''; + $template = delete($opt{template}) || ''; + } else { + ( $today, $template, %opt ) = @_; + } + + my %params = ( 'format' => 'template' ); + $params{'time'} = $today if $today; + $params{'template'} = $template if $template; + $params{$_} = $opt{$_} + foreach grep $opt{$_}, qw( unsquelch_cdr notice_name ); + + $self->print_generic( %params ); +} + +=item print_latex HASHREF | [ TIME [ , TEMPLATE [ , OPTION => VALUE ... ] ] ] + +Internal method - returns a filename of a filled-in LaTeX template for this +invoice (Note: add ".tex" to get the actual filename), and a filename of +an associated logo (with the .eps extension included). + +See print_ps and print_pdf for methods that return PostScript and PDF output. + +Options can be passed as a hashref (recommended) or as a list of time, template +and then any key/value pairs for any other options. + +I<time>, if specified, is 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. + +I<template>, if specified, is the name of a suffix for alternate invoices. + +I<notice_name>, if specified, overrides "Invoice" as the name of the sent document (templates from 10/2009 or newer required) + +=cut + +sub print_latex { + my $self = shift; + my $conf = $self->conf; + my( $today, $template, %opt ); + if ( ref($_[0]) ) { + %opt = %{ shift() }; + $today = delete($opt{'time'}) || ''; + $template = delete($opt{template}) || ''; + } else { + ( $today, $template, %opt ) = @_; + } + + my %params = ( 'format' => 'latex' ); + $params{'time'} = $today if $today; + $params{'template'} = $template if $template; + $params{$_} = $opt{$_} + foreach grep $opt{$_}, qw( unsquelch_cdr notice_name ); + + $template ||= $self->_agent_template + if $self->can('_agent_template'); + + my $pkey = $self->primary_key; + my $tmp_template = $self->table. '.'. $self->$pkey. '.XXXXXXXX'; + + my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc; + my $lh = new File::Temp( + TEMPLATE => $tmp_template, + DIR => $dir, + SUFFIX => '.eps', + UNLINK => 0, + ) or die "can't open temp file: $!\n"; + + my $agentnum = $self->cust_main->agentnum; + + if ( $template && $conf->exists("logo_${template}.eps", $agentnum) ) { + print $lh $conf->config_binary("logo_${template}.eps", $agentnum) + or die "can't write temp file: $!\n"; + } else { + print $lh $conf->config_binary('logo.eps', $agentnum) + or die "can't write temp file: $!\n"; + } + close $lh; + $params{'logo_file'} = $lh->filename; + + if( $conf->exists('invoice-barcode') + && $self->can('invoice_barcode') + && $self->invnum ) { # don't try to barcode statements + my $png_file = $self->invoice_barcode($dir); + my $eps_file = $png_file; + $eps_file =~ s/\.png$/.eps/g; + $png_file =~ /(barcode.*png)/; + $png_file = $1; + $eps_file =~ /(barcode.*eps)/; + $eps_file = $1; + + my $curr_dir = cwd(); + chdir($dir); + # after painfuly long experimentation, it was determined that sam2p won't + # accept : and other chars in the path, no matter how hard I tried to + # escape them, hence the chdir (and chdir back, just to be safe) + system('sam2p', '-j:quiet', $png_file, 'EPS:', $eps_file ) == 0 + or die "sam2p failed: $!\n"; + unlink($png_file); + chdir($curr_dir); + + $params{'barcode_file'} = $eps_file; + } + + my @filled_in = $self->print_generic( %params ); + + my $fh = new File::Temp( TEMPLATE => $tmp_template, + DIR => $dir, + SUFFIX => '.tex', + UNLINK => 0, + ) or die "can't open temp file: $!\n"; + binmode($fh, ':utf8'); # language support + print $fh join('', @filled_in ); + close $fh; + + $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename; + return ($1, $params{'logo_file'}, $params{'barcode_file'}); + +} + +=item print_generic OPTION => VALUE ... + +Internal method - returns a filled-in template for this invoice as a scalar. + +See print_ps and print_pdf for methods that return PostScript and PDF output. + +Non optional options include + format - latex, html, template + +Optional options include + +template - a value used as a suffix for a configuration template + +time - a 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 - + +unsquelch_cdr - overrides any per customer cdr squelching when true + +notice_name - overrides "Invoice" as the name of the sent document (templates from 10/2009 or newer required) + +locale - override customer's locale + +=cut + +#what's with all the sprintf('%10.2f')'s in here? will it cause any +# (alignment in text invoice?) problems to change them all to '%.2f' ? +# yes: fixed width/plain text printing will be borked +sub print_generic { + my( $self, %params ) = @_; + my $conf = $self->conf; + my $today = $params{today} ? $params{today} : time; + warn "$me print_generic called on $self with suffix $params{template}\n" + if $DEBUG; + + my $format = $params{format}; + die "Unknown format: $format" + unless $format =~ /^(latex|html|template)$/; + + my $cust_main = $self->cust_main || $self->prospect_main; + $cust_main->payname( $cust_main->first. ' '. $cust_main->getfield('last') ) + unless $cust_main->payname + && $cust_main->payby !~ /^(CARD|DCRD|CHEK|DCHK)$/; + + my %delimiters = ( 'latex' => [ '[@--', '--@]' ], + 'html' => [ '<%=', '%>' ], + 'template' => [ '{', '}' ], + ); + + warn "$me print_generic creating template\n" + if $DEBUG > 1; + + #create the template + my $template = $params{template} ? $params{template} : $self->_agent_template; + my $templatefile = $self->template_conf. $format; + $templatefile .= "_$template" + if length($template) && $conf->exists($templatefile."_$template"); + my @invoice_template = map "$_\n", $conf->config($templatefile) + or die "cannot load config data $templatefile"; + + my $old_latex = ''; + if ( $format eq 'latex' && 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"; + $old_latex = 'true'; + @invoice_template = _translate_old_latex_format(@invoice_template); + } + + warn "$me print_generic creating T:T object\n" + if $DEBUG > 1; + + my $text_template = new Text::Template( + TYPE => 'ARRAY', + SOURCE => \@invoice_template, + DELIMITERS => $delimiters{$format}, + ); + + warn "$me print_generic compiling T:T object\n" + if $DEBUG > 1; + + $text_template->compile() + or die "Can't compile $templatefile: $Text::Template::ERROR\n"; + + + # additional substitution could possibly cause breakage in existing templates + my %convert_maps = ( + 'latex' => { + 'notes' => sub { map "$_", @_ }, + 'footer' => sub { map "$_", @_ }, + 'smallfooter' => sub { map "$_", @_ }, + 'returnaddress' => sub { map "$_", @_ }, + 'coupon' => sub { map "$_", @_ }, + 'summary' => sub { map "$_", @_ }, + }, + 'html' => { + 'notes' => + sub { + map { + s/%%(.*)$/<!-- $1 -->/g; + s/\\section\*\{\\textsc\{(.)(.*)\}\}/<p><b><font size="+1">$1<\/font>\U$2<\/b>/g; + s/\\begin\{enumerate\}/<ol>/g; + s/\\item / <li>/g; + s/\\end\{enumerate\}/<\/ol>/g; + s/\\textbf\{(.*)\}/<b>$1<\/b>/g; + s/\\\\\*/<br>/g; + s/\\dollar ?/\$/g; + s/\\#/#/g; + s/~/ /g; + $_; + } @_ + }, + 'footer' => + sub { map { s/~/ /g; s/\\\\\*?\s*$/<BR>/; $_; } @_ }, + 'smallfooter' => + sub { map { s/~/ /g; s/\\\\\*?\s*$/<BR>/; $_; } @_ }, + 'returnaddress' => + sub { + map { + s/~/ /g; + s/\\\\\*?\s*$/<BR>/; + s/\\hyphenation\{[\w\s\-]+}//; + s/\\([&])/$1/g; + $_; + } @_ + }, + 'coupon' => sub { "" }, + 'summary' => sub { "" }, + }, + 'template' => { + 'notes' => + sub { + map { + s/%%.*$//g; + s/\\section\*\{\\textsc\{(.*)\}\}/\U$1/g; + s/\\begin\{enumerate\}//g; + s/\\item / * /g; + s/\\end\{enumerate\}//g; + s/\\textbf\{(.*)\}/$1/g; + s/\\\\\*/ /; + s/\\dollar ?/\$/g; + $_; + } @_ + }, + 'footer' => + sub { map { s/~/ /g; s/\\\\\*?\s*$/\n/; $_; } @_ }, + 'smallfooter' => + sub { map { s/~/ /g; s/\\\\\*?\s*$/\n/; $_; } @_ }, + 'returnaddress' => + sub { + map { + s/~/ /g; + s/\\\\\*?\s*$/\n/; # dubious + s/\\hyphenation\{[\w\s\-]+}//; + $_; + } @_ + }, + 'coupon' => sub { "" }, + 'summary' => sub { "" }, + }, + ); + + + # hashes for differing output formats + my %nbsps = ( 'latex' => '~', + 'html' => '', # '&nbps;' would be nice + 'template' => '', # not used + ); + my $nbsp = $nbsps{$format}; + + my %escape_functions = ( 'latex' => \&_latex_escape, + 'html' => \&_html_escape_nbsp,#\&encode_entities, + 'template' => sub { shift }, + ); + my $escape_function = $escape_functions{$format}; + my $escape_function_nonbsp = ($format eq 'html') + ? \&_html_escape : $escape_function; + + my %date_formats = ( 'latex' => $date_format_long, + 'html' => $date_format_long, + 'template' => '%s', + ); + $date_formats{'html'} =~ s/ / /g; + + my $date_format = $date_formats{$format}; + + my %embolden_functions = ( 'latex' => sub { return '\textbf{'. shift(). '}' + }, + 'html' => sub { return '<b>'. shift(). '</b>' + }, + 'template' => sub { shift }, + ); + my $embolden_function = $embolden_functions{$format}; + + my %newline_tokens = ( 'latex' => '\\\\', + 'html' => '<br>', + 'template' => "\n", + ); + my $newline_token = $newline_tokens{$format}; + + warn "$me generating template variables\n" + if $DEBUG > 1; + + # generate template variables + my $returnaddress; + if ( + defined( $conf->config_orbase( "invoice_${format}returnaddress", + $template + ) + ) + && length( $conf->config_orbase( "invoice_${format}returnaddress", + $template + ) + ) + ) { + + $returnaddress = join("\n", + $conf->config_orbase("invoice_${format}returnaddress", $template) + ); + + } elsif ( grep /\S/, + $conf->config_orbase('invoice_latexreturnaddress', $template) ) { + + my $convert_map = $convert_maps{$format}{'returnaddress'}; + $returnaddress = + join( "\n", + &$convert_map( $conf->config_orbase( "invoice_latexreturnaddress", + $template + ) + ) + ); + } elsif ( grep /\S/, $conf->config('company_address', $cust_main->agentnum) ) { + + my $convert_map = $convert_maps{$format}{'returnaddress'}; + $returnaddress = join( "\n", &$convert_map( + map { s/( {2,})/'~' x length($1)/eg; + s/$/\\\\\*/; + $_ + } + ( $conf->config('company_name', $cust_main->agentnum), + $conf->config('company_address', $cust_main->agentnum), + ) + ) + ); + + } else { + + my $warning = "Couldn't find a return address; ". + "do you need to set the company_address configuration value?"; + warn "$warning\n"; + $returnaddress = $nbsp; + #$returnaddress = $warning; + + } + + warn "$me generating invoice data\n" + if $DEBUG > 1; + + my $agentnum = $cust_main->agentnum; + + my %invoice_data = ( + + #invoice from info + 'company_name' => scalar( $conf->config('company_name', $agentnum) ), + 'company_address' => join("\n", $conf->config('company_address', $agentnum) ). "\n", + 'company_phonenum'=> scalar( $conf->config('company_phonenum', $agentnum) ), + 'returnaddress' => $returnaddress, + 'agent' => &$escape_function($cust_main->agent->agent), + + #invoice/quotation info + 'invnum' => $self->invnum, + 'quotationnum' => $self->quotationnum, + 'date' => time2str($date_format, $self->_date), + 'today' => time2str($date_format_long, $today), + 'terms' => $self->terms, + 'template' => $template, #params{'template'}, + 'notice_name' => ($params{'notice_name'} || $self->notice_name),#escape_function? + 'current_charges' => sprintf("%.2f", $self->charged), + 'duedate' => $self->due_date2str($rdate_format), #date_format? + + #customer info + 'custnum' => $cust_main->display_custnum, + 'prospectnum' => $cust_main->prospectnum, + 'agent_custid' => &$escape_function($cust_main->agent_custid), + ( map { $_ => &$escape_function($cust_main->$_()) } qw( + payname company address1 address2 city state zip fax + )), + + #global config + 'ship_enable' => $conf->exists('invoice-ship_address'), + 'unitprices' => $conf->exists('invoice-unitprice'), + 'smallernotes' => $conf->exists('invoice-smallernotes'), + 'smallerfooter' => $conf->exists('invoice-smallerfooter'), + 'balance_due_below_line' => $conf->exists('balance_due_below_line'), + + #layout info -- would be fancy to calc some of this and bury the template + # here in the code + 'topmargin' => scalar($conf->config('invoice_latextopmargin', $agentnum)), + 'headsep' => scalar($conf->config('invoice_latexheadsep', $agentnum)), + 'textheight' => scalar($conf->config('invoice_latextextheight', $agentnum)), + 'extracouponspace' => scalar($conf->config('invoice_latexextracouponspace', $agentnum)), + 'couponfootsep' => scalar($conf->config('invoice_latexcouponfootsep', $agentnum)), + 'verticalreturnaddress' => $conf->exists('invoice_latexverticalreturnaddress', $agentnum), + 'addresssep' => scalar($conf->config('invoice_latexaddresssep', $agentnum)), + 'amountenclosedsep' => scalar($conf->config('invoice_latexcouponamountenclosedsep', $agentnum)), + 'coupontoaddresssep' => scalar($conf->config('invoice_latexcoupontoaddresssep', $agentnum)), + 'addcompanytoaddress' => $conf->exists('invoice_latexcouponaddcompanytoaddress', $agentnum), + + # better hang on to conf_dir for a while (for old templates) + 'conf_dir' => "$FS::UID::conf_dir/conf.$FS::UID::datasrc", + + #these are only used when doing paged plaintext + 'page' => 1, + 'total_pages' => 1, + + ); + + #localization + my $lh = FS::L10N->get_handle( $params{'locale'} || $cust_main->locale ); + $invoice_data{'emt'} = sub { &$escape_function($self->mt(@_)) }; + my %info = FS::Locales->locale_info($cust_main->locale || 'en_US'); + # eval to avoid death for unimplemented languages + my $dh = eval { Date::Language->new($info{'name'}) } || + Date::Language->new(); # fall back to English + # prototype here to silence warnings + $invoice_data{'time2str'} = sub ($;$$) { $dh->time2str(@_) }; + # eventually use this date handle everywhere in here, too + + my $min_sdate = 999999999999; + my $max_edate = 0; + foreach my $cust_bill_pkg ( $self->cust_bill_pkg ) { + next unless $cust_bill_pkg->pkgnum > 0; + $min_sdate = $cust_bill_pkg->sdate + if length($cust_bill_pkg->sdate) && $cust_bill_pkg->sdate < $min_sdate; + $max_edate = $cust_bill_pkg->edate + if length($cust_bill_pkg->edate) && $cust_bill_pkg->edate > $max_edate; + } + + $invoice_data{'bill_period'} = ''; + $invoice_data{'bill_period'} = time2str('%e %h', $min_sdate) + . " to " . time2str('%e %h', $max_edate) + if ($max_edate != 0 && $min_sdate != 999999999999); + + $invoice_data{finance_section} = ''; + if ( $conf->config('finance_pkgclass') ) { + my $pkg_class = + qsearchs('pkg_class', { classnum => $conf->config('finance_pkgclass') }); + $invoice_data{finance_section} = $pkg_class->categoryname; + } + $invoice_data{finance_amount} = '0.00'; + $invoice_data{finance_section} ||= 'Finance Charges'; #avoid config confusion + + my $countrydefault = $conf->config('countrydefault') || 'US'; + foreach ( qw( address1 address2 city state zip country fax) ){ + my $method = 'ship_'.$_; + $invoice_data{"ship_$_"} = _latex_escape($cust_main->$method); + } + foreach ( qw( contact company ) ) { #compatibility + $invoice_data{"ship_$_"} = _latex_escape($cust_main->$_); + } + $invoice_data{'ship_country'} = '' + if ( $invoice_data{'ship_country'} eq $countrydefault ); + + $invoice_data{'cid'} = $params{'cid'} + if $params{'cid'}; + + if ( $cust_main->country eq $countrydefault ) { + $invoice_data{'country'} = ''; + } else { + $invoice_data{'country'} = &$escape_function(code2country($cust_main->country)); + } + + my @address = (); + $invoice_data{'address'} = \@address; + push @address, + $cust_main->payname. + ( ( $cust_main->payby eq 'BILL' ) && $cust_main->payinfo + ? " (P.O. #". $cust_main->payinfo. ")" + : '' + ) + ; + push @address, $cust_main->company + if $cust_main->company; + push @address, $cust_main->address1; + push @address, $cust_main->address2 + if $cust_main->address2; + push @address, + $cust_main->city. ", ". $cust_main->state. " ". $cust_main->zip; + push @address, $invoice_data{'country'} + if $invoice_data{'country'}; + push @address, '' + while (scalar(@address) < 5); + + $invoice_data{'logo_file'} = $params{'logo_file'} + if $params{'logo_file'}; + $invoice_data{'barcode_file'} = $params{'barcode_file'} + if $params{'barcode_file'}; + $invoice_data{'barcode_img'} = $params{'barcode_img'} + if $params{'barcode_img'}; + $invoice_data{'barcode_cid'} = $params{'barcode_cid'} + if $params{'barcode_cid'}; + + 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; + + # the customer's current balance as shown on the invoice before this one + $invoice_data{'true_previous_balance'} = sprintf("%.2f", ($self->previous_balance || 0) ); + + # the change in balance from that invoice to this one + $invoice_data{'balance_adjustments'} = sprintf("%.2f", ($self->previous_balance || 0) - ($self->billing_balance || 0) ); + + # the sum of amount owed on all previous invoices + $invoice_data{'previous_balance'} = sprintf("%.2f", $pr_total); + + # the sum of amount owed on all invoices + $invoice_data{'balance'} = sprintf("%.2f", $balance_due); + + # info from customer's last invoice before this one, for some + # summary formats + $invoice_data{'last_bill'} = {}; + my $last_bill = $pr_cust_bill[-1]; + if ( $last_bill ) { + $invoice_data{'last_bill'} = { + '_date' => $last_bill->_date, #unformatted + # all we need for now + }; + } + + my $summarypage = ''; + if ( $conf->exists('invoice_usesummary', $agentnum) ) { + $summarypage = 1; + } + $invoice_data{'summarypage'} = $summarypage; + + warn "$me substituting variables in notes, footer, smallfooter\n" + if $DEBUG > 1; + + my $tc = $self->template_conf; + my @include = ( [ $tc, 'notes' ], + [ 'invoice_', 'footer' ], + [ 'invoice_', 'smallfooter', ], + ); + push @include, [ $tc, 'coupon', ] + unless $params{'no_coupon'}; + + foreach my $i (@include) { + + my($base, $include) = @$i; + + my $inc_file = $conf->key_orbase("$base$format$include", $template); + my @inc_src; + + if ( $conf->exists($inc_file, $agentnum) + && length( $conf->config($inc_file, $agentnum) ) ) { + + @inc_src = $conf->config($inc_file, $agentnum); + + } else { + + $inc_file = $conf->key_orbase("${base}latex$include", $template); + + my $convert_map = $convert_maps{$format}{$include}; + + @inc_src = map { s/\[\@--/$delimiters{$format}[0]/g; + s/--\@\]/$delimiters{$format}[1]/g; + $_; + } + &$convert_map( $conf->config($inc_file, $agentnum) ); + + } + + my $inc_tt = new Text::Template ( + TYPE => 'ARRAY', + SOURCE => [ map "$_\n", @inc_src ], + DELIMITERS => $delimiters{$format}, + ) or die "Can't create new Text::Template object: $Text::Template::ERROR"; + + unless ( $inc_tt->compile() ) { + my $error = "Can't compile $inc_file template: $Text::Template::ERROR\n"; + warn $error. "Template:\n". join('', map "$_\n", @inc_src); + die $error; + } + + $invoice_data{$include} = $inc_tt->fill_in( HASH => \%invoice_data ); + + $invoice_data{$include} =~ s/\n+$// + if ($format eq 'latex'); + } + + # let invoices use either of these as needed + $invoice_data{'po_num'} = ($cust_main->payby eq 'BILL') + ? $cust_main->payinfo : ''; + $invoice_data{'po_line'} = + ( $cust_main->payby eq 'BILL' && $cust_main->payinfo ) + ? &$escape_function($self->mt("Purchase Order #").$cust_main->payinfo) + : $nbsp; + + my %money_chars = ( 'latex' => '', + 'html' => $conf->config('money_char') || '$', + 'template' => '', + ); + my $money_char = $money_chars{$format}; + + my %other_money_chars = ( 'latex' => '\dollar ',#XXX should be a config too + 'html' => $conf->config('money_char') || '$', + 'template' => '', + ); + my $other_money_char = $other_money_chars{$format}; + $invoice_data{'dollar'} = $other_money_char; + + my @detail_items = (); + my @total_items = (); + my @buf = (); + my @sections = (); + + $invoice_data{'detail_items'} = \@detail_items; + $invoice_data{'total_items'} = \@total_items; + $invoice_data{'buf'} = \@buf; + $invoice_data{'sections'} = \@sections; + + warn "$me generating sections\n" + if $DEBUG > 1; + + # Previous Charges section + # subtotal is the first return value from $self->previous + my $previous_section = { 'description' => $self->mt('Previous Charges'), + 'subtotal' => $other_money_char. + sprintf('%.2f', $pr_total), + 'summarized' => '', #why? $summarypage ? 'Y' : '', + }; + $previous_section->{posttotal} = '0 / 30 / 60 / 90 days overdue '. + join(' / ', map { $cust_main->balance_date_range(@$_) } + $self->_prior_month30s + ) + if $conf->exists('invoice_include_aging'); + + my $taxtotal = 0; + my $tax_section = { 'description' => $self->mt('Taxes, Surcharges, and Fees'), + 'subtotal' => $taxtotal, # adjusted below + }; + my $tax_weight = _pkg_category($tax_section->{description}) + ? _pkg_category($tax_section->{description})->weight + : 0; + $tax_section->{'summarized'} = ''; #why? $summarypage && !$tax_weight ? 'Y' : ''; + $tax_section->{'sort_weight'} = $tax_weight; + + + my $adjusttotal = 0; + my $adjust_section = { 'description' => + $self->mt('Credits, Payments, and Adjustments'), + 'subtotal' => 0, # adjusted below + }; + my $adjust_weight = _pkg_category($adjust_section->{description}) + ? _pkg_category($adjust_section->{description})->weight + : 0; + $adjust_section->{'summarized'} = ''; #why? $summarypage && !$adjust_weight ? 'Y' : ''; + $adjust_section->{'sort_weight'} = $adjust_weight; + + my $unsquelched = $params{unsquelch_cdr} || $cust_main->squelch_cdr ne 'Y'; + my $multisection = $conf->exists('invoice_sections', $cust_main->agentnum); + $invoice_data{'multisection'} = $multisection; + my $late_sections = []; + my $extra_sections = []; + my $extra_lines = (); + + my $default_section = { 'description' => '', + 'subtotal' => '', + 'no_subtotal' => 1, + }; + + if ( $multisection ) { + ($extra_sections, $extra_lines) = + $self->_items_extra_usage_sections($escape_function_nonbsp, $format) + if $conf->exists('usage_class_as_a_section', $cust_main->agentnum) + && $self->can('_items_extra_usage_sections'); + + push @$extra_sections, $adjust_section if $adjust_section->{sort_weight}; + + push @detail_items, @$extra_lines if $extra_lines; + push @sections, + $self->_items_sections( $late_sections, # this could stand a refactor + $summarypage, + $escape_function_nonbsp, + $extra_sections, + $format, #bah + ); + if ( $conf->exists('svc_phone_sections') + && $self->can('_items_svc_phone_sections') + ) + { + my ($phone_sections, $phone_lines) = + $self->_items_svc_phone_sections($escape_function_nonbsp, $format); + push @{$late_sections}, @$phone_sections; + push @detail_items, @$phone_lines; + } + if ( $conf->exists('voip-cust_accountcode_cdr') + && $cust_main->accountcode_cdr + && $self->can('_items_accountcode_cdr') + ) + { + my ($accountcode_section, $accountcode_lines) = + $self->_items_accountcode_cdr($escape_function_nonbsp,$format); + if ( scalar(@$accountcode_lines) ) { + push @{$late_sections}, $accountcode_section; + push @detail_items, @$accountcode_lines; + } + } + } else {# not multisection + # make a default section + push @sections, $default_section; + # and calculate the finance charge total, since it won't get done otherwise. + # XXX possibly other totals? + # XXX possibly finance_pkgclass should not be used in this manner? + if ( $conf->exists('finance_pkgclass') ) { + my @finance_charges; + foreach my $cust_bill_pkg ( $self->cust_bill_pkg ) { + if ( grep { $_->section eq $invoice_data{finance_section} } + $cust_bill_pkg->cust_bill_pkg_display ) { + # I think these are always setup fees, but just to be sure... + push @finance_charges, $cust_bill_pkg->recur + $cust_bill_pkg->setup; + } + } + $invoice_data{finance_amount} = + sprintf('%.2f', sum( @finance_charges ) || 0); + } + } + + # previous invoice balances in the Previous Charges section if there + # is one, otherwise in the main detail section + if ( $self->can('_items_previous') && + $self->enable_previous && + ! $conf->exists('previous_balance-summary_only') ) { + + warn "$me adding previous balances\n" + if $DEBUG > 1; + + foreach my $line_item ( $self->_items_previous ) { + + my $detail = { + ext_description => [], + }; + $detail->{'ref'} = $line_item->{'pkgnum'}; + $detail->{'quantity'} = 1; + $detail->{'section'} = $multisection ? $previous_section + : $default_section; + $detail->{'description'} = &$escape_function($line_item->{'description'}); + if ( exists $line_item->{'ext_description'} ) { + @{$detail->{'ext_description'}} = map { + &$escape_function($_); + } @{$line_item->{'ext_description'}}; + } + $detail->{'amount'} = ( $old_latex ? '' : $money_char). + $line_item->{'amount'}; + $detail->{'product_code'} = $line_item->{'pkgpart'} || 'N/A'; + + push @detail_items, $detail; + push @buf, [ $detail->{'description'}, + $money_char. sprintf("%10.2f", $line_item->{'amount'}), + ]; + } + + } + + if ( @pr_cust_bill && $self->enable_previous ) { + push @buf, ['','-----------']; + push @buf, [ $self->mt('Total Previous Balance'), + $money_char. sprintf("%10.2f", $pr_total) ]; + push @buf, ['','']; + } + + if ( $conf->exists('svc_phone-did-summary') && $self->can('_did_summary') ) { + warn "$me adding DID summary\n" + if $DEBUG > 1; + + my ($didsummary,$minutes) = $self->_did_summary; + my $didsummary_desc = 'DID Activity Summary (since last invoice)'; + push @detail_items, + { 'description' => $didsummary_desc, + 'ext_description' => [ $didsummary, $minutes ], + }; + } + + foreach my $section (@sections, @$late_sections) { + + warn "$me adding section \n". Dumper($section) + if $DEBUG > 1; + + # begin some normalization + $section->{'subtotal'} = $section->{'amount'} + if $multisection + && !exists($section->{subtotal}) + && exists($section->{amount}); + + $invoice_data{finance_amount} = sprintf('%.2f', $section->{'subtotal'} ) + if ( $invoice_data{finance_section} && + $section->{'description'} eq $invoice_data{finance_section} ); + + $section->{'subtotal'} = $other_money_char. + sprintf('%.2f', $section->{'subtotal'}) + if $multisection; + + # continue some normalization + $section->{'amount'} = $section->{'subtotal'} + if $multisection; + + + if ( $section->{'description'} ) { + push @buf, ( [ &$escape_function($section->{'description'}), '' ], + [ '', '' ], + ); + } + + warn "$me setting options\n" + if $DEBUG > 1; + + my %options = (); + $options{'section'} = $section if $multisection; + $options{'format'} = $format; + $options{'escape_function'} = $escape_function; + $options{'no_usage'} = 1 unless $unsquelched; + $options{'unsquelched'} = $unsquelched; + $options{'summary_page'} = $summarypage; + $options{'skip_usage'} = + scalar(@$extra_sections) && !grep{$section == $_} @$extra_sections; + $options{'multisection'} = $multisection; + + warn "$me searching for line items\n" + if $DEBUG > 1; + + foreach my $line_item ( $self->_items_pkg(%options) ) { + + warn "$me adding line item $line_item\n" + if $DEBUG > 1; + + my $detail = { + ext_description => [], + }; + $detail->{'ref'} = $line_item->{'pkgnum'}; + $detail->{'quantity'} = $line_item->{'quantity'}; + $detail->{'section'} = $section; + $detail->{'description'} = &$escape_function($line_item->{'description'}); + if ( exists $line_item->{'ext_description'} ) { + @{$detail->{'ext_description'}} = @{$line_item->{'ext_description'}}; + } + $detail->{'amount'} = ( $old_latex ? '' : $money_char ). + $line_item->{'amount'}; + if ( exists $line_item->{'unit_amount'} ) { + $detail->{'unit_amount'} = ( $old_latex ? '' : $money_char ). + $line_item->{'unit_amount'}; + } + $detail->{'product_code'} = $line_item->{'pkgpart'} || 'N/A'; + + $detail->{'sdate'} = $line_item->{'sdate'}; + $detail->{'edate'} = $line_item->{'edate'}; + $detail->{'seconds'} = $line_item->{'seconds'}; + + push @detail_items, $detail; + push @buf, ( [ $detail->{'description'}, + $money_char. sprintf("%10.2f", $line_item->{'amount'}), + ], + map { [ " ". $_, '' ] } @{$detail->{'ext_description'}}, + ); + } + + if ( $section->{'description'} ) { + push @buf, ( ['','-----------'], + [ $section->{'description'}. ' sub-total', + $section->{'subtotal'} # already formatted this + ], + [ '', '' ], + [ '', '' ], + ); + } + + } + + $invoice_data{current_less_finance} = + sprintf('%.2f', $self->charged - $invoice_data{finance_amount} ); + + # create a major section for previous balance if we have major sections, + # or if previous_section is in summary form + if ( ( $multisection && $self->enable_previous ) + || $conf->exists('previous_balance-summary_only') ) + { + unshift @sections, $previous_section if $pr_total; + } + + warn "$me adding taxes\n" + if $DEBUG > 1; + + foreach my $tax ( $self->_items_tax ) { + + $taxtotal += $tax->{'amount'}; + + my $description = &$escape_function( $tax->{'description'} ); + my $amount = sprintf( '%.2f', $tax->{'amount'} ); + + if ( $multisection ) { + + my $money = $old_latex ? '' : $money_char; + push @detail_items, { + ext_description => [], + ref => '', + quantity => '', + description => $description, + amount => $money. $amount, + product_code => '', + section => $tax_section, + }; + + } else { + + push @total_items, { + 'total_item' => $description, + 'total_amount' => $other_money_char. $amount, + }; + + } + + push @buf,[ $description, + $money_char. $amount, + ]; + + } + + if ( $taxtotal ) { + my $total = {}; + $total->{'total_item'} = $self->mt('Sub-total'); + $total->{'total_amount'} = + $other_money_char. sprintf('%.2f', $self->charged - $taxtotal ); + + if ( $multisection ) { + $tax_section->{'subtotal'} = $other_money_char. + sprintf('%.2f', $taxtotal); + $tax_section->{'pretotal'} = 'New charges sub-total '. + $total->{'total_amount'}; + push @sections, $tax_section if $taxtotal; + }else{ + unshift @total_items, $total; + } + } + $invoice_data{'taxtotal'} = sprintf('%.2f', $taxtotal); + + push @buf,['','-----------']; + push @buf,[$self->mt( + (!$self->enable_previous) + ? 'Total Charges' + : 'Total New Charges' + ), + $money_char. sprintf("%10.2f",$self->charged) ]; + push @buf,['','']; + + # calculate total, possibly including total owed on previous + # invoices + { + my $total = {}; + my $item = 'Total'; + $item = $conf->config('previous_balance-exclude_from_total') + || 'Total New Charges' + if $conf->exists('previous_balance-exclude_from_total'); + my $amount = $self->charged; + if ( $self->enable_previous and !$conf->exists('previous_balance-exclude_from_total') ) { + $amount += $pr_total; + } + + $total->{'total_item'} = &$embolden_function($self->mt($item)); + $total->{'total_amount'} = + &$embolden_function( $other_money_char. sprintf( '%.2f', $amount ) ); + if ( $multisection ) { + if ( $adjust_section->{'sort_weight'} ) { + $adjust_section->{'posttotal'} = $self->mt('Balance Forward').' '. + $other_money_char. sprintf("%.2f", ($self->billing_balance || 0) ); + } else { + $adjust_section->{'pretotal'} = $self->mt('New charges total').' '. + $other_money_char. sprintf('%.2f', $self->charged ); + } + }else{ + push @total_items, $total; + } + push @buf,['','-----------']; + push @buf,[$item, + $money_char. + sprintf( '%10.2f', $amount ) + ]; + push @buf,['','']; + } + + # if we're showing previous invoices, also show previous + # credits and payments + if ( $self->enable_previous + and $self->can('_items_credits') + and $self->can('_items_payments') ) + { + #foreach my $thing ( sort { $a->_date <=> $b->_date } $self->_items_credits, $self->_items_payments + + # credits + my $credittotal = 0; + foreach my $credit ( $self->_items_credits('trim_len'=>60) ) { + + my $total; + $total->{'total_item'} = &$escape_function($credit->{'description'}); + $credittotal += $credit->{'amount'}; + $total->{'total_amount'} = '-'. $other_money_char. $credit->{'amount'}; + $adjusttotal += $credit->{'amount'}; + if ( $multisection ) { + my $money = $old_latex ? '' : $money_char; + push @detail_items, { + ext_description => [], + ref => '', + quantity => '', + description => &$escape_function($credit->{'description'}), + amount => $money. $credit->{'amount'}, + product_code => '', + section => $adjust_section, + }; + } else { + push @total_items, $total; + } + + } + $invoice_data{'credittotal'} = sprintf('%.2f', $credittotal); + + #credits (again) + foreach my $credit ( $self->_items_credits('trim_len'=>32) ) { + push @buf, [ $credit->{'description'}, $money_char.$credit->{'amount'} ]; + } + + # payments + my $paymenttotal = 0; + foreach my $payment ( $self->_items_payments ) { + my $total = {}; + $total->{'total_item'} = &$escape_function($payment->{'description'}); + $paymenttotal += $payment->{'amount'}; + $total->{'total_amount'} = '-'. $other_money_char. $payment->{'amount'}; + $adjusttotal += $payment->{'amount'}; + if ( $multisection ) { + my $money = $old_latex ? '' : $money_char; + push @detail_items, { + ext_description => [], + ref => '', + quantity => '', + description => &$escape_function($payment->{'description'}), + amount => $money. $payment->{'amount'}, + product_code => '', + section => $adjust_section, + }; + }else{ + push @total_items, $total; + } + push @buf, [ $payment->{'description'}, + $money_char. sprintf("%10.2f", $payment->{'amount'}), + ]; + } + $invoice_data{'paymenttotal'} = sprintf('%.2f', $paymenttotal); + + if ( $multisection ) { + $adjust_section->{'subtotal'} = $other_money_char. + sprintf('%.2f', $adjusttotal); + push @sections, $adjust_section + unless $adjust_section->{sort_weight}; + } + + # create Balance Due message + { + my $total; + $total->{'total_item'} = &$embolden_function($self->balance_due_msg); + $total->{'total_amount'} = + &$embolden_function( + $other_money_char. sprintf('%.2f', $summarypage + ? $self->charged + + $self->billing_balance + : $self->owed + $pr_total + ) + ); + if ( $multisection && !$adjust_section->{sort_weight} ) { + $adjust_section->{'posttotal'} = $total->{'total_item'}. ' '. + $total->{'total_amount'}; + }else{ + push @total_items, $total; + } + push @buf,['','-----------']; + push @buf,[$self->balance_due_msg, $money_char. + sprintf("%10.2f", $balance_due ) ]; + } + + if ( $conf->exists('previous_balance-show_credit') + and $cust_main->balance < 0 ) { + my $credit_total = { + 'total_item' => &$embolden_function($self->credit_balance_msg), + 'total_amount' => &$embolden_function( + $other_money_char. sprintf('%.2f', -$cust_main->balance) + ), + }; + if ( $multisection ) { + $adjust_section->{'posttotal'} .= $newline_token . + $credit_total->{'total_item'} . ' ' . $credit_total->{'total_amount'}; + } + else { + push @total_items, $credit_total; + } + push @buf,['','-----------']; + push @buf,[$self->credit_balance_msg, $money_char. + sprintf("%10.2f", -$cust_main->balance ) ]; + } + } + + if ( $multisection ) { + if ( $conf->exists('svc_phone_sections') + && $self->can('_items_svc_phone_sections') + ) + { + my $total; + $total->{'total_item'} = &$embolden_function($self->balance_due_msg); + $total->{'total_amount'} = + &$embolden_function( + $other_money_char. sprintf('%.2f', $self->owed + $pr_total) + ); + my $last_section = pop @sections; + $last_section->{'posttotal'} = $total->{'total_item'}. ' '. + $total->{'total_amount'}; + push @sections, $last_section; + } + push @sections, @$late_sections + if $unsquelched; + } + + # make a discounts-available section, even without multisection + if ( $conf->exists('discount-show_available') + and my @discounts_avail = $self->_items_discounts_avail ) { + my $discount_section = { + 'description' => $self->mt('Discounts Available'), + 'subtotal' => '', + 'no_subtotal' => 1, + }; + + push @sections, $discount_section; + push @detail_items, map { +{ + 'ref' => '', #should this be something else? + 'section' => $discount_section, + 'description' => &$escape_function( $_->{description} ), + 'amount' => $money_char . &$escape_function( $_->{amount} ), + 'ext_description' => [ &$escape_function($_->{ext_description}) || () ], + } } @discounts_avail; + } + + # All sections and items are built; now fill in templates. + my @includelist = (); + push @includelist, 'summary' if $summarypage; + foreach my $include ( @includelist ) { + + my $inc_file = $conf->key_orbase("invoice_${format}$include", $template); + my @inc_src; + + if ( length( $conf->config($inc_file, $agentnum) ) ) { + + @inc_src = $conf->config($inc_file, $agentnum); + + } else { + + $inc_file = $conf->key_orbase("invoice_latex$include", $template); + + my $convert_map = $convert_maps{$format}{$include}; + + @inc_src = map { s/\[\@--/$delimiters{$format}[0]/g; + s/--\@\]/$delimiters{$format}[1]/g; + $_; + } + &$convert_map( $conf->config($inc_file, $agentnum) ); + + } + + my $inc_tt = new Text::Template ( + TYPE => 'ARRAY', + SOURCE => [ map "$_\n", @inc_src ], + DELIMITERS => $delimiters{$format}, + ) or die "Can't create new Text::Template object: $Text::Template::ERROR"; + + unless ( $inc_tt->compile() ) { + my $error = "Can't compile $inc_file template: $Text::Template::ERROR\n"; + warn $error. "Template:\n". join('', map "$_\n", @inc_src); + die $error; + } + + $invoice_data{$include} = $inc_tt->fill_in( HASH => \%invoice_data ); + + $invoice_data{$include} =~ s/\n+$// + if ($format eq 'latex'); + } + + $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?" + if ( $format eq 'template' && !$wasfunc ); + + if ($format eq 'template') { + + if ( $invoice_lines ) { + $invoice_data{'total_pages'} = int( scalar(@buf) / $invoice_lines ); + $invoice_data{'total_pages'}++ + if scalar(@buf) % $invoice_lines; + } + + #setup subroutine for the template + $invoice_data{invoice_lines} = sub { + my $lines = shift || scalar(@buf); + map { + scalar(@buf) + ? shift @buf + : [ '', '' ]; + } + ( 1 .. $lines ); + }; + + my $lines; + my @collect; + while (@buf) { + push @collect, split("\n", + $text_template->fill_in( HASH => \%invoice_data ) + ); + $invoice_data{'page'}++; + } + map "$_\n", @collect; + + } else { # this is where we actually create the invoice + + warn "filling in template for invoice ". $self->invnum. "\n" + if $DEBUG; + warn join("\n", map " $_ => ". $invoice_data{$_}, keys %invoice_data). "\n" + if $DEBUG > 1; + + $text_template->fill_in(HASH => \%invoice_data); + } +} + +sub notice_name { '('.shift->table.')'; } + +sub template_conf { 'invoice_'; } + +# helper routine for generating date ranges +sub _prior_month30s { + my $self = shift; + my @ranges = ( + [ 1, 2592000 ], # 0-30 days ago + [ 2592000, 5184000 ], # 30-60 days ago + [ 5184000, 7776000 ], # 60-90 days ago + [ 7776000, 0 ], # 90+ days ago + ); + + map { [ $_->[0] ? $self->_date - $_->[0] - 1 : '', + $_->[1] ? $self->_date - $_->[1] - 1 : '', + ] } + @ranges; +} + +=item print_ps HASHREF | [ TIME [ , TEMPLATE ] ] + +Returns an postscript invoice, as a scalar. + +Options can be passed as a hashref (recommended) or as a list of time, template +and then any key/value pairs for any other options. + +I<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. + +I<notice_name>, if specified, overrides "Invoice" as the name of the sent document (templates from 10/2009 or newer required) + +=cut + +sub print_ps { + my $self = shift; + + my ($file, $logofile, $barcodefile) = $self->print_latex(@_); + my $ps = generate_ps($file); + unlink($logofile); + unlink($barcodefile) if $barcodefile; + + $ps; +} + +=item print_pdf HASHREF | [ TIME [ , TEMPLATE ] ] + +Returns an PDF invoice, as a scalar. + +Options can be passed as a hashref (recommended) or as a list of time, template +and then any key/value pairs for any other options. + +I<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. + +I<template>, if specified, is the name of a suffix for alternate invoices. + +I<notice_name>, if specified, overrides "Invoice" as the name of the sent document (templates from 10/2009 or newer required) + +=cut + +sub print_pdf { + my $self = shift; + + my ($file, $logofile, $barcodefile) = $self->print_latex(@_); + my $pdf = generate_pdf($file); + unlink($logofile); + unlink($barcodefile) if $barcodefile; + + $pdf; +} + +=item print_html HASHREF | [ TIME [ , TEMPLATE [ , CID ] ] ] + +Returns an HTML invoice, as a scalar. + +I<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. + +I<template>, if specified, is the name of a suffix for alternate invoices. + +I<notice_name>, if specified, overrides "Invoice" as the name of the sent document (templates from 10/2009 or newer required) + +I<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 + +sub print_html { + my $self = shift; + my %params; + if ( ref($_[0]) ) { + %params = %{ shift() }; + }else{ + $params{'time'} = shift; + $params{'template'} = shift; + $params{'cid'} = shift; + } + + $params{'format'} = 'html'; + + $self->print_generic( %params ); +} + +# 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; +} + +sub _html_escape { + my $value = shift; + encode_entities($value); + $value; +} + +sub _html_escape_nbsp { + my $value = _html_escape(shift); + $value =~ s/ +/ /g; + $value; +} + +#utility methods for print_* + +sub _translate_old_latex_format { + warn "_translate_old_latex_format called\n" + if $DEBUG; + + my @template = (); + while ( @_ ) { + my $line = shift; + + if ( $line =~ /^%%Detail\s*$/ ) { + + push @template, q![@--!, + q! foreach my $_tr_line (@detail_items) {!, + q! if ( scalar ($_tr_item->{'ext_description'} ) ) {!, + q! $_tr_line->{'description'} .= !, + q! "\\tabularnewline\n~~".!, + q! join( "\\tabularnewline\n~~",!, + q! @{$_tr_line->{'ext_description'}}!, + q! );!, + q! }!; + + while ( ( my $line_item_line = shift ) + !~ /^%%EndDetail\s*$/ ) { + $line_item_line =~ s/'/\\'/g; # nice LTS + $line_item_line =~ s/\\/\\\\/g; # escape quotes and backslashes + $line_item_line =~ s/\$(\w+)/'. \$_tr_line->{$1}. '/g; + push @template, " \$OUT .= '$line_item_line';"; + } + + push @template, '}', + '--@]'; + #' doh, gvim + } elsif ( $line =~ /^%%TotalDetails\s*$/ ) { + + push @template, '[@--', + ' foreach my $_tr_line (@total_items) {'; + + while ( ( my $total_item_line = shift ) + !~ /^%%EndTotalDetails\s*$/ ) { + $total_item_line =~ s/'/\\'/g; # nice LTS + $total_item_line =~ s/\\/\\\\/g; # escape quotes and backslashes + $total_item_line =~ s/\$(\w+)/'. \$_tr_line->{$1}. '/g; + push @template, " \$OUT .= '$total_item_line';"; + } + + push @template, '}', + '--@]'; + + } else { + $line =~ s/\$(\w+)/[\@-- \$$1 --\@]/g; + push @template, $line; + } + + } + + if ($DEBUG) { + warn "$_\n" foreach @template; + } + + (@template); +} + +sub terms { + my $self = shift; + my $conf = $self->conf; + + #check for an invoice-specific override + return $self->invoice_terms if $self->invoice_terms; + + #check for a customer- specific override + my $cust_main = $self->cust_main; + return $cust_main->invoice_terms if $cust_main && $cust_main->invoice_terms; + + #use configured default + $conf->config('invoice_default_terms') || ''; +} + +sub due_date { + my $self = shift; + my $duedate = ''; + if ( $self->terms =~ /^\s*Net\s*(\d+)\s*$/ ) { + $duedate = $self->_date() + ( $1 * 86400 ); + } + $duedate; +} + +sub due_date2str { + my $self = shift; + $self->due_date ? time2str(shift, $self->due_date) : ''; +} + +sub balance_due_msg { + my $self = shift; + my $msg = $self->mt('Balance Due'); + return $msg unless $self->terms; + if ( $self->due_date ) { + $msg .= ' - ' . $self->mt('Please pay by'). ' '. + $self->due_date2str($date_format); + } elsif ( $self->terms ) { + $msg .= ' - '. $self->terms; + } + $msg; +} + +sub balance_due_date { + my $self = shift; + my $conf = $self->conf; + my $duedate = ''; + if ( $conf->exists('invoice_default_terms') + && $conf->config('invoice_default_terms')=~ /^\s*Net\s*(\d+)\s*$/ ) { + $duedate = time2str($rdate_format, $self->_date + ($1*86400) ); + } + $duedate; +} + +sub credit_balance_msg { + my $self = shift; + $self->mt('Credit Balance Remaining') +} + +=item _date_pretty + +Returns a string with the date, for example: "3/20/2008" + +=cut + +sub _date_pretty { + my $self = shift; + time2str($date_format, $self->_date); +} + +=item _items_sections LATE SUMMARYPAGE ESCAPE EXTRA_SECTIONS FORMAT + +Generate section information for all items appearing on this invoice. +This will only be called for multi-section invoices. + +For each line item (L<FS::cust_bill_pkg> record), this will fetch all +related display records (L<FS::cust_bill_pkg_display>) and organize +them into two groups ("early" and "late" according to whether they come +before or after the total), then into sections. A subtotal is calculated +for each section. + +Section descriptions are returned in sort weight order. Each consists +of a hash containing: + +description: the package category name, escaped +subtotal: the total charges in that section +tax_section: a flag indicating that the section contains only tax charges +summarized: same as tax_section, for some reason +sort_weight: the package category's sort weight + +If 'condense' is set on the display record, it also contains everything +returned from C<_condense_section()>, i.e. C<_condensed_foo_generator> +coderefs to generate parts of the invoice. This is not advised. + +Arguments: + +LATE: an arrayref to push the "late" section hashes onto. The "early" +group is simply returned from the method. + +SUMMARYPAGE: a flag indicating whether this is a summary-format invoice. +Turning this on has the following effects: +- Ignores display items with the 'summary' flag. +- Combines all items into the "early" group. +- Creates sections for all non-disabled package categories, even if they +have no charges on this invoice, as well as a section with no name. + +ESCAPE: an escape function to use for section titles. + +EXTRA_SECTIONS: an arrayref of additional sections to return after the +sorted list. If there are any of these, section subtotals exclude +usage charges. + +FORMAT: 'latex', 'html', or 'template' (i.e. text). Not used, but +passed through to C<_condense_section()>. + +=cut + +use vars qw(%pkg_category_cache); +sub _items_sections { + my $self = shift; + my $late = shift; + my $summarypage = shift; + my $escape = shift; + my $extra_sections = shift; + my $format = shift; + + my %subtotal = (); + my %late_subtotal = (); + my %not_tax = (); + + foreach my $cust_bill_pkg ( $self->cust_bill_pkg ) + { + + my $usage = $cust_bill_pkg->usage; + + foreach my $display ($cust_bill_pkg->cust_bill_pkg_display) { + next if ( $display->summary && $summarypage ); + + my $section = $display->section; + my $type = $display->type; + + $not_tax{$section} = 1 + unless $cust_bill_pkg->pkgnum == 0; + + if ( $display->post_total && !$summarypage ) { + if (! $type || $type eq 'S') { + $late_subtotal{$section} += $cust_bill_pkg->setup + if $cust_bill_pkg->setup != 0 + || $cust_bill_pkg->setup_show_zero; + } + + if (! $type) { + $late_subtotal{$section} += $cust_bill_pkg->recur + if $cust_bill_pkg->recur != 0 + || $cust_bill_pkg->recur_show_zero; + } + + if ($type && $type eq 'R') { + $late_subtotal{$section} += $cust_bill_pkg->recur - $usage + if $cust_bill_pkg->recur != 0 + || $cust_bill_pkg->recur_show_zero; + } + + if ($type && $type eq 'U') { + $late_subtotal{$section} += $usage + unless scalar(@$extra_sections); + } + + } else { + + next if $cust_bill_pkg->pkgnum == 0 && ! $section; + + if (! $type || $type eq 'S') { + $subtotal{$section} += $cust_bill_pkg->setup + if $cust_bill_pkg->setup != 0 + || $cust_bill_pkg->setup_show_zero; + } + + if (! $type) { + $subtotal{$section} += $cust_bill_pkg->recur + if $cust_bill_pkg->recur != 0 + || $cust_bill_pkg->recur_show_zero; + } + + if ($type && $type eq 'R') { + $subtotal{$section} += $cust_bill_pkg->recur - $usage + if $cust_bill_pkg->recur != 0 + || $cust_bill_pkg->recur_show_zero; + } + + if ($type && $type eq 'U') { + $subtotal{$section} += $usage + unless scalar(@$extra_sections); + } + + } + + } + + } + + %pkg_category_cache = (); + + push @$late, map { { 'description' => &{$escape}($_), + 'subtotal' => $late_subtotal{$_}, + 'post_total' => 1, + 'sort_weight' => ( _pkg_category($_) + ? _pkg_category($_)->weight + : 0 + ), + ((_pkg_category($_) && _pkg_category($_)->condense) + ? $self->_condense_section($format) + : () + ), + } } + sort _sectionsort keys %late_subtotal; + + my @sections; + if ( $summarypage ) { + @sections = grep { exists($subtotal{$_}) || ! _pkg_category($_)->disabled } + map { $_->categoryname } qsearch('pkg_category', {}); + push @sections, '' if exists($subtotal{''}); + } else { + @sections = keys %subtotal; + } + + my @early = map { { 'description' => &{$escape}($_), + 'subtotal' => $subtotal{$_}, + 'summarized' => $not_tax{$_} ? '' : 'Y', + 'tax_section' => $not_tax{$_} ? '' : 'Y', + 'sort_weight' => ( _pkg_category($_) + ? _pkg_category($_)->weight + : 0 + ), + ((_pkg_category($_) && _pkg_category($_)->condense) + ? $self->_condense_section($format) + : () + ), + } + } @sections; + push @early, @$extra_sections if $extra_sections; + + sort { $a->{sort_weight} <=> $b->{sort_weight} } @early; + +} + +#helper subs for above + +sub _sectionsort { + _pkg_category($a)->weight <=> _pkg_category($b)->weight; +} + +sub _pkg_category { + my $categoryname = shift; + $pkg_category_cache{$categoryname} ||= + qsearchs( 'pkg_category', { 'categoryname' => $categoryname } ); +} + +my %condensed_format = ( + 'label' => [ qw( Description Qty Amount ) ], + 'fields' => [ + sub { shift->{description} }, + sub { shift->{quantity} }, + sub { my($href, %opt) = @_; + ($opt{dollar} || ''). $href->{amount}; + }, + ], + 'align' => [ qw( l r r ) ], + 'span' => [ qw( 5 1 1 ) ], # unitprices? + 'width' => [ qw( 10.7cm 1.4cm 1.6cm ) ], # don't like this +); + +sub _condense_section { + my ( $self, $format ) = ( shift, shift ); + ( 'condensed' => 1, + map { my $method = "_condensed_$_"; $_ => $self->$method($format) } + qw( description_generator + header_generator + total_generator + total_line_generator + ) + ); +} + +sub _condensed_generator_defaults { + my ( $self, $format ) = ( shift, shift ); + return ( \%condensed_format, ' ', ' ', ' ', sub { shift } ); +} + +my %html_align = ( + 'c' => 'center', + 'l' => 'left', + 'r' => 'right', +); + +sub _condensed_header_generator { + my ( $self, $format ) = ( shift, shift ); + + my ( $f, $prefix, $suffix, $separator, $column ) = + _condensed_generator_defaults($format); + + if ($format eq 'latex') { + $prefix = "\\hline\n\\rule{0pt}{2.5ex}\n\\makebox[1.4cm]{}&\n"; + $suffix = "\\\\\n\\hline"; + $separator = "&\n"; + $column = + sub { my ($d,$a,$s,$w) = @_; + return "\\multicolumn{$s}{$a}{\\makebox[$w][$a]{\\textbf{$d}}}"; + }; + } elsif ( $format eq 'html' ) { + $prefix = '<th></th>'; + $suffix = ''; + $separator = ''; + $column = + sub { my ($d,$a,$s,$w) = @_; + return qq!<th align="$html_align{$a}">$d</th>!; + }; + } + + sub { + my @args = @_; + my @result = (); + + foreach (my $i = 0; $f->{label}->[$i]; $i++) { + push @result, + &{$column}( map { $f->{$_}->[$i] } qw(label align span width) ); + } + + $prefix. join($separator, @result). $suffix; + }; + +} + +sub _condensed_description_generator { + my ( $self, $format ) = ( shift, shift ); + + my ( $f, $prefix, $suffix, $separator, $column ) = + _condensed_generator_defaults($format); + + my $money_char = '$'; + if ($format eq 'latex') { + $prefix = "\\hline\n\\multicolumn{1}{c}{\\rule{0pt}{2.5ex}~} &\n"; + $suffix = '\\\\'; + $separator = " & \n"; + $column = + sub { my ($d,$a,$s,$w) = @_; + return "\\multicolumn{$s}{$a}{\\makebox[$w][$a]{\\textbf{$d}}}"; + }; + $money_char = '\\dollar'; + }elsif ( $format eq 'html' ) { + $prefix = '"><td align="center"></td>'; + $suffix = ''; + $separator = ''; + $column = + sub { my ($d,$a,$s,$w) = @_; + return qq!<td align="$html_align{$a}">$d</td>!; + }; + #$money_char = $conf->config('money_char') || '$'; + $money_char = ''; # this is madness + } + + sub { + #my @args = @_; + my $href = shift; + my @result = (); + + foreach (my $i = 0; $f->{label}->[$i]; $i++) { + my $dollar = ''; + $dollar = $money_char if $i == scalar(@{$f->{label}})-1; + push @result, + &{$column}( &{$f->{fields}->[$i]}($href, 'dollar' => $dollar), + map { $f->{$_}->[$i] } qw(align span width) + ); + } + + $prefix. join( $separator, @result ). $suffix; + }; + +} + +sub _condensed_total_generator { + my ( $self, $format ) = ( shift, shift ); + + my ( $f, $prefix, $suffix, $separator, $column ) = + _condensed_generator_defaults($format); + my $style = ''; + + if ($format eq 'latex') { + $prefix = "& "; + $suffix = "\\\\\n"; + $separator = " & \n"; + $column = + sub { my ($d,$a,$s,$w) = @_; + return "\\multicolumn{$s}{$a}{\\makebox[$w][$a]{$d}}"; + }; + }elsif ( $format eq 'html' ) { + $prefix = ''; + $suffix = ''; + $separator = ''; + $style = 'border-top: 3px solid #000000;border-bottom: 3px solid #000000;'; + $column = + sub { my ($d,$a,$s,$w) = @_; + return qq!<td align="$html_align{$a}" style="$style">$d</td>!; + }; + } + + + sub { + my @args = @_; + my @result = (); + + # my $r = &{$f->{fields}->[$i]}(@args); + # $r .= ' Total' unless $i; + + foreach (my $i = 0; $f->{label}->[$i]; $i++) { + push @result, + &{$column}( &{$f->{fields}->[$i]}(@args). ($i ? '' : ' Total'), + map { $f->{$_}->[$i] } qw(align span width) + ); + } + + $prefix. join( $separator, @result ). $suffix; + }; + +} + +=item total_line_generator FORMAT + +Returns a coderef used for generation of invoice total line items for this +usage_class. FORMAT is either html or latex + +=cut + +# should not be used: will have issues with hash element names (description vs +# total_item and amount vs total_amount -- another array of functions? + +sub _condensed_total_line_generator { + my ( $self, $format ) = ( shift, shift ); + + my ( $f, $prefix, $suffix, $separator, $column ) = + _condensed_generator_defaults($format); + my $style = ''; + + if ($format eq 'latex') { + $prefix = "& "; + $suffix = "\\\\\n"; + $separator = " & \n"; + $column = + sub { my ($d,$a,$s,$w) = @_; + return "\\multicolumn{$s}{$a}{\\makebox[$w][$a]{$d}}"; + }; + }elsif ( $format eq 'html' ) { + $prefix = ''; + $suffix = ''; + $separator = ''; + $style = 'border-top: 3px solid #000000;border-bottom: 3px solid #000000;'; + $column = + sub { my ($d,$a,$s,$w) = @_; + return qq!<td align="$html_align{$a}" style="$style">$d</td>!; + }; + } + + + sub { + my @args = @_; + my @result = (); + + foreach (my $i = 0; $f->{label}->[$i]; $i++) { + push @result, + &{$column}( &{$f->{fields}->[$i]}(@args), + map { $f->{$_}->[$i] } qw(align span width) + ); + } + + $prefix. join( $separator, @result ). $suffix; + }; + +} + +# sub _items { # seems to be unused +# 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 @display = qw( _items_previous _items_pkg ); +# +# my @b = (); +# foreach my $display ( @display ) { +# push @b, $self->$display(@_); +# } +# @b; +# } + +=item _items_pkg [ OPTIONS ] + +Return line item hashes for each package item on this invoice. Nearly +equivalent to + +$self->_items_cust_bill_pkg([ $self->cust_bill_pkg ]) + +The only OPTIONS accepted is 'section', which may point to a hashref +with a key named 'condensed', which may have a true value. If it +does, this method tries to merge identical items into items with +'quantity' equal to the number of items (not the sum of their +separate quantities, for some reason). + +=cut + +sub _items_pkg { + my $self = shift; + my %options = @_; + + warn "$me _items_pkg searching for all package line items\n" + if $DEBUG > 1; + + my @cust_bill_pkg = grep { $_->pkgnum } $self->cust_bill_pkg; + + warn "$me _items_pkg filtering line items\n" + if $DEBUG > 1; + my @items = $self->_items_cust_bill_pkg(\@cust_bill_pkg, @_); + + if ($options{section} && $options{section}->{condensed}) { + + warn "$me _items_pkg condensing section\n" + if $DEBUG > 1; + + my %itemshash = (); + local $Storable::canonical = 1; + foreach ( @items ) { + my $item = { %$_ }; + delete $item->{ref}; + delete $item->{ext_description}; + my $key = freeze($item); + $itemshash{$key} ||= 0; + $itemshash{$key} ++; # += $item->{quantity}; + } + @items = sort { $a->{description} cmp $b->{description} } + map { my $i = thaw($_); + $i->{quantity} = $itemshash{$_}; + $i->{amount} = + sprintf( "%.2f", $i->{quantity} * $i->{amount} );#unit_amount + $i; + } + keys %itemshash; + } + + warn "$me _items_pkg returning ". scalar(@items). " items\n" + if $DEBUG > 1; + + @items; +} + +sub _taxsort { + return 0 unless $a->itemdesc cmp $b->itemdesc; + return -1 if $b->itemdesc eq 'Tax'; + return 1 if $a->itemdesc eq 'Tax'; + return -1 if $b->itemdesc eq 'Other surcharges'; + return 1 if $a->itemdesc eq 'Other surcharges'; + $a->itemdesc cmp $b->itemdesc; +} + +sub _items_tax { + my $self = shift; + my @cust_bill_pkg = sort _taxsort grep { ! $_->pkgnum } $self->cust_bill_pkg; + $self->_items_cust_bill_pkg(\@cust_bill_pkg, @_); +} + +=item _items_cust_bill_pkg CUST_BILL_PKGS OPTIONS + +Takes an arrayref of L<FS::cust_bill_pkg> objects, and returns a +list of hashrefs describing the line items they generate on the invoice. + +OPTIONS may include: + +format: the invoice format. + +escape_function: the function used to escape strings. + +DEPRECATED? (expensive, mostly unused?) +format_function: the function used to format CDRs. + +section: a hashref containing 'description'; if this is present, +cust_bill_pkg_display records not belonging to this section are +ignored. + +multisection: a flag indicating that this is a multisection invoice, +which does something complicated. + +Returns a list of hashrefs, each of which may contain: + +pkgnum, description, amount, unit_amount, quantity, _is_setup, and +ext_description, which is an arrayref of detail lines to show below +the package line. + +=cut + +sub _items_cust_bill_pkg { + my $self = shift; + my $conf = $self->conf; + my $cust_bill_pkgs = shift; + my %opt = @_; + + my $format = $opt{format} || ''; + my $escape_function = $opt{escape_function} || sub { shift }; + my $format_function = $opt{format_function} || ''; + my $no_usage = $opt{no_usage} || ''; + my $unsquelched = $opt{unsquelched} || ''; #unused + my $section = $opt{section}->{description} if $opt{section}; + my $summary_page = $opt{summary_page} || ''; #unused + my $multisection = $opt{multisection} || ''; + my $discount_show_always = 0; + + my $maxlength = $conf->config('cust_bill-latex_lineitem_maxlength') || 50; + + my $cust_main = $self->cust_main;#for per-agent cust_bill-line_item-ate_style + # and location labels + + my @b = (); + my ($s, $r, $u) = ( undef, undef, undef ); + foreach my $cust_bill_pkg ( @$cust_bill_pkgs ) + { + + foreach ( $s, $r, ($opt{skip_usage} ? () : $u ) ) { + if ( $_ && !$cust_bill_pkg->hidden ) { + $_->{amount} = sprintf( "%.2f", $_->{amount} ), + $_->{amount} =~ s/^\-0\.00$/0.00/; + $_->{unit_amount} = sprintf( "%.2f", $_->{unit_amount} ), + push @b, { %$_ } + if $_->{amount} != 0 + || $discount_show_always + || ( ! $_->{_is_setup} && $_->{recur_show_zero} ) + || ( $_->{_is_setup} && $_->{setup_show_zero} ) + ; + $_ = undef; + } + } + + my @cust_bill_pkg_display = $cust_bill_pkg->can('cust_bill_pkg_display') + ? $cust_bill_pkg->cust_bill_pkg_display + : ( $cust_bill_pkg ); + + warn "$me _items_cust_bill_pkg considering cust_bill_pkg ". + $cust_bill_pkg->billpkgnum. ", pkgnum ". $cust_bill_pkg->pkgnum. "\n" + if $DEBUG > 1; + + foreach my $display ( grep { defined($section) + ? $_->section eq $section + : 1 + } + #grep { !$_->summary || !$summary_page } # bunk! + grep { !$_->summary || $multisection } + @cust_bill_pkg_display + ) + { + + warn "$me _items_cust_bill_pkg considering cust_bill_pkg_display ". + $display->billpkgdisplaynum. "\n" + if $DEBUG > 1; + + my $type = $display->type; + + my $desc = $cust_bill_pkg->desc; + $desc = substr($desc, 0, $maxlength). '...' + if $format eq 'latex' && length($desc) > $maxlength; + + my %details_opt = ( 'format' => $format, + 'escape_function' => $escape_function, + 'format_function' => $format_function, + 'no_usage' => $opt{'no_usage'}, + ); + + if ( ref($cust_bill_pkg) eq 'FS::quotation_pkg' ) { + + warn "$me _items_cust_bill_pkg cust_bill_pkg is quotation_pkg\n" + if $DEBUG > 1; + + if ( $cust_bill_pkg->setup != 0 ) { + my $description = $desc; + $description .= ' Setup' + if $cust_bill_pkg->recur != 0 + || $discount_show_always + || $cust_bill_pkg->recur_show_zero; + push @b, { + 'description' => $description, + 'amount' => sprintf("%.2f", $cust_bill_pkg->setup), + }; + } + if ( $cust_bill_pkg->recur != 0 ) { + push @b, { + 'description' => "$desc (". $cust_bill_pkg->part_pkg->freq_pretty.")", + 'amount' => sprintf("%.2f", $cust_bill_pkg->recur), + }; + } + + } elsif ( $cust_bill_pkg->pkgnum > 0 ) { + + warn "$me _items_cust_bill_pkg cust_bill_pkg is non-tax\n" + if $DEBUG > 1; + + my $cust_pkg = $cust_bill_pkg->cust_pkg; + + # start/end dates for invoice formats that do nonstandard + # things with them + my %item_dates = map { $_ => $cust_bill_pkg->$_ } ('sdate', 'edate'); + + if ( (!$type || $type eq 'S') + && ( $cust_bill_pkg->setup != 0 + || $cust_bill_pkg->setup_show_zero + ) + ) + { + + warn "$me _items_cust_bill_pkg adding setup\n" + if $DEBUG > 1; + + my $description = $desc; + $description .= ' Setup' + if $cust_bill_pkg->recur != 0 + || $discount_show_always + || $cust_bill_pkg->recur_show_zero; + + my @d = (); + unless ( $cust_pkg->part_pkg->hide_svc_detail + || $cust_bill_pkg->hidden ) + { + + push @d, map &{$escape_function}($_), + $cust_pkg->h_labels_short($self->_date, undef, 'I') + unless $cust_bill_pkg->pkgpart_override; #don't redisplay services + + if ( $cust_pkg->locationnum != $cust_main->ship_locationnum ) { + my $loc = $cust_pkg->location_label; + $loc = substr($loc, 0, $maxlength). '...' + if $format eq 'latex' && length($loc) > $maxlength; + push @d, &{$escape_function}($loc); + } + + } #unless hiding service details + + push @d, $cust_bill_pkg->details(%details_opt) + if $cust_bill_pkg->recur == 0; + + if ( $cust_bill_pkg->hidden ) { + $s->{amount} += $cust_bill_pkg->setup; + $s->{unit_amount} += $cust_bill_pkg->unitsetup; + push @{ $s->{ext_description} }, @d; + } else { + $s = { + _is_setup => 1, + description => $description, + #pkgpart => $part_pkg->pkgpart, + pkgnum => $cust_bill_pkg->pkgnum, + amount => $cust_bill_pkg->setup, + setup_show_zero => $cust_bill_pkg->setup_show_zero, + unit_amount => $cust_bill_pkg->unitsetup, + quantity => $cust_bill_pkg->quantity, + ext_description => \@d, + }; + }; + + } + + if ( ( !$type || $type eq 'R' || $type eq 'U' ) + && ( + $cust_bill_pkg->recur != 0 + || $cust_bill_pkg->setup == 0 + || $discount_show_always + || $cust_bill_pkg->recur_show_zero + ) + ) + { + + warn "$me _items_cust_bill_pkg adding recur/usage\n" + if $DEBUG > 1; + + my $is_summary = $display->summary; + my $description = ($is_summary && $type && $type eq 'U') + ? "Usage charges" : $desc; + + #pry be a bit more efficient to look some of this conf stuff up + # outside the loop + unless ( + $conf->exists('disable_line_item_date_ranges') + || $cust_pkg->part_pkg->option('disable_line_item_date_ranges',1) + ) { + my $time_period; + my $date_style = $conf->config( 'cust_bill-line_item-date_style', + $cust_main->agentnum + ); + if ( defined($date_style) && $date_style eq 'month_of' ) { + $time_period = time2str('The month of %B', $cust_bill_pkg->sdate); + } elsif ( defined($date_style) && $date_style eq 'X_month' ) { + my $desc = $conf->config( 'cust_bill-line_item-date_description', + $cust_main->agentnum + ); + $desc .= ' ' unless $desc =~ /\s$/; + $time_period = $desc. time2str('%B', $cust_bill_pkg->sdate); + } else { + $time_period = time2str($date_format, $cust_bill_pkg->sdate). + " - ". time2str($date_format, $cust_bill_pkg->edate); + } + $description .= " ($time_period)"; + } + + my @d = (); + my @seconds = (); # for display of usage info + + #at least until cust_bill_pkg has "past" ranges in addition to + #the "future" sdate/edate ones... see #3032 + my @dates = ( $self->_date ); + my $prev = $cust_bill_pkg->previous_cust_bill_pkg; + push @dates, $prev->sdate if $prev; + push @dates, undef if !$prev; + + unless ( $cust_pkg->part_pkg->hide_svc_detail + || $cust_bill_pkg->itemdesc + || $cust_bill_pkg->hidden + || $is_summary && $type && $type eq 'U' ) + { + + warn "$me _items_cust_bill_pkg adding service details\n" + if $DEBUG > 1; + + push @d, map &{$escape_function}($_), + $cust_pkg->h_labels_short(@dates, 'I') + #$cust_bill_pkg->edate, + #$cust_bill_pkg->sdate) + unless $cust_bill_pkg->pkgpart_override; #don't redisplay services + + warn "$me _items_cust_bill_pkg done adding service details\n" + if $DEBUG > 1; + + if ( $cust_pkg->locationnum != $cust_main->ship_locationnum ) { + my $loc = $cust_pkg->location_label; + $loc = substr($loc, 0, $maxlength). '...' + if $format eq 'latex' && length($loc) > $maxlength; + push @d, &{$escape_function}($loc); + } + + # Display of seconds_since_sqlradacct: + # On the invoice, when processing @detail_items, look for a field + # named 'seconds'. This will contain total seconds for each + # service, in the same order as @ext_description. For services + # that don't support this it will show undef. + if ( $conf->exists('svc_acct-usage_seconds') + and ! $cust_bill_pkg->pkgpart_override ) { + foreach my $cust_svc ( + $cust_pkg->h_cust_svc(@dates, 'I') + ) { + + # eval because not having any part_export_usage exports + # is a fatal error, last_bill/_date because that's how + # sqlradius_hour billing does it + my $sec = eval { + $cust_svc->seconds_since_sqlradacct($dates[1] || 0, $dates[0]); + }; + push @seconds, $sec; + } + } #if svc_acct-usage_seconds + + } + + unless ( $is_summary ) { + warn "$me _items_cust_bill_pkg adding details\n" + if $DEBUG > 1; + + #instead of omitting details entirely in this case (unwanted side + # effects), just omit CDRs + $details_opt{'no_usage'} = 1 + if $type && $type eq 'R'; + + push @d, $cust_bill_pkg->details(%details_opt); + } + + warn "$me _items_cust_bill_pkg calculating amount\n" + if $DEBUG > 1; + + my $amount = 0; + if (!$type) { + $amount = $cust_bill_pkg->recur; + } elsif ($type eq 'R') { + $amount = $cust_bill_pkg->recur - $cust_bill_pkg->usage; + } elsif ($type eq 'U') { + $amount = $cust_bill_pkg->usage; + } + + my $unit_amount = + ( $cust_bill_pkg->unitrecur > 0 ) ? $cust_bill_pkg->unitrecur + : $amount; + + if ( !$type || $type eq 'R' ) { + + warn "$me _items_cust_bill_pkg adding recur\n" + if $DEBUG > 1; + + if ( $cust_bill_pkg->hidden ) { + $r->{amount} += $amount; + $r->{unit_amount} += $unit_amount; + push @{ $r->{ext_description} }, @d; + } else { + $r = { + description => $description, + #pkgpart => $part_pkg->pkgpart, + pkgnum => $cust_bill_pkg->pkgnum, + amount => $amount, + recur_show_zero => $cust_bill_pkg->recur_show_zero, + unit_amount => $unit_amount, + quantity => $cust_bill_pkg->quantity, + %item_dates, + ext_description => \@d, + }; + $r->{'seconds'} = \@seconds if grep {defined $_} @seconds; + } + + } else { # $type eq 'U' + + warn "$me _items_cust_bill_pkg adding usage\n" + if $DEBUG > 1; + + if ( $cust_bill_pkg->hidden ) { + $u->{amount} += $amount; + $u->{unit_amount} += $unit_amount, + push @{ $u->{ext_description} }, @d; + } else { + $u = { + description => $description, + #pkgpart => $part_pkg->pkgpart, + pkgnum => $cust_bill_pkg->pkgnum, + amount => $amount, + recur_show_zero => $cust_bill_pkg->recur_show_zero, + unit_amount => $unit_amount, + quantity => $cust_bill_pkg->quantity, + %item_dates, + ext_description => \@d, + }; + } + } + + } # recurring or usage with recurring charge + + } else { #pkgnum tax or one-shot line item (??) + + warn "$me _items_cust_bill_pkg cust_bill_pkg is tax\n" + if $DEBUG > 1; + + 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($date_format, $cust_bill_pkg->sdate). ' - '. + time2str($date_format, $cust_bill_pkg->edate). ')', + 'amount' => sprintf("%.2f", $cust_bill_pkg->recur), + }; + } + + } + + } + + $discount_show_always = ($cust_bill_pkg->cust_bill_pkg_discount + && $conf->exists('discount-show-always')); + + } + + foreach ( $s, $r, ($opt{skip_usage} ? () : $u ) ) { + if ( $_ ) { + $_->{amount} = sprintf( "%.2f", $_->{amount} ), + $_->{amount} =~ s/^\-0\.00$/0.00/; + $_->{unit_amount} = sprintf( "%.2f", $_->{unit_amount} ), + push @b, { %$_ } + if $_->{amount} != 0 + || $discount_show_always + || ( ! $_->{_is_setup} && $_->{recur_show_zero} ) + || ( $_->{_is_setup} && $_->{setup_show_zero} ) + } + } + + warn "$me _items_cust_bill_pkg done considering cust_bill_pkgs\n" + if $DEBUG > 1; + + @b; + +} + +=item _items_discounts_avail + +Returns an array of line item hashrefs representing available term discounts +for this invoice. This makes the same assumptions that apply to term +discounts in general: that the package is billed monthly, at a flat rate, +with no usage charges. A prorated first month will be handled, as will +a setup fee if the discount is allowed to apply to setup fees. + +=cut + +sub _items_discounts_avail { + my $self = shift; + + #maybe move this method from cust_bill when quotations support discount_plans + return () unless $self->can('discount_plans'); + my %plans = $self->discount_plans; + + my $list_pkgnums = 0; # if any packages are not eligible for all discounts + $list_pkgnums = grep { $_->list_pkgnums } values %plans; + + map { + my $months = $_; + my $plan = $plans{$months}; + + my $term_total = sprintf('%.2f', $plan->discounted_total); + my $percent = sprintf('%.0f', + 100 * (1 - $term_total / $plan->base_total) ); + my $permonth = sprintf('%.2f', $term_total / $months); + my $detail = $self->mt('discount on item'). ' '. + join(', ', map { "#$_" } $plan->pkgnums) + if $list_pkgnums; + + # discounts for non-integer months don't work anyway + $months = sprintf("%d", $months); + + +{ + description => $self->mt('Save [_1]% by paying for [_2] months', + $percent, $months), + amount => $self->mt('[_1] ([_2] per month)', + $term_total, $money_char.$permonth), + ext_description => ($detail || ''), + } + } #map + sort { $b <=> $a } keys %plans; + +} + +1; diff --git a/FS/FS/TicketSystem/RT_External.pm b/FS/FS/TicketSystem/RT_External.pm index f976ac0e3..c2aac2db7 100644 --- a/FS/FS/TicketSystem/RT_External.pm +++ b/FS/FS/TicketSystem/RT_External.pm @@ -97,6 +97,11 @@ sub customer_tickets { } +sub service_tickets { + warn "service_tickets not available with RT_External.\n"; + return; +} + sub comments_on_tickets { my ($self, $custnum, $limit, $time ) = @_; $limit ||= 0; @@ -206,7 +211,20 @@ sub statuses { } sub href_customer_tickets { - my( $self, $custnum ) = ( shift, shift ); + my($self, $custnum) = (shift, shift); + if ( $custnum =~ /^(\d+)$/ ) { + return $self->href_search_tickets("MemberOf = 'freeside://freeside/cust_main/$1'"); + } + warn "bad custnum $custnum"; return ''; +} + +sub href_service_tickets { + warn "service_tickets not available with RT_External.\n"; + ''; +} + +sub href_search_tickets { + my( $self, $where ) = ( shift, shift ); my( $priority, @statuses); if ( ref($_[0]) ) { my $opt = shift; @@ -225,8 +243,8 @@ sub href_customer_tickets { #$href .= my $href = "Search/Results.html?Order=ASC&". - "Query= MemberOf = 'freeside://freeside/cust_main/$custnum' ". - #" AND ( Status = 'open' OR Status = 'new' OR Status = 'stalled' )" + "Query= $where" . + #MemberOf = 'freeside://freeside/cust_main/$custnum' ". " AND ( ". join(' OR ', map "Status = '$_'", @statuses ). " ) " ; @@ -246,7 +264,7 @@ sub href_customer_tickets { uri_escape($href); #eventually should unescape all of it... - $href .= '&Rows=100'. + $href .= '&RowsPerPage=50'. '&OrderBy=id&Page=1'. '&Format=%27%20%20%20%3Cb%3E%3Ca%20href%3D%22'. $self->baseurl. @@ -274,15 +292,19 @@ sub href_customer_tickets { } sub href_params_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( $self, $custnum_or_cust_main, $requestors ) = @_; + # no longer takes $custnum--it must be an object + my ( $self, $object, $requestors ) = @_; + my $cust_main; # for default requestors + if ( $object->isa('FS::cust_main') ) { + $cust_main = $object; + } + elsif ( $object->isa('FS::svc_Common') ) { + $object = $object->cust_svc; + $cust_main = $object->cust_pkg->cust_main if ( $object->cust_pkg ); + } + elsif ( $object->isa('FS::cust_svc') ) { + $cust_main = $object->cust_pkg->cust_main if ( $object->cust_pkg ); } # explicit $requestors > config option > invoicing_list @@ -291,9 +313,12 @@ sub href_params_new_ticket { $requestors = $cust_main->invoicing_list_emailonly_scalar if (!$requestors) and defined($cust_main); + my $subtype = $object->table; + my $pkey = $object->get($object->primary_key); + my %param = ( 'Queue' => ($cust_main->agent->ticketing_queueid || $default_queueid), - 'new-MemberOf'=> "freeside://freeside/cust_main/$custnum", + 'new-MemberOf'=> "freeside://freeside/$subtype/$pkey", 'Requestors' => $requestors, ); diff --git a/FS/FS/TicketSystem/RT_Internal.pm b/FS/FS/TicketSystem/RT_Internal.pm index d96e5f05f..01e2e2966 100644 --- a/FS/FS/TicketSystem/RT_Internal.pm +++ b/FS/FS/TicketSystem/RT_Internal.pm @@ -50,7 +50,7 @@ sub access_right { sub session { my( $self, $session ) = @_; - if ( $session && $session->{'Current_User'} ) { # does this even work? + if ( $session && $session->{'CurrentUser'} ) { # does this even work? warn "$me session: using existing session and CurrentUser: \n". Dumper($session->{'CurrentUser'}) if $DEBUG; @@ -92,6 +92,7 @@ sub init { # this needs to be done on each fork warn "$me init: initializing RT\n" if $DEBUG; { + local $SIG{__WARN__}; local $SIG{__DIE__}; eval 'RT::Init("NoSignalHandlers"=>1);'; } @@ -107,10 +108,13 @@ properly. =cut -sub _customer_tickets_search { - my ( $self, $custnum, $limit, $priority ) = @_; +# create an RT::Tickets object for a specified custnum or svcnum - $custnum =~ /^\d+$/ or die "invalid custnum: $custnum"; +sub _tickets_search { + my ( $self, $type, $number, $limit, $priority ) = @_; + + $type =~ /^Customer|Service$/ or die "invalid type: $type"; + $number =~ /^\d+$/ or die "invalid custnum/svcnum: $number"; $limit =~ /^\d+$/ or die "invalid limit: $limit"; my $session = $self->session(); @@ -119,7 +123,8 @@ sub _customer_tickets_search { my $Tickets = RT::Tickets->new($CurrentUser); - my $rtql = "MemberOf = 'freeside://freeside/cust_main/$custnum'"; + # "Customer.number" searches tickets linked via cust_svc also + my $rtql = "$type.number = $number"; if ( defined( $priority ) ) { my $custom_priority = FS::Conf->new->config('ticket_system-custom_priority_field'); @@ -144,8 +149,25 @@ sub _customer_tickets_search { return $Tickets; } +sub href_customer_tickets { + my ($self, $custnum) = (shift, shift); + if ($custnum =~ /^(\d+)$/) { + return $self->href_search_tickets("Customer.number = $custnum", @_); + } + warn "bad custnum $custnum"; ''; +} + +sub href_service_tickets { + my ($self, $svcnum) = (shift, shift); + if ($svcnum =~ /^(\d+)$/ ) { + return $self->href_search_tickets("Service.number = $svcnum", @_); + } + warn "bad svcnum $svcnum"; ''; +} + sub customer_tickets { - my $Tickets = _customer_tickets_search(@_); + my $self = shift; + my $Tickets = $self->_tickets_search('Customer', @_); my $conf = FS::Conf->new; my $priority_order = @@ -168,8 +190,30 @@ sub customer_tickets { sub num_customer_tickets { my ( $self, $custnum, $priority ) = @_; - my $Tickets = $self->_customer_tickets_search($custnum, 0, $priority); - return $Tickets->CountAll; + $self->_tickets_search('Customer', $custnum, 0, $priority)->CountAll; +} + +sub service_tickets { + my $self = shift; + my $Tickets = $self->_tickets_search('Service', @_); + + my $conf = FS::Conf->new; + my $priority_order = + $conf->exists('ticket_system-priority_reverse') ? 'ASC' : 'DESC'; + + my @order_by = ( + { FIELD => 'Priority', ORDER => $priority_order }, + { FIELD => 'Id', ORDER => 'DESC' }, + ); + + $Tickets->OrderByCols(@order_by); + + my @tickets; + while ( my $t = $Tickets->Next ) { + push @tickets, _ticket_info($t); + } + + return \@tickets; } sub _ticket_info { @@ -200,6 +244,12 @@ sub _ticket_info { if ( $ss_priority ) { $ticket_info{'_selfservice_priority'} = $ticket_info{"CF.{$ss_priority}"}; } + my $svcnums = [ + map { $_->Target =~ /cust_svc\/(\d+)/; $1 } + @{ $t->Services->ItemsArrayRef } + ]; + $ticket_info{'svcnums'} = $svcnums; + return \%ticket_info; } diff --git a/FS/FS/Trace.pm b/FS/FS/Trace.pm new file mode 100644 index 000000000..9ff39dd26 --- /dev/null +++ b/FS/FS/Trace.pm @@ -0,0 +1,35 @@ +package FS::Trace; + +use strict; +use Date::Format; +use File::Slurp; + +my @trace = (); + +sub log { + my( $class, $msg ) = @_; + push @trace, [ time, "[$$][". time2str('%r', time). "] $msg" ]; +} + +sub total { + $trace[-1]->[0] - $trace[0]->[0]; +} + +sub reset { + @trace = (); +} + +sub dump_ary { + map $_->[1], @trace; +} + +sub dump { + join("\n", map $_->[1], @trace). "\n"; +} + +sub dumpfile { + my( $class, $filename, $header ) = @_; + write_file( $filename, "$header\n". $class->dump ); +} + +1; diff --git a/FS/FS/UI/Web/small_custview.pm b/FS/FS/UI/Web/small_custview.pm index 36dd30c6d..2c42a6b46 100644 --- a/FS/FS/UI/Web/small_custview.pm +++ b/FS/FS/UI/Web/small_custview.pm @@ -29,7 +29,7 @@ sub small_custview { : qsearchs('cust_main', { 'custnum' => $arg } ) or die "unknown custnum $arg"; - my $html; + my $html = '<DIV ID="fs_small_custview">'; $html = qq!View <A HREF="$url?! . $cust_main->custnum . '">' if $url; @@ -82,45 +82,23 @@ sub small_custview { $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}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"); - } + my $ship = $cust_main->ship_location; - $html .= '</TD></TR></TABLE></TD>'; - } + $html .= '<TD VALIGN="top">'. ntable("#cccccc",2). + '<TR><TD ALIGN="right" VALIGN="top">Service<BR>Address</TD><TD BGCOLOR="#ffffff">'; + $html .= join('<BR>', + grep $_, + $cust_main->contact, + $cust_main->company, + $ship->address1, + $ship->address2, + ($ship->city . ', ' . $ship->state . ' ' . $ship->zip), + ($ship->country eq $countrydefault ? '' : $ship->country ), + ); + + # ship phone numbers no longer exist... + + $html .= '</TD></TR></TABLE></TD>'; $html .= '</TR></TABLE>'; @@ -129,6 +107,8 @@ sub small_custview { # last payment might be good here too? + $html .= '</DIV>'; + $html; } diff --git a/FS/FS/Upgrade.pm b/FS/FS/Upgrade.pm index aabc4e72f..3f76f5116 100644 --- a/FS/FS/Upgrade.pm +++ b/FS/FS/Upgrade.pm @@ -4,6 +4,7 @@ use strict; use vars qw( @ISA @EXPORT_OK $DEBUG ); use Exporter; use Tie::IxHash; +use File::Slurp; use FS::UID qw( dbh driver_name ); use FS::Conf; use FS::Record qw(qsearchs qsearch str2time_sql); @@ -63,7 +64,26 @@ sub upgrade_config { upgrade_overlimit_groups($conf); map { upgrade_overlimit_groups($conf,$_->agentnum) } qsearch('agent', {}); - + + my $DIST_CONF = '/usr/local/etc/freeside/default_conf/';#DIST_CONF in Makefile + $conf->set($_, scalar(read_file( "$DIST_CONF/$_" )) ) + foreach grep { ! $conf->exists($_) && -s "$DIST_CONF/$_" } + qw( quotation_html quotation_latex quotation_latexnotes ); + + # change 'fslongtable' to 'longtable' + # in invoice and quotation main templates, and also in all secondary + # invoice templates + my @latex_confs = + qsearch('conf', { 'name' => {op=>'LIKE', value=>'%latex%'} }); + + foreach my $c (@latex_confs) { + my $value = $c->value; + if (length($value) and $value =~ /fslongtable/) { + $value =~ s/fslongtable/longtable/g; + $conf->set($c->name, $value, $c->agentnum); + } + } + } sub upgrade_overlimit_groups { @@ -269,6 +289,15 @@ sub upgrade_data { #routernum/blocknum 'svc_broadband' => [], + + #set up payment gateways if needed + 'pay_batch' => [], + + #flag monthly tax exemptions + 'cust_tax_exempt_pkg' => [], + + #kick off tax location history upgrade + 'cust_bill_pkg' => [], ; \%hash; diff --git a/FS/FS/access_groupsales.pm b/FS/FS/access_groupsales.pm new file mode 100644 index 000000000..31b07d9f8 --- /dev/null +++ b/FS/FS/access_groupsales.pm @@ -0,0 +1,153 @@ +package FS::access_groupsales; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearch qsearchs ); + +=head1 NAME + +FS::access_groupsales - Object methods for access_groupsales records + +=head1 SYNOPSIS + + use FS::access_groupsales; + + $record = new FS::access_groupsales \%hash; + $record = new FS::access_groupsales { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::access_groupsales object represents an example. FS::access_groupsales inherits from +FS::Record. The following fields are currently supported: + +=over 4 + +=item groupsalesnum + +primary key + +=item groupnum + +groupnum + +=item salesnum + +salesnum + + +=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_groupsales'; } + +=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('groupsalesnum') + || $self->ut_number('groupnum') + || $self->ut_number('salesnum') + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=item sales + +Returns the associated FS::agent object. + +=cut + +sub sales { + my $self = shift; + qsearchs('sales', { 'salesnum' => $self->salesnum } ); +} + +=item access_group + +Returns the associated FS::access_group object. + +=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/access_right.pm b/FS/FS/access_right.pm index 341055bfc..397b456ce 100644 --- a/FS/FS/access_right.pm +++ b/FS/FS/access_right.pm @@ -2,7 +2,9 @@ package FS::access_right; use strict; use vars qw( @ISA ); +use Tie::IxHash; use FS::Record qw( qsearch qsearchs ); +use FS::upgrade_journal; @ISA = qw(FS::Record); @@ -150,6 +152,8 @@ sub _upgrade_data { # class method 'Process payment' => [ 'Process credit card payment', 'Process Echeck payment' ], 'Post refund' => [ 'Post check refund', 'Post cash refund' ], 'Refund payment' => [ 'Refund credit card payment', 'Refund Echeck payment' ], + 'Regular void' => [ 'Void payments' ], + 'Unvoid' => [ 'Unvoid payments', 'Unvoid invoices' ], ); foreach my $oldright (keys %migrate) { @@ -172,9 +176,10 @@ sub _upgrade_data { # class method die $error if $error; } - #after the WEST stuff is sorted, etc. - #my $error = $old->delete; - #die $error if $error; + unless ( $oldright =~ / (payment|refund)$/ ) { #after the WEST stuff is sorted + my $error = $old->delete; + die $error if $error; + } } @@ -182,19 +187,59 @@ sub _upgrade_data { # class method my @all_groups = qsearch('access_group', {}); - my %onetime = ( - 'List customers' => 'List all customers', - 'List packages' => 'Summarize packages', - ); + tie my %onetime, 'Tie::IxHash', + 'List customers' => 'List all customers', + 'List all customers' => 'Advanced customer search', + 'List packages' => 'Summarize packages', + 'Post payment' => 'Backdate payment', + 'Cancel customer package immediately' => 'Un-cancel customer package', + 'Suspend customer package' => 'Suspend customer', + 'Unsuspend customer package' => 'Unsuspend customer', + 'New prospect' => 'Generate quotation', + 'Delete invoices' => 'Void invoices', + 'List invoices' => 'List quotations', + + 'List services' => [ 'Services: Accounts', + 'Services: Domains', + 'Services: Certificates', + 'Services: Mail forwards', + 'Services: Virtual hosting services', + 'Services: Wireless broadband services', + 'Services: DSLs', + 'Services: Dish services', + 'Services: Hardware', + 'Services: Phone numbers', + 'Services: PBXs', + 'Services: Ports', + 'Services: Mailing lists', + 'Services: External services', + ], + + 'Services: Accounts' => 'Services: Accounts: Advanced search', + 'Services: Wireless broadband services' => 'Services: Wireless broadband services: Advanced search', + 'Services: Hardware' => 'Services: Hardware: Advanced search', + + 'List rating data' => [ 'Usage: RADIUS sessions', + 'Usage: Call Detail Records (CDRs)', + 'Usage: Unrateable CDRs', + ], + ; foreach my $old_acl ( keys %onetime ) { - my $new_acl = $onetime{$old_acl}; #support arrayref too? - ( my $journal = 'ACL_'.lc($new_acl) ) =~ s/ /_/g; - next if FS::upgrade_journal->is_done($journal); - # grant $new_acl to all groups who have $old_acl - for my $group (@all_groups) { - if ( $group->access_right($old_acl) ) { + my @new_acl = ref($onetime{$old_acl}) + ? @{ $onetime{$old_acl} } + : ( $onetime{$old_acl} ); + + foreach my $new_acl ( @new_acl ) { + + ( my $journal = 'ACL_'.lc($new_acl) ) =~ s/\W/_/g; + next if FS::upgrade_journal->is_done($journal); + + # grant $new_acl to all groups who have $old_acl + for my $group (@all_groups) { + next unless $group->access_right($old_acl); + next if $group->access_right($new_acl); my $access_right = FS::access_right->new( { 'righttype' => 'FS::access_group', 'rightobjnum' => $group->groupnum, @@ -203,9 +248,11 @@ sub _upgrade_data { # class method my $error = $access_right->insert; die $error if $error; } - } - FS::upgrade_journal->set_done($journal); + FS::upgrade_journal->set_done($journal); + + } + } ### ACL_download_report_data @@ -219,7 +266,7 @@ sub _upgrade_data { # class method 'rightname' => 'Download report data', } ); my $error = $access_right->insert; - die $error if $error; + warn $error if $error; } FS::upgrade_journal->set_done('ACL_download_report_data'); diff --git a/FS/FS/access_user.pm b/FS/FS/access_user.pm index 5d5cc126c..509cc0950 100644 --- a/FS/FS/access_user.pm +++ b/FS/FS/access_user.pm @@ -511,6 +511,42 @@ sub default_customer_view { } +=item spreadsheet_format [ OVERRIDE ] + +Returns a hashref of this user's Excel spreadsheet download settings: +'extension' (xls or xlsx), 'class' (Spreadsheet::WriteExcel or +Excel::Writer::XLSX), and 'mime_type'. If OVERRIDE is 'XLS' or 'XLSX', +use that instead of the user's setting. + +=cut + +# is there a better place to put this? +my %formats = ( + XLS => { + extension => '.xls', + class => 'Spreadsheet::WriteExcel', + mime_type => 'application/vnd.ms-excel', + }, + XLSX => { + extension => '.xlsx', + class => 'Excel::Writer::XLSX', + mime_type => # it's on wikipedia, it must be true + 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet', + } +); + +sub spreadsheet_format { + my $self = shift; + my $override = shift; + + my $f = $override + || $self->option('spreadsheet_format') + || $conf->config('spreadsheet_format') + || 'XLS'; + + $formats{$f}; +} + =item is_system_user Returns true if this user has the name of a known system account. These diff --git a/FS/FS/addr_block.pm b/FS/FS/addr_block.pm index e00f587c6..686bdbd18 100755 --- a/FS/FS/addr_block.pm +++ b/FS/FS/addr_block.pm @@ -223,43 +223,45 @@ sub cidr { $self->NetAddr->cidr; } -=item free_addrs +=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 nothing. There are never free addresses when manual_flag is true. -=item next_free_addr - -Returns a NetAddr::IP object for the first unassigned address in the block, -or '' if there are none. +There is no longer a method to return all free addresses in a block. =cut -sub free_addrs { +sub next_free_addr { my $self = shift; + my $selfaddr = $self->NetAddr; return if $self->manual_flag; my $conf = new FS::Conf; my @excludeaddr = $conf->config('exclude_ip_addr'); - + my %used = map { $_ => 1 } ( + @excludeaddr, + $selfaddr->addr, + $selfaddr->network->addr, + $selfaddr->broadcast->addr, (map { $_->NetAddr->addr } - ($self, - qsearch('svc_broadband', { blocknum => $self->blocknum })) + qsearch('svc_broadband', { blocknum => $self->blocknum }) ), @excludeaddr ); - grep { !$used{$_->addr} } $self->NetAddr->hostenum; - -} + # just do a linear search of the block + my $freeaddr = $selfaddr->network + 1; + while ( $freeaddr < $selfaddr->broadcast ) { + return $freeaddr unless $used{ $freeaddr->addr }; + $freeaddr++; + } + return; -sub next_free_addr { - my $self = shift; - ($self->free_addrs, '')[0] } =item allocate -- deprecated diff --git a/FS/FS/agent_pkg_class.pm b/FS/FS/agent_pkg_class.pm new file mode 100644 index 000000000..1683c1a14 --- /dev/null +++ b/FS/FS/agent_pkg_class.pm @@ -0,0 +1,117 @@ +package FS::agent_pkg_class; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearch qsearchs ); + +=head1 NAME + +FS::agent_pkg_class - Object methods for agent_pkg_class records + +=head1 SYNOPSIS + + use FS::agent_pkg_class; + + $record = new FS::agent_pkg_class \%hash; + $record = new FS::agent_pkg_class { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::agent_pkg_class object represents an commission for a specific agent +and package class. FS::agent_pkg_class inherits from FS::Record. The +following fields are currently supported: + +=over 4 + +=item agentpkgclassnum + +primary key + +=item agentnum + +agentnum + +=item classnum + +classnum + +=item commission_percent + +commission_percent + + +=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 { 'agent_pkg_class'; } + +=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. + +=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->commission_percent(0) unless length($self->commission_percent); + + my $error = + $self->ut_numbern('agentpkgclassnum') + || $self->ut_foreign_key('agentnum', 'agent', 'agentnum') + || $self->ut_foreign_keyn('classnum', 'pkg_class', 'classnum') + || $self->ut_float('commission_percent') + ; + 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/cia.pm b/FS/FS/cdr/cia.pm index 070f3fb0d..ca44c0fdf 100644 --- a/FS/FS/cdr/cia.pm +++ b/FS/FS/cdr/cia.pm @@ -20,11 +20,12 @@ use FS::cdr qw(_cdr_date_parser_maker); skip(2), # Conference Start Time, Conference End Time _cdr_date_parser_maker('startdate'), # Connect Time _cdr_date_parser_maker('enddate'), # Disconnect Time + skip(1), # Duration sub { my($cdr, $data, $conf, $param) = @_; $cdr->duration($data); $cdr->billsec( $data); - }, # Duration - skip(2), # Roundup Duration, User Name + }, # Roundup Duration + skip(1), # User Name 'dst', # DNIS 'src', # ANI skip(2), # Call Type, Toll Free, diff --git a/FS/FS/cdr/infinite.pm b/FS/FS/cdr/infinite.pm index 90560c8c7..02ff9df6f 100644 --- a/FS/FS/cdr/infinite.pm +++ b/FS/FS/cdr/infinite.pm @@ -6,6 +6,8 @@ use FS::cdr qw(_cdr_date_parser_maker); @ISA = qw(FS::cdr); +my $date_parser = _cdr_date_parser_maker('startdate'); + %info = ( 'name' => 'Infinite Conferencing', 'weight' => 520, @@ -13,26 +15,38 @@ use FS::cdr qw(_cdr_date_parser_maker); 'type' => 'csv', 'sep_char' => ',', 'import_fields' => [ - 'uniqueid', # billid - skip(3), # confid, invoicenum, acctgrpid - 'accountcode', # accountid ("Room Confirmation Number") - skip(2), # billingcode ("Room Billingcode"), confname - skip(1), # participant_type - 'startdate', # starttime_t - skip(2), # startdate, starttime + 'uniqueid', # A. billid + skip(3), # B-D. confid, invoicenum, acctgrpid + skip(1), # E. accountid ("Room Confirmation Number") + skip(2), # F-G. billingcode ("Room Billingcode"), confname + skip(1), # H. participant_type + skip(1), # I. starttime_t - timezone is unreliable + sub { # J. startdate + my ($cdr, $data, $conf, $param) = @_; + $param->{'date_part'} = $data; # stash this and combine with the time + ''; + }, + sub { # K. starttime + my ($cdr, $data, $conf, $param) = @_; + my $datestring = delete($param->{'date_part'}) . ' ' . $data; + &{ $date_parser }($cdr, $datestring); + }, sub { my($cdr, $data, $conf, $param) = @_; $cdr->duration($data * 60); $cdr->billsec( $data * 60); - }, # minutes - 'dst', # dnis - 'src', # ani - skip(8), # calltype, calltype_text, confstart_t, confstartdate, + }, # L. minutes + skip(1), # M. dnis + 'src', # N. ani + 'dst', # O. calltype + skip(7), # P-V. calltype_text, confstart_t, confstartdate, # confstarttime, confminutes, conflegs, ppm - 'upstream_price', # callcost - skip(13), # confcost, rppm, rcallcost, rconfcost, - # auxdata[1..4], ldval, sysname, username, cec, pec - 'userfield', # unnamed field - ], + 'upstream_price', # W. callcost + skip(11), # X-AH. confcost, rppm, rcallcost, rconfcost, + # auxdata[1..4], ldval, sysname, username + 'accountcode', # AI. Chairperson Entry Code + skip(1), # AJ. Participant Entry Code + 'description', # AK. contact name + ], ); diff --git a/FS/FS/cdr/taqua.pm b/FS/FS/cdr/taqua.pm index 390152a04..7ef6d769a 100644 --- a/FS/FS/cdr/taqua.pm +++ b/FS/FS/cdr/taqua.pm @@ -7,7 +7,7 @@ use FS::cdr qw(_cdr_date_parser_maker); @ISA = qw(FS::cdr); %info = ( - 'name' => 'Taqua', + 'name' => 'Taqua v6.0', 'weight' => 130, 'header' => 1, 'import_fields' => [ #some of these are kind arbitrary... diff --git a/FS/FS/cdr/taqua62.pm b/FS/FS/cdr/taqua62.pm new file mode 100644 index 000000000..862018e9c --- /dev/null +++ b/FS/FS/cdr/taqua62.pm @@ -0,0 +1,178 @@ +package FS::cdr::taqua62; + +use strict; +use vars qw(@ISA %info $da_rewrite); +use FS::cdr qw(_cdr_date_parser_maker); + +@ISA = qw(FS::cdr); + +%info = ( + 'name' => 'Taqua v6.2', + 'weight' => 131, + 'header' => 1, + 'import_fields' => [ + + #0 + '', #Key + '', #InsertTime, irrelevant + #RecordType + sub { + my($cdr, $field, $conf, $hashref) = @_; + $hashref->{skiprow} = 1 + unless ($field == 0 && $cdr->disposition == 100 ) #regular CDR + || ($field == 1 && $cdr->lastapp eq 'acctcode'); #accountcode + $cdr->cdrtypenum($field); + }, + + '', #RecordVersion + '', #OrigShelfNumber + '', #OrigCardNumber + '', #OrigCircuit + '', #OrigCircuitType + 'uniqueid', #SequenceNumber + 'sessionnum', #SessionNumber + #10 + 'src', #CallingPartyNumber + #CalledPartyNumber + sub { + my( $cdr, $field, $conf ) = @_; + if ( $cdr->calltypenum == 6 && $cdr->cdrtypenum == 0 ) { + $cdr->dst("+$field"); + } else { + $cdr->dst($field); + } + }, + + _cdr_date_parser_maker('startdate', 'gmt' => 1), #CallArrivalTime + _cdr_date_parser_maker('enddate', 'gmt' => 1), #CallCompletionTime + + #Disposition + #sub { my($cdr, $d ) = @_; $cdr->disposition( $disposition{$d}): }, + 'disposition', + # -1 => '', + # 0 => '', + # 100 => '', #regular cdr + # 101 => '', + # 102 => '', + # 103 => '', + # 104 => '', + # 105 => '', + # 201 => '', + # 203 => '', + # 204 => '', + + _cdr_date_parser_maker('answerdate', 'gmt' => 1), #DispositionTime + '', #TCAP + '', #OutboundCarrierConnectTime + '', #OutboundCarrierDisconnectTime + + #TermTrunkGroup + #it appears channels are actually part of trunk groups, but this data + #is interesting and we need a source and destination place to put it + 'dstchannel', #TermTrunkGroup + + #20 + + '', #TermShelfNumber + '', #TermCardNumber + '', #TermCircuit + '', #TermCircuitType + 'carrierid', #OutboundCarrierId + + #BillingNumber + #'charged_party', + sub { + my( $cdr, $field, $conf ) = @_; + + #could be more efficient for the no config case, if anyone ever needs that + $da_rewrite ||= $conf->config('cdr-taqua-da_rewrite'); + + if ( $da_rewrite && $field =~ /\d/ ) { + my $rewrite = $da_rewrite; + $rewrite =~ s/\s//g; + my @rewrite = split(',', $conf->config('cdr-taqua-da_rewrite') ); + if ( grep { $field eq $_ } @rewrite ) { + $cdr->charged_party( $cdr->src() ); + $cdr->calltypenum(12); + return; + } + } + if ( $cdr->is_tollfree ) { # thankfully this is already available + $cdr->charged_party($cdr->dst); # and this + } else { + $cdr->charged_party($field); + } + }, + + 'subscriber', #SubscriberName + 'lastapp', #ServiceName + '', #some weirdness #ChargeTime + 'lastdata', #ServiceInformation + + #30 + + '', #FacilityInfo + '', #all 1900-01-01 0#CallTraceTime + '', #all-1#UniqueIndicator + '', #all-1#PresentationIndicator + '', #empty#Pin + 'calltypenum', #CallType + + #nothing below is used by QIS... + + '', #Balt/empty #OrigRateCenter + '', #Balt/empty #TermRateCenter + + #OrigTrunkGroup + #it appears channels are actually part of trunk groups, but this data + #is interesting and we need a source and destination place to put it + 'channel', #OrigTrunkGroup + 'userfield', #empty#UserDefined + + #40 + + '', #empty#PseudoDestinationNumber + '', #all-1#PseudoCarrierCode + '', #empty#PseudoANI + '', #all-1#PseudoFacilityInfo + '', #OrigDialedDigits + '', #all-1#OrigOutboundCarrier + '', #IncomingCarrierID + 'dcontext', #JurisdictionInfo + '', #OrigDestDigits + '', #empty#AMALineNumber + + #50 + + '', #empty#AMAslpID + '', #empty#AMADigitsDialedWC + '', #OpxOffHook + '', #OpxOnHook + '', #OrigCalledNumber + '', #RedirectingNumber + '', #RouteAttempts + '', #OrigMGCPTerm + '', #TermMGCPTerm + '', #ReasonCode + + #60 + + '', #OrigIPCallID + '', #ESAIPTrunkGroup + '', #ESAReason + '', #BearerlessCall + '', #oCodec + '', #tCodec + '', #OrigTrunkGroupNumber + '', #TermTrunkGroupNumber + '', #TermRecord + '', #OrigRoutingIndicator + + #70 + + '', #TermRoutingIndicator + + ], +); + +1; diff --git a/FS/FS/cdr/troop.pm b/FS/FS/cdr/troop.pm index 020af2b20..429c25a53 100644 --- a/FS/FS/cdr/troop.pm +++ b/FS/FS/cdr/troop.pm @@ -7,7 +7,7 @@ use Time::Local; #use FS::cdr qw( _cdr_date_parser_maker _cdr_min_parser_maker ); %info = ( - 'name' => 'Troop', + 'name' => 'Troop (old?)', 'weight' => 220, 'header' => 2, 'type' => 'xls', diff --git a/FS/FS/cdr/troop2.pm b/FS/FS/cdr/troop2.pm new file mode 100644 index 000000000..ee6474061 --- /dev/null +++ b/FS/FS/cdr/troop2.pm @@ -0,0 +1,94 @@ +package FS::cdr::troop2; + +use strict; +use base qw( FS::cdr ); +use vars qw( %info $tmp_date $tmp_src_city $tmp_dst_city ); +use Date::Parse; +#use Time::Local; +##use FS::cdr qw( _cdr_date_parser_maker _cdr_min_parser_maker ); + +%info = ( + 'name' => 'Troop', + 'weight' => 219, + 'header' => 1, + 'type' => 'xls', + + 'import_fields' => [ + + 'userfield', #account_num (userfield?) + + #call_date + sub { my($cdr, $date) = @_; + #is this an excel date? or just text? + $tmp_date = $date; + }, + + #call_time + sub { my($cdr, $time) = @_; + #is this an excel time? or just text? + $cdr->startdate( str2time("$tmp_date $time") ); + }, + + 'src', #orig_tn + 'dst', #term_tn + + #call_dur + sub { my($cdr, $duration) = @_; + $cdr->duration($duration); + $cdr->billsec($duration); + }, + + 'clid', #auth_code_ani (clid?) + + 'accountcode', #account_code + + #ovs_type + # OVS Type / Maybe / add "011" to international calls + # N = DOM LD / normal + # Z = INTL LD + # O = INTL LD + # others...? + sub { my($cdr, $ovs) = @_; + my $pre = ( $ovs =~ /^\s*[OZ]\s*$/i ) ? '011' : '1'; + $cdr->dst( $pre. $cdr->dst ) unless $cdr->dst =~ /^$pre/; + }, + + #orig_city + sub { (my $cdr, $tmp_src_city) = @_; }, + + #orig_prov_state + sub { my($cdr, $state) = @_; + $cdr->upstream_src_regionname("$tmp_src_city, $state"); + }, + + #term_city + sub { (my $cdr, $tmp_dst_city) = @_; }, + + #term_prov_state + sub { my($cdr, $state) = @_; + $cdr->upstream_dst_regionname("$tmp_dst_city, $state"); + }, + + #term_ovs + '', #CANADA / UNITED STATES / BELL. huh. country or terminating provider? + + '', #cc_ind (what's this?) + + 'upstream_price', #call_charge + + #important? + '', #creation_date + '', #creation_time + + #additional upstream pricing details we don't need? + '', #net_charge + '', #surcharge + '', #gst + '', #pst + '', #hst + + ], + +); + +1; diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index a76170a9b..c48c80627 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -1,26 +1,20 @@ package FS::cust_bill; +use base qw( FS::Template_Mixin FS::cust_main_Mixin FS::Record ); use strict; -use vars qw( @ISA $DEBUG $me - $money_char $date_format $rdate_format $date_format_long ); +use vars qw( $DEBUG $me $date_format ); # but NOT $conf -use vars qw( $invoice_lines @buf ); #yuck use Fcntl qw(:flock); #for spool_csv use Cwd; -use List::Util qw(min max sum); +use List::Util qw(min max); use Date::Format; -use Date::Language; -use Text::Template 1.20; use File::Temp 0.14; -use String::ShellQuote; use HTML::Entities; -use Locale::Country; use Storable qw( freeze thaw ); use GD::Barcode; use FS::UID qw( datasrc ); -use FS::Misc qw( send_email send_fax generate_ps generate_pdf do_print ); +use FS::Misc qw( send_email send_fax do_print ); use FS::Record qw( qsearch qsearchs dbh ); -use FS::cust_main_Mixin; use FS::cust_main; use FS::cust_statement; use FS::cust_bill_pkg; @@ -44,20 +38,16 @@ use FS::cust_bill_batch; use FS::cust_bill_pay_pkg; use FS::cust_credit_bill_pkg; use FS::discount_plan; +use FS::cust_bill_void; use FS::L10N; -@ISA = qw( FS::cust_main_Mixin FS::Record ); - $DEBUG = 0; $me = '[FS::cust_bill]'; #ask FS::UID to run this stuff for us later FS::UID->install_callback( sub { my $conf = new FS::Conf; #global - $money_char = $conf->config('money_char') || '$'; $date_format = $conf->config('date_format') || '%x'; #/YY - $rdate_format = $conf->config('date_format') || '%m/%d/%Y'; #/YYYY - $date_format_long = $conf->config('date_format_long') || '%b %o, %Y'; } ); =head1 NAME @@ -161,6 +151,7 @@ Invoices are normally created by calling the bill method of a customer object =cut sub table { 'cust_bill'; } +sub notice_name { 'Invoice'; } sub cust_linked { $_[0]->cust_main_custnum; } sub cust_unlinked_msg { @@ -213,10 +204,63 @@ sub insert { } +=item void + +Voids this invoice: deletes the invoice and adds a record of the voided invoice +to the FS::cust_bill_void table (and related tables starting from +FS::cust_bill_pkg_void). + +=cut + +sub void { + my $self = shift; + my $reason = scalar(@_) ? 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_bill_void = new FS::cust_bill_void ( { + map { $_ => $self->get($_) } $self->fields + } ); + $cust_bill_void->reason($reason); + my $error = $cust_bill_void->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + foreach my $cust_bill_pkg ( $self->cust_bill_pkg ) { + my $error = $cust_bill_pkg->void($reason); + 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 This method now works but you probably shouldn't use it. Instead, apply a -credit against the invoice. +credit against the invoice, or use the new void method. 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 @@ -246,11 +290,10 @@ sub delete { cust_event cust_credit_bill cust_bill_pay - cust_credit_bill cust_pay_batch cust_bill_pay_batch - cust_bill_pkg cust_bill_batch + cust_bill_pkg )) { foreach my $linked ( $self->$table() ) { @@ -388,13 +431,29 @@ 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 } ) + grep { $_->owed != 0 } + qsearch( 'cust_bill', { 'custnum' => $self->custnum, + #'_date' => { op=>'<', value=>$self->_date }, + 'invnum' => { op=>'<', value=>$self->invnum }, + } ) ; foreach ( @cust_bill ) { $total += $_->owed; } $total, @cust_bill; } +=item enable_previous + +Whether to show the 'Previous Charges' section when printing this invoice. +The negation of the 'disable_previous_balance' config setting. + +=cut + +sub enable_previous { + my $self = shift; + my $agentnum = $self->cust_main->agentnum; + !$self->conf->exists('disable_previous_balance', $agentnum); +} + =item cust_bill_pkg Returns the line items (see L<FS::cust_bill_pkg>) for this invoice. @@ -1314,14 +1373,16 @@ sub send { $balance_over = shift if scalar(@_) && $_[0] !~ /^\s*$/; } + my $cust_main = $self->cust_main; + return 'N/A' unless ! $agentnums - or grep { $_ == $self->cust_main->agentnum } @$agentnums; + or grep { $_ == $cust_main->agentnum } @$agentnums; return '' - unless $self->cust_main->total_owed_date($self->_date) > $balance_over; + unless $cust_main->total_owed_date($self->_date) > $balance_over; $invoice_from ||= $self->_agent_invoice_from || #XXX should go away - $conf->config('invoice_from', $self->cust_main->agentnum ); + $conf->config('invoice_from', $cust_main->agentnum ); my %opt = ( 'template' => $template, @@ -1329,11 +1390,12 @@ sub send { 'notice_name' => ( $notice_name || 'Invoice' ), ); - my @invoicing_list = $self->cust_main->invoicing_list; + my @invoicing_list = $cust_main->invoicing_list; #$self->email_invoice(\%opt) $self->email(\%opt) - if grep { $_ !~ /^(POST|FAX)$/ } @invoicing_list or !@invoicing_list; + if ( grep { $_ !~ /^(POST|FAX)$/ } @invoicing_list or !@invoicing_list ) + && ! $self->invoice_noemail; #$self->print_invoice(\%opt) $self->print(\%opt) @@ -1748,13 +1810,21 @@ Options are: =over 4 -=item format - 'default' or 'billco' +=item format - any of FS::Misc::::Invoicing::spool_formats -=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 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 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. +=item ftp_targetnum - if set to an FTP target (see L<FS::ftp_target>), will +append to that spool. L<FS::Cron::upload> will then send the spool file to +that destination. + +=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 @@ -1782,11 +1852,23 @@ sub spool_csv { 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 $file; + if ( $opt{'agent_spools'} ) { + $file = 'agentnum'.$cust_main->agentnum; + } else { + $file = 'spool'; + } + + if ( $opt{'ftp_targetnum'} ) { + $spooldir .= '/target'.$opt{'ftp_targetnum'}; + mkdir $spooldir, 0700 unless -d $spooldir; + } # otherwise it just goes into export.xxx/cust_bill + + if ( lc($opt{'format'}) eq 'billco' ) { + $file .= '-header'; + } + + $file = "$spooldir/$file.csv"; my ( $header, $detail ) = $self->print_csv(%opt, 'tracctnum' => $tracctnum ); @@ -1801,10 +1883,7 @@ sub spool_csv { flock(CSV, LOCK_UN); close CSV; - $file = - "$spooldir/". - ( $opt{'agent_spools'} ? 'agentnum'.$cust_main->agentnum : 'spool' ). - '-detail.csv'; + $file =~ s/-header.csv$/-detail.csv/; open(CSV,">>$file") or die "can't open $file: $!"; flock(CSV, LOCK_EX); @@ -1826,7 +1905,7 @@ Returns CSV data for this invoice. Options are: -format - 'default' or 'billco' +format - 'default', 'billco', 'oneline', 'bridgestone' 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 @@ -1835,7 +1914,8 @@ 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 +record_type, invnum, custnum, _date, charged, first, last, company, address1, +address2, city, state, zip, country, pkg, setup, recur, sdate, edate =over 4 @@ -1940,6 +2020,26 @@ If I<format> is "billco", the fields of the detail CSV file are as follows: 9 | Grouping Code | GROUP | CHAR | 2 10 | User Defined | ACCT CODE | CHAR | 15 +If format is 'oneline', there is no detail file. Each invoice has a +header line only, with the fields: + +Agent number, agent name, customer number, first name, last name, address +line 1, address line 2, city, state, zip, invoice date, invoice number, +amount charged, amount due, + +and then, for each line item, three columns containing the package number, +description, and amount. + +If format is 'bridgestone', there is no detail file. Each invoice has a +header line with the following fields in a fixed-width format: + +Customer number (in display format), date, name (first last), company, +address 1, address 2, city, state, zip. + +This is a mailing list format, and has no per-invoice fields. To avoid +sending redundant notices, the spooling event should have a "once" or +"once_percust_every" condition. + =cut sub print_csv { @@ -2036,6 +2136,31 @@ sub print_csv { @items, ); + } elsif ( lc($opt{'format'}) eq 'bridgestone' ) { + + # bypass the CSV stuff and just return this + my $longdate = time2str('%B %d, %Y', time); #current time, right? + my $zip = $cust_main->zip; + $zip =~ s/\D//; + my $prefix = $self->conf->config('bridgestone-prefix', $cust_main->agentnum) + || ''; + return ( + sprintf( + "%-5s%-15s%-20s%-30s%-30s%-30s%-30s%-20s%-2s%-9s\n", + $prefix, + $cust_main->display_custnum, + $longdate, + uc(substr($cust_main->contact_firstlast,0,30)), + uc(substr($cust_main->company ,0,30)), + uc(substr($cust_main->address1 ,0,30)), + uc(substr($cust_main->address2 ,0,30)), + uc(substr($cust_main->city ,0,20)), + uc($cust_main->state), + $zip + ), + '' #detail + ); + } else { $csv->combine( @@ -2257,143 +2382,6 @@ sub _agent_invoice_from { $self->cust_main->agent_invoice_from; } -=item print_text HASHREF | [ TIME [ , TEMPLATE [ , OPTION => VALUE ... ] ] ] - -Returns an text invoice, as a list of lines. - -Options can be passed as a hashref (recommended) or as a list of time, template -and then any key/value pairs for any other options. - -I<time>, if specified, is 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. - -I<template>, if specified, is the name of a suffix for alternate invoices. - -I<notice_name>, if specified, overrides "Invoice" as the name of the sent document (templates from 10/2009 or newer required) - -=cut - -sub print_text { - my $self = shift; - my( $today, $template, %opt ); - if ( ref($_[0]) ) { - %opt = %{ shift() }; - $today = delete($opt{'time'}) || ''; - $template = delete($opt{template}) || ''; - } else { - ( $today, $template, %opt ) = @_; - } - - my %params = ( 'format' => 'template' ); - $params{'time'} = $today if $today; - $params{'template'} = $template if $template; - $params{$_} = $opt{$_} - foreach grep $opt{$_}, qw( unsquelch_cdr notice_name ); - - $self->print_generic( %params ); -} - -=item print_latex HASHREF | [ TIME [ , TEMPLATE [ , OPTION => VALUE ... ] ] ] - -Internal method - returns a filename of a filled-in LaTeX template for this -invoice (Note: add ".tex" to get the actual filename), and a filename of -an associated logo (with the .eps extension included). - -See print_ps and print_pdf for methods that return PostScript and PDF output. - -Options can be passed as a hashref (recommended) or as a list of time, template -and then any key/value pairs for any other options. - -I<time>, if specified, is 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. - -I<template>, if specified, is the name of a suffix for alternate invoices. - -I<notice_name>, if specified, overrides "Invoice" as the name of the sent document (templates from 10/2009 or newer required) - -=cut - -sub print_latex { - my $self = shift; - my $conf = $self->conf; - my( $today, $template, %opt ); - if ( ref($_[0]) ) { - %opt = %{ shift() }; - $today = delete($opt{'time'}) || ''; - $template = delete($opt{template}) || ''; - } else { - ( $today, $template, %opt ) = @_; - } - - my %params = ( 'format' => 'latex' ); - $params{'time'} = $today if $today; - $params{'template'} = $template if $template; - $params{$_} = $opt{$_} - foreach grep $opt{$_}, qw( unsquelch_cdr notice_name ); - - $template ||= $self->_agent_template; - - my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc; - my $lh = new File::Temp( TEMPLATE => 'invoice.'. $self->invnum. '.XXXXXXXX', - DIR => $dir, - SUFFIX => '.eps', - UNLINK => 0, - ) or die "can't open temp file: $!\n"; - - my $agentnum = $self->cust_main->agentnum; - - if ( $template && $conf->exists("logo_${template}.eps", $agentnum) ) { - print $lh $conf->config_binary("logo_${template}.eps", $agentnum) - or die "can't write temp file: $!\n"; - } else { - print $lh $conf->config_binary('logo.eps', $agentnum) - or die "can't write temp file: $!\n"; - } - close $lh; - $params{'logo_file'} = $lh->filename; - - if($conf->exists('invoice-barcode')){ - my $png_file = $self->invoice_barcode($dir); - my $eps_file = $png_file; - $eps_file =~ s/\.png$/.eps/g; - $png_file =~ /(barcode.*png)/; - $png_file = $1; - $eps_file =~ /(barcode.*eps)/; - $eps_file = $1; - - my $curr_dir = cwd(); - chdir($dir); - # after painfuly long experimentation, it was determined that sam2p won't - # accept : and other chars in the path, no matter how hard I tried to - # escape them, hence the chdir (and chdir back, just to be safe) - system('sam2p', '-j:quiet', $png_file, 'EPS:', $eps_file ) == 0 - or die "sam2p failed: $!\n"; - unlink($png_file); - chdir($curr_dir); - - $params{'barcode_file'} = $eps_file; - } - - my @filled_in = $self->print_generic( %params ); - - my $fh = new File::Temp( TEMPLATE => 'invoice.'. $self->invnum. '.XXXXXXXX', - DIR => $dir, - SUFFIX => '.tex', - UNLINK => 0, - ) or die "can't open temp file: $!\n"; - binmode($fh, ':utf8'); # language support - print $fh join('', @filled_in ); - close $fh; - - $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename; - return ($1, $params{'logo_file'}, $params{'barcode_file'}); - -} - =item invoice_barcode DIR_OR_FALSE Generates an invoice barcode PNG. If DIR_OR_FALSE is a true value, @@ -2423,1365 +2411,6 @@ sub invoice_barcode { return $gd->png; } -=item print_generic OPTION => VALUE ... - -Internal method - returns a filled-in template for this invoice as a scalar. - -See print_ps and print_pdf for methods that return PostScript and PDF output. - -Non optional options include - format - latex, html, template - -Optional options include - -template - a value used as a suffix for a configuration template - -time - a 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 - - -unsquelch_cdr - overrides any per customer cdr squelching when true - -notice_name - overrides "Invoice" as the name of the sent document (templates from 10/2009 or newer required) - -locale - override customer's locale - -=cut - -#what's with all the sprintf('%10.2f')'s in here? will it cause any -# (alignment in text invoice?) problems to change them all to '%.2f' ? -# yes: fixed width/plain text printing will be borked -sub print_generic { - my( $self, %params ) = @_; - my $conf = $self->conf; - my $today = $params{today} ? $params{today} : time; - warn "$me print_generic called on $self with suffix $params{template}\n" - if $DEBUG; - - my $format = $params{format}; - die "Unknown format: $format" - unless $format =~ /^(latex|html|template)$/; - - my $cust_main = $self->cust_main; - $cust_main->payname( $cust_main->first. ' '. $cust_main->getfield('last') ) - unless $cust_main->payname - && $cust_main->payby !~ /^(CARD|DCRD|CHEK|DCHK)$/; - - my %delimiters = ( 'latex' => [ '[@--', '--@]' ], - 'html' => [ '<%=', '%>' ], - 'template' => [ '{', '}' ], - ); - - warn "$me print_generic creating template\n" - if $DEBUG > 1; - - #create the template - my $template = $params{template} ? $params{template} : $self->_agent_template; - my $templatefile = "invoice_$format"; - $templatefile .= "_$template" - if length($template) && $conf->exists($templatefile."_$template"); - my @invoice_template = map "$_\n", $conf->config($templatefile) - or die "cannot load config data $templatefile"; - - my $old_latex = ''; - if ( $format eq 'latex' && 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"; - $old_latex = 'true'; - @invoice_template = _translate_old_latex_format(@invoice_template); - } - - warn "$me print_generic creating T:T object\n" - if $DEBUG > 1; - - my $text_template = new Text::Template( - TYPE => 'ARRAY', - SOURCE => \@invoice_template, - DELIMITERS => $delimiters{$format}, - ); - - warn "$me print_generic compiling T:T object\n" - if $DEBUG > 1; - - $text_template->compile() - or die "Can't compile $templatefile: $Text::Template::ERROR\n"; - - - # additional substitution could possibly cause breakage in existing templates - my %convert_maps = ( - 'latex' => { - 'notes' => sub { map "$_", @_ }, - 'footer' => sub { map "$_", @_ }, - 'smallfooter' => sub { map "$_", @_ }, - 'returnaddress' => sub { map "$_", @_ }, - 'coupon' => sub { map "$_", @_ }, - 'summary' => sub { map "$_", @_ }, - }, - 'html' => { - 'notes' => - sub { - map { - s/%%(.*)$/<!-- $1 -->/g; - s/\\section\*\{\\textsc\{(.)(.*)\}\}/<p><b><font size="+1">$1<\/font>\U$2<\/b>/g; - s/\\begin\{enumerate\}/<ol>/g; - s/\\item / <li>/g; - s/\\end\{enumerate\}/<\/ol>/g; - s/\\textbf\{(.*)\}/<b>$1<\/b>/g; - s/\\\\\*/<br>/g; - s/\\dollar ?/\$/g; - s/\\#/#/g; - s/~/ /g; - $_; - } @_ - }, - 'footer' => - sub { map { s/~/ /g; s/\\\\\*?\s*$/<BR>/; $_; } @_ }, - 'smallfooter' => - sub { map { s/~/ /g; s/\\\\\*?\s*$/<BR>/; $_; } @_ }, - 'returnaddress' => - sub { - map { - s/~/ /g; - s/\\\\\*?\s*$/<BR>/; - s/\\hyphenation\{[\w\s\-]+}//; - s/\\([&])/$1/g; - $_; - } @_ - }, - 'coupon' => sub { "" }, - 'summary' => sub { "" }, - }, - 'template' => { - 'notes' => - sub { - map { - s/%%.*$//g; - s/\\section\*\{\\textsc\{(.*)\}\}/\U$1/g; - s/\\begin\{enumerate\}//g; - s/\\item / * /g; - s/\\end\{enumerate\}//g; - s/\\textbf\{(.*)\}/$1/g; - s/\\\\\*/ /; - s/\\dollar ?/\$/g; - $_; - } @_ - }, - 'footer' => - sub { map { s/~/ /g; s/\\\\\*?\s*$/\n/; $_; } @_ }, - 'smallfooter' => - sub { map { s/~/ /g; s/\\\\\*?\s*$/\n/; $_; } @_ }, - 'returnaddress' => - sub { - map { - s/~/ /g; - s/\\\\\*?\s*$/\n/; # dubious - s/\\hyphenation\{[\w\s\-]+}//; - $_; - } @_ - }, - 'coupon' => sub { "" }, - 'summary' => sub { "" }, - }, - ); - - - # hashes for differing output formats - my %nbsps = ( 'latex' => '~', - 'html' => '', # '&nbps;' would be nice - 'template' => '', # not used - ); - my $nbsp = $nbsps{$format}; - - my %escape_functions = ( 'latex' => \&_latex_escape, - 'html' => \&_html_escape_nbsp,#\&encode_entities, - 'template' => sub { shift }, - ); - my $escape_function = $escape_functions{$format}; - my $escape_function_nonbsp = ($format eq 'html') - ? \&_html_escape : $escape_function; - - my %date_formats = ( 'latex' => $date_format_long, - 'html' => $date_format_long, - 'template' => '%s', - ); - $date_formats{'html'} =~ s/ / /g; - - my $date_format = $date_formats{$format}; - - my %embolden_functions = ( 'latex' => sub { return '\textbf{'. shift(). '}' - }, - 'html' => sub { return '<b>'. shift(). '</b>' - }, - 'template' => sub { shift }, - ); - my $embolden_function = $embolden_functions{$format}; - - my %newline_tokens = ( 'latex' => '\\\\', - 'html' => '<br>', - 'template' => "\n", - ); - my $newline_token = $newline_tokens{$format}; - - warn "$me generating template variables\n" - if $DEBUG > 1; - - # generate template variables - my $returnaddress; - if ( - defined( $conf->config_orbase( "invoice_${format}returnaddress", - $template - ) - ) - && length( $conf->config_orbase( "invoice_${format}returnaddress", - $template - ) - ) - ) { - - $returnaddress = join("\n", - $conf->config_orbase("invoice_${format}returnaddress", $template) - ); - - } elsif ( grep /\S/, - $conf->config_orbase('invoice_latexreturnaddress', $template) ) { - - my $convert_map = $convert_maps{$format}{'returnaddress'}; - $returnaddress = - join( "\n", - &$convert_map( $conf->config_orbase( "invoice_latexreturnaddress", - $template - ) - ) - ); - } elsif ( grep /\S/, $conf->config('company_address', $self->cust_main->agentnum) ) { - - my $convert_map = $convert_maps{$format}{'returnaddress'}; - $returnaddress = join( "\n", &$convert_map( - map { s/( {2,})/'~' x length($1)/eg; - s/$/\\\\\*/; - $_ - } - ( $conf->config('company_name', $self->cust_main->agentnum), - $conf->config('company_address', $self->cust_main->agentnum), - ) - ) - ); - - } else { - - my $warning = "Couldn't find a return address; ". - "do you need to set the company_address configuration value?"; - warn "$warning\n"; - $returnaddress = $nbsp; - #$returnaddress = $warning; - - } - - warn "$me generating invoice data\n" - if $DEBUG > 1; - - my $agentnum = $self->cust_main->agentnum; - - my %invoice_data = ( - - #invoice from info - 'company_name' => scalar( $conf->config('company_name', $agentnum) ), - 'company_address' => join("\n", $conf->config('company_address', $agentnum) ). "\n", - 'company_phonenum'=> scalar( $conf->config('company_phonenum', $agentnum) ), - 'returnaddress' => $returnaddress, - 'agent' => &$escape_function($cust_main->agent->agent), - - #invoice info - 'invnum' => $self->invnum, - 'date' => time2str($date_format, $self->_date), - 'today' => time2str($date_format_long, $today), - 'terms' => $self->terms, - 'template' => $template, #params{'template'}, - 'notice_name' => ($params{'notice_name'} || 'Invoice'),#escape_function? - 'current_charges' => sprintf("%.2f", $self->charged), - 'duedate' => $self->due_date2str($rdate_format), #date_format? - - #customer info - 'custnum' => $cust_main->display_custnum, - 'agent_custid' => &$escape_function($cust_main->agent_custid), - ( map { $_ => &$escape_function($cust_main->$_()) } qw( - payname company address1 address2 city state zip fax - )), - - #global config - 'ship_enable' => $conf->exists('invoice-ship_address'), - 'unitprices' => $conf->exists('invoice-unitprice'), - 'smallernotes' => $conf->exists('invoice-smallernotes'), - 'smallerfooter' => $conf->exists('invoice-smallerfooter'), - 'balance_due_below_line' => $conf->exists('balance_due_below_line'), - - #layout info -- would be fancy to calc some of this and bury the template - # here in the code - 'topmargin' => scalar($conf->config('invoice_latextopmargin', $agentnum)), - 'headsep' => scalar($conf->config('invoice_latexheadsep', $agentnum)), - 'textheight' => scalar($conf->config('invoice_latextextheight', $agentnum)), - 'extracouponspace' => scalar($conf->config('invoice_latexextracouponspace', $agentnum)), - 'couponfootsep' => scalar($conf->config('invoice_latexcouponfootsep', $agentnum)), - 'verticalreturnaddress' => $conf->exists('invoice_latexverticalreturnaddress', $agentnum), - 'addresssep' => scalar($conf->config('invoice_latexaddresssep', $agentnum)), - 'amountenclosedsep' => scalar($conf->config('invoice_latexcouponamountenclosedsep', $agentnum)), - 'coupontoaddresssep' => scalar($conf->config('invoice_latexcoupontoaddresssep', $agentnum)), - 'addcompanytoaddress' => $conf->exists('invoice_latexcouponaddcompanytoaddress', $agentnum), - - # better hang on to conf_dir for a while (for old templates) - 'conf_dir' => "$FS::UID::conf_dir/conf.$FS::UID::datasrc", - - #these are only used when doing paged plaintext - 'page' => 1, - 'total_pages' => 1, - - ); - - #localization - my $lh = FS::L10N->get_handle( $params{'locale'} || $cust_main->locale ); - $invoice_data{'emt'} = sub { &$escape_function($self->mt(@_)) }; - my %info = FS::Locales->locale_info($cust_main->locale || 'en_US'); - # eval to avoid death for unimplemented languages - my $dh = eval { Date::Language->new($info{'name'}) } || - Date::Language->new(); # fall back to English - # prototype here to silence warnings - $invoice_data{'time2str'} = sub ($;$$) { $dh->time2str(@_) }; - # eventually use this date handle everywhere in here, too - - my $min_sdate = 999999999999; - my $max_edate = 0; - foreach my $cust_bill_pkg ( $self->cust_bill_pkg ) { - next unless $cust_bill_pkg->pkgnum > 0; - $min_sdate = $cust_bill_pkg->sdate - if length($cust_bill_pkg->sdate) && $cust_bill_pkg->sdate < $min_sdate; - $max_edate = $cust_bill_pkg->edate - if length($cust_bill_pkg->edate) && $cust_bill_pkg->edate > $max_edate; - } - - $invoice_data{'bill_period'} = ''; - $invoice_data{'bill_period'} = time2str('%e %h', $min_sdate) - . " to " . time2str('%e %h', $max_edate) - if ($max_edate != 0 && $min_sdate != 999999999999); - - $invoice_data{finance_section} = ''; - if ( $conf->config('finance_pkgclass') ) { - my $pkg_class = - qsearchs('pkg_class', { classnum => $conf->config('finance_pkgclass') }); - $invoice_data{finance_section} = $pkg_class->categoryname; - } - $invoice_data{finance_amount} = '0.00'; - $invoice_data{finance_section} ||= 'Finance Charges'; #avoid config confusion - - my $countrydefault = $conf->config('countrydefault') || 'US'; - my $prefix = $cust_main->has_ship_address ? 'ship_' : ''; - foreach ( qw( contact company address1 address2 city state zip country fax) ){ - my $method = $prefix.$_; - $invoice_data{"ship_$_"} = _latex_escape($cust_main->$method); - } - $invoice_data{'ship_country'} = '' - if ( $invoice_data{'ship_country'} eq $countrydefault ); - - $invoice_data{'cid'} = $params{'cid'} - if $params{'cid'}; - - if ( $cust_main->country eq $countrydefault ) { - $invoice_data{'country'} = ''; - } else { - $invoice_data{'country'} = &$escape_function(code2country($cust_main->country)); - } - - my @address = (); - $invoice_data{'address'} = \@address; - push @address, - $cust_main->payname. - ( ( $cust_main->payby eq 'BILL' ) && $cust_main->payinfo - ? " (P.O. #". $cust_main->payinfo. ")" - : '' - ) - ; - push @address, $cust_main->company - if $cust_main->company; - push @address, $cust_main->address1; - push @address, $cust_main->address2 - if $cust_main->address2; - push @address, - $cust_main->city. ", ". $cust_main->state. " ". $cust_main->zip; - push @address, $invoice_data{'country'} - if $invoice_data{'country'}; - push @address, '' - while (scalar(@address) < 5); - - $invoice_data{'logo_file'} = $params{'logo_file'} - if $params{'logo_file'}; - $invoice_data{'barcode_file'} = $params{'barcode_file'} - if $params{'barcode_file'}; - $invoice_data{'barcode_img'} = $params{'barcode_img'} - if $params{'barcode_img'}; - $invoice_data{'barcode_cid'} = $params{'barcode_cid'} - if $params{'barcode_cid'}; - - 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; - - # the customer's current balance as shown on the invoice before this one - $invoice_data{'true_previous_balance'} = sprintf("%.2f", ($self->previous_balance || 0) ); - - # the change in balance from that invoice to this one - $invoice_data{'balance_adjustments'} = sprintf("%.2f", ($self->previous_balance || 0) - ($self->billing_balance || 0) ); - - # the sum of amount owed on all previous invoices - $invoice_data{'previous_balance'} = sprintf("%.2f", $pr_total); - - # the sum of amount owed on all invoices - $invoice_data{'balance'} = sprintf("%.2f", $balance_due); - - # info from customer's last invoice before this one, for some - # summary formats - $invoice_data{'last_bill'} = {}; - my $last_bill = $pr_cust_bill[-1]; - if ( $last_bill ) { - $invoice_data{'last_bill'} = { - '_date' => $last_bill->_date, #unformatted - # all we need for now - }; - } - - my $summarypage = ''; - if ( $conf->exists('invoice_usesummary', $agentnum) ) { - $summarypage = 1; - } - $invoice_data{'summarypage'} = $summarypage; - - warn "$me substituting variables in notes, footer, smallfooter\n" - if $DEBUG > 1; - - my @include = (qw( notes footer smallfooter )); - push @include, 'coupon' unless $params{'no_coupon'}; - foreach my $include (@include) { - - my $inc_file = $conf->key_orbase("invoice_${format}$include", $template); - my @inc_src; - - if ( $conf->exists($inc_file, $agentnum) - && length( $conf->config($inc_file, $agentnum) ) ) { - - @inc_src = $conf->config($inc_file, $agentnum); - - } else { - - $inc_file = $conf->key_orbase("invoice_latex$include", $template); - - my $convert_map = $convert_maps{$format}{$include}; - - @inc_src = map { s/\[\@--/$delimiters{$format}[0]/g; - s/--\@\]/$delimiters{$format}[1]/g; - $_; - } - &$convert_map( $conf->config($inc_file, $agentnum) ); - - } - - my $inc_tt = new Text::Template ( - TYPE => 'ARRAY', - SOURCE => [ map "$_\n", @inc_src ], - DELIMITERS => $delimiters{$format}, - ) or die "Can't create new Text::Template object: $Text::Template::ERROR"; - - unless ( $inc_tt->compile() ) { - my $error = "Can't compile $inc_file template: $Text::Template::ERROR\n"; - warn $error. "Template:\n". join('', map "$_\n", @inc_src); - die $error; - } - - $invoice_data{$include} = $inc_tt->fill_in( HASH => \%invoice_data ); - - $invoice_data{$include} =~ s/\n+$// - if ($format eq 'latex'); - } - - # let invoices use either of these as needed - $invoice_data{'po_num'} = ($cust_main->payby eq 'BILL') - ? $cust_main->payinfo : ''; - $invoice_data{'po_line'} = - ( $cust_main->payby eq 'BILL' && $cust_main->payinfo ) - ? &$escape_function($self->mt("Purchase Order #").$cust_main->payinfo) - : $nbsp; - - my %money_chars = ( 'latex' => '', - 'html' => $conf->config('money_char') || '$', - 'template' => '', - ); - my $money_char = $money_chars{$format}; - - my %other_money_chars = ( 'latex' => '\dollar ',#XXX should be a config too - 'html' => $conf->config('money_char') || '$', - 'template' => '', - ); - my $other_money_char = $other_money_chars{$format}; - $invoice_data{'dollar'} = $other_money_char; - - my @detail_items = (); - my @total_items = (); - my @buf = (); - my @sections = (); - - $invoice_data{'detail_items'} = \@detail_items; - $invoice_data{'total_items'} = \@total_items; - $invoice_data{'buf'} = \@buf; - $invoice_data{'sections'} = \@sections; - - warn "$me generating sections\n" - if $DEBUG > 1; - - my $previous_section = { 'description' => $self->mt('Previous Charges'), - 'subtotal' => $other_money_char. - sprintf('%.2f', $pr_total), - 'summarized' => '', #why? $summarypage ? 'Y' : '', - }; - $previous_section->{posttotal} = '0 / 30 / 60 / 90 days overdue '. - join(' / ', map { $cust_main->balance_date_range(@$_) } - $self->_prior_month30s - ) - if $conf->exists('invoice_include_aging'); - - my $taxtotal = 0; - my $tax_section = { 'description' => $self->mt('Taxes, Surcharges, and Fees'), - 'subtotal' => $taxtotal, # adjusted below - }; - my $tax_weight = _pkg_category($tax_section->{description}) - ? _pkg_category($tax_section->{description})->weight - : 0; - $tax_section->{'summarized'} = ''; #why? $summarypage && !$tax_weight ? 'Y' : ''; - $tax_section->{'sort_weight'} = $tax_weight; - - - my $adjusttotal = 0; - my $adjust_section = { 'description' => - $self->mt('Credits, Payments, and Adjustments'), - 'subtotal' => 0, # adjusted below - }; - my $adjust_weight = _pkg_category($adjust_section->{description}) - ? _pkg_category($adjust_section->{description})->weight - : 0; - $adjust_section->{'summarized'} = ''; #why? $summarypage && !$adjust_weight ? 'Y' : ''; - $adjust_section->{'sort_weight'} = $adjust_weight; - - my $unsquelched = $params{unsquelch_cdr} || $cust_main->squelch_cdr ne 'Y'; - my $multisection = $conf->exists('invoice_sections', $cust_main->agentnum); - $invoice_data{'multisection'} = $multisection; - my $late_sections = []; - my $extra_sections = []; - my $extra_lines = (); - if ( $multisection ) { - ($extra_sections, $extra_lines) = - $self->_items_extra_usage_sections($escape_function_nonbsp, $format) - if $conf->exists('usage_class_as_a_section', $cust_main->agentnum); - - push @$extra_sections, $adjust_section if $adjust_section->{sort_weight}; - - push @detail_items, @$extra_lines if $extra_lines; - push @sections, - $self->_items_sections( $late_sections, # this could stand a refactor - $summarypage, - $escape_function_nonbsp, - $extra_sections, - $format, #bah - ); - if ($conf->exists('svc_phone_sections')) { - my ($phone_sections, $phone_lines) = - $self->_items_svc_phone_sections($escape_function_nonbsp, $format); - push @{$late_sections}, @$phone_sections; - push @detail_items, @$phone_lines; - } - if ($conf->exists('voip-cust_accountcode_cdr') && $cust_main->accountcode_cdr) { - my ($accountcode_section, $accountcode_lines) = - $self->_items_accountcode_cdr($escape_function_nonbsp,$format); - if ( scalar(@$accountcode_lines) ) { - push @{$late_sections}, $accountcode_section; - push @detail_items, @$accountcode_lines; - } - } - } else {# not multisection - # make a default section - push @sections, { 'description' => '', 'subtotal' => '', - 'no_subtotal' => 1 }; - # and calculate the finance charge total, since it won't get done otherwise. - # XXX possibly other totals? - # XXX possibly finance_pkgclass should not be used in this manner? - if ( $conf->exists('finance_pkgclass') ) { - my @finance_charges; - foreach my $cust_bill_pkg ( $self->cust_bill_pkg ) { - if ( grep { $_->section eq $invoice_data{finance_section} } - $cust_bill_pkg->cust_bill_pkg_display ) { - # I think these are always setup fees, but just to be sure... - push @finance_charges, $cust_bill_pkg->recur + $cust_bill_pkg->setup; - } - } - $invoice_data{finance_amount} = - sprintf('%.2f', sum( @finance_charges ) || 0); - } - } - - unless ( $conf->exists('disable_previous_balance', $agentnum) - || $conf->exists('previous_balance-summary_only') - ) - { - - warn "$me adding previous balances\n" - if $DEBUG > 1; - - foreach my $line_item ( $self->_items_previous ) { - - my $detail = { - ext_description => [], - }; - $detail->{'ref'} = $line_item->{'pkgnum'}; - $detail->{'quantity'} = 1; - $detail->{'section'} = $previous_section; - $detail->{'description'} = &$escape_function($line_item->{'description'}); - if ( exists $line_item->{'ext_description'} ) { - @{$detail->{'ext_description'}} = map { - &$escape_function($_); - } @{$line_item->{'ext_description'}}; - } - $detail->{'amount'} = ( $old_latex ? '' : $money_char). - $line_item->{'amount'}; - $detail->{'product_code'} = $line_item->{'pkgpart'} || 'N/A'; - - push @detail_items, $detail; - push @buf, [ $detail->{'description'}, - $money_char. sprintf("%10.2f", $line_item->{'amount'}), - ]; - } - - } - - if ( @pr_cust_bill && !$conf->exists('disable_previous_balance', $agentnum) ) - { - push @buf, ['','-----------']; - push @buf, [ $self->mt('Total Previous Balance'), - $money_char. sprintf("%10.2f", $pr_total) ]; - push @buf, ['','']; - } - - if ( $conf->exists('svc_phone-did-summary') ) { - warn "$me adding DID summary\n" - if $DEBUG > 1; - - my ($didsummary,$minutes) = $self->_did_summary; - my $didsummary_desc = 'DID Activity Summary (since last invoice)'; - push @detail_items, - { 'description' => $didsummary_desc, - 'ext_description' => [ $didsummary, $minutes ], - }; - } - - foreach my $section (@sections, @$late_sections) { - - warn "$me adding section \n". Dumper($section) - if $DEBUG > 1; - - # begin some normalization - $section->{'subtotal'} = $section->{'amount'} - if $multisection - && !exists($section->{subtotal}) - && exists($section->{amount}); - - $invoice_data{finance_amount} = sprintf('%.2f', $section->{'subtotal'} ) - if ( $invoice_data{finance_section} && - $section->{'description'} eq $invoice_data{finance_section} ); - - $section->{'subtotal'} = $other_money_char. - sprintf('%.2f', $section->{'subtotal'}) - if $multisection; - - # continue some normalization - $section->{'amount'} = $section->{'subtotal'} - if $multisection; - - - if ( $section->{'description'} ) { - push @buf, ( [ &$escape_function($section->{'description'}), '' ], - [ '', '' ], - ); - } - - warn "$me setting options\n" - if $DEBUG > 1; - - my $multilocation = scalar($cust_main->cust_location); #too expensive? - my %options = (); - $options{'section'} = $section if $multisection; - $options{'format'} = $format; - $options{'escape_function'} = $escape_function; - $options{'no_usage'} = 1 unless $unsquelched; - $options{'unsquelched'} = $unsquelched; - $options{'summary_page'} = $summarypage; - $options{'skip_usage'} = - scalar(@$extra_sections) && !grep{$section == $_} @$extra_sections; - $options{'multilocation'} = $multilocation; - $options{'multisection'} = $multisection; - - warn "$me searching for line items\n" - if $DEBUG > 1; - - foreach my $line_item ( $self->_items_pkg(%options) ) { - - warn "$me adding line item $line_item\n" - if $DEBUG > 1; - - my $detail = { - ext_description => [], - }; - $detail->{'ref'} = $line_item->{'pkgnum'}; - $detail->{'quantity'} = $line_item->{'quantity'}; - $detail->{'section'} = $section; - $detail->{'description'} = &$escape_function($line_item->{'description'}); - if ( exists $line_item->{'ext_description'} ) { - @{$detail->{'ext_description'}} = @{$line_item->{'ext_description'}}; - } - $detail->{'amount'} = ( $old_latex ? '' : $money_char ). - $line_item->{'amount'}; - $detail->{'unit_amount'} = ( $old_latex ? '' : $money_char ). - $line_item->{'unit_amount'}; - $detail->{'product_code'} = $line_item->{'pkgpart'} || 'N/A'; - - $detail->{'sdate'} = $line_item->{'sdate'}; - $detail->{'edate'} = $line_item->{'edate'}; - $detail->{'seconds'} = $line_item->{'seconds'}; - - push @detail_items, $detail; - push @buf, ( [ $detail->{'description'}, - $money_char. sprintf("%10.2f", $line_item->{'amount'}), - ], - map { [ " ". $_, '' ] } @{$detail->{'ext_description'}}, - ); - } - - if ( $section->{'description'} ) { - push @buf, ( ['','-----------'], - [ $section->{'description'}. ' sub-total', - $section->{'subtotal'} # already formatted this - ], - [ '', '' ], - [ '', '' ], - ); - } - - } - - $invoice_data{current_less_finance} = - sprintf('%.2f', $self->charged - $invoice_data{finance_amount} ); - - if ( $multisection && !$conf->exists('disable_previous_balance', $agentnum) - || $conf->exists('previous_balance-summary_only') ) - { - unshift @sections, $previous_section if $pr_total; - } - - warn "$me adding taxes\n" - if $DEBUG > 1; - - foreach my $tax ( $self->_items_tax ) { - - $taxtotal += $tax->{'amount'}; - - my $description = &$escape_function( $tax->{'description'} ); - my $amount = sprintf( '%.2f', $tax->{'amount'} ); - - if ( $multisection ) { - - my $money = $old_latex ? '' : $money_char; - push @detail_items, { - ext_description => [], - ref => '', - quantity => '', - description => $description, - amount => $money. $amount, - product_code => '', - section => $tax_section, - }; - - } else { - - push @total_items, { - 'total_item' => $description, - 'total_amount' => $other_money_char. $amount, - }; - - } - - push @buf,[ $description, - $money_char. $amount, - ]; - - } - - if ( $taxtotal ) { - my $total = {}; - $total->{'total_item'} = $self->mt('Sub-total'); - $total->{'total_amount'} = - $other_money_char. sprintf('%.2f', $self->charged - $taxtotal ); - - if ( $multisection ) { - $tax_section->{'subtotal'} = $other_money_char. - sprintf('%.2f', $taxtotal); - $tax_section->{'pretotal'} = 'New charges sub-total '. - $total->{'total_amount'}; - push @sections, $tax_section if $taxtotal; - }else{ - unshift @total_items, $total; - } - } - $invoice_data{'taxtotal'} = sprintf('%.2f', $taxtotal); - - push @buf,['','-----------']; - push @buf,[$self->mt( - $conf->exists('disable_previous_balance', $agentnum) - ? 'Total Charges' - : 'Total New Charges' - ), - $money_char. sprintf("%10.2f",$self->charged) ]; - push @buf,['','']; - - { - my $total = {}; - my $item = 'Total'; - $item = $conf->config('previous_balance-exclude_from_total') - || 'Total New Charges' - if $conf->exists('previous_balance-exclude_from_total'); - my $amount = $self->charged + - ( $conf->exists('disable_previous_balance', $agentnum) || - $conf->exists('previous_balance-exclude_from_total') - ? 0 - : $pr_total - ); - $total->{'total_item'} = &$embolden_function($self->mt($item)); - $total->{'total_amount'} = - &$embolden_function( $other_money_char. sprintf( '%.2f', $amount ) ); - if ( $multisection ) { - if ( $adjust_section->{'sort_weight'} ) { - $adjust_section->{'posttotal'} = $self->mt('Balance Forward').' '. - $other_money_char. sprintf("%.2f", ($self->billing_balance || 0) ); - } else { - $adjust_section->{'pretotal'} = $self->mt('New charges total').' '. - $other_money_char. sprintf('%.2f', $self->charged ); - } - }else{ - push @total_items, $total; - } - push @buf,['','-----------']; - push @buf,[$item, - $money_char. - sprintf( '%10.2f', $amount ) - ]; - push @buf,['','']; - } - - unless ( $conf->exists('disable_previous_balance', $agentnum) ) { - #foreach my $thing ( sort { $a->_date <=> $b->_date } $self->_items_credits, $self->_items_payments - - # credits - my $credittotal = 0; - foreach my $credit ( $self->_items_credits('trim_len'=>60) ) { - - my $total; - $total->{'total_item'} = &$escape_function($credit->{'description'}); - $credittotal += $credit->{'amount'}; - $total->{'total_amount'} = '-'. $other_money_char. $credit->{'amount'}; - $adjusttotal += $credit->{'amount'}; - if ( $multisection ) { - my $money = $old_latex ? '' : $money_char; - push @detail_items, { - ext_description => [], - ref => '', - quantity => '', - description => &$escape_function($credit->{'description'}), - amount => $money. $credit->{'amount'}, - product_code => '', - section => $adjust_section, - }; - } else { - push @total_items, $total; - } - - } - $invoice_data{'credittotal'} = sprintf('%.2f', $credittotal); - - #credits (again) - foreach my $credit ( $self->_items_credits('trim_len'=>32) ) { - push @buf, [ $credit->{'description'}, $money_char.$credit->{'amount'} ]; - } - - # payments - my $paymenttotal = 0; - foreach my $payment ( $self->_items_payments ) { - my $total = {}; - $total->{'total_item'} = &$escape_function($payment->{'description'}); - $paymenttotal += $payment->{'amount'}; - $total->{'total_amount'} = '-'. $other_money_char. $payment->{'amount'}; - $adjusttotal += $payment->{'amount'}; - if ( $multisection ) { - my $money = $old_latex ? '' : $money_char; - push @detail_items, { - ext_description => [], - ref => '', - quantity => '', - description => &$escape_function($payment->{'description'}), - amount => $money. $payment->{'amount'}, - product_code => '', - section => $adjust_section, - }; - }else{ - push @total_items, $total; - } - push @buf, [ $payment->{'description'}, - $money_char. sprintf("%10.2f", $payment->{'amount'}), - ]; - } - $invoice_data{'paymenttotal'} = sprintf('%.2f', $paymenttotal); - - if ( $multisection ) { - $adjust_section->{'subtotal'} = $other_money_char. - sprintf('%.2f', $adjusttotal); - push @sections, $adjust_section - unless $adjust_section->{sort_weight}; - } - - # create Balance Due message - { - my $total; - $total->{'total_item'} = &$embolden_function($self->balance_due_msg); - $total->{'total_amount'} = - &$embolden_function( - $other_money_char. sprintf('%.2f', $summarypage - ? $self->charged + - $self->billing_balance - : $self->owed + $pr_total - ) - ); - if ( $multisection && !$adjust_section->{sort_weight} ) { - $adjust_section->{'posttotal'} = $total->{'total_item'}. ' '. - $total->{'total_amount'}; - }else{ - push @total_items, $total; - } - push @buf,['','-----------']; - push @buf,[$self->balance_due_msg, $money_char. - sprintf("%10.2f", $balance_due ) ]; - } - - if ( $conf->exists('previous_balance-show_credit') - and $cust_main->balance < 0 ) { - my $credit_total = { - 'total_item' => &$embolden_function($self->credit_balance_msg), - 'total_amount' => &$embolden_function( - $other_money_char. sprintf('%.2f', -$cust_main->balance) - ), - }; - if ( $multisection ) { - $adjust_section->{'posttotal'} .= $newline_token . - $credit_total->{'total_item'} . ' ' . $credit_total->{'total_amount'}; - } - else { - push @total_items, $credit_total; - } - push @buf,['','-----------']; - push @buf,[$self->credit_balance_msg, $money_char. - sprintf("%10.2f", -$cust_main->balance ) ]; - } - } - - if ( $multisection ) { - if ($conf->exists('svc_phone_sections')) { - my $total; - $total->{'total_item'} = &$embolden_function($self->balance_due_msg); - $total->{'total_amount'} = - &$embolden_function( - $other_money_char. sprintf('%.2f', $self->owed + $pr_total) - ); - my $last_section = pop @sections; - $last_section->{'posttotal'} = $total->{'total_item'}. ' '. - $total->{'total_amount'}; - push @sections, $last_section; - } - push @sections, @$late_sections - if $unsquelched; - } - - # make a discounts-available section, even without multisection - if ( $conf->exists('discount-show_available') - and my @discounts_avail = $self->_items_discounts_avail ) { - my $discount_section = { - 'description' => $self->mt('Discounts Available'), - 'subtotal' => '', - 'no_subtotal' => 1, - }; - - push @sections, $discount_section; - push @detail_items, map { +{ - 'ref' => '', #should this be something else? - 'section' => $discount_section, - 'description' => &$escape_function( $_->{description} ), - 'amount' => $money_char . &$escape_function( $_->{amount} ), - 'ext_description' => [ &$escape_function($_->{ext_description}) || () ], - } } @discounts_avail; - } - - # All sections and items are built; now fill in templates. - my @includelist = (); - push @includelist, 'summary' if $summarypage; - foreach my $include ( @includelist ) { - - my $inc_file = $conf->key_orbase("invoice_${format}$include", $template); - my @inc_src; - - if ( length( $conf->config($inc_file, $agentnum) ) ) { - - @inc_src = $conf->config($inc_file, $agentnum); - - } else { - - $inc_file = $conf->key_orbase("invoice_latex$include", $template); - - my $convert_map = $convert_maps{$format}{$include}; - - @inc_src = map { s/\[\@--/$delimiters{$format}[0]/g; - s/--\@\]/$delimiters{$format}[1]/g; - $_; - } - &$convert_map( $conf->config($inc_file, $agentnum) ); - - } - - my $inc_tt = new Text::Template ( - TYPE => 'ARRAY', - SOURCE => [ map "$_\n", @inc_src ], - DELIMITERS => $delimiters{$format}, - ) or die "Can't create new Text::Template object: $Text::Template::ERROR"; - - unless ( $inc_tt->compile() ) { - my $error = "Can't compile $inc_file template: $Text::Template::ERROR\n"; - warn $error. "Template:\n". join('', map "$_\n", @inc_src); - die $error; - } - - $invoice_data{$include} = $inc_tt->fill_in( HASH => \%invoice_data ); - - $invoice_data{$include} =~ s/\n+$// - if ($format eq 'latex'); - } - - $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?" - if ( $format eq 'template' && !$wasfunc ); - - if ($format eq 'template') { - - if ( $invoice_lines ) { - $invoice_data{'total_pages'} = int( scalar(@buf) / $invoice_lines ); - $invoice_data{'total_pages'}++ - if scalar(@buf) % $invoice_lines; - } - - #setup subroutine for the template - $invoice_data{invoice_lines} = sub { - my $lines = shift || scalar(@buf); - map { - scalar(@buf) - ? shift @buf - : [ '', '' ]; - } - ( 1 .. $lines ); - }; - - my $lines; - my @collect; - while (@buf) { - push @collect, split("\n", - $text_template->fill_in( HASH => \%invoice_data ) - ); - $invoice_data{'page'}++; - } - map "$_\n", @collect; - }else{ - # this is where we actually create the invoice - warn "filling in template for invoice ". $self->invnum. "\n" - if $DEBUG; - warn join("\n", map " $_ => ". $invoice_data{$_}, keys %invoice_data). "\n" - if $DEBUG > 1; - - $text_template->fill_in(HASH => \%invoice_data); - } -} - -# helper routine for generating date ranges -sub _prior_month30s { - my $self = shift; - my @ranges = ( - [ 1, 2592000 ], # 0-30 days ago - [ 2592000, 5184000 ], # 30-60 days ago - [ 5184000, 7776000 ], # 60-90 days ago - [ 7776000, 0 ], # 90+ days ago - ); - - map { [ $_->[0] ? $self->_date - $_->[0] - 1 : '', - $_->[1] ? $self->_date - $_->[1] - 1 : '', - ] } - @ranges; -} - -=item print_ps HASHREF | [ TIME [ , TEMPLATE ] ] - -Returns an postscript invoice, as a scalar. - -Options can be passed as a hashref (recommended) or as a list of time, template -and then any key/value pairs for any other options. - -I<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. - -I<notice_name>, if specified, overrides "Invoice" as the name of the sent document (templates from 10/2009 or newer required) - -=cut - -sub print_ps { - my $self = shift; - - my ($file, $logofile, $barcodefile) = $self->print_latex(@_); - my $ps = generate_ps($file); - unlink($logofile); - unlink($barcodefile) if $barcodefile; - - $ps; -} - -=item print_pdf HASHREF | [ TIME [ , TEMPLATE ] ] - -Returns an PDF invoice, as a scalar. - -Options can be passed as a hashref (recommended) or as a list of time, template -and then any key/value pairs for any other options. - -I<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. - -I<template>, if specified, is the name of a suffix for alternate invoices. - -I<notice_name>, if specified, overrides "Invoice" as the name of the sent document (templates from 10/2009 or newer required) - -=cut - -sub print_pdf { - my $self = shift; - - my ($file, $logofile, $barcodefile) = $self->print_latex(@_); - my $pdf = generate_pdf($file); - unlink($logofile); - unlink($barcodefile) if $barcodefile; - - $pdf; -} - -=item print_html HASHREF | [ TIME [ , TEMPLATE [ , CID ] ] ] - -Returns an HTML invoice, as a scalar. - -I<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. - -I<template>, if specified, is the name of a suffix for alternate invoices. - -I<notice_name>, if specified, overrides "Invoice" as the name of the sent document (templates from 10/2009 or newer required) - -I<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 - -sub print_html { - my $self = shift; - my %params; - if ( ref($_[0]) ) { - %params = %{ shift() }; - }else{ - $params{'time'} = shift; - $params{'template'} = shift; - $params{'cid'} = shift; - } - - $params{'format'} = 'html'; - - $self->print_generic( %params ); -} - -# 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; -} - -sub _html_escape { - my $value = shift; - encode_entities($value); - $value; -} - -sub _html_escape_nbsp { - my $value = _html_escape(shift); - $value =~ s/ +/ /g; - $value; -} - -#utility methods for print_* - -sub _translate_old_latex_format { - warn "_translate_old_latex_format called\n" - if $DEBUG; - - my @template = (); - while ( @_ ) { - my $line = shift; - - if ( $line =~ /^%%Detail\s*$/ ) { - - push @template, q![@--!, - q! foreach my $_tr_line (@detail_items) {!, - q! if ( scalar ($_tr_item->{'ext_description'} ) ) {!, - q! $_tr_line->{'description'} .= !, - q! "\\tabularnewline\n~~".!, - q! join( "\\tabularnewline\n~~",!, - q! @{$_tr_line->{'ext_description'}}!, - q! );!, - q! }!; - - while ( ( my $line_item_line = shift ) - !~ /^%%EndDetail\s*$/ ) { - $line_item_line =~ s/'/\\'/g; # nice LTS - $line_item_line =~ s/\\/\\\\/g; # escape quotes and backslashes - $line_item_line =~ s/\$(\w+)/'. \$_tr_line->{$1}. '/g; - push @template, " \$OUT .= '$line_item_line';"; - } - - push @template, '}', - '--@]'; - #' doh, gvim - } elsif ( $line =~ /^%%TotalDetails\s*$/ ) { - - push @template, '[@--', - ' foreach my $_tr_line (@total_items) {'; - - while ( ( my $total_item_line = shift ) - !~ /^%%EndTotalDetails\s*$/ ) { - $total_item_line =~ s/'/\\'/g; # nice LTS - $total_item_line =~ s/\\/\\\\/g; # escape quotes and backslashes - $total_item_line =~ s/\$(\w+)/'. \$_tr_line->{$1}. '/g; - push @template, " \$OUT .= '$total_item_line';"; - } - - push @template, '}', - '--@]'; - - } else { - $line =~ s/\$(\w+)/[\@-- \$$1 --\@]/g; - push @template, $line; - } - - } - - if ($DEBUG) { - warn "$_\n" foreach @template; - } - - (@template); -} - -sub terms { - my $self = shift; - my $conf = $self->conf; - - #check for an invoice-specific override - return $self->invoice_terms if $self->invoice_terms; - - #check for a customer- specific override - my $cust_main = $self->cust_main; - return $cust_main->invoice_terms if $cust_main->invoice_terms; - - #use configured default - $conf->config('invoice_default_terms') || ''; -} - -sub due_date { - my $self = shift; - my $duedate = ''; - if ( $self->terms =~ /^\s*Net\s*(\d+)\s*$/ ) { - $duedate = $self->_date() + ( $1 * 86400 ); - } - $duedate; -} - -sub due_date2str { - my $self = shift; - $self->due_date ? time2str(shift, $self->due_date) : ''; -} - -sub balance_due_msg { - my $self = shift; - my $msg = $self->mt('Balance Due'); - return $msg unless $self->terms; - if ( $self->due_date ) { - $msg .= ' - ' . $self->mt('Please pay by'). ' '. - $self->due_date2str($date_format); - } elsif ( $self->terms ) { - $msg .= ' - '. $self->terms; - } - $msg; -} - -sub balance_due_date { - my $self = shift; - my $conf = $self->conf; - my $duedate = ''; - if ( $conf->exists('invoice_default_terms') - && $conf->config('invoice_default_terms')=~ /^\s*Net\s*(\d+)\s*$/ ) { - $duedate = time2str($rdate_format, $self->_date + ($1*86400) ); - } - $duedate; -} - -sub credit_balance_msg { - my $self = shift; - $self->mt('Credit Balance Remaining') -} - =item invnum_date_pretty Returns a string with the invoice number and date, for example: @@ -3794,420 +2423,6 @@ sub invnum_date_pretty { $self->mt('Invoice #'). $self->invnum. ' ('. $self->_date_pretty. ')'; } -=item _date_pretty - -Returns a string with the date, for example: "3/20/2008" - -=cut - -sub _date_pretty { - my $self = shift; - time2str($date_format, $self->_date); -} - -=item _items_sections LATE SUMMARYPAGE ESCAPE EXTRA_SECTIONS FORMAT - -Generate section information for all items appearing on this invoice. -This will only be called for multi-section invoices. - -For each line item (L<FS::cust_bill_pkg> record), this will fetch all -related display records (L<FS::cust_bill_pkg_display>) and organize -them into two groups ("early" and "late" according to whether they come -before or after the total), then into sections. A subtotal is calculated -for each section. - -Section descriptions are returned in sort weight order. Each consists -of a hash containing: - -description: the package category name, escaped -subtotal: the total charges in that section -tax_section: a flag indicating that the section contains only tax charges -summarized: same as tax_section, for some reason -sort_weight: the package category's sort weight - -If 'condense' is set on the display record, it also contains everything -returned from C<_condense_section()>, i.e. C<_condensed_foo_generator> -coderefs to generate parts of the invoice. This is not advised. - -Arguments: - -LATE: an arrayref to push the "late" section hashes onto. The "early" -group is simply returned from the method. - -SUMMARYPAGE: a flag indicating whether this is a summary-format invoice. -Turning this on has the following effects: -- Ignores display items with the 'summary' flag. -- Combines all items into the "early" group. -- Creates sections for all non-disabled package categories, even if they -have no charges on this invoice, as well as a section with no name. - -ESCAPE: an escape function to use for section titles. - -EXTRA_SECTIONS: an arrayref of additional sections to return after the -sorted list. If there are any of these, section subtotals exclude -usage charges. - -FORMAT: 'latex', 'html', or 'template' (i.e. text). Not used, but -passed through to C<_condense_section()>. - -=cut - -use vars qw(%pkg_category_cache); -sub _items_sections { - my $self = shift; - my $late = shift; - my $summarypage = shift; - my $escape = shift; - my $extra_sections = shift; - my $format = shift; - - my %subtotal = (); - my %late_subtotal = (); - my %not_tax = (); - - foreach my $cust_bill_pkg ( $self->cust_bill_pkg ) - { - - my $usage = $cust_bill_pkg->usage; - - foreach my $display ($cust_bill_pkg->cust_bill_pkg_display) { - next if ( $display->summary && $summarypage ); - - my $section = $display->section; - my $type = $display->type; - - $not_tax{$section} = 1 - unless $cust_bill_pkg->pkgnum == 0; - - if ( $display->post_total && !$summarypage ) { - if (! $type || $type eq 'S') { - $late_subtotal{$section} += $cust_bill_pkg->setup - if $cust_bill_pkg->setup != 0; - } - - if (! $type) { - $late_subtotal{$section} += $cust_bill_pkg->recur - if $cust_bill_pkg->recur != 0; - } - - if ($type && $type eq 'R') { - $late_subtotal{$section} += $cust_bill_pkg->recur - $usage - if $cust_bill_pkg->recur != 0; - } - - if ($type && $type eq 'U') { - $late_subtotal{$section} += $usage - unless scalar(@$extra_sections); - } - - } else { - - next if $cust_bill_pkg->pkgnum == 0 && ! $section; - - if (! $type || $type eq 'S') { - $subtotal{$section} += $cust_bill_pkg->setup - if $cust_bill_pkg->setup != 0; - } - - if (! $type) { - $subtotal{$section} += $cust_bill_pkg->recur - if $cust_bill_pkg->recur != 0; - } - - if ($type && $type eq 'R') { - $subtotal{$section} += $cust_bill_pkg->recur - $usage - if $cust_bill_pkg->recur != 0; - } - - if ($type && $type eq 'U') { - $subtotal{$section} += $usage - unless scalar(@$extra_sections); - } - - } - - } - - } - - %pkg_category_cache = (); - - push @$late, map { { 'description' => &{$escape}($_), - 'subtotal' => $late_subtotal{$_}, - 'post_total' => 1, - 'sort_weight' => ( _pkg_category($_) - ? _pkg_category($_)->weight - : 0 - ), - ((_pkg_category($_) && _pkg_category($_)->condense) - ? $self->_condense_section($format) - : () - ), - } } - sort _sectionsort keys %late_subtotal; - - my @sections; - if ( $summarypage ) { - @sections = grep { exists($subtotal{$_}) || ! _pkg_category($_)->disabled } - map { $_->categoryname } qsearch('pkg_category', {}); - push @sections, '' if exists($subtotal{''}); - } else { - @sections = keys %subtotal; - } - - my @early = map { { 'description' => &{$escape}($_), - 'subtotal' => $subtotal{$_}, - 'summarized' => $not_tax{$_} ? '' : 'Y', - 'tax_section' => $not_tax{$_} ? '' : 'Y', - 'sort_weight' => ( _pkg_category($_) - ? _pkg_category($_)->weight - : 0 - ), - ((_pkg_category($_) && _pkg_category($_)->condense) - ? $self->_condense_section($format) - : () - ), - } - } @sections; - push @early, @$extra_sections if $extra_sections; - - sort { $a->{sort_weight} <=> $b->{sort_weight} } @early; - -} - -#helper subs for above - -sub _sectionsort { - _pkg_category($a)->weight <=> _pkg_category($b)->weight; -} - -sub _pkg_category { - my $categoryname = shift; - $pkg_category_cache{$categoryname} ||= - qsearchs( 'pkg_category', { 'categoryname' => $categoryname } ); -} - -my %condensed_format = ( - 'label' => [ qw( Description Qty Amount ) ], - 'fields' => [ - sub { shift->{description} }, - sub { shift->{quantity} }, - sub { my($href, %opt) = @_; - ($opt{dollar} || ''). $href->{amount}; - }, - ], - 'align' => [ qw( l r r ) ], - 'span' => [ qw( 5 1 1 ) ], # unitprices? - 'width' => [ qw( 10.7cm 1.4cm 1.6cm ) ], # don't like this -); - -sub _condense_section { - my ( $self, $format ) = ( shift, shift ); - ( 'condensed' => 1, - map { my $method = "_condensed_$_"; $_ => $self->$method($format) } - qw( description_generator - header_generator - total_generator - total_line_generator - ) - ); -} - -sub _condensed_generator_defaults { - my ( $self, $format ) = ( shift, shift ); - return ( \%condensed_format, ' ', ' ', ' ', sub { shift } ); -} - -my %html_align = ( - 'c' => 'center', - 'l' => 'left', - 'r' => 'right', -); - -sub _condensed_header_generator { - my ( $self, $format ) = ( shift, shift ); - - my ( $f, $prefix, $suffix, $separator, $column ) = - _condensed_generator_defaults($format); - - if ($format eq 'latex') { - $prefix = "\\hline\n\\rule{0pt}{2.5ex}\n\\makebox[1.4cm]{}&\n"; - $suffix = "\\\\\n\\hline"; - $separator = "&\n"; - $column = - sub { my ($d,$a,$s,$w) = @_; - return "\\multicolumn{$s}{$a}{\\makebox[$w][$a]{\\textbf{$d}}}"; - }; - } elsif ( $format eq 'html' ) { - $prefix = '<th></th>'; - $suffix = ''; - $separator = ''; - $column = - sub { my ($d,$a,$s,$w) = @_; - return qq!<th align="$html_align{$a}">$d</th>!; - }; - } - - sub { - my @args = @_; - my @result = (); - - foreach (my $i = 0; $f->{label}->[$i]; $i++) { - push @result, - &{$column}( map { $f->{$_}->[$i] } qw(label align span width) ); - } - - $prefix. join($separator, @result). $suffix; - }; - -} - -sub _condensed_description_generator { - my ( $self, $format ) = ( shift, shift ); - - my ( $f, $prefix, $suffix, $separator, $column ) = - _condensed_generator_defaults($format); - - my $money_char = '$'; - if ($format eq 'latex') { - $prefix = "\\hline\n\\multicolumn{1}{c}{\\rule{0pt}{2.5ex}~} &\n"; - $suffix = '\\\\'; - $separator = " & \n"; - $column = - sub { my ($d,$a,$s,$w) = @_; - return "\\multicolumn{$s}{$a}{\\makebox[$w][$a]{\\textbf{$d}}}"; - }; - $money_char = '\\dollar'; - }elsif ( $format eq 'html' ) { - $prefix = '"><td align="center"></td>'; - $suffix = ''; - $separator = ''; - $column = - sub { my ($d,$a,$s,$w) = @_; - return qq!<td align="$html_align{$a}">$d</td>!; - }; - #$money_char = $conf->config('money_char') || '$'; - $money_char = ''; # this is madness - } - - sub { - #my @args = @_; - my $href = shift; - my @result = (); - - foreach (my $i = 0; $f->{label}->[$i]; $i++) { - my $dollar = ''; - $dollar = $money_char if $i == scalar(@{$f->{label}})-1; - push @result, - &{$column}( &{$f->{fields}->[$i]}($href, 'dollar' => $dollar), - map { $f->{$_}->[$i] } qw(align span width) - ); - } - - $prefix. join( $separator, @result ). $suffix; - }; - -} - -sub _condensed_total_generator { - my ( $self, $format ) = ( shift, shift ); - - my ( $f, $prefix, $suffix, $separator, $column ) = - _condensed_generator_defaults($format); - my $style = ''; - - if ($format eq 'latex') { - $prefix = "& "; - $suffix = "\\\\\n"; - $separator = " & \n"; - $column = - sub { my ($d,$a,$s,$w) = @_; - return "\\multicolumn{$s}{$a}{\\makebox[$w][$a]{$d}}"; - }; - }elsif ( $format eq 'html' ) { - $prefix = ''; - $suffix = ''; - $separator = ''; - $style = 'border-top: 3px solid #000000;border-bottom: 3px solid #000000;'; - $column = - sub { my ($d,$a,$s,$w) = @_; - return qq!<td align="$html_align{$a}" style="$style">$d</td>!; - }; - } - - - sub { - my @args = @_; - my @result = (); - - # my $r = &{$f->{fields}->[$i]}(@args); - # $r .= ' Total' unless $i; - - foreach (my $i = 0; $f->{label}->[$i]; $i++) { - push @result, - &{$column}( &{$f->{fields}->[$i]}(@args). ($i ? '' : ' Total'), - map { $f->{$_}->[$i] } qw(align span width) - ); - } - - $prefix. join( $separator, @result ). $suffix; - }; - -} - -=item total_line_generator FORMAT - -Returns a coderef used for generation of invoice total line items for this -usage_class. FORMAT is either html or latex - -=cut - -# should not be used: will have issues with hash element names (description vs -# total_item and amount vs total_amount -- another array of functions? - -sub _condensed_total_line_generator { - my ( $self, $format ) = ( shift, shift ); - - my ( $f, $prefix, $suffix, $separator, $column ) = - _condensed_generator_defaults($format); - my $style = ''; - - if ($format eq 'latex') { - $prefix = "& "; - $suffix = "\\\\\n"; - $separator = " & \n"; - $column = - sub { my ($d,$a,$s,$w) = @_; - return "\\multicolumn{$s}{$a}{\\makebox[$w][$a]{$d}}"; - }; - }elsif ( $format eq 'html' ) { - $prefix = ''; - $suffix = ''; - $separator = ''; - $style = 'border-top: 3px solid #000000;border-bottom: 3px solid #000000;'; - $column = - sub { my ($d,$a,$s,$w) = @_; - return qq!<td align="$html_align{$a}" style="$style">$d</td>!; - }; - } - - - sub { - my @args = @_; - my @result = (); - - foreach (my $i = 0; $f->{label}->[$i]; $i++) { - push @result, - &{$column}( &{$f->{fields}->[$i]}(@args), - map { $f->{$_}->[$i] } qw(align span width) - ); - } - - $prefix. join( $separator, @result ). $suffix; - }; - -} - #sub _items_extra_usage_sections { # my $self = shift; # my $escape = shift; @@ -4713,23 +2928,6 @@ sub _items_svc_phone_sections { } -sub _items { # seems to be unused - 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 @display = qw( _items_previous _items_pkg ); - - my @b = (); - foreach my $display ( @display ) { - push @b, $self->$display(@_); - } - @b; -} - sub _items_previous { my $self = shift; my $conf = $self->conf; @@ -4763,473 +2961,6 @@ sub _items_previous { #}; } -=item _items_pkg [ OPTIONS ] - -Return line item hashes for each package item on this invoice. Nearly -equivalent to - -$self->_items_cust_bill_pkg([ $self->cust_bill_pkg ]) - -The only OPTIONS accepted is 'section', which may point to a hashref -with a key named 'condensed', which may have a true value. If it -does, this method tries to merge identical items into items with -'quantity' equal to the number of items (not the sum of their -separate quantities, for some reason). - -=cut - -sub _items_pkg { - my $self = shift; - my %options = @_; - - warn "$me _items_pkg searching for all package line items\n" - if $DEBUG > 1; - - my @cust_bill_pkg = grep { $_->pkgnum } $self->cust_bill_pkg; - - warn "$me _items_pkg filtering line items\n" - if $DEBUG > 1; - my @items = $self->_items_cust_bill_pkg(\@cust_bill_pkg, @_); - - if ($options{section} && $options{section}->{condensed}) { - - warn "$me _items_pkg condensing section\n" - if $DEBUG > 1; - - my %itemshash = (); - local $Storable::canonical = 1; - foreach ( @items ) { - my $item = { %$_ }; - delete $item->{ref}; - delete $item->{ext_description}; - my $key = freeze($item); - $itemshash{$key} ||= 0; - $itemshash{$key} ++; # += $item->{quantity}; - } - @items = sort { $a->{description} cmp $b->{description} } - map { my $i = thaw($_); - $i->{quantity} = $itemshash{$_}; - $i->{amount} = - sprintf( "%.2f", $i->{quantity} * $i->{amount} );#unit_amount - $i; - } - keys %itemshash; - } - - warn "$me _items_pkg returning ". scalar(@items). " items\n" - if $DEBUG > 1; - - @items; -} - -sub _taxsort { - return 0 unless $a->itemdesc cmp $b->itemdesc; - return -1 if $b->itemdesc eq 'Tax'; - return 1 if $a->itemdesc eq 'Tax'; - return -1 if $b->itemdesc eq 'Other surcharges'; - return 1 if $a->itemdesc eq 'Other surcharges'; - $a->itemdesc cmp $b->itemdesc; -} - -sub _items_tax { - my $self = shift; - my @cust_bill_pkg = sort _taxsort grep { ! $_->pkgnum } $self->cust_bill_pkg; - $self->_items_cust_bill_pkg(\@cust_bill_pkg, @_); -} - -=item _items_cust_bill_pkg CUST_BILL_PKGS OPTIONS - -Takes an arrayref of L<FS::cust_bill_pkg> objects, and returns a -list of hashrefs describing the line items they generate on the invoice. - -OPTIONS may include: - -format: the invoice format. - -escape_function: the function used to escape strings. - -DEPRECATED? (expensive, mostly unused?) -format_function: the function used to format CDRs. - -section: a hashref containing 'description'; if this is present, -cust_bill_pkg_display records not belonging to this section are -ignored. - -multisection: a flag indicating that this is a multisection invoice, -which does something complicated. - -multilocation: a flag to display the location label for the package. - -Returns a list of hashrefs, each of which may contain: - -pkgnum, description, amount, unit_amount, quantity, _is_setup, and -ext_description, which is an arrayref of detail lines to show below -the package line. - -=cut - -sub _items_cust_bill_pkg { - my $self = shift; - my $conf = $self->conf; - my $cust_bill_pkgs = shift; - my %opt = @_; - - my $format = $opt{format} || ''; - my $escape_function = $opt{escape_function} || sub { shift }; - my $format_function = $opt{format_function} || ''; - my $no_usage = $opt{no_usage} || ''; - my $unsquelched = $opt{unsquelched} || ''; #unused - my $section = $opt{section}->{description} if $opt{section}; - my $summary_page = $opt{summary_page} || ''; #unused - my $multilocation = $opt{multilocation} || ''; - my $multisection = $opt{multisection} || ''; - my $discount_show_always = 0; - - my $maxlength = $conf->config('cust_bill-latex_lineitem_maxlength') || 50; - - my $cust_main = $self->cust_main;#for per-agent cust_bill-line_item-ate_style - - my @b = (); - my ($s, $r, $u) = ( undef, undef, undef ); - foreach my $cust_bill_pkg ( @$cust_bill_pkgs ) - { - - foreach ( $s, $r, ($opt{skip_usage} ? () : $u ) ) { - if ( $_ && !$cust_bill_pkg->hidden ) { - $_->{amount} = sprintf( "%.2f", $_->{amount} ), - $_->{amount} =~ s/^\-0\.00$/0.00/; - $_->{unit_amount} = sprintf( "%.2f", $_->{unit_amount} ), - push @b, { %$_ } - if $_->{amount} != 0 - || $discount_show_always - || ( ! $_->{_is_setup} && $_->{recur_show_zero} ) - || ( $_->{_is_setup} && $_->{setup_show_zero} ) - ; - $_ = undef; - } - } - - warn "$me _items_cust_bill_pkg considering cust_bill_pkg ". - $cust_bill_pkg->billpkgnum. ", pkgnum ". $cust_bill_pkg->pkgnum. "\n" - if $DEBUG > 1; - - foreach my $display ( grep { defined($section) - ? $_->section eq $section - : 1 - } - #grep { !$_->summary || !$summary_page } # bunk! - grep { !$_->summary || $multisection } - $cust_bill_pkg->cust_bill_pkg_display - ) - { - - warn "$me _items_cust_bill_pkg considering cust_bill_pkg_display ". - $display->billpkgdisplaynum. "\n" - if $DEBUG > 1; - - my $type = $display->type; - - my $desc = $cust_bill_pkg->desc; - $desc = substr($desc, 0, $maxlength). '...' - if $format eq 'latex' && length($desc) > $maxlength; - - my %details_opt = ( 'format' => $format, - 'escape_function' => $escape_function, - 'format_function' => $format_function, - 'no_usage' => $opt{'no_usage'}, - ); - - if ( $cust_bill_pkg->pkgnum > 0 ) { - - warn "$me _items_cust_bill_pkg cust_bill_pkg is non-tax\n" - if $DEBUG > 1; - - my $cust_pkg = $cust_bill_pkg->cust_pkg; - - # start/end dates for invoice formats that do nonstandard - # things with them - my %item_dates = map { $_ => $cust_bill_pkg->$_ } ('sdate', 'edate'); - - if ( (!$type || $type eq 'S') - && ( $cust_bill_pkg->setup != 0 - || $cust_bill_pkg->setup_show_zero - ) - ) - { - - warn "$me _items_cust_bill_pkg adding setup\n" - if $DEBUG > 1; - - my $description = $desc; - $description .= ' Setup' - if $cust_bill_pkg->recur != 0 - || $discount_show_always - || $cust_bill_pkg->recur_show_zero; - - my @d = (); - unless ( $cust_pkg->part_pkg->hide_svc_detail - || $cust_bill_pkg->hidden ) - { - - push @d, map &{$escape_function}($_), - $cust_pkg->h_labels_short($self->_date, undef, 'I') - unless $cust_bill_pkg->pkgpart_override; #don't redisplay services - - if ( $multilocation ) { - my $loc = $cust_pkg->location_label; - $loc = substr($loc, 0, $maxlength). '...' - if $format eq 'latex' && length($loc) > $maxlength; - push @d, &{$escape_function}($loc); - } - - } #unless hiding service details - - push @d, $cust_bill_pkg->details(%details_opt) - if $cust_bill_pkg->recur == 0; - - if ( $cust_bill_pkg->hidden ) { - $s->{amount} += $cust_bill_pkg->setup; - $s->{unit_amount} += $cust_bill_pkg->unitsetup; - push @{ $s->{ext_description} }, @d; - } else { - $s = { - _is_setup => 1, - description => $description, - #pkgpart => $part_pkg->pkgpart, - pkgnum => $cust_bill_pkg->pkgnum, - amount => $cust_bill_pkg->setup, - setup_show_zero => $cust_bill_pkg->setup_show_zero, - unit_amount => $cust_bill_pkg->unitsetup, - quantity => $cust_bill_pkg->quantity, - ext_description => \@d, - }; - }; - - } - - if ( ( !$type || $type eq 'R' || $type eq 'U' ) - && ( - $cust_bill_pkg->recur != 0 - || $cust_bill_pkg->setup == 0 - || $discount_show_always - || $cust_bill_pkg->recur_show_zero - ) - ) - { - - warn "$me _items_cust_bill_pkg adding recur/usage\n" - if $DEBUG > 1; - - my $is_summary = $display->summary; - my $description = ($is_summary && $type && $type eq 'U') - ? "Usage charges" : $desc; - - #pry be a bit more efficient to look some of this conf stuff up - # outside the loop - unless ( - $conf->exists('disable_line_item_date_ranges') - || $cust_pkg->part_pkg->option('disable_line_item_date_ranges',1) - ) { - my $time_period; - my $date_style = $conf->config( 'cust_bill-line_item-date_style', - $cust_main->agentnum - ); - if ( defined($date_style) && $date_style eq 'month_of' ) { - $time_period = time2str('The month of %B', $cust_bill_pkg->sdate); - } elsif ( defined($date_style) && $date_style eq 'X_month' ) { - my $desc = $conf->config( 'cust_bill-line_item-date_description', - $cust_main->agentnum - ); - $desc .= ' ' unless $desc =~ /\s$/; - $time_period = $desc. time2str('%B', $cust_bill_pkg->sdate); - } else { - $time_period = time2str($date_format, $cust_bill_pkg->sdate). - " - ". time2str($date_format, $cust_bill_pkg->edate); - } - $description .= " ($time_period)"; - } - - my @d = (); - my @seconds = (); # for display of usage info - - #at least until cust_bill_pkg has "past" ranges in addition to - #the "future" sdate/edate ones... see #3032 - my @dates = ( $self->_date ); - my $prev = $cust_bill_pkg->previous_cust_bill_pkg; - push @dates, $prev->sdate if $prev; - push @dates, undef if !$prev; - - unless ( $cust_pkg->part_pkg->hide_svc_detail - || $cust_bill_pkg->itemdesc - || $cust_bill_pkg->hidden - || $is_summary && $type && $type eq 'U' ) - { - - warn "$me _items_cust_bill_pkg adding service details\n" - if $DEBUG > 1; - - push @d, map &{$escape_function}($_), - $cust_pkg->h_labels_short(@dates, 'I') - #$cust_bill_pkg->edate, - #$cust_bill_pkg->sdate) - unless $cust_bill_pkg->pkgpart_override; #don't redisplay services - - warn "$me _items_cust_bill_pkg done adding service details\n" - if $DEBUG > 1; - - if ( $multilocation ) { - my $loc = $cust_pkg->location_label; - $loc = substr($loc, 0, $maxlength). '...' - if $format eq 'latex' && length($loc) > $maxlength; - push @d, &{$escape_function}($loc); - } - - # Display of seconds_since_sqlradacct: - # On the invoice, when processing @detail_items, look for a field - # named 'seconds'. This will contain total seconds for each - # service, in the same order as @ext_description. For services - # that don't support this it will show undef. - if ( $conf->exists('svc_acct-usage_seconds') - and ! $cust_bill_pkg->pkgpart_override ) { - foreach my $cust_svc ( - $cust_pkg->h_cust_svc(@dates, 'I') - ) { - - # eval because not having any part_export_usage exports - # is a fatal error, last_bill/_date because that's how - # sqlradius_hour billing does it - my $sec = eval { - $cust_svc->seconds_since_sqlradacct($dates[1] || 0, $dates[0]); - }; - push @seconds, $sec; - } - } #if svc_acct-usage_seconds - - } - - unless ( $is_summary ) { - warn "$me _items_cust_bill_pkg adding details\n" - if $DEBUG > 1; - - #instead of omitting details entirely in this case (unwanted side - # effects), just omit CDRs - $details_opt{'no_usage'} = 1 - if $type && $type eq 'R'; - - push @d, $cust_bill_pkg->details(%details_opt); - } - - warn "$me _items_cust_bill_pkg calculating amount\n" - if $DEBUG > 1; - - my $amount = 0; - if (!$type) { - $amount = $cust_bill_pkg->recur; - } elsif ($type eq 'R') { - $amount = $cust_bill_pkg->recur - $cust_bill_pkg->usage; - } elsif ($type eq 'U') { - $amount = $cust_bill_pkg->usage; - } - - if ( !$type || $type eq 'R' ) { - - warn "$me _items_cust_bill_pkg adding recur\n" - if $DEBUG > 1; - - if ( $cust_bill_pkg->hidden ) { - $r->{amount} += $amount; - $r->{unit_amount} += $cust_bill_pkg->unitrecur; - push @{ $r->{ext_description} }, @d; - } else { - $r = { - description => $description, - #pkgpart => $part_pkg->pkgpart, - pkgnum => $cust_bill_pkg->pkgnum, - amount => $amount, - recur_show_zero => $cust_bill_pkg->recur_show_zero, - unit_amount => $cust_bill_pkg->unitrecur, - quantity => $cust_bill_pkg->quantity, - %item_dates, - ext_description => \@d, - }; - $r->{'seconds'} = \@seconds if grep {defined $_} @seconds; - } - - } else { # $type eq 'U' - - warn "$me _items_cust_bill_pkg adding usage\n" - if $DEBUG > 1; - - if ( $cust_bill_pkg->hidden ) { - $u->{amount} += $amount; - $u->{unit_amount} += $cust_bill_pkg->unitrecur; - push @{ $u->{ext_description} }, @d; - } else { - $u = { - description => $description, - #pkgpart => $part_pkg->pkgpart, - pkgnum => $cust_bill_pkg->pkgnum, - amount => $amount, - recur_show_zero => $cust_bill_pkg->recur_show_zero, - unit_amount => $cust_bill_pkg->unitrecur, - quantity => $cust_bill_pkg->quantity, - %item_dates, - ext_description => \@d, - }; - } - } - - } # recurring or usage with recurring charge - - } else { #pkgnum tax or one-shot line item (??) - - warn "$me _items_cust_bill_pkg cust_bill_pkg is tax\n" - if $DEBUG > 1; - - 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($date_format, $cust_bill_pkg->sdate). ' - '. - time2str($date_format, $cust_bill_pkg->edate). ')', - 'amount' => sprintf("%.2f", $cust_bill_pkg->recur), - }; - } - - } - - } - - $discount_show_always = ($cust_bill_pkg->cust_bill_pkg_discount - && $conf->exists('discount-show-always')); - - } - - foreach ( $s, $r, ($opt{skip_usage} ? () : $u ) ) { - if ( $_ ) { - $_->{amount} = sprintf( "%.2f", $_->{amount} ), - $_->{amount} =~ s/^\-0\.00$/0.00/; - $_->{unit_amount} = sprintf( "%.2f", $_->{unit_amount} ), - push @b, { %$_ } - if $_->{amount} != 0 - || $discount_show_always - || ( ! $_->{_is_setup} && $_->{recur_show_zero} ) - || ( $_->{_is_setup} && $_->{setup_show_zero} ) - } - } - - warn "$me _items_cust_bill_pkg done considering cust_bill_pkgs\n" - if $DEBUG > 1; - - @b; - -} - sub _items_credits { my( $self, %opt ) = @_; my $trim_len = $opt{'trim_len'} || 60; @@ -5278,51 +3009,6 @@ sub _items_payments { } -=item _items_discounts_avail - -Returns an array of line item hashrefs representing available term discounts -for this invoice. This makes the same assumptions that apply to term -discounts in general: that the package is billed monthly, at a flat rate, -with no usage charges. A prorated first month will be handled, as will -a setup fee if the discount is allowed to apply to setup fees. - -=cut - -sub _items_discounts_avail { - my $self = shift; - my $list_pkgnums = 0; # if any packages are not eligible for all discounts - - my %plans = $self->discount_plans; - - $list_pkgnums = grep { $_->list_pkgnums } values %plans; - - map { - my $months = $_; - my $plan = $plans{$months}; - - my $term_total = sprintf('%.2f', $plan->discounted_total); - my $percent = sprintf('%.0f', - 100 * (1 - $term_total / $plan->base_total) ); - my $permonth = sprintf('%.2f', $term_total / $months); - my $detail = $self->mt('discount on item'). ' '. - join(', ', map { "#$_" } $plan->pkgnums) - if $list_pkgnums; - - # discounts for non-integer months don't work anyway - $months = sprintf("%d", $months); - - +{ - description => $self->mt('Save [_1]% by paying for [_2] months', - $percent, $months), - amount => $self->mt('[_1] ([_2] per month)', - $term_total, $money_char.$permonth), - ext_description => ($detail || ''), - } - } #map - sort { $b <=> $a } keys %plans; - -} - =item call_details [ OPTION => VALUE ... ] Returns an array of CSV strings representing the call details for this invoice @@ -5421,6 +3107,7 @@ sub process_re_X { } sub re_X { + # spool_invoice ftp_invoice fax_invoice print_invoice my($method, $job, %param ) = @_; if ( $DEBUG ) { warn "re_X $method for job $job with param:\n". @@ -5608,7 +3295,12 @@ sub search_sql_where { push @search, "cust_main.agentnum = $1"; } - #agentnum + #refnum + if ( $param->{'refnum'} =~ /^(\d+)$/ ) { + push @search, "cust_main.refnum = $1"; + } + + #custnum if ( $param->{'custnum'} =~ /^(\d+)$/ ) { push @search, "cust_bill.custnum = $1"; } diff --git a/FS/FS/cust_bill_ApplicationCommon.pm b/FS/FS/cust_bill_ApplicationCommon.pm index cadb8a796..cb0705041 100644 --- a/FS/FS/cust_bill_ApplicationCommon.pm +++ b/FS/FS/cust_bill_ApplicationCommon.pm @@ -337,6 +337,7 @@ sub calculate_applications { # could expand @open above, instead, for a slightly different magic effect my @result = (); foreach my $apply ( @apply ) { + # $apply = [ FS::cust_bill_pkg_tax_location record, amount ] my @sub_lines = $apply->[0]->cust_bill_pkg_tax_Xlocation; my $amount = $apply->[1]; warn "applying ". $apply->[1]. " to ". $apply->[0]->desc @@ -346,6 +347,10 @@ sub calculate_applications { my $owed = $subline->owed; push @result, [ $apply->[0], sprintf('%.2f', min($amount, $owed) ), + # $subline->primary_key is "billpkgtaxlocationnum" + # or "billpkgtaxratelocationnum" + # This is the ONLY place either of those fields will + # be set. { $subline->primary_key => $subline->get($subline->primary_key) }, ]; $amount -= $owed; diff --git a/FS/FS/cust_bill_pkg.pm b/FS/FS/cust_bill_pkg.pm index 1ee5c0943..20c8e5a55 100644 --- a/FS/FS/cust_bill_pkg.pm +++ b/FS/FS/cust_bill_pkg.pm @@ -1,13 +1,13 @@ package FS::cust_bill_pkg; +use base qw( FS::TemplateItem_Mixin FS::cust_main_Mixin FS::Record ); use strict; use vars qw( @ISA $DEBUG $me ); use Carp; +use List::Util qw( sum min ); use Text::CSV_XS; -use FS::Record qw( qsearch qsearchs dbdef dbh ); -use FS::cust_main_Mixin; +use FS::Record qw( qsearch qsearchs dbh ); use FS::cust_pkg; -use FS::part_pkg; use FS::cust_bill; use FS::cust_bill_pkg_detail; use FS::cust_bill_pkg_display; @@ -18,10 +18,13 @@ use FS::cust_tax_exempt_pkg; use FS::cust_bill_pkg_tax_location; use FS::cust_bill_pkg_tax_rate_location; use FS::cust_tax_adjustment; - -use List::Util qw(sum); - -@ISA = qw( FS::cust_main_Mixin FS::Record ); +use FS::cust_bill_pkg_void; +use FS::cust_bill_pkg_detail_void; +use FS::cust_bill_pkg_display_void; +use FS::cust_bill_pkg_discount_void; +use FS::cust_bill_pkg_tax_location_void; +use FS::cust_bill_pkg_tax_rate_location_void; +use FS::cust_tax_exempt_pkg_void; $DEBUG = 0; $me = '[FS::cust_bill_pkg]'; @@ -120,6 +123,13 @@ customer object (see L<FS::cust_main>). sub table { 'cust_bill_pkg'; } +sub detail_table { 'cust_bill_pkg_detail'; } +sub display_table { 'cust_bill_pkg_display'; } +sub discount_table { 'cust_bill_pkg_discount'; } +#sub tax_location_table { 'cust_bill_pkg_tax_location'; } +#sub tax_rate_location_table { 'cust_bill_pkg_tax_rate_location'; } +#sub tax_exempt_pkg_table { 'cust_tax_exempt_pkg'; } + =item insert Adds this line item to the database. If there is an error, returns the error, @@ -180,14 +190,12 @@ sub insert { } } - if ( $self->_cust_tax_exempt_pkg ) { - foreach my $cust_tax_exempt_pkg ( @{$self->_cust_tax_exempt_pkg} ) { - $cust_tax_exempt_pkg->billpkgnum($self->billpkgnum); - $error = $cust_tax_exempt_pkg->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error inserting cust_tax_exempt_pkg: $error"; - } + foreach my $cust_tax_exempt_pkg ( @{$self->cust_tax_exempt_pkg} ) { + $cust_tax_exempt_pkg->billpkgnum($self->billpkgnum); + $error = $cust_tax_exempt_pkg->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error inserting cust_tax_exempt_pkg: $error"; } } @@ -230,6 +238,75 @@ sub insert { } +=item void + +Voids this line item: deletes the line item and adds a record of the voided +line item to the FS::cust_bill_pkg_void table (and related tables). + +=cut + +sub void { + my $self = shift; + my $reason = scalar(@_) ? 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_bill_pkg_void = new FS::cust_bill_pkg_void ( { + map { $_ => $self->get($_) } $self->fields + } ); + $cust_bill_pkg_void->reason($reason); + my $error = $cust_bill_pkg_void->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + foreach my $table (qw( + cust_bill_pkg_detail + cust_bill_pkg_display + cust_bill_pkg_discount + cust_bill_pkg_tax_location + cust_bill_pkg_tax_rate_location + cust_tax_exempt_pkg + )) { + + foreach my $linked ( qsearch($table, { billpkgnum=>$self->billpkgnum }) ) { + + my $vclass = 'FS::'.$table.'_void'; + my $void = $vclass->new( { + map { $_ => $linked->get($_) } $linked->fields + }); + my $error = $void->insert || $linked->delete; + 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 Not recommended. @@ -253,6 +330,7 @@ sub delete { foreach my $table (qw( cust_bill_pkg_detail cust_bill_pkg_display + cust_bill_pkg_discount cust_bill_pkg_tax_location cust_bill_pkg_tax_rate_location cust_tax_exempt_pkg @@ -389,36 +467,6 @@ sub regularize_details { return; } -=item cust_pkg - -Returns the package (see L<FS::cust_pkg>) for this invoice line item. - -=cut - -sub cust_pkg { - my $self = shift; - carp "$me $self -> cust_pkg" if $DEBUG; - qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } ); -} - -=item part_pkg - -Returns the package definition for this invoice line item. - -=cut - -sub part_pkg { - my $self = shift; - if ( $self->pkgpart_override ) { - qsearchs('part_pkg', { 'pkgpart' => $self->pkgpart_override } ); - } else { - my $part_pkg; - my $cust_pkg = $self->cust_pkg; - $part_pkg = $cust_pkg->part_pkg if $cust_pkg; - $part_pkg; - } -} - =item cust_bill Returns the invoice (see L<FS::cust_bill>) for this invoice line item. @@ -448,173 +496,6 @@ sub previous_cust_bill_pkg { }); } -=item details [ OPTION => VALUE ... ] - -Returns an array of detail information for the invoice line item. - -Currently available options are: I<format>, I<escape_function> and -I<format_function>. - -If I<format> is set to html or latex then the array members are improved -for tabular appearance in those environments if possible. - -If I<escape_function> is set then the array members are processed by this -function before being returned. - -I<format_function> overrides the normal HTML or LaTeX function for returning -formatted CDRs. It can be set to a subroutine which returns an empty list -to skip usage detail: - - 'format_function' => sub { () }, - -=cut - -sub details { - my ( $self, %opt ) = @_; - my $escape_function = $opt{escape_function} || sub { shift }; - - my $csv = new Text::CSV_XS; - - if ( $opt{format_function} ) { - - #this still expects to be passed a cust_bill_pkg_detail object as the - #second argument, which is expensive - carp "deprecated format_function passed to cust_bill_pkg->details"; - my $format_sub = $opt{format_function} if $opt{format_function}; - - map { ( $_->format eq 'C' - ? &{$format_sub}( $_->detail, $_ ) - : &{$escape_function}( $_->detail ) - ) - } - qsearch ({ 'table' => 'cust_bill_pkg_detail', - 'hashref' => { 'billpkgnum' => $self->billpkgnum }, - 'order_by' => 'ORDER BY detailnum', - }); - - } elsif ( $opt{'no_usage'} ) { - - my $sql = "SELECT detail FROM cust_bill_pkg_detail ". - " WHERE billpkgnum = ". $self->billpkgnum. - " AND ( format IS NULL OR format != 'C' ) ". - " ORDER BY detailnum"; - my $sth = dbh->prepare($sql) or die dbh->errstr; - $sth->execute or die $sth->errstr; - - map &{$escape_function}( $_->[0] ), @{ $sth->fetchall_arrayref }; - - } else { - - my $format_sub; - my $format = $opt{format} || ''; - if ( $format eq 'html' ) { - - $format_sub = sub { my $detail = shift; - $csv->parse($detail) or return "can't parse $detail"; - join('</TD><TD>', map { &$escape_function($_) } - $csv->fields - ); - }; - - } elsif ( $format eq 'latex' ) { - - $format_sub = sub { - my $detail = shift; - $csv->parse($detail) or return "can't parse $detail"; - #join(' & ', map { '\small{'. &$escape_function($_). '}' } - # $csv->fields ); - my $result = ''; - my $column = 1; - foreach ($csv->fields) { - $result .= ' & ' if $column > 1; - if ($column > 6) { # KLUDGE ALERT! - $result .= '\multicolumn{1}{l}{\scriptsize{'. - &$escape_function($_). '}}'; - }else{ - $result .= '\scriptsize{'. &$escape_function($_). '}'; - } - $column++; - } - $result; - }; - - } else { - - $format_sub = sub { my $detail = shift; - $csv->parse($detail) or return "can't parse $detail"; - join(' - ', map { &$escape_function($_) } - $csv->fields - ); - }; - - } - - my $sql = "SELECT format, detail FROM cust_bill_pkg_detail ". - " WHERE billpkgnum = ". $self->billpkgnum. - " ORDER BY detailnum"; - my $sth = dbh->prepare($sql) or die dbh->errstr; - $sth->execute or die $sth->errstr; - - #avoid the fetchall_arrayref and loop for less memory usage? - - map { (defined($_->[0]) && $_->[0] eq 'C') - ? &{$format_sub}( $_->[1] ) - : &{$escape_function}( $_->[1] ); - } - @{ $sth->fetchall_arrayref }; - - } - -} - -=item details_header [ OPTION => VALUE ... ] - -Returns a list representing an invoice line item detail header, if any. -This relies on the behavior of voip_cdr in that it expects the header -to be the first CSV formatted detail (as is expected by invoice generation -routines). Returns the empty list otherwise. - -=cut - -sub details_header { - my $self = shift; - return '' unless defined dbdef->table('cust_bill_pkg_detail'); - - my $csv = new Text::CSV_XS; - - my @detail = - qsearch ({ 'table' => 'cust_bill_pkg_detail', - 'hashref' => { 'billpkgnum' => $self->billpkgnum, - 'format' => 'C', - }, - 'order_by' => 'ORDER BY detailnum LIMIT 1', - }); - return() unless scalar(@detail); - $csv->parse($detail[0]->detail) or return (); - $csv->fields; -} - -=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->itemdesc || $self->part_pkg->pkg; - } else { - my $desc = $self->itemdesc || 'Tax'; - $desc .= ' '. $self->itemcomment if $self->itemcomment =~ /\S/; - $desc; - } -} - =item owed_setup Returns the amount owed (still outstanding) on this line item's setup fee, @@ -692,45 +573,6 @@ sub units { $self->pkgnum ? $self->part_pkg->calc_units($self->cust_pkg) : 0; # 1? } -=item quantity - -=cut - -sub quantity { - my( $self, $value ) = @_; - if ( defined($value) ) { - $self->setfield('quantity', $value); - } - $self->getfield('quantity') || 1; -} - -=item unitsetup - -=cut - -sub unitsetup { - my( $self, $value ) = @_; - if ( defined($value) ) { - $self->setfield('unitsetup', $value); - } - $self->getfield('unitsetup') eq '' - ? $self->getfield('setup') - : $self->getfield('unitsetup'); -} - -=item unitrecur - -=cut - -sub unitrecur { - my( $self, $value ) = @_; - if ( defined($value) ) { - $self->setfield('unitrecur', $value); - } - $self->getfield('unitrecur') eq '' - ? $self->getfield('recur') - : $self->getfield('unitrecur'); -} =item set_display OPTION => VALUE ... @@ -942,52 +784,10 @@ sub usage_classes { } -=item cust_bill_pkg_display [ type => TYPE ] - -Returns an array of display information for the invoice line item optionally -limited to 'TYPE'. - -=cut - -sub cust_bill_pkg_display { - my ( $self, %opt ) = @_; - - my $default = - new FS::cust_bill_pkg_display { billpkgnum =>$self->billpkgnum }; - - return ( $default ) unless defined dbdef->table('cust_bill_pkg_display');#hmmm - - my $type = $opt{type} if exists $opt{type}; - my @result; - - if ( $self->get('display') ) { - @result = grep { defined($type) ? ($type eq $_->type) : 1 } - @{ $self->get('display') }; - } else { - my $hashref = { 'billpkgnum' => $self->billpkgnum }; - $hashref->{type} = $type if defined($type); - - @result = qsearch ({ 'table' => 'cust_bill_pkg_display', - 'hashref' => { 'billpkgnum' => $self->billpkgnum }, - 'order_by' => 'ORDER BY billpkgdisplaynum', - }); - } - - push @result, $default unless ( scalar(@result) || $type ); - - @result; - -} - -# reserving this name for my friends FS::{tax_rate|cust_main_county}::taxline -# and FS::cust_main::bill - -sub _cust_tax_exempt_pkg { +sub cust_tax_exempt_pkg { my ( $self ) = @_; - $self->{Hash}->{_cust_tax_exempt_pkg} or - $self->{Hash}->{_cust_tax_exempt_pkg} = []; - + $self->{Hash}->{cust_tax_exempt_pkg} ||= []; } =item cust_bill_pkg_tax_Xlocation @@ -1009,60 +809,608 @@ sub cust_bill_pkg_tax_Xlocation { } -=item cust_bill_pkg_detail [ CLASSNUM ] - -Returns the list of associated cust_bill_pkg_detail objects -The optional CLASSNUM argument will limit the details to the specified usage -class. +=item recur_show_zero =cut -sub cust_bill_pkg_detail { - my $self = shift; - my $classnum = shift || ''; +sub recur_show_zero { shift->_X_show_zero('recur'); } +sub setup_show_zero { shift->_X_show_zero('setup'); } - my %hash = ( 'billpkgnum' => $self->billpkgnum ); - $hash{classnum} = $classnum if $classnum; +sub _X_show_zero { + my( $self, $what ) = @_; - qsearch( 'cust_bill_pkg_detail', \%hash ), + return 0 unless $self->$what() == 0 && $self->pkgnum; + $self->cust_pkg->_X_show_zero($what); } -=item cust_bill_pkg_discount +=back + +=head1 CLASS METHODS + +=over 4 -Returns the list of associated cust_bill_pkg_discount objects. +=item usage_sql + +Returns an SQL expression for the total usage charges in details on +an item. =cut -sub cust_bill_pkg_discount { - my $self = shift; - qsearch( 'cust_bill_pkg_discount', { 'billpkgnum' => $self->billpkgnum } ); +my $usage_sql = + '(SELECT COALESCE(SUM(cust_bill_pkg_detail.amount),0) + FROM cust_bill_pkg_detail + WHERE cust_bill_pkg_detail.billpkgnum = cust_bill_pkg.billpkgnum)'; + +sub usage_sql { $usage_sql } + +# this makes owed_sql, etc. much more concise +sub charged_sql { + my ($class, $start, $end, %opt) = @_; + my $charged = + $opt{setuprecur} =~ /^s/ ? 'cust_bill_pkg.setup' : + $opt{setuprecur} =~ /^r/ ? 'cust_bill_pkg.recur' : + 'cust_bill_pkg.setup + cust_bill_pkg.recur'; + + if ($opt{no_usage} and $charged =~ /recur/) { + $charged = "$charged - $usage_sql" + } + + $charged; } -=item recur_show_zero + +=item owed_sql [ BEFORE, AFTER, OPTIONS ] + +Returns an SQL expression for the amount owed. BEFORE and AFTER specify +a date window. OPTIONS may include 'no_usage' (excludes usage charges) +and 'setuprecur' (set to "setup" or "recur" to limit to one or the other). =cut -sub recur_show_zero { - #my $self = shift; - # $self->recur == 0 - #&& $self->pkgnum - #&& $self->cust_pkg->part_pkg->recur_show_zero; +sub owed_sql { + my $class = shift; + '(' . $class->charged_sql(@_) . + ' - ' . $class->paid_sql(@_) . + ' - ' . $class->credited_sql(@_) . ')' +} + +=item paid_sql [ BEFORE, AFTER, OPTIONS ] - shift->_X_show_zero('recur'); +Returns an SQL expression for the sum of payments applied to this item. + +=cut + +sub paid_sql { + my ($class, $start, $end, %opt) = @_; + my $s = $start ? "AND cust_bill_pay._date <= $start" : ''; + my $e = $end ? "AND cust_bill_pay._date > $end" : ''; + my $setuprecur = + $opt{setuprecur} =~ /^s/ ? 'setup' : + $opt{setuprecur} =~ /^r/ ? 'recur' : + ''; + $setuprecur &&= "AND setuprecur = '$setuprecur'"; + + my $paid = "( SELECT COALESCE(SUM(cust_bill_pay_pkg.amount),0) + FROM cust_bill_pay_pkg JOIN cust_bill_pay USING (billpaynum) + WHERE cust_bill_pay_pkg.billpkgnum = cust_bill_pkg.billpkgnum + $s $e$setuprecur )"; + + if ( $opt{no_usage} ) { + # cap the amount paid at the sum of non-usage charges, + # minus the amount credited against non-usage charges + "LEAST($paid, ". + $class->charged_sql($start, $end, %opt) . ' - ' . + $class->credited_sql($start, $end, %opt).')'; + } + else { + $paid; + } } -sub setup_show_zero { - shift->_X_show_zero('setup'); +sub credited_sql { + my ($class, $start, $end, %opt) = @_; + my $s = $start ? "AND cust_credit_bill._date <= $start" : ''; + my $e = $end ? "AND cust_credit_bill._date > $end" : ''; + my $setuprecur = + $opt{setuprecur} =~ /^s/ ? 'setup' : + $opt{setuprecur} =~ /^r/ ? 'recur' : + ''; + $setuprecur &&= "AND setuprecur = '$setuprecur'"; + + my $credited = "( SELECT COALESCE(SUM(cust_credit_bill_pkg.amount),0) + FROM cust_credit_bill_pkg JOIN cust_credit_bill USING (creditbillnum) + WHERE cust_credit_bill_pkg.billpkgnum = cust_bill_pkg.billpkgnum + $s $e $setuprecur )"; + + if ( $opt{no_usage} ) { + # cap the amount credited at the sum of non-usage charges + "LEAST($credited, ". $class->charged_sql($start, $end, %opt).')'; + } + else { + $credited; + } + } -sub _X_show_zero { - my( $self, $what ) = @_; +sub upgrade_tax_location { + # For taxes that were calculated/invoiced before cust_location refactoring + # (May-June 2012), there are no cust_bill_pkg_tax_location records unless + # they were calculated on a package-location basis. Create them here, + # along with any necessary cust_location records and any tax exemption + # records. + + my ($class, %opt) = @_; + # %opt may include 's' and 'e': start and end date ranges + # and 'X': abort on any error, instead of just rolling back changes to + # that invoice + my $dbh = dbh; + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; - return 0 unless $self->$what() == 0 && $self->pkgnum; + eval { + use FS::h_cust_main; + use FS::h_cust_bill; + use FS::h_part_pkg; + use FS::h_cust_main_exemption; + }; - $self->cust_pkg->_X_show_zero($what); + local $FS::cust_location::import = 1; + + my $conf = FS::Conf->new; # h_conf? + return if $conf->exists('enable_taxproducts'); #don't touch this case + my $use_ship = $conf->exists('tax-ship_address'); + + my $date_where = ''; + if ($opt{s}) { + $date_where .= " AND cust_bill._date >= $opt{s}"; + } + if ($opt{e}) { + $date_where .= " AND cust_bill._date < $opt{e}"; + } + + my $commit_each_invoice = 1 unless $opt{X}; + + # if an invoice has either of these kinds of objects, then it doesn't + # need to be upgraded...probably + my $sub_has_tax_link = 'SELECT 1 FROM cust_bill_pkg_tax_location'. + ' JOIN cust_bill_pkg USING (billpkgnum)'. + ' WHERE cust_bill_pkg.invnum = cust_bill.invnum'; + my $sub_has_exempt = 'SELECT 1 FROM cust_tax_exempt_pkg'. + ' JOIN cust_bill_pkg USING (billpkgnum)'. + ' WHERE cust_bill_pkg.invnum = cust_bill.invnum'. + ' AND exempt_monthly IS NULL'; + + my @invnums = map { $_->invnum } qsearch({ + select => 'cust_bill.invnum', + table => 'cust_bill', + hashref => {}, + extra_sql => "WHERE NOT EXISTS($sub_has_tax_link) ". + "AND NOT EXISTS($sub_has_exempt) ". + $date_where, + }); + + print "Processing ".scalar(@invnums)." invoices...\n"; + + my $committed; + INVOICE: + foreach my $invnum (@invnums) { + $committed = 0; + print STDERR "Invoice #$invnum\n"; + my $pre = ''; + my %pkgpart_taxclass; # pkgpart => taxclass + my %pkgpart_exempt_setup; + my %pkgpart_exempt_recur; + my $h_cust_bill = qsearchs('h_cust_bill', + { invnum => $invnum, + history_action => 'insert' }); + if (!$h_cust_bill) { + warn "no insert record for invoice $invnum; skipped\n"; + #$date = $cust_bill->_date as a fallback? + # We're trying to avoid using non-real dates (-d/-y invoice dates) + # when looking up history records in other tables. + next INVOICE; + } + my $custnum = $h_cust_bill->custnum; + + # Determine the address corresponding to this tax region. + # It's either the bill or ship address of the customer as of the + # invoice date-of-insertion. (Not necessarily the invoice date.) + my $date = $h_cust_bill->history_date; + my $h_cust_main = qsearchs('h_cust_main', + { custnum => $custnum }, + FS::h_cust_main->sql_h_searchs($date) + ); + if (!$h_cust_main ) { + warn "no historical address for cust#".$h_cust_bill->custnum."; skipped\n"; + next INVOICE; + # fallback to current $cust_main? sounds dangerous. + } + + # This is a historical customer record, so it has a historical address. + # If there's no cust_location matching this custnum and address (there + # probably isn't), create one. + $pre = 'ship_' if $use_ship and length($h_cust_main->get('ship_last')); + my %hash = map { $_ => $h_cust_main->get($pre.$_) } + FS::cust_main->location_fields; + # not really needed for this, and often result in duplicate locations + delete @hash{qw(censustract censusyear latitude longitude coord_auto)}; + + $hash{custnum} = $h_cust_main->custnum; + my $tax_loc = qsearchs('cust_location', \%hash) # unlikely + || FS::cust_location->new({ %hash }); + if ( !$tax_loc->locationnum ) { + $tax_loc->disabled('Y'); + my $error = $tax_loc->insert; + if ( $error ) { + warn "couldn't create historical location record for cust#". + $h_cust_main->custnum.": $error\n"; + next INVOICE; + } + } + my $exempt_cust = 1 if $h_cust_main->tax; + + # Get any per-customer taxname exemptions that were in effect. + my %exempt_cust_taxname = map { + $_->taxname => 1 + } qsearch('h_cust_main_exemption', { 'custnum' => $custnum }, + FS::h_cust_main_exemption->sql_h_searchs($date) + ); + + # classify line items + my @tax_items; + my %nontax_items; # taxclass => array of cust_bill_pkg + foreach my $item ($h_cust_bill->cust_bill_pkg) { + my $pkgnum = $item->pkgnum; + + if ( $pkgnum == 0 ) { + + push @tax_items, $item; + + } else { + # (pkgparts really shouldn't change, right?) + my $h_cust_pkg = qsearchs('h_cust_pkg', { pkgnum => $pkgnum }, + FS::h_cust_pkg->sql_h_searchs($date) + ); + if ( !$h_cust_pkg ) { + warn "no historical package #".$item->pkgpart."; skipped\n"; + next INVOICE; + } + my $pkgpart = $h_cust_pkg->pkgpart; + + if (!exists $pkgpart_taxclass{$pkgpart}) { + my $h_part_pkg = qsearchs('h_part_pkg', { pkgpart => $pkgpart }, + FS::h_part_pkg->sql_h_searchs($date) + ); + if ( !$h_part_pkg ) { + warn "no historical package def #$pkgpart; skipped\n"; + next INVOICE; + } + $pkgpart_taxclass{$pkgpart} = $h_part_pkg->taxclass || ''; + $pkgpart_exempt_setup{$pkgpart} = 1 if $h_part_pkg->setuptax; + $pkgpart_exempt_recur{$pkgpart} = 1 if $h_part_pkg->recurtax; + } + + # mark any exemptions that apply + if ( $pkgpart_exempt_setup{$pkgpart} ) { + $item->set('exempt_setup' => 1); + } + + if ( $pkgpart_exempt_recur{$pkgpart} ) { + $item->set('exempt_recur' => 1); + } + + my $taxclass = $pkgpart_taxclass{ $pkgpart }; + + $nontax_items{$taxclass} ||= []; + push @{ $nontax_items{$taxclass} }, $item; + } + } + printf("%d tax items: \$%.2f\n", scalar(@tax_items), map {$_->setup} @tax_items) + if @tax_items; + + # Use a variation on the procedure in + # FS::cust_main::Billing::_handle_taxes to identify taxes that apply + # to this bill. + my @loc_keys = qw( district city county state country ); + my %taxhash = map { $_ => $h_cust_main->get($pre.$_) } @loc_keys; + my %taxdef_by_name; # by name, and then by taxclass + my %est_tax; # by name, and then by taxclass + my %taxable_items; # by taxnum, and then an array + + foreach my $taxclass (keys %nontax_items) { + my %myhash = %taxhash; + my @elim = qw( district city county state ); + my @taxdefs; # because there may be several with different taxnames + do { + $myhash{taxclass} = $taxclass; + @taxdefs = qsearch('cust_main_county', \%myhash); + if ( !@taxdefs ) { + $myhash{taxclass} = ''; + @taxdefs = qsearch('cust_main_county', \%myhash); + } + $myhash{ shift @elim } = ''; + } while scalar(@elim) and !@taxdefs; + + print "Class '$taxclass': ". scalar(@{ $nontax_items{$taxclass} }). + " items, ". scalar(@taxdefs)." tax defs found.\n"; + foreach my $taxdef (@taxdefs) { + next if $taxdef->tax == 0; + $taxdef_by_name{$taxdef->taxname}{$taxdef->taxclass} = $taxdef; + + $taxable_items{$taxdef->taxnum} ||= []; + foreach my $orig_item (@{ $nontax_items{$taxclass} }) { + # clone the item so that taxdef-dependent changes don't + # change it for other taxdefs + my $item = FS::cust_bill_pkg->new({ $orig_item->hash }); + + # these flags are already set if the part_pkg declares itself exempt + $item->set('exempt_setup' => 1) if $taxdef->setuptax; + $item->set('exempt_recur' => 1) if $taxdef->recurtax; + + my @new_exempt; + my $taxable = $item->setup + $item->recur; + # credits + # h_cust_credit_bill_pkg? + # NO. Because if these exemptions HAD been created at the time of + # billing, and then a credit applied later, the exemption would + # have been adjusted by the amount of the credit. So we adjust + # the taxable amount before creating the exemption. + # But don't deduct the credit from taxable, because the tax was + # calculated before the credit was applied. + foreach my $f (qw(setup recur)) { + my $credited = FS::Record->scalar_sql( + "SELECT SUM(amount) FROM cust_credit_bill_pkg ". + "WHERE billpkgnum = ? AND setuprecur = ?", + $item->billpkgnum, + $f + ); + $item->set($f, $item->get($f) - $credited) if $credited; + } + my $existing_exempt = FS::Record->scalar_sql( + "SELECT SUM(amount) FROM cust_tax_exempt_pkg WHERE ". + "billpkgnum = ? AND taxnum = ?", + $item->billpkgnum, $taxdef->taxnum + ) || 0; + $taxable -= $existing_exempt; + + if ( $taxable and $exempt_cust ) { + push @new_exempt, { exempt_cust => 'Y', amount => $taxable }; + $taxable = 0; + } + if ( $taxable and $exempt_cust_taxname{$taxdef->taxname} ){ + push @new_exempt, { exempt_cust_taxname => 'Y', amount => $taxable }; + $taxable = 0; + } + if ( $taxable and $item->exempt_setup ) { + push @new_exempt, { exempt_setup => 'Y', amount => $item->setup }; + $taxable -= $item->setup; + } + if ( $taxable and $item->exempt_recur ) { + push @new_exempt, { exempt_recur => 'Y', amount => $item->recur }; + $taxable -= $item->recur; + } + + $item->set('taxable' => $taxable); + push @{ $taxable_items{$taxdef->taxnum} }, $item + if $taxable > 0; + + # estimate the amount of tax (this is necessary because different + # taxdefs with the same taxname may have different tax rates) + # and sum that for each taxname/taxclass combination + # (in cents) + $est_tax{$taxdef->taxname} ||= {}; + $est_tax{$taxdef->taxname}{$taxdef->taxclass} ||= 0; + $est_tax{$taxdef->taxname}{$taxdef->taxclass} += + $taxable * $taxdef->tax; + + foreach (@new_exempt) { + next if $_->{amount} == 0; + my $cust_tax_exempt_pkg = FS::cust_tax_exempt_pkg->new({ + %$_, + billpkgnum => $item->billpkgnum, + taxnum => $taxdef->taxnum, + }); + my $error = $cust_tax_exempt_pkg->insert; + if ($error) { + my $pkgnum = $item->pkgnum; + warn "error creating tax exemption for inv$invnum pkg$pkgnum:". + "\n$error\n\n"; + next INVOICE; + } + } #foreach @new_exempt + } #foreach $item + } #foreach $taxdef + } #foreach $taxclass + + # Now go through the billed taxes and match them up with the line items. + TAX_ITEM: foreach my $tax_item ( @tax_items ) + { + my $taxname = $tax_item->itemdesc; + $taxname = '' if $taxname eq 'Tax'; + + if ( !exists( $taxdef_by_name{$taxname} ) ) { + # then we didn't find any applicable taxes with this name + warn "no definition found for tax item '$taxname'.\n". + '('.join(' ', @hash{qw(country state county city district)}).")\n"; + # possibly all of these should be "next TAX_ITEM", but whole invoices + # are transaction protected and we can go back and retry them. + next INVOICE; + } + # classname => cust_main_county + my %taxdef_by_class = %{ $taxdef_by_name{$taxname} }; + + # Divide the tax item among taxclasses, if necessary + # classname => estimated tax amount + my $this_est_tax = $est_tax{$taxname}; + if (!defined $this_est_tax) { + warn "no taxable sales found for inv#$invnum, tax item '$taxname'.\n"; + next INVOICE; + } + my $est_total = sum(values %$this_est_tax); + if ( $est_total == 0 ) { + # shouldn't happen + warn "estimated tax on invoice #$invnum is zero.\n"; + next INVOICE; + } + + my $real_tax = $tax_item->setup; + printf ("Distributing \$%.2f tax:\n", $real_tax); + my $cents_remaining = $real_tax * 100; # for rounding error + my @tax_links; # partial CBPTL hashrefs + foreach my $taxclass (keys %taxdef_by_class) { + my $taxdef = $taxdef_by_class{$taxclass}; + # these items already have "taxable" set to their charge amount + # after applying any credits or exemptions + my @items = @{ $taxable_items{$taxdef->taxnum} }; + my $subtotal = sum(map {$_->get('taxable')} @items); + printf("\t$taxclass: %.2f\n", $this_est_tax->{$taxclass}/$est_total); + + foreach my $nontax (@items) { + my $part = int($real_tax + # class allocation + * ($this_est_tax->{$taxclass}/$est_total) + # item allocation + * ($nontax->get('taxable'))/$subtotal + # convert to cents + * 100 + ); + $cents_remaining -= $part; + push @tax_links, { + taxnum => $taxdef->taxnum, + pkgnum => $nontax->pkgnum, + cents => $part, + }; + } #foreach $nontax + } #foreach $taxclass + # Distribute any leftover tax round-robin style, one cent at a time. + my $i = 0; + my $nlinks = scalar(@tax_links); + if ( $nlinks ) { + while (int($cents_remaining) > 0) { + $tax_links[$i % $nlinks]->{cents} += 1; + $cents_remaining--; + $i++; + } + } else { + warn "Can't create tax links--no taxable items found.\n"; + next INVOICE; + } + + # Gather credit/payment applications so that we can link them + # appropriately. + my @unlinked = ( + qsearch( 'cust_credit_bill_pkg', + { billpkgnum => $tax_item->billpkgnum, billpkgtaxlocationnum => '' } + ), + qsearch( 'cust_bill_pay_pkg', + { billpkgnum => $tax_item->billpkgnum, billpkgtaxlocationnum => '' } + ) + ); + + # grab the first one + my $this_unlinked = shift @unlinked; + my $unlinked_cents = int($this_unlinked->amount * 100) if $this_unlinked; + + # Create tax links (yay!) + printf("Creating %d tax links.\n",scalar(@tax_links)); + foreach (@tax_links) { + my $link = FS::cust_bill_pkg_tax_location->new({ + billpkgnum => $tax_item->billpkgnum, + taxtype => 'FS::cust_main_county', + locationnum => $tax_loc->locationnum, + taxnum => $_->{taxnum}, + pkgnum => $_->{pkgnum}, + amount => sprintf('%.2f', $_->{cents} / 100), + }); + my $error = $link->insert; + if ( $error ) { + warn "Can't create tax link for inv#$invnum: $error\n"; + next INVOICE; + } + + my $link_cents = $_->{cents}; + # update/create subitem links + # + # If $this_unlinked is undef, then we've allocated all of the + # credit/payment applications to the tax item. If $link_cents is 0, + # then we've applied credits/payments to all of this package fraction, + # so go on to the next. + while ($this_unlinked and $link_cents) { + # apply as much as possible of $link_amount to this credit/payment + # link + my $apply_cents = min($link_cents, $unlinked_cents); + $link_cents -= $apply_cents; + $unlinked_cents -= $apply_cents; + # $link_cents or $unlinked_cents or both are now zero + $this_unlinked->set('amount' => sprintf('%.2f',$apply_cents/100)); + $this_unlinked->set('billpkgtaxlocationnum' => $link->billpkgtaxlocationnum); + my $pkey = $this_unlinked->primary_key; #creditbillpkgnum or billpaypkgnum + if ( $this_unlinked->$pkey ) { + # then it's an existing link--replace it + $error = $this_unlinked->replace; + } else { + $this_unlinked->insert; + } + # what do we do with errors at this stage? + if ( $error ) { + warn "Error creating tax application link: $error\n"; + next INVOICE; # for lack of a better idea + } + + if ( $unlinked_cents == 0 ) { + # then we've allocated all of this payment/credit application, + # so grab the next one + $this_unlinked = shift @unlinked; + $unlinked_cents = int($this_unlinked->amount * 100) if $this_unlinked; + } elsif ( $link_cents == 0 ) { + # then we've covered all of this package tax fraction, so split + # off a new application from this one + $this_unlinked = $this_unlinked->new({ + $this_unlinked->hash, + $pkey => '', + }); + # $unlinked_cents is still what it is + } + + } #while $this_unlinked and $link_cents + } #foreach (@tax_links) + } #foreach $tax_item + + $dbh->commit if $commit_each_invoice and $oldAutoCommit; + $committed = 1; + + } #foreach $invnum + continue { + if (!$committed) { + $dbh->rollback if $oldAutoCommit; + die "Upgrade halted.\n" unless $commit_each_invoice; + } + } + + $dbh->commit if $oldAutoCommit and !$commit_each_invoice; + ''; +} + +sub _upgrade_data { + # Create a queue job to run upgrade_tax_location from January 1, 2012 to + # the present date. + eval { + use FS::queue; + use Date::Parse 'str2time'; + }; + my $class = shift; + my $upgrade = 'tax_location_2012'; + return if FS::upgrade_journal->is_done($upgrade); + my $job = FS::queue->new({ + 'job' => 'FS::cust_bill_pkg::upgrade_tax_location' + }); + # call it kind of like a class method, not that it matters much + $job->insert($class, 's' => str2time('2012-01-01')); + # Then mark the upgrade as done, so that we don't queue the job twice + # and somehow run two of them concurrently. + FS::upgrade_journal->set_done($upgrade); } =back @@ -1082,6 +1430,8 @@ 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. +The upgrade procedure is pretty sketchy. + =head1 SEE ALSO L<FS::Record>, L<FS::cust_bill>, L<FS::cust_pkg>, L<FS::cust_main>, schema.html diff --git a/FS/FS/cust_bill_pkg_detail_void.pm b/FS/FS/cust_bill_pkg_detail_void.pm new file mode 100644 index 000000000..cebe7c1f8 --- /dev/null +++ b/FS/FS/cust_bill_pkg_detail_void.pm @@ -0,0 +1,168 @@ +package FS::cust_bill_pkg_detail_void; + +use strict; +use base qw( FS::Record ); +use FS::Record; # qw( qsearch qsearchs ); +use FS::cust_bill_pkg_void; +use FS::usage_class; + +=head1 NAME + +FS::cust_bill_pkg_detail_void - Object methods for cust_bill_pkg_detail_void records + +=head1 SYNOPSIS + + use FS::cust_bill_pkg_detail_void; + + $record = new FS::cust_bill_pkg_detail_void \%hash; + $record = new FS::cust_bill_pkg_detail_void { '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_void object represents additional detail +information for a voided invoice line item. FS::cust_bill_pkg_detail_void +inherits from FS::Record. The following fields are currently supported: + +=over 4 + +=item detailnum + +primary key + +=item billpkgnum + +billpkgnum + +=item pkgnum + +pkgnum + +=item invnum + +invnum + +=item amount + +amount + +=item format + +format + +=item classnum + +classnum + +=item duration + +duration + +=item phonenum + +phonenum + +=item accountcode + +accountcode + +=item startdate + +startdate + +=item regionname + +regionname + +=item detail + +detail + + +=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_bill_pkg_detail_void'; } + +=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 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('detailnum') + || $self->ut_foreign_keyn('billpkgnum', 'cust_bill_pkg_void', 'billpkgnum') + || $self->ut_numbern('pkgnum') + || $self->ut_numbern('invnum') + || $self->ut_floatn('amount') + || $self->ut_enum('format', [ '', 'C' ] ) + || $self->ut_foreign_keyn('classnum', 'usage_class', 'classnum') + || $self->ut_numbern('duration') + || $self->ut_textn('phonenum') + || $self->ut_textn('accountcode') + || $self->ut_numbern('startdate') + || $self->ut_textn('regionname') + || $self->ut_text('detail') + ; + 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/cust_bill_pkg_discount.pm b/FS/FS/cust_bill_pkg_discount.pm index e7dd5f22f..dfa83d393 100644 --- a/FS/FS/cust_bill_pkg_discount.pm +++ b/FS/FS/cust_bill_pkg_discount.pm @@ -28,8 +28,8 @@ FS::cust_bill_pkg_discount - Object methods for cust_bill_pkg_discount records =head1 DESCRIPTION An FS::cust_bill_pkg_discount object represents the slice of a customer -applied to a line item. FS::cust_bill_pkg_discount inherits from -FS::Record. The following fields are currently supported: +discount applied to a specific line item. FS::cust_bill_pkg_discount inherits +from FS::Record. The following fields are currently supported: =over 4 diff --git a/FS/FS/cust_bill_pkg_discount_void.pm b/FS/FS/cust_bill_pkg_discount_void.pm new file mode 100644 index 000000000..859ef3cf2 --- /dev/null +++ b/FS/FS/cust_bill_pkg_discount_void.pm @@ -0,0 +1,129 @@ +package FS::cust_bill_pkg_discount_void; + +use strict; +use base qw( FS::Record ); +use FS::Record; # qw( qsearch qsearchs ); +use FS::cust_bill_pkg_void; +use FS::cust_pkg_discount; + +=head1 NAME + +FS::cust_bill_pkg_discount_void - Object methods for cust_bill_pkg_discount_void records + +=head1 SYNOPSIS + + use FS::cust_bill_pkg_discount_void; + + $record = new FS::cust_bill_pkg_discount_void \%hash; + $record = new FS::cust_bill_pkg_discount_void { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cust_bill_pkg_discount_void object represents the slice of a customer +discount applied to a specific voided line item. +FS::cust_bill_pkg_discount_void inherits from FS::Record. The following fields +are currently supported: + +=over 4 + +=item billpkgdiscountnum + +primary key + +=item billpkgnum + +billpkgnum + +=item pkgdiscountnum + +pkgdiscountnum + +=item amount + +amount + +=item months + +months + + +=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 + +sub table { 'cust_bill_pkg_discount_void'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +=item delete + +Delete this record from the database. + +=cut + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +=item check + +Checks all fields to make sure this is a valid example. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +sub check { + my $self = shift; + + my $error = + $self->ut_number('billpkgdiscountnum') + || $self->ut_foreign_key('billpkgnum', 'cust_bill_pkg_void', 'billpkgnum' ) + || $self->ut_foreign_key('pkgdiscountnum', 'cust_pkg_discount', 'pkgdiscountnum' ) + || $self->ut_money('amount') + || $self->ut_float('months') + ; + 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/cust_bill_pkg_display_void.pm b/FS/FS/cust_bill_pkg_display_void.pm new file mode 100644 index 000000000..e78801a36 --- /dev/null +++ b/FS/FS/cust_bill_pkg_display_void.pm @@ -0,0 +1,132 @@ +package FS::cust_bill_pkg_display_void; + +use strict; +use base qw( FS::Record ); +use FS::Record; # qw( qsearch qsearchs ); +use FS::cust_bill_pkg_void; + +=head1 NAME + +FS::cust_bill_pkg_display_void - Object methods for cust_bill_pkg_display_void records + +=head1 SYNOPSIS + + use FS::cust_bill_pkg_display_void; + + $record = new FS::cust_bill_pkg_display_void \%hash; + $record = new FS::cust_bill_pkg_display_void { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cust_bill_pkg_display_void object represents voided line item display +information. FS::cust_bill_pkg_display_void inherits from FS::Record. The +following fields are currently supported: + +=over 4 + +=item billpkgdisplaynum + +primary key + +=item billpkgnum + +billpkgnum + +=item section + +section + +=item post_total + +post_total + +=item type + +type + +=item summary + +summary + + +=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_bill_pkg_display_void'; } + +=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 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('billpkgdisplaynum') + || $self->ut_foreign_key('billpkgnum', 'cust_bill_pkg_void', 'billpkgnum') + || $self->ut_textn('section') + || $self->ut_enum('post_total', [ '', 'Y' ]) + || $self->ut_enum('type', [ '', 'S', 'R', 'U' ]) + || $self->ut_enum('summary', [ '', '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/cust_bill_pkg_tax_location_void.pm b/FS/FS/cust_bill_pkg_tax_location_void.pm new file mode 100644 index 000000000..9e0794bad --- /dev/null +++ b/FS/FS/cust_bill_pkg_tax_location_void.pm @@ -0,0 +1,139 @@ +package FS::cust_bill_pkg_tax_location_void; + +use strict; +use base qw( FS::Record ); +use FS::Record; # qw( qsearch qsearchs ); +use FS::cust_bill_pkg_void; +use FS::cust_pkg; +use FS::cust_location; + +=head1 NAME + +FS::cust_bill_pkg_tax_location_void - Object methods for cust_bill_pkg_tax_location_void records + +=head1 SYNOPSIS + + use FS::cust_bill_pkg_tax_location_void; + + $record = new FS::cust_bill_pkg_tax_location_void \%hash; + $record = new FS::cust_bill_pkg_tax_location_void { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cust_bill_pkg_tax_location_void object represents a voided record +of taxation based on package location. FS::cust_bill_pkg_tax_location_void +inherits from FS::Record. The following fields are currently supported: + +=over 4 + +=item billpkgtaxlocationnum + +primary key + +=item billpkgnum + +billpkgnum + +=item taxnum + +taxnum + +=item taxtype + +taxtype + +=item pkgnum + +pkgnum + +=item locationnum + +locationnum + +=item amount + +amount + + +=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_bill_pkg_tax_location_void'; } + +=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 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('billpkgtaxlocationnum') + || $self->ut_foreign_key('billpkgnum', 'cust_bill_pkg_void', 'billpkgnum' ) + || $self->ut_number('taxnum') #cust_bill_pkg/tax_rate key, based on taxtype + || $self->ut_enum('taxtype', [ qw( FS::cust_main_county FS::tax_rate ) ] ) + || $self->ut_foreign_key('pkgnum', 'cust_pkg', 'pkgnum' ) + || $self->ut_foreign_key('locationnum', 'cust_location', 'locationnum' ) + || $self->ut_money('amount') + ; + 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/cust_bill_pkg_tax_rate_location_void.pm b/FS/FS/cust_bill_pkg_tax_rate_location_void.pm new file mode 100644 index 000000000..f2e85c085 --- /dev/null +++ b/FS/FS/cust_bill_pkg_tax_rate_location_void.pm @@ -0,0 +1,139 @@ +package FS::cust_bill_pkg_tax_rate_location_void; + +use strict; +use base qw( FS::Record ); +use FS::Record; # qw( qsearch qsearchs ); +use FS::cust_bill_pkg_void; +use FS::tax_rate_location; + +=head1 NAME + +FS::cust_bill_pkg_tax_rate_location_void - Object methods for cust_bill_pkg_tax_rate_location_void records + +=head1 SYNOPSIS + + use FS::cust_bill_pkg_tax_rate_location_void; + + $record = new FS::cust_bill_pkg_tax_rate_location_void \%hash; + $record = new FS::cust_bill_pkg_tax_rate_location_void { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cust_bill_pkg_tax_rate_location_void object represents a voided record +of taxation based on package location. +FS::cust_bill_pkg_tax_rate_location_void inherits from FS::Record. The +following fields are currently supported: + +=over 4 + +=item billpkgtaxratelocationnum + +primary key + +=item billpkgnum + +billpkgnum + +=item taxnum + +taxnum + +=item taxtype + +taxtype + +=item locationtaxid + +locationtaxid + +=item taxratelocationnum + +taxratelocationnum + +=item amount + +amount + + +=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_bill_pkg_tax_rate_location_void'; } + +=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 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('billpkgtaxratelocationnum') + || $self->ut_foreign_key('billpkgnum', 'cust_bill_pkg_void', 'billpkgnum' ) + || $self->ut_number('taxnum') #cust_bill_pkg/tax_rate key, based on taxtype + || $self->ut_text('taxtype', [ qw( FS::cust_main_county FS::tax_rate ) ] ) + || $self->ut_textn('locationtaxid') + || $self->ut_foreign_key('taxratelocationnum', 'tax_rate_location', 'taxratelocationnum' ) + || $self->ut_money('amount') + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::cust_bill_pkg_tax_rate_location>, L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/cust_bill_pkg_void.pm b/FS/FS/cust_bill_pkg_void.pm new file mode 100644 index 000000000..8949ba7a3 --- /dev/null +++ b/FS/FS/cust_bill_pkg_void.pm @@ -0,0 +1,272 @@ +package FS::cust_bill_pkg_void; +use base qw( FS::TemplateItem_Mixin FS::Record ); + +use strict; +use FS::Record qw( qsearch qsearchs dbh fields ); +use FS::cust_bill_void; +use FS::cust_bill_pkg_detail; +use FS::cust_bill_pkg_display; +use FS::cust_bill_pkg_discount; +use FS::cust_bill_pkg; +use FS::cust_bill_pkg_tax_location; +use FS::cust_bill_pkg_tax_rate_location; +use FS::cust_tax_exempt_pkg; + +=head1 NAME + +FS::cust_bill_pkg_void - Object methods for cust_bill_pkg_void records + +=head1 SYNOPSIS + + use FS::cust_bill_pkg_void; + + $record = new FS::cust_bill_pkg_void \%hash; + $record = new FS::cust_bill_pkg_void { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cust_bill_pkg_void object represents a voided invoice line item. +FS::cust_bill_pkg_void inherits from FS::Record. The following fields are +currently supported: + +=over 4 + +=item billpkgnum + +primary key + +=item invnum + +invnum + +=item pkgnum + +pkgnum + +=item pkgpart_override + +pkgpart_override + +=item setup + +setup + +=item recur + +recur + +=item sdate + +sdate + +=item edate + +edate + +=item itemdesc + +itemdesc + +=item itemcomment + +itemcomment + +=item section + +section + +=item freq + +freq + +=item quantity + +quantity + +=item unitsetup + +unitsetup + +=item unitrecur + +unitrecur + +=item hidden + +hidden + + +=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_bill_pkg_void'; } + +sub detail_table { 'cust_bill_pkg_detail_void'; } +sub display_table { 'cust_bill_pkg_display_void'; } +sub discount_table { 'cust_bill_pkg_discount_void'; } +#sub tax_location_table { 'cust_bill_pkg_tax_location'; } +#sub tax_rate_location_table { 'cust_bill_pkg_tax_rate_location'; } +#sub tax_exempt_pkg_table { 'cust_tax_exempt_pkg'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=item unvoid + +"Un-void"s this line item: Deletes the voided line item from the database and +adds back a normal line item (and related tables). + +=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_bill_pkg = new FS::cust_bill_pkg ( { + map { $_ => $self->get($_) } fields('cust_bill_pkg') + } ); + my $error = $cust_bill_pkg->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + foreach my $table (qw( + cust_bill_pkg_detail + cust_bill_pkg_display + cust_bill_pkg_discount + cust_bill_pkg_tax_location + cust_bill_pkg_tax_rate_location + cust_tax_exempt_pkg + )) { + + foreach my $voided ( + qsearch($table.'_void', { billpkgnum=>$self->billpkgnum }) + ) { + + my $class = 'FS::'.$table; + my $unvoid = $class->new( { + map { $_ => $voided->get($_) } fields($table) + }); + my $error = $unvoid->insert || $voided->delete; + 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 + +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. + +=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('billpkgnum') + || $self->ut_snumber('pkgnum') + || $self->ut_number('invnum') #cust_bill or cust_bill_void, if we ever support line item voiding + || $self->ut_numbern('pkgpart_override') + || $self->ut_money('setup') + || $self->ut_money('recur') + || $self->ut_numbern('sdate') + || $self->ut_numbern('edate') + || $self->ut_textn('itemdesc') + || $self->ut_textn('itemcomment') + || $self->ut_textn('section') + || $self->ut_textn('freq') + || $self->ut_numbern('quantity') + || $self->ut_moneyn('unitsetup') + || $self->ut_moneyn('unitrecur') + || $self->ut_enum('hidden', [ '', 'Y' ]) + ; + return $error if $error; + + $self->SUPER::check; +} + +=item cust_bill + +Returns the voided invoice (see L<FS::cust_bill_void>) for this voided line +item. + +=cut + +sub cust_bill { + my $self = shift; + #cust_bill or cust_bill_void, if we ever support line item voiding + qsearchs( 'cust_bill_void', { 'invnum' => $self->invnum } ); +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/cust_bill_void.pm b/FS/FS/cust_bill_void.pm new file mode 100644 index 000000000..cce77b3aa --- /dev/null +++ b/FS/FS/cust_bill_void.pm @@ -0,0 +1,286 @@ +package FS::cust_bill_void; +use base qw( FS::Template_Mixin FS::cust_main_Mixin FS::otaker_Mixin FS::Record ); + +use strict; +use FS::Record qw( qsearch qsearchs dbh fields ); +use FS::cust_main; +use FS::cust_statement; +use FS::access_user; +use FS::cust_bill_pkg_void; +use FS::cust_bill; + +=head1 NAME + +FS::cust_bill_void - Object methods for cust_bill_void records + +=head1 SYNOPSIS + + use FS::cust_bill_void; + + $record = new FS::cust_bill_void \%hash; + $record = new FS::cust_bill_void { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cust_bill_void object represents a voided invoice. FS::cust_bill_void +inherits from FS::Record. The following fields are currently supported: + +=over 4 + +=item invnum + +primary key + +=item custnum + +custnum + +=item _date + +_date + +=item charged + +charged + +=item invoice_terms + +invoice_terms + +=item previous_balance + +previous_balance + +=item billing_balance + +billing_balance + +=item closed + +closed + +=item statementnum + +statementnum + +=item agent_invid + +agent_invid + +=item promised_date + +promised_date + +=item void_date + +void_date + +=item reason + +reason + +=item void_usernum + +void_usernum + + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new voided invoice. To add the voided invoice 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_bill_void'; } +sub notice_name { 'VOIDED Invoice'; } +#XXXsub template_conf { 'quotation_'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +=item unvoid + +"Un-void"s this invoice: Deletes the voided invoice from the database and adds +back a normal invoice (and related tables). + +=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_bill = new FS::cust_bill ( { + map { $_ => $self->get($_) } fields('cust_bill') + } ); + my $error = $cust_bill->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + foreach my $cust_bill_pkg_void ( $self->cust_bill_pkg ) { + my $error = $cust_bill_pkg_void->unvoid; + 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 + +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 voided 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_number('invnum') + || $self->ut_foreign_key('custnum', 'cust_main', 'custnum' ) + || $self->ut_numbern('_date') + || $self->ut_money('charged') + || $self->ut_textn('invoice_terms') + || $self->ut_moneyn('previous_balance') + || $self->ut_moneyn('billing_balance') + || $self->ut_enum('closed', [ '', 'Y' ]) + || $self->ut_foreign_keyn('statementnum', 'cust_statement', 'statementnum') + || $self->ut_numbern('agent_invid') + || $self->ut_numbern('promised_date') + || $self->ut_numbern('void_date') + || $self->ut_textn('reason') + || $self->ut_numbern('void_usernum') + ; + return $error if $error; + + $self->void_date(time) unless $self->void_date; + + $self->void_usernum($FS::CurrentUser::CurrentUser->usernum) + unless $self->void_usernum; + + $self->SUPER::check; +} + +=item display_invnum + +Returns the displayed invoice number for this invoice: agent_invid if +cust_bill-default_agent_invid is set and it has a value, invnum otherwise. + +=cut + +sub display_invnum { + my $self = shift; + my $conf = $self->conf; + if ( $conf->exists('cust_bill-default_agent_invid') && $self->agent_invid ){ + return $self->agent_invid; + } else { + return $self->invnum; + } +} + +=item void_access_user + +Returns the voiding employee object (see L<FS::access_user>). + +=cut + +sub void_access_user { + my $self = shift; + qsearchs('access_user', { 'usernum' => $self->void_usernum } ); +} + +=item cust_main + +=cut + +sub cust_main { + my $self = shift; + qsearchs('cust_main', { 'custnum' => $self->custnum } ); +} + +=item cust_bill_pkg + +=cut + +sub cust_bill_pkg { #actually cust_bill_pkg_void objects + my $self = shift; + qsearch('cust_bill_pkg_void', { invnum=>$self->invnum }); +} + +=back + +=item enable_previous + +=cut + +sub enable_previous { 0 } + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/cust_class.pm b/FS/FS/cust_class.pm index a811be7a7..7cbc9b818 100644 --- a/FS/FS/cust_class.pm +++ b/FS/FS/cust_class.pm @@ -44,6 +44,11 @@ Text name of this customer class Number of associated cust_category (see L<FS::cust_category>) +=item tax + +Tax exempt flag, empty or 'Y'. Used when the cust_class-tax_exempt +configuration setting is turned on. + =item disabled Disabled flag, empty or 'Y' @@ -86,6 +91,16 @@ Checks all fields to make sure this is a valid customer 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_enum('tax', [ '', 'Y' ]) + || $self->SUPER::check; + +} + =item cust_category =item category diff --git a/FS/FS/cust_credit_bill_pkg.pm b/FS/FS/cust_credit_bill_pkg.pm index 64f1f297e..418900785 100644 --- a/FS/FS/cust_credit_bill_pkg.pm +++ b/FS/FS/cust_credit_bill_pkg.pm @@ -103,18 +103,22 @@ sub insert { return $error; } - my $payable = $self->cust_bill_pkg->payable($self->setuprecur); - my $taxable = $self->_is_taxable ? $payable : 0; - my $part_pkg = $self->cust_bill_pkg->part_pkg; - my $freq = $self->cust_bill_pkg->freq; + my $cust_bill_pkg = $self->cust_bill_pkg; + #'payable' is the amount charged (either setup or recur) + # minus any credit applications, including this one + my $payable = $cust_bill_pkg->payable($self->setuprecur); + my $part_pkg = $cust_bill_pkg->part_pkg; + my $freq = $cust_bill_pkg->freq; unless ($freq) { $freq = $part_pkg ? ($part_pkg->freq || 1) : 1;#fallback.. assumes unchanged } - my $taxable_per_month = sprintf("%.2f", $taxable / $freq ); + my $taxable_per_month = sprintf("%.2f", $payable / $freq ); my $credit_per_month = sprintf("%.2f", $self->amount / $freq ); #pennies? if ($taxable_per_month >= 0) { #panic if its subzero? - my $groupby = 'taxnum,year,month'; + my $groupby = join(',', + qw(taxnum year month exempt_monthly exempt_cust + exempt_cust_taxname exempt_setup exempt_recur)); my $sum = 'SUM(amount)'; my @exemptions = qsearch( { @@ -124,25 +128,55 @@ sub insert { 'extra_sql' => "GROUP BY $groupby HAVING $sum > 0", } ); + # each $exemption is now the sum of all monthly exemptions applied to + # this line item for a particular taxnum and month. foreach my $exemption ( @exemptions ) { - next if $taxable_per_month >= $exemption->amount; - my $amount = $exemption->amount - $taxable_per_month; - if ($amount > $credit_per_month) { - "cust_bill_pkg ". $self->billpkgnum. " Reducing.\n"; - $amount = $credit_per_month; + my $amount = 0; + if ( $exemption->exempt_monthly ) { + # finite exemptions + # $taxable_per_month is AFTER inserting the credit application, so + # if it's still larger than the exemption, we don't need to adjust + next if $taxable_per_month >= $exemption->amount; + # the amount of 'excess' exemption already in place (above the + # remaining charged amount). We'll de-exempt that much, or the + # amount of the new credit, whichever is smaller. + $amount = $exemption->amount - $taxable_per_month; + # $amount is the amount of 'excess' exemption already existing + # (above the remaining taxable charge amount). We'll "de-exempt" + # that much, or the amount of the new credit, whichever is smaller. + if ($amount > $credit_per_month) { + "cust_bill_pkg ". $self->billpkgnum. " Reducing.\n"; + $amount = $credit_per_month; + } + } elsif ( $exemption->exempt_setup or $exemption->exempt_recur ) { + # package defined exemptions: may be setup only, recur only, or both + my $method = 'exempt_'.$self->setuprecur; + if ( $exemption->$method ) { + # then it's exempt from the portion of the charge that this + # credit is being applied to + $amount = $self->amount; + } + } else { + # other types of exemptions: always equal to the amount of + # the charge + $amount = $self->amount; } + next if $amount == 0; + + # create a negative exemption my $cust_tax_exempt_pkg = new FS::cust_tax_exempt_pkg { + $exemption->hash, # for exempt_ flags, taxnum, month/year 'billpkgnum' => $self->billpkgnum, 'creditbillpkgnum' => $self->creditbillpkgnum, 'amount' => sprintf('%.2f', 0-$amount), - map { $_ => $exemption->$_ } split(',', $groupby) }; + my $error = $cust_tax_exempt_pkg->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; return "error inserting cust_tax_exempt_pkg: $error"; } - } + } #foreach $exemption } $dbh->commit or die $dbh->errstr if $oldAutoCommit; @@ -233,7 +267,7 @@ sub delete { return "error calculating taxes: $hashref_or_error"; } - push @generated_exemptions, @{ $cust_bill_pkg->_cust_tax_exempt_pkg || [] }; + push @generated_exemptions, @{ $cust_bill_pkg->cust_tax_exempt_pkg }; } foreach my $taxnum ( keys %seen ) { diff --git a/FS/FS/cust_location.pm b/FS/FS/cust_location.pm index 6f7eb9964..88831725e 100644 --- a/FS/FS/cust_location.pm +++ b/FS/FS/cust_location.pm @@ -1,15 +1,18 @@ package FS::cust_location; +use base qw( FS::geocode_Mixin FS::Record ); use strict; -use base qw( FS::geocode_Mixin FS::Record ); +use vars qw( $import ); use Locale::Country; -use FS::UID qw( dbh ); +use FS::UID qw( dbh driver_name ); use FS::Record qw( qsearch ); #qsearchs ); use FS::Conf; use FS::prospect_main; use FS::cust_main; use FS::cust_main_county; +$import = 0; + =head1 NAME FS::cust_location - Object methods for cust_location records @@ -110,11 +113,16 @@ otherwise returns false. sub insert { my $self = shift; + my $conf = new FS::Conf; + + if ( $self->censustract ) { + $self->set('censusyear' => $conf->config('census_year') || 2012); + } + my $error = $self->SUPER::insert(@_); #false laziness with cust_main, will go away eventually - my $conf = new FS::Conf; - if ( !$error and $conf->config('tax_district_method') ) { + if ( !$import and !$error and $conf->config('tax_district_method') ) { my $queue = new FS::queue { 'job' => 'FS::geocode_Mixin::process_district_update' @@ -141,21 +149,14 @@ sub replace { my $self = shift; my $old = shift; $old ||= $self->replace_old; - my $error = $self->SUPER::replace($old); - - #false laziness with cust_main, will go away eventually - my $conf = new FS::Conf; - if ( !$error and $conf->config('tax_district_method') - and $self->get('address1') ne $old->get('address1') ) { - - my $queue = new FS::queue { - 'job' => 'FS::geocode_Mixin::process_district_update' - }; - $error = $queue->insert( ref($self), $self->locationnum ); - + # the following fields are immutable + foreach (qw(address1 address2 city state zip country)) { + if ( $self->$_ ne $old->$_ ) { + return "can't change cust_location field $_"; + } } - $error || ''; + $self->SUPER::replace($old); } @@ -171,6 +172,7 @@ and replace methods. #fields anyway... sub check { my $self = shift; + my $conf = new FS::Conf; my $error = $self->ut_numbern('locationnum') @@ -182,7 +184,7 @@ sub check { || $self->ut_textn('county') || $self->ut_textn('state') || $self->ut_country('country') - || $self->ut_zip('zip', $self->country) + || (!$import && $self->ut_zip('zip', $self->country)) || $self->ut_coordn('latitude') || $self->ut_coordn('longitude') || $self->ut_enum('coord_auto', [ '', 'Y' ]) @@ -192,19 +194,36 @@ sub check { || $self->ut_enum('location_kind', [ '', 'R', 'B' ] ) || $self->ut_alphan('geocode') || $self->ut_alphan('district') + || $self->ut_numbern('censusyear') ; return $error if $error; + if ( $self->censustract ne '' ) { + $self->censustract =~ /^\s*(\d{9})\.?(\d{2})\s*$/ + or return "Illegal census tract: ". $self->censustract; + + $self->censustract("$1.$2"); + } + + if ( $conf->exists('cust_main-require_address2') and + !$self->ship_address2 =~ /\S/ ) { + return "Unit # is required"; + } + + $self->set_coord + unless $import || ($self->latitude && $self->longitude); - return "No prospect or customer!" unless $self->prospectnum || $self->custnum; + # tricky...we have to allow for the customer to not be inserted yet + return "No prospect or customer!" unless $self->prospectnum + || $self->custnum + || $self->get('custnum_pending'); return "Prospect and customer!" if $self->prospectnum && $self->custnum; - my $conf = new FS::Conf; return 'Location kind is required' if $self->prospectnum && $conf->exists('prospect_main-alt_address_format') && ! $self->location_kind; - unless ( qsearch('cust_main_county', { + unless ( $import or qsearch('cust_main_county', { 'country' => $self->country, 'state' => '', } ) ) { @@ -261,19 +280,40 @@ location_kind. =cut -=item move_to HASHREF +=item disable_if_unused + +Sets the "disabled" flag on the location if it is no longer in use as a +prospect location, package location, or a customer's billing or default +service address. + +=cut + +sub disable_if_unused { + + my $self = shift; + my $locationnum = $self->locationnum; + return '' if FS::cust_main->count('bill_locationnum = '.$locationnum) + or FS::cust_main->count('ship_locationnum = '.$locationnum) + or FS::contact->count( 'locationnum = '.$locationnum) + or FS::cust_pkg->count('cancel IS NULL AND + locationnum = '.$locationnum) + ; + $self->disabled('Y'); + $self->replace; + +} + +=item move_to -Takes a hashref with one or more cust_location fields. Creates a duplicate -of the existing location with all fields set to the values in the hashref. -Moves all packages that use the existing location to the new one, then sets -the "disabled" flag on the old location. Returns nothing on success, an -error message on error. +Takes a new L<FS::cust_location> object. Moves all packages that use the +existing location to the new one, then sets the "disabled" flag on the old +location. Returns nothing on success, an error message on error. =cut sub move_to { my $old = shift; - my $hashref = shift; + my $new = shift; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -287,16 +327,12 @@ sub move_to { my $dbh = dbh; my $error = ''; - my $new = FS::cust_location->new({ - $old->location_hash, - 'custnum' => $old->custnum, - 'prospectnum' => $old->prospectnum, - %$hashref - }); - $error = $new->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Error creating location: $error"; + if ( !$new->locationnum ) { + $error = $new->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error creating location: $error"; + } } my @pkgs = qsearch('cust_pkg', { @@ -314,15 +350,14 @@ sub move_to { } } - $old->disabled('Y'); - $error = $old->replace; + $error = $old->disable_if_unused; if ( $error ) { $dbh->rollback if $oldAutoCommit; return "Error disabling old location: $error"; } $dbh->commit if $oldAutoCommit; - return; + ''; } =item alternize @@ -403,11 +438,100 @@ sub dealternize { ''; } +=item location_label + +Returns the label of the location object, with an optional site ID +string (based on the cust_location-label_prefix config option). + +=cut + +sub location_label { + my $self = shift; + my %opt = @_; + my $conf = new FS::Conf; + my $prefix = ''; + my $format = $conf->config('cust_location-label_prefix') || ''; + my $cust_or_prospect; + if ( $self->custnum ) { + $cust_or_prospect = FS::cust_main->by_key($self->custnum); + } + elsif ( $self->prospectnum ) { + $cust_or_prospect = FS::prospect_main->by_key($self->prospectnum); + } + + if ( $format eq 'CoStAg' ) { + my $agent = $conf->config('cust_main-custnum-display_prefix', + $cust_or_prospect->agentnum) + || $cust_or_prospect->agent->agent; + # else this location is invalid + $prefix = uc( join('', + $self->country, + ($self->state =~ /^(..)/), + ($agent =~ /^(..)/), + sprintf('%05d', $self->locationnum) + ) ); + } + elsif ( $self->custnum and + $self->locationnum == $cust_or_prospect->ship_locationnum ) { + $prefix = 'Default service location'; + } + $prefix .= ($opt{join_string} || ': ') if $prefix; + $prefix . $self->SUPER::location_label(%opt); +} + =back -=head1 BUGS +=head1 CLASS METHODS + +=item in_county_sql OPTIONS + +Returns an SQL expression to test membership in a cust_main_county +geographic area. By default, this requires district, city, county, +state, and country to match exactly. Pass "ornull => 1" to allow +partial matches where some fields are NULL in the cust_main_county +record but not in the location. + +Pass "param => 1" to receive a parameterized expression (rather than +one that requires a join to cust_main_county) and a list of parameter +names in order. -Not yet used for cust_main billing and shipping addresses. +=cut + +sub in_county_sql { + # replaces FS::cust_pkg::location_sql + my ($class, %opt) = @_; + my $ornull = $opt{ornull} ? ' OR ? IS NULL' : ''; + my $x = $ornull ? 3 : 2; + my @fields = (('district') x 3, + ('city') x 3, + ('county') x $x, + ('state') x $x, + 'country'); + + my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text'; + + my @where = ( + "cust_location.district = ? OR ? = '' OR CAST(? AS $text) IS NULL", + "cust_location.city = ? OR ? = '' OR CAST(? AS $text) IS NULL", + "cust_location.county = ? OR (? = '' AND cust_location.county IS NULL) $ornull", + "cust_location.state = ? OR (? = '' AND cust_location.state IS NULL ) $ornull", + "cust_location.country = ?" + ); + my $sql = join(' AND ', map "($_)\n", @where); + if ( $opt{param} ) { + return $sql, @fields; + } + else { + # do the substitution here + foreach (@fields) { + $sql =~ s/\?/cust_main_county.$_/; + $sql =~ s/cust_main_county.$_ = ''/cust_main_county.$_ IS NULL/; + } + return $sql; + } +} + +=head1 BUGS =head1 SEE ALSO diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index d45e6ece6..321349e9a 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -4,17 +4,19 @@ require 5.006; use strict; #FS::cust_main:_Marketgear when they're ready to move to 2.1 use base qw( FS::cust_main::Packages FS::cust_main::Status + FS::cust_main::NationalID FS::cust_main::Billing FS::cust_main::Billing_Realtime FS::cust_main::Billing_Discount + FS::cust_main::Location FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin - FS::geocode_Mixin + FS::geocode_Mixin FS::Quotable_Mixin FS::o2m_Common FS::Record ); use vars qw( $DEBUG $me $conf @encrypted_fields $import - $ignore_expired_card $ignore_illegal_zip $ignore_banned_card + $ignore_expired_card $ignore_banned_card $ignore_illegal_zip $skip_fuzzyfiles @paytypes ); @@ -41,6 +43,7 @@ use FS::payby; use FS::cust_pkg; use FS::cust_svc; use FS::cust_bill; +use FS::cust_bill_void; use FS::legacy_cust_bill; use FS::cust_pay; use FS::cust_pay_pending; @@ -71,6 +74,7 @@ use FS::cust_main_note; use FS::cust_attachment; use FS::contact; use FS::Locales; +use FS::upgrade_journal; # 1 is mostly method/subroutine entry and options # 2 traces progress of some operations @@ -80,7 +84,6 @@ $me = '[FS::cust_main]'; $import = 0; $ignore_expired_card = 0; -$ignore_illegal_zip = 0; $ignore_banned_card = 0; $skip_fuzzyfiles = 0; @@ -178,28 +181,6 @@ Cocial security number (optional) (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) @@ -216,56 +197,6 @@ phone (optional) phone (optional) -=item ship_first - -Shipping first name - -=item ship_last - -Shipping 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 ship_mobile - -phone (optional) - =item payby Payment Type (See L<FS::payinfo_Mixin> for valid payby values) @@ -364,6 +295,12 @@ sub table { 'cust_main'; } Adds this customer to the database. If there is an error, returns the error, otherwise returns false. +Usually the customer's location will not yet exist in the database, and +the C<bill_location> and C<ship_location> pseudo-fields must be set to +uninserted L<FS::cust_location> objects. These will be inserted and linked +(in both directions) to the new customer record. If they're references +to the same object, they will become the same location. + 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 @@ -399,8 +336,9 @@ 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.) -The I<tax_exemption> option can be set to an arrayref of tax names. -FS::cust_main_exemption records will be created and inserted. +The I<tax_exemption> option can be set to an arrayref of tax names or a hashref +of tax names and exemption numbers. FS::cust_main_exemption records will be +created and inserted. If I<prospectnum> is set, moves contacts and locations from that prospect. @@ -461,13 +399,47 @@ sub insert { } + # insert locations + foreach my $l (qw(bill_location ship_location)) { + my $loc = delete $self->hashref->{$l}; + # XXX if we're moving a prospect's locations, do that here + if ( !$loc ) { + return "$l not set"; + } + + if ( !$loc->locationnum ) { + # warn the location that we're going to insert it with no custnum + $loc->set(custnum_pending => 1); + warn " inserting $l\n" + if $DEBUG > 1; + my $error = $loc->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + my $label = $l eq 'ship_location' ? 'service' : 'billing'; + return "$error (in $label location)"; + } + } + elsif ( ($loc->custnum || 0) > 0 or $loc->prospectnum ) { + # then it somehow belongs to another customer--shouldn't happen + $dbh->rollback if $oldAutoCommit; + return "$l belongs to customer ".$loc->custnum; + } + # else it already belongs to this customer + # (happens when ship_location is identical to bill_location) + + $self->set($l.'num', $loc->locationnum); + + if ( $self->get($l.'num') eq '' ) { + $dbh->rollback if $oldAutoCommit; + return "$l not set"; + } + } + warn " inserting $self\n" if $DEBUG > 1; $self->signupdate(time) unless $self->signupdate; - $self->censusyear($conf->config('census_year')||'2012') if $self->censustract; - $self->auto_agent_custid() if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid; @@ -478,6 +450,22 @@ sub insert { return $error; } + # now set cust_location.custnum + foreach my $l (qw(bill_location ship_location)) { + warn " setting $l.custnum\n" + if $DEBUG > 1; + my $loc = $self->$l; + unless ( $loc->custnum ) { + $loc->set(custnum => $self->custnum); + $error ||= $loc->replace; + } + + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error setting $l custnum: $error"; + } + } + warn " setting invoicing list\n" if $DEBUG > 1; @@ -545,10 +533,15 @@ sub insert { my $tax_exemption = delete $options{'tax_exemption'}; if ( $tax_exemption ) { - foreach my $taxname ( @$tax_exemption ) { + + $tax_exemption = { map { $_ => '' } @$tax_exemption } + if ref($tax_exemption) eq 'ARRAY'; + + foreach my $taxname ( keys %$tax_exemption ) { my $cust_main_exemption = new FS::cust_main_exemption { - 'custnum' => $self->custnum, - 'taxname' => $taxname, + 'custnum' => $self->custnum, + 'taxname' => $taxname, + 'exempt_number' => $tax_exemption->{$taxname}, }; my $error = $cust_main_exemption->insert; if ( $error ) { @@ -1253,9 +1246,12 @@ sub merge { return "Can't merge a customer into self" if $self->custnum == $new_custnum; - unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) { - return "Invalid new customer number: $new_custnum"; - } + my $new_cust_main = qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) + or return "Invalid new customer number: $new_custnum"; + + return 'Access denied: "Merge customer across agents" access right required to merge into a customer of a different agent' + if $self->agentnum != $new_cust_main->agentnum + && ! $FS::CurrentUser::CurrentUser->access_right('Merge customer across agents'); local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -1290,6 +1286,7 @@ sub merge { tie my %financial_tables, 'Tie::IxHash', 'cust_bill' => 'invoices', + 'cust_bill_void' => 'voided invoices', 'cust_statement' => 'statements', 'cust_credit' => 'credits', 'cust_pay' => 'payments', @@ -1312,7 +1309,7 @@ sub merge { } - my $name = $self->ship_name; + my $name = $self->ship_name; #? my $locationnum = ''; foreach my $cust_pkg ( $self->all_pkgs ) { @@ -1448,10 +1445,13 @@ sub merge { =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ] - Replaces the OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. +To change the customer's address, set the pseudo-fields C<bill_location> and +C<ship_location>. The address will still only change if at least one of the +address fields differs from the existing values. + 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 @@ -1461,8 +1461,9 @@ check_invoicing_list first. Here's an example: Currently available options are: I<tax_exemption>. -The I<tax_exemption> option can be set to an arrayref of tax names. -FS::cust_main_exemption records will be deleted and inserted as appropriate. +The I<tax_exemption> option can be set to an arrayref of tax names or a hashref +of tax names and exemption numbers. FS::cust_main_exemption records will be +deleted and inserted as appropriate. =cut @@ -1487,16 +1488,19 @@ sub replace { return "You are not permitted to create complimentary accounts."; } - if ( $old->get('geocode') && $old->get('geocode') eq $self->get('geocode') - && $conf->exists('enable_taxproducts') - ) - { - my $pre = ($conf->exists('tax-ship_address') && $self->ship_zip) - ? 'ship_' : ''; - $self->set('geocode', '') - if $old->get($pre.'zip') ne $self->get($pre.'zip') - && length($self->get($pre.'zip')) >= 10; - } + # should be unnecessary--geocode will default to null on new locations + #if ( $old->get('geocode') && $old->get('geocode') eq $self->get('geocode') + # && $conf->exists('enable_taxproducts') + # ) + #{ + # my $pre = ($conf->exists('tax-ship_address') && $self->ship_zip) + # ? 'ship_' : ''; + # $self->set('geocode', '') + # if $old->get($pre.'zip') ne $self->get($pre.'zip') + # && length($self->get($pre.'zip')) >= 10; + #} + + # set_coord/coord_auto stuff is now handled by cust_location local($ignore_expired_card) = 1 if $old->payby =~ /^(CARD|DCRD)$/ @@ -1508,11 +1512,10 @@ sub replace { || $old->payby =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ ) && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask ); - if ( $self->censustract ne '' and $self->censustract ne $old->censustract ) { - # update censusyear whenever tract code changes - $self->censusyear($conf->config('census_year')||'2012'); - } - + return "Invoicing locale is required" + if $old->locale + && ! $self->locale + && $conf->exists('cust_main-require_locale'); local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -1525,6 +1528,47 @@ sub replace { local $FS::UID::AutoCommit = 0; my $dbh = dbh; + for my $l (qw(bill_location ship_location)) { + my $old_loc = $old->$l; + my $new_loc = $self->$l; + + if ( !$new_loc->locationnum ) { + # changing location + # If the new location is all empty fields, or if it's identical to + # the old location in all fields, don't replace. + my @nonempty = grep { $new_loc->$_ } $self->location_fields; + next if !@nonempty; + my @unlike = grep { $new_loc->$_ ne $old_loc->$_ } $self->location_fields; + + if ( @unlike or $old_loc->disabled ) { + warn " changed $l fields: ".join(',',@unlike)."\n" + if $DEBUG; + $new_loc->set(custnum => $self->custnum); + + # insert it--the old location will be disabled later + my $error = $new_loc->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + } else { + # no fields have changed and $old_loc isn't disabled, so don't change it + next; + } + + } + elsif ( $new_loc->custnum ne $self->custnum or $new_loc->prospectnum ) { + $dbh->rollback if $oldAutoCommit; + return "$l belongs to customer ".$new_loc->custnum; + } + # else the new location belongs to this customer so we're good + + # set the foo_locationnum now that we have one. + $self->set($l.'num', $new_loc->locationnum); + + } #for $l + my $error = $self->SUPER::replace($old); if ( $error ) { @@ -1532,6 +1576,27 @@ sub replace { return $error; } + # now move packages to the new service location + $self->set('ship_location', ''); #flush cache + if ( $old->ship_locationnum and # should only be null during upgrade... + $old->ship_locationnum != $self->ship_locationnum ) { + $error = $old->ship_location->move_to($self->ship_location); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + # don't move packages based on the billing location, but + # disable it if it's no longer in use + if ( $old->bill_locationnum and + $old->bill_locationnum != $self->bill_locationnum ) { + $error = $old->bill_location->disable_if_unused; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF my $invoicing_list = shift @param; $error = $self->check_invoicing_list( $invoicing_list ); @@ -1569,17 +1634,27 @@ sub replace { my $tax_exemption = delete $options{'tax_exemption'}; if ( $tax_exemption ) { + $tax_exemption = { map { $_ => '' } @$tax_exemption } + if ref($tax_exemption) eq 'ARRAY'; + my %cust_main_exemption = map { $_->taxname => $_ } qsearch('cust_main_exemption', { 'custnum' => $old->custnum } ); - foreach my $taxname ( @$tax_exemption ) { + foreach my $taxname ( keys %$tax_exemption ) { - next if delete $cust_main_exemption{$taxname}; + if ( $cust_main_exemption{$taxname} && + $cust_main_exemption{$taxname}->exempt_number eq $tax_exemption->{$taxname} + ) + { + delete $cust_main_exemption{$taxname}; + next; + } my $cust_main_exemption = new FS::cust_main_exemption { - 'custnum' => $self->custnum, - 'taxname' => $taxname, + 'custnum' => $self->custnum, + 'taxname' => $taxname, + 'exempt_number' => $tax_exemption->{$taxname}, }; my $error = $cust_main_exemption->insert; if ( $error ) { @@ -1623,24 +1698,7 @@ sub replace { } } - # FS::geocode_Mixin::after_replace ? - # though this will go away anyway once we move customer bill/service - # locations into cust_location - # We can trigger this on any address change--just have to make sure - # not to trigger it on itself. - if ( $conf->config('tax_district_method') and !$import - and ( $self->get('ship_address1') ne $old->get('ship_address1') - or $self->get('address1') ne $old->get('address1') ) ) { - my $queue = new FS::queue { - 'job' => 'FS::geocode_Mixin::process_district_update', - 'custnum' => $self->custnum, - }; - my $error = $queue->insert( ref($self), $self->custnum ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing tax district update: $error"; - } - } + # tax district update in cust_location # cust_main exports! @@ -1685,16 +1743,14 @@ sub queue_fuzzyfiles_update { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $queue = new FS::queue { 'job' => 'FS::cust_main::Search::append_fuzzyfiles' }; - my $error = $queue->insert( map $self->getfield($_), @FS::cust_main::Search::fuzzyfields ); - 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::Search::append_fuzzyfiles' }; - $error = $queue->insert( map $self->getfield("ship_$_"), @FS::cust_main::Search::fuzzyfields ); + my @locations = $self->bill_location; + push @locations, $self->ship_location if $self->has_ship_address; + foreach my $location (@locations) { + my $queue = new FS::queue { + 'job' => 'FS::cust_main::Search::append_fuzzyfiles' + }; + my @args = map $location->get($_), @FS::cust_main::Search::fuzzyfields; + my $error = $queue->insert( @args ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "queueing job (transaction rolled back): $error"; @@ -1725,13 +1781,19 @@ sub check { || $self->ut_number('agentnum') || $self->ut_textn('agent_custid') || $self->ut_number('refnum') + || $self->ut_foreign_key('bill_locationnum', 'cust_location','locationnum') + || $self->ut_foreign_key('ship_locationnum', 'cust_location','locationnum') || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum') || $self->ut_textn('custbatch') || $self->ut_name('last') || $self->ut_name('first') - || $self->ut_snumbern('birthdate') || $self->ut_snumbern('signupdate') + || $self->ut_snumbern('birthdate') + || $self->ut_snumbern('spouse_birthdate') + || $self->ut_snumbern('anniversary_date') || $self->ut_textn('company') +<<<<<<< HEAD +======= || $self->ut_text('address1') || $self->ut_textn('address2') || $self->ut_text('city') @@ -1743,18 +1805,19 @@ sub check { || $self->ut_enum('coord_auto', [ '', 'Y' ]) || $self->ut_enum('addr_clean', [ '', 'Y' ]) || $self->ut_numbern('censusyear') +>>>>>>> 13763 || $self->ut_anything('comments') || $self->ut_numbern('referral_custnum') || $self->ut_textn('stateid') || $self->ut_textn('stateid_state') || $self->ut_textn('invoice_terms') - || $self->ut_alphan('geocode') - || $self->ut_alphan('district') || $self->ut_floatn('cdr_termination_percentage') || $self->ut_floatn('credit_limit') || $self->ut_numbern('billday') + || $self->ut_numbern('prorate_day') || $self->ut_enum('edit_subject', [ '', 'Y' ] ) || $self->ut_enum('calling_list_exempt', [ '', 'Y' ] ) + || $self->ut_enum('invoice_noemail', [ '', 'Y' ] ) || $self->ut_enum('locale', [ '', FS::Locales->locales ]) ; @@ -1773,13 +1836,6 @@ sub check { unless ! $self->referral_custnum || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } ); - if ( $self->censustract ne '' ) { - $self->censustract =~ /^\s*(\d{9})\.?(\d{2})\s*$/ - or return "Illegal census tract: ". $self->censustract; - - $self->censustract("$1.$2"); - } - if ( $self->ss eq '' ) { $self->ss(''); } else { @@ -1790,23 +1846,7 @@ sub check { $self->ss("$1-$2-$3"); } - -# bad idea to disable, causes billing to fail because of no tax rates later -# except we don't fail any more - 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, - } ); - } - } + # cust_main_county verification now handled by cust_location check $error = $self->ut_phonen('daytime', $self->country) @@ -1816,12 +1856,8 @@ sub check { ; return $error if $error; - unless ( $ignore_illegal_zip ) { - $error = $self->ut_zip('zip', $self->country); - return $error if $error; - } - if ( $conf->exists('cust_main-require_phone', $self->agentnum) + && ! $import && ! length($self->daytime) && ! length($self->night) && ! length($self->mobile) ) { @@ -1840,6 +1876,9 @@ sub check { } +<<<<<<< HEAD + #ship_ fields are gone +======= if ( $self->has_ship_address && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") } $self->addr_fields ) @@ -1902,6 +1941,7 @@ sub check { && $conf->exists('cust_main-require_address2'); } +>>>>>>> 13763 #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/ # or return "Illegal payby: ". $self->payby; @@ -1927,7 +1967,9 @@ sub check { # check the credit card. my $check_payinfo = ! $self->is_encrypted($self->payinfo); - if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) { + # Need some kind of global flag to accept invalid cards, for testing + # on scrubbed data. + if ( !$import && $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) { my $payinfo = $self->payinfo; $payinfo =~ s/\D//g; @@ -2109,6 +2151,11 @@ sub check { $self->payname($1); } + return "Please select an invoicing locale" + if ! $self->locale + && ! $self->custnum + && $conf->exists('cust_main-require_locale'); + foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) { $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag(); $self->$flag($1); @@ -2144,7 +2191,7 @@ Returns true if this customer record has a separate shipping address. sub has_ship_address { my $self = shift; - scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields ); + $self->bill_locationnum != $self->ship_locationnum; } =item location_hash @@ -2155,6 +2202,11 @@ shipping address is used if present. =cut +sub location_hash { + my $self = shift; + $self->ship_location->location_hash; +} + =item cust_location Returns all locations (see L<FS::cust_location>) for this customer. @@ -2163,7 +2215,8 @@ Returns all locations (see L<FS::cust_location>) for this customer. sub cust_location { my $self = shift; - qsearch('cust_location', { 'custnum' => $self->custnum } ); + qsearch('cust_location', { 'custnum' => $self->custnum, + 'prospectnum' => '' } ); } =item cust_contact @@ -2500,6 +2553,25 @@ Adds a payment for this invoice to the pending credit card batch (see L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value, runs the payment using a realtime gateway. +Options may include: + +B<amount>: the amount to be paid; defaults to the customer's balance minus +any payments in transit. + +B<payby>: the payment method; defaults to cust_main.payby + +B<realtime>: runs this as a realtime payment instead of adding it to a +batch. Deprecated. + +B<invnum>: sets cust_pay_batch.invnum. + +B<address1>, B<address2>, B<city>, B<state>, B<zip>, B<country>: sets +the billing address for the payment; defaults to the customer's billing +location. + +B<payinfo>, B<paydate>, B<payname>: sets the payment account, expiration +date, and name; defaults to those fields in cust_main. + =cut sub batch_card { @@ -2560,6 +2632,8 @@ sub batch_card { $options{$_} = '' unless exists($options{$_}); } + my $loc = $self->bill_location; + my $cust_pay_batch = new FS::cust_pay_batch ( { 'batchnum' => $pay_batch->batchnum, 'invnum' => $invnum || 0, # is there a better value? @@ -2569,12 +2643,12 @@ sub batch_card { 'custnum' => $self->custnum, 'last' => $self->getfield('last'), 'first' => $self->getfield('first'), - 'address1' => $options{address1} || $self->address1, - 'address2' => $options{address2} || $self->address2, - 'city' => $options{city} || $self->city, - 'state' => $options{state} || $self->state, - 'zip' => $options{zip} || $self->zip, - 'country' => $options{country} || $self->country, + 'address1' => $options{address1} || $loc->address1, + 'address2' => $options{address2} || $loc->address2, + 'city' => $options{city} || $loc->city, + 'state' => $options{state} || $loc->state, + 'zip' => $options{zip} || $loc->zip, + 'country' => $options{country} || $loc->country, 'payby' => $options{payby} || $self->payby, 'payinfo' => $options{payinfo} || $self->payinfo, 'exp' => $options{paydate} || $self->paydate, @@ -2970,7 +3044,8 @@ sub payment_info { $return{payname} = $self->payname || ( $self->first. ' '. $self->get('last') ); - $return{$_} = $self->get($_) for qw(address1 address2 city state zip); + $return{$_} = $self->bill_location->$_ + for qw(address1 address2 city state zip); $return{payby} = $self->payby; $return{stateid_state} = $self->stateid_state; @@ -3659,6 +3734,20 @@ be passed. =cut +=item cust_bill_void + +Returns all the voided invoices (see L<FS::cust_bill_void>) for this customer. + +=cut + +sub cust_bill_void { + my $self = shift; + + map { $_ } #return $self->num_cust_bill_void unless wantarray; + sort { $a->_date <=> $b->_date } + qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } ) +} + sub cust_statement { my $self = shift; my $opt = ref($_[0]) ? shift : { @_ }; @@ -3815,7 +3904,7 @@ sub cust_pay_void { =item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ] -Returns all batched payments (see L<FS::cust_pay_void>) for this customer. +Returns all batched payments (see L<FS::cust_pay_batch>) for this customer. Optionally, a list or hashref of additional arguments to the qsearch call can be passed. @@ -3980,6 +4069,27 @@ sub name { $name; } +=item service_contact + +Returns the L<FS::contact> object for this customer that has the 'Service' +contact class, or undef if there is no such contact. Deprecated; don't use +this in new code. + +=cut + +sub service_contact { + my $self = shift; + if ( !exists($self->{service_contact}) ) { + my $classnum = $self->scalar_sql( + 'SELECT classnum FROM contact_class WHERE classname = \'Service\'' + ) || 0; #if it's zero, qsearchs will return nothing + $self->{service_contact} = qsearchs('contact', { + 'classnum' => $classnum, 'custnum' => $self->custnum + }) || undef; + } + $self->{service_contact}; +} + =item ship_name Returns a name string for this (service/shipping) contact, either @@ -3989,13 +4099,10 @@ Returns a name string for this (service/shipping) contact, either 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; - } + + my $name = $self->ship_contact; + $name = $self->company. " ($name)" if $self->company; + $name; } =item name_short @@ -4018,13 +4125,9 @@ or "First Last". sub ship_name_short { my $self = shift; - if ( $self->get('ship_last') ) { - $self->ship_company !~ /^\s*$/ - ? $self->ship_company - : $self->ship_contact_firstlast; - } else { - $self->name_company_or_firstlast; - } + $self->service_contact + ? $self->ship_contact_firstlast + : $self->name_short } =item contact @@ -4046,9 +4149,8 @@ Returns this customer's full (shipping) contact name only, "Last, First" sub ship_contact { my $self = shift; - $self->get('ship_last') - ? $self->get('ship_last'). ', '. $self->ship_first - : $self->contact; + my $contact = $self->service_contact || $self; + $contact->get('last') . ', ' . $contact->get('first'); } =item contact_firstlast @@ -4070,9 +4172,8 @@ Returns this customer's full (shipping) contact name only, "First Last". sub ship_contact_firstlast { my $self = shift; - $self->get('ship_last') - ? $self->first. ' '. $self->get('ship_last') - : $self->contact_firstlast; + my $contact = $self->service_contact || $self; + $contact->get('first') . ' '. $contact->get('last'); } =item country_full @@ -5047,39 +5148,71 @@ sub process_censustract_update { return; } +#starting to take quite a while for big dbs +# - seq scan of h_cust_main (yuck), but not going to index paycvv, so +# - seq scan of cust_main on signupdate... index signupdate? will that help? +# - seq scan of cust_main on paydate... index on substrings? maybe set an +# upgrade journal flag now that we have that, yyyy-m-dd paydates are ancient +# - seq scan of cust_main on payinfo.. certainly not going toi ndex that... +# upgrade journal again? this is also an ancient problem +# - otaker upgrade? journal and call it good? (double check to make sure +# we're not still setting otaker here) +# +#only going to get worse with new location stuff... + sub _upgrade_data { #class method my ($class, %opts) = @_; my @statements = ( 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL', - 'UPDATE cust_main SET signupdate = (SELECT signupdate FROM h_cust_main WHERE signupdate IS NOT NULL AND h_cust_main.custnum = cust_main.custnum ORDER BY historynum DESC LIMIT 1) WHERE signupdate IS NULL', ); - # fix yyyy-m-dd formatted paydates - if ( driver_name =~ /^mysql/i ) { + + #this seems to be the only expensive one.. why does it take so long? + unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) { push @statements, - "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'"; + 'UPDATE cust_main SET signupdate = (SELECT signupdate FROM h_cust_main WHERE signupdate IS NOT NULL AND h_cust_main.custnum = cust_main.custnum ORDER BY historynum DESC LIMIT 1) WHERE signupdate IS NULL'; + FS::upgrade_journal->set_done('cust_main__signupdate'); } - else { # the SQL standard - push @statements, - "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'"; + + unless ( FS::upgrade_journal->is_done('cust_main__paydate') ) { + + # fix yyyy-m-dd formatted paydates + if ( driver_name =~ /^mysql/i ) { + push @statements, + "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'"; + } else { # the SQL standard + push @statements, + "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'"; + } + FS::upgrade_journal->set_done('cust_main__paydate'); } - push @statements, #fix the weird BILL with a cc# in payinfo problem - #DCRD to be safe - "UPDATE cust_main SET payby = 'DCRD' WHERE payby = 'BILL' and length(payinfo) = 16 and payinfo ". regexp_sql. q( '^[0-9]*$' ); + unless ( FS::upgrade_journal->is_done('cust_main__payinfo') ) { + push @statements, #fix the weird BILL with a cc# in payinfo problem + #DCRD to be safe + "UPDATE cust_main SET payby = 'DCRD' WHERE payby = 'BILL' and length(payinfo) = 16 and payinfo ". regexp_sql. q( '^[0-9]*$' ); + + FS::upgrade_journal->set_done('cust_main__payinfo'); + + } + + my $t = time; foreach my $sql ( @statements ) { my $sth = dbh->prepare($sql) or die dbh->errstr; $sth->execute or die $sth->errstr; + #warn ( (time - $t). " seconds\n" ); + #$t = time; } local($ignore_expired_card) = 1; - local($ignore_illegal_zip) = 1; local($ignore_banned_card) = 1; local($skip_fuzzyfiles) = 1; local($import) = 1; #prevent automatic geocoding (need its own variable?) $class->_upgrade_otaker(%opts); + FS::cust_main::Location->_upgrade_data(%opts); + } =back diff --git a/FS/FS/cust_main/Billing.pm b/FS/FS/cust_main/Billing.pm index 0a557fca2..11247a28f 100644 --- a/FS/FS/cust_main/Billing.pm +++ b/FS/FS/cust_main/Billing.pm @@ -721,6 +721,11 @@ jurisdictions (i.e. Texas) have tax exemptions which are date sensitive. sub calculate_taxes { my ($self, $cust_bill_pkg, $taxlisthash, $invoice_time) = @_; + # $taxlisthash is a hashref + # keys are identifiers, values are arrayrefs + # each arrayref starts with a tax object (cust_main_county or tax_rate) + # then any cust_bill_pkg objects the tax applies to + local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG; warn "$me calculate_taxes\n" @@ -730,32 +735,52 @@ sub calculate_taxes { my @tax_line_items = (); # keys are tax names (as printed on invoices / itemdesc ) - # values are listrefs of taxlisthash keys (internal identifiers) + # values are arrayrefs of taxlisthash keys (internal identifiers) my %taxname = (); # keys are taxlisthash keys (internal identifiers) # values are (cumulative) amounts - my %tax = (); + my %tax_amount = (); # keys are taxlisthash keys (internal identifiers) - # values are listrefs of cust_bill_pkg_tax_location hashrefs + # values are arrayrefs of cust_bill_pkg_tax_location hashrefs my %tax_location = (); # keys are taxlisthash keys (internal identifiers) - # values are listrefs of cust_bill_pkg_tax_rate_location hashrefs + # values are arrayrefs of cust_bill_pkg_tax_rate_location hashrefs my %tax_rate_location = (); + # keys are taxnums (not internal identifiers!) + # values are arrayrefs of cust_tax_exempt_pkg objects + my %tax_exemption; + foreach my $tax ( keys %$taxlisthash ) { + # $tax is a tax identifier my $tax_object = shift @{ $taxlisthash->{$tax} }; + # $tax_object is a cust_main_county or tax_rate + # (with pkgnum and locationnum set) + # the rest of @{ $taxlisthash->{$tax} } is cust_bill_pkg objects warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2; warn " ". join('/', @{ $taxlisthash->{$tax} } ). "\n" if $DEBUG > 2; + # taxline calculates the tax on all cust_bill_pkgs in the + # first (arrayref) argument, and returns a hashref of 'name' + # (the line item description) and 'amount'. + # It also calculates exemptions and attaches them to the cust_bill_pkgs + # in the argument. + my $taxables = $taxlisthash->{$tax}; + my $exemptions = $tax_exemption{$tax_object->taxnum} ||= []; my $hashref_or_error = - $tax_object->taxline( $taxlisthash->{$tax}, + $tax_object->taxline( $taxables, 'custnum' => $self->custnum, - 'invoice_time' => $invoice_time + 'invoice_time' => $invoice_time, + 'exemptions' => $exemptions, ); return $hashref_or_error unless ref($hashref_or_error); + # then collect any new exemptions generated for this tax + push @$exemptions, @{ $_->cust_tax_exempt_pkg } + foreach @$taxables; + unshift @{ $taxlisthash->{$tax} }, $tax_object; my $name = $hashref_or_error->{'name'}; @@ -765,10 +790,12 @@ sub calculate_taxes { $taxname{ $name } ||= []; push @{ $taxname{ $name } }, $tax; - $tax{ $tax } += $amount; + $tax_amount{ $tax } += $amount; + # link records between cust_main_county/tax_rate and cust_location $tax_location{ $tax } ||= []; - if ( $tax_object->get('pkgnum') || $tax_object->get('locationnum') ) { + $tax_rate_location{ $tax } ||= []; + if ( ref($tax_object) eq 'FS::cust_main_county' ) { push @{ $tax_location{ $tax } }, { 'taxnum' => $tax_object->taxnum, @@ -778,9 +805,7 @@ sub calculate_taxes { 'amount' => sprintf('%.2f', $amount ), }; } - - $tax_rate_location{ $tax } ||= []; - if ( ref($tax_object) eq 'FS::tax_rate' ) { + elsif ( ref($tax_object) eq 'FS::tax_rate' ) { my $taxratelocationnum = $tax_object->tax_rate_location->taxratelocationnum; push @{ $tax_rate_location{ $tax } }, @@ -798,17 +823,21 @@ sub calculate_taxes { #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit my %packagemap = map { $_->pkgnum => $_ } @$cust_bill_pkg; foreach my $tax ( keys %$taxlisthash ) { - foreach ( @{ $taxlisthash->{$tax} }[1 ... scalar(@{ $taxlisthash->{$tax} })] ) { - next unless ref($_) eq 'FS::cust_bill_pkg'; - - my @cust_tax_exempt_pkg = splice( @{ $_->_cust_tax_exempt_pkg } ); + my $taxables = $taxlisthash->{$tax}; + my $tax_object = shift @$taxables; # the rest are line items + foreach my $cust_bill_pkg ( @$taxables ) { + next unless ref($cust_bill_pkg) eq 'FS::cust_bill_pkg'; - next unless @cust_tax_exempt_pkg; #just avoiding the prob when irrelevant? - die "can't distribute tax exemptions: no line item for ". Dumper($_). - " in packagemap ". join(',', sort {$a<=>$b} keys %packagemap). "\n" - unless $packagemap{$_->pkgnum}; + my @cust_tax_exempt_pkg = splice @{ $cust_bill_pkg->cust_tax_exempt_pkg }; - push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg }, + next unless @cust_tax_exempt_pkg; + # get the non-disintegrated version + my $real_cust_bill_pkg = $packagemap{$cust_bill_pkg->pkgnum} + or die "can't distribute tax exemptions: no line item for ". + Dumper($_). " in packagemap ". + join(',', sort {$a<=>$b} keys %packagemap). "\n"; + + push @{ $real_cust_bill_pkg->cust_tax_exempt_pkg }, @cust_tax_exempt_pkg; } } @@ -816,15 +845,15 @@ sub calculate_taxes { #consolidate and create tax line items warn "consolidating and generating...\n" if $DEBUG > 2; foreach my $taxname ( keys %taxname ) { - my $tax = 0; + my $tax_total = 0; my %seen = (); my @cust_bill_pkg_tax_location = (); my @cust_bill_pkg_tax_rate_location = (); warn "adding $taxname\n" if $DEBUG > 1; foreach my $taxitem ( @{ $taxname{$taxname} } ) { next if $seen{$taxitem}++; - warn "adding $tax{$taxitem}\n" if $DEBUG > 1; - $tax += $tax{$taxitem}; + warn "adding $tax_amount{$taxitem}\n" if $DEBUG > 1; + $tax_total += $tax_amount{$taxitem}; push @cust_bill_pkg_tax_location, map { new FS::cust_bill_pkg_tax_location $_ } @{ $tax_location{ $taxitem } }; @@ -832,9 +861,9 @@ sub calculate_taxes { map { new FS::cust_bill_pkg_tax_rate_location $_ } @{ $tax_rate_location{ $taxitem } }; } - next unless $tax; + next unless $tax_total; - $tax = sprintf('%.2f', $tax ); + $tax_total = sprintf('%.2f', $tax_total ); my $pkg_category = qsearchs( 'pkg_category', { 'categoryname' => $taxname, 'disabled' => '', @@ -855,7 +884,7 @@ sub calculate_taxes { push @tax_line_items, new FS::cust_bill_pkg { 'pkgnum' => 0, - 'setup' => $tax, + 'setup' => $tax_total, 'recur' => 0, 'sdate' => '', 'edate' => '', @@ -877,7 +906,7 @@ sub _make_lines { my $part_pkg = $params{part_pkg} or die "no part_pkg specified"; my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified"; - my $precommit_hooks = $params{precommit_hooks} or die "no package specified"; + my $precommit_hooks = $params{precommit_hooks} or die "no precommit_hooks specified"; my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified"; my $total_setup = $params{setup} or die "no setup accumulator specified"; my $total_recur = $params{recur} or die "no recur accumulator specified"; @@ -952,13 +981,15 @@ sub _make_lines { # bill recurring fee ### - #XXX unit stuff here too my $recur = 0; my $unitrecur = 0; my @recur_discounts = (); my $sdate; if ( ! $cust_pkg->start_date - and ( ! $cust_pkg->susp || $part_pkg->option('suspend_bill', 1) ) + and ( ! $cust_pkg->susp || $cust_pkg->option('suspend_bill',1) + || ( $part_pkg->option('suspend_bill', 1) ) + && ! $cust_pkg->option('no_suspend_bill',1) + ) and ( $part_pkg->freq ne '0' && ( $cust_pkg->bill || 0 ) <= day_end($time) ) || ( $part_pkg->plan eq 'voip_cdr' @@ -1011,6 +1042,9 @@ sub _make_lines { return "$@ running $method for $cust_pkg\n" if ( $@ ); + #base_cancel??? + $unitrecur = $cust_pkg->part_pkg->base_recur || $recur; #XXX uuh + if ( $increment_next_bill ) { my $next_bill = $part_pkg->add_freq($sdate, $options{freq_override} || 0); @@ -1178,7 +1212,14 @@ sub _handle_taxes { push @classes, 'setup' if ($cust_bill_pkg->setup && !$options->{cancel}); push @classes, 'recur' if ($cust_bill_pkg->recur && !$options->{cancel}); - if ( $self->tax !~ /Y/i && $self->payby ne 'COMP' ) { + my $exempt = $conf->exists('cust_class-tax_exempt') + ? ( $self->cust_class ? $self->cust_class->tax : '' ) + : $self->tax; + # standardize this just to be sure + $exempt = ($exempt eq 'Y') ? 'Y' : ''; + + #if ( $exempt !~ /Y/i && $self->payby ne 'COMP' ) { + if ( $self->payby ne 'COMP' ) { if ( $conf->exists('enable_taxproducts') && ( scalar($part_pkg->part_pkg_taxoverride) @@ -1187,36 +1228,36 @@ sub _handle_taxes { ) { - foreach my $class (@classes) { - my $err_or_ref = $self->_gather_taxes( $part_pkg, $class, $cust_pkg ); - return $err_or_ref unless ref($err_or_ref); - $taxes{$class} = $err_or_ref; - } + if ( !$exempt ) { + + foreach my $class (@classes) { + my $err_or_ref = $self->_gather_taxes( $part_pkg, $class, $cust_pkg ); + return $err_or_ref unless ref($err_or_ref); + $taxes{$class} = $err_or_ref; + } + + unless (exists $taxes{''}) { + my $err_or_ref = $self->_gather_taxes( $part_pkg, '', $cust_pkg ); + return $err_or_ref unless ref($err_or_ref); + $taxes{''} = $err_or_ref; + } - unless (exists $taxes{''}) { - my $err_or_ref = $self->_gather_taxes( $part_pkg, '', $cust_pkg ); - return $err_or_ref unless ref($err_or_ref); - $taxes{''} = $err_or_ref; } - } else { + } else { # cust_main_county tax system + + # We fetch taxes even if the customer is completely exempt, + # because we need to record that fact. my @loc_keys = qw( district city county state country ); - my %taxhash; - if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) { - my $cust_location = $cust_pkg->cust_location; - %taxhash = map { $_ => $cust_location->$_() } @loc_keys; - } else { - my $prefix = - ( $conf->exists('tax-ship_address') && length($self->ship_last) ) - ? 'ship_' - : ''; - %taxhash = map { $_ => $self->get("$prefix$_") } @loc_keys; - } + my $location = $cust_pkg->tax_location; + my %taxhash = map { $_ => $location->$_ } @loc_keys; $taxhash{'taxclass'} = $part_pkg->taxclass; - my @taxes = (); + warn "taxhash:\n". Dumper(\%taxhash) if $DEBUG > 2; + + my @taxes = (); # entries are cust_main_county objects my %taxhash_elim = %taxhash; my @elim = qw( district city county state ); do { @@ -1235,15 +1276,11 @@ sub _handle_taxes { } while ( !scalar(@taxes) && scalar(@elim) ); - @taxes = grep { ! $_->taxname or ! $self->tax_exemption($_->taxname) } - @taxes - if $self->cust_main_exemption; #just to be safe - - if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) { - foreach (@taxes) { - $_->set('pkgnum', $cust_pkg->pkgnum ); - $_->set('locationnum', $cust_pkg->locationnum ); - } + foreach (@taxes) { + # These could become cust_bill_pkg_tax_location records, + # or cust_tax_exempt_pkg. We'll decide later. + $_->set('pkgnum', $cust_pkg->pkgnum); + $_->set('locationnum', $cust_pkg->tax_locationnum); } $taxes{''} = [ @taxes ]; @@ -1260,7 +1297,7 @@ sub _handle_taxes { } #if $conf->exists('enable_taxproducts') ... - } + } # if $self->payby eq 'COMP' #what's this doing in the middle of _handle_taxes? probably should split #this into three parts above in _make_lines @@ -1270,17 +1307,28 @@ sub _handle_taxes { my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate; foreach my $key (keys %tax_cust_bill_pkg) { + # $key is "setup", "recur", or a usage class name. ('' is a usage class.) + # $tax_cust_bill_pkg{$key} is a cust_bill_pkg for that component of + # the line item. + # $taxes{$key} is an arrayref of cust_main_county or tax_rate objects that + # apply to $key-class charges. my @taxes = @{ $taxes{$key} || [] }; my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key}; my %localtaxlisthash = (); foreach my $tax ( @taxes ) { + # this is the tax identifier, not the taxname my $taxname = ref( $tax ). ' '. $tax->taxnum; -# $taxname .= ' pkgnum'. $cust_pkg->pkgnum. -# ' locationnum'. $cust_pkg->locationnum -# if $conf->exists('tax-pkg_address') && $cust_pkg->locationnum; - + $taxname .= ' pkgnum'. $cust_pkg->pkgnum; + # We need to create a separate $taxlisthash entry for each pkgnum + # on the invoice, so that cust_bill_pkg_tax_location records will + # be linked correctly. + + # $taxlisthash: keys are "setup", "recur", and usage classes. + # Values are arrayrefs, first the tax object (cust_main_county + # or tax_rate) and then any cust_bill_pkg objects that the + # tax applies to. $taxlisthash->{ $taxname } ||= [ $tax ]; push @{ $taxlisthash->{ $taxname } }, $tax_cust_bill_pkg; @@ -1521,17 +1569,23 @@ sub retry_realtime { cust_bill_batch ); - my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'", - @realtime_events - ). - ' ) '; + my $is_realtime_event = + ' part_event.action IN ( '. + join(',', map "'$_'", @realtime_events ). + ' ) '; + + my $batch_or_statustext = + "( part_event.action = 'cust_bill_batch' + OR ( statustext IS NOT NULL AND statustext != '' ) + )"; + my @cust_event = qsearch({ 'table' => 'cust_event', 'select' => 'cust_event.*', 'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join", 'hashref' => { 'status' => 'done' }, - 'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ". + 'extra_sql' => " AND $batch_or_statustext ". " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1" }); diff --git a/FS/FS/cust_main/Import.pm b/FS/FS/cust_main/Import.pm index 7f5a3f009..eadcc1a55 100644 --- a/FS/FS/cust_main/Import.pm +++ b/FS/FS/cust_main/Import.pm @@ -13,6 +13,7 @@ use FS::cust_main; use FS::svc_acct; use FS::svc_external; use FS::svc_phone; +use FS::svc_hardware; use FS::part_referral; $DEBUG = 0; @@ -197,6 +198,37 @@ sub batch_import { push @fields, map "svc_phone.$_", qw( countrycode phonenum sip_password pin) if $format eq 'svc_external_svc_phone'; $payby = 'BILL'; + } elsif ( $format eq 'birthdates-acct_phone_hardware') { + @fields = qw( agent_custid refnum + last first company address1 address2 city state zip country + daytime night + ship_last ship_first ship_company ship_address1 ship_address2 + ship_city ship_state ship_zip ship_country + birthdate spouse_birthdate + payinfo paycvv paydate + invoicing_list + cust_pkg.pkgpart cust_pkg.bill + svc_acct.username svc_acct._password + ); + push @fields, map "svc_phone.$_", qw(countrycode phonenum sip_password pin); + push @fields, map "svc_hardware.$_", qw(typenum ip_addr hw_addr serial); + + $payby = 'BILL'; + } elsif ( $format eq 'national_id-acct_phone') { + @fields = qw( agent_custid refnum + last first company address1 address2 city state zip country + daytime night + ship_last ship_first ship_company ship_address1 ship_address2 + ship_city ship_state ship_zip ship_country + national_id + payinfo paycvv paydate + invoicing_list + cust_pkg.pkgpart cust_pkg.bill + svc_acct.username svc_acct._password svc_acct.slipip + ); + push @fields, map "svc_phone.$_", qw(countrycode phonenum sip_password pin); + + $payby = 'BILL'; } else { die "unknown format $format"; } @@ -304,7 +336,7 @@ sub batch_import { $cust_pkg{$1} = parse_datetime( shift @columns ); } - } elsif ( $field =~ /^svc_acct\.(username|_password)$/ ) { + } elsif ( $field =~ /^svc_acct\.(username|_password|slipip)$/ ) { $svc_x{$1} = shift @columns; @@ -314,7 +346,11 @@ sub batch_import { } elsif ( $field =~ /^svc_phone\.(countrycode|phonenum|sip_password|pin)$/ ) { $svc_x{$1} = shift @columns; - + + } elsif ( $field =~ /^svc_hardware\.(typenum|ip_addr|hw_addr|serial)$/ ) { + + $svc_x{$1} = shift @columns; + } else { #refnum interception @@ -353,6 +389,10 @@ sub batch_import { } } + $cust_main{$_} = parse_datetime($cust_main{$_}) + foreach grep $cust_main{$_}, + qw( birthdate spouse_birthdate anniversary_date ); + my $invoicing_list = $cust_main{'invoicing_list'} ? [ delete $cust_main{'invoicing_list'} ] : []; @@ -387,11 +427,19 @@ sub batch_import { if ( $svc_x{'countrycode'} || $svc_x{'phonenum'} ) { $svc_phone = FS::svc_phone->new( { map { $_ => delete($svc_x{$_}) } - qw( countrycode phonenum sip_password pin) + qw( countrycode phonenum sip_password pin ) + } ); + } + + my $svc_hardware = ''; + if ( $svc_x{'typenum'} ) { + $svc_hardware = FS::svc_hardware->new( { + map { $_ => delete($svc_x{$_}) } + qw( typenum ip_addr hw_addr serial ) } ); } - if ( $svcdb || $svc_phone ) { + if ( $svcdb || $svc_phone || $svc_hardware ) { my $part_pkg = $cust_pkg->part_pkg; unless ( $part_pkg ) { $dbh->rollback if $oldAutoCommit; @@ -406,6 +454,11 @@ sub batch_import { $svc_phone->svcpart( $part_pkg->svcpart_unique_svcdb('svc_phone') ); push @svc_x, $svc_phone; } + if ( $svc_hardware ) { + $svc_hardware->svcpart( $part_pkg->svcpart_unique_svcdb('svc_hardware') ); + push @svc_x, $svc_hardware; + } + } $hash{$cust_pkg} = \@svc_x; diff --git a/FS/FS/cust_main/Location.pm b/FS/FS/cust_main/Location.pm new file mode 100644 index 000000000..8e30bb65b --- /dev/null +++ b/FS/FS/cust_main/Location.pm @@ -0,0 +1,252 @@ +package FS::cust_main::Location; + +use strict; +use vars qw( $DEBUG $me @location_fields ); +use FS::Record qw(qsearch qsearchs); +use FS::UID qw(dbh); +use FS::cust_location; + +use Carp qw(carp); + +$DEBUG = 0; +$me = '[FS::cust_main::Location]'; + +my $init = 0; +BEGIN { + # set up accessors for location fields + if (!$init) { + no strict 'refs'; + @location_fields = + qw( address1 address2 city county state zip country district + latitude longitude coord_auto censustract censusyear geocode ); + + foreach my $f (@location_fields) { + *{"FS::cust_main::Location::$f"} = sub { + carp "WARNING: tried to set cust_main.$f with accessor" if (@_ > 1); + shift->bill_location->$f + }; + *{"FS::cust_main::Location::ship_$f"} = sub { + carp "WARNING: tried to set cust_main.ship_$f with accessor" if (@_ > 1); + shift->ship_location->$f + }; + } + $init++; + } +} + +#debugging shim--probably a performance hit, so remove this at some point +sub get { + my $self = shift; + my $field = shift; + if ( $DEBUG and grep (/^(ship_)?($field)$/, @location_fields) ) { + carp "WARNING: tried to get() location field $field"; + $self->$field; + } + $self->FS::Record::get($field); +} + +=head1 NAME + +FS::cust_main::Location - Location-related methods for cust_main + +=head1 DESCRIPTION + +These methods are available on FS::cust_main objects; + +=head1 METHODS + +=over 4 + +=item bill_location + +Returns an L<FS::cust_location> object for the customer's billing address. + +=cut + +sub bill_location { + my $self = shift; + $self->hashref->{bill_location} + ||= FS::cust_location->by_key($self->bill_locationnum); +} + +=item ship_location + +Returns an L<FS::cust_location> object for the customer's service address. + +=cut + +sub ship_location { + my $self = shift; + $self->hashref->{ship_location} + ||= FS::cust_location->by_key($self->ship_locationnum); +} + +=item location TYPE + +An alternative way of saying "bill_location or ship_location, depending on +if TYPE is 'bill' or 'ship'". + +=cut + +sub location { + my $self = shift; + return $self->bill_location if $_[0] eq 'bill'; + return $self->ship_location if $_[0] eq 'ship'; + die "bad location type '$_[0]'"; +} + +=back + +=head1 CLASS METHODS + +=over 4 + +=item location_fields + +Returns a list of fields found in the location objects. All of these fields +can be read (but not written) by calling them as methods on the +L<FS::cust_main> object (prefixed with 'ship_' for the service address +fields). + +=cut + +sub location_fields { @location_fields } + +sub _upgrade_data { + my $class = shift; + eval "use FS::contact; + use FS::contact_class; + use FS::contact_phone; + use FS::phone_type"; + + local $FS::cust_location::import = 1; + local $DEBUG = 0; + my $error; + + # Step 0: set up contact classes and phone types + my $service_contact_class = + qsearchs('contact_class', { classname => 'Service'}) + || new FS::contact_class { classname => 'Service'}; + + if ( !$service_contact_class->classnum ) { + $error = $service_contact_class->insert; + die "error creating contact class for Service: $error" if $error; + } + my %phone_type = ( # fudge slightly + daytime => 'Work', + night => 'Home', + mobile => 'Mobile', + fax => 'Fax' + ); + my $w = 10; + foreach (keys %phone_type) { + $phone_type{$_} = qsearchs('phone_type', { typename => $phone_type{$_}}) + || new FS::phone_type { typename => $phone_type{$_}, + weight => $w }; + # just in case someone still doesn't have these + if ( !$phone_type{$_}->phonetypenum ) { + $error = $phone_type{$_}->insert; + die "error creating phone type '$_': $error" if $error; + } + } + + foreach my $cust_main (qsearch('cust_main', { bill_locationnum => '' })) { + # Step 1: extract billing and service addresses into cust_location + my $custnum = $cust_main->custnum; + my $bill_location = FS::cust_location->new( + { + custnum => $custnum, + map { $_ => $cust_main->get($_) } location_fields() + } + ); + $error = $bill_location->insert; + die "error migrating billing address for customer $custnum: $error" + if $error; + + $cust_main->set(bill_locationnum => $bill_location->locationnum); + + if ( $cust_main->get('ship_address1') ) { + my $ship_location = FS::cust_location->new( + { + custnum => $custnum, + map { $_ => $cust_main->get("ship_$_") } location_fields() + } + ); + $error = $ship_location->insert; + die "error migrating service address for customer $custnum: $error" + if $error; + + $cust_main->set(ship_locationnum => $ship_location->locationnum); + + # Step 2: Extract shipping address contact fields into contact + my %unlike = map { $_ => 1 } + grep { $cust_main->get($_) ne $cust_main->get("ship_$_") } + qw( last first company daytime night fax mobile ); + + if ( %unlike ) { + # then there IS a service contact + my $contact = FS::contact->new({ + 'custnum' => $custnum, + 'classnum' => $service_contact_class->classnum, + 'locationnum' => $ship_location->locationnum, + 'last' => $cust_main->get('ship_last'), + 'first' => $cust_main->get('ship_first'), + }); + if ( $unlike{'company'} ) { + # there's no contact.company field, but keep a record of it + $contact->set(comment => 'Company: '.$cust_main->get('ship_company')); + } + $error = $contact->insert; + die "error migrating service contact for customer $custnum: $error" + if $error; + + foreach ( grep { $unlike{$_} } qw( daytime night fax mobile ) ) { + my $phone = $cust_main->get("ship_$_"); + next if !$phone; + my $contact_phone = FS::contact_phone->new({ + 'contactnum' => $contact->contactnum, + 'phonetypenum' => $phone_type{$_}->phonetypenum, + FS::contact::_parse_phonestring( $phone ) + }); + $error = $contact_phone->insert; + # die "whose responsible this" + die "error migrating service contact phone for customer $custnum: $error" + if $error; + $cust_main->set("ship_$_" => ''); + } + + $cust_main->set("ship_$_" => '') foreach qw(last first company); + } #if %unlike + } #if ship_address1 + else { + $cust_main->set(ship_locationnum => $bill_location->locationnum); + } + + # Step 3: Wipe the migrated fields and update the cust_main + + $cust_main->set("ship_$_" => '') foreach location_fields(); + $cust_main->set($_ => '') foreach location_fields(); + + $error = $cust_main->replace; + die "error migrating addresses for customer $custnum: $error" + if $error; + + # Step 4: set packages at the "default service location" to ship_location + foreach my $cust_pkg ( + qsearch('cust_pkg', { custnum => $custnum, locationnum => '' }) + ) { + # not a location change + $cust_pkg->set('locationnum', $cust_main->ship_locationnum); + $error = $cust_pkg->replace; + die "error migrating package ".$cust_pkg->pkgnum.": $error" + if $error; + } + + } #foreach $cust_main +} + +=back + +=cut + +1; diff --git a/FS/FS/cust_main/NationalID.pm b/FS/FS/cust_main/NationalID.pm new file mode 100644 index 000000000..a742b7637 --- /dev/null +++ b/FS/FS/cust_main/NationalID.pm @@ -0,0 +1,64 @@ +package FS::cust_main::NationalID; + +use strict; +use vars qw( $conf ); +use Date::Simple qw( days_in_month ); +use FS::UID; + +install_callback FS::UID sub { + $conf = new FS::Conf; +}; + +sub set_national_id_from_cgi { + my( $self, $cgi ) = @_; + + my $error = ''; + + if ( my $id_country = $conf->config('national_id-country') ) { + if ( $id_country eq 'MY' ) { + + if ( $cgi->param('national_id1') =~ /\S/ ) { + my $nric = $cgi->param('national_id1'); + $nric =~ s/\s//g; + if ( $nric =~ /^(\d{2})(\d{2})(\d{2})\-?(\d{2})\-?(\d{4})$/ ) { + my( $y, $m, $d, $bp, $n ) = ( $1, $2, $3, $4, $5 ); + $self->national_id( "$y$m$d-$bp-$n" ); + + my @lt = localtime(time); + my $year = ( $y <= substr( $lt[5]+1900, -2) ) ? 2000 + $y + : 1900 + $y; + $error ||= "Illegal NRIC: ". $cgi->param('national_id1') + if $m < 1 || $m > 12 || $d < 1 || $d > days_in_month($year, $m); + #$bp validation per http://en.wikipedia.org/wiki/National_Registration_Identity_Card_Number_%28Malaysia%29#Second_section:_Birthplace ? seems like a bad idea, some could be missing or get added + } else { + $error ||= "Illegal NRIC: ". $cgi->param('national_id1'); + } + } elsif ( $cgi->param('national_id2') =~ /\S/ ) { + my $oldic = $cgi->param('national_id2'); + $oldic =~ s/\s//g; + + # can you please remove validation for "Old IC/Passport:" field, customer + # will have other field format like, RF/123456, I/5234234 ... + #if ( $oldic =~ /^\w\d{9}$/ ) { + $self->national_id($oldic); + #} else { + # $error ||= "Illegal Old IC/Passport: ". $cgi->param('national_id2'); + #} + + } else { + $error ||= 'Either NRIC or Old IC/Passport is required'; + } + + } else { + warn "unknown national_id-country $id_country"; + } + } elsif ( $cgi->param('national_id0') ) { + $self->national_id( $cgi->param('national_id0') ); + } + + $error; + +} + +1; + diff --git a/FS/FS/cust_main/Packages.pm b/FS/FS/cust_main/Packages.pm index 06331d3df..11c13e5dd 100644 --- a/FS/FS/cust_main/Packages.pm +++ b/FS/FS/cust_main/Packages.pm @@ -40,7 +40,8 @@ FS::cust_pkg object =item cust_location -Optional FS::cust_location object +Optional FS::cust_location object. If not specified, the customer's +ship_location will be used. =item svcs @@ -105,6 +106,9 @@ sub order_pkg { } $cust_pkg->locationnum($opt->{'cust_location'}->locationnum); } + else { + $cust_pkg->locationnum($self->ship_locationnum); + } $cust_pkg->custnum( $self->custnum ); @@ -351,6 +355,7 @@ Returns all suspended packages (see L<FS::cust_pkg>) for this customer. sub suspended_pkgs { my $self = shift; + return $self->num_suspended_pkgs unless wantarray; grep { $_->susp } $self->ncancelled_pkgs; } @@ -377,6 +382,7 @@ this customer. sub unsuspended_pkgs { my $self = shift; + return $self->num_unsuspended_pkgs unless wantarray; grep { ! $_->susp } $self->ncancelled_pkgs; } @@ -406,7 +412,11 @@ sub billing_pkgs { my $self = shift; grep { my $part_pkg = $_->part_pkg; $part_pkg->freq ne '' && $part_pkg->freq ne '0' - && ( ! $_->susp || $part_pkg->option('suspend_bill', 1) ); + && ( ! $_->susp || $_->option('suspend_bill',1) + || ( $part_pkg->option('suspend_bill', 1) + && ! $_->option('no_suspend_bill',1) + ) + ); } $self->ncancelled_pkgs; } @@ -438,6 +448,16 @@ sub num_ncancelled_pkgs { shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )"); } +sub num_suspended_pkgs { + shift->num_pkgs(" ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) + AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0 "); +} + +sub num_unsuspended_pkgs { + shift->num_pkgs(" ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) + AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) "); +} + sub num_pkgs { my( $self ) = shift; my $sql = scalar(@_) ? shift : ''; diff --git a/FS/FS/cust_main/Search.pm b/FS/FS/cust_main/Search.pm index 1e9eee79d..b07223ec5 100644 --- a/FS/FS/cust_main/Search.pm +++ b/FS/FS/cust_main/Search.pm @@ -85,8 +85,7 @@ sub smart_search { 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ). ' ( '. join(' OR ', map "$_ = '$phonen'", - qw( daytime night fax - ship_daytime ship_night ship_fax ) + qw( daytime night mobile fax ) ). ' ) '. " AND $agentnums_sql", #agent virtualization @@ -101,8 +100,7 @@ sub smart_search { 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ). ' ( '. join(' OR ', map "$_ LIKE '$phonen\%'", - qw( daytime night - ship_daytime ship_night ) + qw( daytime night ) ). ' ) '. " AND $agentnums_sql", #agent virtualization @@ -142,10 +140,12 @@ sub smart_search { my $num = $1; if ( $num =~ /^(\d+)$/ && $num <= 2147483647 ) { #need a bigint custnum? wow + my $agent_custid_null = $conf->exists('cust_main-default_agent_custid') + ? ' AND agent_custid IS NULL ' : ''; push @cust_main, qsearch( { 'table' => 'cust_main', 'hashref' => { 'custnum' => $num, %options }, - 'extra_sql' => " AND $agentnums_sql", #agent virtualization + 'extra_sql' => " AND $agentnums_sql $agent_custid_null", } ); } @@ -166,19 +166,26 @@ sub smart_search { } } + push @cust_main, qsearch( { + 'table' => 'cust_main', + 'hashref' => { 'agent_custid' => $num, %options }, + 'extra_sql' => " AND $agentnums_sql", #agent virtualization + } ); + if ( $conf->exists('address1-search') ) { my $len = length($num); $num = lc($num); - foreach my $prefix ( '', 'ship_' ) { - push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => { %options, }, - 'extra_sql' => - ( keys(%options) ? ' AND ' : ' WHERE ' ). - " LOWER(SUBSTRING(${prefix}address1 FROM 1 FOR $len)) = '$num' ". - " AND $agentnums_sql", - } ); - } + # probably the Right Thing: return customers that have any associated + # locations matching the string, not just bill/ship location + push @cust_main, qsearch( { + 'table' => 'cust_main', + 'addl_from' => ' JOIN cust_location USING (custnum) ', + 'hashref' => { %options, }, + 'extra_sql' => + ( keys(%options) ? ' AND ' : ' WHERE ' ). + " LOWER(SUBSTRING(cust_location.address1 FROM 1 FOR $len)) = '$num' ". + " AND $agentnums_sql", + } ); } } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) { @@ -190,20 +197,19 @@ sub smart_search { #so just do an exact search (but case-insensitive, so USPS standardization #doesn't throw a wrench in the works) - foreach my $prefix ( '', 'ship_' ) { - push @cust_main, qsearch( { + push @cust_main, qsearch( { 'table' => 'cust_main', 'hashref' => { %options }, 'extra_sql' => - ( keys(%options) ? ' AND ' : ' WHERE ' ). - join(' AND ', - " LOWER(${prefix}first) = ". dbh->quote(lc($first)), - " LOWER(${prefix}last) = ". dbh->quote(lc($last)), - " LOWER(${prefix}company) = ". dbh->quote(lc($company)), - $agentnums_sql, - ), - } ); - } + ( keys(%options) ? ' AND ' : ' WHERE ' ). + join(' AND ', + " LOWER(first) = ". dbh->quote(lc($first)), + " LOWER(last) = ". dbh->quote(lc($last)), + " LOWER(company) = ". dbh->quote(lc($company)), + $agentnums_sql, + ), + } ), + #contacts? } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search # try (ship_){last,company} @@ -241,16 +247,14 @@ sub smart_search { #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 ) - )"; + $sql .= "( LOWER(cust_main.last) = $q_last AND LOWER(cust_main.first) = $q_first )"; push @cust_main, qsearch( { 'table' => 'cust_main', 'hashref' => \%options, 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization } ); + #contacts? # or it just be something that was typed in... (try that in a sec) @@ -262,11 +266,13 @@ sub smart_search { 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 "; - $sql .= " OR LOWER(address1) = $q_value - OR LOWER(ship_address1) = $q_value + #yes, it's a kludge + $sql .= " OR EXISTS( + SELECT 1 FROM cust_location + WHERE LOWER(cust_location.address1) = $q_value + AND cust_location.custnum = cust_main.custnum + ) " if $conf->exists('address1-search'); $sql .= " )"; @@ -288,32 +294,21 @@ sub smart_search { my @hashrefs = ( { 'company' => { op=>'ILIKE', value=>"%$value%" }, }, - { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, }, ); if ( $first && $last ) { + #contacts? ship_first/ship_last are gone 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%" }, }, - ; - } - - if ( $conf->exists('address1-search') ) { - push @hashrefs, - { 'address1' => { op=>'ILIKE', value=>"%$value%" }, }, - { 'ship_address1' => { op=>'ILIKE', value=>"%$value%" }, }, ; } @@ -329,27 +324,38 @@ sub smart_search { } + if ( $conf->exists('address1-search') ) { + + push @cust_main, qsearch( { + 'table' => 'cust_main', + 'addl_from' => 'JOIN cust_location USING (custnum)', + 'extra_sql' => 'WHERE cust_location.address1 ILIKE '. + dbh->quote("%$value%"), + } ); + + } + #fuzzy - my @fuzopts = ( - \%options, #hashref - '', #select - " AND $agentnums_sql", #extra_sql #agent virtualization + my %fuzopts = ( + 'hashref' => \%options, + 'select' => '', + 'extra_sql' => " AND $agentnums_sql", #agent virtualization ); if ( $first && $last ) { push @cust_main, FS::cust_main::Search->fuzzy_search( { 'last' => $last, #fuzzy hashref 'first' => $first }, # - @fuzopts + %fuzopts ); } foreach my $field ( 'last', 'company' ) { push @cust_main, - FS::cust_main::Search->fuzzy_search( { $field => $value }, @fuzopts ); + FS::cust_main::Search->fuzzy_search( { $field => $value }, %fuzopts ); } if ( $conf->exists('address1-search') ) { push @cust_main, - FS::cust_main::Search->fuzzy_search( { 'address1' => $value }, @fuzopts ); + FS::cust_main::Search->fuzzy_search( { 'address1' => $value }, %fuzopts ); } } @@ -451,6 +457,8 @@ HASHREF. Valid parameters are =item address +=item zip + =item refnum =item cancelled_pkgs @@ -461,6 +469,18 @@ bool listref of start date, end date +=item birthdate + +listref of start date, end date + +=item spouse_birthdate + +listref of start date, end date + +=item anniversary_date + +listref of start date, end date + =item payby listref @@ -498,6 +518,7 @@ sub search { 'usernum' => '', 'status' => '', 'address' => '', + 'zip' => '', 'paydate_year' => '', 'invoice_terms' => '', 'custbatch' => '', @@ -552,18 +573,40 @@ sub search { ## if ( $params->{'address'} =~ /\S/ ) { my $address = dbh->quote('%'. lc($params->{'address'}). '%'); - push @where, '('. join(' OR ', - map "LOWER($_) LIKE $address", - qw(address1 address2 ship_address1 ship_address2) - ). - ')'; + push @where, "EXISTS( + SELECT 1 FROM cust_location + WHERE cust_location.custnum = cust_main.custnum + AND (LOWER(cust_location.address1) LIKE $address OR + LOWER(cust_location.address2) LIKE $address) + )"; + } + + ## + # zipcode + ## + if ( $params->{'zip'} =~ /\S/ ) { + my $zip = dbh->quote($params->{'zip'} . '%'); + push @where, "EXISTS( + SELECT 1 FROM cust_location + WHERE cust_location.custnum = cust_main.custnum + AND cust_location.zip LIKE $zip + )"; } ### # refnum ### - if ( $params->{'refnum'} =~ /^(\d+)$/ ) { - push @where, "refnum = $1"; + if ( $params->{'refnum'} ) { + + my @refnum = ref( $params->{'refnum'} ) + ? @{ $params->{'refnum'} } + : ( $params->{'refnum'} ); + + @refnum = grep /^(\d*)$/, @refnum; + + push @where, '( '. join(' OR ', map "cust_main.refnum = $_", @refnum ). ' )' + if @refnum; + } ## @@ -593,7 +636,7 @@ sub search { # dates ## - foreach my $field (qw( signupdate )) { + foreach my $field (qw( signupdate birthdate spouse_birthdate anniversary_date )) { next unless exists($params->{$field}); @@ -604,7 +647,7 @@ sub search { "cust_main.$field >= $beginning", "cust_main.$field <= $ending"; - if(defined $hour) { + if($field eq 'signupdate' && defined $hour) { if ($dbh->{Driver}->{Name} =~ /Pg/i) { push @where, "extract(hour from to_timestamp(cust_main.$field)) = $hour"; } @@ -755,6 +798,9 @@ sub search { my @select = ( 'cust_main.custnum', + # there's a good chance that we'll need these + 'cust_main.bill_locationnum', + 'cust_main.ship_locationnum', FS::UI::Web::cust_sql_fields($params->{'cust_fields'}), ); @@ -764,22 +810,33 @@ sub search { if ($params->{'flattened_pkgs'}) { #my $pkg_join = ''; + $addl_from .= ' LEFT JOIN cust_pkg USING ( custnum ) '; if ($dbh->{Driver}->{Name} eq 'Pg') { - push @select, "array_to_string(array(select pkg from cust_pkg left join part_pkg using ( pkgpart ) where cust_main.custnum = cust_pkg.custnum $pkgwhere),'|') as magic"; + push @select, " + ARRAY_TO_STRING( + ARRAY( + SELECT pkg FROM cust_pkg LEFT JOIN part_pkg USING ( pkgpart ) + WHERE cust_main.custnum = cust_pkg.custnum $pkgwhere + ), '|' + ) AS magic + "; } elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) { push @select, "GROUP_CONCAT(part_pkg.pkg SEPARATOR '|') as magic"; - $addl_from .= ' LEFT JOIN cust_pkg USING ( custnum ) '; #Pg too w/flatpkg? $addl_from .= ' LEFT JOIN part_pkg USING ( pkgpart ) '; #$pkg_join .= ' LEFT JOIN part_pkg USING ( pkgpart ) '; } else { warn "warning: unknown database type ". $dbh->{Driver}->{Name}. - "omitting packing information from report."; + "omitting package information from report."; } - my $header_query = "SELECT COUNT(cust_pkg.custnum = cust_main.custnum) AS count FROM cust_main $addl_from $extra_sql $pkgwhere group by cust_main.custnum order by count desc limit 1"; + my $header_query = " + SELECT COUNT(cust_pkg.custnum = cust_main.custnum) AS count + FROM cust_main $addl_from $extra_sql $pkgwhere + GROUP BY cust_main.custnum ORDER BY count DESC LIMIT 1 + "; my $sth = dbh->prepare($header_query) or die dbh->errstr; $sth->execute() or die $sth->errstr; @@ -825,20 +882,27 @@ sub search { } -=item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ] +=item fuzzy_search FUZZY_HASHREF [ OPTS ] Performs a fuzzy (approximate) search and returns the matching FS::cust_main records. Currently, I<first>, I<last>, I<company> and/or I<address1> may be -specified (the appropriate ship_ field is also searched). +specified. Additional options are the same as FS::Record::qsearch =cut sub fuzzy_search { - my( $self, $fuzzy, $hash, @opt) = @_; - #$self - $hash ||= {}; + my( $self, $fuzzy ) = @_; + # sensible defaults, then merge in any passed options + my %fuzopts = ( + 'table' => 'cust_main', + 'addl_from' => '', + 'extra_sql' => '', + 'hashref' => {}, + @_ + ); + my @cust_main = (); check_and_rebuild_fuzzyfiles(); @@ -852,8 +916,25 @@ sub fuzzy_search { my @fcust = (); foreach ( keys %match ) { - push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt); - push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt); + if ( $field eq 'address1' ) { + #because it lives outside the table + my $addl_from = $fuzopts{addl_from} . + 'JOIN cust_location USING (custnum)'; + my $extra_sql = $fuzopts{extra_sql} . + " AND cust_location.address1 = ".dbh->quote($_); + push @fcust, qsearch({ + %fuzopts, + 'addl_from' => $addl_from, + 'extra_sql' => $extra_sql, + }); + } else { + my $hash = $fuzopts{hashref}; + $hash->{$field} = $_; + push @fcust, qsearch({ + %fuzopts, + 'hashref' => $hash + }); + } } my %fsaw = (); push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust; diff --git a/FS/FS/cust_main_county.pm b/FS/FS/cust_main_county.pm index e937b205c..143f62ed3 100644 --- a/FS/FS/cust_main_county.pm +++ b/FS/FS/cust_main_county.pm @@ -4,7 +4,7 @@ use strict; use vars qw( @ISA @EXPORT_OK $conf @cust_main_county %cust_main_county $countyflag ); # $cityflag ); use Exporter; -use FS::Record qw( qsearch dbh ); +use FS::Record qw( qsearch qsearchs dbh ); use FS::cust_bill_pkg; use FS::cust_bill; use FS::cust_pkg; @@ -164,6 +164,57 @@ sub recurtax { return ''; } +=item label OPTIONS + +Returns a label looking like "Anytown, Alameda County, CA, US". + +If the taxname field is set, it will look like +"CA Sales Tax (Anytown, Alameda County, CA, US)". + +If the taxclass is set, then it will be +"Anytown, Alameda County, CA, US (International)". + +Currently it will not contain the district, even if the city+county+state +is not unique. + +OPTIONS may contain "no_taxclass" (hides taxclass) and/or "no_city" +(hides city). It may also contain "out", in which case, if this +region (district+city+county+state+country) contains no non-zero +taxes, the label will read "Out of taxable region(s)". + +=cut + +sub label { + my ($self, %opt) = @_; + if ( $opt{'out'} + and $self->tax == 0 + and !defined(qsearchs('cust_main_county', { + 'district' => $self->district, + 'city' => $self->city, + 'county' => $self->county, + 'state' => $self->state, + 'country' => $self->country, + 'tax' => { op => '>', value => 0 }, + })) ) + { + return 'Out of taxable region(s)'; + } + my $label = $self->country; + $label = $self->state.", $label" if $self->state; + $label = $self->county." County, $label" if $self->county; + if (!$opt{no_city}) { + $label = $self->city.", $label" if $self->city; + } + # ugly labels when taxclass and taxname are both non-null... + # but this is how the tax report does it + if (!$opt{no_taxclass}) { + $label = "$label (".$self->taxclass.')' if $self->taxclass; + } + $label = $self->taxname." ($label)" if $self->taxname; + + $label; +} + =item sql_taxclass_sameregion Returns an SQL WHERE fragment or the empty string to search for entries @@ -176,7 +227,7 @@ with different tax classes. sub sql_taxclass_sameregion { my $self = shift; - my $same_query = 'SELECT taxclass FROM cust_main_county '. + my $same_query = 'SELECT DISTINCT taxclass FROM cust_main_county '. ' WHERE taxnum != ? AND country = ?'; my @same_param = ( 'taxnum', 'country' ); foreach my $opt_field (qw( state county )) { @@ -207,21 +258,30 @@ sub _list_sql { =item taxline TAXABLES_ARRAYREF, [ OPTION => VALUE ... ] -Returns a listref of a name and an amount of tax calculated for the list of -packages or amounts referenced by TAXABLES_ARRAYREF. Returns a scalar error -message on error. +Returns an hashref of a name and an amount of tax calculated for the +line items (L<FS::cust_bill_pkg> objects) in TAXABLES_ARRAYREF. The line +items must come from the same invoice. Returns a scalar error message +on error. + +In addition to calculating the tax for the line items, this will calculate +any appropriate tax exemptions and attach them to the line items. -Options include custnum and invoice_date and are hints to this method +Options may include 'custnum' and 'invoice_date' in case the cust_bill_pkg +objects belong to an invoice that hasn't been inserted yet. + +Options may include 'exemptions', an arrayref of L<FS::cust_tax_exempt_pkg> +objects belonging to the same customer, to be counted against the monthly +tax exemption limit if there is one. =cut +# XXX this should just return a cust_bill_pkg object for the tax, +# but that requires changing stuff in tax_rate.pm also. + sub taxline { my( $self, $taxables, %opt ) = @_; + return 'taxline called with no line items' unless @$taxables; - my @exemptions = (); - push @exemptions, @{ $_->_cust_tax_exempt_pkg } - for grep { ref($_) } @$taxables; - local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -236,29 +296,92 @@ sub taxline { my $name = $self->taxname || 'Tax'; my $amount = 0; + my $cust_bill = $taxables->[0]->cust_bill; + my $custnum = $cust_bill ? $cust_bill->custnum : $opt{'custnum'}; + my $invoice_date = $cust_bill ? $cust_bill->_date : $opt{'invoice_date'}; + my $cust_main = FS::cust_main->by_key($custnum) if $custnum > 0; + if (!$cust_main) { + # better way to handle this? should we just assume that it's taxable? + die "unable to calculate taxes for an unknown customer\n"; + } + + # set a flag if the customer is tax-exempt + my $exempt_cust; + my $conf = FS::Conf->new; + if ( $conf->exists('cust_class-tax_exempt') ) { + my $cust_class = $cust_main->cust_class; + $exempt_cust = $cust_class->tax if $cust_class; + } else { + $exempt_cust = $cust_main->tax; + } + + # set a flag if the customer is exempt from this tax here + my $exempt_cust_taxname = $cust_main->tax_exemption($self->taxname) + if $self->taxname; + + # Gather any exemptions that are already attached to these cust_bill_pkgs + # so that we can deduct them from the customer's monthly limit. + my @existing_exemptions = @{ $opt{'exemptions'} }; + push @existing_exemptions, @{ $_->cust_tax_exempt_pkg } + for @$taxables; + foreach my $cust_bill_pkg (@$taxables) { my $cust_pkg = $cust_bill_pkg->cust_pkg; - my $cust_bill = $cust_pkg->cust_bill if $cust_pkg; - my $custnum = $cust_pkg ? $cust_pkg->custnum : $opt{custnum}; my $part_pkg = $cust_bill_pkg->part_pkg; - my $invoice_date = $cust_bill ? $cust_bill->_date : $opt{invoice_date}; - - my $taxable_charged = 0; - $taxable_charged += $cust_bill_pkg->setup - unless $part_pkg->setuptax =~ /^Y$/i - || $self->setuptax =~ /^Y$/i; - $taxable_charged += $cust_bill_pkg->recur - unless $part_pkg->recurtax =~ /^Y$/i - || $self->recurtax =~ /^Y$/i; - - next unless $taxable_charged; + + my @new_exemptions; + my $taxable_charged = $cust_bill_pkg->setup + $cust_bill_pkg->recur + or next; # don't create zero-amount exemptions + + # XXX the following procedure should probably be in cust_bill_pkg + + if ( $exempt_cust ) { + + push @new_exemptions, FS::cust_tax_exempt_pkg->new({ + amount => $taxable_charged, + exempt_cust => 'Y', + }); + $taxable_charged = 0; + + } elsif ( $exempt_cust_taxname ) { + + push @new_exemptions, FS::cust_tax_exempt_pkg->new({ + amount => $taxable_charged, + exempt_cust_taxname => 'Y', + }); + $taxable_charged = 0; + + } + + if ( ($part_pkg->setuptax eq 'Y' or $self->setuptax eq 'Y') + and $cust_bill_pkg->setup > 0 and $taxable_charged > 0 ) { + + push @new_exemptions, FS::cust_tax_exempt_pkg->new({ + amount => $cust_bill_pkg->setup, + exempt_setup => 'Y' + }); + $taxable_charged -= $cust_bill_pkg->setup; + + } + if ( ($part_pkg->recurtax eq 'Y' or $self->recurtax eq 'Y') + and $cust_bill_pkg->recur > 0 and $taxable_charged > 0 ) { + + push @new_exemptions, FS::cust_tax_exempt_pkg->new({ + amount => $cust_bill_pkg->recur, + exempt_recur => 'Y' + }); + $taxable_charged -= $cust_bill_pkg->recur; + + } - if ( $self->exempt_amount && $self->exempt_amount > 0 ) { + if ( $self->exempt_amount && $self->exempt_amount > 0 + and $taxable_charged > 0 ) { #my ($mon,$year) = (localtime($cust_bill_pkg->sdate) )[4,5]; my ($mon,$year) = (localtime( $cust_bill_pkg->sdate || $invoice_date ) )[4,5]; $mon++; + $year += 1900; my $freq = $cust_bill_pkg->freq; unless ($freq) { $freq = $part_pkg->freq || 1; # less trustworthy fallback @@ -294,6 +417,7 @@ sub taxline { AND taxnum = ? AND year = ? AND month = ? + AND exempt_monthly = 'Y' "; my $sth = dbh->prepare($sql) or do { $dbh->rollback if $oldAutoCommit; @@ -302,7 +426,7 @@ sub taxline { $sth->execute( $custnum, $self->taxnum, - 1900+$year, + $year, $mon, ) or do { $dbh->rollback if $oldAutoCommit; @@ -311,9 +435,10 @@ sub taxline { my $existing_exemption = $sth->fetchrow_arrayref->[0] || 0; foreach ( grep { $_->taxnum == $self->taxnum && + $_->exempt_monthly eq 'Y' && $_->month == $mon && - $_->year == 1900+$year - } @exemptions + $_->year == $year + } @existing_exemptions ) { $existing_exemption += $_->amount; @@ -325,42 +450,50 @@ sub taxline { my $addl = $remaining_exemption > $taxable_per_month ? $taxable_per_month : $remaining_exemption; + push @new_exemptions, FS::cust_tax_exempt_pkg->new({ + amount => sprintf('%.2f', $addl), + exempt_monthly => 'Y', + year => $year, + month => $mon, + }); $taxable_charged -= $addl; - - my $cust_tax_exempt_pkg = new FS::cust_tax_exempt_pkg ( { - 'taxnum' => $self->taxnum, - 'year' => 1900+$year, - 'month' => $mon, - 'amount' => sprintf('%.2f', $addl ), - } ); - if ($cust_bill_pkg->billpkgnum) { - $cust_tax_exempt_pkg->billpkgnum($cust_bill_pkg->billpkgnum); - my $error = $cust_tax_exempt_pkg->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "fatal: can't insert cust_tax_exempt_pkg: $error"; - } - }else{ - push @exemptions, $cust_tax_exempt_pkg; - push @{ $cust_bill_pkg->_cust_tax_exempt_pkg }, $cust_tax_exempt_pkg; - } # if $cust_bill_pkg->billpkgnum - } # if $remaining_exemption > 0 - - #++ + } + last if $taxable_charged < 0.005; + # if they're using multiple months of exemption for a multi-month + # package, then record the exemptions in separate months $mon++; - #until ( $mon < 12 ) { $mon -= 12; $year++; } - until ( $mon < 13 ) { $mon -= 12; $year++; } + if ( $mon > 12 ) { + $mon -= 12; + $year++; + } } #foreach $which_month + } # if exempt_amount + + $_->taxnum($self->taxnum) foreach @new_exemptions; + + if ( $cust_bill_pkg->billpkgnum ) { + die "tried to calculate tax exemptions on a previously billed line item\n"; + # this is unnecessary +# foreach my $cust_tax_exempt_pkg (@new_exemptions) { +# my $error = $cust_tax_exempt_pkg->insert; +# if ( $error ) { +# $dbh->rollback if $oldAutoCommit; +# return "can't insert cust_tax_exempt_pkg: $error"; +# } +# } + } - } #if $tax->exempt_amount + # attach them to the line item + push @{ $cust_bill_pkg->cust_tax_exempt_pkg }, @new_exemptions; + push @existing_exemptions, @new_exemptions; + # If we were smart, we'd also generate a cust_bill_pkg_tax_location + # record at this point, but that would require redesigning more stuff. $taxable_charged = sprintf( "%.2f", $taxable_charged); - $amount += $taxable_charged * $self->tax / 100 - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; + $amount += $taxable_charged * $self->tax / 100; + } #foreach $cust_bill_pkg return { 'name' => $name, diff --git a/FS/FS/cust_main_exemption.pm b/FS/FS/cust_main_exemption.pm index 06d22b7e0..c6f3d5e6e 100644 --- a/FS/FS/cust_main_exemption.pm +++ b/FS/FS/cust_main_exemption.pm @@ -3,6 +3,7 @@ package FS::cust_main_exemption; use strict; use base qw( FS::Record ); use FS::Record qw( qsearch qsearchs ); +use FS::Conf; use FS::cust_main; =head1 NAME @@ -44,6 +45,9 @@ Customer (see L<FS::cust_main>) taxname +=item exempt_number + +Exemption number =back @@ -108,9 +112,15 @@ sub check { $self->ut_numbern('exemptionnum') || $self->ut_foreign_key('custnum', 'cust_main', 'custnum') || $self->ut_text('taxname') + || $self->ut_textn('exempt_number') ; return $error if $error; + my $conf = new FS::Conf; + if ( ! $self->exempt_number && $conf->exists('tax-cust_exempt-groups-require_individual_nums') ) { + return 'Tax exemption number required for '. $self->taxname. ' exemption'; + } + $self->SUPER::check; } diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index ef30809b0..d28997ccd 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -22,6 +22,7 @@ use FS::cust_pay_refund; use FS::cust_main; use FS::cust_pkg; use FS::cust_pay_void; +use FS::upgrade_journal; $DEBUG = 0; @@ -87,7 +88,7 @@ order taker (see L<FS::access_user>) =item payby -Payment Type (See L<FS::payinfo_Mixin> for valid payby values) +Payment Type (See L<FS::payinfo_Mixin> for valid values) =item payinfo @@ -129,6 +130,11 @@ The deposit account number. The teller number. +=item pay_batch + +The number of the batch this payment came from (see L<FS::pay_batch>), +or null if it was processed through a realtime gateway or entered manually. + =back =head1 METHODS @@ -513,6 +519,7 @@ sub check { || $self->ut_alphan('depositor') || $self->ut_numbern('account') || $self->ut_numbern('teller') + || $self->ut_foreign_keyn('batchnum', 'pay_batch', 'batchnum') || $self->payinfo_check() ; return $error if $error; @@ -582,7 +589,7 @@ sub send_receipt { my $conf = new FS::Conf; - return '' unless $conf->exists('payment_receipt', $cust_main->agentnum); + return '' unless $conf->config_bool('payment_receipt', $cust_main->agentnum); my @invoicing_list = $cust_main->invoicing_list_emailonly; return '' unless @invoicing_list; @@ -655,7 +662,7 @@ sub send_receipt { } - } else { #not manual + } elsif ( ! $cust_main->invoice_noemail ) { #not manual my $queue = new FS::queue { 'paynum' => $self->paynum, @@ -760,6 +767,12 @@ 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. +FS::cust_pay objects may have the pseudo-field 'apply_to', containing a +reference to an array of (uninserted) FS::cust_bill_pay objects. If so, +those objects will be inserted with the paynum of the payment, and for +each one, an error message or an empty string will be inserted into the +list of errors. + For example: my @errors = FS::cust_pay->batch_insert(@cust_pay); @@ -786,19 +799,35 @@ sub batch_insert { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $errors = 0; + my $num_errors = 0; - my @errors = map { - my $error = $_->insert( 'manual' => 1 ); - if ( $error ) { - $errors++; - } else { - $_->cust_main->apply_payments; + my @errors; + foreach my $cust_pay (@_) { + my $error = $cust_pay->insert( 'manual' => 1 ); + push @errors, $error; + $num_errors++ if $error; + + if ( ref($cust_pay->get('apply_to')) eq 'ARRAY' ) { + + foreach my $cust_bill_pay ( @{ $cust_pay->apply_to } ) { + if ( $error ) { # insert placeholders if cust_pay wasn't inserted + push @errors, ''; + } + else { + $cust_bill_pay->set('paynum', $cust_pay->paynum); + my $apply_error = $cust_bill_pay->insert; + push @errors, $apply_error || ''; + $num_errors++ if $apply_error; + } + } + + } elsif ( !$error ) { #normal case: apply payments as usual + $cust_pay->cust_main->apply_payments; } - $error; - } @_; - if ( $errors ) { + } + + if ( $num_errors ) { $dbh->rollback if $oldAutoCommit; } else { $dbh->commit or die $dbh->errstr if $oldAutoCommit; @@ -853,93 +882,103 @@ sub _upgrade_data { #class method # otaker/ivan upgrade ## - #not the most efficient, but hey, it only has to run once + unless ( FS::upgrade_journal->is_done('cust_pay__otaker_ivan') ) { - my $where = "WHERE ( otaker IS NULL OR otaker = '' OR otaker = 'ivan' ) ". - " AND usernum IS NULL ". - " AND 0 < ( SELECT COUNT(*) FROM cust_main ". - " WHERE cust_main.custnum = cust_pay.custnum ) "; + #not the most efficient, but hey, it only has to run once - my $count_sql = "SELECT COUNT(*) FROM cust_pay $where"; + my $where = "WHERE ( otaker IS NULL OR otaker = '' OR otaker = 'ivan' ) ". + " AND usernum IS NULL ". + " AND 0 < ( SELECT COUNT(*) FROM cust_main ". + " WHERE cust_main.custnum = cust_pay.custnum ) "; - my $sth = dbh->prepare($count_sql) or die dbh->errstr; - $sth->execute or die $sth->errstr; - my $total = $sth->fetchrow_arrayref->[0]; - #warn "$total cust_pay records to update\n" - # if $DEBUG; - local($DEBUG) = 2 if $total > 1000; #could be a while, force progress info + my $count_sql = "SELECT COUNT(*) FROM cust_pay $where"; - my $count = 0; - my $lastprog = 0; + my $sth = dbh->prepare($count_sql) or die dbh->errstr; + $sth->execute or die $sth->errstr; + my $total = $sth->fetchrow_arrayref->[0]; + #warn "$total cust_pay records to update\n" + # if $DEBUG; + local($DEBUG) = 2 if $total > 1000; #could be a while, force progress info - my @cust_pay = qsearch( { - 'table' => 'cust_pay', - 'hashref' => {}, - 'extra_sql' => $where, - 'order_by' => 'ORDER BY paynum', - } ); + my $count = 0; + my $lastprog = 0; - foreach my $cust_pay (@cust_pay) { + my @cust_pay = qsearch( { + 'table' => 'cust_pay', + 'hashref' => {}, + 'extra_sql' => $where, + 'order_by' => 'ORDER BY paynum', + } ); - my $h_cust_pay = $cust_pay->h_search('insert'); - if ( $h_cust_pay ) { - next if $cust_pay->otaker eq $h_cust_pay->history_user; - #$cust_pay->otaker($h_cust_pay->history_user); - $cust_pay->set('otaker', $h_cust_pay->history_user); - } else { - $cust_pay->set('otaker', 'legacy'); - } + foreach my $cust_pay (@cust_pay) { - delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge - my $error = $cust_pay->replace; + my $h_cust_pay = $cust_pay->h_search('insert'); + if ( $h_cust_pay ) { + next if $cust_pay->otaker eq $h_cust_pay->history_user; + #$cust_pay->otaker($h_cust_pay->history_user); + $cust_pay->set('otaker', $h_cust_pay->history_user); + } else { + $cust_pay->set('otaker', 'legacy'); + } - if ( $error ) { - warn " *** WARNING: Error updating order taker for payment paynum ". - $cust_pay->paynun. ": $error\n"; - next; - } + delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge + my $error = $cust_pay->replace; - $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it + if ( $error ) { + warn " *** WARNING: Error updating order taker for payment paynum ". + $cust_pay->paynun. ": $error\n"; + next; + } + + $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it + + $count++; + if ( $DEBUG > 1 && $lastprog + 30 < time ) { + warn "$me $count/$total (".sprintf('%.2f',100*$count/$total). '%)'."\n"; + $lastprog = time; + } - $count++; - if ( $DEBUG > 1 && $lastprog + 30 < time ) { - warn "$me $count/$total (". sprintf('%.2f',100*$count/$total). '%)'. "\n"; - $lastprog = time; } + FS::upgrade_journal->set_done('cust_pay__otaker_ivan'); } ### # payinfo N/A upgrade ### - #XXX remove the 'N/A (tokenized)' part (or just this entire thing) + unless ( FS::upgrade_journal->is_done('cust_pay__payinfo_na') ) { - my @na_cust_pay = qsearch( { - 'table' => 'cust_pay', - 'hashref' => {}, #could be encrypted# { 'payinfo' => 'N/A' }, - 'extra_sql' => "WHERE ( payinfo = 'N/A' OR paymask = 'N/AA' OR paymask = 'N/A (tokenized)' ) AND payby IN ( 'CARD', 'CHEK' )", - } ); + #XXX remove the 'N/A (tokenized)' part (or just this entire thing) - foreach my $na ( @na_cust_pay ) { + my @na_cust_pay = qsearch( { + 'table' => 'cust_pay', + 'hashref' => {}, #could be encrypted# { 'payinfo' => 'N/A' }, + 'extra_sql' => "WHERE ( payinfo = 'N/A' OR paymask = 'N/AA' OR paymask = 'N/A (tokenized)' ) AND payby IN ( 'CARD', 'CHEK' )", + } ); - next unless $na->payinfo eq 'N/A'; + foreach my $na ( @na_cust_pay ) { + + next unless $na->payinfo eq 'N/A'; + + my $cust_pay_pending = + qsearchs('cust_pay_pending', { 'paynum' => $na->paynum } ); + unless ( $cust_pay_pending ) { + warn " *** WARNING: not-yet recoverable N/A card for payment ". + $na->paynum. " (no cust_pay_pending)\n"; + next; + } + $na->$_($cust_pay_pending->$_) for qw( payinfo paymask ); + my $error = $na->replace; + if ( $error ) { + warn " *** WARNING: Error updating payinfo for payment paynum ". + $na->paynun. ": $error\n"; + next; + } - my $cust_pay_pending = - qsearchs('cust_pay_pending', { 'paynum' => $na->paynum } ); - unless ( $cust_pay_pending ) { - warn " *** WARNING: not-yet recoverable N/A card for payment ". - $na->paynum. " (no cust_pay_pending)\n"; - next; - } - $na->$_($cust_pay_pending->$_) for qw( payinfo paymask ); - my $error = $na->replace; - if ( $error ) { - warn " *** WARNING: Error updating payinfo for payment paynum ". - $na->paynun. ": $error\n"; - next; } + FS::upgrade_journal->set_done('cust_pay__payinfo_na'); } ### @@ -950,6 +989,21 @@ sub _upgrade_data { #class method $class->_upgrade_otaker(%opts); $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it + ### + # migrate batchnums from the misused 'paybatch' field to 'batchnum' + ### + my @cust_pay = qsearch( { + 'table' => 'cust_pay', + 'addl_from' => ' JOIN pay_batch ON cust_pay.paybatch = CAST(pay_batch.batchnum AS text) ', + } ); + foreach my $cust_pay (@cust_pay) { + $cust_pay->set('batchnum' => $cust_pay->paybatch); + $cust_pay->set('paybatch' => ''); + my $error = $cust_pay->replace; + warn "error setting batchnum on cust_pay #".$cust_pay->paynum.":\n $error" + if $error; + } + } =back diff --git a/FS/FS/cust_pay_batch.pm b/FS/FS/cust_pay_batch.pm index f5e6a4bf1..9f2e9ddfc 100644 --- a/FS/FS/cust_pay_batch.pm +++ b/FS/FS/cust_pay_batch.pm @@ -204,6 +204,35 @@ sub cust_main { qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); } +=item expmmyy + +Returns the credit card expiration date in MMYY format. If this is a +CHEK payment, returns an empty string. + +=cut + +sub expmmyy { + my $self = shift; + if ( $self->payby eq 'CARD' ) { + $self->get('exp') =~ /^(\d{4})-(\d{2})-(\d{2})$/; + return sprintf('%02u%02u', $2, ($1 % 100)); + } + else { + return ''; + } +} + +=item pay_batch + +Returns the payment batch this payment belongs to (L<FS::pay_batch). + +=cut + +sub pay_batch { + my $self = shift; + FS::pay_batch->by_key($self->batchnum); +} + #you know what, screw this in the new world of events. we should be able to #get the event defs to retry (remove once.pm condition, add every.pm) without #mucking about with statuses of previous cust_event records. right? @@ -276,6 +305,8 @@ sub approve { my $paybatchnum = $new->paybatchnum; my $old = qsearchs('cust_pay_batch', { paybatchnum => $paybatchnum }) or return "paybatchnum $paybatchnum not found"; + # leave these restrictions in place until TD EFT is converted over + # to B::BP return "paybatchnum $paybatchnum already resolved ('".$old->status."')" if $old->status; $new->status('Approved'); @@ -291,6 +322,7 @@ sub approve { 'paid' => $new->paid, '_date' => $new->_date, 'usernum' => $new->usernum, + 'batchnum' => $new->batchnum, } ); $error = $cust_pay->insert; if ( $error ) { @@ -364,6 +396,62 @@ sub decline { return; } +=item request_item [ OPTIONS ] + +Returns a L<Business::BatchPayment::Item> object for this batch payment +entry. This can be submitted to a processor. + +OPTIONS can be a list of key/values to append to the attributes. The most +useful case of this is "process_date" to set a processing date based on the +date the batch is being submitted. + +=cut + +sub request_item { + local $@; + my $self = shift; + + eval "use Business::BatchPayment;"; + die "couldn't load Business::BatchPayment: $@" if $@; + + my $cust_main = $self->cust_main; + my $location = $cust_main->bill_location; + my $pay_batch = $self->pay_batch; + + my %payment; + $payment{payment_type} = FS::payby->payby2bop( $pay_batch->payby ); + if ( $payment{payment_type} eq 'CC' ) { + $payment{card_number} = $self->payinfo, + $payment{expiration} = $self->expmmyy, + } elsif ( $payment{payment_type} eq 'ECHECK' ) { + $self->payinfo =~ /(\d+)@(\d+)/; # or else what? + $payment{account_number} = $1; + $payment{routing_code} = $2; + $payment{account_type} = $cust_main->paytype; + # XXX what if this isn't their regular payment method? + } else { + die "unsupported BatchPayment method: ".$pay_batch->payby; + } + + Business::BatchPayment->create(Item => + # required + action => 'payment', + tid => $self->paybatchnum, + amount => $self->amount, + + # customer info + customer_id => $self->custnum, + first_name => $cust_main->first, + last_name => $cust_main->last, + company => $cust_main->company, + address => $location->address1, + ( map { $_ => $location->$_ } qw(address2 city state country zip) ), + + invoice_number => $self->invnum, + %payment, + ); +} + =back =head1 BUGS diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index bee1b82fb..16adea3d7 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -10,9 +10,9 @@ use List::Util qw(max); use Tie::IxHash; use Time::Local qw( timelocal timelocal_nocheck ); use MIME::Entity; -use FS::UID qw( getotaker dbh ); +use FS::UID qw( getotaker dbh driver_name ); use FS::Misc qw( send_email ); -use FS::Record qw( qsearch qsearchs ); +use FS::Record qw( qsearch qsearchs fields ); use FS::CurrentUser; use FS::cust_svc; use FS::part_pkg; @@ -338,6 +338,9 @@ sub insert { if ( $conf->config('ticket_system') && $options{ticket_subject} ) { + #this init stuff is still inefficient, but at least its limited to + # the small number (any?) folks using ticket emailing on pkg order + #eval ' # use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" ); # use RT; @@ -879,6 +882,158 @@ sub cancel_if_expired { ''; } +=item uncancel + +"Un-cancels" this package: Orders a new package with the same custnum, pkgpart, +locationnum, (other fields?). Attempts to re-provision cancelled services +using history information (errors at this stage are not fatal). + +cust_pkg: pass a scalar reference, will be filled in with the new cust_pkg object + +svc_fatal: service provisioning errors are fatal + +svc_errors: pass an array reference, will be filled in with any provisioning errors + +=cut + +sub uncancel { + my( $self, %options ) = @_; + + #in case you try do do $uncancel-date = $cust_pkg->uncacel + return '' unless $self->get('cancel'); + + ## + # Transaction-alize + ## + + 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; + + ## + # insert the new package + ## + + my $cust_pkg = new FS::cust_pkg { + last_bill => ( $options{'last_bill'} || $self->get('last_bill') ), + bill => ( $options{'bill'} || $self->get('bill') ), + uncancel => time, + uncancel_pkgnum => $self->pkgnum, + map { $_ => $self->get($_) } qw( + custnum pkgpart locationnum + setup + susp adjourn resume expire start_date contract_end dundate + change_date change_pkgpart change_locationnum + manual_flag no_auto quantity agent_pkgid recur_show_zero setup_show_zero + ), + }; + + my $error = $cust_pkg->insert( + 'change' => 1, #supresses any referral credit to a referring customer + ); + if ($error) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + ## + # insert services + ## + + #find historical services within this timeframe before the package cancel + # (incompatible with "time" option to cust_pkg->cancel?) + my $fuzz = 2 * 60; #2 minutes? too much? (might catch separate unprovision) + # too little? (unprovisioing export delay?) + my($end, $start) = ( $self->get('cancel'), $self->get('cancel') - $fuzz ); + my @h_cust_svc = $self->h_cust_svc( $end, $start ); + + my @svc_errors; + foreach my $h_cust_svc (@h_cust_svc) { + my $h_svc_x = $h_cust_svc->h_svc_x( $end, $start ); + #next unless $h_svc_x; #should this happen? + (my $table = $h_svc_x->table) =~ s/^h_//; + require "FS/$table.pm"; + my $class = "FS::$table"; + my $svc_x = $class->new( { + 'pkgnum' => $cust_pkg->pkgnum, + 'svcpart' => $h_cust_svc->svcpart, + map { $_ => $h_svc_x->get($_) } fields($table) + } ); + + # radius_usergroup + if ( $h_svc_x->isa('FS::h_svc_Radius_Mixin') ) { + $svc_x->usergroup( [ $h_svc_x->h_usergroup($end, $start) ] ); + } + + my $svc_error = $svc_x->insert; + if ( $svc_error ) { + if ( $options{svc_fatal} ) { + $dbh->rollback if $oldAutoCommit; + return $svc_error; + } else { + push @svc_errors, $svc_error; + # is this necessary? svc_Common::insert already deletes the + # cust_svc if inserting svc_x fails. + my $cust_svc = qsearchs('cust_svc', { 'svcnum' => $svc_x->svcnum }); + if ( $cust_svc ) { + my $cs_error = $cust_svc->delete; + if ( $cs_error ) { + $dbh->rollback if $oldAutoCommit; + return $cs_error; + } + } + } # svc_fatal + } # svc_error + } #foreach $h_cust_svc + + #these are pretty rare, but should handle them + # - dsl_device (mac addresses) + # - phone_device (mac addresses) + # - dsl_note (ikano notes) + # - domain_record (i.e. restore DNS information w/domains) + # - inventory_item(?) (inventory w/un-cancelling service?) + # - nas (svc_broaband nas stuff) + #this stuff is unused in the wild afaik + # - mailinglistmember + # - router.svcnum? + # - svc_domain.parent_svcnum? + # - acct_snarf (ancient mail fetching config) + # - cgp_rule (communigate) + # - cust_svc_option (used by our Tron stuff) + # - acct_rt_transaction (used by our time worked stuff) + + ## + # also move over any services that didn't unprovision at cancellation + ## + + foreach my $cust_svc ( qsearch('cust_svc', { pkgnum => $self->pkgnum } ) ) { + $cust_svc->pkgnum( $cust_pkg->pkgnum ); + my $error = $cust_svc->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + ## + # Finish + ## + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ${ $options{cust_pkg} } = $cust_pkg if ref($options{cust_pkg}); + @{ $options{svc_errors} } = @svc_errors if ref($options{svc_errors}); + + ''; +} + =item unexpire Cancels any pending expiration (sets the expire field to null). @@ -1041,8 +1196,13 @@ sub suspend { $hash{'resume'} = $resume_date; } + $options{options} ||= {}; + my $new = new FS::cust_pkg ( \%hash ); - $error = $new->replace( $self, options => { $self->options } ); + $error = $new->replace( $self, options => { $self->options, + %{ $options{options} }, + } + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -1162,7 +1322,8 @@ sub credit_remaining { 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 and the -adjourn field if it is in the past). +adjourn field if it is in the past). If the suspend reason includes an +unsuspension package, that package will be ordered. Available options are: @@ -1239,6 +1400,8 @@ sub unsuspend { } #if $date + my @labels = (); + foreach my $cust_svc ( qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } ) ) { @@ -1258,10 +1421,15 @@ sub unsuspend { $dbh->rollback if $oldAutoCommit; return $error; } + my( $label, $value ) = $cust_svc->label; + push @labels, "$label: $value"; } } + my $cust_pkg_reason = $self->last_cust_pkg_reason('susp'); + my $reason = $cust_pkg_reason ? $cust_pkg_reason->reason : ''; + my %hash = $self->hash; my $inactive = time - $hash{'susp'}; @@ -1288,6 +1456,61 @@ sub unsuspend { return $error; } + my $unsusp_pkg; + + if ( $reason && $reason->unsuspend_pkgpart ) { + my $part_pkg = FS::part_pkg->by_key($reason->unsuspend_pkgpart) + or $error = "Unsuspend package definition ".$reason->unsuspend_pkgpart. + " not found."; + my $start_date = $self->cust_main->next_bill_date + if $reason->unsuspend_hold; + + if ( $part_pkg ) { + $unsusp_pkg = FS::cust_pkg->new({ + 'custnum' => $self->custnum, + 'pkgpart' => $reason->unsuspend_pkgpart, + 'start_date' => $start_date, + 'locationnum' => $self->locationnum, + # discount? probably not... + }); + + $error ||= $self->cust_main->order_pkg( 'cust_pkg' => $unsusp_pkg ); + } + + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + if ( $conf->config('unsuspend_email_admin') ) { + + my $error = send_email( + 'from' => $conf->config('invoice_from', $self->cust_main->agentnum), + #invoice_from ??? well as good as any + 'to' => $conf->config('unsuspend_email_admin'), + 'subject' => 'FREESIDE NOTIFICATION: Customer package unsuspended', 'body' => [ + "This is an automatic message from your Freeside installation\n", + "informing you that the following customer package has been unsuspended:\n", + "\n", + 'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n", + 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n", + ( map { "Service : $_\n" } @labels ), + ($unsusp_pkg ? + "An unsuspension fee was charged: ". + $unsusp_pkg->part_pkg->pkg_comment."\n" + : '' + ), + ], + ); + + if ( $error ) { + warn "WARNING: can't send unsuspension admin email (unsuspending anyway): ". + "$error\n"; + } + + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no errors @@ -1895,7 +2118,7 @@ sub cust_svc { } if ( $opt{'svcdb'} ) { $search{addl_from} = ' LEFT JOIN part_svc USING ( svcpart ) '; - $search{hashref}->{svcdb} = $opt{'svcdb'}; + $search{extra_sql} = ' AND svcdb = '. dbh->quote( $opt{'svcdb'} ); } cluck "cust_pkg->cust_svc called" if $DEBUG > 2; @@ -2029,11 +2252,14 @@ field, I<num_avail>, which specifies the number of available services. sub available_part_svc { my $self = shift; + + my $pkg_quantity = $self->quantity || 1; + grep { $_->num_avail > 0 } map { my $part_svc = $_->part_svc; $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking - $_->quantity - $self->num_cust_svc($_->svcpart); + $pkg_quantity * $_->quantity - $self->num_cust_svc($_->svcpart); # more evil encapsulation breakage if($part_svc->{'Hash'}{'num_avail'} > 0) { @@ -2075,6 +2301,8 @@ sub part_svc { my $self = shift; my %opt = @_; + my $pkg_quantity = $self->quantity || 1; + #XXX some sort of sort order besides numeric by svcpart... my @part_svc = sort { $a->svcpart <=> $b->svcpart } map { my $pkg_svc = $_; @@ -2082,7 +2310,7 @@ sub part_svc { my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart); $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil $part_svc->{'Hash'}{'num_avail'} = - max( 0, $pkg_svc->quantity - $num_cust_svc ); + max( 0, $pkg_quantity * $pkg_svc->quantity - $num_cust_svc ); $part_svc->{'Hash'}{'cust_pkg_svc'} = $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [] unless exists($opt{summarize_size}) && $opt{summarize_size} > 0 @@ -2441,6 +2669,39 @@ Returns the label of the location object (see L<FS::cust_location>). #end of subs in location_Mixin.pm now... unfortunately the POD doesn't mixin +=item tax_locationnum + +Returns the foreign key to a L<FS::cust_location> object for calculating +tax on this package, as determined by the C<tax-pkg_address> and +C<tax-ship_address> configuration flags. + +=cut + +sub tax_locationnum { + my $self = shift; + my $conf = FS::Conf->new; + if ( $conf->exists('tax-pkg_address') ) { + return $self->locationnum; + } + elsif ( $conf->exists('tax-ship_address') ) { + return $self->cust_main->ship_locationnum; + } + else { + return $self->cust_main->bill_locationnum; + } +} + +=item tax_location + +Returns the L<FS::cust_location> object for tax_locationnum. + +=cut + +sub tax_location { + my $self = shift; + FS::cust_location->by_key( $self->tax_locationnum ) +} + =item seconds_since TIMESTAMP Returns the number of seconds all accounts (see L<FS::svc_acct>) in this @@ -2487,7 +2748,7 @@ sub seconds_since_sqlradacct { grep { my $part_svc = $_->part_svc; $part_svc->svcdb eq 'svc_acct' - && scalar($part_svc->part_export('sqlradius')); + && scalar($part_svc->part_export_usage); } $self->cust_svc ) { $seconds += $cust_svc->seconds_since_sqlradacct($start, $end); @@ -2519,7 +2780,7 @@ sub attribute_since_sqlradacct { grep { my $part_svc = $_->part_svc; $part_svc->svcdb eq 'svc_acct' - && scalar($part_svc->part_export('sqlradius')); + && scalar($part_svc->part_export_usage); } $self->cust_svc ) { $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib); @@ -3057,7 +3318,12 @@ specifies the user for agent virtualization =item fcc_line - boolean selects packages containing fcc form 477 telco lines +boolean; if true, returns only packages with more than 0 FCC phone lines. + +=item state, country + +Limit to packages with a service location in the specified state and country. +For FCC 477 reporting, mostly. =back @@ -3231,8 +3497,8 @@ sub search { if ( exists($params->{'censustract'}) ) { $params->{'censustract'} =~ /^([.\d]*)$/; - my $censustract = "cust_main.censustract = '$1'"; - $censustract .= ' OR cust_main.censustract is NULL' unless $1; + my $censustract = "cust_location.censustract = '$1'"; + $censustract .= ' OR cust_location.censustract is NULL' unless $1; push @where, "( $censustract )"; } @@ -3244,10 +3510,22 @@ sub search { ) { if ($1) { - push @where, "cust_main.censustract LIKE '$1%'"; + push @where, "cust_location.censustract LIKE '$1%'"; } else { push @where, - "( cust_main.censustract = '' OR cust_main.censustract IS NULL )"; + "( cust_location.censustract = '' OR cust_location.censustract IS NULL )"; + } + } + + ### + # parse country/state + ### + for (qw(state country)) { # parsing rules are the same for these + if ( exists($params->{$_}) + && uc($params->{$_}) =~ /^([A-Z]{2})$/ ) + { + # XXX post-2.3 only--before that, state/country may be in cust_main + push @where, "cust_location.$_ = '$1'"; } } @@ -3375,22 +3653,36 @@ sub search { my $addl_from = 'LEFT JOIN cust_main USING ( custnum ) '. 'LEFT JOIN part_pkg USING ( pkgpart ) '. - 'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) '; + 'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) '. + 'LEFT JOIN cust_location USING ( locationnum ) '; + + my $select; + my $count_query; + if ( $params->{'select_zip5'} ) { + my $zip = 'cust_location.zip'; - my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql"; + $select = "DISTINCT substr($zip,1,5) as zip"; + $orderby = "ORDER BY substr($zip,1,5)"; + $count_query = "SELECT COUNT( DISTINCT substr($zip,1,5) )"; + } else { + $select = join(', ', + 'cust_pkg.*', + ( map "part_pkg.$_", qw( pkg freq ) ), + 'pkg_class.classname', + 'cust_main.custnum AS cust_main_custnum', + FS::UI::Web::cust_sql_fields( + $params->{'cust_fields'} + ), + ); + $count_query = 'SELECT COUNT(*)'; + } + + $count_query .= " FROM cust_pkg $addl_from $extra_sql"; my $sql_query = { 'table' => 'cust_pkg', 'hashref' => {}, - 'select' => join(', ', - 'cust_pkg.*', - ( map "part_pkg.$_", qw( pkg freq ) ), - 'pkg_class.classname', - 'cust_main.custnum AS cust_main_custnum', - FS::UI::Web::cust_sql_fields( - $params->{'cust_fields'} - ), - ), + 'select' => $select, 'extra_sql' => $extra_sql, 'order_by' => $orderby, 'addl_from' => $addl_from, @@ -3427,6 +3719,25 @@ sub fcc_477_count { } +=item tax_locationnum_sql + +Returns an SQL expression for the tax location for a package, based +on the settings of 'tax-pkg_address' and 'tax-ship_address'. + +=cut + +sub tax_locationnum_sql { + my $conf = FS::Conf->new; + if ( $conf->exists('tax-pkg_address') ) { + 'cust_pkg.locationnum'; + } + elsif ( $conf->exists('tax-ship_address') ) { + 'cust_main.ship_locationnum'; + } + else { + 'cust_main.bill_locationnum'; + } +} =item location_sql @@ -3445,7 +3756,13 @@ sub location_sql { # '?' placeholders in _location_sql_where my $x = $ornull ? 3 : 2; - my @bill_param = ( ('city')x3, ('county')x$x, ('state')x$x, 'country' ); + my @bill_param = ( + ('district')x3, + ('city')x3, + ('county')x$x, + ('state')x$x, + 'country' + ); my $main_where; my @main_param; @@ -3504,16 +3821,19 @@ sub _location_sql_where { $ornull = $ornull ? ' OR ? IS NULL ' : ''; - my $or_empty_city = " OR ( ? = '' AND $table.${prefix}city IS NULL ) "; - my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL ) "; - my $or_empty_state = " OR ( ? = '' AND $table.${prefix}state IS NULL ) "; + my $or_empty_city = " OR ( ? = '' AND $table.${prefix}city IS NULL )"; + my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL )"; + my $or_empty_state = " OR ( ? = '' AND $table.${prefix}state IS NULL )"; + + my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text'; # ( $table.${prefix}city = ? $or_empty_city $ornull ) " - ( $table.${prefix}city = ? OR ? = '' OR CAST(? AS text) IS NULL ) - AND ( $table.${prefix}county = ? $or_empty_county $ornull ) - AND ( $table.${prefix}state = ? $or_empty_state $ornull ) - AND $table.${prefix}country = ? + ( $table.district = ? OR ? = '' OR CAST(? AS $text) IS NULL ) + AND ( $table.${prefix}city = ? OR ? = '' OR CAST(? AS $text) IS NULL ) + AND ( $table.${prefix}county = ? $or_empty_county $ornull ) + AND ( $table.${prefix}state = ? $or_empty_state $ornull ) + AND $table.${prefix}country = ? "; } diff --git a/FS/FS/cust_pkg_discount.pm b/FS/FS/cust_pkg_discount.pm index a20794027..5f4d0dccf 100644 --- a/FS/FS/cust_pkg_discount.pm +++ b/FS/FS/cust_pkg_discount.pm @@ -106,7 +106,8 @@ sub insert { 'amount' => $self->amount, 'percent' => $self->percent, 'months' => $self->months, - 'setup' => $self->setup, + 'setup' => $self->setup, + #'linked' => $self->linked, 'disabled' => 'Y', }; my $error = $discount->insert; diff --git a/FS/FS/cust_pkg_reason.pm b/FS/FS/cust_pkg_reason.pm index 641605f05..c29a2f928 100644 --- a/FS/FS/cust_pkg_reason.pm +++ b/FS/FS/cust_pkg_reason.pm @@ -4,6 +4,7 @@ use strict; use vars qw( $ignore_empty_action ); use base qw( FS::otaker_Mixin FS::Record ); use FS::Record qw( qsearch qsearchs ); +use FS::upgrade_journal; $ignore_empty_action = 0; @@ -209,6 +210,25 @@ sub _upgrade_data { # class method } #remove nullability if scalar(@migrated) - $count == 0 && ->column('action'); + + unless ( FS::upgrade_journal->is_done('cust_pkg_reason__missing_reason') ) { + $class->_upgrade_missing_reason(%opts); + FS::upgrade_journal->set_done('cust_pkg_reason__missing_reason'); + } + + #still can't fill in an action? don't abort the upgrade + local($ignore_empty_action) = 1; + + $class->_upgrade_otaker(%opts); + +} + +sub _upgrade_missing_reason { + my ($class, %opts) = @_; + + #false laziness w/above + my $action_replace = + " AND ( history_action = 'replace_old' OR history_action = 'replace_new' )"; #seek expirations/adjourns without reason foreach my $field (qw( expire adjourn cancel susp )) { @@ -309,10 +329,6 @@ sub _upgrade_data { # class method } } - #still can't fill in an action? don't abort the upgrade - local($ignore_empty_action) = 1; - - $class->_upgrade_otaker(%opts); } =back diff --git a/FS/FS/cust_statement.pm b/FS/FS/cust_statement.pm index 45fae1ccf..9954b7b90 100644 --- a/FS/FS/cust_statement.pm +++ b/FS/FS/cust_statement.pm @@ -6,6 +6,8 @@ use FS::Record qw( dbh qsearch ); #qsearchs ); use FS::cust_main; use FS::cust_bill; +use List::Util qw( sum ); + =head1 NAME FS::cust_statement - Object methods for cust_statement records @@ -61,8 +63,13 @@ 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. Pass "statementnum => 'ALL'" to create a temporary statement that includes -all of the customer's invoices. This statement can't be inserted and won't -set the statementnum field on any invoices. +all of the customer's open invoices. This statement can't be inserted and +won't set the statementnum field on any invoices. + +Pass "invnum => number" to create a temporary statement including only +the specified invoice. This is functionally the same as the invoice itself, +but will be rendered using the statement template and other +statement-specific options. =cut @@ -170,13 +177,23 @@ Returns the associated invoices (cust_bill records) for this statement. sub cust_bill { my $self = shift; # we use it about a thousand times, let's cache it - $self->{Hash}->{cust_bill} ||= [ - qsearch('cust_bill', { - $self->statementnum eq 'ALL' ? - ('custnum' => $self->custnum) : - ('statementnum' => $self->statementnum) - } ) - ]; + if ( !exists($self->{Hash}->{cust_bill}) ) { + my @cust_bill; + if ( $self->invnum && $self->invnum =~ /^\d+$/ ) { + # one specific invoice + @cust_bill = FS::cust_bill->by_key($self->invnum) + or die "unknown invnum '".$self->invnum."'"; + $self->set('custnum' => $cust_bill[0]->custnum); + } elsif ( $self->statementnum eq 'ALL' ) { + # all open invoices + @cust_bill = $self->cust_main->open_cust_bill; + } else { + @cust_bill = qsearch('cust_bill', + { statementnum => $self->statementnum } + ); + } + $self->{Hash}->{cust_bill} = \@cust_bill; + } @{ $self->{Hash}->{cust_bill} } } @@ -266,9 +283,20 @@ sub tax { shift->_total('tax', @_); } sub charged { shift->_total('charged', @_); } sub owed { shift->_total('owed', @_); } -#don't show previous info +sub enable_previous { + my $self = shift; + $self->conf->exists('previous_balance-show_on_statements'); +} + sub previous { - ( 0 ); # 0, empty list + my $self = shift; + if ( $self->enable_previous ) { + my @previous = grep { $_->_date < ($self->cust_bill)[0]->_date } + $self->cust_main->open_cust_bill; + return(sum(map {$_->owed} @previous), @previous); + } else { + return 0; + } } =back diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index fc6e60594..52069316d 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -69,6 +69,8 @@ The following fields are currently supported: =item svcpart - Service definition (see L<FS::part_svc>) +=item agent_svcid - Optional legacy service ID + =item overlimit - date the service exceeded its usage limit =back @@ -98,6 +100,28 @@ 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. +=cut + +sub delete { + my $self = shift; + my $error = $self->SUPER::delete; + return $error if $error; + + if ( FS::Conf->new->config('ticket_system') eq 'RT_Internal' ) { + FS::TicketSystem->init; + my $session = FS::TicketSystem->session; + my $links = RT::Links->new($session->{CurrentUser}); + my $svcnum = $self->svcnum; + $links->Limit(FIELD => 'Target', + VALUE => 'freeside://freeside/cust_svc/'.$svcnum); + while ( my $l = $links->Next ) { + my ($val, $msg) = $l->Delete; + # can't do anything useful on error + warn "error unlinking ticket $svcnum: $msg\n" if !$val; + } + } +} + =item cancel Cancels the relevant service by calling the B<cancel> method of the associated @@ -297,6 +321,7 @@ sub check { $self->ut_numbern('svcnum') || $self->ut_numbern('pkgnum') || $self->ut_number('svcpart') + || $self->ut_numbern('agent_svcid') || $self->ut_numbern('overlimit') ; return $error if $error; @@ -310,15 +335,27 @@ sub check { ($part_svc) = grep { $_->svcpart == $self->svcpart } $cust_pkg->part_svc; return "No svcpart ". $self->svcpart. " services in pkgpart ". $cust_pkg->pkgpart - unless $part_svc; + unless $part_svc || $ignore_quantity; return "Already ". $part_svc->get('num_cust_svc'). " ". $part_svc->svc. " services for pkgnum ". $self->pkgnum - if $part_svc->get('num_avail') == 0 and !$ignore_quantity; + if !$ignore_quantity && $part_svc->get('num_avail') <= 0 ; } $self->SUPER::check; } +=item display_svcnum + +Returns the displayed service number for this service: agent_svcid if it has a +value, svcnum otherwise + +=cut + +sub display_svcnum { + my $self = shift; + $self->agent_svcid || $self->svcnum; +} + =item part_svc Returns the definition for this service, as a FS::part_svc object (see @@ -756,6 +793,107 @@ sub get_session_history { } +=item tickets + +Returns an array of hashes representing the tickets linked to this service. + +=cut + +sub tickets { + my $self = shift; + + my $conf = FS::Conf->new; + my $num = $conf->config('cust_main-max_tickets') || 10; + my @tickets = (); + + if ( $conf->config('ticket_system') ) { + unless ( $conf->config('ticket_system-custom_priority_field') ) { + + @tickets = @{ FS::TicketSystem->service_tickets($self->svcnum, $num) }; + + } else { + + foreach my $priority ( + $conf->config('ticket_system-custom_priority_field-values'), '' + ) { + last if scalar(@tickets) >= $num; + push @tickets, + @{ FS::TicketSystem->service_tickets( $self->svcnum, + $num - scalar(@tickets), + $priority, + ) + }; + } + } + } + (@tickets); +} + + +=back + +=head1 SUBROUTINES + +=over 4 + +=item smart_search OPTION => VALUE ... + +Accepts the option I<search>, the string to search for. The string will +be searched for as a username, email address, IP address, MAC address, +phone number, and hardware serial number. Unlike the I<smart_search> on +customers, this always requires an exact match. + +=cut + +# though perhaps it should be fuzzy in some cases? + +sub smart_search { + my %param = __PACKAGE__->smart_search_param(@_); + qsearch(\%param); +} + +sub smart_search_param { + my $class = shift; + my %opt = @_; + + my $string = $opt{'search'}; + $string =~ s/(^\s+|\s+$)//; #trim leading & trailing whitespace + + my @or = + map { my $table = $_; + my $search_sql = "FS::$table"->search_sql($string); + " ( svcdb = '$table' + AND 0 < ( SELECT COUNT(*) FROM $table + WHERE $table.svcnum = cust_svc.svcnum + AND $search_sql + ) + ) "; + } + FS::part_svc->svc_tables; + + if ( $string =~ /^(\d+)$/ ) { + unshift @or, " ( agent_svcid IS NOT NULL AND agent_svcid = $1 ) "; + } + + my @extra_sql = ' ( '. join(' OR ', @or). ' ) '; + + push @extra_sql, $FS::CurrentUser::CurrentUser->agentnums_sql( + 'null_right' => 'View/link unlinked services' + ); + my $extra_sql = ' WHERE '.join(' AND ', @extra_sql); + #for agentnum + my $addl_from = ' LEFT JOIN cust_pkg USING ( pkgnum )'. + ' LEFT JOIN cust_main USING ( custnum )'. + ' LEFT JOIN part_svc USING ( svcpart )'; + + ( + 'table' => 'cust_svc', + 'addl_from' => $addl_from, + 'hashref' => {}, + 'extra_sql' => $extra_sql, + ); +} + =back =head1 BUGS diff --git a/FS/FS/cust_tax_exempt_pkg.pm b/FS/FS/cust_tax_exempt_pkg.pm index e63b84b30..bbabb5b0a 100644 --- a/FS/FS/cust_tax_exempt_pkg.pm +++ b/FS/FS/cust_tax_exempt_pkg.pm @@ -7,6 +7,10 @@ use FS::cust_main_Mixin; use FS::cust_bill_pkg; use FS::cust_main_county; use FS::cust_credit_bill_pkg; +use FS::UID qw(dbh); +use FS::upgrade_journal; + +# some kind of common ancestor with cust_bill_pkg_tax_location would make sense @ISA = qw( FS::cust_main_Mixin FS::Record ); @@ -32,22 +36,45 @@ FS::cust_tax_exempt_pkg - Object methods for cust_tax_exempt_pkg records =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: +exemption. Whenever a package would be taxed (based on its location and +taxclass), but some or all of it is exempt from taxation, an +FS::cust_tax_exempt_pkg record is created. + +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 billpkgnum - invoice line item (see L<FS::cust_bill_pkg>) that +was exempted from tax. =item taxnum - tax rate (see L<FS::cust_main_county>) -=item year +=item year - the year in which the exemption occurred. NULL if this +is a customer or package exemption rather than a monthly exemption. + +=item month - the month in which the exemption occurred. NULL if this +is a customer or package exemption. + +=item amount - the amount of revenue exempted. For monthly exemptions +this may be anything up to the monthly exemption limit defined in +L<FS::cust_main_county> for this tax. For customer exemptions it is +always the full price of the line item. For package exemptions it +may be the setup fee, the recurring fee, or the sum of those. + +=item exempt_cust - flag indicating that the customer is tax-exempt +(cust_main.tax = 'Y'). -=item month +=item exempt_cust_taxname - flag indicating that the customer is exempt +from the tax with this name (see L<FS::cust_main_exemption). -=item amount +=item exempt_setup, exempt_recur: flag indicating that the package's setup +or recurring fee is not taxable (part_pkg.setuptax and part_pkg.recurtax). + +=item exempt_monthly: flag indicating that this is a monthly per-customer +exemption (Texas tax). =back @@ -109,18 +136,44 @@ and replace methods. sub check { my $self = shift; - $self->ut_numbern('exemptnum') -# || $self->ut_foreign_key('custnum', 'cust_main', 'custnum') + my $error = $self->ut_numbern('exemptnum') || $self->ut_foreign_key('billpkgnum', 'cust_bill_pkg', 'billpkgnum') || $self->ut_foreign_key('taxnum', 'cust_main_county', 'taxnum') || $self->ut_foreign_keyn('creditbillpkgnum', 'cust_credit_bill_pkg', 'creditbillpkgnum') - || $self->ut_number('year') #check better - || $self->ut_number('month') #check better + || $self->ut_numbern('year') #check better + || $self->ut_numbern('month') #check better || $self->ut_money('amount') + || $self->ut_flag('exempt_cust') + || $self->ut_flag('exempt_setup') + || $self->ut_flag('exempt_recur') + || $self->ut_flag('exempt_cust_taxname') || $self->SUPER::check ; + + return $error if $error; + + if ( $self->get('exempt_cust') ) { + $self->set($_ => '') for qw( + exempt_cust_taxname exempt_setup exempt_recur exempt_monthly month year + ); + } elsif ( $self->get('exempt_cust_taxname') ) { + $self->set($_ => '') for qw( + exempt_setup exempt_recur exempt_monthly month year + ); + } elsif ( $self->get('exempt_setup') || $self->get('exempt_recur') ) { + $self->set($_ => '') for qw(exempt_monthly month year); + } elsif ( $self->get('exempt_monthly') ) { + $self->year =~ /^\d{4}$/ + or return "illegal exemption year: '".$self->year."'"; + $self->month >= 1 && $self->month <= 12 + or return "illegal exemption month: '".$self->month."'"; + } else { + return "no exemption type selected"; + } + + ''; } =item cust_main_county @@ -135,6 +188,18 @@ sub cust_main_county { qsearchs( 'cust_main_county', { 'taxnum', $self->taxnum } ); } +sub _upgrade_data { + my $class = shift; + + my $journal = 'cust_tax_exempt_pkg_flags'; + if ( !FS::upgrade_journal->is_done($journal) ) { + my $sql = "UPDATE cust_tax_exempt_pkg SET exempt_monthly = 'Y' ". + "WHERE month IS NOT NULL"; + dbh->do($sql) or die dbh->errstr; + FS::upgrade_journal->set_done($journal); + } +} + =back =head1 BUGS diff --git a/FS/FS/cust_tax_exempt_pkg_void.pm b/FS/FS/cust_tax_exempt_pkg_void.pm new file mode 100644 index 000000000..bfbc8c739 --- /dev/null +++ b/FS/FS/cust_tax_exempt_pkg_void.pm @@ -0,0 +1,143 @@ +package FS::cust_tax_exempt_pkg_void; + +use strict; +use base qw( FS::Record ); +use FS::Record; # qw( qsearch qsearchs ); +use FS::cust_bill_pkg_void; +use FS::cust_main_county; + +=head1 NAME + +FS::cust_tax_exempt_pkg_void - Object methods for cust_tax_exempt_pkg_void records + +=head1 SYNOPSIS + + use FS::cust_tax_exempt_pkg_void; + + $record = new FS::cust_tax_exempt_pkg_void \%hash; + $record = new FS::cust_tax_exempt_pkg_void { '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_void object represents a voided record of a customer +tax exemption. FS::cust_tax_exempt_pkg_void inherits from FS::Record. The +following fields are currently supported: + +=over 4 + +=item exemptpkgnum + +primary key + +=item billpkgnum + +billpkgnum + +=item taxnum + +taxnum + +=item year + +year + +=item month + +month + +=item creditbillpkgnum + +creditbillpkgnum + +=item amount + +amount + + +=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_tax_exempt_pkg_void'; } + +=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 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('exemptpkgnum') + || $self->ut_foreign_key('billpkgnum', 'cust_bill_pkg_void', 'billpkgnum' ) + || $self->ut_foreign_key('taxnum', 'cust_main_county', 'taxnum') + || $self->ut_numbern('year') + || $self->ut_numbern('month') + || $self->ut_numbern('creditbillpkgnum') #no FK check, will have been del'ed + || $self->ut_money('amount') + || $self->ut_flag('exempt_cust') + || $self->ut_flag('exempt_setup') + || $self->ut_flag('exempt_recur') + || $self->ut_flag('exempt_cust_taxname') + || $self->ut_flag('exempt_monthly') + ; + 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/cust_tax_location.pm b/FS/FS/cust_tax_location.pm index 161a6547b..1a9bf5a41 100644 --- a/FS/FS/cust_tax_location.pm +++ b/FS/FS/cust_tax_location.pm @@ -298,7 +298,7 @@ sub batch_import { } if ( scalar( @columns ) ) { $dbh->rollback if $oldAutoCommit; - return "Unexpected trailing columns in line (wrong format?): $line"; + return "Unexpected trailing columns in line (wrong format?) importing cust_tax_location: $line"; } my $error = &{$hook}(\%cust_tax_location); diff --git a/FS/FS/detail_format/sum_duration_prefix.pm b/FS/FS/detail_format/sum_duration_prefix.pm index d70ad0e5a..04590415c 100644 --- a/FS/FS/detail_format/sum_duration_prefix.pm +++ b/FS/FS/detail_format/sum_duration_prefix.pm @@ -71,7 +71,7 @@ sub finish { $prefix, map({ $_->{count}, - (int($_->{duration}/60) . ' min'), + sprintf('%.01f min', $_->{duration}/60), } @subtotals ), $self->money_char . sprintf('%.02f',$total_amount), ); diff --git a/FS/FS/discount.pm b/FS/FS/discount.pm index 88cbdd41c..f6f994599 100644 --- a/FS/FS/discount.pm +++ b/FS/FS/discount.pm @@ -136,6 +136,7 @@ sub check { || $self->ut_floatn('months') #actually decimal, but this will do || $self->ut_enum('disabled', [ '', 'Y' ]) || $self->ut_enum('setup', [ '', 'Y' ]) + #|| $self->ut_enum('linked', [ '', 'Y' ]) ; return $error if $error; diff --git a/FS/FS/domain_record.pm b/FS/FS/domain_record.pm index 8d767d510..cd881ae08 100644 --- a/FS/FS/domain_record.pm +++ b/FS/FS/domain_record.pm @@ -3,8 +3,7 @@ package FS::domain_record; use strict; use vars qw( @ISA $noserial_hack $DEBUG $me ); use FS::Conf; -#use FS::Record qw( qsearch qsearchs ); -use FS::Record qw( qsearchs dbh ); +use FS::Record qw( qsearchs dbh ); #qsearch use FS::svc_domain; use FS::svc_www; diff --git a/FS/FS/ftp_target.pm b/FS/FS/ftp_target.pm new file mode 100644 index 000000000..bf9fc891a --- /dev/null +++ b/FS/FS/ftp_target.pm @@ -0,0 +1,194 @@ +package FS::ftp_target; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearch qsearchs ); +use vars qw($me $DEBUG); + +$DEBUG = 0; + +=head1 NAME + +FS::ftp_target - Object methods for ftp_target records + +=head1 SYNOPSIS + + use FS::ftp_target; + + $record = new FS::ftp_target \%hash; + $record = new FS::ftp_target { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::ftp_target object represents an account on a remote FTP or SFTP +server for transferring files. FS::ftp_target inherits from FS::Record. + +=over 4 + +=item targetnum - primary key + +=item agentnum - L<FS::agent> foreign key; can be null + +=item hostname - the DNS name of the FTP site + +=item username - username + +=item password - password + +=item path - the working directory to change to upon connecting + +=item secure - a flag ('Y' or null) for whether to use SFTP + +=back + +=head1 METHODS + +=over 4 + +=cut + +sub table { 'ftp_target'; } + +=item new HASHREF + +Creates a new FTP target. To add it to the database, see L<"insert">. + +=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. + +=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 + +sub check { + my $self = shift; + + if ( !$self->get('port') ) { + if ( $self->secure ) { + $self->set('port', 22); + } else { + $self->set('port', 21); + } + } + + my $error = + $self->ut_numbern('targetnum') + || $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum') + || $self->ut_text('hostname') + || $self->ut_text('username') + || $self->ut_text('password') + || $self->ut_number('port') + || $self->ut_text('path') + || $self->ut_flag('secure') + || $self->ut_enum('handling', [ $self->handling_types ]) + ; + return $error if $error; + + $self->SUPER::check; +} + +=item connect + +Creates a Net::FTP or Net::SFTP::Foreign object (according to the setting +of the 'secure' flag), connects to 'hostname', attempts to log in with +'username' and 'password', and changes the working directory to 'path'. +On success, returns the object. On failure, dies with an error message. + +=cut + +sub connect { + my $self = shift; + if ( $self->secure ) { + eval "use Net::SFTP::Foreign;"; + die $@ if $@; + my %args = ( + port => $self->port, + user => $self->username, + password => $self->password, + more => ($DEBUG ? '-v' : ''), + timeout => 30, + autodie => 1, #we're doing this anyway + ); + my $sftp = Net::SFTP::Foreign->new($self->hostname, %args); + $sftp->setcwd($self->path); + return $sftp; + } + else { + eval "use Net::FTP;"; + die $@ if $@; + my %args = ( + Debug => $DEBUG, + Port => $self->port, + Passive => 1,# optional? + ); + my $ftp = Net::FTP->new($self->hostname, %args) + or die "connect to ".$self->hostname." failed: $@"; + $ftp->login($self->username, $self->password) + or die "login to ".$self->username.'@'.$self->hostname." failed: $@"; + $ftp->binary; #optional? + $ftp->cwd($self->path) + or ($self->path eq '/') + or die "cwd to ".$self->hostname.'/'.$self->path." failed: $@"; + + return $ftp; + } +} + +=item label + +Returns a descriptive label for this target. + +=cut + +sub label { + my $self = shift; + $self->targetnum . ': ' . $self->username . '@' . $self->hostname; +} + +=item handling_types + +Returns a list of values for the "handling" field, corresponding to the +known ways to preprocess a file before uploading. Currently those are +implemented somewhat crudely in L<FS::Cron::upload>. + +=cut + +sub handling_types { + '', + #'billco', #not implemented this way yet + 'bridgestone', +} + +=back + +=head1 SEE ALSO + +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/h_cust_main_exemption.pm b/FS/FS/h_cust_main_exemption.pm new file mode 100644 index 000000000..072c4123e --- /dev/null +++ b/FS/FS/h_cust_main_exemption.pm @@ -0,0 +1,19 @@ +package FS::h_cust_main_exemption; + +use strict; +use base qw( FS::h_Common FS::cust_main_exemption ); + +sub table { 'h_cust_main_exemption' }; + +=head1 NAME + +FS::h_cust_main_exemption - Historical customer tax exemption records. + +=head1 SEE ALSO + +L<FS::cust_main_exemption>, L<FS::h_Common>, L<FS::Record>. + +=cut + +1; + diff --git a/FS/FS/h_part_pkg.pm b/FS/FS/h_part_pkg.pm new file mode 100644 index 000000000..2c0e65f22 --- /dev/null +++ b/FS/FS/h_part_pkg.pm @@ -0,0 +1,37 @@ +package FS::h_part_pkg; + +use strict; +use vars qw( @ISA ); +use base qw(FS::h_Common FS::part_pkg); + +sub table { 'h_part_pkg' }; + +sub _rebless {}; # don't try to rebless these + +=head1 NAME + +FS::h_part_pkg - Historical record of package definition. + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +An FS::h_part_pkg object represents historical changes to package +definitions. + +=head1 BUGS + +Many important properties of a part_pkg are in other tables, especially +plan options, service allotments, and link/bundle relationships. The +methods to access those from the part_pkg will work, but they're +really accessing current, not historical, data. Be careful. + +=head1 SEE ALSO + +L<FS::part_pkg>, L<FS::h_Common>, L<FS::Record>, schema.html from the base +documentation. + +=cut + +1; + diff --git a/FS/FS/h_radius_usergroup.pm b/FS/FS/h_radius_usergroup.pm new file mode 100644 index 000000000..bbccd6bb7 --- /dev/null +++ b/FS/FS/h_radius_usergroup.pm @@ -0,0 +1,24 @@ +package FS::h_radius_usergroup; + +use strict; +use base qw( FS::h_Common FS::radius_usergroup ); + +sub table { 'h_radius_usergroup' }; + +=head1 NAME + +FS::h_radius_usergroup - Historical RADIUS usergroup records. + +=head1 DESCRIPTION + +An FS::h_radius_usergroup object represents historical changes to an account's +RADIUS group (L<FS::radius_usergroup>). + +=head1 SEE ALSO + +L<FS::radius_usergroup>, L<FS::h_Common>, L<FS::Record> + +=cut + +1; + diff --git a/FS/FS/h_svc_Radius_Mixin.pm b/FS/FS/h_svc_Radius_Mixin.pm new file mode 100644 index 000000000..af2977085 --- /dev/null +++ b/FS/FS/h_svc_Radius_Mixin.pm @@ -0,0 +1,17 @@ +package FS::h_svc_Radius_Mixin; + +use strict; +use FS::Record qw( qsearch ); +use FS::h_radius_usergroup; + +sub h_usergroup { + my $self = shift; + map { $_->groupnum } + qsearch( 'h_radius_usergroup', + { svcnum => $self->svcnum }, + FS::h_radius_usergroup->sql_h_searchs(@_), + ); +} + +1; + diff --git a/FS/FS/h_svc_acct.pm b/FS/FS/h_svc_acct.pm index 247d20c9a..f525f8206 100644 --- a/FS/FS/h_svc_acct.pm +++ b/FS/FS/h_svc_acct.pm @@ -1,16 +1,13 @@ package FS::h_svc_acct; +use base qw( FS::h_svc_Radius_Mixin FS::h_Common FS::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' }; diff --git a/FS/FS/h_svc_broadband.pm b/FS/FS/h_svc_broadband.pm index d6038fbe8..01477fe1c 100644 --- a/FS/FS/h_svc_broadband.pm +++ b/FS/FS/h_svc_broadband.pm @@ -1,11 +1,8 @@ package FS::h_svc_broadband; +use base qw( FS::h_svc_Radius_Mixin FS::h_Common FS::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' }; diff --git a/FS/FS/inventory_item.pm b/FS/FS/inventory_item.pm index 39a0dff4b..477c93410 100644 --- a/FS/FS/inventory_item.pm +++ b/FS/FS/inventory_item.pm @@ -111,6 +111,7 @@ sub check { 'Edit global inventory'] ) || $self->ut_text('item') || $self->ut_foreign_keyn('svcnum', 'cust_svc', 'svcnum' ) + || $self->ut_alphan('svc_field') ; return $error if $error; diff --git a/FS/FS/msg_template.pm b/FS/FS/msg_template.pm index e47776c86..cac7fe572 100644 --- a/FS/FS/msg_template.pm +++ b/FS/FS/msg_template.pm @@ -465,14 +465,12 @@ sub substitutions { name name_short contact contact_firstlast address1 address2 city county state zip country - daytime night fax + daytime night mobile fax has_ship_address - ship_last ship_first ship_company ship_name ship_name_short ship_contact ship_contact_firstlast ship_address1 ship_address2 ship_city ship_county ship_state ship_zip ship_country - ship_daytime ship_night ship_fax paymask payname paytype payip num_cancelled_pkgs num_ncancelled_pkgs num_pkgs @@ -485,6 +483,15 @@ sub substitutions { signupdate dundate packages recurdates ), + #compatibility: obsolete ship_ fields - use the non-ship versions + map ( + { my $field = $_; + [ "ship_$field" => sub { shift->$field } ] + } + qw( last first company daytime night fax ) + ), + # ship_name, ship_name_short, ship_contact, ship_contact_firstlast + # still work, though [ expdate => sub { shift->paydate_epoch } ], #compatibility [ signupdate_ymd => sub { $ymd->(shift->signupdate) } ], [ dundate_ymd => sub { $ymd->(shift->dundate) } ], @@ -671,10 +678,20 @@ sub _upgrade_data { if ( $msg_template->subject || $msg_template->body ) { # create new default content my %content; - foreach ('subject','body') { - $content{$_} = $msg_template->$_; - $msg_template->setfield($_, ''); + $content{subject} = $msg_template->subject; + $msg_template->set('subject', ''); + + # work around obscure Pg/DBD bug + # https://rt.cpan.org/Public/Bug/Display.html?id=60200 + # (though the right fix is to upgrade DBD) + my $body = $msg_template->body; + if ( $body =~ /^x([0-9a-f]+)$/ ) { + # there should be no real message templates that look like that + warn "converting template body to TEXT\n"; + $body = pack('H*', $1); } + $content{body} = $body; + $msg_template->set('body', ''); my $error = $msg_template->replace(%content); die $error if $error; diff --git a/FS/FS/option_Common.pm b/FS/FS/option_Common.pm index 968dcdf79..c1dda22af 100644 --- a/FS/FS/option_Common.pm +++ b/FS/FS/option_Common.pm @@ -65,7 +65,10 @@ sub insert { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $error = $self->SUPER::insert; + my $error; + + $error = $self->check_options($options) + || $self->SUPER::insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -197,7 +200,17 @@ sub replace { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $error = $self->SUPER::replace($old); + my $error; + + if ($options_supplied) { + $error = $self->check_options($options); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + $error = $self->SUPER::replace($old); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -274,6 +287,21 @@ sub replace { } +=item check_options HASHREF + +This method is called by 'insert' and 'replace' to check the options that were supplied. + +Return error-message, or false. + +(In this class, this is a do-nothing routine that always returns false. Override as necessary. No need to call superclass.) + +=cut + +sub check_options { + my ($self, $options) = @_; + ''; +} + =item option_objects Returns all options as FS::I<tablename>_option objects. diff --git a/FS/FS/part_event.pm b/FS/FS/part_event.pm index 62f16fa1c..b7371c9ab 100644 --- a/FS/FS/part_event.pm +++ b/FS/FS/part_event.pm @@ -306,8 +306,8 @@ sub targets { }); my @tested_objects; foreach my $object ( @objects ) { - my $cust_event = $self->new_cust_event($object); - next unless $cust_event->test_conditions('time' => $time); + my $cust_event = $self->new_cust_event($object, 'time' => $time); + next unless $cust_event->test_conditions; $object->set('cust_event', $cust_event); push @tested_objects, $object; diff --git a/FS/FS/part_event/Action/Mixin/credit_agent_pkg_class.pm b/FS/FS/part_event/Action/Mixin/credit_agent_pkg_class.pm new file mode 100644 index 000000000..73d32e0a7 --- /dev/null +++ b/FS/FS/part_event/Action/Mixin/credit_agent_pkg_class.pm @@ -0,0 +1,25 @@ +package FS::part_event::Action::Mixin::credit_agent_pkg_class; +use base qw( FS::part_event::Action::Mixin::credit_pkg ); + +use strict; + +sub option_fields { + my $class = shift; + my %option_fields = $class->SUPER::option_fields; + delete $option_fields{'percent'}; + %option_fields; +} + +sub _calc_credit_percent { + my( $self, $cust_pkg ) = @_; + + my $agent_pkg_class = qsearchs( 'agent_pkg_class', { + 'agentnum' => $self->cust_main($cust_pkg)->agentnum, + 'classnum' => $cust_pkg->classnum, + }); + + $agent_pkg_class ? $agent_pkg_class->commission_percent : 0; + +} + +1; diff --git a/FS/FS/part_event/Action/Mixin/credit_pkg.pm b/FS/FS/part_event/Action/Mixin/credit_pkg.pm index aeda92f91..9dcd701a9 100644 --- a/FS/FS/part_event/Action/Mixin/credit_pkg.pm +++ b/FS/FS/part_event/Action/Mixin/credit_pkg.pm @@ -51,7 +51,7 @@ sub _calc_credit { } } - my $percent = $self->option('percent'); + my $percent = $self->_calc_credit_percent($cust_pkg); #my @arg = $no_cust_pkg{$what} ? () : ($cust_pkg); my @arg = ($what eq 'setup_cost') ? () : ($cust_pkg); @@ -60,4 +60,9 @@ sub _calc_credit { } +sub _calc_credit_percent { + my( $self, $cust_pkg ) = @_; + $self->option('percent'); +} + 1; diff --git a/FS/FS/part_event/Action/cust_bill_email.pm b/FS/FS/part_event/Action/cust_bill_email.pm index a5cd86145..1a3bca4b7 100644 --- a/FS/FS/part_event/Action/cust_bill_email.pm +++ b/FS/FS/part_event/Action/cust_bill_email.pm @@ -17,7 +17,7 @@ sub do_action { #my $cust_main = $self->cust_main($cust_bill); my $cust_main = $cust_bill->cust_main; - $cust_bill->email; + $cust_bill->email unless $cust_main->invoice_noemail; } 1; diff --git a/FS/FS/part_event/Action/cust_bill_fee_greater_percent_or_flat.pm b/FS/FS/part_event/Action/cust_bill_fee_greater_percent_or_flat.pm new file mode 100644 index 000000000..558f5cdf2 --- /dev/null +++ b/FS/FS/part_event/Action/cust_bill_fee_greater_percent_or_flat.pm @@ -0,0 +1,41 @@ +package FS::part_event::Action::cust_bill_fee_greater_percent_or_flat; + +use strict; +use base qw( FS::part_event::Action::fee ); +use Tie::IxHash; + +sub description { 'Late fee (greater of percentage of invoice or flat fee)'; } + +sub eventtable_hashref { + { 'cust_bill' => 1 }; +} + +sub option_fields { + my $class = shift; + + my $t = tie my %option_fields, 'Tie::IxHash', $class->SUPER::option_fields(); + $t->Shift; #assumes charge is first + $t->Unshift( 'flat_fee' => { label=>'Flat Fee', type=>'money', } ); + $t->Unshift( 'percent' => { label=>'Percent', size=>2, } ); + + %option_fields; +} + +sub _calc_fee { + my( $self, $cust_bill ) = @_; + my $percent = sprintf('%.2f', $cust_bill->owed * $self->option('percent') / 100 ); + my $flat_fee = $self->option('flat_fee'); + + my $num = $flat_fee - $percent; + if ($num == 0) { + return($percent); + } + elsif ($num > 0) { + return($flat_fee); + } + else { + return($percent); + } +} + +1; diff --git a/FS/FS/part_event/Action/cust_bill_send_csv_ftp.pm b/FS/FS/part_event/Action/cust_bill_send_csv_ftp.pm index bf472683f..56ba680e1 100644 --- a/FS/FS/part_event/Action/cust_bill_send_csv_ftp.pm +++ b/FS/FS/part_event/Action/cust_bill_send_csv_ftp.pm @@ -2,6 +2,7 @@ package FS::part_event::Action::cust_bill_send_csv_ftp; use strict; use base qw( FS::part_event::Action ); +use FS::Misc::Invoicing qw( spool_formats ); sub description { 'Upload CSV invoice data to an FTP server'; } @@ -15,10 +16,7 @@ sub option_fields { ( 'ftpformat' => { label => 'Format', type =>'select', - options => ['default', 'billco'], - option_labels => { 'default' => 'Default', - 'billco' => 'Billco', - }, + options => [ spool_formats() ], }, 'ftpserver' => 'FTP server', 'ftpusername' => 'FTP username', diff --git a/FS/FS/part_event/Action/cust_bill_spool_csv.pm b/FS/FS/part_event/Action/cust_bill_spool_csv.pm index 11ecbc555..14349a9dd 100644 --- a/FS/FS/part_event/Action/cust_bill_spool_csv.pm +++ b/FS/FS/part_event/Action/cust_bill_spool_csv.pm @@ -2,6 +2,7 @@ package FS::part_event::Action::cust_bill_spool_csv; use strict; use base qw( FS::part_event::Action ); +use FS::Misc::Invoicing qw( spool_formats ); sub description { 'Spool CSV invoice data'; } @@ -15,10 +16,7 @@ sub option_fields { ( 'spoolformat' => { label => 'Format', type => 'select', - options => ['default', 'billco'], - option_labels => { 'default' => 'Default', - 'billco' => 'Billco', - }, + options => [ spool_formats() ], }, 'spoolbalanceover' => { label => 'If balance (this invoice and previous) over', @@ -28,6 +26,13 @@ sub option_fields { type => 'checkbox', value => '1', }, + 'ftp_targetnum' => { label => 'Upload spool to FTP target', + type => 'select-table', + table => 'ftp_target', + name_col => 'label', + empty_label => '(do not upload)', + order_by => 'targetnum', + }, ); } @@ -43,6 +48,7 @@ sub do_action { 'format' => $self->option('spoolformat'), 'balanceover' => $self->option('spoolbalanceover'), 'agent_spools' => $self->option('spoolagent_spools'), + 'ftp_targetnum'=> $self->option('ftp_targetnum'), ); } diff --git a/FS/FS/part_event/Action/pkg_agent_credit.pm b/FS/FS/part_event/Action/pkg_agent_credit.pm index 4bcee983b..e1c77be07 100644 --- a/FS/FS/part_event/Action/pkg_agent_credit.pm +++ b/FS/FS/part_event/Action/pkg_agent_credit.pm @@ -18,7 +18,7 @@ sub do_action { my $agent_cust_main = $agent->agent_cust_main; #? or return "No customer record for agent ". $agent->agent; - my $amount = $self->_calc_credit($cust_pkg); + my $amount = $self->_calc_credit($cust_pkg); return '' unless $amount > 0; my $reasonnum = $self->option('reasonnum'); @@ -29,6 +29,7 @@ sub do_action { 'eventnum' => $cust_event->eventnum, 'addlinfo' => 'for customer #'. $cust_main->display_custnum. ': '.$cust_main->name, + #'commission_agentnum' => $agent->agentnum, ); die "Error crediting customer ". $agent_cust_main->custnum. " for agent commission: $error" diff --git a/FS/FS/part_event/Action/pkg_agent_credit_pkg_class.pm b/FS/FS/part_event/Action/pkg_agent_credit_pkg_class.pm new file mode 100644 index 000000000..3dcf668f9 --- /dev/null +++ b/FS/FS/part_event/Action/pkg_agent_credit_pkg_class.pm @@ -0,0 +1,9 @@ +package FS::part_event::Action::pkg_agent_credit_pkg_class; + +use strict; +use base qw( FS::part_event::Action::Mixin::credit_agent_pkg_class + FS::part_event::Action::pkg_agent_credit ); + +sub description { 'Credit the agent an amount based on their commission percentage for the referred package class'; } + +1; diff --git a/FS/FS/part_event/Condition/after_event.pm b/FS/FS/part_event/Condition/after_event.pm new file mode 100644 index 000000000..1d8d2124e --- /dev/null +++ b/FS/FS/part_event/Condition/after_event.pm @@ -0,0 +1,81 @@ +package FS::part_event::Condition::after_event; + +use strict; +use FS::Record qw( qsearchs ); +use FS::part_event; +use FS::cust_event; + +use base qw( FS::part_event::Condition ); + +sub description { "After running another event" } + +# Runs the event at least X days after the most recent time another event +# ran on the same object. + +sub option_fields { + ( + 'eventpart' => { label=>'Event', type=>'select-part_event', + disable_empty => 1, + hashref => { disabled => '' }, + }, + 'run_delay' => { label=>'Delay', type=>'freq', value=>'1', }, + ); +} + +# Specification: +# Given an event B that has this condition, where the "eventpart" +# option is set to event A, and the "run_delay" option is set to +# X days. +# This condition is TRUE if: +# - Event A last ran X or more days in the past, +# AND +# - Event B has not run since the most recent occurrence of event A. + +sub condition { + # similar to "once_every", but with a different eventpart + my($self, $object, %opt) = @_; + + my $obj_pkey = $object->primary_key; + my $tablenum = $object->$obj_pkey(); + + my $before = $self->option_age_from('run_delay',$opt{'time'}); + my $eventpart = $self->option('eventpart'); + + my %hash = ( + 'eventpart' => $eventpart, + 'tablenum' => $tablenum, + 'status' => { op => '!=', value => 'failed' }, + ); + + my $most_recent_other = qsearchs( { + 'table' => 'cust_event', + 'hashref' => \%hash, + 'order_by' => " ORDER BY _date DESC LIMIT 1", + } ) + or return 0; # if it hasn't run at all, return false + + return 0 if $most_recent_other->_date > $before; # we're still in the delay + + # now see if there's been an instance of this event since the one we're + # following... + $hash{'eventpart'} = $self->eventpart; + if ( $opt{'cust_event'} and $opt{'cust_event'}->eventnum =~ /^(\d+)$/ ) { + $hash{'eventnum'} = { op => '!=', value => $1 }; + } + + my $most_recent_self = qsearchs( { + 'table' => 'cust_event', + 'hashref' => \%hash, + 'order_by' => " ORDER BY _date DESC LIMIT 1", + } ); + + return 0 if defined($most_recent_self) + and $most_recent_self->_date >= $most_recent_other->_date; + # the follower has already run + + 1; +} + +# condition_sql, maybe someday + +1; diff --git a/FS/FS/part_event/Condition/balance_age_under.pm b/FS/FS/part_event/Condition/balance_age_under.pm new file mode 100644 index 000000000..ac6d786fc --- /dev/null +++ b/FS/FS/part_event/Condition/balance_age_under.pm @@ -0,0 +1,52 @@ +package FS::part_event::Condition::balance_age_under; + +use strict; +use base qw( FS::part_event::Condition ); + +sub description { 'Customer balance age (under)'; } + +sub option_fields { + ( + 'balance' => { 'label' => 'Balance under (or equal to)', + 'type' => 'money', + 'value' => '0.00', #default + }, + 'age' => { 'label' => 'Age', + 'type' => 'freq', + }, + ); +} + +sub condition { + my($self, $object, %opt) = @_; + + my $cust_main = $self->cust_main($object); + + my $under = $self->option('balance'); + $under = 0 unless length($under); + + my $age = $self->option_age_from('age', $opt{'time'} ); + + $cust_main->balance_date($age) <= $under; +} + +sub condition_sql { + my( $class, $table, %opt ) = @_; + + my $under = $class->condition_sql_option('balance'); + my $age = $class->condition_sql_option_age_from('age', $opt{'time'}); + + my $balance_sql = FS::cust_main->balance_date_sql( $age ); + + "$balance_sql <= CAST( $under AS DECIMAL(10,2) )"; +} + +sub order_sql { + shift->condition_sql_option_age('age'); +} + +sub order_sql_weight { + 10; +} + +1; diff --git a/FS/FS/part_event/Condition/has_referral_custnum.pm b/FS/FS/part_event/Condition/has_referral_custnum.pm index 70c9c7f8b..dee240fec 100644 --- a/FS/FS/part_event/Condition/has_referral_custnum.pm +++ b/FS/FS/part_event/Condition/has_referral_custnum.pm @@ -13,30 +13,49 @@ sub option_fields { 'type' => 'checkbox', 'value' => 'Y', }, + 'check_bal' => { 'label' => 'Check referring custoemr balance', + 'type' => 'checkbox', + 'value' => 'Y', + }, + 'balance' => { 'label' => 'Referring customer balance under (or equal to)', + 'type' => 'money', + 'value' => '0.00', #default + }, + 'age' => { 'label' => 'Referring customer balance age', + 'type' => 'freq', + }, ); } sub condition { - my($self, $object) = @_; + my($self, $object, %opt) = @_; my $cust_main = $self->cust_main($object); if ( $self->option('active') ) { - return 0 unless $cust_main->referral_custnum; - #check for no cust_main for referral_custnum? (deleted?) + return 0 unless $cust_main->referral_custnum_cust_main->status eq 'active'; + } else { + return 0 unless $cust_main->referral_custnum; # ? 1 : 0; + } - $cust_main->referral_custnum_cust_main->status eq 'active'; + return 1 unless $self->option('check_bal'); - } else { + my $referring_cust_main = $cust_main->referral_custnum_cust_main; - $cust_main->referral_custnum; # ? 1 : 0; + #false laziness w/ balance_age_under + my $under = $self->option('balance'); + $under = 0 unless length($under); - } + my $age = $self->option_age_from('age', $opt{'time'} ); + + $referring_cust_main->balance_date($age) <= $under; } +#this is incomplete wrt checking referring customer balances, but that's okay. +# false positives are acceptable here, its just an optimizaiton sub condition_sql { my( $class, $table ) = @_; diff --git a/FS/FS/part_event/Condition/once_percust_every.pm b/FS/FS/part_event/Condition/once_percust_every.pm new file mode 100644 index 000000000..9e2ec1f00 --- /dev/null +++ b/FS/FS/part_event/Condition/once_percust_every.pm @@ -0,0 +1,58 @@ +package FS::part_event::Condition::once_percust_every; + +use strict; +use FS::Record qw( qsearch ); +use FS::part_event; +use FS::cust_event; + +use base qw( FS::part_event::Condition ); + +sub description { "Don't run this event more than once per customer in the specified interval"; } + +sub eventtable_hashref { + { 'cust_main' => 0, + 'cust_bill' => 1, + 'cust_pkg' => 1, + }; +} + +# Runs the event at most "once every X", per customer. + +sub option_fields { + ( + 'run_delay' => { label=>'Interval', type=>'freq', value=>'1m', }, + ); +} + +sub condition { + my($self, $object, %opt) = @_; + + my $obj_pkey = $object->primary_key; + my $obj_table = $object->table; + my $custnum = $object->custnum; + + my @where = ( + "tablenum IN ( SELECT $obj_pkey FROM $obj_table WHERE custnum = $custnum )" + ); + if ( $opt{'cust_event'}->eventnum =~ /^(\d+)$/ ) { + push @where, " eventnum != $1 "; + } + my $extra_sql = ' AND '. join(' AND ', @where); + + my $max_date = $self->option_age_from('run_delay', $opt{'time'}); + + my @existing = qsearch( { + 'table' => 'cust_event', + 'hashref' => { + 'eventpart' => $self->eventpart, + 'status' => { op=>'!=', value=>'failed' }, + '_date' => { op=>'>', value=>$max_date }, + }, + 'extra_sql' => $extra_sql, + } ); + + ! scalar(@existing); + +} + +1; diff --git a/FS/FS/part_event/Condition/pkg_dundate_age.pm b/FS/FS/part_event/Condition/pkg_dundate_age.pm new file mode 100644 index 000000000..75fce1fd2 --- /dev/null +++ b/FS/FS/part_event/Condition/pkg_dundate_age.pm @@ -0,0 +1,43 @@ +package FS::part_event::Condition::pkg_dundate_age; +use base qw( FS::part_event::Condition ); + +use strict; + +sub description { + "Skip until specified # of days before package suspension delay date"; +} + + +sub option_fields { + ( + 'age' => { 'label' => 'Time before suspension delay date', + 'type' => 'freq', + }, + ); +} + +sub eventtable_hashref { + { 'cust_main' => 0, + 'cust_bill' => 0, + 'cust_pkg' => 1, + }; +} + +sub condition { + my($self, $cust_pkg, %opt) = @_; + + my $age = $self->option_age_from('age', $opt{'time'} ); + + $cust_pkg->dundate <= $age; +} + +sub condition_sql { + my( $class, $table, %opt ) = @_; + return 'true' unless $table eq 'cust_pkg'; + + my $age = $class->condition_sql_option_age_from('age', $opt{'time'}); + + "COALESCE($table.dundate,0) <= ". $age; +} + +1; diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 45773e097..b0f708a66 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -4,10 +4,12 @@ use strict; use vars qw( @ISA @EXPORT_OK $DEBUG %exports ); use Exporter; use Tie::IxHash; -use base qw( FS::option_Common FS::m2m_Common ); # m2m for 'export_nas' +use base qw( FS::option_Common FS::m2m_Common ); use FS::Record qw( qsearch qsearchs dbh ); use FS::part_svc; use FS::part_export_option; +use FS::part_export_machine; +use FS::svc_export_machine; use FS::export_svc; #for export modules, though they should probably just use it themselves @@ -108,6 +110,50 @@ otherwise returns false. If a hash reference of options is supplied, part_export_option records are created (see L<FS::part_export_option>). +=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; + } + + #kinda false laziness with process_m2name + my @machines = map { $_ =~ s/^\s+//; $_ =~ s/\s+$//; $_ } + grep /\S/, + split /[\n\r]{1,2}/, + $self->part_export_machine_textarea; + + foreach my $machine ( @machines ) { + + my $part_export_machine = new FS::part_export_machine { + 'exportnum' => $self->exportnum, + 'machine' => $machine, + }; + $error = $part_export_machine->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. @@ -117,13 +163,13 @@ Delete this record from the database. #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; @@ -147,10 +193,103 @@ sub delete { } } - $dbh->commit or die $dbh->errstr if $oldAutoCommit; + foreach my $part_export_machine ( $self->part_export_machine ) { + my $error = $part_export_machine->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 or hash reference of options is supplied, option records are created +or modified. + +=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; + } + + if ( $self->part_export_machine_textarea ) { + + my %part_export_machine = map { $_->machine => $_ } + $self->part_export_machine; + + my @machines = map { $_ =~ s/^\s+//; $_ =~ s/\s+$//; $_ } + grep /\S/, + split /[\n\r]{1,2}/, + $self->part_export_machine_textarea; + + foreach my $machine ( @machines ) { + + if ( $part_export_machine{$machine} ) { + + if ( $part_export_machine{$machine}->disabled eq 'Y' ) { + $part_export_machine{$machine}->disabled(''); + $error = $part_export_machine{$machine}->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + delete $part_export_machine{$machine}; #so we don't disable it below + + } else { + + my $part_export_machine = new FS::part_export_machine { + 'exportnum' => $self->exportnum, + 'machine' => $machine + }; + $error = $part_export_machine->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + } + + } + + + foreach my $part_export_machine ( values %part_export_machine ) { + $part_export_machine->disabled('Y'); + $error = $part_export_machine->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; } =item check @@ -166,7 +305,7 @@ sub check { my $error = $self->ut_numbern('exportnum') || $self->ut_textn('exportname') - || $self->ut_domain('machine') + || $self->ut_domainn('machine') || $self->ut_alpha('exporttype') ; return $error if $error; @@ -192,6 +331,31 @@ sub label { ($self->exportname || $self->exporttype ). ' ('. $self->machine. ')'; } +=item label_html + +Returns a label for this export, "exportname: exporttype to machine". + +=cut + +sub label_html { + my $self = shift; + + my $label = $self->exportname + ? '<B>'. $self->exportname. '</B>: ' #<BR>'. + : ''; + + $label .= $self->exporttype; + + $label .= ' to '. ( $self->machine eq '_SVC_MACHINE' + ? 'per-service hostname' + : $self->machine + ) + if $self->machine; + + $label; + +} + #=item part_svc # #Returns the service definition (see L<FS::part_svc>) for this export. @@ -233,6 +397,20 @@ sub cust_svc { $self->export_svc; } +=item part_export_machine + +Returns all machines as FS::part_export_machine objects (see +L<FS::part_export_machine>). + +=cut + +sub part_export_machine { + my $self = shift; + map { $_ } #behavior of sort undefined in scalar context + sort { $a->machine cmp $b->machine } + qsearch('part_export_machine', { 'exportnum' => $self->exportnum } ); +} + =item export_svc Returns a list of associated FS::export_svc records. @@ -293,6 +471,26 @@ sub _rebless { $self; } +=item svc_machine + +=cut + +sub svc_machine { + my( $self, $svc_x ) = @_; + + return $self->machine unless $self->machine eq '_SVC_MACHINE'; + + my $svc_export_machine = qsearchs('svc_export_machine', { + 'svcnum' => $svc_x->svcnum, + 'exportnum' => $self->exportnum, + }) + #would only happen if you add this export to existing services without a + #machine set then try to run exports without setting it... right? + or die "No hostname selected for ".($self->exportname || $self->exporttype); + + return $svc_export_machine->part_export_machine->machine; +} + #these should probably all go away, just let the subclasses define em =item export_insert SVC_OBJECT diff --git a/FS/FS/part_export/acct_google.pm b/FS/FS/part_export/acct_google.pm index afc45db81..d153728e9 100644 --- a/FS/FS/part_export/acct_google.pm +++ b/FS/FS/part_export/acct_google.pm @@ -16,10 +16,12 @@ tie my %options, 'Tie::IxHash', # admin logins. %info = ( - 'svc' => 'svc_acct', - 'desc' => 'Google hosted mail', - 'options' => \%options, - 'nodomain' => 'Y', + 'svc' => 'svc_acct', + 'desc' => 'Google hosted mail', + 'options' => \%options, + 'nodomain' => 'Y', + 'no_machine' => 1, + 'default_svc_class' => 'Email', 'notes' => <<'END' Export accounts to the Google Provisioning API. Requires REST::Google::Apps::Provisioning from CPAN. diff --git a/FS/FS/part_export/acct_http.pm b/FS/FS/part_export/acct_http.pm index b4c64ac62..23df7b37d 100644 --- a/FS/FS/part_export/acct_http.pm +++ b/FS/FS/part_export/acct_http.pm @@ -51,6 +51,7 @@ tie %options, 'Tie::IxHash', 'svc' => 'svc_acct', 'desc' => 'Send an HTTP or HTTPS GET or POST request, for accounts.', 'options' => \%options, + 'no_machine' => 1, 'notes' => <<'END' Send an HTTP or HTTPS GET or POST to the specified URL on account addition, modification and deletion. For HTTPS support, diff --git a/FS/FS/part_export/acct_plesk.pm b/FS/FS/part_export/acct_plesk.pm index d8d70a30e..50b6faebf 100644 --- a/FS/FS/part_export/acct_plesk.pm +++ b/FS/FS/part_export/acct_plesk.pm @@ -15,9 +15,11 @@ tie my %options, 'Tie::IxHash', ; %info = ( - 'svc' => 'svc_acct', - 'desc' => 'Real-time export to Plesk managed mail service', - 'options'=> \%options, + 'svc' => 'svc_acct', + 'desc' => 'Real-time export to Plesk managed mail service', + 'options' => \%options, + 'no_machine' => 1, + 'default_svc_class' => 'Email', 'notes' => <<'END' Real-time export to <a href="http://www.swsoft.com/">Plesk</a> managed server. diff --git a/FS/FS/part_export/acct_sql.pm b/FS/FS/part_export/acct_sql.pm index ffe39caa5..8163f2017 100644 --- a/FS/FS/part_export/acct_sql.pm +++ b/FS/FS/part_export/acct_sql.pm @@ -60,11 +60,13 @@ my $postfix_native_mailbox_map = keys %postfix_native_mailbox_map ); %info = ( - 'svc' => 'svc_acct', - 'desc' => 'Real-time export of accounts to SQL databases '. - '(vpopmail, Postfix+Courier IMAP, others?)', - 'options' => \%options, - 'nodomain' => '', + 'svc' => 'svc_acct', + 'desc' => 'Real-time export of accounts to SQL databases '. + '(vpopmail, Postfix+Courier IMAP, others?)', + 'options' => \%options, + 'nodomain' => '', + 'no_machine' => 1, + 'default_svc_class' => 'Email', 'notes' => <<END Export accounts (svc_acct records) to SQL databases. Currently has default configurations for vpopmail and Postfix+Courier IMAP but intended to be diff --git a/FS/FS/part_export/acct_sql_status.pm b/FS/FS/part_export/acct_sql_status.pm index e6aeb2071..248105f18 100644 --- a/FS/FS/part_export/acct_sql_status.pm +++ b/FS/FS/part_export/acct_sql_status.pm @@ -14,6 +14,7 @@ delete $options{$_} for qw( table schema static primary_key ); 'desc' => 'Mailbox status information from SQL', 'options' => \%options, 'nodomain' => '', + 'no_machine' => 1, 'notes' => <<END Read mailbox status information (vacation and spam settings) from an SQL database, tables "vacation" and "users" respectively. diff --git a/FS/FS/part_export/acct_xmlrpc.pm b/FS/FS/part_export/acct_xmlrpc.pm new file mode 100644 index 000000000..3070f281a --- /dev/null +++ b/FS/FS/part_export/acct_xmlrpc.pm @@ -0,0 +1,269 @@ +package FS::part_export::acct_xmlrpc; +use base qw( FS::part_export ); + +use vars qw( %info ); # $DEBUG ); +#use Data::Dumper; +use Tie::IxHash; +use Frontier::Client; #to avoid adding a dependency on RPC::XML just now +#use FS::Record qw( qsearch qsearchs ); +use FS::Schema qw( dbdef ); + +#$DEBUG = 1; + +tie my %options, 'Tie::IxHash', + 'xmlrpc_url' => { label => 'XML-RPC URL', }, + 'param_style' => { label => 'Parameter style', + type => 'select', + options => [ 'Individual values', + 'Struct of name/value pairs', + ], + }, + 'insert_method' => { label => 'Insert method', }, + 'insert_params' => { label => 'Insert parameters', type=>'textarea', }, + 'replace_method' => { label => 'Replace method', }, + 'replace_params' => { label => 'Replace parameters', type=>'textarea', }, + 'delete_method' => { label => 'Delete method', }, + 'delete_params' => { label => 'Delete parameters', type=>'textarea', }, + 'suspend_method' => { label => 'Suspend method', }, + 'suspend_params' => { label => 'Suspend parameters', type=>'textarea', }, + 'unsuspend_method' => { label => 'Unsuspend method', }, + 'unsuspend_params' => { label => 'Unsuspend parameters', type=>'textarea', }, +; + +%info = ( + 'svc' => 'svc_acct', + 'desc' => 'Configurable provisioning of accounts via the XML-RPC protocol', + 'options' => \%options, + 'no_machine' => 1, + 'notes' => <<'END', +Configurable, real-time export of accounts via the XML-RPC protocol.<BR> +<BR> +If using "Individual values" parameter style, specify one parameter per line.<BR> +<BR> +If using "Struct of name/value pairs" parameter style, specify one name and +value on each line, separated by whitespace.<BR> +<BR> +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>$crypt_password</code> - encrypted password + <LI><code>$ldap_password</code> - Password in LDAP/RFC2307 format (for example, "{PLAIN}himom", "{CRYPT}94pAVyK/4oIBk" or "{MD5}5426824942db4253f87a1009fd5d2d4") + <LI><code>$uid</code> + <LI><code>$gid</code> + <LI><code>$finger</code> - Real name + <LI><code>$dir</code> - home directory + <LI><code>$shell</code> + <LI><code>$quota</code> + <LI><code>@radius_groups</code> +<!-- <LI><code>$reasonnum (when suspending)</code> + <LI><code>$reasontext (when suspending)</code> + <LI><code>$reasontypenum (when suspending)</code> + <LI><code>$reasontypetext (when suspending)</code> +--> +<!-- + <LI><code>$pkgnum</code> + <LI><code>$custnum</code> +--> + <LI>All other fields in <b>svc_acct</b> are also available. +<!-- <LI>The following fields from <b>cust_main</b> are also available (except during replace): company, address1, address2, city, state, zip, county, daytime, night, fax, otaker, agent_custid, locale. --> +</UL> + +END +); + +sub _export_insert { shift->_export_command('insert', @_) } +sub _export_delete { shift->_export_command('delete', @_) } +sub _export_suspend { shift->_export_command('suspend', @_) } +sub _export_unsuspend { shift->_export_command('unsuspend', @_) } + +sub _export_command { + my ( $self, $action, $svc_acct) = (shift, shift, shift); + my $method = $self->option($action.'_method'); + return '' if $method =~ /^\s*$/; + + my @params = split("\n", $self->option($action.'_params') ); + + my( @x_param ) = (); + my( %x_struct ) = (); + foreach my $param (@params) { + + my($name, $value) = ('', ''); + if ($self->option('param_style') eq 'Struct of name/value pairs' ) { + ($name, $value) = split(/\s+/, $param); + } else { #'Individual values' + $value = $param; + } + + if ( $value =~ /^\s*(\$|\@)(\w+)\s*$/ ) { + $value = $self->_export_value($2, $svc_acct); + } + + if ($self->option('param_style') eq 'Struct of name/value pairs' ) { + $x_struct{$name} = $value; + } else { #'Individual values' + push @x_param, $value; + } + + } + + my @x = (); + if ($self->option('param_style') eq 'Struct of name/value pairs' ) { + @x = ( \%x_struct ); + } else { #'Individual values' + @x = @x_param; + } + + #option to queue (or not) ? + + my $conn = Frontier::Client->new( url => $self->option('xmlrpc_url') ); + + my $result = $conn->call($method, @x); + + #XXX error checking? $result? from the call? + ''; +} + +sub _export_replace { + my( $self, $new, $old ) = (shift, shift, shift); + + my $method = $self->option($action.'_method'); + return '' if $method =~ /^\s*$/; + + my @params = split("\n", $self->option($action.'_params') ); + + my( @x_param ) = (); + my( %x_struct ) = (); + foreach my $param (@params) { + + my($name, $value) = ('', ''); + if ($self->option('param_style') eq 'Struct of name/value pairs' ) { + ($name, $value) = split(/\s+/, $param); + } else { #'Individual values' + $value = $param; + } + + if ( $value =~ /^\s*(\$|\@)(old|new)_(\w+)\s*$/ ) { + if ($2 eq 'old' ) { + $value = $self->_export_value($3, $old); + } elsif ( $2 eq 'new' ) { + $value = $self->_export_value($3, $new); + } else { + die 'guru meditation stella blue'; + } + } + + if ($self->option('param_style') eq 'Struct of name/value pairs' ) { + $x_struct{$name} = $value; + } else { #'Individual values' + push @x_param, $value; + } + + } + + my @x = (); + if ($self->option('param_style') eq 'Struct of name/value pairs' ) { + @x = ( \%x_struct ); + } else { #'Individual values' + @x = @x_param; + } + + #option to queue (or not) ? + + my $conn = Frontier::Client->new( url => $self->option('xmlrpc_url') ); + + my $result = $conn->call($method, @x); + + #XXX error checking? $result? from the call? + ''; + +} + +#comceptual false laziness w/shellcommands.pm +sub _export_value { + my( $self, $value, $svc_acct) = (shift, shift, shift); + + my %fields = map { $_=>1 } $svc_acct->fields; + + if ( $fields{$value} ) { + my $type = dbdef->table('svc_acct')->column($value)->type; + if ( $type =~ /^(int|serial)/i ) { + return Frontier::Client->new->int( $svc_acct->$value() ); + } elsif ( $value =~ /^last_log/ ) { + return Frontier::Client->new->date_time( $svc_acct->$value() ); #conversion? + } else { + return Frontier::Client->new->string( $svc_acct->$value() ); + } + } elsif ( $value eq 'domain' ) { + return Frontier::Client->new->string( $svc_acct->domain ); + } elsif ( $value eq 'crypt_password' ) { + return Frontier::Client->new->string( $svc_acct->crypt_password( $self->option('crypt') ) ); + } elsif ( $value eq 'ldap_password' ) { + return Frontier::Client->new->string( $svc_acct->ldap_password($self->option('crypt') ) ); + } elsif ( $value eq 'radius_groups' ) { + my @radius_groups = $svc_acct->radius_groups; + #XXX + } + +# my $cust_pkg = $svc_acct->cust_svc->cust_pkg; +# if ( $cust_pkg ) { +# no strict 'vars'; +# { +# no strict 'refs'; +# foreach my $custf (qw( company address1 address2 city state zip country +# daytime night fax otaker agent_custid locale +# )) +# { +# ${$custf} = $cust_pkg->cust_main->$custf(); +# } +# } +# $email = ( grep { $_ !~ /^(POST|FAX)$/ } $cust_pkg->cust_main->invoicing_list )[0]; +# } else { +# $email = ''; +# } + +# my ($reasonnum, $reasontext, $reasontypenum, $reasontypetext); +# if ( $cust_pkg && $action eq 'suspend' && +# (my $r = $cust_pkg->last_reason('susp')) ) +# { +# $reasonnum = $r->reasonnum; +# $reasontext = $r->reason; +# $reasontypenum = $r->reason_type; +# $reasontypetext = $r->reasontype->type; +# +# my %reasonmap = $self->_groups_susp_reason_map; +# my $userspec = ''; +# $userspec = $reasonmap{$reasonnum} +# if exists($reasonmap{$reasonnum}); +# $userspec = $reasonmap{$reasontext} +# if (!$userspec && exists($reasonmap{$reasontext})); +# +# my $suspend_user; +# if ( $userspec =~ /^\d+$/ ) { +# $suspend_user = qsearchs( 'svc_acct', { 'svcnum' => $userspec } ); +# } elsif ( $userspec =~ /^\S+\@\S+$/ ) { +# my ($username,$domain) = split(/\@/, $userspec); +# for my $user (qsearch( 'svc_acct', { 'username' => $username } )){ +# $suspend_user = $user if $userspec eq $user->email; +# } +# } elsif ($userspec) { +# $suspend_user = qsearchs( 'svc_acct', { 'username' => $userspec } ); +# } +# +# @radius_groups = $suspend_user->radius_groups +# if $suspend_user; +# +# } else { +# $reasonnum = $reasontext = $reasontypenum = $reasontypetext = ''; +# } + +# $pkgnum = $cust_pkg ? $cust_pkg->pkgnum : ''; +# $custnum = $cust_pkg ? $cust_pkg->custnum : ''; + + ''; + +} + +1; + diff --git a/FS/FS/part_export/amazon_ec2.pm b/FS/FS/part_export/amazon_ec2.pm index 0e65ca00c..06e2c238e 100644 --- a/FS/FS/part_export/amazon_ec2.pm +++ b/FS/FS/part_export/amazon_ec2.pm @@ -20,6 +20,7 @@ tie my %options, 'Tie::IxHash', 'desc' => 'Export to Amazon EC2', 'options' => \%options, + 'no_machine' => 1, 'notes' => <<'END' Create instances in the Amazon EC2 (Elastic compute cloud). Install Net::Amazon::EC2 perl module. Advisable to set svc_external-skip_manual config diff --git a/FS/FS/part_export/artera_turbo.pm b/FS/FS/part_export/artera_turbo.pm index c006db9cd..e22bbf2af 100644 --- a/FS/FS/part_export/artera_turbo.pm +++ b/FS/FS/part_export/artera_turbo.pm @@ -37,6 +37,7 @@ tie my %options, 'Tie::IxHash', 'Real-time export to Artera Turbo Reseller API', 'options' => \%options, #'nodomain' => 'Y', + 'no_machine' => 1, 'notes' => <<'END' Real-time export to <a href="http://www.arteraturbo.com/">Artera Turbo</a> Reseller API. Requires installation of diff --git a/FS/FS/part_export/broadband_http.pm b/FS/FS/part_export/broadband_http.pm index 9edfee5d3..c1ed7fca6 100644 --- a/FS/FS/part_export/broadband_http.pm +++ b/FS/FS/part_export/broadband_http.pm @@ -45,6 +45,7 @@ tie %options, 'Tie::IxHash', 'svc' => 'svc_broadband', 'desc' => 'Send an HTTP or HTTPS GET or POST request, for accounts.', 'options' => \%options, + 'no_machine' => 1, 'notes' => <<'END' <p>Send an HTTP or HTTPS GET or POST to the specified URL on account addition, modification and deletion. For HTTPS support, diff --git a/FS/FS/part_export/broadband_nas.pm b/FS/FS/part_export/broadband_nas.pm index a160c9944..5a8ffac3b 100644 --- a/FS/FS/part_export/broadband_nas.pm +++ b/FS/FS/part_export/broadband_nas.pm @@ -43,6 +43,7 @@ FS::UID->install_callback( 'svc' => 'svc_broadband', 'desc' => 'Create a NAS entry in Freeside', 'options' => \%options, + 'no_machine' => 1, 'weight' => 10, 'notes' => <<'END' <p>Create an entry in the NAS (RADIUS client) table, inheriting the IP diff --git a/FS/FS/part_export/broadband_shellcommands.pm b/FS/FS/part_export/broadband_shellcommands.pm index c7f0fbb33..cf9c36c8f 100644 --- a/FS/FS/part_export/broadband_shellcommands.pm +++ b/FS/FS/part_export/broadband_shellcommands.pm @@ -107,3 +107,4 @@ sub ssh_cmd { #subroutine, not method ''; } +1; diff --git a/FS/FS/part_export/broadband_snmp.pm b/FS/FS/part_export/broadband_snmp.pm index cb1740efc..44b4dbabb 100644 --- a/FS/FS/part_export/broadband_snmp.pm +++ b/FS/FS/part_export/broadband_snmp.pm @@ -52,6 +52,7 @@ tie my %options, 'Tie::IxHash', 'svc' => 'svc_broadband', 'desc' => 'Send SNMP requests to the service IP address', 'options' => \%options, + 'no_machine' => 1, 'weight' => 10, 'notes' => <<'END' Send one or more SNMP SET requests to the IP address registered to the service. diff --git a/FS/FS/part_export/broadband_sql.pm b/FS/FS/part_export/broadband_sql.pm index 697d3cdac..4f526c805 100644 --- a/FS/FS/part_export/broadband_sql.pm +++ b/FS/FS/part_export/broadband_sql.pm @@ -24,6 +24,7 @@ tie my %options, 'Tie::IxHash', 'desc' => 'Real-time export of broadband services to SQL databases ', 'options' => \%options, 'nodomain' => '', + 'no_machine' => 1, 'notes' => <<END END ); diff --git a/FS/FS/part_export/broadband_sqlradius.pm b/FS/FS/part_export/broadband_sqlradius.pm index 29bd28899..b5d1a80cb 100644 --- a/FS/FS/part_export/broadband_sqlradius.pm +++ b/FS/FS/part_export/broadband_sqlradius.pm @@ -1,7 +1,7 @@ package FS::part_export::broadband_sqlradius; use strict; -use vars qw($DEBUG @ISA %options %info $conf); +use vars qw($DEBUG @ISA @pw_set %options %info $conf); use Tie::IxHash; use FS::Conf; use FS::Record qw( dbh str2time_sql ); #qsearch qsearchs ); @@ -13,6 +13,8 @@ FS::UID->install_callback(sub { $conf = new FS::Conf }); $DEBUG = 0; +@pw_set = ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '.', ',' ); + tie %options, 'Tie::IxHash', 'datasrc' => { label=>'DBI data source ' }, 'username' => { label=>'Database username' }, @@ -53,6 +55,7 @@ tie %options, 'Tie::IxHash', 'svc' => 'svc_broadband', 'desc' => 'Real-time export to SQL-backed RADIUS (such as FreeRadius) for broadband services', 'options' => \%options, + 'no_machine' => 1, 'nas' => 'Y', 'notes' => <<END, Real-time export of <b>radcheck</b>, <b>radreply</b>, and <b>usergroup</b> @@ -106,8 +109,65 @@ sub radius_check { %check; } -sub _export_suspend {} -sub _export_unsuspend {} +sub radius_check_suspended { + my($self, $svc_broadband) = (shift, shift); + + return () unless $self->option('mac_as_password') + || length( $self->option('radius_password',1)); + + my $password_attrib = $conf->config('radius-password') || 'Password'; + ( + $password_attrib => join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) ) + ); +} + +#false laziness w/sqlradius.pm +sub _export_suspend { + my( $self, $svc_broadband ) = (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 @newgroups = $self->suspended_usergroups($svc_broadband); + + unless (@newgroups) { #don't change password if assigning to a suspended group + + my $err_or_queue = $self->sqlradius_queue( + $svc_broadband->svcnum, 'insert', + 'check', $self->export_username($svc_broadband), + $self->radius_check_suspended($svc_broadband) + ); + unless ( ref($err_or_queue) ) { + $dbh->rollback if $oldAutoCommit; + return $err_or_queue; + } + + } + + my $error = + $self->sqlreplace_usergroups( + $svc_broadband->svcnum, + $self->export_username($svc_broadband), + '', + [ $svc_broadband->radius_groups('hashref') ], + \@newgroups, + ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; +} sub update_svc {} #do nothing diff --git a/FS/FS/part_export/communigate_pro.pm b/FS/FS/part_export/communigate_pro.pm index a3ec5e0be..8b66225d2 100644 --- a/FS/FS/part_export/communigate_pro.pm +++ b/FS/FS/part_export/communigate_pro.pm @@ -36,6 +36,7 @@ tie %options, 'Tie::IxHash', 'svc' => [qw( svc_acct svc_domain svc_forward svc_mailinglist )], 'desc' => 'Real-time export of accounts, domains, mail forwards and mailing lists to a CommuniGate Pro mail server', 'options' => \%options, + 'default_svc_class' => 'Email', 'notes' => <<'END' Real time export of accounts, domains, mail forwards and mailing lists to a <a href="http://www.stalker.com/CommuniGatePro/">CommuniGate Pro</a> diff --git a/FS/FS/part_export/communigate_pro_singledomain.pm b/FS/FS/part_export/communigate_pro_singledomain.pm index e25043fbb..cecea2826 100644 --- a/FS/FS/part_export/communigate_pro_singledomain.pm +++ b/FS/FS/part_export/communigate_pro_singledomain.pm @@ -16,6 +16,7 @@ tie my %options, 'Tie::IxHash', %FS::part_export::communigate_pro::options, 'Real-time export to a CommuniGate Pro mail server, one domain only', 'options' => \%options, 'nodomain' => 'Y', + 'default_svc_class' => 'Email', 'notes' => <<'END' Real time export to a <a href="http://www.stalker.com/CommuniGatePro/">CommuniGate Pro</a> diff --git a/FS/FS/part_export/cp.pm b/FS/FS/part_export/cp.pm index 96fa43710..2ae97e12d 100644 --- a/FS/FS/part_export/cp.pm +++ b/FS/FS/part_export/cp.pm @@ -18,6 +18,7 @@ tie my %options, 'Tie::IxHash', 'svc' => 'svc_acct', 'desc' => 'Real-time export to Critical Path Account Provisioning Protocol', 'options'=> \%options, + 'default_svc_class' => 'Email', 'notes' => <<'END' Real-time export to <a href="http://www.cp.net/">Critial Path Account Provisioning Protocol</a>. diff --git a/FS/FS/part_export/cpanel.pm b/FS/FS/part_export/cpanel.pm index 0ad00df01..6c61e3d2b 100644 --- a/FS/FS/part_export/cpanel.pm +++ b/FS/FS/part_export/cpanel.pm @@ -190,3 +190,5 @@ sub cpanel_connect { $whm; } + +1; diff --git a/FS/FS/part_export/cust_http.pm b/FS/FS/part_export/cust_http.pm index e8b677be2..e834f93ea 100644 --- a/FS/FS/part_export/cust_http.pm +++ b/FS/FS/part_export/cust_http.pm @@ -55,6 +55,7 @@ tie %options, 'Tie::IxHash', 'svc' => 'cust_main', 'desc' => 'Send an HTTP or HTTPS GET or POST request, for customers.', 'options' => \%options, + 'no_machine' => 1, 'notes' => <<'END' Send an HTTP or HTTPS GET or POST to the specified URL on customer addition, modification and deletion. For HTTPS support, diff --git a/FS/FS/part_export/cyrus.pm b/FS/FS/part_export/cyrus.pm index 84c9e5a30..246d5b3dc 100644 --- a/FS/FS/part_export/cyrus.pm +++ b/FS/FS/part_export/cyrus.pm @@ -17,6 +17,8 @@ tie my %options, 'Tie::IxHash', 'desc' => 'Real-time export to Cyrus IMAP server', 'options' => \%options, 'nodomain' => 'Y', + 'no_machine' => 1, #de facto... but "server" option should move to it + 'default_svc_class' => 'Email', 'notes' => <<'END' Integration with <a href="http://asg.web.cmu.edu/cyrus/imapd/">Cyrus IMAP Server</a>. diff --git a/FS/FS/part_export/dashcs_e911.pm b/FS/FS/part_export/dashcs_e911.pm index 320d0a67b..2717233cf 100644 --- a/FS/FS/part_export/dashcs_e911.pm +++ b/FS/FS/part_export/dashcs_e911.pm @@ -20,6 +20,7 @@ tie my %options, 'Tie::IxHash', 'svc' => 'svc_phone', 'desc' => 'Provision e911 services via Dash Carrier Services', 'notes' => 'Provision e911 services via Dash Carrier Services', + 'no_machine' => 1, 'options' => \%options, ); diff --git a/FS/FS/part_export/dma_radiusmanager.pm b/FS/FS/part_export/dma_radiusmanager.pm new file mode 100644 index 000000000..ab77c4645 --- /dev/null +++ b/FS/FS/part_export/dma_radiusmanager.pm @@ -0,0 +1,336 @@ +package FS::part_export::dma_radiusmanager; + +use strict; +use vars qw($DEBUG %info %options); +use base 'FS::part_export'; +use FS::part_svc; +use FS::svc_acct; +use FS::radius_group; +use Tie::IxHash; +use Digest::MD5 'md5_hex'; + +tie %options, 'Tie::IxHash', + 'dbname' => { label=>'Database name', default=>'radius' }, + 'username' => { label=>'Database username' }, + 'password' => { label=>'Database password' }, + 'manager' => { label=>'Manager name' }, + 'groupid' => { label=>'Group ID', default=>'1' }, + 'service_prefix' => { label=>'Service name prefix' }, + 'nasnames' => { label=>'NAS IDs/addresses' }, + 'debug' => { label=>'Enable debugging', type=>'checkbox' }, +; + +%info = ( + 'svc' => 'svc_acct', + 'desc' => 'Export to DMA Radius Manager', + 'options' => \%options, + 'nodomain' => 'Y', + 'notes' => '', #XXX +); + +$DEBUG = 0; + +sub connect { + my $self = shift; + my $datasrc = 'dbi:mysql:host='.$self->machine. + ':database='.$self->option('dbname'); + DBI->connect( + $datasrc, + $self->option('username'), + $self->option('password'), + { AutoCommit => 0 } + ) or die $DBI::errstr; +} + +sub export_insert { my $self = shift; $self->dma_rm_queue('insert', @_) } +sub export_delete { my $self = shift; $self->dma_rm_queue('delete', @_) } +sub export_replace { my $self = shift; $self->dma_rm_queue('replace', @_) } +sub export_suspend { my $self = shift; $self->dma_rm_queue('suspend', @_) } +sub export_unsuspend { my $self = shift; $self->dma_rm_queue('unsuspend', @_) } + +sub dma_rm_queue { + my ($self, $action, $svc_acct, $old) = @_; + + my $svcnum = $svc_acct->svcnum; + + my $cust_pkg = $svc_acct->cust_svc->cust_pkg; + my $cust_main = $cust_pkg->cust_main; + my $location = $cust_pkg->cust_location; + + my %params = ( + # for the remote side + username => $svc_acct->username, + password => md5_hex($svc_acct->_password), + groupid => $self->option('groupid'), + enableuser => 1, + firstname => $cust_main->first, + lastname => $cust_main->last, + company => $cust_main->company, + phone => ($cust_main->daytime || $cust_main->night), + mobile => $cust_main->mobile, + address => $location->address1, # address2? + city => $location->city, + state => $location->state, + zip => $location->zip, + country => $location->country, + gpslat => $location->latitude, + gpslong => $location->longitude, + comment => 'svcnum'.$svcnum, + createdby => $self->option('manager'), + owner => $self->option('manager'), + email => $cust_main->invoicing_list_emailonly_scalar, + + # used internally by the export + exportnum => $self->exportnum, + svcnum => $svcnum, + action => $action, + svcpart => $svc_acct->cust_svc->svcpart, + _password => $svc_acct->_password, + ); + if ( $action eq 'replace' ) { + $params{'old_username'} = $old->username; + $params{'old_password'} = $old->_password; + } + my $queue = FS::queue->new({ + 'svcnum' => $svcnum, + 'job' => "FS::part_export::dma_radiusmanager::dma_rm_action", + }); + $queue->insert(%params); +} + +sub dma_rm_action { + my %params = @_; + my $svcnum = delete $params{svcnum}; + my $action = delete $params{action}; + my $svcpart = delete $params{svcpart}; + my $exportnum = delete $params{exportnum}; + + my $username = $params{username}; + my $password = delete $params{_password}; + + my $self = FS::part_export->by_key($exportnum); + my $dbh = $self->connect; + local $DEBUG = 1 if $self->option('debug'); + + # export the part_svc if needed, and get its srvid + my $part_svc = FS::part_svc->by_key($svcpart); + my $srvid = $self->export_part_svc($part_svc, $dbh); # dies on error + $params{srvid} = $srvid; + + if ( $action eq 'insert' ) { + warn "rm_users: inserting svcnum$svcnum\n" if $DEBUG; + my $sth = $dbh->prepare( 'INSERT INTO rm_users ( '. + join(', ', keys(%params)). + ') VALUES ('. + join(', ', ('?') x keys(%params)). + ')' + ); + $sth->execute(values(%params)) or die $dbh->errstr; + + # minor false laziness w/ sqlradius_insert + warn "radcheck: inserting $username\n" if $DEBUG; + $sth = $dbh->prepare( 'INSERT INTO radcheck ( + username, attribute, op, value + ) VALUES (?, ?, ?, ?)' ); + $sth->execute( + $username, + 'Cleartext-Password', + ':=', # :=( + $password, + ) or die $dbh->errstr; + + $sth->execute( + $username, + 'Simultaneous-Use', + ':=', + 1, # should this be an option? + ) or die $dbh->errstr; + # also, we don't support exporting any other radius attrs... + # those should go in 'custattr' if we need them + } elsif ( $action eq 'replace' ) { + + my $old_username = delete $params{old_username}; + my $old_password = delete $params{old_password}; + # svcnum is invariant and on the remote side, so we don't need any + # of the old fields to do this + warn "rm_users: updating svcnum$svcnum\n" if $DEBUG; + my $sth = $dbh->prepare( 'UPDATE rm_users SET '. + join(', ', map { "$_ = ?" } keys(%params)). + ' WHERE comment = ?' + ); + $sth->execute(values(%params), $params{comment}) or die $dbh->errstr; + # except for username/password changes + if ( $old_password ne $password ) { + warn "radcheck: changing password for $old_username\n" if $DEBUG; + $sth = $dbh->prepare( 'UPDATE radcheck SET value = ? '. + 'WHERE username = ? and attribute = \'Cleartext-Password\'' + ); + $sth->execute($password, $old_username) or die $dbh->errstr; + } + if ( $old_username ne $username ) { + warn "radcheck: changing username $old_username to $username\n" + if $DEBUG; + $sth = $dbh->prepare( 'UPDATE radcheck SET username = ? '. + 'WHERE username = ?' + ); + $sth->execute($username, $old_username) or die $dbh->errstr; + } + + } elsif ( $action eq 'suspend' ) { + + # this is sufficient + warn "rm_users: disabling svcnum#$svcnum\n" if $DEBUG; + my $sth = $dbh->prepare( 'UPDATE rm_users SET enableuser = 0 '. + 'WHERE comment = ?' + ); + $sth->execute($params{comment}) or die $dbh->errstr; + + } elsif ( $action eq 'unsuspend' ) { + + warn "rm_users: enabling svcnum#$svcnum\n" if $DEBUG; + my $sth = $dbh->prepare( 'UPDATE rm_users SET enableuser = 1 '. + 'WHERE comment = ?' + ); + $sth->execute($params{comment}) or die $dbh->errstr; + + } elsif ( $action eq 'delete' ) { + + warn "rm_users: deleting svcnum#$svcnum\n" if $DEBUG; + my $sth = $dbh->prepare( 'DELETE FROM rm_users WHERE comment = ?' ); + $sth->execute($params{comment}) or die $dbh->errstr; + + warn "radcheck: deleting $username\n" if $DEBUG; + $sth = $dbh->prepare( 'DELETE FROM radcheck WHERE username = ?' ); + $sth->execute($username) or die $dbh->errstr; + + # if this were smarter it would also delete the rm_services record + # if it was no longer in use, but that's not really necessary + } + + $dbh->commit; + ''; +} + +=item export_part_svc PART_SVC DBH + +Query Radius Manager for a service definition matching the name of +PART_SVC (optionally with a prefix defined in the export options). +If there is one, update it to match the attributes of PART_SVC; if +not, create one. Then return its srvid. + +=cut + +sub export_part_svc { + my ($self, $part_svc, $dbh) = @_; + + my $name = $self->option('service_prefix').$part_svc->svc; + + my %params = ( + 'srvname' => $name, + 'enableservice' => 1, + 'nextsrvid' => -1, + 'dailynextsrvid' => -1, + ); + my @fixed_groups; + # use speed settings from fixed usergroups configured on this part_svc + if ( my $psc = $part_svc->part_svc_column('usergroup') ) { + if ( $psc->columnflag eq 'F' ) { + # each part_svc really should only have one fixed group with non-null + # speed settings, but go by priority order for consistency + @fixed_groups = + sort { $a->priority <=> $b->priority } + grep { $_ } + map { FS::radius_group->by_key($_) } + split(/\s*,\s*/, $psc->columnvalue); + } + } # otherwise there are no fixed groups, so leave speed empty + + foreach (qw(down up)) { + my $speed = "speed_$_"; + foreach my $group (@fixed_groups) { + if ( ($group->$speed || 0) > 0 ) { + $params{$_.'rate'} = $group->$speed; + last; + } + } + } + # anything else we need here? poolname, maybe? + + warn "rm_services: looking for '$name'\n" if $DEBUG; + my $sth = $dbh->prepare( + 'SELECT srvid FROM rm_services WHERE srvname = ? AND enableservice = 1' + ); + $sth->execute($name) or die $dbh->errstr; + if ( $sth->rows > 1 ) { + die "Multiple services with name '$name' found in Radius Manager.\n"; + } elsif ( $sth->rows == 1 ) { + my $row = $sth->fetchrow_arrayref; + my $srvid = $row->[0]; + warn "rm_services: updating srvid#$srvid\n" if $DEBUG; + $sth = $dbh->prepare( + 'UPDATE rm_services SET '.join(', ', map {"$_ = ?"} keys %params) . + ' WHERE srvid = ?' + ); + $sth->execute(values(%params), $srvid) or die $dbh->errstr; + return $srvid; + } else { # $sth->rows == 0 + # create a new one + # but first... get the next available srvid + $sth = $dbh->prepare('SELECT MAX(srvid) FROM rm_services'); + $sth->execute or die $dbh->errstr; + my $srvid = 1; # just in case you somehow have nothing in your database + if ( $sth->rows ) { + $srvid = $sth->fetchrow_arrayref->[0] + 1; + } + $params{'srvid'} = $srvid; + # NOW create a new one + warn "rm_services: inserting '$name' as srvid#$srvid\n" if $DEBUG; + $sth = $dbh->prepare( + 'INSERT INTO rm_services ('.join(', ', keys %params). + ') VALUES ('.join(', ', map {'?'} keys %params).')' + ); + $sth->execute(values(%params)) or die $dbh->errstr; + # also link it to our manager name + warn "rm_services: linking to manager\n" if $DEBUG; + $sth = $dbh->prepare( + 'INSERT INTO rm_allowedmanagers (srvid, managername) VALUES (?, ?)' + ); + $sth->execute($srvid, $self->option('manager')) or die $dbh->errstr; + # and allow it on our NAS + $sth = $dbh->prepare( + 'INSERT INTO rm_allowednases (srvid, nasid) VALUES (?, ?)' + ); + foreach my $nasid ($self->nas_ids($dbh)) { + warn "rm_services: linking to nasid#$nasid\n" if $DEBUG; + $sth->execute($srvid, $nasid) or die $dbh->errstr; + } + return $srvid; + } +} + +=item nas_ids DBH + +Convert the 'nasnames option into a list of real NAS ids. + +=cut + +sub nas_ids { + my $self = shift; + my $dbh = shift; + + my @nasnames = split(/\s*,\s*/, $self->option('nasnames')); + return unless @nasnames; + # pass these through unchanged + my @ids = grep { /^\d+$/ } @nasnames; + @nasnames = grep { not /^\d+$/ } @nasnames; + my $in_nasnames = join(',', map {$dbh->quote($_)} @nasnames); + + my $sth = $dbh->prepare("SELECT id FROM nas WHERE nasname IN ($in_nasnames)"); + $sth->execute or die $dbh->errstr; + my $rows = $sth->fetchall_arrayref; + push @ids, $_->[0] foreach @$rows; + + return @ids; +} + +1; diff --git a/FS/FS/part_export/domain_sql.pm b/FS/FS/part_export/domain_sql.pm index 0749fec09..ff0d949f1 100644 --- a/FS/FS/part_export/domain_sql.pm +++ b/FS/FS/part_export/domain_sql.pm @@ -26,6 +26,7 @@ my $postfix_transport_static = 'desc' => 'Real time export of domains to SQL databases '. '(postfix, others?)', 'options' => \%options, + 'no_machine' => 1, 'notes' => <<END Export domains (svc_domain records) to SQL databases. Currently this is a simple export with a default for Postfix, but it can be extended for other diff --git a/FS/FS/part_export/everyone_net.pm b/FS/FS/part_export/everyone_net.pm index 0fd32fa8b..7386973e4 100644 --- a/FS/FS/part_export/everyone_net.pm +++ b/FS/FS/part_export/everyone_net.pm @@ -18,6 +18,8 @@ tie my %options, 'Tie::IxHash', 'svc' => 'svc_acct', 'desc' => 'Real-time export to Everyone.net outsourced mail service', 'options'=> \%options, + 'no_machine' => 1, + 'default_svc_class' => 'Email', 'notes' => <<'END' Real-time export to <a href="http://www.everyone.net/">Everyone.net</a> via the XRC Remote API. diff --git a/FS/FS/part_export/ez_prepaid.pm b/FS/FS/part_export/ez_prepaid.pm new file mode 100644 index 000000000..9f454df54 --- /dev/null +++ b/FS/FS/part_export/ez_prepaid.pm @@ -0,0 +1,184 @@ +package FS::part_export::ez_prepaid; + +use base qw( FS::part_export ); + +use strict; +use vars qw(@ISA %info $version $replace_ok_kludge $product_info); +use Tie::IxHash; +use FS::Record qw( qsearchs ); +use FS::svc_external; +use SOAP::Lite; +use XML::Simple qw( xml_in ); +use Data::Dumper; + +$version = '01'; + +my $product_info; +my %language_id = ( English => 1, Spanish => 2 ); + +tie my %options, 'Tie::IxHash', + 'site_id' => { label => 'Site ID' }, + 'clerk_id' => { label => 'Clerk ID' }, +# 'product_id' => { label => 'Product ID' }, use the 'title' field +# 'amount' => { label => 'Purchase amount' }, + 'language' => { label => 'Language', + type => 'select', + options => [ 'English', 'Spanish' ], + }, + + 'debug' => { label => 'Debug level', + type => 'select', options => [0, 1, 2 ] }, +; + +%info = ( + 'svc' => 'svc_external', + 'desc' => 'Purchase EZ-Prepaid PIN', + 'options' => \%options, + 'no_machine' => 1, + 'notes' => <<'END' +<P>Export to the EZ-Prepaid PIN purchase service. If the purchase is allowed, +the PIN will be stored as svc_external.id.</P> +<P>svc_external.title must contain the product ID, and should be set as a fixed +field in the service definition. For a list of product IDs, see the +"Merchant Info" tab in the EZ Prepaid reseller portal.</P> +END + ); + +$replace_ok_kludge = 0; + +sub _export_insert { + my ($self, $svc_external) = @_; + + # the name on the certificate is 'debisys.com', for some reason + local $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME}=0; + + my $pin = eval { $self->ez_prepaid_PinDistSale( $svc_external->title ) }; + return $@ if $@; + + local($replace_ok_kludge) = 1; + $svc_external->set('id', $pin); + $svc_external->replace; +} + +sub _export_replace { + $replace_ok_kludge ? '' : "can't change PIN after purchase"; +} + +sub _export_delete { + "can't delete PIN after purchase"; +} + +# possibly options at some point to relate these to agentnum/usernum +sub site_id { $_[0]->option('site_id') } + +sub clerk_id { $_[0]->option('clerk_id') } + +sub ez_prepaid_PinDistSale { + my $self = shift; + my $product_id = shift; + $self->ez_prepaid_init; # populate product ID cache + my $info = $product_info->{$product_id}; + if ( $info ) { + if ( $self->option('debug') ) { + warn "Purchasing PIN product #$product_id:\n" . + $info->{Description}."\n". + $info->{CurrencyCode} . ' ' .$info->{Amount}."\n"; + } + } else { #no $info + die "Unknown PIN product #$product_id.\n"; + } + + my $response = $self->ez_prepaid_request( + 'PinDistSale', + $version, + $self->site_id, + $self->clerk_id, + $product_id, + '', # AccountID, not used for PIN sale + $product_info->{$product_id}->{Amount}, + $self->svcnum, + ($language_id{ $self->option('language') } || 1), + ); + if ( $self->option('debug') ) { + warn Dumper($response); + # includes serial number and transaction ID, possibly useful + # (but we don't have a structured place to store it--maybe in + # a customer note?) + } + $response->{Pin}; +} + +sub ez_prepaid_init { + # returns the SOAP client object + my $self = shift; + my $wsdl = 'https://webservice.ez-prepaid.com/soap/webServices.wsdl'; + + if ( $self->option('debug') >= 2 ) { + SOAP::Lite->import(+trace => [transport => \&log_transport ]); + } + + if ( !$self->client ) { + $self->set(client => SOAP::Lite->new->service($wsdl)); + # I don't know if this can happen, but better to bail out here + # than go into recursion. + die "Error creating SOAP client\n" if !$self->client; + } + + if ( !defined($product_info) ) { + # for now we only support the 'PIN' type + my $response = $self->ez_prepaid_request( + 'GetTransTypeList', $version, $self->site_id, '', '', '', '' + ); + my %transtype = map { $_->{Description} => $_->{TransTypeId} } + @{ $response->{TransType} }; + + if ( !exists $transtype{PIN} ) { + warn "'PIN' transaction type not available.\n"; + # or else your site ID is wrong + return; + } + + $response = $self->ez_prepaid_request( + 'GetProductList', + $version, + $self->option('site_id'), + $transtype{PIN}, + '', #CarrierId + '', #CategoryId + '', #ProductId + ); + $product_info = +{ + map { $_->{ProductId} => $_ } + @{ $response->{Product} } + }; + } #!defined $product_info +} + +sub log_transport { + my $in = shift; + if ( UNIVERSAL::can($in, 'content') ) { + warn $in->content."\n"; + } +} + +my @ForceArray = qw(TransType Product); # add others as needed +sub ez_prepaid_request { + my $self = shift; + # takes a method name and param list, + # returns a hashref containing the unpacked response + # or dies on error + + $self->ez_prepaid_init if !$self->client; + + my $method = shift; + my $xml = $self->client->$method(@_); + # All of their response data types are one part, a string, containing + # an encoded XML structure, containing the fields described in the docs. + my $response = xml_in($xml, ForceArray => \@ForceArray); + if ( exists($response->{ResponseCode}) && $response->{ResponseCode} > 0 ) { + die "[$method] ".$response->{ResponseMessage}; + } + $response; +} + +1; diff --git a/FS/FS/part_export/forward_sql.pm b/FS/FS/part_export/forward_sql.pm index 563efcc44..eb4137801 100644 --- a/FS/FS/part_export/forward_sql.pm +++ b/FS/FS/part_export/forward_sql.pm @@ -10,6 +10,7 @@ use FS::Record; 'desc' => 'Real-time export of forwards to SQL databases ', #.' (vpopmail, Postfix+Courier IMAP, others?)', 'options' => __PACKAGE__->sql_options, + 'no_machine' => 1, 'notes' => <<END Export mail forwards (svc_forward records) to SQL databases. diff --git a/FS/FS/part_export/freeswitch.pm b/FS/FS/part_export/freeswitch.pm new file mode 100644 index 000000000..eb490fd85 --- /dev/null +++ b/FS/FS/part_export/freeswitch.pm @@ -0,0 +1,192 @@ +package FS::part_export::freeswitch; +use base qw( FS::part_export ); + +use vars qw( %info ); # $DEBUG ); +#use Data::Dumper; +use Tie::IxHash; +use Text::Template; +use FS::Record qw( qsearch ); #qsearchs ); +use FS::svc_phone; +#use FS::Schema qw( dbdef ); + +#$DEBUG = 1; + +tie my %options, 'Tie::IxHash', + 'user' => { label => 'SSH username', default=>'root', }, + 'directory' => { label => 'Directory to store FreeSWITCH account XML files', + default => '/usr/local/freeswitch/conf/directory/', + }, + #'domain' => { label => 'Optional fixed SIP domain to use, overrides svc_phone domain', }, + 'reload' => { label => 'Reload command', + default => '/usr/local/freeswitch/bin/fs_cli -x reloadxml', + }, + 'user_template' => { label => 'User XML configuration template', + type => 'textarea', + default => <<'END', +<domain name="<% $domain %>"> + <user id="<% $phonenum %>"> + <params> + <param name="password" value="<% $sip_password %>"/> + </params> + </user> +</domain> +END + }, +; + +%info = ( + 'svc' => 'svc_phone', + 'desc' => 'Provision phone services to FreeSWITCH XML configuration files', + 'options' => \%options, + 'notes' => <<'END', +Export XML account configuration files to FreeSWITCH, one per domain. +<br><br> +You will need to enable the svc_phone-domain configuration setting and +<a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.9:Documentation:Administration:SSH_Keys">setup SSH for unattended operation</a>. +END +); + +sub rebless { shift; } + +sub _export_insert { + my( $self, $svc_phone ) = ( shift, shift ); + + $self->_export_rebuild_domain($svc_phone); + +} + +sub _export_replace { + my( $self, $new, $old ) = ( shift, shift, shift ); + + my $error = $self->_export_rebuild_domain($new); + return $error if $error; + + if ( $new->domsvc ne $old->domsvc && $old->domsvc ) { + $error = $self->_export_rebuild_domain($old); + return $error if $error; + } + + ''; +} + +sub _export_delete { + my( $self, $svc_phone ) = ( shift, shift ); + + $self->_export_rebuild_domain($svc_phone); +} + +sub _export_rebuild_domain { + my($self, $svc_phone) = ( shift, shift ); + + eval "use Net::SCP;"; + die $@ if $@; + + #create and copy over file + + my $tempdir = '%%%FREESIDE_CONF%%%/cache.'. $FS::UID::datasrc; + + my $domain = $svc_phone->domain or return "domain required"; + + my $fh = new File::Temp( + TEMPLATE => "$tempdir/freeswitch.$domain.XXXXXXXX", + DIR => $dir, + #UNLINK => 0, + ); + + print $fh qq(<domain name="$domain">\n); + + my @dom_svc_phone = qsearch( 'svc_phone', { 'domsvc'=>$svc_phone->domsvc } ); + + foreach my $dom_svc_phone (@dom_svc_phone) { + + print $fh $self->freeswitch_template_fillin( $dom_svc_phone, 'user' ) + or die "print to freeswitch template failed: $!"; + + } + + print $fh qq(</domain>\n); + $fh->flush; + + my $scp = new Net::SCP; + my $user = $self->option('user')||'root'; + my $host = $self->machine; + my $dir = $self->option('directory'); + + $scp->scp( $fh->filename, "$user\@$host:$dir/$domain.xml" ) + or return $scp->{errstr}; + + #signal freeswitch to reload config + $self->freeswitch_ssh( command => $self->option('reload') ); + + ''; + +} + +sub freeswitch_template_fillin { + my( $self, $svc_phone, $template ) = (shift, shift, shift); + + $template ||= 'user'; #? + + #cache a %tt hash? + my $tt = new Text::Template ( + TYPE => 'STRING', + SOURCE => $self->option($template.'_template'), + DELIMITERS => [ '<%', '%>' ], + ); + + #false lazinessish w/phone_shellcommands::_export_command + my %hash = ( + map { $_ => $svc_phone->getfield($_) } $svc_phone->fields + ); + + #might as well do em all, they're all going in an XML file as attribs + foreach ( keys %hash ) { + $hash{$_} =~ s/'/'/g; + $hash{$_} =~ s/"/"/g; + } + + $tt->fill_in( + HASH => \%hash, + ); +} + +##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::freeswitch::ssh_cmd", +# }; +# $queue->insert( @_ ); +#} + +sub freeswitch_ssh { #method + my $self = shift; + ssh_cmd( user => $self->option('user')||'root', + host => $self->machine, + @_, + ); +} + +sub ssh_cmd { #subroutine, not method + use Net::OpenSSH; + my $opt = { @_ }; + open my $def_in, '<', '/dev/null' or die "unable to open /dev/null"; + my $ssh = Net::OpenSSH->new( $opt->{'user'}.'@'.$opt->{'host'}, + default_stdin_fh => $def_in, + ); + die "Couldn't establish SSH connection: ". $ssh->error if $ssh->error; + my ($output, $errput) = $ssh->capture2( #{stdin_discard => 1}, + $opt->{'command'} + ); + die "Error running SSH command: ". $ssh->error if $ssh->error; + + #who the fuck knows what freeswitch reload outputs, probably a fucking + # ascii advertisement for cluecon + #die $errput if $errput; + #die $output if $output; + + ''; +} + +1; diff --git a/FS/FS/part_export/globalpops_voip.pm b/FS/FS/part_export/globalpops_voip.pm index 6df21f406..9fe45ba0a 100644 --- a/FS/FS/part_export/globalpops_voip.pm +++ b/FS/FS/part_export/globalpops_voip.pm @@ -19,6 +19,7 @@ tie my %options, 'Tie::IxHash', 'svc' => 'svc_phone', 'desc' => 'Provision phone numbers to VoIP Innovations (formerly GlobalPOPs VoIP)', 'options' => \%options, + 'no_machine' => 1, 'notes' => <<'END' Requires installation of <a href="http://search.cpan.org/dist/Net-GlobalPOPs-MediaServicesAPI">Net::GlobalPOPs::MediaServicesAPI</a> diff --git a/FS/FS/part_export/http.pm b/FS/FS/part_export/http.pm index 3749224ff..c35c89f12 100644 --- a/FS/FS/part_export/http.pm +++ b/FS/FS/part_export/http.pm @@ -43,6 +43,7 @@ tie %options, 'Tie::IxHash', 'svc' => 'svc_domain', 'desc' => 'Send an HTTP or HTTPS GET or POST request', 'options' => \%options, + 'no_machine' => 1, '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> diff --git a/FS/FS/part_export/http_status.pm b/FS/FS/part_export/http_status.pm index 5342106b4..6fbd3fbe6 100644 --- a/FS/FS/part_export/http_status.pm +++ b/FS/FS/part_export/http_status.pm @@ -17,6 +17,7 @@ tie my %options, 'Tie::IxHash', 'svc' => 'svc_dsl', 'desc' => 'Retrieve status information via HTTP or HTTPS', 'options' => \%options, + 'no_machine' => 1, 'notes' => <<'END' Fields from the service can be substituted in the URL as $field. END diff --git a/FS/FS/part_export/ikano.pm b/FS/FS/part_export/ikano.pm index eedc9d0ac..23917bf9e 100644 --- a/FS/FS/part_export/ikano.pm +++ b/FS/FS/part_export/ikano.pm @@ -31,6 +31,7 @@ tie my %options, 'Tie::IxHash', 'svc' => 'svc_dsl', 'desc' => 'Provision DSL to Ikano', 'options' => \%options, + 'no_machine' => 1, 'notes' => <<'END' Requires installation of <a href="http://search.cpan.org/dist/Net-Ikano">Net::Ikano</a> from CPAN. diff --git a/FS/FS/part_export/indosoft.pm b/FS/FS/part_export/indosoft.pm index b5734019b..02ae5efc5 100644 --- a/FS/FS/part_export/indosoft.pm +++ b/FS/FS/part_export/indosoft.pm @@ -17,6 +17,7 @@ tie my %options, 'Tie::IxHash', 'desc' => 'Export conferences to the Indosoft Conference Bridge', 'options' => \%options, + 'no_machine' => 1, 'notes' => <<'END' Export conferences to the Indosoft conference bridge. Net::Indosoft::Voicebridge is required. diff --git a/FS/FS/part_export/infostreet.pm b/FS/FS/part_export/infostreet.pm index ef16c7c54..51f57605a 100644 --- a/FS/FS/part_export/infostreet.pm +++ b/FS/FS/part_export/infostreet.pm @@ -19,6 +19,7 @@ tie my %options, 'Tie::IxHash', 'desc' => 'Real-time export to InfoStreet streetSmartAPI', 'options' => \%options, 'nodomain' => 'Y', + 'no_machine' => 1, 'notes' => <<'END' Real-time export to <a href="http://www.infostreet.com/">InfoStreet</a> streetSmartAPI. diff --git a/FS/FS/part_export/internal_diddb.pm b/FS/FS/part_export/internal_diddb.pm index a94e43e28..b51f63173 100644 --- a/FS/FS/part_export/internal_diddb.pm +++ b/FS/FS/part_export/internal_diddb.pm @@ -17,6 +17,7 @@ tie my %options, 'Tie::IxHash', 'desc' => 'Provision phone numbers from the internal DID database', 'notes' => 'After adding the export, DIDs may be imported under Tools -> Importing -> Import phone numbers (DIDs)', 'options' => \%options, + 'no_machine' => 1, ); sub rebless { shift; } diff --git a/FS/FS/part_export/ldap.pm b/FS/FS/part_export/ldap.pm index 838532021..fe634d230 100644 --- a/FS/FS/part_export/ldap.pm +++ b/FS/FS/part_export/ldap.pm @@ -41,6 +41,7 @@ tie my %options, 'Tie::IxHash', 'svc' => 'svc_acct', 'desc' => 'Real-time export to LDAP', 'options' => \%options, + 'default_svc_class' => 'Email', '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. diff --git a/FS/FS/part_export/netsapiens.pm b/FS/FS/part_export/netsapiens.pm index 775e374ca..2e37d04b6 100644 --- a/FS/FS/part_export/netsapiens.pm +++ b/FS/FS/part_export/netsapiens.pm @@ -5,6 +5,7 @@ use MIME::Base64; use Tie::IxHash; use FS::part_export; use Date::Format qw( time2str ); +use Regexp::Common qw/URI/; @ISA = qw(FS::part_export); $me = '[FS::part_export::netsapiens]'; @@ -33,6 +34,20 @@ tie my %dialplan_fields, 'Tie::IxHash', 'from_user' => { label=>'Source User Translation' }, ; +my %features = ( + 'for' => 'Forward', + 'fnr' => 'Forward Not Registered', + 'fna' => 'Forward No Answer', + 'fbu' => 'Forward Busy', + 'dnd' => 'Do-Not-Disturb', + 'sim' => 'Simultaneous Ring', +); + +my %feature_param = ( + 'dnd' => 'n/a', + 'sim' => '$phonenum', +); + tie my %options, 'Tie::IxHash', 'login' => { label=>'NetSapiens tac2 User API username' }, 'password' => { label=>'NetSapiens tac2 User API password' }, @@ -44,6 +59,12 @@ tie my %options, 'Tie::IxHash', 'domain_no_tld' => { label=>'Omit TLD from domains', type=>'checkbox' }, 'debug' => { label=>'Enable debugging', type=>'checkbox' }, %subscriber_fields, + 'features' => { label => 'Default features', + type => 'select', + multiple => 1, + options => [ keys %features ], + option_label => sub { $features{$_[0]}; }, + }, %registrar_fields, %dialplan_fields, 'did_countrycode' => { label=>'Use country code in DID destination', @@ -51,18 +72,37 @@ tie my %options, 'Tie::IxHash', ; %info = ( - 'svc' => [ 'svc_phone', ], # 'part_device', - 'desc' => 'Provision phone numbers to NetSapiens', - 'options' => \%options, - 'notes' => <<'END' + 'svc' => [ 'svc_phone', ], # 'part_device', + 'desc' => 'Provision phone numbers to NetSapiens', + 'options' => \%options, + 'no_machine' => 1, + 'notes' => <<'END' Requires installation of <a href="http://search.cpan.org/dist/REST-Client">REST::Client</a> from CPAN. END ); +# http://devguide.netsapiens.com/ + sub rebless { shift; } + +sub check_options { + my ($self, $options) = @_; + + my $rex = qr/$RE{URI}{HTTP}{-scheme => qr|https?|}/; # match any "http:" or "https:" URL + + for my $key (qw/url device_url/) { + if ($$options{$key} && ($$options{$key} !~ $rex)) { + return "Invalid (URL): " . $$options{$key}; + } + } + return ''; +} + + + sub ns_command { my $self = shift; $self->_ns_command('', @_); @@ -130,6 +170,14 @@ sub ns_registrar { '/registrar_config/'. $self->ns_devicename($svc_phone); } +sub ns_feature { + my($self, $svc_phone, $feature) = (shift, shift, shift); + + $self->ns_subscriber($svc_phone). + "/feature_config/$feature,*,*,*,*"; + +} + sub ns_devicename { my( $self, $svc_phone ) = (shift, shift); @@ -186,7 +234,9 @@ sub ns_create_or_update { my ($email) = ($cust_main->invoicing_list_emailonly, ''); my $custnum = $cust_main->custnum; + ### # Piece 1 (already done) - User creation + ### $phonenum =~ /^(\d{3})/; my $area_code = $1; @@ -213,7 +263,34 @@ sub ns_create_or_update { join(', ', $self->ns_parse_response( $ns->responseContent ) ); } - #Piece 2 - sip device creation + ### + # Piece 1.5 - feature creation + ### + foreach $feature (split /\s+/, $self->option('features') ) { + + my $param= exists($feature_param{$feature}) ? $feature_param{$feature} : ''; + $param = $phonenum if $param eq '$phonenum'; + + my $nsf = $self->ns_command( 'PUT', $self->ns_feature($svc_phone, $feature), + 'control' => 'd', #User Control, disable + 'expires' => 'never', + #'ts' => '', #? + 'parameters' => $param, + 'hour_match' => '*', + 'time_frame' => '*', + 'activation' => 'now', + ); + + if ( $nsf->responseCode !~ /^2/ ) { + return $nsf->responseCode. ' '. + join(', ', $self->ns_parse_response( $ns->responseContent ) ); + } + + } + + ### + # Piece 2 - sip device creation + ### my $ns2 = $self->ns_command( 'PUT', $self->ns_registrar($svc_phone), 'termination_match' => $self->ns_devicename($svc_phone), @@ -227,7 +304,9 @@ sub ns_create_or_update { join(', ', $self->ns_parse_response( $ns2->responseContent ) ); } - #Piece 3 - DID mapping to user + ### + # Piece 3 - DID mapping to user + ### my $ns3 = $self->ns_command( 'PUT', $self->ns_dialplan($svc_phone), 'to_user' => $phonenum, diff --git a/FS/FS/part_export/null.pm b/FS/FS/part_export/null.pm index 0145af3a4..3a764883c 100644 --- a/FS/FS/part_export/null.pm +++ b/FS/FS/part_export/null.pm @@ -11,3 +11,4 @@ sub _export_insert {} sub _export_replace {} sub _export_delete {} +1; diff --git a/FS/FS/part_export/phone_shellcommands.pm b/FS/FS/part_export/phone_shellcommands.pm index 040af27a7..5c1ae0153 100644 --- a/FS/FS/part_export/phone_shellcommands.pm +++ b/FS/FS/part_export/phone_shellcommands.pm @@ -138,3 +138,4 @@ sub ssh_cmd { #subroutine, not method &Net::SSH::ssh_cmd( { @_ } ); } +1; diff --git a/FS/FS/part_export/phone_sqlopensips.pm b/FS/FS/part_export/phone_sqlopensips.pm index 3d01c1624..7b07ecf4a 100644 --- a/FS/FS/part_export/phone_sqlopensips.pm +++ b/FS/FS/part_export/phone_sqlopensips.pm @@ -21,10 +21,11 @@ tie %options, 'Tie::IxHash', ; %info = ( - 'svc' => 'svc_phone', - 'desc' => 'Export DIDs to OpenSIPs dr_rules table', - 'options' => \%options, - 'notes' => 'Export DIDs to OpenSIPs dr_rules table', + 'svc' => 'svc_phone', + 'desc' => 'Export DIDs to OpenSIPs dr_rules table', + 'options' => \%options, + 'no_machine' => 1, + 'notes' => 'Export DIDs to OpenSIPs dr_rules table', ); sub rebless { shift; } @@ -93,3 +94,4 @@ sub dr_reload { ''; } +1; diff --git a/FS/FS/part_export/phone_sqlradius.pm b/FS/FS/part_export/phone_sqlradius.pm index 6b14bed3c..46c372cb4 100644 --- a/FS/FS/part_export/phone_sqlradius.pm +++ b/FS/FS/part_export/phone_sqlradius.pm @@ -39,10 +39,11 @@ tie %options, 'Tie::IxHash', ; %info = ( - 'svc' => 'svc_phone', - 'desc' => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS) for phone provisioning and rating', - 'options' => \%options, - 'notes' => <<END, + 'svc' => 'svc_phone', + 'desc' => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS) for phone provisioning and rating', + 'options' => \%options, + 'no_machine' => 1, + 'notes' => <<END, Real-time export of <b>radcheck</b> table to any SQL database for <a href="http://www.freeradius.org/">FreeRADIUS</a> or <a href="http://radius.innercite.com/">ICRADIUS</a>. diff --git a/FS/FS/part_export/postfix.pm b/FS/FS/part_export/postfix.pm index 4fd19ee61..9a8d617f3 100644 --- a/FS/FS/part_export/postfix.pm +++ b/FS/FS/part_export/postfix.pm @@ -22,6 +22,7 @@ tie my %options, 'Tie::IxHash', 'svc' => 'svc_forward', 'desc' => 'Postfix text files', 'options' => \%options, + 'default_svc_class' => 'Email', 'notes' => <<'END' Batch export of Postfix aliases and virtual files. <a href="http://search.cpan.org/dist/File-Rsync">File::Rsync</a> diff --git a/FS/FS/part_export/prizm.pm b/FS/FS/part_export/prizm.pm index 02e89c6d3..996448951 100644 --- a/FS/FS/part_export/prizm.pm +++ b/FS/FS/part_export/prizm.pm @@ -79,11 +79,12 @@ possibly harmful. EOT %info = ( - 'svc' => 'svc_broadband', - 'desc' => 'Real-time export to Northbound Interface', - 'options' => \%options, - 'nodomain' => 'Y', - 'notes' => $notes, + 'svc' => 'svc_broadband', + 'desc' => 'Real-time export to Northbound Interface', + 'options' => \%options, + 'nodomain' => 'Y', + 'no_machine' => 1, + 'notes' => $notes, ); sub prizm_command { diff --git a/FS/FS/part_export/radiator.pm b/FS/FS/part_export/radiator.pm index 2ac3edb22..f09d36abb 100644 --- a/FS/FS/part_export/radiator.pm +++ b/FS/FS/part_export/radiator.pm @@ -11,6 +11,8 @@ tie my %options, 'Tie::IxHash', %FS::part_export::sqlradius::options; 'desc' => 'Real-time export to RADIATOR', 'options' => \%options, 'nodomain' => '', + 'no_machine' => 1, + 'default_svc_class' => 'Internet', '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. diff --git a/FS/FS/part_export/router.pm b/FS/FS/part_export/router.pm index 6a1d676f4..3071ece74 100644 --- a/FS/FS/part_export/router.pm +++ b/FS/FS/part_export/router.pm @@ -87,6 +87,7 @@ tie my %options, 'Tie::IxHash', 'svc' => 'svc_broadband', 'desc' => 'Send a command to a router.', 'options' => \%options, + 'no_machine' => 1, 'notes' => 'Installation of Net::Telnet from CPAN is required for telnet connections. This export will execute if the following virtual fields are set on the router: admin_user, admin_password, admin_address, admin_timeout, admin_prompt. Option virtual fields are: admin_cmd_insert, admin_cmd_replace, admin_cmd_delete, admin_cmd_suspend, admin_cmd_unsuspend. See the module documentation for a full list of required/supported router virtual fields.', ); diff --git a/FS/FS/part_export/rt_ticket.pm b/FS/FS/part_export/rt_ticket.pm index b53b7da8a..7ae6105a0 100644 --- a/FS/FS/part_export/rt_ticket.pm +++ b/FS/FS/part_export/rt_ticket.pm @@ -127,6 +127,7 @@ tie my %options, 'Tie::IxHash', ( 'Create an RT ticket', 'options' => \%options, 'nodomain' => '', + 'no_machine' => 1, 'notes' => ' Create a ticket in RT. The subject and body of the ticket will be generated from a message template.' diff --git a/FS/FS/part_export/send_email.pm b/FS/FS/part_export/send_email.pm index 05f623633..6ba131f18 100644 --- a/FS/FS/part_export/send_email.pm +++ b/FS/FS/part_export/send_email.pm @@ -85,6 +85,7 @@ tie my %options, 'Tie::IxHash', ( 'Send an email message', 'options' => \%options, 'nodomain' => '', + 'no_machine' => 1, 'notes' => ' Send an email message. The subject and body of the message will be generated from a message template.' diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm index 20e909135..f964af31c 100644 --- a/FS/FS/part_export/shellcommands.pm +++ b/FS/FS/part_export/shellcommands.pm @@ -97,12 +97,12 @@ tie my %options, 'Tie::IxHash', ; %info = ( - 'svc' => 'svc_acct', - 'desc' => - 'Real-time export via remote SSH (i.e. useradd, userdel, etc.)', - 'options' => \%options, - 'nodomain' => 'Y', - 'notes' => <<'END' + 'svc' => 'svc_acct', + 'desc' => 'Real-time export via remote SSH (i.e. useradd, userdel, etc.)', + 'options' => \%options, + 'nodomain' => 'Y', + 'svc_machine' => 1, + '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 @@ -124,24 +124,7 @@ running will not accept a domain as a parameter. You will need to 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=' + <INPUT TYPE="button" VALUE="FreeBSD" 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"; @@ -360,7 +343,7 @@ sub _export_command { my @ssh_cmd_args = ( user => $self->option('user') || 'root', - host => $self->machine, + host => $self->svc_machine($svc_acct), command => $command_string, stdin_string => $stdin_string, ignored_errors => $self->option('ignored_errors') || '', @@ -373,7 +356,7 @@ sub _export_command { eval { ssh_cmd(@ssh_cmd_args) }; $error = $@; $error = $error->full_message if ref $error; # Exception::Class::Base - return $error. ' ('. $self->exporttype. ' to '. $self->machine. ')' + return $error. ' ('. $self->exporttype. ' to '. $self->svc_machine($svc_acct). ')' if $error; } else { @@ -433,7 +416,7 @@ sub _export_replace { # $error ||= "can't change RADIUS groups"; #} } - return $error. ' ('. $self->exporttype. ' to '. $self->machine. ')' + return $error. ' ('. $self->exporttype. ' to '. $self->svc_machine($new). ')' if $error; $new_agent_custid = $new_cust_main ? $new_cust_main->agent_custid : ''; @@ -457,7 +440,7 @@ sub _export_replace { my @ssh_cmd_args = ( user => $self->option('user') || 'root', - host => $self->machine, + host => $self->svc_machine($new), command => $command_string, stdin_string => $stdin_string, ignored_errors => $self->option('ignored_errors') || '', @@ -470,7 +453,7 @@ sub _export_replace { eval { ssh_cmd(@ssh_cmd_args) }; $error = $@; $error = $error->full_message if ref $error; # Exception::Class::Base - return $error. ' ('. $self->exporttype. ' to '. $self->machine. ')' + return $error. ' ('. $self->exporttype. ' to '. $self->svc_machine($new). ')' if $error; } else { @@ -507,7 +490,7 @@ sub ssh_cmd { #subroutine, not method my ($output, $errput) = $ssh->capture2($ssh_opt, $opt->{'command'}); return if $opt->{'ignore_all_errors'}; - die "Error running SSH command: ". $ssh->error if $ssh->error; + #die "Error running SSH command: ". $ssh->error if $ssh->error; if ( ($output || $errput) && $opt->{'ignored_errors'} && length($opt->{'ignored_errors'}) @@ -521,7 +504,9 @@ sub ssh_cmd { #subroutine, not method $errput =~ s/[\s\n]//g; } - die "$errput\n" if $errput; + die (($errput || $ssh->error). "\n") if $errput || $ssh->error; + #die "$errput\n" if $errput; + die "$output\n" if $output and $opt->{'fail_on_output'}; ''; } diff --git a/FS/FS/part_export/shellcommands_withdomain.pm b/FS/FS/part_export/shellcommands_withdomain.pm index 1ebf5f633..1b59589bf 100644 --- a/FS/FS/part_export/shellcommands_withdomain.pm +++ b/FS/FS/part_export/shellcommands_withdomain.pm @@ -80,10 +80,11 @@ tie my %options, 'Tie::IxHash', ; %info = ( - 'svc' => 'svc_acct', - 'desc' => 'Real-time export via remote SSH (vpopmail, ISPMan)', - 'options' => \%options, - 'notes' => <<'END' + 'svc' => 'svc_acct', + 'desc' => 'Real-time export via remote SSH (vpopmail, ISPMan, MagicMail)', + 'options' => \%options, + 'svc_machine' => 1, + '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 diff --git a/FS/FS/part_export/sqlmail.pm b/FS/FS/part_export/sqlmail.pm index cbdaf7f52..19505b488 100644 --- a/FS/FS/part_export/sqlmail.pm +++ b/FS/FS/part_export/sqlmail.pm @@ -37,6 +37,7 @@ tie my %options, 'Tie::IxHash', 'desc' => 'Real-time export to SQL-backed mail server', 'options' => \%options, 'nodomain' => '', + 'default_svc_class' => 'Email', '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 diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm index 910346bea..6760d09b7 100644 --- a/FS/FS/part_export/sqlradius.pm +++ b/FS/FS/part_export/sqlradius.pm @@ -110,7 +110,9 @@ END 'desc' => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS)', 'options' => \%options, 'nodomain' => 'Y', + 'no_machine' => 1, 'nas' => 'Y', # show export_nas selection in UI + 'default_svc_class' => 'Internet', 'notes' => $notes1. 'This export does not export RADIUS realms (see also '. 'sqlradius_withdomain). '. @@ -250,6 +252,7 @@ sub _export_replace { ''; } +#false laziness w/broadband_sqlradius.pm sub _export_suspend { my( $self, $svc_acct ) = (shift, shift); @@ -297,7 +300,7 @@ sub _export_suspend { } sub _export_unsuspend { - my( $self, $svc_acct ) = (shift, shift); + my( $self, $svc_x ) = (shift, shift); local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -310,21 +313,21 @@ sub _export_unsuspend { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $err_or_queue = $self->sqlradius_queue( $svc_acct->svcnum, 'insert', - 'check', $self->export_username($svc_acct), $svc_acct->radius_check ); + my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'insert', + 'check', $self->export_username($svc_x), $self->radius_check($svc_x) ); unless ( ref($err_or_queue) ) { $dbh->rollback if $oldAutoCommit; return $err_or_queue; } my $error; - my (@oldgroups) = $self->suspended_usergroups($svc_acct); + my (@oldgroups) = $self->suspended_usergroups($svc_x); $error = $self->sqlreplace_usergroups( - $svc_acct->svcnum, - $self->export_username($svc_acct), + $svc_x->svcnum, + $self->export_username($svc_x), '', \@oldgroups, - [ $svc_acct->radius_groups('hashref') ], + [ $svc_x->radius_groups('hashref') ], ); if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -345,6 +348,7 @@ sub _export_delete { sub sqlradius_queue { my( $self, $svcnum, $method ) = (shift, shift, shift); + my %args = @_; my $queue = new FS::queue { 'svcnum' => $svcnum, 'job' => "FS::part_export::sqlradius::sqlradius_$method", @@ -358,14 +362,16 @@ sub sqlradius_queue { } sub suspended_usergroups { - my ($self, $svc_acct) = (shift, shift); + my ($self, $svc_x) = (shift, shift); + + return () unless $svc_x; - return () unless $svc_acct; + my $svc_table = $svc_x->table; #false laziness with FS::part_export::shellcommands #subclass part_export? - my $r = $svc_acct->cust_svc->cust_pkg->last_reason('susp'); + my $r = $svc_x->cust_svc->cust_pkg->last_reason('susp'); my %reasonmap = $self->_groups_susp_reason_map; my $userspec = ''; if ($r) { @@ -374,19 +380,19 @@ sub suspended_usergroups { $userspec = $reasonmap{$r->reason} if (!$userspec && exists($reasonmap{$r->reason})); } - my $suspend_user; - if ($userspec =~ /^\d+$/ ){ - $suspend_user = qsearchs( 'svc_acct', { 'svcnum' => $userspec } ); - }elsif ($userspec =~ /^\S+\@\S+$/){ + my $suspend_svc; + if ( $userspec =~ /^\d+$/ ){ + $suspend_svc = qsearchs( $svc_table, { 'svcnum' => $userspec } ); + } elsif ( $userspec =~ /^\S+\@\S+$/ && $svc_table eq 'svc_acct' ){ my ($username,$domain) = split(/\@/, $userspec); for my $user (qsearch( 'svc_acct', { 'username' => $username } )){ - $suspend_user = $user if $userspec eq $user->email; + $suspend_svc = $user if $userspec eq $user->email; } - }elsif ($userspec){ - $suspend_user = qsearchs( 'svc_acct', { 'username' => $userspec } ); + }elsif ( $userspec && $svc_table eq 'svc_acct' ){ + $suspend_svc = qsearchs( 'svc_acct', { 'username' => $userspec } ); } #esalf - return $suspend_user->radius_groups('hashref') if $suspend_user; + return $suspend_svc->radius_groups('hashref') if $suspend_svc; (); } @@ -756,7 +762,7 @@ sub usage_sessions { } -=item update_svc_acct +=item update_svc =cut @@ -962,8 +968,7 @@ are identified by the combination of group name and attribute name. In the special case where attributes are being replaced because a group name (L<FS::radius_group>->groupname) is changing, the pseudo-field -'groupname' must be set in OLD_RADIUS_ATTR. It's probably best to do this - +'groupname' must be set in OLD_RADIUS_ATTR. =cut @@ -978,41 +983,43 @@ sub export_attr_replace { shift->export_attr_action('replace', @_); } sub export_attr_action { my $self = shift; my ($action, $new, $old) = @_; - my ($attrname, $attrtype, $groupname) = - ($new->attrname, $new->attrtype, $new->radius_group->groupname); - if ( $action eq 'replace' ) { - - if ( $new->attrtype ne $old->attrtype ) { - # they're in separate tables in the target - return $self->export_attr_action('delete', $old) - || $self->export_attr_action('insert', $new) - ; - } + my $err_or_queue; - # otherwise, just make sure we know the old attribute/group names - # so we can find the existing record - $attrname = $old->attrname; - $groupname = $old->groupname || $old->radius_group->groupname; - # maybe this should be enforced more strictly - warn "WARNING: attribute replace without 'groupname' set; assuming '$groupname'\n" - if !defined($old->groupname); + if ( $action eq 'delete' ) { + $old = $new; + } + if ( $action eq 'delete' or $action eq 'replace' ) { + # delete based on an exact match + my %opt = ( + attrname => $old->attrname, + attrtype => $old->attrtype, + groupname => $old->groupname || $old->radius_group->groupname, + op => $old->op, + value => $old->value, + ); + $err_or_queue = $self->sqlradius_queue('', 'attr_delete', %opt); + return $err_or_queue unless ref $err_or_queue; + } + # this probably doesn't matter, but just to be safe... + my $jobnum = $err_or_queue->jobnum if $action eq 'replace'; + if ( $action eq 'replace' or $action eq 'insert' ) { + my %opt = ( + attrname => $new->attrname, + attrtype => $new->attrtype, + groupname => $new->radius_group->groupname, + op => $new->op, + value => $new->value, + ); + $err_or_queue = $self->sqlradius_queue('', 'attr_insert', %opt); + $err_or_queue->depend_insert($jobnum) if $jobnum; + return $err_or_queue unless ref $err_or_queue; } - - my $err_or_queue = $self->sqlradius_queue('', "attr_$action", - attrnum => $new->attrnum, - attrname => $attrname, - attrtype => $attrtype, - groupname => $groupname, - ); - return $err_or_queue unless ref $err_or_queue; ''; } sub sqlradius_attr_insert { my $dbh = sqlradius_connect(shift, shift, shift); my %opt = @_; - my $radius_attr = qsearchs('radius_attr', { attrnum => $opt{'attrnum'} }) - or die 'attrnum '.$opt{'attrnum'}.' not found'; my $table; # make sure $table is completely safe @@ -1023,12 +1030,10 @@ sub sqlradius_attr_insert { $table = 'radgroupreply'; } else { - die "unknown attribute type '".$radius_attr->attrtype."'"; + die "unknown attribute type '$opt{attrtype}'"; } - my @values = ( - $opt{'groupname'}, map { $radius_attr->$_ } qw(attrname op value) - ); + my @values = @opt{ qw(groupname attrname op value) }; my $sth = $dbh->prepare( 'INSERT INTO '.$table.' (groupname, attribute, op, value) VALUES (?,?,?,?)' ); @@ -1050,41 +1055,16 @@ sub sqlradius_attr_delete { die "unknown attribute type '".$opt{'attrtype'}."'"; } + my @values = @opt{ qw(groupname attrname op value) }; my $sth = $dbh->prepare( - 'DELETE FROM '.$table.' WHERE groupname = ? AND attribute = ?' + 'DELETE FROM '.$table. + ' WHERE groupname = ? AND attribute = ? AND op = ? AND value = ?'. + ' LIMIT 1' ); - $sth->execute( @opt{'groupname', 'attrname'} ) or die $dbh->errstr; + $sth->execute(@values) or die $dbh->errstr; } -sub sqlradius_attr_replace { - my $dbh = sqlradius_connect(shift, shift, shift); - my %opt = @_; - my $radius_attr = qsearchs('radius_attr', { attrnum => $opt{'attrnum'} }) - or die 'attrnum '.$opt{'attrnum'}.' not found'; - - my $table; - if ( $opt{'attrtype'} eq 'C' ) { - $table = 'radgroupcheck'; - } - elsif ( $opt{'attrtype'} eq 'R' ) { - $table = 'radgroupreply'; - } - else { - die "unknown attribute type '".$opt{'attrtype'}."'"; - } - - my $sth = $dbh->prepare( - 'UPDATE '.$table.' SET groupname = ?, attribute = ?, op = ?, value = ? - WHERE groupname = ? AND attribute = ?' - ); - - my $new_groupname = $radius_attr->radius_group->groupname; - my @new_values = ( - $new_groupname, map { $radius_attr->$_ } qw(attrname op value) - ); - $sth->execute( @new_values, @opt{'groupname', 'attrname'} ) - or die $dbh->errstr; -} +#sub sqlradius_attr_replace { no longer needed =item export_group_replace NEW OLD @@ -1154,8 +1134,13 @@ sub _upgrade_exporttype { sub import_attrs { my $self = shift; - my $dbh = sqlradius_connect( map $self->option($_), + my $dbh = DBI->connect( map $self->option($_), qw( datasrc username password ) ); + unless ( $dbh ) { + warn "Error connecting to RADIUS server: $DBI::errstr\n"; + return; + } + my $usergroup = $self->option('usergroup') || 'usergroup'; my $error; warn "Importing RADIUS groups and attributes from ".$self->option('datasrc'). @@ -1176,6 +1161,7 @@ sub import_attrs { SELECT groupname, attribute, op, value, \'C\' FROM radgroupcheck UNION SELECT groupname, attribute, op, value, \'R\' FROM radgroupreply'; + my @fixes; # things that need to be changed on the radius db foreach my $row ( @{ $dbh->selectall_arrayref($sql) } ) { my ($groupname, $attrname, $op, $value, $attrtype) = @$row; warn "$groupname.$attrname\n"; @@ -1197,6 +1183,20 @@ SELECT groupname, attribute, op, value, \'R\' FROM radgroupreply'; my $old = $a->{$attrname}; my $new; + if ( $attrtype eq 'R' ) { + # Freeradius tolerates illegal operators in reply attributes. We don't. + if ( !grep ($_ eq $op, FS::radius_attr->ops('R')) ) { + warn "$groupname.$attrname: changing $op to +=\n"; + # Make a note to change it in the db + push @fixes, [ + 'UPDATE radgroupreply SET op = \'+=\' WHERE groupname = ? AND attribute = ? AND op = ? AND VALUE = ?', + $groupname, $attrname, $op, $value + ]; + # and import it correctly. + $op = '+='; + } + } + if ( defined $old ) { # replace $new = new FS::radius_attr { @@ -1226,6 +1226,13 @@ SELECT groupname, attribute, op, value, \'R\' FROM radgroupreply'; } $attrs_of{$groupname}->{$attrname} = $new; } #foreach $row + + foreach (@fixes) { + my ($sql, @args) = @$_; + my $sth = $dbh->prepare($sql); + $sth->execute(@args) or warn $sth->errstr; + } + return; } diff --git a/FS/FS/part_export/sqlradius_withdomain.pm b/FS/FS/part_export/sqlradius_withdomain.pm index e5a7151a2..2af9e8d76 100644 --- a/FS/FS/part_export/sqlradius_withdomain.pm +++ b/FS/FS/part_export/sqlradius_withdomain.pm @@ -6,11 +6,16 @@ use FS::part_export::sqlradius; tie my %options, 'Tie::IxHash', %FS::part_export::sqlradius::options; +$options{'strip_tld'} = { type => 'checkbox', + label => 'Strip TLD from realm names', + }; + %info = ( 'svc' => 'svc_acct', 'desc' => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS) with realms', 'options' => \%options, 'nodomain' => '', + 'default_svc_class' => 'Internet', 'notes' => $FS::part_export::sqlradius::notes1. 'This export exports domains to RADIUS realms (see also '. 'sqlradius). '. @@ -21,7 +26,11 @@ tie my %options, 'Tie::IxHash', %FS::part_export::sqlradius::options; sub export_username { my($self, $svc_acct) = (shift, shift); - $svc_acct->email; + my $email = $svc_acct->email; + if ( $self->option('strip_tld') ) { + $email =~ s/\.\w+$//; + } + $email; } 1; diff --git a/FS/FS/part_export/textradius.pm b/FS/FS/part_export/textradius.pm index 869c7c7dc..07de87563 100644 --- a/FS/FS/part_export/textradius.pm +++ b/FS/FS/part_export/textradius.pm @@ -18,6 +18,7 @@ tie my %options, 'Tie::IxHash', 'desc' => 'Real-time export to a text /etc/raddb/users file (Livingston, Cistron)', 'options' => \%options, + 'default_svc_class' => 'Internet', 'notes' => <<'END' This will edit a text RADIUS users file in place on a remote server. Requires installation of diff --git a/FS/FS/part_export/trango.pm b/FS/FS/part_export/trango.pm index e7f1126dd..64d2cc4ec 100644 --- a/FS/FS/part_export/trango.pm +++ b/FS/FS/part_export/trango.pm @@ -68,6 +68,7 @@ tie my %options, 'Tie::IxHash', ( 'svc' => 'svc_broadband', 'desc' => 'Sends SNMP SETs to a Trango AP.', 'options' => \%options, + 'no_machine' => 1, 'notes' => 'Requires Net::SNMP. See the documentation for FS::part_export::trango for required virtual fields and usage information.', ); diff --git a/FS/FS/part_export/vitelity.pm b/FS/FS/part_export/vitelity.pm index 12c3a7fce..350a5ad48 100644 --- a/FS/FS/part_export/vitelity.pm +++ b/FS/FS/part_export/vitelity.pm @@ -26,6 +26,7 @@ tie my %options, 'Tie::IxHash', 'svc' => 'svc_phone', 'desc' => 'Provision phone numbers to Vitelity', 'options' => \%options, + 'no_machine' => 1, 'notes' => <<'END' Requires installation of <a href="http://search.cpan.org/dist/Net-Vitelity">Net::Vitelity</a> diff --git a/FS/FS/part_export/vpopmail.pm b/FS/FS/part_export/vpopmail.pm index 799a8e1c1..5fca1704c 100644 --- a/FS/FS/part_export/vpopmail.pm +++ b/FS/FS/part_export/vpopmail.pm @@ -23,6 +23,7 @@ tie my %options, 'Tie::IxHash', 'svc' => 'svc_acct', 'desc' => 'Real-time export to vpopmail text files', 'options' => \%options, + 'default_svc_class' => 'Email', 'notes' => <<'END' This export is currently unmaintained. See shellcommands_withdomain for an export that uses vpopmail CLI commands instead.<BR> diff --git a/FS/FS/part_export/www_plesk.pm b/FS/FS/part_export/www_plesk.pm index ccf9b3e17..a247f054e 100644 --- a/FS/FS/part_export/www_plesk.pm +++ b/FS/FS/part_export/www_plesk.pm @@ -18,10 +18,11 @@ tie my %options, 'Tie::IxHash', ; %info = ( - 'svc' => 'svc_www', - 'desc' => 'Real-time export to Plesk managed hosting service', - 'options'=> \%options, - 'notes' => <<'END' + 'svc' => 'svc_www', + 'desc' => 'Real-time export to Plesk managed hosting service', + 'options' => \%options, + 'no_machine' => 1, + 'notes' => <<'END' Real-time export to <a href="http://www.swsoft.com/">Plesk</a> managed server. Requires installation of diff --git a/FS/FS/part_export/www_shellcommands.pm b/FS/FS/part_export/www_shellcommands.pm index d6116aba1..bef2e9470 100644 --- a/FS/FS/part_export/www_shellcommands.pm +++ b/FS/FS/part_export/www_shellcommands.pm @@ -188,3 +188,4 @@ sub ssh_cmd { #subroutine, not method ''; } +1; diff --git a/FS/FS/part_export_machine.pm b/FS/FS/part_export_machine.pm new file mode 100644 index 000000000..1598e0372 --- /dev/null +++ b/FS/FS/part_export_machine.pm @@ -0,0 +1,155 @@ +package FS::part_export_machine; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( dbh qsearch ); #qsearchs ); +use FS::part_export; +use FS::svc_export_machine; + +=head1 NAME + +FS::part_export_machine - Object methods for part_export_machine records + +=head1 SYNOPSIS + + use FS::part_export_machine; + + $record = new FS::part_export_machine \%hash; + $record = new FS::part_export_machine { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::part_export_machine object represents an export hostname choice. +FS::part_export_machine inherits from FS::Record. The following fields are +currently supported: + +=over 4 + +=item machinenum + +primary key + +=item exportnum + +Export, see L<FS::part_export> + +=item machine + +Hostname or IP address + +=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 { 'part_export_machine'; } + +=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. + +=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; + } + + foreach my $svc_export_machine ( $self->svc_export_machine ) { + my $error = $svc_export_machine->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. + +=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('machinenum') + || $self->ut_foreign_key('exportnum', 'part_export', 'exportnum') + || $self->ut_domain('machine') + || $self->ut_enum('disabled', [ '', 'Y' ]) + ; + return $error if $error; + + $self->SUPER::check; +} + +=item svc_export_machine + +=cut + +sub svc_export_machine { + my $self = shift; + qsearch( 'svc_export_machine', { 'machinenum' => $self->machinenum } ); +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::part_export>, L<FS::Record> + +=cut + +1; + diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index 061001bdc..6e7f8f87e 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -103,6 +103,9 @@ inherits from FS::Record. The following fields are currently supported: =item fcc_ds0s - Optional DS0 equivalency number for FCC form 477 +=item fcc_voip_class - Which column of FCC form 477 part II.B this package +belongs in. + =item successor - Foreign key for the part_pkg that replaced this record. If this record is not obsolete, will be null. @@ -622,6 +625,7 @@ sub check { : $self->ut_agentnum_acl('agentnum', \@null_agentnum_right) ) || $self->ut_numbern('fcc_ds0s') + || $self->ut_numbern('fcc_voip_class') || $self->ut_foreign_keyn('successor', 'part_pkg', 'pkgpart') || $self->ut_foreign_keyn('family_pkgpart', 'part_pkg', 'pkgpart') || $self->SUPER::check @@ -1592,6 +1596,83 @@ sub _upgrade_data { # class method } } + # set any package with FCC voice lines to the "VoIP with broadband" category + # for backward compatibility + # + # recover from a bad upgrade bug + my $upgrade = 'part_pkg_fcc_voip_class_FIX'; + if (!FS::upgrade_journal->is_done($upgrade)) { + my $bad_upgrade = qsearchs('upgrade_journal', + { upgrade => 'part_pkg_fcc_voip_class' } + ); + if ( $bad_upgrade ) { + my $where = 'WHERE history_date <= '.$bad_upgrade->_date. + ' AND history_date > '.($bad_upgrade->_date - 3600); + my @h_part_pkg_option = map { FS::part_pkg_option->new($_->hashref) } + qsearch({ + 'select' => '*', + 'table' => 'h_part_pkg_option', + 'hashref' => {}, + 'extra_sql' => "$where AND history_action = 'delete'", + 'order_by' => 'ORDER BY history_date ASC', + }); + my @h_pkg_svc = map { FS::pkg_svc->new($_->hashref) } + qsearch({ + 'select' => '*', + 'table' => 'h_pkg_svc', + 'hashref' => {}, + 'extra_sql' => "$where AND history_action = 'replace_old'", + 'order_by' => 'ORDER BY history_date ASC', + }); + my %opt; + foreach my $deleted (@h_part_pkg_option, @h_pkg_svc) { + my $pkgpart ||= $deleted->pkgpart; + $opt{$pkgpart} ||= { + options => {}, + pkg_svc => {}, + primary_svc => '', + hidden_svc => {}, + }; + if ( $deleted->isa('FS::part_pkg_option') ) { + $opt{$pkgpart}{options}{ $deleted->optionname } = $deleted->optionvalue; + } else { # pkg_svc + my $svcpart = $deleted->svcpart; + $opt{$pkgpart}{pkg_svc}{$svcpart} = $deleted->quantity; + $opt{$pkgpart}{hidden_svc}{$svcpart} ||= $deleted->hidden; + $opt{$pkgpart}{primary_svc} = $svcpart if $deleted->primary_svc; + } + } + foreach my $pkgpart (keys %opt) { + my $part_pkg = FS::part_pkg->by_key($pkgpart); + my $error = $part_pkg->replace( $part_pkg->replace_old, $opt{$pkgpart} ); + if ( $error ) { + die "error recovering damaged pkgpart $pkgpart:\n$error\n"; + } + } + } # $bad_upgrade exists + else { # do the original upgrade, but correctly this time + @part_pkg = qsearch('part_pkg', { + fcc_ds0s => { op => '>', value => 0 }, + fcc_voip_class => '' + }); + foreach my $part_pkg (@part_pkg) { + $part_pkg->set(fcc_voip_class => 2); + my @pkg_svc = $part_pkg->pkg_svc; + my %quantity = map {$_->svcpart, $_->quantity} @pkg_svc; + my %hidden = map {$_->svcpart, $_->hidden } @pkg_svc; + my $error = $part_pkg->replace( + $part_pkg->replace_old, + options => { $part_pkg->options }, + pkg_svc => \%quantity, + hidden_svc => \%hidden, + primary_svc => ($part_pkg->svcpart || ''), + ); + die $error if $error; + } + } + FS::upgrade_journal->set_done($upgrade); + } + } =item curuser_pkgs_sql diff --git a/FS/FS/part_pkg/delayed_Mixin.pm b/FS/FS/part_pkg/delayed_Mixin.pm index d28480db2..83e543a4f 100644 --- a/FS/FS/part_pkg/delayed_Mixin.pm +++ b/FS/FS/part_pkg/delayed_Mixin.pm @@ -2,6 +2,7 @@ package FS::part_pkg::delayed_Mixin; use strict; use vars qw(%info); +use NEXT; %info = ( 'disabled' => 1, @@ -45,7 +46,7 @@ sub calc_remain { && $last_bill == $cust_pkg->setup; } - return $self->SUPER::calc_remain($cust_pkg, %options); + return $self->NEXT::calc_remain($cust_pkg, %options); } sub can_start_date { ! shift->option('delay_setup', 1) } diff --git a/FS/FS/part_pkg/flat.pm b/FS/FS/part_pkg/flat.pm index 0e44f5db5..22eb69815 100644 --- a/FS/FS/part_pkg/flat.pm +++ b/FS/FS/part_pkg/flat.pm @@ -151,8 +151,9 @@ sub calc_recur { if $self->recur_temporality eq 'preceding' && !$last_bill; my $charge = $self->base_recur($cust_pkg, $sdate); - if ( my $cutoff_day = $self->cutoff_day($cust_pkg) ) { - $charge = $self->calc_prorate(@_, $cutoff_day); + # always treat cutoff_day as a list + if ( my @cutoff_day = $self->cutoff_day($cust_pkg) ) { + $charge = $self->calc_prorate(@_, @cutoff_day); } elsif ( $param->{freq_override} ) { # XXX not sure if this should be mutually exclusive with sync_bill_date. @@ -161,6 +162,9 @@ sub calc_recur { $charge *= $param->{freq_override} if $param->{freq_override}; } + my $quantity = $cust_pkg->quantity || 1; + $charge *= $quantity; + my $discount = $self->calc_discount($cust_pkg, $sdate, $details, $param); return sprintf('%.2f', $charge - $discount); } @@ -174,7 +178,7 @@ sub cutoff_day { return (localtime($next_bill))[3]; } } - return 0; + return (); } sub base_recur { diff --git a/FS/FS/part_pkg/flat_introrate.pm b/FS/FS/part_pkg/flat_introrate.pm index 33cc3d48a..10c205609 100644 --- a/FS/FS/part_pkg/flat_introrate.pm +++ b/FS/FS/part_pkg/flat_introrate.pm @@ -32,8 +32,8 @@ sub base_recur { warn "flat_introrate base_recur requires date!" if !$time; my $now = $time ? $$time : time; - my ($duration) = ($self->option('intro_duration') =~ /^(\d+)$/); - unless ($duration) { + my ($duration) = ($self->option('intro_duration') =~ /^\s*(\d+)\s*$/); + unless (length($duration)) { die "Invalid intro_duration: " . $self->option('intro_duration'); } my $intro_end = $self->add_freq($cust_pkg->setup, $duration); diff --git a/FS/FS/part_pkg/prepaid.pm b/FS/FS/part_pkg/prepaid.pm index 407343bc8..50f908c6d 100644 --- a/FS/FS/part_pkg/prepaid.pm +++ b/FS/FS/part_pkg/prepaid.pm @@ -23,7 +23,7 @@ tie my %overlimit_action, 'Tie::IxHash', 'shortname' => 'Prepaid, no automatic cycle', 'inherit_fields' => [ 'usage_Mixin', 'global_Mixin' ], 'fields' => { - 'recur_action' => { 'name' => 'Action to take upon reaching end of prepaid preiod', + 'recur_action' => { 'name' => 'Action to take upon reaching end of prepaid period', 'type' => 'select', 'select_options' => \%recur_action, }, diff --git a/FS/FS/part_pkg/prorate.pm b/FS/FS/part_pkg/prorate.pm index f930d417d..ac86f3918 100644 --- a/FS/FS/part_pkg/prorate.pm +++ b/FS/FS/part_pkg/prorate.pm @@ -44,12 +44,16 @@ use FS::part_pkg::flat; sub calc_recur { my $self = shift; - return $self->calc_prorate(@_, $self->cutoff_day) - $self->calc_discount(@_); + my $cust_pkg = $_[0]; + $self->calc_prorate(@_, $self->cutoff_day($cust_pkg)) + - $self->calc_discount(@_); } sub cutoff_day { - my $self = shift; - $self->option('cutoff_day', 1) || 1; + my( $self, $cust_pkg ) = @_; + my $prorate_day = $cust_pkg->cust_main->prorate_day; + $prorate_day ? ( $prorate_day ) + : split(/\s*,\s*/, $self->option('cutoff_day', 1) || '1'); } 1; diff --git a/FS/FS/part_pkg/prorate_Mixin.pm b/FS/FS/part_pkg/prorate_Mixin.pm index a01b5c409..d148c963d 100644 --- a/FS/FS/part_pkg/prorate_Mixin.pm +++ b/FS/FS/part_pkg/prorate_Mixin.pm @@ -4,6 +4,7 @@ use strict; use vars qw( %info ); use Time::Local qw( timelocal timelocal_nocheck ); use Date::Format qw( time2str ); +use List::Util qw( min ); %info = ( 'disabled' => 1, @@ -76,8 +77,8 @@ day arrives. =cut sub calc_prorate { - my ($self, $cust_pkg, $sdate, $details, $param, $cutoff_day) = @_; - die "no cutoff_day" unless $cutoff_day; + my ($self, $cust_pkg, $sdate, $details, $param, @cutoff_days) = @_; + die "no cutoff_day" unless @cutoff_days; die "can't prorate non-monthly package\n" if $self->freq =~ /\D/; my $money_char = FS::Conf->new->config('money_char') || '$'; @@ -103,8 +104,19 @@ sub calc_prorate { $add_period = 1; } + # if the customer alreqady has a billing day-of-month established, + # and it's a valid cutoff day, try to respect it + my $next_bill_day; + if ( my $next_bill = $cust_pkg->cust_main->next_bill_date ) { + $next_bill_day = (localtime($next_bill))[3]; + if ( grep {$_ == $next_bill_day} @cutoff_days ) { + # by removing all other cutoff days from the list + @cutoff_days = ($next_bill_day); + } + } + my ($mend, $mstart); - ($mnow, $mend, $mstart) = $self->_endpoints($mnow, $cutoff_day); + ($mnow, $mend, $mstart) = $self->_endpoints($mnow, @cutoff_days); # next bill date will be figured as $$sdate + one period $$sdate = $mstart; @@ -155,12 +167,12 @@ set, in which case it postpones the next bill to the cutoff day. sub prorate_setup { my $self = shift; my ($cust_pkg, $sdate) = @_; - my $cutoff_day = $self->cutoff_day($cust_pkg); + my @cutoff_days = $self->cutoff_day($cust_pkg); if ( ! $cust_pkg->bill and $self->option('prorate_defer_bill',1) - and $cutoff_day + and @cutoff_days ) { - my ($mnow, $mend, $mstart) = $self->_endpoints($sdate, $cutoff_day); + my ($mnow, $mend, $mstart) = $self->_endpoints($sdate, @cutoff_days); # If today is the cutoff day, set the next bill and setup both to # midnight today, so that the customer will be billed normally for a # month starting today. @@ -186,7 +198,9 @@ before the end of the prorate interval. =cut sub _endpoints { - my ($self, $mnow, $cutoff_day) = @_; + my $self = shift; + my $mnow = shift; + my @cutoff_days = sort {$a <=> $b} @_; # only works for freq >= 1 month; probably can't be fixed my ($sec, $min, $hour, $mday, $mon, $year) = (localtime($mnow))[0..5]; @@ -202,12 +216,20 @@ sub _endpoints { } my $mend; my $mstart; + # select the first cutoff day that's on or after the current day + my $cutoff_day = min( grep { $_ >= $mday } @cutoff_days ); + # if today is after the last cutoff, choose the first one + $cutoff_day ||= $cutoff_days[0]; + + # then, if today is on or after the selected day, set period to + # (cutoff day this month) - (cutoff day next month) if ( $mday >= $cutoff_day ) { $mend = timelocal_nocheck(0,0,0,$cutoff_day,$mon == 11 ? 0 : $mon + 1,$year+($mon==11)); $mstart = timelocal_nocheck(0,0,0,$cutoff_day,$mon,$year); } + # otherwise, set period to (cutoff day last month) - (cutoff day this month) else { $mend = timelocal_nocheck(0,0,0,$cutoff_day,$mon,$year); diff --git a/FS/FS/part_pkg/recur_Common.pm b/FS/FS/part_pkg/recur_Common.pm index 7233cc67f..03d5c2cb2 100644 --- a/FS/FS/part_pkg/recur_Common.pm +++ b/FS/FS/part_pkg/recur_Common.pm @@ -39,14 +39,15 @@ sub calc_setup { sub cutoff_day { # prorate/subscription only; we don't support sync_bill_date here - my $self = shift; - my $cust_pkg = shift; + my( $self, $cust_pkg ) = @_; my $recur_method = $self->option('recur_method',1) || 'anniversary'; - if ( $recur_method eq 'prorate' or $recur_method eq 'subscription' ) { - return $self->option('cutoff_day',1) || 1; - } else { - return 0; - } + return () unless $recur_method eq 'prorate' + || $recur_method eq 'subscription'; + + #false laziness w/prorate.pm::cutoff_day + my $prorate_day = $cust_pkg->cust_main->prorate_day; + $prorate_day ? ( $prorate_day ) + : split(/\s*,\s*/, $self->option('cutoff_day', 1) || '1'); } sub calc_recur_Common { @@ -58,26 +59,26 @@ sub calc_recur_Common { if ( $param->{'increment_next_bill'} ) { my $recur_method = $self->option('recur_method', 1) || 'anniversary'; - my $cutoff_day = $self->cutoff_day($cust_pkg); + my @cutoff_day = $self->cutoff_day($cust_pkg); $charges = $self->base_recur($cust_pkg); $charges += $param->{'override_charges'} if $param->{'override_charges'}; if ( $recur_method eq 'prorate' ) { - $charges = $self->calc_prorate(@_, $cutoff_day); + $charges = $self->calc_prorate(@_, @cutoff_day); $charges += $param->{'override_charges'} if $param->{'override_charges'}; } elsif ( $recur_method eq 'subscription' ) { my ($day, $mon, $year) = ( localtime($$sdate) )[ 3..5 ]; - if ( $day < $cutoff_day ) { + if ( $day < $cutoff_day[0] ) { if ( $mon == 0 ) { $mon=11; $year--; } else { $mon--; } } - $$sdate = timelocal(0, 0, 0, $cutoff_day, $mon, $year); + $$sdate = timelocal(0, 0, 0, $cutoff_day[0], $mon, $year); }#$recur_method diff --git a/FS/FS/part_pkg/voip_cdr.pm b/FS/FS/part_pkg/voip_cdr.pm index aaad974cf..8c3d80d49 100644 --- a/FS/FS/part_pkg/voip_cdr.pm +++ b/FS/FS/part_pkg/voip_cdr.pm @@ -401,9 +401,10 @@ sub calc_usage { #my @invoice_details_sort; #first rate any outstanding CDRs not yet rated - foreach my $cdr ( - $svc_x->get_cdrs( %options ) - ) { + my $cdr_search = $svc_x->psearch_cdrs(%options); + $cdr_search->limit(1000); + $cdr_search->increment(0); # because we're changing their status as we go + while ( my $cdr = $cdr_search->fetch ) { my $error = $cdr->rate( 'part_pkg' => $self, @@ -414,14 +415,19 @@ sub calc_usage { ); die $error if $error; #?? + $cdr_search->adjust(1) if $cdr->freesidestatus eq ''; + # it was skipped without changing status, so increment the + # offset so that we don't re-fetch it on refill + } # $cdr #then add details to invoices & get a total $options{'status'} = 'rated'; - foreach my $cdr ( - $svc_x->get_cdrs( %options ) - ) { + $cdr_search = $svc_x->psearch_cdrs(%options); + $cdr_search->limit(1000); + $cdr_search->increment(0); + while ( my $cdr = $cdr_search->fetch ) { my $error; # at this point we officially Do Not Care about the rating method if ( $included_calls > 0 ) { @@ -436,7 +442,9 @@ sub calc_usage { } die $error if $error; $formatter->append($cdr); - } + + $cdr_search->adjust(1) if $cdr->freesidestatus eq 'rated'; + } #$cdr } $formatter->finish; #writes into $details diff --git a/FS/FS/part_pkg/voip_inbound.pm b/FS/FS/part_pkg/voip_inbound.pm index f4e51836f..9054f7b99 100644 --- a/FS/FS/part_pkg/voip_inbound.pm +++ b/FS/FS/part_pkg/voip_inbound.pm @@ -227,19 +227,22 @@ sub calc_usage { ) { my $svc_phone = $cust_svc->svc_x; - foreach my $cdr ( $svc_phone->get_cdrs( + my $cdr_search = $svc_phone->psearch_cdrs( 'inbound' => 1, 'default_prefix' => $self->option('default_prefix'), 'status' => '', # unprocessed only 'for_update' => 1, - ) - ) { + ); + $cdr_search->limit(1000); + $cdr_search->increment(0); + while ( my $cdr = $cdr_search->fetch ) { my $reason = $self->check_chargable( $cdr, 'option_cache' => \%opt_cache, ); if ( $reason ) { warn "not charging for CDR ($reason)\n" if $DEBUG; + $cdr_search->adjust(1); next; } @@ -310,6 +313,8 @@ sub calc_usage { die $error if $error; $formatter->append($cdr); + $cdr_search->adjust(1) if $cdr->freesidestatus eq ''; + } #$cdr } # $cust_svc # unshift @$details, { format => 'C', diff --git a/FS/FS/part_pkg/voip_tiered.pm b/FS/FS/part_pkg/voip_tiered.pm index e5dcf6dd8..d8d74c13f 100644 --- a/FS/FS/part_pkg/voip_tiered.pm +++ b/FS/FS/part_pkg/voip_tiered.pm @@ -132,9 +132,11 @@ sub calc_usage { $options{'inbound'} = ( $pass eq 'inbound' ); - foreach my $cdr ( - $svc_x->get_cdrs( %options ) - ) { + my $cdr_search = $svc_x->psearch_cdrs(%options); + $cdr_search->limit(1000); + $cdr_search->increment(0); + while ( my $cdr = $cdr_search->fetch ) { + if ( $DEBUG > 1 ) { warn "rating CDR $cdr\n". join('', map { " $_ => ". $cdr->{$_}. "\n" } keys %$cdr ); @@ -173,6 +175,8 @@ sub calc_usage { $total += $charge_min; + $cdr_search->adjust(1) if $cdr->freesidestatus eq ''; + } # $cdr } # $pass @@ -213,9 +217,10 @@ sub calc_usage { # tell the formatter what we're sending it $formatter->inbound($options{'inbound'}); - foreach my $cdr ( - $svc_x->get_cdrs( %options ) - ) { + my $cdr_search = $svc_x->psearch_cdrs(%options); + $cdr_search->limit(1000); + $cdr_search->increment(0); + while ( my $cdr = $cdr_search->fetch ) { my $object = $options{'inbound'} ? $cdr->cdr_termination( 1 ) #1: inbound @@ -242,6 +247,8 @@ sub calc_usage { $formatter->append($cdr); + $cdr_search->adjust(1) if $cdr->freesidestatus eq 'processing-tiered'; + } # $cdr } # $pass diff --git a/FS/FS/part_pkg_taxrate.pm b/FS/FS/part_pkg_taxrate.pm index e29c3d0b4..c83f700d9 100644 --- a/FS/FS/part_pkg_taxrate.pm +++ b/FS/FS/part_pkg_taxrate.pm @@ -384,7 +384,7 @@ sub batch_import { } if ( scalar( @columns ) ) { $dbh->rollback if $oldAutoCommit; - return "Unexpected trailing columns in line (wrong format?): $line"; + return "Unexpected trailing columns in line (wrong format?) importing part_pkg_taxrate: $line"; } my $error = &{$hook}(\%part_pkg_taxrate); diff --git a/FS/FS/part_referral.pm b/FS/FS/part_referral.pm index c94c57e19..992e1c52a 100644 --- a/FS/FS/part_referral.pm +++ b/FS/FS/part_referral.pm @@ -163,10 +163,16 @@ simply using rather than editing advertising sources). sub all_part_referral { my $self = shift; + my $global = @_ ? shift : ''; + my $disabled = @_ ? shift : ''; + + my $hashref = $disabled ? {} : { 'disabled' => '' }; + my $and = $disabled ? ' WHERE ' : ' AND '; qsearch({ 'table' => 'part_referral', - 'extra_sql' => ' WHERE '. $self->acl_agentnum_sql(@_). ' ORDER BY refnum ', + 'hashref' => $hashref, + 'extra_sql' => $and. $self->acl_agentnum_sql($global). ' ORDER BY refnum ', }); } diff --git a/FS/FS/part_svc.pm b/FS/FS/part_svc.pm index 7e592bf72..7f22411e0 100644 --- a/FS/FS/part_svc.pm +++ b/FS/FS/part_svc.pm @@ -9,6 +9,7 @@ use FS::part_svc_column; use FS::part_export; use FS::export_svc; use FS::cust_svc; +use FS::part_svc_class; @ISA = qw(FS::Record); @@ -51,6 +52,8 @@ FS::Record. The following fields are currently supported: =item svcdb - table used for this service. See L<FS::svc_acct>, L<FS::svc_domain>, and L<FS::svc_forward>, among others. +=item classnum - Optional service class (see L<FS::svc_class>) + =item disabled - Disabled flag, empty or `Y' =item preserve - Preserve after cancellation, empty or 'Y' @@ -387,6 +390,7 @@ sub check { || $self->ut_enum('disabled', [ '', 'Y' ] ) || $self->ut_enum('preserve', [ '', 'Y' ] ) || $self->ut_enum('selfservice_access', [ '', 'hidden', 'readonly' ] ) + || $self->ut_foreign_keyn('classnum', 'part_svc_class', 'classnum' ) ; return $error if $error; @@ -587,7 +591,7 @@ sub _svc_defs { }; my $mod = $1; - if ( $mod =~ /^svc_[A-Z]/ or $mod =~ /^svc_acct_pop$/ ) { + if ( $mod =~ /^svc_[A-Z]/ or $mod =~ /^(svc_acct_pop|svc_export_machine)$/ ) { warn "skipping FS::$mod" if $DEBUG; next; } diff --git a/FS/FS/part_svc_class.pm b/FS/FS/part_svc_class.pm new file mode 100644 index 000000000..d1c991582 --- /dev/null +++ b/FS/FS/part_svc_class.pm @@ -0,0 +1,126 @@ +package FS::part_svc_class; +use base qw( FS::class_Common ); + +use strict; +use FS::Record; # qw( qsearch qsearchs ); + +=head1 NAME + +FS::part_svc_class - Object methods for part_svc_class records + +=head1 SYNOPSIS + + use FS::part_svc_class; + + $record = new FS::part_svc_class \%hash; + $record = new FS::part_svc_class { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::part_svc_class object represents a service class. FS::part_svc_class +inherits from FS::Record. The following fields are currently supported: + +=over 4 + +=item classnum + +primary key + +=item classname + +classname + +=item disabled + +disabled + + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new service class. To add the service 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 { 'part_svc_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 service 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_text('classname') + || $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/pay_batch.pm b/FS/FS/pay_batch.pm index bb92bdf2f..b8da9b49b 100644 --- a/FS/FS/pay_batch.pm +++ b/FS/FS/pay_batch.pm @@ -10,6 +10,10 @@ use FS::cust_pay; use FS::agent; use Date::Parse qw(str2time); use Business::CreditCard qw(cardtype); +use Scalar::Util 'blessed'; +use IO::Scalar; +use FS::Misc qw(send_email); # for error notification +use List::Util qw(sum); @ISA = qw(FS::Record); @@ -47,10 +51,14 @@ from FS::Record. The following fields are currently supported: =item status - O (Open), I (In-transit), or R (Resolved) -=item download - +=item download - time when the batch was first downloaded -=item upload - +=item upload - time when the batch was first uploaded +=item title - unique batch identifier + +For incoming batches, the combination of 'title', 'payby', and 'agentnum' +must be unique. =back @@ -116,15 +124,28 @@ sub check { || $self->ut_enum('payby', [ 'CARD', 'CHEK' ]) || $self->ut_enum('status', [ 'O', 'I', 'R' ]) || $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum') + || $self->ut_alphan('title') ; return $error if $error; + if ( $self->title ) { + my @existing = + grep { !$self->batchnum or $_->batchnum != $self->batchnum } + qsearch('pay_batch', { + payby => $self->payby, + agentnum => $self->agentnum, + title => $self->title, + }); + return "Batch already exists as batchnum ".$existing[0]->batchnum + if @existing; + } + $self->SUPER::check; } =item agent -Returns the L<FS::agent> object for this template. +Returns the L<FS::agent> object for this batch. =cut @@ -132,6 +153,16 @@ sub agent { qsearchs('agent', { 'agentnum' => $_[0]->agentnum }); } +=item cust_pay_batch + +Returns all L<FS::cust_pay_batch> objects for this batch. + +=cut + +sub cust_pay_batch { + qsearch('cust_pay_batch', { 'batchnum' => $_[0]->batchnum }); +} + =item rebalance =cut @@ -198,7 +229,10 @@ Options are: I<filehandle> - open filehandle of results file. -I<format> - "csv-td_canada_trust-merchant_pc_batch", "csv-chase_canada-E-xactBatch", "ach-spiritone", or "PAP" +I<format> - an L<FS::pay_batch> module + +I<gateway> - an L<FS::payment_gateway> object for a batch gateway. This +takes precedence over I<format>. =cut @@ -207,13 +241,13 @@ sub import_results { my $param = ref($_[0]) ? shift : { @_ }; my $fh = $param->{'filehandle'}; + my $job = $param->{'job'}; + $job->update_statustext(0) if $job; + my $format = $param->{'format'}; my $info = $import_info{$format} or die "unknown format $format"; - my $job = $param->{'job'}; - $job->update_statustext(0) if $job; - my $conf = new FS::Conf; my $filetype = $info->{'filetype'}; # CSV, fixed, variable @@ -254,10 +288,6 @@ sub import_results { my $total = 0; my $line; - # Order of operations has been changed here. - # We now slurp everything into @all_values, then - # process one line at a time. - if ($filetype eq 'XML') { eval "use XML::Simple"; die $@ if $@; @@ -428,8 +458,12 @@ sub process_import_results { my $param = thaw(decode_base64(shift)); $param->{'job'} = $job; warn Dumper($param) if $DEBUG; - my $batchnum = delete $param->{'batchnum'} or die "no batchnum specified\n"; - my $batch = FS::pay_batch->by_key($batchnum) or die "batchnum '$batchnum' not found\n"; + my $gatewaynum = delete $param->{'gatewaynum'}; + if ( $gatewaynum ) { + $param->{'gateway'} = FS::payment_gateway->by_key($gatewaynum) + or die "gatewaynum '$gatewaynum' not found\n"; + delete $param->{'format'}; # to avoid confusion + } my $file = $param->{'uploaded_files'} or die "no files provided\n"; $file =~ s/^(\w+):([\.\w]+)$/$2/; @@ -438,44 +472,404 @@ sub process_import_results { '<', "$dir/$file" ) or die "unable to open '$file'.\n"; - my $error = $batch->import_results($param); + + my $error; + if ( $param->{gateway} ) { + $error = FS::pay_batch->import_from_gateway(%$param); + } else { + my $batchnum = delete $param->{'batchnum'} or die "no batchnum specified\n"; + my $batch = FS::pay_batch->by_key($batchnum) or die "batchnum '$batchnum' not found\n"; + $error = $batch->import_results($param); + } unlink $file; die $error if $error; } -# Formerly httemplate/misc/download-batch.cgi -sub export_batch { - my $self = shift; - my $conf = new FS::Conf; - my $format = shift || $conf->config('batch-default_format') - or die "No batch format configured\n"; - my $info = $export_info{$format} or die "Format not found: '$format'\n"; - &{$info->{'init'}}($conf) if exists($info->{'init'}); +=item import_from_gateway [ OPTIONS ] - my $curuser = $FS::CurrentUser::CurrentUser; +Import results from a L<FS::payment_gateway>, using Business::BatchPayment, +and apply them. GATEWAY must use the Business::BatchPayment namespace. + +This is a class method, since results can be applied to any batch. +The 'batch-reconsider' option determines whether an already-approved +or declined payment can have its status changed by a later import. + +OPTIONS may include: + +- gateway: the L<FS::payment_gateway>, required +- filehandle: a file name or handle to use as a data source. +- job: an L<FS::queue> object to update with progress messages. + +=cut + +sub import_from_gateway { + my $class = shift; + my %opt = @_; + my $gateway = $opt{'gateway'}; + my $conf = FS::Conf->new; + + # unavoidable duplication with import_batch, for now + 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 $dbh = dbh; + + my $job = delete($opt{'job'}); + $job->update_statustext(0) if $job; + + my $total = 0; + return "import_from_gateway requires a payment_gateway" + unless eval { $gateway->isa('FS::payment_gateway') }; + + my %proc_opt = ( + 'input' => $opt{'filehandle'}, # will do nothing if it's empty + # any other constructor options go here + ); + + my @item_errors; + my $mail_on_error = $conf->config('batch-errors_to'); + if ( $mail_on_error ) { + # construct error trap + $proc_opt{'on_parse_error'} = sub { + my ($self, $line, $error) = @_; + push @item_errors, " '$line'\n$error"; + }; + } + + my $processor = $gateway->batch_processor(%proc_opt); + + my @batches = $processor->receive; + + my $num = 0; + + my $total_items = sum( map{$_->count} @batches); + + # whether to allow items to change status + my $reconsider = $conf->exists('batch-reconsider'); + + # mutex all affected batches + my %pay_batch_for_update; + + my %bop2payby = (CC => 'CARD', ECHECK => 'CHEK'); + + BATCH: foreach my $batch (@batches) { + + my %incoming_batch = ( + 'CARD' => {}, + 'CHEK' => {}, + ); + + ITEM: foreach my $item ($batch->elements) { + + my $cust_pay_batch; # the new batch entry (with status) + my $pay_batch; # the freeside batch it belongs to + my $payby; # CARD or CHEK + my $error; + + # follow realtime gateway practice here + # though eventually this stuff should go into separate fields... + my $paybatch = $gateway->gatewaynum . '-' . $gateway->gateway_module . + ':' . $item->authorization . ':' . $item->order_number; + + if ( $batch->incoming ) { + # This is a one-way batch. + # Locate the customer, find an open batch correct for them, + # create a payment. Don't bother creating a cust_pay_batch + # entry. + my $cust_main; + if ( defined($item->customer_id) + and $item->customer_id =~ /^\d+$/ + and $item->customer_id > 0 ) { + + $cust_main = FS::cust_main->by_key($item->customer_id) + || qsearchs('cust_main', + { 'agent_custid' => $item->customer_id } + ); + if ( !$cust_main ) { + push @item_errors, "Unknown customer_id ".$item->customer_id; + next ITEM; + } + } + else { + push @item_errors, "Illegal customer_id '".$item->customer_id."'"; + next ITEM; + } + # it may also make sense to allow selecting the customer by + # invoice_number, but no modules currently work that way + + $payby = $bop2payby{ $item->payment_type }; + my $agentnum = ''; + $agentnum = $cust_main->agentnum if $conf->exists('batch-spoolagent'); + + # create a batch if necessary + $pay_batch = $incoming_batch{$payby}->{$agentnum} ||= + FS::pay_batch->new({ + status => 'R', # pre-resolve it + payby => $payby, + agentnum => $agentnum, + upload => time, + title => $batch->batch_id, + }); + if ( !$pay_batch->batchnum ) { + $error = $pay_batch->insert; + die $error if $error; # can't do anything if this fails + } + + if ( !$item->approved ) { + $error ||= "payment rejected - ".$item->error_message; + } + if ( !defined($item->amount) or $item->amount <= 0 ) { + $error ||= "no amount in item $num"; + } + + my $payinfo; + if ( $item->check_number ) { + $payby = 'BILL'; # right? + $payinfo = $item->check_number; + } elsif ( $item->assigned_token ) { + $payinfo = $item->assigned_token; + } + # create the payment + my $cust_pay = FS::cust_pay->new( + { + custnum => $cust_main->custnum, + _date => $item->payment_date->epoch, + paid => sprintf('%.2f',$item->amount), + payby => $payby, + invnum => $item->invoice_number, + batchnum => $pay_batch->batchnum, + paybatch => $paybatch, + payinfo => $payinfo, + } + ); + $error ||= $cust_pay->insert; + eval { $cust_main->apply_payments }; + $error ||= $@; + + if ( $error ) { + push @item_errors, 'Payment for customer '.$item->customer_id."\n$error"; + } + + } else { + # This is a request/reply batch. + # Locate the request (the 'tid' attribute is the paybatchnum). + my $paybatchnum = $item->tid; + $cust_pay_batch = FS::cust_pay_batch->by_key($paybatchnum); + if (!$cust_pay_batch) { + push @item_errors, "paybatchnum $paybatchnum not found"; + next ITEM; + } + $payby = $cust_pay_batch->payby; + + my $batchnum = $cust_pay_batch->batchnum; + if ( $batch->batch_id and $batch->batch_id != $batchnum ) { + warn "batch ID ".$batch->batch_id. + " does not match batchnum ".$cust_pay_batch->batchnum."\n"; + } + + # lock the batch and check its status + $pay_batch = FS::pay_batch->by_key($batchnum); + $pay_batch_for_update{$batchnum} ||= $pay_batch->select_for_update; + if ( $pay_batch->status ne 'I' and !$reconsider ) { + $error = "batch $batchnum no longer in transit"; + } + + if ( $cust_pay_batch->status ) { + my $new_status = $item->approved ? 'approved' : 'declined'; + if ( lc( $cust_pay_batch->status ) eq $new_status ) { + # already imported with this status, so don't touch + next ITEM; + } + elsif ( !$reconsider ) { + # then we're not allowed to change its status, so bail out + $error = "paybatchnum ".$item->tid. + " already resolved with status '". $cust_pay_batch->status . "'"; + } + } + + if ( $error ) { + push @item_errors, "Payment for customer ".$cust_pay_batch->custnum."\n$error"; + next ITEM; + } + + my $new_payinfo; + # update payinfo, if needed + if ( $item->assigned_token ) { + $new_payinfo = $item->assigned_token; + } elsif ( $payby eq 'CARD' ) { + $new_payinfo = $item->card_number if $item->card_number; + } else { #$payby eq 'CHEK' + $new_payinfo = $item->account_number . '@' . $item->routing_code + if $item->account_number; + } + $cust_pay_batch->set('payinfo', $new_payinfo) if $new_payinfo; + + # set "paid" pseudo-field (transfers to cust_pay) to the actual amount + # paid, if the batch says it's different from the amount requested + if ( defined $item->amount ) { + $cust_pay_batch->set('paid', $item->amount); + } else { + $cust_pay_batch->set('paid', $cust_pay_batch->amount); + } + + # set payment date to when it was processed + $cust_pay_batch->_date($item->payment_date->epoch) + if $item->payment_date; + + # approval status + if ( $item->approved ) { + # follow Billing_Realtime format for paybatch + $error = $cust_pay_batch->approve($paybatch); + $total += $cust_pay_batch->paid; + } + else { + $error = $cust_pay_batch->decline($item->error_message); + } + + if ( $error ) { + push @item_errors, "Payment for customer ".$cust_pay_batch->custnum."\n$error"; + next ITEM; + } + } # $batch->incoming + + $num++; + $job->update_statustext(int(100 * $num/( $total_items ) ), + 'Importing batch items') + if $job; + + } #foreach $item + + } #foreach $batch (input batch, not pay_batch) + + # Format an error message + if ( @item_errors ) { + my $error_text = join("\n\n", + "Errors during batch import: ".scalar(@item_errors), + @item_errors + ); + if ( $mail_on_error ) { + my $subject = "Batch import errors"; #? + my $body = "Import from gateway ".$gateway->label."\n".$error_text; + send_email( + to => $mail_on_error, + from => $conf->config('invoice_from'), + subject => $subject, + body => $body, + ); + } else { + # Bail out. + $dbh->rollback if $oldAutoCommit; + die $error_text; + } + } + + # Auto-resolve (with brute-force error handling) + foreach my $pay_batch (values %pay_batch_for_update) { + my $error = $pay_batch->try_to_resolve; + + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + $dbh->commit if $oldAutoCommit; + return; +} + +=item try_to_resolve + +Resolve this batch if possible. A batch can be resolved if all of its +entries have status. If the system options 'batch-auto_resolve_days' +and 'batch-auto_resolve_status' are set, and the batch's download date is +at least (batch-auto_resolve_days) before the current time, then it can +be auto-resolved; entries with no status will be approved or declined +according to the batch-auto_resolve_status setting. + +=cut + +sub try_to_resolve { + my $self = shift; + my $conf = FS::Conf->new;; + + return if $self->status ne 'I'; + + my @unresolved = qsearch('cust_pay_batch', + { + batchnum => $self->batchnum, + status => '' + } + ); + + if ( @unresolved and $conf->exists('batch-auto_resolve_days') ) { + my $days = $conf->config('batch-auto_resolve_days'); # can be zero + # either 'approve' or 'decline' + my $action = $conf->config('batch-auto_resolve_status') || ''; + return unless + length($days) and + length($action) and + time > ($self->download + 86400 * $days) + ; + + my $error; + foreach my $cpb (@unresolved) { + if ( $action eq 'approve' ) { + # approve it for the full amount + $cpb->set('paid', $cpb->amount) unless ($cpb->paid || 0) > 0; + $error = $cpb->approve($self->batchnum); + } + elsif ( $action eq 'decline' ) { + $error = $cpb->decline('No response from processor'); + } + return $error if $error; + } + } + + $self->set_status('R'); +} + +=item prepare_for_export + +Prepare the batch to be exported. This will: +- Set the status to "in transit". +- If batch-increment_expiration is set and this is a credit card batch, + increment expiration dates that are in the past. +- If this is the first download for this batch, adjust payment amounts to + not be greater than the customer's current balance. If the customer's + balance is zero, the entry will be removed. + +Use this within a transaction. + +=cut + +sub prepare_for_export { + my $self = shift; + my $conf = FS::Conf->new; + my $curuser = $FS::CurrentUser::CurrentUser; my $first_download; my $status = $self->status; if ($status eq 'O') { $first_download = 1; my $error = $self->set_status('I'); - die "error updating pay_batch status: $error\n" if $error; + return "error updating pay_batch status: $error\n" if $error; } elsif ($status eq 'I' && $curuser->access_right('Reprocess batches')) { $first_download = 0; + } elsif ($status eq 'R' && + $curuser->access_right('Redownload resolved batches')) { + $first_download = 0; } else { die "No pending batch.\n"; } - my $batch = ''; - my $batchtotal = 0; - my $batchcount = 0; - - my @cust_pay_batch = sort { $a->paybatchnum <=> $b->paybatchnum } - qsearch('cust_pay_batch', { batchnum => $self->batchnum } ); + my @cust_pay_batch = sort { $a->paybatchnum <=> $b->paybatchnum } + $self->cust_pay_batch; # handle batch-increment_expiration option if ( $self->payby eq 'CARD' ) { @@ -487,40 +881,76 @@ sub export_batch { $year++ while( $year < $cyear or ($year == $cyear and $mon <= $cmon) ); $_->exp( sprintf('%4u-%02u-%02u', $year + 1900, $mon+1, $day) ); } - $_->setfield('expmmyy', sprintf('%02u%02u', $mon+1, $year % 100)); + my $error = $_->replace; + return $error if $error; } } if ($first_download) { #remove or reduce entries if customer's balance changed - my @new = (); foreach my $cust_pay_batch (@cust_pay_batch) { my $balance = $cust_pay_batch->cust_main->balance; if ($balance <= 0) { # then don't charge this customer my $error = $cust_pay_batch->delete; - if ( $error ) { - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; - die $error; - } - next; + return $error if $error; } elsif ($balance < $cust_pay_batch->amount) { # reduce the charge to the remaining balance $cust_pay_batch->amount($balance); my $error = $cust_pay_batch->replace; - if ( $error ) { - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; - die $error; - } + return $error if $error; } # else $balance >= $cust_pay_batch->amount - - push @new, $cust_pay_batch; } - @cust_pay_batch = @new; + } #if $first_download + + ''; +} + +=item export_batch [ format => FORMAT | gateway => GATEWAY ] + +Export batch for processing. FORMAT is the name of an L<FS::pay_batch> +module, in which case the configuration options are in 'batchconfig-FORMAT'. + +Alternatively, GATEWAY can be an L<FS::payment_gateway> object set to a +L<Business::BatchPayment> module. + +=cut + +sub export_batch { + my $self = shift; + my %opt = @_; + my $conf = new FS::Conf; + my $batch; + + my $gateway = $opt{'gateway'}; + if ( $gateway ) { + # welcome to the future + my $fh = IO::Scalar->new(\$batch); + $self->export_to_gateway($gateway, 'file' => $fh); + return $batch; } + my $format = $opt{'format'} || $conf->config('batch-default_format') + or die "No batch format configured\n"; + + my $info = $export_info{$format} or die "Format not found: '$format'\n"; + + &{$info->{'init'}}($conf) if exists($info->{'init'}); + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $self->prepare_for_export; + + die $error if $error; + my $batchtotal = 0; + my $batchcount = 0; + + my @cust_pay_batch = $self->cust_pay_batch; + my $delim = exists($info->{'delimiter'}) ? $info->{'delimiter'} : "\n"; my $h = $info->{'header'}; @@ -534,8 +964,8 @@ sub export_batch { $batchcount++; $batchtotal += $cust_pay_batch->amount; $batch .= - &{$info->{'row'}}($cust_pay_batch, $self, $batchcount, $batchtotal). - $delim; + &{$info->{'row'}}($cust_pay_batch, $self, $batchcount, $batchtotal). + $delim; } my $f = $info->{'footer'}; @@ -557,6 +987,43 @@ sub export_batch { return $batch; } +=item export_to_gateway GATEWAY OPTIONS + +Given L<FS::payment_gateway> GATEWAY, export the items in this batch to +that gateway via Business::BatchPayment. OPTIONS may include: + +- file: override the default transport and write to this file (name or handle) + +=cut + +sub export_to_gateway { + + my ($self, $gateway, %opt) = @_; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $self->prepare_for_export; + die $error if $error; + + my %proc_opt = ( + 'output' => $opt{'file'}, # will do nothing if it's empty + # any other constructor options go here + ); + my $processor = $gateway->batch_processor(%proc_opt); + + my @items = map { $_->request_item } $self->cust_pay_batch; + my $batch = Business::BatchPayment->create(Batch => + batch_id => $self->batchnum, + items => \@items + ); + $processor->submit($batch); + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; +} + sub manual_approve { my $self = shift; my $date = time; @@ -603,6 +1070,61 @@ sub manual_approve { return; } +sub _upgrade_data { + # Set up configuration for gateways that have a Business::BatchPayment + # module. + + eval "use Class::MOP;"; + if ( $@ ) { + warn "Moose/Class::MOP not available.\n$@\nSkipping pay_batch upgrade.\n"; + return; + } + my $conf = FS::Conf->new; + for my $format (keys %export_info) { + my $mod = "FS::pay_batch::$format"; + if ( $mod->can('_upgrade_gateway') + and $conf->exists("batchconfig-$format") ) { + + local $@; + my ($module, %gw_options) = $mod->_upgrade_gateway; + my $gateway = FS::payment_gateway->new({ + gateway_namespace => 'Business::BatchPayment', + gateway_module => $module, + }); + my $error = $gateway->insert(%gw_options); + if ( $error ) { + warn "Failed to migrate '$format' to a Business::BatchPayment::$module gateway:\n$error\n"; + next; + } + + # test whether it loads + my $processor = eval { $gateway->batch_processor }; + if ( !$processor ) { + warn "Couldn't load Business::BatchPayment module for '$format'.\n"; + # if not, remove it so it doesn't hang around and break things + $gateway->delete; + } + else { + # remove the batchconfig-* + warn "Created Business::BatchPayment gateway '".$gateway->label. + "' for '$format' batch processing.\n"; + $conf->delete("batchconfig-$format"); + + # and if appropriate, make it the system default + for my $payby (qw(CARD CHEK)) { + if ( ($conf->config("batch-fixed_format-$payby") || '') eq $format ) { + warn "Setting as default for $payby.\n"; + $conf->set("batch-gateway-$payby", $gateway->gatewaynum); + $conf->delete("batch-fixed_format-$payby"); + } + } + } # if $processor + } #if can('_upgrade_gateway') and batchconfig-$format + } #for $format + + ''; +} + =back =head1 BUGS diff --git a/FS/FS/pay_batch/BoM.pm b/FS/FS/pay_batch/BoM.pm index 7bfc22a64..719b504e5 100644 --- a/FS/FS/pay_batch/BoM.pm +++ b/FS/FS/pay_batch/BoM.pm @@ -31,13 +31,13 @@ $name = 'BoM'; }, header => sub { my $pay_batch = shift; - sprintf( "A%10s%04u%06u%05u%54s\n", + sprintf( "A%10s%04u%06u%05u%54s\n", #80 $origid, $pay_batch->batchnum, jdate($pay_batch->download), $datacenter, "") . - sprintf( "XD%03u%06u%-15s%-30s%09u%-12s \n", + sprintf( "XD%03u%06u%-15s%-30s%09u%-12s \n", #80 $typecode, jdate($pay_batch->download), $shortname, @@ -48,7 +48,7 @@ $name = 'BoM'; row => sub { my ($cust_pay_batch, $pay_batch) = @_; my ($account, $aba) = split('@', $cust_pay_batch->payinfo); - sprintf( "D%010.0f%09u%-12s%-29s%-19s\n", + sprintf( "D%010.0f%09u%-12s%-29s%-19s\n", #80 $cust_pay_batch->amount * 100, $aba, $account, @@ -58,8 +58,8 @@ $name = 'BoM'; }, footer => sub { my ($pay_batch, $batchcount, $batchtotal) = @_; - sprintf( "YD%08u%014.0f%56s\n", $batchcount, $batchtotal*100, ""). - sprintf( "Z%014u%04u%014u%05u%41s\n", + sprintf( "YD%08u%014.0f%56s\n", $batchcount, $batchtotal*100, ""). #80 + sprintf( "Z%014u%04u%014u%05u%42s\n", #80 now $batchtotal*100, $batchcount, "0", "0", ""); }, ); diff --git a/FS/FS/pay_batch/eft_canada.pm b/FS/FS/pay_batch/eft_canada.pm index 23dcc2dc9..ea9d58402 100644 --- a/FS/FS/pay_batch/eft_canada.pm +++ b/FS/FS/pay_batch/eft_canada.pm @@ -17,7 +17,51 @@ $name = 'eft_canada'; my ($trans_code, $process_date); +#ref http://gocanada.about.com/od/canadatravelplanner/a/canada_holidays.htm +my %holiday_yearly = ( + 1 => { map {$_=>1} 1 }, #new year's + 11 => { map {$_=>1} 11 }, #remembrance day + 12 => { map {$_=>1} 25 }, #christmas + 12 => { map {$_=>1} 26 }, #boxing day +); +my %holiday = ( + 2012 => { + 7 => { map {$_=>1} 2 }, #canada day + 8 => { map {$_=>1} 6 }, #First Monday of August Civic Holiday + 9 => { map {$_=>1} 3 }, #labour day + 10 => { map {$_=>1} 8 }, #thanksgiving + }, + 2013 => { 2 => { map {$_=>1} 18 }, #family day + 3 => { map {$_=>1} 29 }, #good friday + 4 => { map {$_=>1} 1 }, #easter monday + 5 => { map {$_=>1} 20 }, #victoria day + 7 => { map {$_=>1} 1 }, #canada day + 8 => { map {$_=>1} 5 }, #First Monday of August Civic Holiday + 9 => { map {$_=>1} 2 }, #labour day + 10 => { map {$_=>1} 14 }, #thanksgiving + }, + 2014 => { 2 => { map {$_=>1} 17 }, #family day + 4 => { map {$_=>1} 18 }, #good friday + 4 => { map {$_=>1} 21 }, #easter monday + 5 => { map {$_=>1} 19 }, #victoria day + 7 => { map {$_=>1} 1 }, #canada day + 8 => { map {$_=>1} 4 }, #First Monday of August Civic Holiday + 9 => { map {$_=>1} 1 }, #labour day + 10 => { map {$_=>1} 13 }, #thanksgiving + }, + 2015 => { 2 => { map {$_=>1} 16 }, #family day + 4 => { map {$_=>1} 3 }, #good friday + 4 => { map {$_=>1} 6 }, #easter monday + 5 => { map {$_=>1} 18 }, #victoria day + 7 => { map {$_=>1} 1 }, #canada day + 8 => { map {$_=>1} 3 }, #First Monday of August Civic Holiday + 9 => { map {$_=>1} 7 }, #labour day + 10 => { map {$_=>1} 12 }, #thanksgiving + }, +); + %export_info = ( + init => sub { my $conf = shift; my @config = $conf->config('batchconfig-eft_canada'); @@ -25,9 +69,24 @@ my ($trans_code, $process_date); my $process_delay; ($trans_code, $process_delay) = @config[2,3]; $process_delay ||= 1; # days - $process_date = time2str('%D', time + ($process_delay * 86400)); + + my $pt = time + ($process_delay * 86400); + my @lt = localtime($pt); + while ( $lt[6] == 0 #Sunday + || $lt[6] == 6 #Saturday + || $holiday_yearly{ $lt[4]+1 }{ $lt[3] } + || $holiday{ $lt[5]+1900 }{ $lt[4]+1 }{ $lt[3] } + ) + { + $pt += 86400; + @lt = localtime($pt); + } + + $process_date = time2str('%D', $pt); }, + delimiter => '', # avoid blank lines for header/footer + # EFT Upload Specification for .CSV Files, Rev. 2.0 # not a true CSV format--strings aren't quoted, so be careful row => sub { diff --git a/FS/FS/pay_batch/paymentech.pm b/FS/FS/pay_batch/paymentech.pm index f22a80f89..2ac5a6624 100644 --- a/FS/FS/pay_batch/paymentech.pm +++ b/FS/FS/pay_batch/paymentech.pm @@ -140,5 +140,18 @@ my %paytype = ( row => sub {}, ); +# Including this means that there is a Business::BatchPayment module for +# this gateway and we want to upgrade it. +# Must return the name of the module, followed by a hash of options. + +sub _upgrade_gateway { + my $conf = FS::Conf->new; + my @batchconfig = $conf->config('batchconfig-paymentech'); + my %options; + @options{ qw(bin terminalID merchantID login password ) } = @batchconfig; + $options{'industryType'} = 'EC'; + ( 'Paymentech', %options ); +} + 1; diff --git a/FS/FS/pay_batch/td_eft1464.pm b/FS/FS/pay_batch/td_eft1464.pm index 3a6befef5..93612f1ea 100644 --- a/FS/FS/pay_batch/td_eft1464.pm +++ b/FS/FS/pay_batch/td_eft1464.pm @@ -154,5 +154,14 @@ $name = 'td_eft1464'; }, ); +sub _upgrade_gateway { + my $conf = FS::Conf->new; + my @batchconfig = $conf->config('batchconfig-td_eft1464'); + my %options; + @options{ qw(originator datacentre short_name long_name return_branch + return_account cpa_code) } = @batchconfig; + ( 'TD_EFT', %options ); +} + 1; diff --git a/FS/FS/payment_gateway.pm b/FS/FS/payment_gateway.pm index bc8b875c3..4a7585e24 100644 --- a/FS/FS/payment_gateway.pm +++ b/FS/FS/payment_gateway.pm @@ -39,7 +39,7 @@ currently supported: =item gatewaynum - primary key -=item gateway_namespace - Business::OnlinePayment or Business::OnlineThirdPartyPayment +=item gateway_namespace - Business::OnlinePayment, Business::OnlineThirdPartyPayment, or Business::BatchPayment =item gateway_module - Business::OnlinePayment:: module name @@ -51,6 +51,13 @@ currently supported: =item disabled - Disabled flag, empty or 'Y' +=item auto_resolve_status - For BatchPayment only, set to 'approve' to +auto-approve unresolved payments after some number of days, 'reject' to +auto-decline them, or null to do nothing. + +=item auto_resolve_days - For BatchPayment, the number of days to wait before +auto-resolving the batch. + =back =head1 METHODS @@ -116,16 +123,21 @@ sub check { || $self->ut_alpha('gateway_module') || $self->ut_enum('gateway_namespace', ['Business::OnlinePayment', 'Business::OnlineThirdPartyPayment', + 'Business::BatchPayment', ] ) || $self->ut_textn('gateway_username') || $self->ut_anything('gateway_password') || $self->ut_textn('gateway_callback_url') # a bit too permissive || $self->ut_enum('disabled', [ '', 'Y' ] ) + || $self->ut_enum('auto_resolve_status', [ '', 'approve', 'reject' ]) + || $self->ut_numbern('auto_resolve_days') #|| $self->ut_textn('gateway_action') ; return $error if $error; - if ( $self->gateway_action ) { + if ( $self->gateway_namespace eq 'Business::BatchPayment' ) { + $self->gateway_action('Payment'); + } elsif ( $self->gateway_action ) { my @actions = split(/,\s*/, $self->gateway_action); $self->gateway_action( join( ',', map { /^(Normal Authorization|Authorization Only|Credit|Post Authorization)$/ @@ -198,6 +210,19 @@ sub disable { } +=item label + +Returns a semi-friendly label for the gateway. + +=cut + +sub label { + my $self = shift; + $self->gatewaynum . ': ' . + ($self->gateway_username ? $self->gateway_username . '@' : '') . + $self->gateway_module +} + =item namespace_description returns a friendly name for the namespace @@ -208,12 +233,58 @@ my %namespace2description = ( '' => 'Direct', 'Business::OnlinePayment' => 'Direct', 'Business::OnlineThirdPartyPayment' => 'Hosted', + 'Business::BatchPayment' => 'Batch', ); sub namespace_description { $namespace2description{shift->gateway_namespace} || 'Unknown'; } +=item batch_processor OPTIONS + +For BatchPayment gateways only. Returns a +L<Business::BatchPayment::Processor> object to communicate with the +gateway. + +OPTIONS will be passed to the constructor, along with any gateway +options in the database for this L<FS::payment_gateway>. Useful things +to include there may include 'input' and 'output' (to direct transport +to files), 'debug', and 'test_mode'. + +If the global 'business-batchpayment-test_transaction' flag is set, +'test_mode' will be forced on, and gateways that don't support test +mode will be disabled. + +=cut + +sub batch_processor { + local $@; + my $self = shift; + my %opt = @_; + my $batch = $opt{batch}; + my $output = $opt{output}; + die 'gateway '.$self->gatewaynum.' is not a Business::BatchPayment gateway' + unless $self->gateway_namespace eq 'Business::BatchPayment'; + eval "use Business::BatchPayment;"; + die "couldn't load Business::BatchPayment: $@" if $@; + + my $conf = new FS::Conf; + my $test_mode = $conf->exists('business-batchpayment-test_transaction'); + $opt{'test_mode'} = 1 if $test_mode; + + my $module = $self->gateway_module; + my $processor = eval { + Business::BatchPayment->create($module, $self->options, %opt) + }; + die "failed to create Business::BatchPayment::$module object: $@" + if $@; + + die "$module does not support test mode" + if $test_mode and not $processor->does('Business::BatchPayment::TestMode'); + + return $processor; +} + # _upgrade_data # # Used by FS::Upgrade to migrate to a new database. diff --git a/FS/FS/prospect_main.pm b/FS/FS/prospect_main.pm index 5a4048f51..b5d51d333 100644 --- a/FS/FS/prospect_main.pm +++ b/FS/FS/prospect_main.pm @@ -1,10 +1,10 @@ package FS::prospect_main; use strict; -use base qw( FS::o2m_Common FS::Record ); +use base qw( FS::Quotable_Mixin FS::o2m_Common FS::Record ); use vars qw( $DEBUG ); use Scalar::Util qw( blessed ); -use FS::Record qw( dbh qsearch ); #qsearchs ); +use FS::Record qw( dbh qsearch qsearchs ); use FS::agent; use FS::cust_location; use FS::contact; @@ -213,6 +213,9 @@ sub check { =item name +Returns a name for this prospect, as a string (company name for commercial +prospects, contact name for residential prospects). + =cut sub name { @@ -244,7 +247,8 @@ Returns the locations (see L<FS::cust_location>) associated with this prospect. sub cust_location { my $self = shift; - qsearch( 'cust_location', { 'prospectnum' => $self->prospectnum } ); + qsearch( 'cust_location', { 'prospectnum' => $self->prospectnum, + 'custnum' => '' } ); } =item qual @@ -258,6 +262,16 @@ sub qual { qsearch( 'qual', { 'prospectnum' => $self->prospectnum } ); } +=item agent + +Returns the agent (see L<FS::agent>) for this customer. + +=cut + +sub agent { + my $self = shift; + qsearchs( 'agent', { 'agentnum' => $self->agentnum } ); +} =item search HASHREF diff --git a/FS/FS/quotation.pm b/FS/FS/quotation.pm new file mode 100644 index 000000000..bf2711b0a --- /dev/null +++ b/FS/FS/quotation.pm @@ -0,0 +1,318 @@ +package FS::quotation; +use base qw( FS::Template_Mixin FS::cust_main_Mixin FS::otaker_Mixin FS::Record ); + +use strict; +use FS::Record qw( qsearch qsearchs ); +use FS::CurrentUser; +use FS::cust_main; +use FS::prospect_main; +use FS::quotation_pkg; + +=head1 NAME + +FS::quotation - Object methods for quotation records + +=head1 SYNOPSIS + + use FS::quotation; + + $record = new FS::quotation \%hash; + $record = new FS::quotation { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::quotation object represents a quotation. FS::quotation inherits from +FS::Record. The following fields are currently supported: + +=over 4 + +=item quotationnum + +primary key + +=item prospectnum + +prospectnum + +=item custnum + +custnum + +=item _date + +_date + +=item disabled + +disabled + +=item usernum + +usernum + + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new quotation. To add the quotation 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 { 'quotation'; } +sub notice_name { 'Quotation'; } +sub template_conf { 'quotation_'; } + +=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. + +=item check + +Checks all fields to make sure this is a valid quotation. 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('quotationnum') + || $self->ut_foreign_keyn('prospectnum', 'prospect_main', 'prospectnum' ) + || $self->ut_foreign_keyn('custnum', 'cust_main', 'custnum' ) + || $self->ut_numbern('_date') + || $self->ut_enum('disabled', [ '', 'Y' ]) + || $self->ut_numbern('usernum') + ; + return $error if $error; + + $self->_date(time) unless $self->_date; + + $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum; + + $self->SUPER::check; +} + +=item prospect_main + +=cut + +sub prospect_main { + my $self = shift; + qsearchs('prospect_main', { 'prospectnum' => $self->prospectnum } ); +} + +=item cust_main + +=cut + +sub cust_main { + my $self = shift; + qsearchs('cust_main', { 'custnum' => $self->custnum } ); +} + +=item cust_bill_pkg + +=cut + +sub cust_bill_pkg { #actually quotation_pkg objects + my $self = shift; + qsearch('quotation_pkg', { quotationnum=>$self->quotationnum }); +} + +=item total_setup + +=cut + +sub total_setup { + my $self = shift; + $self->_total('setup'); +} + +=item total_recur [ FREQ ] + +=cut + +sub total_recur { + my $self = shift; +#=item total_recur [ FREQ ] + #my $freq = @_ ? shift : ''; + $self->_total('recur'); +} + +sub _total { + my( $self, $method ) = @_; + + my $total = 0; + $total += $_->$method() for $self->cust_bill_pkg; + sprintf('%.2f', $total); + +} + +=item enable_previous + +=cut + +sub enable_previous { 0 } + +=back + +=head1 CLASS METHODS + +=over 4 + + +=item search_sql_where HASHREF + +Class method which returns an SQL WHERE fragment to search for parameters +specified in HASHREF. Valid parameters are + +=over 4 + +=item _date + +List reference of start date, end date, as UNIX timestamps. + +=item invnum_min + +=item invnum_max + +=item agentnum + +=item charged + +List reference of charged limits (exclusive). + +=item owed + +List reference of charged limits (exclusive). + +=item open + +flag, return open invoices only + +=item net + +flag, return net invoices only + +=item days + +=item newest_percust + +=back + +Note: validates all passed-in data; i.e. safe to use with unchecked CGI params. + +=cut + +sub search_sql_where { + my($class, $param) = @_; + #if ( $DEBUG ) { + # warn "$me search_sql_where called with params: \n". + # join("\n", map { " $_: ". $param->{$_} } keys %$param ). "\n"; + #} + + my @search = (); + + #agentnum + if ( $param->{'agentnum'} =~ /^(\d+)$/ ) { + push @search, "( prospect_main.agentnum = $1 OR cust_main.agentnum = $1 )"; + } + +# #refnum +# if ( $param->{'refnum'} =~ /^(\d+)$/ ) { +# push @search, "cust_main.refnum = $1"; +# } + + #prospectnum + if ( $param->{'prospectnum'} =~ /^(\d+)$/ ) { + push @search, "quotation.prospectnum = $1"; + } + + #custnum + if ( $param->{'custnum'} =~ /^(\d+)$/ ) { + push @search, "cust_bill.custnum = $1"; + } + + #_date + if ( $param->{_date} ) { + my($beginning, $ending) = @{$param->{_date}}; + + push @search, "quotation._date >= $beginning", + "quotation._date < $ending"; + } + + #quotationnum + if ( $param->{'quotationnum_min'} =~ /^(\d+)$/ ) { + push @search, "quotation.quotationnum >= $1"; + } + if ( $param->{'quotationnum_max'} =~ /^(\d+)$/ ) { + push @search, "quotation.quotationnum <= $1"; + } + +# #charged +# if ( $param->{charged} ) { +# my @charged = ref($param->{charged}) +# ? @{ $param->{charged} } +# : ($param->{charged}); +# +# push @search, map { s/^charged/cust_bill.charged/; $_; } +# @charged; +# } + + my $owed_sql = FS::cust_bill->owed_sql; + + #days + push @search, "quotation._date < ". (time-86400*$param->{'days'}) + if $param->{'days'}; + + #agent virtualization + my $curuser = $FS::CurrentUser::CurrentUser; + #false laziness w/search/quotation.html + push @search,' ( '. $curuser->agentnums_sql( table=>'prospect_main' ). + ' OR '. $curuser->agentnums_sql( table=>'cust_main' ). + ' ) '; + + join(' AND ', @search ); + +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/quotation_pkg.pm b/FS/FS/quotation_pkg.pm new file mode 100644 index 000000000..3d40bb03a --- /dev/null +++ b/FS/FS/quotation_pkg.pm @@ -0,0 +1,166 @@ +package FS::quotation_pkg; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearchs ); #qsearch +use FS::part_pkg; +use FS::cust_location; + +=head1 NAME + +FS::quotation_pkg - Object methods for quotation_pkg records + +=head1 SYNOPSIS + + use FS::quotation_pkg; + + $record = new FS::quotation_pkg \%hash; + $record = new FS::quotation_pkg { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::quotation_pkg object represents a quotation package. +FS::quotation_pkg inherits from FS::Record. The following fields are currently +supported: + +=over 4 + +=item quotationpkgnum + +primary key + +=item pkgpart + +pkgpart + +=item locationnum + +locationnum + +=item start_date + +start_date + +=item contract_end + +contract_end + +=item quantity + +quantity + +=item waive_setup + +waive_setup + + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new quotation package. To add the quotation package 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 { 'quotation_pkg'; } + +=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. + +=item check + +Checks all fields to make sure this is a valid quotation package. 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('quotationpkgnum') + || $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' ) + || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum' ) + || $self->ut_numbern('start_date') + || $self->ut_numbern('contract_end') + || $self->ut_numbern('quantity') + || $self->ut_enum('waive_setup', [ '', 'Y'] ) + ; + return $error if $error; + + $self->SUPER::check; +} + +sub part_pkg { + my $self = shift; + qsearchs('part_pkg', { 'pkgpart' => $self->pkgpart } ); +} + +sub desc { + my $self = shift; + $self->part_pkg->pkg; +} + +sub setup { + my $self = shift; + return '0.00' if $self->waive_setup eq 'Y'; + my $part_pkg = $self->part_pkg; + #my $setup = $part_pkg->can('base_setup') ? $part_pkg->base_setup + # : $part_pkg->option('setup_fee'); + my $setup = $part_pkg->option('setup_fee'); + #XXX discounts + $setup *= $self->quantity if $self->quantity; + sprintf('%.2f', $setup); + +} + +sub recur { + my $self = shift; + my $part_pkg = $self->part_pkg; + my $recur = $part_pkg->can('base_recur') ? $part_pkg->base_recur + : $part_pkg->option('recur_fee'); + #XXX discounts + $recur *= $self->quantity if $self->quantity; + sprintf('%.2f', $recur); +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/quotation_pkg_discount.pm b/FS/FS/quotation_pkg_discount.pm new file mode 100644 index 000000000..34e13a610 --- /dev/null +++ b/FS/FS/quotation_pkg_discount.pm @@ -0,0 +1,128 @@ +package FS::quotation_pkg_discount; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearch qsearchs ); + +=head1 NAME + +FS::quotation_pkg_discount - Object methods for quotation_pkg_discount records + +=head1 SYNOPSIS + + use FS::quotation_pkg_discount; + + $record = new FS::quotation_pkg_discount \%hash; + $record = new FS::quotation_pkg_discount { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::quotation_pkg_discount object represents a quotation package discount. +FS::quotation_pkg_discount inherits from FS::Record. The following fields are +currently supported: + +=over 4 + +=item quotationpkgdiscountnum + +primary key + +=item quotationpkgnum + +quotationpkgnum + +=item discountnum + +discountnum + + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new quotation package discount. To add the quotation package +discount 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 { 'quotation_pkg_discount'; } + +=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 quotation package discount. +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('quotationpkgdiscountnum') + || $self->ut_foreign_key('quotationpkgnum', 'quotation_pkg', 'quotationpkgnum' ) + || $self->ut_foreign_key('discountnum', 'discount', 'discountnum' ) + ; + 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/radius_group.pm b/FS/FS/radius_group.pm index 37aa0f37b..f1a4efe7f 100644 --- a/FS/FS/radius_group.pm +++ b/FS/FS/radius_group.pm @@ -47,6 +47,8 @@ description priority - for export +=item speed_up, speed_down - connection speeds in bits per second. Some +exports may use this to generate appropriate RADIUS attributes. =back @@ -176,6 +178,8 @@ sub check { || $self->ut_text('groupname') || $self->ut_textn('description') || $self->ut_numbern('priority') + || $self->ut_numbern('speed_up') + || $self->ut_numbern('speed_down') ; return $error if $error; diff --git a/FS/FS/rate.pm b/FS/FS/rate.pm index 02d8250eb..a2511cf99 100644 --- a/FS/FS/rate.pm +++ b/FS/FS/rate.pm @@ -387,7 +387,7 @@ sub rate_detail { =item process -Experimental job-queue processor for web interface adds/edits +Job-queue processor for web interface adds/edits =cut diff --git a/FS/FS/reason.pm b/FS/FS/reason.pm index 377da4985..a9a7d745d 100644 --- a/FS/FS/reason.pm +++ b/FS/FS/reason.pm @@ -46,6 +46,15 @@ FS::Record. The following fields are currently supported: =item disabled - 'Y' or '' +=item unsuspend_pkgpart - for suspension reasons only, the pkgpart (see +L<FS::part_pkg>) of a package to be ordered when the package is unsuspended. +Typically this will be some kind of reactivation fee. Attaching it to +a suspension reason allows the reactivation fee to be charged for some +suspensions but not others. + +=item unsuspend_hold - 'Y' or ''. If unsuspend_pkgpart is set, this tells +whether to bill the unsuspend package immediately ('') or to wait until +the customer's next invoice ('Y'). =back @@ -97,16 +106,30 @@ sub check { my $error = $self->ut_numbern('reasonnum') + || $self->ut_number('reason_type') + || $self->ut_foreign_key('reason_type', 'reason_type', 'typenum') || $self->ut_text('reason') + || $self->ut_flag('disabled') ; return $error if $error; + if ( $self->reasontype->class eq 'S' ) { + $error = $self->ut_numbern('unsuspend_pkgpart') + || $self->ut_foreign_keyn('unsuspend_pkgpart', 'part_pkg', 'pkgpart') + || $self->ut_flag('unsuspend_hold') + ; + return $error if $error; + } else { + $self->set('unsuspend_pkgpart' => ''); + $self->set('unsuspend_hold' => ''); + } + $self->SUPER::check; } =item reasontype -Returns the reason_type (see <I>FS::reason_type</I>) associated with this reason. +Returns the reason_type (see L<FS::reason_type>) associated with this reason. =cut @@ -118,7 +141,7 @@ sub reasontype { =head1 BUGS -Here be termintes. Don't use on wooden computers. +Here by termintes. Don't use on wooden computers. =head1 SEE ALSO diff --git a/FS/FS/sales.pm b/FS/FS/sales.pm new file mode 100644 index 000000000..3cb61fde3 --- /dev/null +++ b/FS/FS/sales.pm @@ -0,0 +1,142 @@ +package FS::sales; + +use strict; +use vars qw( @ISA ); +use base qw( FS::Record ); +use Business::CreditCard 0.28; +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; +#use FS::Conf; + +@ISA = qw( FS::m2m_Common FS::Record ); + +=head1 NAME + +FS::sales - Object methods for sales records + +=head1 SYNOPSIS + + use FS::sales; + + $record = new FS::sales \%hash; + $record = new FS::sales { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::sales object represents an example. FS::sales inherits from +FS::Record. The following fields are currently supported: + +=over 4 + +=item salesnum + +primary key + +=item agentnum + +agentnum + +=item disabled + +disabled + + +=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 { 'sales'; } + +=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('salesnum') + || $self->ut_numbern('agentnum') + ; + return $error if $error; + + if ( $self->dbdef_table->column('disabled') ) { + $error = $self->ut_enum('disabled', [ '', 'Y' ] ); + 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/svc_Common.pm b/FS/FS/svc_Common.pm index ff00ce028..7aede54a6 100644 --- a/FS/FS/svc_Common.pm +++ b/FS/FS/svc_Common.pm @@ -5,6 +5,7 @@ use vars qw( @ISA $noexport_hack $DEBUG $me $overlimit_missing_cust_svc_nonfatal_kludge ); use Carp qw( cluck carp croak confess ); #specify cluck have to specify them all use Scalar::Util qw( blessed ); +use Lingua::EN::Inflect qw( PL_N ); use FS::Conf; use FS::Record qw( qsearch qsearchs fields dbh ); use FS::cust_main_Mixin; @@ -199,12 +200,13 @@ 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<child_objects> is set to an array reference of FS::tablename objects +(for example, FS::svc_export_machine or 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 @@ -243,6 +245,7 @@ sub insert { my $svcnum = $self->svcnum; my $cust_svc = $svcnum ? qsearchs('cust_svc',{'svcnum'=>$self->svcnum}) : ''; + my $inserted_cust_svc = 0; #unless ( $svcnum ) { if ( !$svcnum or !$cust_svc ) { $cust_svc = new FS::cust_svc ( { @@ -256,6 +259,7 @@ sub insert { $dbh->rollback if $oldAutoCommit; return $error; } + $inserted_cust_svc = 1; $svcnum = $self->svcnum($cust_svc->svcnum); } else { #$cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum}); @@ -274,6 +278,10 @@ sub insert { || $self->preinsert_hook || $self->SUPER::insert; if ( $error ) { + if ( $inserted_cust_svc ) { + my $derror = $cust_svc->delete; + die $derror if $derror; + } $dbh->rollback if $oldAutoCommit; return $error; } @@ -432,7 +440,16 @@ sub expire { Replaces OLD_RECORD with this one. If there is an error, returns the error, otherwise returns false. -Currently available options are: I<export_args> and I<depend_jobnum>. +Currently available options are: I<child_objects>, I<export_args> and +I<depend_jobnum>. + +If I<child_objects> is set to an array reference of FS::tablename objects +(for example, FS::svc_export_machine or FS::acct_snarf objects), they +will have their svcnum field set and will be inserted or replaced 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 @@ -455,6 +472,8 @@ sub replace { ? shift : { @_ }; + my $objects = $options->{'child_objects'} || []; + my @jobnums = (); local $FS::queue::jobnums = \@jobnums; warn "[$me] replace: set \$FS::queue::jobnums to $FS::queue::jobnums\n" @@ -504,6 +523,34 @@ sub replace { return $error; } + foreach my $object ( @$objects ) { + my($field, $obj); + if ( ref($object) eq 'ARRAY' ) { + ($obj, $field) = @$object; + } else { + $obj = $object; + $field = 'svcnum'; + } + $obj->$field($new->svcnum); + + my $oldobj = qsearchs( $obj->table, { + $field => $new->svcnum, + map { $_ => $obj->$_ } $obj->_svc_child_partfields, + }); + + if ( $oldobj ) { + my $pkey = $oldobj->primary_key; + $obj->$pkey($oldobj->$pkey); + $obj->replace($oldobj); + } else { + $error = $obj->insert; + } + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + #new-style exports! unless ( $noexport_hack ) { @@ -844,8 +891,7 @@ sub set_auto_inventory { 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 + return "Out of ". PL_N($inventory_class->classname); } next if $columnflag eq 'M' && $inventory_item->svcnum == $self->svcnum; @@ -853,31 +899,38 @@ sub set_auto_inventory { $self->setfield( $field, $inventory_item->item ); #if $columnflag eq 'A' && $self->$field() eq ''; - $inventory_item->svcnum( $self->svcnum ); - my $ierror = $inventory_item->replace(); - if ( $ierror ) { - $dbh->rollback if $oldAutoCommit; - return "Error provisioning inventory: $ierror"; - } - if ( $old && $old->$field() && $old->$field() ne $self->$field() ) { my $old_inv = qsearchs({ - 'table' => 'inventory_item', - 'hashref' => { 'classnum' => $classnum, - 'svcnum' => $old->svcnum, - 'item' => $old->$field(), - }, + 'table' => 'inventory_item', + 'hashref' => { 'classnum' => $classnum, + 'svcnum' => $old->svcnum, + }, + 'extra_sql' => ' AND '. + '( ( svc_field IS NOT NULL AND svc_field = '.$dbh->quote($field).' )'. + ' OR ( svc_field IS NULL AND item = '. dbh->quote($old->$field).' )'. + ')', }); if ( $old_inv ) { $old_inv->svcnum(''); + $old_inv->svc_field(''); my $oerror = $old_inv->replace; if ( $oerror ) { $dbh->rollback if $oldAutoCommit; return "Error unprovisioning inventory: $oerror"; } + } else { + warn "old inventory_item not found for $field ". $self->$field; } } + $inventory_item->svcnum( $self->svcnum ); + $inventory_item->svc_field( $field ); + my $ierror = $inventory_item->replace(); + if ( $ierror ) { + $dbh->rollback if $oldAutoCommit; + return "Error provisioning inventory: $ierror"; + } + } $dbh->commit or die $dbh->errstr if $oldAutoCommit; @@ -906,6 +959,7 @@ sub return_inventory { foreach my $inventory_item ( $self->inventory_item ) { $inventory_item->svcnum(''); + $inventory_item->svc_field(''); my $error = $inventory_item->replace(); if ( $error ) { $dbh->rollback if $oldAutoCommit; diff --git a/FS/FS/svc_Radius_Mixin.pm b/FS/FS/svc_Radius_Mixin.pm index 731c83262..ac97eab58 100644 --- a/FS/FS/svc_Radius_Mixin.pm +++ b/FS/FS/svc_Radius_Mixin.pm @@ -1,11 +1,14 @@ package FS::svc_Radius_Mixin; +use base qw( FS::m2m_Common FS::svc_Common ); use strict; -use base qw(FS::m2m_Common FS::svc_Common); -use FS::Record qw(qsearch); +use FS::Record qw( qsearch dbh ); use FS::radius_group; use FS::radius_usergroup; -use Carp qw(confess); +use Carp qw( confess ); + +# not really a mixin since it overrides insert/replace/delete and has svc_Common +# as a base class, should probably be renamed svc_Radius_Common =head1 NAME @@ -17,15 +20,34 @@ FS::svc_Radius_Mixin - partial base class for services with RADIUS groups =cut - sub insert { my $self = shift; - $self->SUPER::insert(@_) - || $self->process_m2m( - 'link_table' => 'radius_usergroup', - 'target_table' => 'radius_group', - 'params' => $self->usergroup, - ); + + 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->process_m2m( + 'link_table' => 'radius_usergroup', + 'target_table' => 'radius_group', + 'params' => $self->usergroup, + ); + + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; } sub replace { @@ -33,22 +55,63 @@ sub replace { my $old = shift; $old = $new->replace_old if !defined($old); + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + $old->usergroup; # make sure this is cached for exports - $new->process_m2m( - 'link_table' => 'radius_usergroup', - 'target_table' => 'radius_group', - 'params' => $new->usergroup, - ) || $new->SUPER::replace($old, @_); + + my $error = $new->process_m2m( + 'link_table' => 'radius_usergroup', + 'target_table' => 'radius_group', + 'params' => $new->usergroup, + ) + || $new->SUPER::replace($old, @_); + + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; } sub delete { my $self = shift; - $self->SUPER::delete(@_) - || $self->process_m2m( - 'link_table' => 'radius_usergroup', - 'target_table' => 'radius_group', - 'params' => [], - ); + + 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->process_m2m( + 'link_table' => 'radius_usergroup', + 'target_table' => 'radius_group', + 'params' => [], + ); + + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; } sub usergroup { diff --git a/FS/FS/svc_Tower_Mixin.pm b/FS/FS/svc_Tower_Mixin.pm index 0b5588466..6adbc6f5e 100644 --- a/FS/FS/svc_Tower_Mixin.pm +++ b/FS/FS/svc_Tower_Mixin.pm @@ -52,5 +52,4 @@ sub tower_sector_sql { @where; } - 1; diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index e67db43c6..7ce79ae01 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -2808,6 +2808,13 @@ Arrayref of additional WHERE clauses, will be ANDed together. sub search { my ($class, $params) = @_; + my @from = ( + ' LEFT JOIN cust_svc USING ( svcnum ) ', + ' LEFT JOIN part_svc USING ( svcpart ) ', + ' LEFT JOIN cust_pkg USING ( pkgnum ) ', + ' LEFT JOIN cust_main USING ( custnum ) ', + ); + my @where = (); # domain @@ -2852,9 +2859,17 @@ sub search { push @where, "svcpart = $1"; } + if ( $params->{'exportnum'} =~ /^(\d+)$/ ) { + push @from, ' LEFT JOIN export_svc USING ( svcpart )'; + push @where, "exportnum = $1"; + } + # sector and tower my @where_sector = $class->tower_sector_sql($params); - push @where, @where_sector if @where_sector; + if ( @where_sector ) { + push @where, @where_sector; + push @from, ' LEFT JOIN tower_sector USING ( sectornum )'; + } # here is the agent virtualization #if ($params->{CurrentUser}) { @@ -2875,16 +2890,9 @@ sub search { push @where, @{ $params->{'where'} } if $params->{'where'}; + my $addl_from = join(' ', @from); my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : ''; - my $addl_from = ' LEFT JOIN cust_svc USING ( svcnum ) '. - ' LEFT JOIN part_svc USING ( svcpart ) '. - ' LEFT JOIN cust_pkg USING ( pkgnum ) '. - ' LEFT JOIN cust_main USING ( custnum ) '; - - $addl_from .= ' LEFT JOIN tower_sector USING ( sectornum )' - if @where_sector; - my $count_query = "SELECT COUNT(*) FROM svc_acct $addl_from $extra_sql"; #if ( keys %svc_acct ) { # $count_query .= ' WHERE '. diff --git a/FS/FS/svc_broadband.pm b/FS/FS/svc_broadband.pm index 64cc3770e..26659d52a 100755 --- a/FS/FS/svc_broadband.pm +++ b/FS/FS/svc_broadband.pm @@ -245,6 +245,12 @@ sub search { push @where, "svcpart = $1"; } + #exportnum + if ( $params->{'exportnum'} =~ /^(\d+)$/ ) { + push @from, 'LEFT JOIN export_svc USING ( svcpart )'; + push @where, "exportnum = $1"; + } + #ip_addr if ( $params->{'ip_addr'} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/ ) { push @where, "ip_addr = '$1'"; @@ -543,9 +549,9 @@ sub _check_ip_addr { sub _check_duplicate { my $self = shift; - - $self->lock_table; - + # Not a reliable check because the table isn't locked, but + # that's why we have a unique index. This is just to give a + # friendlier error message. my @dup; @dup = $self->find_duplicates('global', 'ip_addr'); if ( @dup ) { diff --git a/FS/FS/svc_export_machine.pm b/FS/FS/svc_export_machine.pm new file mode 100644 index 000000000..10f7b6821 --- /dev/null +++ b/FS/FS/svc_export_machine.pm @@ -0,0 +1,124 @@ +package FS::svc_export_machine; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearchs ); #qsearch ); +use FS::cust_svc; +use FS::part_export; +use FS::part_export_machine; + +sub _svc_child_partfields { ('exportnum') }; + +=head1 NAME + +FS::svc_export_machine - Object methods for svc_export_machine records + +=head1 SYNOPSIS + + use FS::svc_export_machine; + + $record = new FS::svc_export_machine \%hash; + $record = new FS::svc_export_machine { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::svc_export_machine object represents a customer service export +hostname. FS::svc_export_machine inherits from FS::Record. The following +fields are currently supported: + +=over 4 + +=item svcexportmachinenum + +primary key + +=item svcnum + +Customer service, see L<FS::cust_svc> + +=item machinenum + +Export hostname, see L<FS::part_export_machine> + +=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 { 'svc_export_machine'; } + +=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. + +=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('svcexportmachinenum') + || $self->ut_foreign_key('svcnum', 'cust_svc', 'svcnum' ) + || $self->ut_foreign_key('exportnum', 'part_export', 'exportnum' ) + || $self->ut_foreign_key('machinenum', 'part_export_machine', 'machinenum') + ; + return $error if $error; + + $self->SUPER::check; +} + +=item part_export_machine + +=cut + +sub part_export_machine { + my $self = shift; + qsearchs('part_export_machine', { 'machinenum' => $self->machinenum } ); +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::cust_svc>, L<FS::part_export_machine>, L<FS::Record> + +=cut + +1; + diff --git a/FS/FS/svc_pbx.pm b/FS/FS/svc_pbx.pm index f8b96050d..4182a1315 100644 --- a/FS/FS/svc_pbx.pm +++ b/FS/FS/svc_pbx.pm @@ -3,6 +3,7 @@ package FS::svc_pbx; use strict; use base qw( FS::svc_External_Common ); use FS::Record qw( qsearch qsearchs dbh ); +use FS::PagedSearch qw( psearch ); use FS::Conf; use FS::cust_svc; use FS::svc_phone; @@ -259,11 +260,13 @@ sub _check_duplicate { return ''; } -=item get_cdrs +=item psearch_cdrs OPTIONS -Returns a set of Call Detail Records (see L<FS::cdr>) associated with this -service. By default, "associated with" means that the "charged_party" field of -the CDR matches the "title" field of the service. +Returns a paged search (L<FS::PagedSearch>) for Call Detail Records +associated with this service. By default, "associated with" means that +the "charged_party" field of the CDR matches the "title" field of the +service. To access the CDRs themselves, call "->fetch" on the resulting +object. =over 2 @@ -295,7 +298,7 @@ to allow title to indicate a range of IP addresses. =cut -sub get_cdrs { +sub psearch_cdrs { my($self, %options) = @_; my %hash = (); my @where = (); @@ -343,15 +346,26 @@ sub get_cdrs { my $extra_sql = ( keys(%hash) ? ' AND ' : ' WHERE ' ). join(' AND ', @where ) if @where; - my @cdrs = - qsearch( { + psearch( { 'table' => 'cdr', 'hashref' => \%hash, 'extra_sql' => $extra_sql, 'order_by' => "ORDER BY startdate $for_update", - } ); + } ); +} + +=item get_cdrs (DEPRECATED) + +Like psearch_cdrs, but returns all the L<FS::cdr> objects at once, in a +single list. Arguments are the same as for psearch_cdrs. This can take +an unreasonably large amount of memory and is best avoided. - @cdrs; +=cut + +sub get_cdrs { + my $self = shift; + my $psearch = $self->psearch_cdrs($_); + qsearch ( $psearch->{query} ) } =back diff --git a/FS/FS/svc_phone.pm b/FS/FS/svc_phone.pm index 118748ea2..1296c1e85 100644 --- a/FS/FS/svc_phone.pm +++ b/FS/FS/svc_phone.pm @@ -7,6 +7,7 @@ use Data::Dumper; use Scalar::Util qw( blessed ); use FS::Conf; use FS::Record qw( qsearch qsearchs dbh ); +use FS::PagedSearch qw( psearch ); use FS::Msgcat qw(gettext); use FS::part_svc; use FS::phone_device; @@ -218,13 +219,14 @@ Class method which returns an SQL fragment to search for the given string. sub search_sql { my( $class, $string ) = @_; + my $conf = new FS::Conf; + if ( $conf->exists('svc_phone-allow_alpha_phonenum') ) { $string =~ s/\W//g; } else { $string =~ s/\D//g; } - my $conf = new FS::Conf; my $ccode = ( $conf->exists('default_phone_countrycode') && $conf->config('default_phone_countrycode') ) @@ -647,11 +649,13 @@ sub cust_location_or_main { $cust_pkg ? $cust_pkg->cust_location_or_main : ''; } -=item get_cdrs +=item psearch_cdrs OPTIONS -Returns a set of Call Detail Records (see L<FS::cdr>) associated with this -service. By default, "associated with" means that either the "src" or the -"charged_party" field of the CDR matches the "phonenum" field of the service. +Returns a paged search (L<FS::PagedSearch>) for Call Detail Records +associated with this service. By default, "associated with" means that +either the "src" or the "charged_party" field of the CDR matches the +"phonenum" field of the service. To access the CDRs themselves, call +"->fetch" on the resulting object. =over 2 @@ -675,11 +679,16 @@ with the chosen prefix. =item by_svcnum: not supported for svc_phone +=item billsec_sum: Instead of returning all of the CDRs, return a single +record (as an L<FS::cdr> object) with the sum of the 'billsec' field over +the entire result set. + =back =cut -sub get_cdrs { +sub psearch_cdrs { + my($self, %options) = @_; my @fields; my %hash; @@ -738,18 +747,30 @@ sub get_cdrs { my $extra_sql = ( keys(%hash) ? ' AND ' : ' WHERE ' ). join(' AND ', @where ); - my @cdrs = - qsearch( { + psearch( { 'table' => 'cdr', 'hashref' => \%hash, 'extra_sql' => $extra_sql, 'order_by' => $options{'billsec_sum'} ? '' : "ORDER BY startdate $for_update", 'select' => $options{'billsec_sum'} ? 'sum(billsec) as billsec_sum' : '*', - } ); + } ); +} - @cdrs; +=item get_cdrs (DEPRECATED) + +Like psearch_cdrs, but returns all the L<FS::cdr> objects at once, in a +single list. Arguments are the same as for psearch_cdrs. This can take +an unreasonably large amount of memory and is best avoided. + +=cut + +sub get_cdrs { + my $self = shift; + my $psearch = $self->psearch_cdrs(@_); + qsearch ( $psearch->{query} ) } + =back =head1 BUGS diff --git a/FS/FS/tax_class.pm b/FS/FS/tax_class.pm index 4f0396982..bfec2c06c 100644 --- a/FS/FS/tax_class.pm +++ b/FS/FS/tax_class.pm @@ -339,7 +339,7 @@ sub batch_import { } if ( scalar( @columns ) ) { $dbh->rollback if $oldAutoCommit; - return "Unexpected trailing columns in line (wrong format?): $line"; + return "Unexpected trailing columns in line (wrong format?) importing tax_class: $line"; } my $error = &{$hook}(\%tax_class); diff --git a/FS/FS/tax_rate.pm b/FS/FS/tax_rate.pm index 48c01967d..a5a623d94 100644 --- a/FS/FS/tax_rate.pm +++ b/FS/FS/tax_rate.pm @@ -10,6 +10,7 @@ use DateTime::Format::Strptime; use Storable qw( thaw nfreeze ); use IO::File; use File::Temp; +use Text::CSV_XS; use LWP::UserAgent; use HTTP::Request; use HTTP::Response; @@ -637,6 +638,7 @@ sub batch_import { $count *=2; if ( $format eq 'cch' || $format eq 'cch-update' ) { + #false laziness w/below (sub _perform_cch_diff) @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax excessrate effective_date taxauth taxtype taxcat taxname usetax useexcessrate fee unittype feemax maxtype passflag @@ -715,9 +717,6 @@ sub batch_import { die "unknown format $format"; } - eval "use Text::CSV_XS;"; - die $@ if $@; - my $csv = new Text::CSV_XS; my $imported = 0; @@ -758,9 +757,10 @@ sub batch_import { foreach my $field ( @fields ) { $tax_rate{$field} = shift @columns; } + if ( scalar( @columns ) ) { $dbh->rollback if $oldAutoCommit; - return "Unexpected trailing columns in line (wrong format?): $line"; + return "Unexpected trailing columns in line (wrong format?) importing tax_rate: $line"; } my $error = &{$hook}(\%tax_rate); @@ -993,7 +993,7 @@ sub _perform_batch_import { } push @insert_list, - 'DETAIL', "$dir/".$files{detail}, \&FS::tax_rate::batch_import, $format + 'DETAIL', "$dir/".$files{detailfile}, \&FS::tax_rate::batch_import, $format if $format =~ /update/; $error ||= _perform_cch_tax_import( $job, @@ -1115,8 +1115,26 @@ sub _perform_cch_diff { } close $newcsvfh; - for (keys %oldlines) { - print $dfh $_, ',"D"', "\n" if $oldlines{$_}; + #false laziness w/above (sub batch_import) + my @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax + excessrate effective_date taxauth taxtype taxcat taxname + usetax useexcessrate fee unittype feemax maxtype passflag + passtype basetype ); + my $numfields = scalar(@fields); + + my $csv = new Text::CSV_XS { 'always_quote' => 1 }; + + for my $line (grep $oldlines{$_}, keys %oldlines) { + + $csv->parse($line) or do { + #$dbh->rollback if $oldAutoCommit; + die "can't parse: ". $csv->error_input(); + }; + my @columns = $csv->fields(); + + $csv->combine( splice(@columns, 0, $numfields) ); + + print $dfh $csv->string, ',"D"', "\n"; } close $dfh; @@ -1170,9 +1188,6 @@ sub _cch_fetch_and_unzip { sub _cch_extract_csv_from_dbf { my ( $job, $dir, $name ) = @_; - eval "use Text::CSV_XS;"; - die $@ if $@; - eval "use XBase;"; die $@ if $@; @@ -1635,16 +1650,16 @@ sub process_download_and_update { if (-d $dir) { - if (-d "$dir.4") { - opendir(my $dirh, "$dir.4") or die "failed to open $dir.4: $!\n"; + if (-d "$dir.9") { + opendir(my $dirh, "$dir.9") or die "failed to open $dir.9: $!\n"; foreach my $file (readdir($dirh)) { - unlink "$dir.4/$file" if (-f "$dir.4/$file"); + unlink "$dir.9/$file" if (-f "$dir.9/$file"); } closedir($dirh); - rmdir "$dir.4"; + rmdir "$dir.9"; } - for (3, 2, 1) { + for (8, 7, 6, 5, 4, 3, 2, 1) { if ( -e "$dir.$_" ) { rename "$dir.$_", "$dir.". ($_+1) or die "can't rename $dir.$_: $!\n"; } diff --git a/FS/FS/tax_rate_location.pm b/FS/FS/tax_rate_location.pm index 1a6c47dcf..b4be8b90e 100644 --- a/FS/FS/tax_rate_location.pm +++ b/FS/FS/tax_rate_location.pm @@ -301,7 +301,7 @@ sub batch_import { } if ( scalar( @columns ) ) { $dbh->rollback if $oldAutoCommit; - return "Unexpected trailing columns in line (wrong format?): $line"; + return "Unexpected trailing columns in line (wrong format?) importing tax-rate_location: $line"; } my $error = &{$hook}(\%tax_rate_location); diff --git a/FS/MANIFEST b/FS/MANIFEST index 9cff85651..069b001d1 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -37,7 +37,6 @@ FS/ClientAPI/Bulk.pm FS/ClientAPI/MasonComponent.pm FS/ClientAPI/MyAccount.pm FS/ClientAPI/PrepaidPhone.pm -FS/ClientAPI/SGNG.pm FS/ClientAPI/Signup.pm FS/Conf.pm FS/ConfItem.pm @@ -95,6 +94,7 @@ FS/h_cust_pkg_reason.pm FS/h_cust_svc.pm FS/h_cust_tax_exempt.pm FS/h_domain_record.pm +FS/h_part_pkg.pm FS/h_svc_acct.pm FS/h_svc_broadband.pm FS/h_svc_domain.pm @@ -636,3 +636,42 @@ FS/GeocodeCache.pm t/GeocodeCache.t FS/upgrade_journal.pm t/upgrade_journal.t +FS/sales.pm +t/sales.t +FS/access_groupsales.pm +t/access_groupsales.t +FS/part_svc_class.pm +t/part_svc_class.t +FS/ftp_target.pm +t/ftp_target.t +FS/quotation.pm +t/quotation.t +FS/quotation_pkg.pm +t/quotation_pkg.t +FS/quotation_pkg_discount.pm +t/quotation_pkg_discount.t +FS/Quotable_Mixin.pm +t/Quotable_Mixin.t +FS/cust_bill_void.pm +t/cust_bill_void.t +FS/cust_bill_pkg_void.pm +t/cust_bill_pkg_void.t +FS/cust_bill_pkg_detail_void.pm +t/cust_bill_pkg_detail_void.t +FS/cust_bill_pkg_display_void.pm +t/cust_bill_pkg_display_void.t +FS/cust_bill_pkg_tax_location_void.pm +t/cust_bill_pkg_tax_location_void.t +FS/cust_bill_pkg_tax_rate_location_void.pm +t/cust_bill_pkg_tax_rate_location_void.t +FS/cust_tax_exempt_pkg_void.pm +t/cust_tax_exempt_pkg_void.t +FS/cust_bill_pkg_discount_void.pm +t/cust_bill_pkg_discount_void.t +FS/Trace.pm +FS/agent_pkg_class.pm +t/agent_pkg_class.t +FS/part_export_machine.pm +t/part_export_machine.t +FS/svc_export_machine.pm +t/svc_export_machine.t diff --git a/FS/bin/freeside-cdrd b/FS/bin/freeside-cdrd index 2cf75f31c..b21bd5b07 100644 --- a/FS/bin/freeside-cdrd +++ b/FS/bin/freeside-cdrd @@ -108,7 +108,7 @@ while (1) { } myexit() if sigterm() || sigint(); - sleep 1 unless $found; + sleep 5 unless $found; } diff --git a/FS/bin/freeside-check b/FS/bin/freeside-check index 9930aae6c..fdfc66af0 100644 --- a/FS/bin/freeside-check +++ b/FS/bin/freeside-check @@ -5,7 +5,6 @@ use strict; use FS::UID qw( adminsuidsetup ); use FS::Cron::check qw( check_queued check_selfservice check_apache check_bop_failures - check_sg check_sg_login check_sgng alert error_msg ); @@ -21,11 +20,5 @@ check_queued or alert('Queue daemon not running', @emails); check_selfservice or alert(error_msg(), @emails); check_apache or alert('Apache not running: '. error_msg(), @emails); -#no-ops unless you are sg -my $sg = 'FS::ClientAPI::SG'; -check_sg or alert("$sg not responding: ". error_msg(), @emails); -check_sg_login or alert("$sg login errort: ". error_msg(), @emails); -check_sgng or alert("${sg}NG not responding: ". error_msg(), @emails); - check_bop_failures or alert(error_msg(), @emails); diff --git a/FS/bin/freeside-daily b/FS/bin/freeside-daily index b73d0b112..8e8ae4ff9 100755 --- a/FS/bin/freeside-daily +++ b/FS/bin/freeside-daily @@ -7,7 +7,7 @@ use FS::Conf; &untaint_argv; #what it sounds like (eww) use vars qw(%opt); -getopts("p:a:d:vl:sy:nmrkg:uo", \%opt); +getopts("p:a:d:vl:sy:nmrkg:o", \%opt); my $user = shift or die &usage; adminsuidsetup $user; @@ -51,25 +51,29 @@ unless ( $opt{k} ) { notify_flat_delay(%opt); } -#debian Pg 8.1+ auto-vaccums, 7.4 w/postgresql-contrib -if ( $opt{u} ) { - use FS::Cron::vacuum qw(vacuum); - vacuum(); -} - -#you can skip this just by not having the config -use FS::Cron::backup qw(backup); -backup(); - #same use FS::Cron::rt_tasks qw(rt_daily); rt_daily(%opt); +#does nothing unless batch-gateway-* configs are set +use FS::Cron::pay_batch qw(batch_submit batch_receive); +batch_submit(%opt); +batch_receive(%opt); + +#you can skip this by not having the config +use FS::Cron::agent_email qw(agent_email); +agent_email(%opt); + my $deldir = "$FS::UID::cache_dir/cache.$FS::UID::datasrc/"; unlink <${deldir}.invoice*>; unlink <${deldir}.letter*>; unlink <${deldir}.CGItemp*>; +#backup should be last +#you can skip this just by not having the config +use FS::Cron::backup qw(backup); +backup(); + ### # subroutines ### @@ -140,8 +144,6 @@ the bill and collect methods of a cust_main object. See L<FS::cust_main>. -k: skip notify_flat_delay - -u: Do a vacuum (starting with version 1.9, this is not run by default). - user: From the mapsecrets file - see config.html from the base documentation custnum: if one or more customer numbers are specified, only bills those diff --git a/FS/bin/freeside-eftca-upload b/FS/bin/freeside-eftca-upload index 45a358b23..b66765af3 100755 --- a/FS/bin/freeside-eftca-upload +++ b/FS/bin/freeside-eftca-upload @@ -46,7 +46,7 @@ foreach my $pay_batch (@batches) { my $batchnum = $pay_batch->batchnum; my $filename = time2str('%Y%m%d', time) . '-' . sprintf('%06d.csv',$batchnum); print STDERR "Exporting batch $batchnum to $filename...\n" if $opt_v; - my $text = $pay_batch->export_batch('eft_canada'); + my $text = $pay_batch->export_batch(format => 'eft_canada'); open OUT, ">$tmpdir/$filename"; print OUT $text; close OUT; diff --git a/FS/bin/freeside-paymentech-upload b/FS/bin/freeside-paymentech-upload index 3f8abc047..609019eb2 100755 --- a/FS/bin/freeside-paymentech-upload +++ b/FS/bin/freeside-paymentech-upload @@ -59,7 +59,7 @@ foreach my $pay_batch (@batches) { my $batchnum = $pay_batch->batchnum; my $filename = sprintf('%06d',$batchnum) . '-' .time2str('%Y%m%d%H%M%S', time); print STDERR "Exporting batch $batchnum to $filename...\n" if $opt_v; - my $text = $pay_batch->export_batch('paymentech'); + my $text = $pay_batch->export_batch(format => 'paymentech'); $text =~ s!<fileID>FILEID</fileID>!<fileID>$filename</fileID>! or die "couldn't find FILEID tag\n"; open OUT, ">$tmpdir/$filename.xml"; diff --git a/FS/bin/freeside-prepaidd b/FS/bin/freeside-prepaidd index 05b068b02..c095ceee4 100644 --- a/FS/bin/freeside-prepaidd +++ b/FS/bin/freeside-prepaidd @@ -85,7 +85,7 @@ while (1) { } die "exiting" if sigterm() || sigint(); - sleep 5; + sleep 60; } diff --git a/FS/t/Quotable_Mixin.t b/FS/t/Quotable_Mixin.t new file mode 100644 index 000000000..cb0a56150 --- /dev/null +++ b/FS/t/Quotable_Mixin.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::Quotable_Mixin; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/access_groupsales.t b/FS/t/access_groupsales.t new file mode 100644 index 000000000..50993cf26 --- /dev/null +++ b/FS/t/access_groupsales.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::access_groupsales; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/agent_pkg_class.t b/FS/t/agent_pkg_class.t new file mode 100644 index 000000000..dc0fa12b2 --- /dev/null +++ b/FS/t/agent_pkg_class.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::agent_pkg_class; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_bill_pkg_detail_void.t b/FS/t/cust_bill_pkg_detail_void.t new file mode 100644 index 000000000..bd58c4eab --- /dev/null +++ b/FS/t/cust_bill_pkg_detail_void.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_bill_pkg_detail_void; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_bill_pkg_discount_void.t b/FS/t/cust_bill_pkg_discount_void.t new file mode 100644 index 000000000..e591eb03d --- /dev/null +++ b/FS/t/cust_bill_pkg_discount_void.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_bill_pkg_discount_void; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_bill_pkg_display_void.t b/FS/t/cust_bill_pkg_display_void.t new file mode 100644 index 000000000..87403e12e --- /dev/null +++ b/FS/t/cust_bill_pkg_display_void.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_bill_pkg_display_void; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_bill_pkg_tax_location_void.t b/FS/t/cust_bill_pkg_tax_location_void.t new file mode 100644 index 000000000..dbfea5131 --- /dev/null +++ b/FS/t/cust_bill_pkg_tax_location_void.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_bill_pkg_tax_location_void; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_bill_pkg_tax_rate_location_void.t b/FS/t/cust_bill_pkg_tax_rate_location_void.t new file mode 100644 index 000000000..8ebda6528 --- /dev/null +++ b/FS/t/cust_bill_pkg_tax_rate_location_void.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_bill_pkg_tax_rate_location_void; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_bill_pkg_void.t b/FS/t/cust_bill_pkg_void.t new file mode 100644 index 000000000..9256b469f --- /dev/null +++ b/FS/t/cust_bill_pkg_void.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_bill_pkg_void; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_bill_void.t b/FS/t/cust_bill_void.t new file mode 100644 index 000000000..95ff4a45c --- /dev/null +++ b/FS/t/cust_bill_void.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_bill_void; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/ftp_target.t b/FS/t/ftp_target.t new file mode 100644 index 000000000..1a5928118 --- /dev/null +++ b/FS/t/ftp_target.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::ftp_target; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export_machine.t b/FS/t/part_export_machine.t new file mode 100644 index 000000000..792bb5092 --- /dev/null +++ b/FS/t/part_export_machine.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export_machine; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_svc_class.t b/FS/t/part_svc_class.t new file mode 100644 index 000000000..e838c0b30 --- /dev/null +++ b/FS/t/part_svc_class.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_svc_class; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/quotation.t b/FS/t/quotation.t new file mode 100644 index 000000000..effcac67e --- /dev/null +++ b/FS/t/quotation.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::quotation; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/quotation_pkg.t b/FS/t/quotation_pkg.t new file mode 100644 index 000000000..5164c7e1c --- /dev/null +++ b/FS/t/quotation_pkg.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::quotation_pkg; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/quotation_pkg_discount.t b/FS/t/quotation_pkg_discount.t new file mode 100644 index 000000000..a1c5f53a3 --- /dev/null +++ b/FS/t/quotation_pkg_discount.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::quotation_pkg_discount; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/sales.t b/FS/t/sales.t new file mode 100644 index 000000000..e47eb398b --- /dev/null +++ b/FS/t/sales.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::sales; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/svc_export_machine.t b/FS/t/svc_export_machine.t new file mode 100644 index 000000000..5279be2ca --- /dev/null +++ b/FS/t/svc_export_machine.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::svc_export_machine; +$loaded=1; +print "ok 1\n"; |