diff options
Diffstat (limited to 'FS')
122 files changed, 9374 insertions, 4068 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,6 +266,8 @@ 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_type> - Agent type class @@ -546,11 +552,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 1bfae03ad..4de29481d 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,6 +112,8 @@ 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', @@ -138,6 +141,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 @@ -188,6 +192,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', @@ -253,9 +258,12 @@ tie my %rights, 'Tie::IxHash', ### 'Reporting/listing rights' => [ 'List customers', + 'List all customers', + 'Advanced customer search', 'List zip codes', #NEW 'List invoices', 'List packages', + 'Summarize packages', 'List services', 'List service passwords', @@ -266,6 +274,29 @@ tie my %rights, 'Tie::IxHash', { rightname=> 'List inventory', global=>1 }, { 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 }, ], @@ -306,6 +337,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 }, @@ -361,6 +394,7 @@ sub default_superuser_rights { 'Delete payment', 'Delete credit', #? 'Delete refund', #? + 'Edit customer package dates', 'Time queue', 'Redownload resolved batches', 'Raw SQL', diff --git a/FS/FS/ClientAPI/MasonComponent.pm b/FS/FS/ClientAPI/MasonComponent.pm index 37cf7ef20..534b48a76 100644 --- a/FS/FS/ClientAPI/MasonComponent.pm +++ b/FS/FS/ClientAPI/MasonComponent.pm @@ -36,7 +36,7 @@ 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 }, diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm index acd0c6e85..54799b817 100644 --- a/FS/FS/ClientAPI/MyAccount.pm +++ b/FS/FS/ClientAPI/MyAccount.pm @@ -46,18 +46,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 +114,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 ) @@ -151,12 +150,25 @@ sub login_info { %{ skin_info($p) }, 'phone_login' => $conf->exists('selfservice_server-phone_login'), 'single_domain'=> scalar($conf->config('selfservice_server-single_domain')), + 'banner_url' => scalar($conf->config('selfservice-login_banner_url')), + 'banner_image_md5' => + md5_hex($conf->config_binary('selfservice-login_banner_image')), ); return \%info; } +sub login_banner_image { + my $p = shift; + my $conf = new FS::Conf; + my $image = $conf->config_binary('selfservice-login_banner_image'); + return { + 'md5' => md5_hex($image), + 'image' => $image, + }; +} + #false laziness w/FS::ClientAPI::passwd::passwd sub login { my $p = shift; @@ -183,6 +195,8 @@ sub login { } else { +warn Dumper($p); + my $svc_domain = qsearchs('svc_domain', { 'domain' => $p->{'domain'} } ) or return { error => 'Domain '. $p->{'domain'}. ' not found' }; @@ -368,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; @@ -403,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; @@ -431,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"; @@ -472,8 +516,8 @@ sub customer_info { } - return { 'error' => '', - 'custnum' => $custnum, + return { 'error' => '', + 'custnum' => $custnum, %return, }; @@ -496,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; @@ -511,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; @@ -545,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'}) @@ -557,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})$/ @@ -697,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; @@ -716,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') ) { @@ -839,6 +1012,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, @@ -863,7 +1038,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 + ) }; } @@ -914,9 +1091,16 @@ sub do_process_payment { 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 @@ -1362,6 +1546,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 ], @@ -1454,12 +1639,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' ) { @@ -1757,6 +1944,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 1e068f428..7dd20c652 100644 --- a/FS/FS/ClientAPI_XMLRPC.pm +++ b/FS/FS/ClientAPI_XMLRPC.pm @@ -37,17 +37,21 @@ $DEBUG = 0; $FS::ClientAPI::DEBUG = $DEBUG; #false laziness w/FS::SelfService/XMLRPC.pm, same problem as below but worse +our %typefix_skin_info = ( + 'logo' => 'base64', + 'title_left_image' => 'base64', + 'title_right_image' => 'base64', + 'menu_top_image' => 'base64', + 'menu_body_image' => 'base64', + 'menu_bottom_image' => 'base64', +); our %typefix = ( 'invoice_pdf' => { 'invoice_pdf' => 'base64', }, 'legacy_invoice_pdf' => { 'invoice_pdf' => 'base64', }, - 'skin_info' => { 'logo' => 'base64', - 'title_left_image' => 'base64', - 'title_right_image' => 'base64', - 'menu_top_image' => 'base64', - 'menu_body_image' => 'base64', - 'menu_bottom_image' => 'base64', - }, + 'skin_info' => \%typefix_skin_info, + 'login_info' => \%typefix_skin_info, 'invoice_logo' => { 'logo' => 'base64', }, + 'login_banner_image' => { 'image' => 'base64', }, ); sub AUTOLOAD { @@ -94,11 +98,13 @@ sub ss2clientapi { 'chfn' => 'passwd/passwd', 'chsh' => 'passwd/passwd', 'login_info' => 'MyAccount/login_info', + 'login_banner_image' => 'MyAccount/login_banner_image', 'login' => 'MyAccount/login', 'logout' => 'MyAccount/logout', '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', @@ -171,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 ee7f2b4be..7e641308b 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; }, ); @@ -884,6 +970,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 +1197,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 +1253,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 +1318,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.', @@ -1420,6 +1537,7 @@ and customer address. Include units.', 'description' => 'Send payment receipts.', 'type' => 'checkbox', 'per_agent' => 1, + 'agent_bool' => 1, }, { @@ -1594,6 +1712,13 @@ and customer address. Include units.', }, { + 'key' => 'disable_maxselect', + 'section' => 'UI', + 'description' => 'Prevent changing the number of records per page.', + 'type' => 'checkbox', + }, + + { 'key' => 'session-start', 'section' => 'session', 'description' => 'If defined, the command which is executed on the Freeside machine when a session begins. The contents of the file are treated as a double-quoted perl string, with the following variables available: <code>$ip</code>, <code>$nasip</code> and <code>$nasfqdn</code>, which are the IP address of the starting session, and the IP address and fully-qualified domain name of the NAS this session is on.', @@ -1839,6 +1964,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.", @@ -2291,6 +2423,13 @@ and customer address. Include units.', }, { + 'key' => 'require_cash_deposit_info', + 'section' => 'billing', + 'description' => 'When recording cash payments, display bank deposit information fields.', + 'type' => 'checkbox', + }, + + { 'key' => 'paymentforcedtobatch', 'section' => 'deprecated', 'description' => 'See batch-enable_payby and realtime-disable_payby. Used to (for CHEK): Cause per customer payment entry to be forced to a batch processor rather than performed realtime.', @@ -2843,6 +2982,14 @@ and customer address. Include units.', }, { + 'key' => 'company_url', + 'section' => 'UI', + 'description' => 'Your company URL', + 'type' => 'text', + 'per_agent' => 1, + }, + + { 'key' => 'company_address', 'section' => 'required', 'description' => 'Your company address', @@ -2933,7 +3080,7 @@ and customer address. Include units.', 'section' => 'invoicing', 'description' => 'Enable FTP of raw invoice data - format.', 'type' => 'select', - 'select_enum' => [ '', 'default', 'billco', ], + 'options' => [ spool_formats() ], }, { @@ -2969,7 +3116,7 @@ and customer address. Include units.', 'section' => 'invoicing', 'description' => 'Enable spooling of raw invoice data - format.', 'type' => 'select', - 'select_enum' => [ '', 'default', 'billco', ], + 'options' => [ spool_formats() ], }, { @@ -2980,6 +3127,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.', @@ -3030,6 +3203,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.', @@ -3258,6 +3441,40 @@ 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' ], + }, + #lists could be auto-generated from pay_batch info { 'key' => 'batch-fixed_format-CARD', @@ -3424,7 +3641,14 @@ 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', }, @@ -3580,9 +3804,19 @@ and customer address. Include units.', 'section' => 'billing', 'description' => 'Display format for line item date ranges on invoice line items.', 'type' => 'select', - 'select_hash' => [ '' => 'STARTDATE-ENDDATE', - 'month_of' => 'Month of MONTHNAME', + 'select_hash' => [ '' => 'STARTDATE-ENDDATE', + 'month_of' => 'Month of MONTHNAME', + 'X_month' => 'DATE_DESC MONTHNAME', ], + 'per_agent' => 1, + }, + + { + 'key' => 'cust_bill-line_item-date_description', + 'section' => 'billing', + 'description' => 'Text to display for "DATE_DESC" when using cust_bill-line_item-date_style DATE_DESC MONTHNAME.', + 'type' => 'text', + 'per_agent' => 1, }, { @@ -3857,7 +4091,17 @@ and customer address. Include units.', 'section' => 'UI', 'description' => 'Prefix the customer number with this string for display purposes.', 'type' => 'text', - #and then probably agent-virt this to merge these instances + 'per_agent' => 1, + }, + + { + 'key' => 'cust_main-custnum-display_special', + 'section' => 'UI', + 'description' => 'Use this customer number prefix format', + 'type' => 'select', + 'select_hash' => [ '' => '', + 'CoStAg' => 'CoStAg (country, state, agent name or display_prefix)', + 'CoStCl' => 'CoStCl (country, state, class name)' ], }, { @@ -3910,6 +4154,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".', @@ -3959,6 +4210,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', @@ -4125,6 +4392,20 @@ and customer address. Include units.', }, { + 'key' => 'selfservice-login_banner_image', + 'section' => 'self-service', + 'description' => 'Banner image shown on the login page, in PNG format.', + 'type' => 'image', + }, + + { + 'key' => 'selfservice-login_banner_url', + 'section' => 'self-service', + 'description' => 'Link for the login banner.', + 'type' => 'text', + }, + + { 'key' => 'selfservice-bulk_format', 'section' => 'deprecated', 'description' => 'Parameter arrangement for selfservice bulk features', @@ -4305,34 +4586,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.", @@ -4437,6 +4690,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.', @@ -4484,14 +4744,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', }, @@ -4594,6 +4854,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.', @@ -4801,6 +5068,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', @@ -4846,7 +5120,34 @@ and customer address. Include units.', }, }, - + { + 'key' => 'brand-agent', + 'section' => 'UI', + 'description' => 'Brand the backoffice interface (currently Help->About) using the company_name, company_url and logo.png configuration settings of the selected agent. Typically used when selling or bundling hosted access to the backoffice interface. NOTE: The AGPL software license has specific requirements for source code availability in this situation.', + '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 => "apacheroot", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, { key => "apachemachine", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, { key => "apachemachines", 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/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..c7cedafb9 --- /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, 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 7143c721b..e26a4b747 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); @@ -122,6 +122,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 +304,14 @@ 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; # Sammath Naur if ( $FS::Mason::addl_handler_use ) { @@ -506,28 +514,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, @@ -574,11 +561,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..0d21df4ca 100644 --- a/FS/FS/Mason/Request.pm +++ b/FS/FS/Mason/Request.pm @@ -33,9 +33,28 @@ 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 ) = @_; + #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/) ) { package HTML::Mason::Commands; #? diff --git a/FS/FS/Misc.pm b/FS/FS/Misc.pm index 297e39fbc..2be9ec203 100644 --- a/FS/FS/Misc.pm +++ b/FS/FS/Misc.pm @@ -913,6 +913,16 @@ sub ocr_image { @lines; } +=item spool_formats + +Returns a list of the invoice spool formats. + +=cut + +sub spool_formats { + qw(default oneline billco bridgestone) +} + =back =head1 BUGS diff --git a/FS/FS/Misc/Geo.pm b/FS/FS/Misc/Geo.pm index d7375b065..5d6f33cb7 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; $DEBUG = 0; 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..0ac269f4c 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; @@ -2562,6 +2563,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 +3047,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 +3068,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/Table.pm b/FS/FS/Report/Table.pm index 3942543b5..73eed6e0c 100644 --- a/FS/FS/Report/Table.pm +++ b/FS/FS/Report/Table.pm @@ -32,21 +32,32 @@ options in %opt. =over 4 -=item signups: The number of customers signed up. +=item signups: The number of customers signed up. Options are "refnum" +(limit by advertising source) and "indirect" (boolean, tells us to limit +to customers that have a referral_custnum that matches the advertising source). =cut sub signups { my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_; - my @where = ( - $self->in_time_period_and_agent($speriod, $eperiod, $agentnum, 'signupdate') + my @where = ( $self->in_time_period_and_agent($speriod, $eperiod, $agentnum, + 'cust_main.signupdate') ); - if ( $opt{'refnum'} ) { + my $join = ''; + if ( $opt{'indirect'} ) { + $join = " JOIN cust_main AS referring_cust_main". + " ON (cust_main.referral_custnum = referring_cust_main.custnum)"; + + if ( $opt{'refnum'} ) { + push @where, "referring_cust_main.refnum = ".$opt{'refnum'}; + } + } + elsif ( $opt{'refnum'} ) { push @where, "refnum = ".$opt{'refnum'}; } $self->scalar_sql( - "SELECT COUNT(*) FROM cust_main WHERE ".join(' AND ', @where) + "SELECT COUNT(*) FROM cust_main $join WHERE ".join(' AND ', @where) ); } @@ -61,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) ); } @@ -74,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 @@ -94,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. @@ -110,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) ); } @@ -120,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) ); } @@ -139,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) ); } @@ -159,8 +171,8 @@ sub netcredits { $eperiod, $agentnum, 'cust_bill._date' - ) - . (%opt ? $self->for_custnum(%opt) : '') + ). + $self->for_opts(%opt) ); } @@ -169,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 @@ -179,7 +191,8 @@ sub receipts { #net payments $eperiod, $agentnum, 'cust_bill._date' - ) + ). + $self->for_opts(%opt) ); } @@ -188,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 @@ -198,7 +211,8 @@ sub netrefunds { $eperiod, $agentnum, 'cust_credit._date' - ) + ). + $self->for_opts(%opt) ); } @@ -405,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 @@ -425,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'} ) { @@ -478,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, @@ -608,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 41216992f..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 @@ -49,9 +50,8 @@ sub data { my $syear = $self->{'start_year'}; my $emonth = $self->{'end_month'}; my $eyear = $self->{'end_year'}; - # how far to extrapolate into the future - my $pmonth = $self->{'project_month'}; - my $pyear = $self->{'project_year'}; + # whether to extrapolate into the future + my $projecting = $self->{'projection'}; # sanity checks if ( $eyear < $syear or @@ -60,18 +60,16 @@ sub data { } my $agentnum = $self->{'agentnum'}; + my $refnum = $self->{'refnum'}; - if ( $pyear > $eyear or - ($pyear == $eyear and $pmonth > $emonth) ) { + if ( $projecting ) { - # create the entire projection set first to avoid timing problems + $self->init_projection; - $self->init_projection if $pmonth; - - my $thisyear = $eyear; - my $thismonth = $emonth; - while ( $thisyear < $pyear || - ( $thisyear == $pyear and $thismonth <= $pmonth ) + my $thismonth = $smonth; + my $thisyear = $syear; + while ( $thisyear < $eyear || + ( $thisyear == $eyear and $thismonth <= $emonth ) ) { my $speriod = timelocal(0,0,0,1,$thismonth-1,$thisyear); $thismonth++; @@ -84,10 +82,8 @@ sub data { my %data; - my $max_year = $pyear || $eyear; - my $max_month = $pmonth || $emonth; - - my $projecting = 0; # are we currently projecting? + my $max_year = $eyear; + my $max_month = $emonth; while ( $syear < $max_year || ( $syear == $max_year && $smonth < $max_month+1 ) ) { @@ -101,11 +97,6 @@ sub data { push @{$data{label}}, "$smonth/$syear"; } - if ( $syear > $eyear || ( $syear == $eyear && $smonth >= $emonth + 1 ) ) { - # start getting data from the projection - $projecting = 1; - } - my $speriod = timelocal(0,0,0,1,$smonth-1,$syear); push @{$data{speriod}}, $speriod; if ( ++$smonth == 13 ) { $syear++; $smonth=1; } @@ -121,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; } @@ -133,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 9b21dfc11..797b70549 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -473,6 +473,18 @@ sub tables_hashref { 'index' => [ ['typenum'], ['disabled'], ['agent_custnum'] ], }, + 'sales' => { + 'columns' => [ + 'salesnum', 'serial', '', '', '', '', + 'salesperson', 'varchar', '', $char_d, '', '', + 'agentnum', 'int', 'NULL', '', '', '', + 'disabled', 'char', 'NULL', 1, '', '', + ], + 'primary_key' => 'salesnum', + 'unique' => [], + 'index' => [ ['salesnum'], ['disabled'] ], + }, + 'agent_type' => { 'columns' => [ 'typenum', 'serial', '', '', '', '', @@ -845,16 +857,17 @@ sub tables_hashref { 'stateid', 'varchar', 'NULL', $char_d, '', '', 'stateid_state', 'varchar', 'NULL', $char_d, '', '', 'birthdate' ,@date_type, '', '', + 'spouse_birthdate' ,@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, '', '', @@ -883,7 +896,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', '', '', '', @@ -915,6 +928,9 @@ sub tables_hashref { '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' ] ], @@ -925,16 +941,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' ] ], }, @@ -1048,8 +1054,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', '', '', '', '', @@ -1067,6 +1115,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, '', '', @@ -1076,6 +1126,7 @@ sub tables_hashref { 'unique' => [], 'index' => [ [ 'prospectnum' ], [ 'custnum' ], [ 'county' ], [ 'state' ], [ 'country' ], [ 'zip' ], + [ 'city' ], [ 'district' ] ], }, @@ -1130,10 +1181,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' => [], @@ -1166,9 +1218,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', @@ -1343,12 +1396,17 @@ sub tables_hashref { # index into payby table # eventually 'payinfo', 'varchar', 'NULL', 512, '', '', #see cust_main above - 'paymask', 'varchar', 'NULL', $char_d, '', '', + 'paymask', 'varchar', 'NULL', $char_d, '', '', 'paydate', 'varchar', 'NULL', 10, '', '', 'paybatch', 'varchar', 'NULL', $char_d, '', '', #for auditing purposes. 'payunique', 'varchar', 'NULL', $char_d, '', '', #separate paybatch "unique" functions from current usage '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, '', '', ], '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' ] ], @@ -1494,6 +1552,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, '', '', @@ -1643,14 +1703,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' => { @@ -1827,6 +1888,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' => [], @@ -1835,18 +1897,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' => [ @@ -2550,7 +2623,7 @@ sub tables_hashref { 'plan_id', 'varchar', 'NULL', $char_d, '', '', ], 'primary_key' => 'svcnum', - 'unique' => [ [ 'mac_addr' ] ], + 'unique' => [ [ 'ip_addr' ], [ 'mac_addr' ] ], 'index' => [], }, @@ -2988,7 +3061,6 @@ sub tables_hashref { ### 'upstream_currency', 'char', 'NULL', 3, '', '', - 'upstream_price', 'decimal', 'NULL', '10,4', '', '', 'upstream_rateplanid', 'int', 'NULL', '', '', '', #? # how it was rated internally... @@ -3013,6 +3085,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, '', '', @@ -3148,11 +3224,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' ] ], @@ -3229,6 +3306,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', '', '', '', '', @@ -3621,6 +3709,36 @@ sub tables_hashref { 'index' => [], }, + 'upgrade_journal' => { + 'columns' => [ + 'upgradenum', 'serial', '', '', '', '', + '_date', 'int', '', '', '', '', + 'upgrade', 'varchar', '', $char_d, '', '', + 'status', 'varchar', '', $char_d, '', '', + 'statustext', 'varchar', 'NULL', $char_d, '', '', + ], + 'primary_key' => 'upgradenum', + 'unique' => [ [ 'upgradenum' ] ], + '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/Template_Mixin.pm b/FS/FS/Template_Mixin.pm new file mode 100644 index 000000000..d1bcec5d5 --- /dev/null +++ b/FS/FS/Template_Mixin.pm @@ -0,0 +1,2550 @@ +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 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') ) { + 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; + + 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); + } + } + + unless ( $conf->exists('disable_previous_balance', $agentnum) + || $conf->exists('previous_balance-summary_only') + || ! $self->can('_items_previous') + ) + { + + 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 && !$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') && $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 $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) + || ! $self->can('_items_credits') + || ! $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. + +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; + } + } + + 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 ( $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; + +} + +=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..e2dfce373 100644 --- a/FS/FS/TicketSystem/RT_Internal.pm +++ b/FS/FS/TicketSystem/RT_Internal.pm @@ -107,10 +107,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 +122,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 +148,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 +189,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 +243,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/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 8f66c66b5..417b2026c 100644 --- a/FS/FS/Upgrade.pm +++ b/FS/FS/Upgrade.pm @@ -4,9 +4,11 @@ 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); +use FS::upgrade_journal; use FS::svc_domain; $FS::svc_domain::whois_hack = 1; @@ -62,7 +64,12 @@ 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 ); + } sub upgrade_overlimit_groups { @@ -268,6 +275,9 @@ sub upgrade_data { #routernum/blocknum 'svc_broadband' => [], + + #set up payment gateways if needed + 'pay_batch' => [], ; \%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 ef8cc6cd8..e6266b49b 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); @@ -180,6 +182,91 @@ sub _upgrade_data { # class method } + my @all_groups = qsearch('access_group', {}); + + 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', + + '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 = 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, + 'rightname' => $new_acl, + } ); + my $error = $access_right->insert; + die $error if $error; + } + + FS::upgrade_journal->set_done($journal); + + } + + } + + ### ACL_download_report_data + if ( !FS::upgrade_journal->is_done('ACL_download_report_data') ) { + + # grant to everyone + for my $group (@all_groups) { + my $access_right = FS::access_right->new( { + 'righttype' => 'FS::access_group', + 'rightobjnum' => $group->groupnum, + 'rightname' => 'Download report data', + } ); + my $error = $access_right->insert; + die $error if $error; + } + + FS::upgrade_journal->set_done('ACL_download_report_data'); + } + ''; } diff --git a/FS/FS/cdr/cia.pm b/FS/FS/cdr/cia.pm index 61343338a..ca44c0fdf 100644 --- a/FS/FS/cdr/cia.pm +++ b/FS/FS/cdr/cia.pm @@ -20,16 +20,17 @@ 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, - skip(1), # Chair Conference Entry Code - 'accountcode', # Participant Conference Entry Code, + 'accountcode', # Chair Conference Entry Code + skip(1), # Participant Conference Entry Code, ], ); 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/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 3aa75eca5..83748be1b 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; @@ -46,18 +40,13 @@ use FS::cust_credit_bill_pkg; use FS::discount_plan; 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 +150,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 { @@ -388,8 +378,10 @@ 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 }, + } ) ; foreach ( @cust_bill ) { $total += $_->owed; } $total, @cust_bill; @@ -1314,14 +1306,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 +1323,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 +1743,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 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. +=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 +1785,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 +1816,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 +1838,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 +1847,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 +1953,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 { @@ -2005,6 +2038,62 @@ sub print_csv { '0', # 29 | Other Taxes & Fees*** NUM* 9 ); + } elsif ( lc($opt{'format'}) eq 'oneline' ) { #name? + + my ($previous_balance) = $self->previous; + my $totaldue = sprintf('%.2f', $self->owed + $previous_balance); + my @items = map { + ($_->{pkgnum} || ''), + $_->{description}, + $_->{amount} + } $self->_items_pkg; + + $csv->combine( + $cust_main->agentnum, + $cust_main->agent->agent, + $self->custnum, + $cust_main->first, + $cust_main->last, + $cust_main->address1, + $cust_main->address2, + $cust_main->city, + $cust_main->state, + $cust_main->zip, + + # invoice fields + time2str("%x", $self->_date), + $self->invnum, + $self->charged, + $totaldue, + + @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( @@ -2044,6 +2133,10 @@ sub print_csv { } + } elsif ( lc($opt{'format'}) eq 'oneline' ) { + + #do nothing + } else { foreach my $cust_bill_pkg ( $self->cust_bill_pkg ) { @@ -2222,143 +2315,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, @@ -2388,1365 +2344,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: @@ -3759,420 +2356,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; @@ -4678,23 +2861,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; @@ -4728,461 +2894,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 @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; - - 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'); - if ( defined($date_style) && $date_style eq 'month_of' ) { - $time_period = time2str('The month of %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; @@ -5231,51 +2942,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 @@ -5374,6 +3040,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". @@ -5561,7 +3228,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_pkg.pm b/FS/FS/cust_bill_pkg.pm index 1ee5c0943..4220d3c06 100644 --- a/FS/FS/cust_bill_pkg.pm +++ b/FS/FS/cust_bill_pkg.pm @@ -955,8 +955,6 @@ sub cust_bill_pkg_display { 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; @@ -1043,26 +1041,125 @@ sub cust_bill_pkg_discount { =cut -sub recur_show_zero { - #my $self = shift; - # $self->recur == 0 - #&& $self->pkgnum - #&& $self->cust_pkg->part_pkg->recur_show_zero; +sub recur_show_zero { shift->_X_show_zero('recur'); } +sub setup_show_zero { shift->_X_show_zero('setup'); } + +sub _X_show_zero { + my( $self, $what ) = @_; - shift->_X_show_zero('recur'); + return 0 unless $self->$what() == 0 && $self->pkgnum; + $self->cust_pkg->_X_show_zero($what); } -sub setup_show_zero { - shift->_X_show_zero('setup'); +=back + +=head1 CLASS METHODS + +=over 4 + +=item usage_sql + +Returns an SQL expression for the total usage charges in details on +an item. + +=cut + +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; } -sub _X_show_zero { - my( $self, $what ) = @_; - return 0 unless $self->$what() == 0 && $self->pkgnum; +=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 owed_sql { + my $class = shift; + '(' . $class->charged_sql(@_) . + ' - ' . $class->paid_sql(@_) . + ' - ' . $class->credited_sql(@_) . ')' +} + +=item paid_sql [ BEFORE, AFTER, OPTIONS ] + +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 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; + } - $self->cust_pkg->_X_show_zero($what); } =back 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_location.pm b/FS/FS/cust_location.pm index f863b1020..2810dc957 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' ]) @@ -191,22 +193,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 $self->latitude && $self->longitude; + 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' => '', } ) ) { @@ -263,19 +279,40 @@ location_kind. =cut -=item move_to HASHREF +=item disable_if_unused -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. +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 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'; @@ -289,16 +326,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', { @@ -316,15 +349,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 @@ -405,11 +437,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 7d1a15621..82b09b61f 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -6,15 +6,16 @@ use strict; use base qw( FS::cust_main::Packages FS::cust_main::Status 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 ); @@ -71,6 +72,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 +82,6 @@ $me = '[FS::cust_main]'; $import = 0; $ignore_expired_card = 0; -$ignore_illegal_zip = 0; $ignore_banned_card = 0; $skip_fuzzyfiles = 0; @@ -178,28 +179,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 +195,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 +293,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 +334,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 +397,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 +448,20 @@ 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; + $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 +529,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 ) { @@ -1312,7 +1301,7 @@ sub merge { } - my $name = $self->ship_name; + my $name = $self->ship_name; #? my $locationnum = ''; foreach my $cust_pkg ( $self->all_pkgs ) { @@ -1448,10 +1437,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 +1453,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,41 +1480,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; - } - - for my $pre ( grep $old->get($_.'coord_auto'), ( '', 'ship_' ) ) { - - $self->set($pre.'coord_auto', '') && next - if $self->get($pre.'latitude') && $self->get($pre.'longitude') - && ( $self->get($pre.'latitude') != $old->get($pre.'latitude') - || $self->get($pre.'longitude') != $old->get($pre.'longitude') - ); - - $self->set_coord($pre) - if $old->get($pre.'address1') ne $self->get($pre.'address1') - || $old->get($pre.'city') ne $self->get($pre.'city') - || $old->get($pre.'state') ne $self->get($pre.'state') - || $old->get($pre.'country') ne $self->get($pre.'country'); - - } - - unless ( $import ) { - $self->set_coord - if ! $self->coord_auto && ! $self->latitude && ! $self->longitude; + # 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; + #} - $self->set_coord('ship_') - if $self->has_ship_address && ! $self->ship_coord_auto - && ! $self->ship_latitude && ! $self->ship_longitude; - } + # set_coord/coord_auto stuff is now handled by cust_location local($ignore_expired_card) = 1 if $old->payby =~ /^(CARD|DCRD)$/ @@ -1533,11 +1504,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'; @@ -1550,6 +1520,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 ) { @@ -1557,6 +1568,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 ); @@ -1594,17 +1626,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 ) { @@ -1648,24 +1690,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! @@ -1710,16 +1735,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"; @@ -1750,6 +1773,8 @@ 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') @@ -1757,34 +1782,20 @@ sub check { || $self->ut_snumbern('birthdate') || $self->ut_snumbern('signupdate') || $self->ut_textn('company') - || $self->ut_text('address1') - || $self->ut_textn('address2') - || $self->ut_text('city') - || $self->ut_textn('county') - || $self->ut_textn('state') - || $self->ut_country('country') - || $self->ut_coordn('latitude') - || $self->ut_coordn('longitude') - || $self->ut_enum('coord_auto', [ '', 'Y' ]) - || $self->ut_numbern('censusyear') || $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_enum('edit_subject', [ '', 'Y' ] ) || $self->ut_enum('calling_list_exempt', [ '', 'Y' ] ) + || $self->ut_enum('invoice_noemail', [ '', 'Y' ] ) || $self->ut_enum('locale', [ '', FS::Locales->locales ]) ; - $self->set_coord - unless $import || ($self->latitude && $self->longitude); - #barf. need message catalogs. i18n. etc. $error .= "Please select an advertising source." if $error =~ /^Illegal or empty \(numeric\) refnum: /; @@ -1800,13 +1811,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 { @@ -1817,23 +1821,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) @@ -1843,12 +1831,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) ) { @@ -1867,71 +1851,7 @@ sub check { } - if ( $self->has_ship_address - && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") } - $self->addr_fields ) - ) - { - my $error = - $self->ut_name('ship_last') - || $self->ut_name('ship_first') - || $self->ut_textn('ship_company') - || $self->ut_text('ship_address1') - || $self->ut_textn('ship_address2') - || $self->ut_text('ship_city') - || $self->ut_textn('ship_county') - || $self->ut_textn('ship_state') - || $self->ut_country('ship_country') - || $self->ut_coordn('ship_latitude') - || $self->ut_coordn('ship_longitude') - || $self->ut_enum('ship_coord_auto', [ '', 'Y' ] ) - ; - return $error if $error; - - $self->set_coord('ship_') - unless $import || ($self->ship_latitude && $self->ship_longitude); - - #false laziness with above - unless ( qsearchs('cust_main_county', { - 'country' => $self->ship_country, - 'state' => '', - } ) ) { - return "Unknown ship_state/ship_county/ship_country: ". - $self->ship_state. "/". $self->ship_county. "/". $self->ship_country - unless qsearch('cust_main_county',{ - 'state' => $self->ship_state, - 'county' => $self->ship_county, - 'country' => $self->ship_country, - } ); - } - #eofalse - - $error = - $self->ut_phonen('ship_daytime', $self->ship_country) - || $self->ut_phonen('ship_night', $self->ship_country) - || $self->ut_phonen('ship_fax', $self->ship_country) - || $self->ut_phonen('ship_mobile', $self->ship_country) - ; - return $error if $error; - - unless ( $ignore_illegal_zip ) { - $error = $self->ut_zip('ship_zip', $self->ship_country); - return $error if $error; - } - return "Unit # is required." - if $self->ship_address2 =~ /^\s*$/ - && $conf->exists('cust_main-require_address2'); - - } else { # ship_ info eq billing info, so don't store dup info in database - - $self->setfield("ship_$_", '') - foreach $self->addr_fields; - - return "Unit # is required." - if $self->address2 =~ /^\s*$/ - && $conf->exists('cust_main-require_address2'); - - } + #ship_ fields are gone #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/ # or return "Illegal payby: ". $self->payby; @@ -1957,7 +1877,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; @@ -2139,6 +2061,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); @@ -2174,7 +2101,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 @@ -2185,6 +2112,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. @@ -2193,7 +2125,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 @@ -2590,6 +2523,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? @@ -2599,16 +2534,16 @@ 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, - 'payby' => $options{payby} || $self->payby, - 'payinfo' => $options{payinfo} || $self->payinfo, - 'exp' => $options{paydate} || $self->paydate, - 'payname' => $options{payname} || $self->payname, + '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} || $loc->payby, + 'payinfo' => $options{payinfo} || $loc->payinfo, + 'exp' => $options{paydate} || $loc->paydate, + 'payname' => $options{payname} || $loc->payname, 'amount' => $amount, # consolidating } ); @@ -3000,7 +2935,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; @@ -3962,12 +3898,32 @@ cust_main-default_agent_custid is set and it has a value, custnum otherwise. sub display_custnum { my $self = shift; + + my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || ''; + if ( my $special = $conf->config('cust_main-custnum-display_special') ) { + if ( $special eq 'CoStAg' ) { + $prefix = uc( join('', + $self->country, + ($self->state =~ /^(..)/), + $prefix || ($self->agent->agent =~ /^(..)/) + ) ); + } + elsif ( $special eq 'CoStCl' ) { + $prefix = uc( join('', + $self->country, + ($self->state =~ /^(..)/), + ($self->classnum ? $self->cust_class->classname =~ /^(..)/ : '__') + ) ); + } + # add any others here if needed + } + my $length = $conf->config('cust_main-custnum-display_length'); if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){ return $self->agent_custid; - } elsif ( $conf->config('cust_main-custnum-display_prefix') ) { + } elsif ( $prefix ) { $length = 8 if !defined($length); - return $conf->config('cust_main-custnum-display_prefix'). + return $prefix . sprintf('%0'.$length.'d', $self->custnum) } elsif ( $length ) { return sprintf('%0'.$length.'d', $self->custnum); @@ -3990,6 +3946,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 @@ -3999,13 +3976,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 @@ -4028,13 +4002,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 @@ -4056,9 +4026,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 @@ -4080,9 +4049,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 @@ -5057,39 +5025,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 665662aa8..bab94c31d 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" @@ -746,9 +751,15 @@ sub calculate_taxes { my %tax_rate_location = (); 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 my $hashref_or_error = $tax_object->taxline( $taxlisthash->{$tax}, 'custnum' => $self->custnum, @@ -767,8 +778,10 @@ sub calculate_taxes { $tax{ $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 +791,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 } }, @@ -877,7 +888,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,7 +963,6 @@ sub _make_lines { # bill recurring fee ### - #XXX unit stuff here too my $recur = 0; my $unitrecur = 0; my @recur_discounts = (); @@ -1014,6 +1024,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); @@ -1181,7 +1194,11 @@ 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; + + if ( $exempt !~ /Y/i && $self->payby ne 'COMP' ) { if ( $conf->exists('enable_taxproducts') && ( scalar($part_pkg->part_pkg_taxoverride) @@ -1205,21 +1222,12 @@ sub _handle_taxes { } else { 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 = (); + my @taxes = (); # entries are cust_main_county objects my %taxhash_elim = %taxhash; my @elim = qw( district city county state ); do { @@ -1242,11 +1250,13 @@ sub _handle_taxes { @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 ); - } + # all packages now have a locationnum and should get a + # cust_bill_pkg_tax_location record. The tax_locationnum + # may be the package's locationnum, or the customer's bill + # or service location. + foreach (@taxes) { + $_->set('pkgnum', $cust_pkg->pkgnum); + $_->set('locationnum', $cust_pkg->tax_locationnum); } $taxes{''} = [ @taxes ]; @@ -1273,17 +1283,27 @@ 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; + # $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; @@ -1524,17 +1544,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..6681f9ec2 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,22 @@ 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'; } else { die "unknown format $format"; } @@ -314,7 +331,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 +374,9 @@ sub batch_import { } } + $cust_main{$_} = parse_datetime($cust_main{$_}) + foreach grep $cust_main{$_}, qw( birthdate spouse_birthdate ); + my $invoicing_list = $cust_main{'invoicing_list'} ? [ delete $cust_main{'invoicing_list'} ] : []; @@ -387,11 +411,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 ) } ); } - if ( $svcdb || $svc_phone ) { + 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 || $svc_hardware ) { my $part_pkg = $cust_pkg->part_pkg; unless ( $part_pkg ) { $dbh->rollback if $oldAutoCommit; @@ -406,6 +438,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/Packages.pm b/FS/FS/cust_main/Packages.pm index 316dedea1..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; } @@ -442,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 62464e4aa..b528a689c 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 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 @@ -127,6 +125,12 @@ sub smart_search { || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+' && $search =~ /^\s*(\w\w?\d+)\s*$/ ) + || ( $conf->config('cust_main-custnum-display_special') + # it's not currently possible for special prefixes to contain + # digits, so just strip off any alphabetic prefix and match + # the rest to custnum + && $search =~ /^\s*[[:alpha:]]*(\d+)\s*$/ + ) || ( $conf->exists('address1-search' ) && $search =~ /^\s*(\d+\-?\w*)\s*$/ #i.e. 1234A or 9432-D ) @@ -136,45 +140,52 @@ 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", } ); } - #if this becomes agent-virt need to get a list of all prefixes the current - #user can see (via their agents) - my $prefix = $conf->config('cust_main-custnum-display_prefix'); - if ( $prefix && $prefix eq substr($num, 0, length($prefix)) ) { - push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => { 'custnum' => 0 + substr($num, length($prefix)), - %options, + # for all agents this user can see, if any of them have custnum prefixes + # that match the search string, include customers that match the rest + # of the custnum and belong to that agent + foreach my $agentnum ( $FS::CurrentUser::CurrentUser->agentnums ) { + my $p = $conf->config('cust_main-custnum-display_prefix', $agentnum); + next if !$p; + if ( $p eq substr($num, 0, length($p)) ) { + push @cust_main, qsearch( { + 'table' => 'cust_main', + 'hashref' => { 'custnum' => 0 + substr($num, length($p)), + 'agentnum' => $agentnum, + %options, }, - 'extra_sql' => " AND $agentnums_sql", #agent virtualization - } ); + } ); + } } push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => { 'agent_custid' => $num, %options }, - 'extra_sql' => " AND $agentnums_sql", #agent virtualization + '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*$/ ) { @@ -186,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} @@ -237,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) @@ -258,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 .= " )"; @@ -284,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%" }, }, ; } @@ -325,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 ); } } @@ -457,6 +467,14 @@ 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 payby listref @@ -548,18 +566,28 @@ 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) + )"; } ### # 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; + } ## @@ -589,7 +617,7 @@ sub search { # dates ## - foreach my $field (qw( signupdate )) { + foreach my $field (qw( signupdate birthdate spouse_birthdate )) { next unless exists($params->{$field}); @@ -600,7 +628,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"; } @@ -760,22 +788,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; @@ -821,20 +860,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(); @@ -848,8 +894,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..6316f239a 100644 --- a/FS/FS/cust_main_county.pm +++ b/FS/FS/cust_main_county.pm @@ -176,7 +176,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 )) { 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 d98d11ecb..2a2b9d025 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 @@ -113,6 +114,22 @@ books closed flag, empty or `Y' Desired pkgnum when using experimental package balances. +=item bank + +The bank where the payment was deposited. + +=item depositor + +The name of the depositor. + +=item account + +The deposit account number. + +=item teller + +The teller number. + =back =head1 METHODS @@ -493,8 +510,11 @@ sub check { || $self->ut_textn('payunique') || $self->ut_enum('closed', [ '', 'Y' ]) || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum') + || $self->ut_textn('bank') + || $self->ut_alphan('depositor') + || $self->ut_numbern('account') + || $self->ut_numbern('teller') || $self->payinfo_check() - || $self->ut_numbern('discount_term') ; return $error if $error; @@ -509,6 +529,12 @@ sub check { return "invalid discount_term" if ($self->discount_term && $self->discount_term < 2); + if ( $self->payby eq 'CASH' and $conf->exists('require_cash_deposit_info') ) { + foreach (qw(bank depositor account teller)) { + return "$_ required" if $self->get($_) eq ''; + } + } + #i guess not now, with cust_pay_pending, if we actually make it here, we _do_ want to record it # # UNIQUE index should catch this too, without race conditions, but this # # should give a better error message the other 99.9% of the time... @@ -557,7 +583,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; @@ -735,6 +761,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); @@ -761,19 +793,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; @@ -828,93 +876,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'); } ### diff --git a/FS/FS/cust_pay_batch.pm b/FS/FS/cust_pay_batch.pm index f5e6a4bf1..5f21ff4b1 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'); @@ -364,6 +395,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_pay_void.pm b/FS/FS/cust_pay_void.pm index f1193cd24..bebcfd4cc 100644 --- a/FS/FS/cust_pay_void.pm +++ b/FS/FS/cust_pay_void.pm @@ -68,9 +68,7 @@ order taker (see L<FS::access_user>) =item payby -`CARD' (credit cards), `CHEK' (electronic check/ACH), -`LECB' (phone bill billing), `BILL' (billing), `CASH' (cash), -`WEST' (Western Union), `MCRD' (Manual credit card), or `COMP' (free) +Payment Type (See L<FS::payinfo_Mixin> for valid values) =item payinfo @@ -186,6 +184,7 @@ sub check { || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum') || $self->ut_numbern('void_date') || $self->ut_textn('reason') + || $self->payinfo_check ; return $error if $error; @@ -197,31 +196,6 @@ sub check { $self->void_date(time) unless $self->void_date; - $self->payby =~ /^(CARD|CHEK|LECB|BILL|COMP|PREP|CASH|WEST|MCRD)$/ - or return "Illegal payby"; - $self->payby($1); - - #false laziness with cust_refund::check - if ( $self->payby eq 'CARD' ) { - my $payinfo = $self->payinfo; - $payinfo =~ s/\D//g; - $self->payinfo($payinfo); - if ( $self->payinfo ) { - $self->payinfo =~ /^(\d{13,16}|\d{8,9})$/ - or return "Illegal (mistyped?) credit card number (payinfo)"; - $self->payinfo($1); - validate($self->payinfo) or return "Illegal credit card number"; - return "Unknown card type" if $self->payinfo !~ /^99\d{14}$/ #token - && cardtype($self->payinfo) eq "Unknown"; - } else { - $self->payinfo('N/A'); - } - - } else { - $error = $self->ut_textn('payinfo'); - return $error if $error; - } - $self->void_usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->void_usernum; diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 4b458deaf..627a7fc3e 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; @@ -879,6 +879,154 @@ 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 && $options{svc_fatal} ) { + $dbh->rollback if $oldAutoCommit; + return $svc_error; + } else { + 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; + } + } + } + push @svc_errors, $svc_error if $svc_error; + } + + #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). @@ -1244,6 +1392,8 @@ sub unsuspend { } #if $date + my @labels = (); + foreach my $cust_svc ( qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } ) ) { @@ -1263,6 +1413,8 @@ sub unsuspend { $dbh->rollback if $oldAutoCommit; return $error; } + my( $label, $value ) = $cust_svc->label; + push @labels, "$label: $value"; } } @@ -1293,6 +1445,29 @@ sub unsuspend { 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 ), + ], + ); + + if ( $error ) { + warn "WARNING: can't send unsuspension admin email (unsuspending anyway): ". + "$error\n"; + } + + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no errors @@ -1900,7 +2075,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; @@ -2034,11 +2209,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) { @@ -2080,6 +2258,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 = $_; @@ -2087,7 +2267,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 @@ -2446,6 +2626,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 @@ -3305,7 +3518,7 @@ sub search { "NOT (".FS::cust_pkg->onetime_sql . ")"; } else { - foreach my $field (qw( setup last_bill bill adjourn susp expire contract_end cancel )) { + foreach my $field (qw( setup last_bill bill adjourn susp expire contract_end change_date cancel )) { next unless exists($params->{$field}); @@ -3432,6 +3645,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 @@ -3450,7 +3682,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; @@ -3509,16 +3747,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_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_svc.pm b/FS/FS/cust_svc.pm index fc6e60594..2ec8f12c2 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; @@ -319,6 +344,18 @@ sub check { $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/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/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_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..ffb4f52fb 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) } ], 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/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/Condition.pm b/FS/FS/part_event/Condition.pm index 32751974c..fc69f1d0c 100644 --- a/FS/FS/part_event/Condition.pm +++ b/FS/FS/part_event/Condition.pm @@ -360,10 +360,10 @@ sub condition_sql_option_option { } -#used for part_event/Condition/cust_bill_has_service.pm +#used for part_event/Condition/cust_bill_has_service.pm and has_cust_tag.pm #a little false laziness w/above and condition_sql_option_integer sub condition_sql_option_option_integer { - my( $class, $option, $driver_name ) = @_; + my( $class, $option ) = @_; ( my $condname = $class ) =~ s/^.*:://; @@ -375,7 +375,7 @@ sub condition_sql_option_option_integer { AND part_event_condition_option.optionvalue = 'HASH' )"; - my $integer = ($driver_name =~ /^mysql/) ? 'UNSIGNED INTEGER' : 'INTEGER'; + my $integer = (driver_name =~ /^mysql/) ? 'UNSIGNED INTEGER' : 'INTEGER'; my $optionname = "CAST(optionname AS $integer)"; 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/cust_bill_has_service.pm b/FS/FS/part_event/Condition/cust_bill_has_service.pm index 65c996437..6e981ee03 100644 --- a/FS/FS/part_event/Condition/cust_bill_has_service.pm +++ b/FS/FS/part_event/Condition/cust_bill_has_service.pm @@ -42,9 +42,7 @@ sub condition_sql { my( $class, $table, %opt ) = @_; my $servicenums = - $class->condition_sql_option_option_integer( 'has_service', - $opt{'driver_name'}, - ); + $class->condition_sql_option_option_integer('has_service'); my $sql = qq| 0 < ( SELECT COUNT(cs.svcpart) FROM cust_bill_pkg cbp, cust_svc cs diff --git a/FS/FS/part_event/Condition/has_cust_tag.pm b/FS/FS/part_event/Condition/has_cust_tag.pm new file mode 100644 index 000000000..cde933881 --- /dev/null +++ b/FS/FS/part_event/Condition/has_cust_tag.pm @@ -0,0 +1,49 @@ +package FS::part_event::Condition::has_cust_tag; + +use strict; + +use base qw( FS::part_event::Condition ); +use FS::Record qw( qsearch ); + +sub description { + 'Customer has tag', +} + +sub eventtable_hashref { + { 'cust_main' => 1, + 'cust_bill' => 1, + 'cust_pkg' => 1, + }; +} + +#something like this +sub option_fields { + ( + 'tagnum' => { 'label' => 'Customer tag', + 'type' => 'select-cust_tag', + 'multiple' => 1, + }, + ); +} + +sub condition { + my( $self, $object ) = @_; + + my $cust_main = $self->cust_main($object); + + my $hashref = $self->option('tagnum') || {}; + grep $hashref->{ $_->tagnum }, $cust_main->cust_tag; +} + +sub condition_sql { + my( $self, $table ) = @_; + + my $matching_tags = + "SELECT tagnum FROM cust_tag WHERE cust_tag.custnum = $table.custnum". + " AND cust_tag.tagnum IN ". + $self->condition_sql_option_option_integer('tagnum'); + + "EXISTS($matching_tags)"; +} + +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/acct_xmlrpc.pm b/FS/FS/part_export/acct_xmlrpc.pm new file mode 100644 index 000000000..d746f29bc --- /dev/null +++ b/FS/FS/part_export/acct_xmlrpc.pm @@ -0,0 +1,268 @@ +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, + 'notes' => <<'END', +Configurable, real-time export of accounts via the XML-RPC protocol.<BR> +<BR> +If using "Individual values" parameter style, specfify 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/broadband_sqlradius.pm b/FS/FS/part_export/broadband_sqlradius.pm index 29bd28899..5806362b5 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' }, @@ -106,8 +108,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/netsapiens.pm b/FS/FS/part_export/netsapiens.pm index 775e374ca..6e2ee8ae3 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', @@ -61,8 +82,26 @@ 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 +169,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 +233,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 +262,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 +303,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/sqlradius.pm b/FS/FS/part_export/sqlradius.pm index 910346bea..c360c9ef0 100644 --- a/FS/FS/part_export/sqlradius.pm +++ b/FS/FS/part_export/sqlradius.pm @@ -111,6 +111,7 @@ END 'options' => \%options, 'nodomain' => 'Y', '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 +251,7 @@ sub _export_replace { ''; } +#false laziness w/broadband_sqlradius.pm sub _export_suspend { my( $self, $svc_acct ) = (shift, shift); @@ -297,7 +299,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 +312,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; @@ -358,14 +360,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 +378,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 +760,7 @@ sub usage_sessions { } -=item update_svc_acct +=item update_svc =cut @@ -1154,8 +1158,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'). 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/prorate.pm b/FS/FS/part_pkg/prorate.pm index f930d417d..f8d03dcb5 100644 --- a/FS/FS/part_pkg/prorate.pm +++ b/FS/FS/part_pkg/prorate.pm @@ -49,7 +49,7 @@ sub calc_recur { sub cutoff_day { my $self = shift; - $self->option('cutoff_day', 1) || 1; + 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..9d7341b76 100644 --- a/FS/FS/part_pkg/recur_Common.pm +++ b/FS/FS/part_pkg/recur_Common.pm @@ -45,7 +45,7 @@ sub cutoff_day { if ( $recur_method eq 'prorate' or $recur_method eq 'subscription' ) { return $self->option('cutoff_day',1) || 1; } else { - return 0; + return (); } } @@ -58,26 +58,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_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..dd18e87f9 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; 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..4f223e113 100644 --- a/FS/FS/pay_batch.pm +++ b/FS/FS/pay_batch.pm @@ -10,6 +10,8 @@ use FS::cust_pay; use FS::agent; use Date::Parse qw(str2time); use Business::CreditCard qw(cardtype); +use Scalar::Util 'blessed'; +use IO::Scalar; @ISA = qw(FS::Record); @@ -124,7 +126,7 @@ sub check { =item agent -Returns the L<FS::agent> object for this template. +Returns the L<FS::agent> object for this batch. =cut @@ -132,6 +134,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 +210,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 +222,18 @@ sub import_results { my $param = ref($_[0]) ? shift : { @_ }; my $fh = $param->{'filehandle'}; + my $job = $param->{'job'}; + $job->update_statustext(0) if $job; + + my $gateway = $param->{'gateway'}; + if ( $gateway ) { + return $self->import_from_gateway($gateway, 'file' => $fh, 'job' => $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 +274,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 $@; @@ -431,6 +447,13 @@ sub process_import_results { 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/; my $dir = '%%%FREESIDE_CACHE%%%/cache.' . $FS::UID::datasrc; @@ -443,39 +466,258 @@ sub process_import_results { 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 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: + +- file: 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 $gateway = shift; + my %opt = @_; + 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{'file'}, # will do nothing if it's empty + # any other constructor options go here + ); + + my $processor = $gateway->batch_processor(%proc_opt); + + my @batches = $processor->receive; + my $error; + my $num = 0; + + # whether to allow items to change status + my $reconsider = $conf->exists('batch-reconsider'); + + # mutex all affected batches + my %pay_batch_for_update; + + BATCH: foreach my $batch (@batches) { + ITEM: foreach my $item ($batch->elements) { + # cust_pay_batch.paybatchnum should be in the 'tid' attribute + my $paybatchnum = $item->tid; + my $cust_pay_batch = FS::cust_pay_batch->by_key($paybatchnum); + if (!$cust_pay_batch) { + # XXX for one-way batch protocol this needs to create new payments + $error = "unknown paybatchnum $paybatchnum"; + last ITEM; + } + + 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 + my $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"; + last ITEM; + } + + 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 . "'"; + last ITEM; + } + } + + # create a new cust_pay_batch with whatever information we got back + my $new_cust_pay_batch = new FS::cust_pay_batch { $cust_pay_batch->hash }; + my $new_payinfo; + # update payinfo, if needed + if ( $item->assigned_token ) { + $new_payinfo = $item->assigned_token; + } elsif ( $cust_pay_batch->payby eq 'CARD' ) { + $new_payinfo = $item->card_number if $item->card_number; + } else { #$cust_pay_batch->payby eq 'CHEK' + $new_payinfo = $item->account_number . '@' . $item->routing_code + if $item->account_number; + } + $new_cust_pay_batch->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 ) { + $new_cust_pay_batch->paid($item->amount); + } else { + $new_cust_pay_batch->paid($cust_pay_batch->amount); + } + + # set payment date to when it was processed + $new_cust_pay_batch->_date($item->payment_date->epoch) + if $item->payment_date; + + # approval status + if ( $item->approved ) { + # follow Billing_Realtime format for paybatch + my $paybatch = $gateway->gatewaynum . + '-' . + $gateway->gateway_module . + ':' . + $item->authorization . + ':' . + $item->order_number; + + $error = $new_cust_pay_batch->approve($paybatch); + $total += $new_cust_pay_batch->paid; + } + else { + $error = $new_cust_pay_batch->decline($item->error_message); + } + last ITEM if $error; + $num++; + $job->update_statustext(int(100 * $num/( $batch->count + 1 ) ), + 'Importing batch items') + if $job; + } #foreach $item + + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + } #foreach $batch (input batch, not pay_batch) + + # Auto-resolve + foreach my $pay_batch (values %pay_batch_for_update) { + $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 a 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 ) { + my $days = $conf->config('batch-auto_resolve_days') || ''; + # 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; } 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 +729,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 +812,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 +835,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 +918,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 length( $conf->config("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/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/payby.pm b/FS/FS/payby.pm index 33ed42507..d1961a58d 100644 --- a/FS/FS/payby.pm +++ b/FS/FS/payby.pm @@ -176,6 +176,11 @@ sub realtime { # can use realtime payment facilities return $hash{$payby}->{realtime}; } +sub payby2shortname { + my $self = shift; + map { $_ => $hash{$_}->{shortname} } $self->payby; +} + sub payby2longname { my $self = shift; map { $_ => $hash{$_}->{longname} } $self->payby; diff --git a/FS/FS/payment_gateway.pm b/FS/FS/payment_gateway.pm index bc8b875c3..fac738499 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_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..0cfb11e2f --- /dev/null +++ b/FS/FS/quotation.pm @@ -0,0 +1,162 @@ +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 { + my $self = shift; + #actually quotation_pkg objects + qsearch('quotation_pkg', { quotationnum=>$self->quotationnum }); +} + +=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/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..a6daf44c8 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; @@ -243,6 +244,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 +258,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 +277,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; } @@ -844,8 +851,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 +859,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 +919,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_broadband.pm b/FS/FS/svc_broadband.pm index 2b6be2c6c..82102697d 100755 --- a/FS/FS/svc_broadband.pm +++ b/FS/FS/svc_broadband.pm @@ -428,7 +428,8 @@ sub check { } else { my $addr_block = $self->addr_block; - unless ( $addr_block and $addr_block->manual_flag ) { + if ( $self->ip_addr eq '' + and not ( $addr_block and $addr_block->manual_flag ) ) { my $error = $self->assign_ip_addr; return $error if $error; } @@ -525,6 +526,12 @@ sub _check_ip_addr { else { return 'Cannot parse address: '.$self->ip_addr unless $self->NetAddr; } + + if ( $self->addr_block + and not $self->addr_block->NetAddr->contains($self->NetAddr) ) { + return 'Address '.$self->ip_addr.' not in block '.$self->addr_block->cidr; + } + # if (my $dup = qsearchs('svc_broadband', { # ip_addr => $self->ip_addr, # svcnum => {op=>'!=', value => $self->svcnum} @@ -536,9 +543,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_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_rate.pm b/FS/FS/tax_rate.pm index 48c01967d..e9496e4f5 100644 --- a/FS/FS/tax_rate.pm +++ b/FS/FS/tax_rate.pm @@ -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, diff --git a/FS/FS/upgrade_journal.pm b/FS/FS/upgrade_journal.pm new file mode 100644 index 000000000..8f6d121a3 --- /dev/null +++ b/FS/FS/upgrade_journal.pm @@ -0,0 +1,151 @@ +package FS::upgrade_journal; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearch qsearchs ); + +=head1 NAME + +FS::upgrade_journal - Object methods for upgrade_journal records + +=head1 SYNOPSIS + + use FS::upgrade_journal; + + $record = new FS::upgrade_journal \%hash; + $record = new FS::upgrade_journal { 'column' => 'value' }; + + $error = $record->insert; + + # Typical use case + my $upgrade = 'rename_all_customers_to_Bob'; + if ( ! FS::upgrade_journal->is_done($upgrade) ) { + ... # do the upgrade, then, if it succeeds + FS::upgrade_journal->set_done($upgrade); + } + +=head1 DESCRIPTION + +An FS::upgrade_journal object records an upgrade procedure that was run +on the database. FS::upgrade_journal inherits from FS::Record. The +following fields are currently supported: + +=over 4 + +=item upgradenum - primary key + +=item _date - unix timestamp when the upgrade was run + +=item upgrade - string identifier for the upgrade procedure; must match /^\w+$/ + +=item status - either 'done' or 'failed' + +=item statustext - any other message that needs to be recorded + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new upgrade record. To add it 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 { 'upgrade_journal'; } + +=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 + +sub delete { die "upgrade_journal records can't be deleted" } +sub replace { die "upgrade_journal records can't be modified" } + +=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; + + if ( !$self->_date ) { + $self->_date(time); + } + + my $error = + $self->ut_numbern('upgradenum') + || $self->ut_number('_date') + || $self->ut_alpha('upgrade') + || $self->ut_text('status') + || $self->ut_textn('statustext') + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=head1 CLASS METHODS + +=over 4 + +=item is_done UPGRADE + +Returns the upgrade entry with identifier UPGRADE and status 'done', if +there is one. This is an easy way to check whether an upgrade has been done. + +=cut + +sub is_done { + my ($class, $upgrade) = @_; + qsearch('upgrade_journal', { 'status' => 'done', 'upgrade' => $upgrade }) +} + +=item set_done UPGRADE + +Creates and inserts an upgrade entry with the current time, status 'done', +and identifier UPGRADE. Dies on error. + +=cut + +sub set_done { + my ($class, $upgrade) = @_; + my $new = $class->new({ 'status' => 'done', 'upgrade' => $upgrade }); + my $error = $new->insert; + die $error if $error; + $new; +} + + +=head1 BUGS + +Despite how it looks, this is not currently suitable for use as a mutex. + +=head1 SEE ALSO + +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/MANIFEST b/FS/MANIFEST index f0a4a9d6b..590874d46 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 @@ -632,3 +631,21 @@ FS/h_svc_cert.pm t/h_svc_cert.t FS/contact_class.pm t/contact_class.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 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..2b33d1671 100755 --- a/FS/bin/freeside-daily +++ b/FS/bin/freeside-daily @@ -65,6 +65,11 @@ backup(); 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); + my $deldir = "$FS::UID::cache_dir/cache.$FS::UID::datasrc/"; unlink <${deldir}.invoice*>; unlink <${deldir}.letter*>; 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/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_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/upgrade_journal.t b/FS/t/upgrade_journal.t new file mode 100644 index 000000000..0822effc5 --- /dev/null +++ b/FS/t/upgrade_journal.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::upgrade_journal; +$loaded=1; +print "ok 1\n"; |