diff options
Diffstat (limited to 'FS')
88 files changed, 4561 insertions, 1431 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 diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm index d2417f069..eb9974adf 100644 --- a/FS/FS/AccessRight.pm +++ b/FS/FS/AccessRight.pm @@ -111,6 +111,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 +140,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 +191,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', @@ -254,6 +258,7 @@ tie my %rights, 'Tie::IxHash', 'Reporting/listing rights' => [ 'List customers', 'List all customers', + 'Advanced customer search', 'List zip codes', #NEW 'List invoices', 'List packages', @@ -269,6 +274,27 @@ tie my %rights, 'Tie::IxHash', { rightname=>'View email logs', global=>1 }, 'Download report data', + 'Services: Accounts', + 'Services: Accounts: Advanced search', + 'Services: Domains', + 'Services: Certificates', + 'Services: Mail forwards', + 'Services: Virtual hosting services', + 'Services: Wireless broadband services', + 'Services: Wireless broadband services: Advanced search', + 'Services: DSLs', + 'Services: Dish services', + 'Services: Hardware', + 'Services: Hardware: Advanced search', + 'Services: Phone numbers', + 'Services: PBXs', + 'Services: Ports', + 'Services: Mailing lists', + 'Services: External services', + 'Usage: RADIUS sessions', + 'Usage: Call Detail Records (CDRs)', + 'Usage: Unrateable CDRs', + 'Usage: Time worked', #{ rightname => 'List customers of all agents', global=>1 }, ], @@ -310,6 +336,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 }, 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 7bc3011d2..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 ) @@ -196,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' }; @@ -381,10 +382,16 @@ sub customer_info { my $cust_main = qsearchs('cust_main', $search ) or return { 'error' => "unknown custnum $custnum" }; + $return{display_custnum} = $cust_main->display_custnum; + if ( $session->{'pkgnum'} ) { $return{balance} = $cust_main->balance_pkgnum( $session->{'pkgnum'} ); + #next_bill_date from cust_pkg? } else { $return{balance} = $cust_main->balance; + $return{next_bill_date} = $cust_main->next_bill_date; + $return{next_bill_date_pretty} = + time2str('%m/%d/%Y', $return{next_bill_date} ); } my @tickets = $cust_main->tickets; @@ -416,21 +423,45 @@ sub customer_info { }; } $cust_main->open_cust_bill; $return{open_invoices} = \@open; + + my $sql = 'SELECT MAX(_date) FROM cust_bill WHERE custnum = ?'; + my $sth = dbh->prepare($sql) or die dbh->errstr; + $sth->execute($custnum) or die $sth->errstr; + $return{'last_invoice_date'} = $sth->fetchrow_arrayref->[0]; + $return{'last_invoice_date_pretty'} = + time2str('%m/%d/%Y', $return{'last_invoice_date'} ); } + $return{countrydefault} = scalar($conf->config('countrydefault')); + $return{small_custview} = small_custview( $cust_main, - scalar($conf->config('countrydefault')), + $return{countrydefault}, ( $session->{'pkgnum'} ? 1 : 0 ), #nobalance ); $return{name} = $cust_main->first. ' '. $cust_main->get('last'); - $return{ship_name} = $cust_main->ship_first. ' '. $cust_main->get('ship_last'); + + $return{has_ship_address} = $cust_main->has_ship_address; + $return{status} = $cust_main->status; + $return{statuscolor} = $cust_main->statuscolor; for (@cust_main_editable_fields) { $return{$_} = $cust_main->get($_); } + for (@location_editable_fields) { + $return{$_} = $cust_main->bill_location->get($_); + $return{'ship_'.$_} = $cust_main->ship_location->get($_); + } + $return{has_ship_address} = $cust_main->has_ship_address; + # compatibility: some places in selfservice use this to determine + # if there's a ship address + if ( $return{has_ship_address} ) { + $return{ship_last} = $cust_main->last; + $return{ship_first} = $cust_main->first; + } + if ( $cust_main->payby =~ /^(CARD|DCRD)$/ ) { $return{payinfo} = $cust_main->paymask; @return{'month', 'year'} = $cust_main->paydate_monthyear; @@ -444,7 +475,7 @@ sub customer_info { if (scalar($conf->config('support_packages'))) { my @support_services = (); foreach ($cust_main->support_services) { - my $seconds = $_->svc_x->seconds; + my $seconds = $_->svc_x->seconds || 0; my $time_remaining = (($seconds < 0) ? '-' : '' ). int(abs($seconds)/3600)."h". sprintf("%02d",(abs($seconds)%3600)/60)."m"; @@ -485,8 +516,8 @@ sub customer_info { } - return { 'error' => '', - 'custnum' => $custnum, + return { 'error' => '', + 'custnum' => $custnum, %return, }; @@ -509,14 +540,17 @@ sub customer_info_short { my $cust_main = qsearchs('cust_main', $search ) or return { 'error' => "unknown custnum $custnum" }; + $return{display_custnum} = $cust_main->display_custnum; + + $return{countrydefault} = scalar($conf->config('countrydefault')); + $return{small_custview} = small_custview( $cust_main, - scalar($conf->config('countrydefault')), + $return{countrydefault}, 1, ##nobalance ); $return{name} = $cust_main->first. ' '. $cust_main->get('last'); - $return{ship_name} = $cust_main->ship_first. ' '. $cust_main->get('ship_last'); $return{payby} = $cust_main->payby; @@ -524,7 +558,12 @@ sub customer_info_short { for (@cust_main_editable_fields) { $return{$_} = $cust_main->get($_); } - + #maybe a little more expensive, but it should be cached by now + for (@location_editable_fields) { + $return{$_} = $cust_main->bill_location->get($_); + $return{'ship_'.$_} = $cust_main->ship_location->get($_); + } + if ( $cust_main->payby =~ /^(CARD|DCRD)$/ ) { $return{payinfo} = $cust_main->paymask; @return{'month', 'year'} = $cust_main->paydate_monthyear; @@ -558,6 +597,103 @@ sub customer_info_short { }; } +sub billing_history { + my $p = shift; + + my($context, $session, $custnum) = _custoragent_session_custnum($p); + return { 'error' => $session } if $context eq 'error'; + + return { 'error' => 'No customer' } unless $custnum; + + my $search = { 'custnum' => $custnum }; + $search->{'agentnum'} = $session->{'agentnum'} if $context eq 'agent'; + my $cust_main = qsearchs('cust_main', $search ) + or return { 'error' => "unknown custnum $custnum" }; + + my %return = (); + + if ( $session->{'pkgnum'} ) { + #$return{balance} = $cust_main->balance_pkgnum( $session->{'pkgnum'} ); + #next_bill_date from cust_pkg? + return { 'error' => 'No history for package' }; + } + + $return{balance} = $cust_main->balance; + $return{next_bill_date} = $cust_main->next_bill_date; + $return{next_bill_date_pretty} = + time2str('%m/%d/%Y', $return{next_bill_date} ); + + my @history = (); + + my $conf = new FS::Conf; + + if ( $conf->exists('selfservice-billing_history-line_items') ) { + + foreach my $cust_bill ( $cust_main->cust_bill ) { + + push @history, { + 'type' => 'Line item', + 'description' => $_->desc. ( $_->sdate && $_->edate + ? ' '. time2str('%d-%b-%Y', $_->sdate). + ' To '. time2str('%d-%b-%Y', $_->edate) + : '' + ), + 'amount' => sprintf('%.2f', $_->setup + $_->recur ), + 'date' => $cust_bill->_date, + 'date_pretty' => time2str('%m/%d/%Y', $cust_bill->_date ), + } + foreach $cust_bill->cust_bill_pkg; + + } + + } else { + + push @history, { + 'type' => 'Invoice', + 'description' => 'Invoice #'. $_->display_invnum, + 'amount' => sprintf('%.2f', $_->charged ), + 'date' => $_->_date, + 'date_pretty' => time2str('%m/%d/%Y', $_->_date ), + } + foreach $cust_main->cust_bill; + + } + + push @history, { + 'type' => 'Payment', + 'description' => 'Payment', #XXX type + 'amount' => sprintf('%.2f', 0 - $_->paid ), + 'date' => $_->_date, + 'date_pretty' => time2str('%m/%d/%Y', $_->_date ), + } + foreach $cust_main->cust_pay; + + push @history, { + 'type' => 'Credit', + 'description' => 'Credit', #more info? + 'amount' => sprintf('%.2f', 0 -$_->amount ), + 'date' => $_->_date, + 'date_pretty' => time2str('%m/%d/%Y', $_->_date ), + } + foreach $cust_main->cust_credit; + + push @history, { + 'type' => 'Refund', + 'description' => 'Refund', #more info? type, like payment? + 'amount' => $_->refund, + 'date' => $_->_date, + 'date_pretty' => time2str('%m/%d/%Y', $_->_date ), + } + foreach $cust_main->cust_refund; + + @history = sort { $b->{'date'} <=> $a->{'date'} } @history; + + $return{'history'} = \@history; + + return \%return; + +} + sub edit_info { my $p = shift; my $session = _cache->get($p->{'session_id'}) @@ -570,9 +706,32 @@ sub edit_info { or return { 'error' => "unknown custnum $custnum" }; my $new = new FS::cust_main { $cust_main->hash }; + $new->set( $_ => $p->{$_} ) foreach grep { exists $p->{$_} } @cust_main_editable_fields; + if ( exists($p->{address1}) ) { + my $bill_location = FS::cust_location->new({ + map { $_ => $p->{$_} } @location_editable_fields + }); + # if this is unchanged from before, cust_main::replace will ignore it + $new->set('bill_location' => $bill_location); + } + + if ( exists($p->{ship_address1}) ) { + my $ship_location = FS::cust_location->new({ + map { $_ => $p->{"ship_$_"} } @location_editable_fields + }); + if ( !grep { length($p->{"ship_$_"}) } @location_editable_fields ) { + # Selfservice unfortunately tries to indicate "same as billing + # address" by sending all fields empty. Did this ever work? + $ship_location = $cust_main->bill_location; + } + $new->set('ship_location' => $ship_location); + } + # but if it hasn't been passed in at all, leave ship_location alone-- + # DON'T change it to match bill_location. + my $payby = ''; if (exists($p->{'payby'})) { $p->{'payby'} =~ /^([A-Z]{4})$/ @@ -710,7 +869,8 @@ sub payment_info { $return{payname} = $cust_main->payname || ( $cust_main->first. ' '. $cust_main->get('last') ); - $return{$_} = $cust_main->get($_) for qw(address1 address2 city state zip); + $return{$_} = $cust_main->bill_location->get($_) + for qw(address1 address2 city state zip); $return{payby} = $cust_main->payby; $return{stateid_state} = $cust_main->stateid_state; @@ -729,7 +889,7 @@ sub payment_info { $return{payinfo2} = $payinfo2; $return{paytype} = $cust_main->paytype; $return{paystate} = $cust_main->paystate; - + $return{payname} = $cust_main->payname; # override 'first/last name' default from above, if any. Is instution-name here. (#15819) } if ( $conf->config('prepayment_discounts-credit_type') ) { @@ -852,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, @@ -876,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 + ) }; } @@ -927,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 @@ -1375,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 ], @@ -1467,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' ) { @@ -1770,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 98e1910c3..7dd20c652 100644 --- a/FS/FS/ClientAPI_XMLRPC.pm +++ b/FS/FS/ClientAPI_XMLRPC.pm @@ -104,6 +104,7 @@ sub ss2clientapi { 'switch_acct' => 'MyAccount/switch_acct', 'customer_info' => 'MyAccount/customer_info', 'customer_info_short' => 'MyAccount/customer_info_short', + 'billing_history' => 'MyAccount/billing_history', 'edit_info' => 'MyAccount/edit_info', #add to ss cgi! 'invoice' => 'MyAccount/invoice', 'invoice_pdf' => 'MyAccount/invoice_pdf', @@ -176,22 +177,6 @@ sub ss2clientapi { 'call_time' => 'PrepaidPhone/call_time', 'call_time_nanpa' => 'PrepaidPhone/call_time_nanpa', 'phonenum_balance' => 'PrepaidPhone/phonenum_balance', - #izoom - #'bulk_processrow' => 'Bulk/processrow', - #conflicts w/Agentone# 'check_username' => 'Bulk/check_username', - #sg - 'ping' => 'SGNG/ping', - 'decompify_pkgs' => 'SGNG/decompify_pkgs', - 'previous_payment_info' => 'SGNG/previous_payment_info', - 'previous_payment_info_renew_info' - => 'SGNG/previous_payment_info_renew_info', - 'previous_process_payment' => 'SGNG/previous_process_payment', - 'previous_process_payment_order_pkg' - => 'SGNG/previous_process_payment_order_pkg', - 'previous_process_payment_change_pkg' - => 'SGNG/previous_process_payment_change_pkg', - 'previous_process_payment_order_renew' - => 'SGNG/previous_process_payment_order_renew', }; } diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 81443632c..13625da25 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 @@ -1420,6 +1499,7 @@ and customer address. Include units.', 'description' => 'Send payment receipts.', 'type' => 'checkbox', 'per_agent' => 1, + 'agent_bool' => 1, }, { @@ -1846,6 +1926,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.", @@ -2955,7 +3042,7 @@ and customer address. Include units.', 'section' => 'invoicing', 'description' => 'Enable FTP of raw invoice data - format.', 'type' => 'select', - 'select_enum' => [ '', 'default', 'oneline', 'billco', ], + 'options' => [ spool_formats() ], }, { @@ -2991,7 +3078,7 @@ and customer address. Include units.', 'section' => 'invoicing', 'description' => 'Enable spooling of raw invoice data - format.', 'type' => 'select', - 'select_enum' => [ '', 'default', 'oneline', 'billco', ], + 'options' => [ spool_formats() ], }, { @@ -3002,6 +3089,32 @@ and customer address. Include units.', }, { + 'key' => 'bridgestone-batch_counter', + 'section' => '', + 'description' => 'Batch counter for spool files. Increments every time a spool file is uploaded.', + 'type' => 'text', + 'per_agent' => 1, + }, + + { + 'key' => 'bridgestone-prefix', + 'section' => '', + 'description' => 'Agent identifier for uploading to BABT printing service.', + 'type' => 'text', + 'per_agent' => 1, + }, + + { + 'key' => 'bridgestone-confirm_template', + 'section' => '', + 'description' => 'Confirmation email template for uploading to BABT service. Text::Template format, with variables "$zipfile" (name of the zipped file), "$seq" (sequence number), "$prefix" (user ID string), and "$rows" (number of records in the file). Should include Subject: and To: headers, separated from the rest of the message by a blank line.', + # this could use a true message template, but it's hard to see how that + # would make the world a better place + 'type' => 'textarea', + 'per_agent' => 1, + }, + + { 'key' => 'svc_acct-usage_suspend', 'section' => 'billing', 'description' => 'Suspends the package an account belongs to when svc_acct.seconds or a bytecount is decremented to 0 or below (accounts with an empty seconds and up|down|totalbytes value are ignored). Typically used in conjunction with prepaid packages and freeside-sqlradius-radacctd.', @@ -3052,6 +3165,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.', @@ -3446,7 +3569,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', }, @@ -3952,6 +4082,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".', @@ -4001,6 +4138,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', @@ -4361,34 +4514,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.", @@ -4493,6 +4618,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.', @@ -4540,14 +4672,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', }, @@ -4650,6 +4782,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.', @@ -4857,6 +4996,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', @@ -4916,6 +5062,20 @@ and customer address. Include units.', '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/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 f6ad714d3..16c9afd96 100644 --- a/FS/FS/Mason.pm +++ b/FS/FS/Mason.pm @@ -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,11 @@ 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; # Sammath Naur if ( $FS::Mason::addl_handler_use ) { 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/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/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/Schema.pm b/FS/FS/Schema.pm index 3894f65f8..a90c73a95 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' ] ], }, @@ -1067,6 +1073,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 +1084,7 @@ sub tables_hashref { 'unique' => [], 'index' => [ [ 'prospectnum' ], [ 'custnum' ], [ 'county' ], [ 'state' ], [ 'country' ], [ 'zip' ], + [ 'city' ], [ 'district' ] ], }, @@ -1167,9 +1176,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', @@ -1500,6 +1510,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, '', '', @@ -1649,14 +1661,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' => { @@ -1833,6 +1846,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' => [], @@ -1841,18 +1855,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' => [ @@ -2556,7 +2581,7 @@ sub tables_hashref { 'plan_id', 'varchar', 'NULL', $char_d, '', '', ], 'primary_key' => 'svcnum', - 'unique' => [ [ 'mac_addr' ] ], + 'unique' => [ [ 'ip_addr' ], [ 'mac_addr' ] ], 'index' => [], }, @@ -2994,7 +3019,6 @@ sub tables_hashref { ### 'upstream_currency', 'char', 'NULL', 3, '', '', - 'upstream_price', 'decimal', 'NULL', '10,4', '', '', 'upstream_rateplanid', 'int', 'NULL', '', '', '', #? # how it was rated internally... @@ -3019,6 +3043,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, '', '', @@ -3154,11 +3182,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' ] ], @@ -3235,6 +3264,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', '', '', '', '', @@ -3640,6 +3680,23 @@ sub tables_hashref { 'index' => [ [ 'upgrade' ] ], }, + 'ftp_target' => { + 'columns' => [ + 'targetnum', 'serial', '', '', '', '', + 'agentnum', 'int', 'NULL', '', '', '', + 'hostname', 'varchar', '', $char_d, '', '', + 'port', 'int', '', '', '', '', + 'username', 'varchar', '', $char_d, '', '', + 'password', 'varchar', '', $char_d, '', '', + 'path', 'varchar', '', $char_d, '', '', + 'secure', 'char', 'NULL', 1, '', '', + 'handling', 'varchar', 'NULL', $char_d, '', '', + ], + 'primary_key' => 'targetnum', + 'unique' => [ [ 'targetnum' ] ], + 'index' => [], + }, + %{ tables_hashref_torrus() }, # tables of ours for doing torrus virtual port combining diff --git a/FS/FS/Setup.pm b/FS/FS/Setup.pm index e2c5a5a2c..e27b66fc5 100644 --- a/FS/FS/Setup.pm +++ b/FS/FS/Setup.pm @@ -209,6 +209,14 @@ sub populate_initial_data { sub initial_data { my %opt = @_; + my $cust_location = FS::cust_location->new({ + 'address1' => '1234 System Lane', + 'city' => 'Systemtown', + 'state' => 'CA', + 'zip' => '54321', + 'country' => 'US', + }); + #tie my %hash, 'Tie::DxHash', tie my %hash, 'Tie::IxHash', @@ -351,14 +359,11 @@ sub initial_data { 'refnum' => 1, #XXX 'first' => 'System', 'last' => 'Accounts', - 'address1' => '1234 System Lane', - 'city' => 'Systemtown', - 'state' => 'CA', - 'zip' => '54321', - 'country' => 'US', 'payby' => 'COMP', 'payinfo' => 'system', #or something 'paydate' => '1/2037', + 'bill_location' => $cust_location, + 'ship_location' => $cust_location, }, ], diff --git a/FS/FS/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/access_groupsales.pm b/FS/FS/access_groupsales.pm new file mode 100644 index 000000000..31b07d9f8 --- /dev/null +++ b/FS/FS/access_groupsales.pm @@ -0,0 +1,153 @@ +package FS::access_groupsales; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearch qsearchs ); + +=head1 NAME + +FS::access_groupsales - Object methods for access_groupsales records + +=head1 SYNOPSIS + + use FS::access_groupsales; + + $record = new FS::access_groupsales \%hash; + $record = new FS::access_groupsales { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::access_groupsales object represents an example. FS::access_groupsales inherits from +FS::Record. The following fields are currently supported: + +=over 4 + +=item groupsalesnum + +primary key + +=item groupnum + +groupnum + +=item salesnum + +salesnum + + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new example. To add the example to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I<hash> method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'access_groupsales'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +# the insert method can be inherited from FS::Record + +=item delete + +Delete this record from the database. + +=cut + +# the delete method can be inherited from FS::Record + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +# the replace method can be inherited from FS::Record + +=item check + +Checks all fields to make sure this is a valid example. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +# the check method should currently be supplied - FS::Record contains some +# data checking routines + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('groupsalesnum') + || $self->ut_number('groupnum') + || $self->ut_number('salesnum') + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=item sales + +Returns the associated FS::agent object. + +=cut + +sub sales { + my $self = shift; + qsearchs('sales', { 'salesnum' => $self->salesnum } ); +} + +=item access_group + +Returns the associated FS::access_group object. + +=cut + +sub access_group { + my $self = shift; + qsearchs('access_group', { 'groupnum' => $self->groupnum } ); +} + +=back + + +=head1 BUGS + +The author forgot to customize this manpage. + +=head1 SEE ALSO + +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/access_right.pm b/FS/FS/access_right.pm index 341055bfc..1e65ca354 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); @@ -182,19 +184,56 @@ sub _upgrade_data { # class method my @all_groups = qsearch('access_group', {}); - my %onetime = ( - 'List customers' => 'List all customers', - 'List packages' => 'Summarize packages', - ); + tie my %onetime, 'Tie::IxHash', + 'List customers' => 'List all customers', + 'List all customers' => 'Advanced customer search', + 'List packages' => 'Summarize packages', + 'Post payment' => 'Backdate payment', + 'Cancel customer package immediately' => 'Un-cancel customer package', + 'Suspend customer package' => 'Suspend customer', + 'Unsuspend customer package' => 'Unsuspend customer', + + 'List services' => [ 'Services: Accounts', + 'Services: Domains', + 'Services: Certificates', + 'Services: Mail forwards', + 'Services: Virtual hosting services', + 'Services: Wireless broadband services', + 'Services: DSLs', + 'Services: Dish services', + 'Services: Hardware', + 'Services: Phone numbers', + 'Services: PBXs', + 'Services: Ports', + 'Services: Mailing lists', + 'Services: External services', + ], + + 'Services: Accounts' => 'Services: Accounts: Advanced search', + 'Services: Wireless broadband services' => 'Services: Wireless broadband services: Advanced search', + 'Services: Hardware' => 'Services: Hardware: Advanced search', + + 'List rating data' => [ 'Usage: RADIUS sessions', + 'Usage: Call Detail Records (CDRs)', + 'Usage: Unrateable CDRs', + ], + ; foreach my $old_acl ( keys %onetime ) { - my $new_acl = $onetime{$old_acl}; #support arrayref too? - ( my $journal = 'ACL_'.lc($new_acl) ) =~ s/ /_/g; - next if FS::upgrade_journal->is_done($journal); - # grant $new_acl to all groups who have $old_acl - for my $group (@all_groups) { - if ( $group->access_right($old_acl) ) { + my @new_acl = ref($onetime{$old_acl}) + ? @{ $onetime{$old_acl} } + : ( $onetime{$old_acl} ); + + foreach my $new_acl ( @new_acl ) { + + ( my $journal = 'ACL_'.lc($new_acl) ) =~ s/\W/_/g; + next if FS::upgrade_journal->is_done($journal); + + # grant $new_acl to all groups who have $old_acl + for my $group (@all_groups) { + next unless $group->access_right($old_acl); + next if $group->access_right($new_acl); my $access_right = FS::access_right->new( { 'righttype' => 'FS::access_group', 'rightobjnum' => $group->groupnum, @@ -203,9 +242,11 @@ sub _upgrade_data { # class method my $error = $access_right->insert; die $error if $error; } - } - FS::upgrade_journal->set_done($journal); + FS::upgrade_journal->set_done($journal); + + } + } ### ACL_download_report_data diff --git a/FS/FS/cdr/cia.pm b/FS/FS/cdr/cia.pm index 070f3fb0d..ca44c0fdf 100644 --- a/FS/FS/cdr/cia.pm +++ b/FS/FS/cdr/cia.pm @@ -20,11 +20,12 @@ use FS::cdr qw(_cdr_date_parser_maker); skip(2), # Conference Start Time, Conference End Time _cdr_date_parser_maker('startdate'), # Connect Time _cdr_date_parser_maker('enddate'), # Disconnect Time + skip(1), # Duration sub { my($cdr, $data, $conf, $param) = @_; $cdr->duration($data); $cdr->billsec( $data); - }, # Duration - skip(2), # Roundup Duration, User Name + }, # Roundup Duration + skip(1), # User Name 'dst', # DNIS 'src', # ANI skip(2), # Call Type, Toll Free, diff --git a/FS/FS/cdr/infinite.pm b/FS/FS/cdr/infinite.pm index 90560c8c7..02ff9df6f 100644 --- a/FS/FS/cdr/infinite.pm +++ b/FS/FS/cdr/infinite.pm @@ -6,6 +6,8 @@ use FS::cdr qw(_cdr_date_parser_maker); @ISA = qw(FS::cdr); +my $date_parser = _cdr_date_parser_maker('startdate'); + %info = ( 'name' => 'Infinite Conferencing', 'weight' => 520, @@ -13,26 +15,38 @@ use FS::cdr qw(_cdr_date_parser_maker); 'type' => 'csv', 'sep_char' => ',', 'import_fields' => [ - 'uniqueid', # billid - skip(3), # confid, invoicenum, acctgrpid - 'accountcode', # accountid ("Room Confirmation Number") - skip(2), # billingcode ("Room Billingcode"), confname - skip(1), # participant_type - 'startdate', # starttime_t - skip(2), # startdate, starttime + 'uniqueid', # A. billid + skip(3), # B-D. confid, invoicenum, acctgrpid + skip(1), # E. accountid ("Room Confirmation Number") + skip(2), # F-G. billingcode ("Room Billingcode"), confname + skip(1), # H. participant_type + skip(1), # I. starttime_t - timezone is unreliable + sub { # J. startdate + my ($cdr, $data, $conf, $param) = @_; + $param->{'date_part'} = $data; # stash this and combine with the time + ''; + }, + sub { # K. starttime + my ($cdr, $data, $conf, $param) = @_; + my $datestring = delete($param->{'date_part'}) . ' ' . $data; + &{ $date_parser }($cdr, $datestring); + }, sub { my($cdr, $data, $conf, $param) = @_; $cdr->duration($data * 60); $cdr->billsec( $data * 60); - }, # minutes - 'dst', # dnis - 'src', # ani - skip(8), # calltype, calltype_text, confstart_t, confstartdate, + }, # L. minutes + skip(1), # M. dnis + 'src', # N. ani + 'dst', # O. calltype + skip(7), # P-V. calltype_text, confstart_t, confstartdate, # confstarttime, confminutes, conflegs, ppm - 'upstream_price', # callcost - skip(13), # confcost, rppm, rcallcost, rconfcost, - # auxdata[1..4], ldval, sysname, username, cec, pec - 'userfield', # unnamed field - ], + 'upstream_price', # W. callcost + skip(11), # X-AH. confcost, rppm, rcallcost, rconfcost, + # auxdata[1..4], ldval, sysname, username + 'accountcode', # AI. Chairperson Entry Code + skip(1), # AJ. Participant Entry Code + 'description', # AK. contact name + ], ); diff --git a/FS/FS/cdr/troop.pm b/FS/FS/cdr/troop.pm index 020af2b20..429c25a53 100644 --- a/FS/FS/cdr/troop.pm +++ b/FS/FS/cdr/troop.pm @@ -7,7 +7,7 @@ use Time::Local; #use FS::cdr qw( _cdr_date_parser_maker _cdr_min_parser_maker ); %info = ( - 'name' => 'Troop', + 'name' => 'Troop (old?)', 'weight' => 220, 'header' => 2, 'type' => 'xls', diff --git a/FS/FS/cdr/troop2.pm b/FS/FS/cdr/troop2.pm new file mode 100644 index 000000000..ee6474061 --- /dev/null +++ b/FS/FS/cdr/troop2.pm @@ -0,0 +1,94 @@ +package FS::cdr::troop2; + +use strict; +use base qw( FS::cdr ); +use vars qw( %info $tmp_date $tmp_src_city $tmp_dst_city ); +use Date::Parse; +#use Time::Local; +##use FS::cdr qw( _cdr_date_parser_maker _cdr_min_parser_maker ); + +%info = ( + 'name' => 'Troop', + 'weight' => 219, + 'header' => 1, + 'type' => 'xls', + + 'import_fields' => [ + + 'userfield', #account_num (userfield?) + + #call_date + sub { my($cdr, $date) = @_; + #is this an excel date? or just text? + $tmp_date = $date; + }, + + #call_time + sub { my($cdr, $time) = @_; + #is this an excel time? or just text? + $cdr->startdate( str2time("$tmp_date $time") ); + }, + + 'src', #orig_tn + 'dst', #term_tn + + #call_dur + sub { my($cdr, $duration) = @_; + $cdr->duration($duration); + $cdr->billsec($duration); + }, + + 'clid', #auth_code_ani (clid?) + + 'accountcode', #account_code + + #ovs_type + # OVS Type / Maybe / add "011" to international calls + # N = DOM LD / normal + # Z = INTL LD + # O = INTL LD + # others...? + sub { my($cdr, $ovs) = @_; + my $pre = ( $ovs =~ /^\s*[OZ]\s*$/i ) ? '011' : '1'; + $cdr->dst( $pre. $cdr->dst ) unless $cdr->dst =~ /^$pre/; + }, + + #orig_city + sub { (my $cdr, $tmp_src_city) = @_; }, + + #orig_prov_state + sub { my($cdr, $state) = @_; + $cdr->upstream_src_regionname("$tmp_src_city, $state"); + }, + + #term_city + sub { (my $cdr, $tmp_dst_city) = @_; }, + + #term_prov_state + sub { my($cdr, $state) = @_; + $cdr->upstream_dst_regionname("$tmp_dst_city, $state"); + }, + + #term_ovs + '', #CANADA / UNITED STATES / BELL. huh. country or terminating provider? + + '', #cc_ind (what's this?) + + 'upstream_price', #call_charge + + #important? + '', #creation_date + '', #creation_time + + #additional upstream pricing details we don't need? + '', #net_charge + '', #surcharge + '', #gst + '', #pst + '', #hst + + ], + +); + +1; diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index a76170a9b..35ab9f388 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -388,8 +388,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 +1316,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 +1333,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 +1753,21 @@ Options are: =over 4 -=item format - 'default' or 'billco' +=item format - any of FS::Misc::::Invoicing::spool_formats -=item dest - if set (to POST, EMAIL or FAX), only sends spools invoices if the customer has the corresponding invoice destinations set (see L<FS::cust_main_invoice>). +=item dest - if set (to POST, EMAIL or FAX), only sends spools invoices if the +customer has the corresponding invoice destinations set (see +L<FS::cust_main_invoice>). -=item agent_spools - if set to a true value, will spool to per-agent files rather than a single global file +=item agent_spools - if set to a true value, will spool to per-agent files +rather than a single global file -=item balanceover - if set, only spools the invoice if the total amount owed on this invoice and all older invoices is greater than the specified amount. +=item ftp_targetnum - if set to an FTP target (see L<FS::ftp_target>), will +append to that spool. L<FS::Cron::upload> will then send the spool file to +that destination. + +=item balanceover - if set, only spools the invoice if the total amount owed on +this invoice and all older invoices is greater than the specified amount. =back @@ -1782,11 +1795,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 +1826,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 +1848,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 +1857,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 +1963,26 @@ If I<format> is "billco", the fields of the detail CSV file are as follows: 9 | Grouping Code | GROUP | CHAR | 2 10 | User Defined | ACCT CODE | CHAR | 15 +If format is 'oneline', there is no detail file. Each invoice has a +header line only, with the fields: + +Agent number, agent name, customer number, first name, last name, address +line 1, address line 2, city, state, zip, invoice date, invoice number, +amount charged, amount due, + +and then, for each line item, three columns containing the package number, +description, and amount. + +If format is 'bridgestone', there is no detail file. Each invoice has a +header line with the following fields in a fixed-width format: + +Customer number (in display format), date, name (first last), company, +address 1, address 2, city, state, zip. + +This is a mailing list format, and has no per-invoice fields. To avoid +sending redundant notices, the spooling event should have a "once" or +"once_percust_every" condition. + =cut sub print_csv { @@ -2036,6 +2079,31 @@ sub print_csv { @items, ); + } elsif ( lc($opt{'format'}) eq 'bridgestone' ) { + + # bypass the CSV stuff and just return this + my $longdate = time2str('%B %d, %Y', time); #current time, right? + my $zip = $cust_main->zip; + $zip =~ s/\D//; + my $prefix = $self->conf->config('bridgestone-prefix', $cust_main->agentnum) + || ''; + return ( + sprintf( + "%-5s%-15s%-20s%-30s%-30s%-30s%-30s%-20s%-2s%-9s\n", + $prefix, + $cust_main->display_custnum, + $longdate, + uc(substr($cust_main->contact_firstlast,0,30)), + uc(substr($cust_main->company ,0,30)), + uc(substr($cust_main->address1 ,0,30)), + uc(substr($cust_main->address2 ,0,30)), + uc(substr($cust_main->city ,0,20)), + uc($cust_main->state), + $zip + ), + '' #detail + ); + } else { $csv->combine( @@ -2777,11 +2845,13 @@ sub print_generic { $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.$_; + 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 ); @@ -2978,6 +3048,12 @@ sub print_generic { 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) @@ -3009,8 +3085,7 @@ sub print_generic { } } else {# not multisection # make a default section - push @sections, { 'description' => '', 'subtotal' => '', - 'no_subtotal' => 1 }; + 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? @@ -3043,7 +3118,8 @@ sub print_generic { }; $detail->{'ref'} = $line_item->{'pkgnum'}; $detail->{'quantity'} = 1; - $detail->{'section'} = $previous_section; + $detail->{'section'} = $multisection ? $previous_section + : $default_section; $detail->{'description'} = &$escape_function($line_item->{'description'}); if ( exists $line_item->{'ext_description'} ) { @{$detail->{'ext_description'}} = map { @@ -3882,17 +3958,20 @@ sub _items_sections { if ( $display->post_total && !$summarypage ) { if (! $type || $type eq 'S') { $late_subtotal{$section} += $cust_bill_pkg->setup - if $cust_bill_pkg->setup != 0; + 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; + 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; + if $cust_bill_pkg->recur != 0 + || $cust_bill_pkg->recur_show_zero; } if ($type && $type eq 'U') { @@ -3906,17 +3985,20 @@ sub _items_sections { if (! $type || $type eq 'S') { $subtotal{$section} += $cust_bill_pkg->setup - if $cust_bill_pkg->setup != 0; + 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; + 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; + if $cust_bill_pkg->recur != 0 + || $cust_bill_pkg->recur_show_zero; } if ($type && $type eq 'U') { @@ -4909,6 +4991,8 @@ sub _items_cust_bill_pkg { } } + my @cust_bill_pkg_display = $cust_bill_pkg->cust_bill_pkg_display; + warn "$me _items_cust_bill_pkg considering cust_bill_pkg ". $cust_bill_pkg->billpkgnum. ", pkgnum ". $cust_bill_pkg->pkgnum. "\n" if $DEBUG > 1; @@ -4919,7 +5003,7 @@ sub _items_cust_bill_pkg { } #grep { !$_->summary || !$summary_page } # bunk! grep { !$_->summary || $multisection } - $cust_bill_pkg->cust_bill_pkg_display + @cust_bill_pkg_display ) { @@ -5421,6 +5505,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". 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_location.pm b/FS/FS/cust_location.pm index a5250ec05..2810dc957 100644 --- a/FS/FS/cust_location.pm +++ b/FS/FS/cust_location.pm @@ -4,7 +4,7 @@ use base qw( FS::geocode_Mixin FS::Record ); use strict; 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; @@ -113,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' @@ -144,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); } @@ -174,6 +172,7 @@ and replace methods. #fields anyway... sub check { my $self = shift; + my $conf = new FS::Conf; my $error = $self->ut_numbern('locationnum') @@ -185,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' ]) @@ -194,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 $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' => '', } ) ) { @@ -266,19 +279,40 @@ location_kind. =cut -=item move_to HASHREF +=item disable_if_unused + +Sets the "disabled" flag on the location if it is no longer in use as a +prospect location, package location, or a customer's billing or default +service address. + +=cut + +sub disable_if_unused { + + my $self = shift; + my $locationnum = $self->locationnum; + return '' if FS::cust_main->count('bill_locationnum = '.$locationnum) + or FS::cust_main->count('ship_locationnum = '.$locationnum) + or FS::contact->count( 'locationnum = '.$locationnum) + or FS::cust_pkg->count('cancel IS NULL AND + locationnum = '.$locationnum) + ; + $self->disabled('Y'); + $self->replace; + +} + +=item move_to -Takes a hashref with one or more cust_location fields. Creates a duplicate -of the existing location with all fields set to the values in the hashref. -Moves all packages that use the existing location to the new one, then sets -the "disabled" flag on the old location. Returns nothing on success, an -error message on error. +Takes a new L<FS::cust_location> object. Moves all packages that use the +existing location to the new one, then sets the "disabled" flag on the old +location. Returns nothing on success, an error message on error. =cut sub move_to { my $old = shift; - my $hashref = shift; + my $new = shift; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -292,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', { @@ -319,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 @@ -408,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 -Not yet used for cust_main billing and shipping addresses. +=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. + +=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 845d09848..b382232b2 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -6,6 +6,7 @@ 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::o2m_Common @@ -14,7 +15,7 @@ use base qw( FS::cust_main::Packages FS::cust_main::Status 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'); - - } + # 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; + #} - unless ( $import ) { - $self->set_coord - if ! $self->coord_auto && ! $self->latitude && ! $self->longitude; - - $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; @@ -4010,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 @@ -4019,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 @@ -4048,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 @@ -4076,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 @@ -4100,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 @@ -5077,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 ca8d9960c..e7b953060 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 } }, @@ -952,7 +963,6 @@ sub _make_lines { # bill recurring fee ### - #XXX unit stuff here too my $recur = 0; my $unitrecur = 0; my @recur_discounts = (); @@ -1011,6 +1021,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); @@ -1206,21 +1219,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 { @@ -1243,11 +1247,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 ]; @@ -1274,17 +1280,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; @@ -1525,17 +1541,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 06331d3df..957043a84 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; } @@ -438,6 +444,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 31b89cd31..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 @@ -142,10 +140,12 @@ sub smart_search { my $num = $1; if ( $num =~ /^(\d+)$/ && $num <= 2147483647 ) { #need a bigint custnum? wow + my $agent_custid_null = $conf->exists('cust_main-default_agent_custid') + ? ' AND agent_custid IS NULL ' : ''; push @cust_main, qsearch( { 'table' => 'cust_main', 'hashref' => { 'custnum' => $num, %options }, - 'extra_sql' => " AND $agentnums_sql", #agent virtualization + 'extra_sql' => " AND $agentnums_sql $agent_custid_null", } ); } @@ -175,16 +175,17 @@ sub smart_search { 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*$/ ) { @@ -196,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} @@ -247,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) @@ -268,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 .= " )"; @@ -294,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%" }, }, ; } @@ -335,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 ); } } @@ -467,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 @@ -558,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; + } ## @@ -599,7 +617,7 @@ sub search { # dates ## - foreach my $field (qw( signupdate )) { + foreach my $field (qw( signupdate birthdate spouse_birthdate )) { next unless exists($params->{$field}); @@ -610,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"; } @@ -770,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; @@ -831,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(); @@ -858,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 ef30809b0..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 @@ -582,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; @@ -760,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); @@ -786,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; @@ -853,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) { + + 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'); + } - delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge - my $error = $cust_pay->replace; + delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge + my $error = $cust_pay->replace; - if ( $error ) { - warn " *** WARNING: Error updating order taker for payment paynum ". - $cust_pay->paynun. ": $error\n"; - next; - } + 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 - $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_pkg.pm b/FS/FS/cust_pkg.pm index bee1b82fb..22559e95f 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). @@ -1239,6 +1387,8 @@ sub unsuspend { } #if $date + my @labels = (); + foreach my $cust_svc ( qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } ) ) { @@ -1258,6 +1408,8 @@ sub unsuspend { $dbh->rollback if $oldAutoCommit; return $error; } + my( $label, $value ) = $cust_svc->label; + push @labels, "$label: $value"; } } @@ -1288,6 +1440,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 @@ -1895,7 +2070,7 @@ sub cust_svc { } if ( $opt{'svcdb'} ) { $search{addl_from} = ' LEFT JOIN part_svc USING ( svcpart ) '; - $search{hashref}->{svcdb} = $opt{'svcdb'}; + $search{extra_sql} = ' AND svcdb = '. dbh->quote( $opt{'svcdb'} ); } cluck "cust_pkg->cust_svc called" if $DEBUG > 2; @@ -2029,11 +2204,14 @@ field, I<num_avail>, which specifies the number of available services. sub available_part_svc { my $self = shift; + + my $pkg_quantity = $self->quantity || 1; + grep { $_->num_avail > 0 } map { my $part_svc = $_->part_svc; $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking - $_->quantity - $self->num_cust_svc($_->svcpart); + $pkg_quantity * $_->quantity - $self->num_cust_svc($_->svcpart); # more evil encapsulation breakage if($part_svc->{'Hash'}{'num_avail'} > 0) { @@ -2075,6 +2253,8 @@ sub part_svc { my $self = shift; my %opt = @_; + my $pkg_quantity = $self->quantity || 1; + #XXX some sort of sort order besides numeric by svcpart... my @part_svc = sort { $a->svcpart <=> $b->svcpart } map { my $pkg_svc = $_; @@ -2082,7 +2262,7 @@ sub part_svc { my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart); $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil $part_svc->{'Hash'}{'num_avail'} = - max( 0, $pkg_svc->quantity - $num_cust_svc ); + max( 0, $pkg_quantity * $pkg_svc->quantity - $num_cust_svc ); $part_svc->{'Hash'}{'cust_pkg_svc'} = $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [] unless exists($opt{summarize_size}) && $opt{summarize_size} > 0 @@ -2441,6 +2621,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 @@ -3427,6 +3640,25 @@ sub fcc_477_count { } +=item tax_locationnum_sql + +Returns an SQL expression for the tax location for a package, based +on the settings of 'tax-pkg_address' and 'tax-ship_address'. + +=cut + +sub tax_locationnum_sql { + my $conf = FS::Conf->new; + if ( $conf->exists('tax-pkg_address') ) { + 'cust_pkg.locationnum'; + } + elsif ( $conf->exists('tax-ship_address') ) { + 'cust_main.ship_locationnum'; + } + else { + 'cust_main.bill_locationnum'; + } +} =item location_sql @@ -3445,7 +3677,13 @@ sub location_sql { # '?' placeholders in _location_sql_where my $x = $ornull ? 3 : 2; - my @bill_param = ( ('city')x3, ('county')x$x, ('state')x$x, 'country' ); + my @bill_param = ( + ('district')x3, + ('city')x3, + ('county')x$x, + ('state')x$x, + 'country' + ); my $main_where; my @main_param; @@ -3504,16 +3742,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 6bd8cb837..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 @@ -319,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; @@ -341,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 @@ -831,24 +846,37 @@ 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 = @_; - # some false laziness w/ search/cust_svc.html + my $string = $opt{'search'}; $string =~ s/(^\s+|\s+$)//; #trim leading & trailing whitespace - my @extra_sql = ' ( '. join(' 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 - ). ' ) '; + 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' ); @@ -858,14 +886,16 @@ sub smart_search { ' LEFT JOIN cust_main USING ( custnum )'. ' LEFT JOIN part_svc USING ( svcpart )'; - qsearch({ - 'table' => 'cust_svc', - 'addl_from' => $addl_from, - 'hashref' => {}, - 'extra_sql' => $extra_sql, - }); + ( + 'table' => 'cust_svc', + 'addl_from' => $addl_from, + 'hashref' => {}, + 'extra_sql' => $extra_sql, + ); } +=back + =head1 BUGS Behaviour of changing the svcpart of cust_svc records is undefined and should 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/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_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/balance_age_under.pm b/FS/FS/part_event/Condition/balance_age_under.pm new file mode 100644 index 000000000..ac6d786fc --- /dev/null +++ b/FS/FS/part_event/Condition/balance_age_under.pm @@ -0,0 +1,52 @@ +package FS::part_event::Condition::balance_age_under; + +use strict; +use base qw( FS::part_event::Condition ); + +sub description { 'Customer balance age (under)'; } + +sub option_fields { + ( + 'balance' => { 'label' => 'Balance under (or equal to)', + 'type' => 'money', + 'value' => '0.00', #default + }, + 'age' => { 'label' => 'Age', + 'type' => 'freq', + }, + ); +} + +sub condition { + my($self, $object, %opt) = @_; + + my $cust_main = $self->cust_main($object); + + my $under = $self->option('balance'); + $under = 0 unless length($under); + + my $age = $self->option_age_from('age', $opt{'time'} ); + + $cust_main->balance_date($age) <= $under; +} + +sub condition_sql { + my( $class, $table, %opt ) = @_; + + my $under = $class->condition_sql_option('balance'); + my $age = $class->condition_sql_option_age_from('age', $opt{'time'}); + + my $balance_sql = FS::cust_main->balance_date_sql( $age ); + + "$balance_sql <= CAST( $under AS DECIMAL(10,2) )"; +} + +sub order_sql { + shift->condition_sql_option_age('age'); +} + +sub order_sql_weight { + 10; +} + +1; diff --git a/FS/FS/part_event/Condition/has_referral_custnum.pm b/FS/FS/part_event/Condition/has_referral_custnum.pm index 70c9c7f8b..dee240fec 100644 --- a/FS/FS/part_event/Condition/has_referral_custnum.pm +++ b/FS/FS/part_event/Condition/has_referral_custnum.pm @@ -13,30 +13,49 @@ sub option_fields { 'type' => 'checkbox', 'value' => 'Y', }, + 'check_bal' => { 'label' => 'Check referring custoemr balance', + 'type' => 'checkbox', + 'value' => 'Y', + }, + 'balance' => { 'label' => 'Referring customer balance under (or equal to)', + 'type' => 'money', + 'value' => '0.00', #default + }, + 'age' => { 'label' => 'Referring customer balance age', + 'type' => 'freq', + }, ); } sub condition { - my($self, $object) = @_; + my($self, $object, %opt) = @_; my $cust_main = $self->cust_main($object); if ( $self->option('active') ) { - return 0 unless $cust_main->referral_custnum; - #check for no cust_main for referral_custnum? (deleted?) + return 0 unless $cust_main->referral_custnum_cust_main->status eq 'active'; + } else { + return 0 unless $cust_main->referral_custnum; # ? 1 : 0; + } - $cust_main->referral_custnum_cust_main->status eq 'active'; + return 1 unless $self->option('check_bal'); - } else { + my $referring_cust_main = $cust_main->referral_custnum_cust_main; - $cust_main->referral_custnum; # ? 1 : 0; + #false laziness w/ balance_age_under + my $under = $self->option('balance'); + $under = 0 unless length($under); - } + my $age = $self->option_age_from('age', $opt{'time'} ); + + $referring_cust_main->balance_date($age) <= $under; } +#this is incomplete wrt checking referring customer balances, but that's okay. +# false positives are acceptable here, its just an optimizaiton sub condition_sql { my( $class, $table ) = @_; diff --git a/FS/FS/part_event/Condition/once_percust_every.pm b/FS/FS/part_event/Condition/once_percust_every.pm new file mode 100644 index 000000000..9e2ec1f00 --- /dev/null +++ b/FS/FS/part_event/Condition/once_percust_every.pm @@ -0,0 +1,58 @@ +package FS::part_event::Condition::once_percust_every; + +use strict; +use FS::Record qw( qsearch ); +use FS::part_event; +use FS::cust_event; + +use base qw( FS::part_event::Condition ); + +sub description { "Don't run this event more than once per customer in the specified interval"; } + +sub eventtable_hashref { + { 'cust_main' => 0, + 'cust_bill' => 1, + 'cust_pkg' => 1, + }; +} + +# Runs the event at most "once every X", per customer. + +sub option_fields { + ( + 'run_delay' => { label=>'Interval', type=>'freq', value=>'1m', }, + ); +} + +sub condition { + my($self, $object, %opt) = @_; + + my $obj_pkey = $object->primary_key; + my $obj_table = $object->table; + my $custnum = $object->custnum; + + my @where = ( + "tablenum IN ( SELECT $obj_pkey FROM $obj_table WHERE custnum = $custnum )" + ); + if ( $opt{'cust_event'}->eventnum =~ /^(\d+)$/ ) { + push @where, " eventnum != $1 "; + } + my $extra_sql = ' AND '. join(' AND ', @where); + + my $max_date = $self->option_age_from('run_delay', $opt{'time'}); + + my @existing = qsearch( { + 'table' => 'cust_event', + 'hashref' => { + 'eventpart' => $self->eventpart, + 'status' => { op=>'!=', value=>'failed' }, + '_date' => { op=>'>', value=>$max_date }, + }, + 'extra_sql' => $extra_sql, + } ); + + ! scalar(@existing); + +} + +1; diff --git a/FS/FS/part_event/Condition/pkg_dundate_age.pm b/FS/FS/part_event/Condition/pkg_dundate_age.pm new file mode 100644 index 000000000..75fce1fd2 --- /dev/null +++ b/FS/FS/part_event/Condition/pkg_dundate_age.pm @@ -0,0 +1,43 @@ +package FS::part_event::Condition::pkg_dundate_age; +use base qw( FS::part_event::Condition ); + +use strict; + +sub description { + "Skip until specified # of days before package suspension delay date"; +} + + +sub option_fields { + ( + 'age' => { 'label' => 'Time before suspension delay date', + 'type' => 'freq', + }, + ); +} + +sub eventtable_hashref { + { 'cust_main' => 0, + 'cust_bill' => 0, + 'cust_pkg' => 1, + }; +} + +sub condition { + my($self, $cust_pkg, %opt) = @_; + + my $age = $self->option_age_from('age', $opt{'time'} ); + + $cust_pkg->dundate <= $age; +} + +sub condition_sql { + my( $class, $table, %opt ) = @_; + return 'true' unless $table eq 'cust_pkg'; + + my $age = $class->condition_sql_option_age_from('age', $opt{'time'}); + + "COALESCE($table.dundate,0) <= ". $age; +} + +1; diff --git a/FS/FS/part_export/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 867c19acc..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]'; @@ -42,6 +43,11 @@ my %features = ( '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' }, @@ -80,6 +86,22 @@ END 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('', @_); @@ -245,11 +267,14 @@ sub ns_create_or_update { ### 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' => '', + 'parameters' => $param, 'hour_match' => '*', 'time_frame' => '*', 'activation' => 'now', 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/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/prospect_main.pm b/FS/FS/prospect_main.pm index 5a4048f51..6adc852f8 100644 --- a/FS/FS/prospect_main.pm +++ b/FS/FS/prospect_main.pm @@ -244,7 +244,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 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 64cc3770e..82102697d 100755 --- a/FS/FS/svc_broadband.pm +++ b/FS/FS/svc_broadband.pm @@ -543,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 b395ea605..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; @@ -648,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 @@ -676,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; @@ -739,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' : '*', - } ); + } ); +} + +=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 =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/MANIFEST b/FS/MANIFEST index 0c9cc5452..e7aba204d 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 @@ -634,3 +633,11 @@ 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 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/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/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"; |