X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=cbcf6cc5168c27a68071709c54395495c21681fa;hb=779ca0263837bebf7f0ab6f45cb8381706049658;hp=7866369d757596aca30dac0479fd9b996d983856;hpb=dba94fcedddc2a762bacd478816c41375f3d45e9;p=freeside.git diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 7866369d7..cbcf6cc51 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -16,9 +16,11 @@ BEGIN { } use Digest::MD5 qw(md5_base64); use Date::Format; +use Date::Parse; #use Date::Manip; use String::Approx qw(amatch); use Business::CreditCard 0.28; +use Locale::Country; use FS::UID qw( getotaker dbh ); use FS::Record qw( qsearchs qsearch dbdef ); use FS::Misc qw( send_email ); @@ -43,6 +45,7 @@ use FS::part_pkg; use FS::part_bill_event; use FS::cust_bill_event; use FS::cust_tax_exempt; +use FS::cust_tax_exempt_pkg; use FS::type_pkgs; use FS::payment_gateway; use FS::agent_payment_gateway; @@ -77,7 +80,7 @@ sub _cache { my $self = shift; my ( $hashref, $cache ) = @_; if ( exists $hashref->{'pkgnum'} ) { -# #@{ $self->{'_pkgnum'} } = (); + #@{ $self->{'_pkgnum'} } = (); my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum}); $self->{'_pkgnum'} = $subcache; #push @{ $self->{'_pkgnum'} }, @@ -117,8 +120,6 @@ FS::cust_main - Object methods for cust_main records $error = $record->collect; $error = $record->collect %options; $error = $record->collect 'invoice_time' => $time, - 'batch_card' => 'yes', - 'report_badcard' => 'yes', ; =head1 DESCRIPTION @@ -284,6 +285,8 @@ sub paymask { =item referral_custnum - referring customer number +=item spool_cdr - Enable individual CDR spooling, empty or `Y' + =back =head1 METHODS @@ -334,7 +337,7 @@ Currently available options are: I and I. If I is set, all provisioning jobs will have a dependancy on the supplied jobnum (they will not run until the specific job completes). This can be used to defer provisioning until some action completes (such -as running the customer's credit card sucessfully). +as running the customer's credit card successfully). The I option is deprecated. If I is set true, no provisioning jobs (exports) are scheduled. (You can schedule them later with @@ -478,7 +481,7 @@ Currently available options are: I and I. If I is set, all provisioning jobs will have a dependancy on the supplied jobnum (they will not run until the specific job completes). This can be used to defer provisioning until some action completes (such -as running the customer's credit card sucessfully). +as running the customer's credit card successfully). The I option is deprecated. If I is set true, no provisioning jobs (exports) are scheduled. (You can schedule them later with @@ -921,6 +924,8 @@ sub replace { my $self = shift; my $old = shift; my @param = @_; + warn "$me replace called\n" + if $DEBUG; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -939,10 +944,13 @@ sub replace { $old = qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); } - if ( $self->payby eq 'COMP' && $self->payby ne $old->payby - && $conf->config('users-allow_comp') ) { - return "You are not permitted to create complimentary accounts." - unless grep { $_ eq getotaker } $conf->config('users-allow_comp'); + my $curuser = $FS::CurrentUser::CurrentUser; + if ( $self->payby eq 'COMP' + && $self->payby ne $old->payby + && ! $curuser->access_right('Complimentary customer') + ) + { + return "You are not permitted to create complimentary accounts."; } local($ignore_expired_card) = 1 @@ -1211,7 +1219,12 @@ sub check { if cardtype($self->payinfo) eq "Unknown"; my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref); - return "Banned credit card" if $ban; + if ( $ban ) { + return 'Banned credit card: banned on '. + time2str('%a %h %o at %r', $ban->_date). + ' by '. $ban->otaker. + ' (ban# '. $ban->bannum. ')'; + } if ( defined $self->dbdef_table->column('paycvv') ) { if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) { @@ -1257,13 +1270,23 @@ sub check { my $payinfo = $self->payinfo; $payinfo =~ s/[^\d\@]//g; - $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba'; - $payinfo = "$1\@$2"; + if ( $conf->exists('echeck-nonus') ) { + $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba'; + $payinfo = "$1\@$2"; + } else { + $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba'; + $payinfo = "$1\@$2"; + } $self->payinfo($payinfo); $self->paycvv('') if $self->dbdef_table->column('paycvv'); my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref); - return "Banned ACH account" if $ban; + if ( $ban ) { + return 'Banned ACH account: banned on '. + time2str('%a %h %o at %r', $ban->_date). + ' by '. $ban->otaker. + ' (ban# '. $ban->bannum. ')'; + } } elsif ( $self->payby eq 'LECB' ) { @@ -1282,9 +1305,12 @@ sub check { } elsif ( $self->payby eq 'COMP' ) { - if ( !$self->custnum && $conf->config('users-allow_comp') ) { + my $curuser = $FS::CurrentUser::CurrentUser; + if ( ! $self->custnum + && ! $curuser->access_right('Complimentary customer') + ) + { return "You are not permitted to create complimentary accounts." - unless grep { $_ eq getotaker } $conf->config('users-allow_comp'); } $error = $self->ut_textn('payinfo'); @@ -1305,7 +1331,7 @@ sub check { } if ( $self->paydate eq '' || $self->paydate eq '-' ) { - return "Expriation date required" + return "Expiration date required" unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/; $self->paydate(''); } else { @@ -1336,8 +1362,10 @@ sub check { $self->payname($1); } - $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax; - $self->tax($1); + foreach my $flag (qw( tax spool_cdr )) { + $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag(); + $self->$flag($1); + } $self->otaker(getotaker) unless $self->otaker; @@ -1460,7 +1488,8 @@ sub unsuspend { =item suspend Suspends all unsuspended packages (see L) for this customer. -Always returns a list: an empty list on success or a list of errors. + +Returns a list: an empty list on success or a list of errors. =cut @@ -1472,8 +1501,9 @@ sub suspend { =item suspend_if_pkgpart PKGPART [ , PKGPART ... ] Suspends all unsuspended packages (see L) matching the listed -PKGPARTs (see L). Always returns a list: an empty list on -success or a list of errors. +PKGPARTs (see L). + +Returns a list: an empty list on success or a list of errors. =cut @@ -1488,8 +1518,9 @@ sub suspend_if_pkgpart { =item suspend_unless_pkgpart PKGPART [ , PKGPART ... ] Suspends all unsuspended packages (see L) unless they match the -listed PKGPARTs (see L). Always returns a list: an empty list -on success or a list of errors. +listed PKGPARTs (see L). + +Returns a list: an empty list on success or a list of errors. =cut @@ -1614,17 +1645,30 @@ sub bill { $self->select_for_update; #mutex + #create a new invoice + #(we'll remove it later if it doesn't actually need to be generated [contains + # no line items] and we're inside a transaciton so nothing else will see it) + my $cust_bill = new FS::cust_bill ( { + 'custnum' => $self->custnum, + '_date' => $time, + #'charged' => $charged, + 'charged' => 0, + } ); + $error = $cust_bill->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "can't create invoice for customer #". $self->custnum. ": $error"; + } + my $invnum = $cust_bill->invnum; + + ### # find the packages which are due for billing, find out how much they are # & generate invoice database. - - my( $total_setup, $total_recur ) = ( 0, 0 ); - #my( $taxable_setup, $taxable_recur ) = ( 0, 0 ); - my @cust_bill_pkg = (); - #my $tax = 0;## - #my $taxable_charged = 0;## - #my $charged = 0;## + ### + my( $total_setup, $total_recur ) = ( 0, 0 ); my %tax; + my @precommit_hooks = (); foreach my $cust_pkg ( qsearch('cust_pkg', { 'custnum' => $self->custnum } ) @@ -1646,7 +1690,10 @@ sub bill { my @details = (); + ### # bill setup + ### + my $setup = 0; if ( !$cust_pkg->setup || $options{'resetup'} ) { @@ -1655,13 +1702,16 @@ sub bill { $setup = eval { $cust_pkg->calc_setup( $time ) }; if ( $@ ) { $dbh->rollback if $oldAutoCommit; - return $@; + return "$@ running calc_setup for $cust_pkg\n"; } $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup; } - #bill recurring fee + ### + # bill recurring fee + ### + my $recur = 0; my $sdate; if ( $part_pkg->getfield('freq') ne '0' && @@ -1674,10 +1724,13 @@ sub bill { # XXX shared with $recur_prog $sdate = $cust_pkg->bill || $cust_pkg->setup || $time; - $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details ) }; + #over two params! lets at least switch to a hashref for the rest... + my %param = ( 'precommit_hooks' => \@precommit_hooks, ); + + $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) }; if ( $@ ) { $dbh->rollback if $oldAutoCommit; - return $@; + return "$@ running calc_recur for $cust_pkg\n"; } #change this bit to use Date::Manip? CAREFUL with timezones (see @@ -1716,6 +1769,10 @@ sub bill { warn "\$recur is undefined" unless defined($recur); warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill); + ### + # If $cust_pkg has been modified, update it and create cust_bill_pkg records + ### + if ( $cust_pkg->modified ) { warn " package ". $cust_pkg->pkgnum. " modified; updating\n" @@ -1737,10 +1794,13 @@ sub bill { $dbh->rollback if $oldAutoCommit; return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum; } + if ( $setup != 0 || $recur != 0 ) { - warn " charges (setup=$setup, recur=$recur); queueing line items\n" + + warn " charges (setup=$setup, recur=$recur); adding line items\n" if $DEBUG > 1; my $cust_bill_pkg = new FS::cust_bill_pkg ({ + 'invnum' => $invnum, 'pkgnum' => $cust_pkg->pkgnum, 'setup' => $setup, 'recur' => $recur, @@ -1748,35 +1808,40 @@ sub bill { 'edate' => $cust_pkg->bill, 'details' => \@details, }); - push @cust_bill_pkg, $cust_bill_pkg; + $error = $cust_bill_pkg->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "can't create invoice line item for invoice #$invnum: $error"; + } $total_setup += $setup; $total_recur += $recur; + ### + # handle taxes + ### + unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) { - my @taxes = qsearch( 'cust_main_county', { - 'state' => $self->state, - 'county' => $self->county, - 'country' => $self->country, - 'taxclass' => $part_pkg->taxclass, - } ); + my $prefix = + ( $conf->exists('tax-ship_address') && length($self->ship_last) ) + ? 'ship_' + : ''; + my %taxhash = map { $_ => $self->get("$prefix$_") } + qw( state county country ); + + $taxhash{'taxclass'} = $part_pkg->taxclass; + + my @taxes = qsearch( 'cust_main_county', \%taxhash ); + unless ( @taxes ) { - @taxes = qsearch( 'cust_main_county', { - 'state' => $self->state, - 'county' => $self->county, - 'country' => $self->country, - 'taxclass' => '', - } ); + $taxhash{'taxclass'} = ''; + @taxes = qsearch( 'cust_main_county', \%taxhash ); } #one more try at a whole-country tax rate unless ( @taxes ) { - @taxes = qsearch( 'cust_main_county', { - 'state' => '', - 'county' => '', - 'country' => $self->country, - 'taxclass' => '', - } ); + $taxhash{$_} = '' foreach qw( state county ); + @taxes = qsearch( 'cust_main_county', \%taxhash ); } # maybe eliminate this entirely, along with all the 0% records @@ -1784,8 +1849,10 @@ sub bill { $dbh->rollback if $oldAutoCommit; return "fatal: can't find tax rate for state/county/country/taxclass ". - join('/', ( map $self->$_(), qw(state county country) ), - $part_pkg->taxclass ). "\n"; + join('/', ( map $self->get("$prefix$_"), + qw(state county country) + ), + $part_pkg->taxclass ). "\n"; } foreach my $tax ( @taxes ) { @@ -1800,7 +1867,8 @@ sub bill { next unless $taxable_charged; if ( $tax->exempt_amount && $tax->exempt_amount > 0 ) { - my ($mon,$year) = (localtime($sdate) )[4,5]; + #my ($mon,$year) = (localtime($sdate) )[4,5]; + my ($mon,$year) = (localtime( $sdate || $cust_bill->_date ) )[4,5]; $mon++; my $freq = $part_pkg->freq || 1; if ( $freq !~ /(\d+)$/ ) { @@ -1808,40 +1876,74 @@ sub bill { return "daily/weekly package definitions not (yet?)". " compatible with monthly tax exemptions"; } - my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq ); + my $taxable_per_month = + sprintf("%.2f", $taxable_charged / $freq ); + + #call the whole thing off if this customer has any old + #exemption records... + my @cust_tax_exempt = + qsearch( 'cust_tax_exempt' => { custnum=> $self->custnum } ); + if ( @cust_tax_exempt ) { + $dbh->rollback if $oldAutoCommit; + return + 'this customer still has old-style tax exemption records; '. + 'run bin/fs-migrate-cust_tax_exempt?'; + } + foreach my $which_month ( 1 .. $freq ) { - my %hash = ( - 'custnum' => $self->custnum, - 'taxnum' => $tax->taxnum, - 'year' => 1900+$year, - 'month' => $mon++, - ); - #until ( $mon < 12 ) { $mon -= 12; $year++; } - until ( $mon < 13 ) { $mon -= 12; $year++; } - my $cust_tax_exempt = - qsearchs('cust_tax_exempt', \%hash) - || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } ); - my $remaining_exemption = sprintf("%.2f", - $tax->exempt_amount - $cust_tax_exempt->amount ); + + #maintain the new exemption table now + my $sql = " + SELECT SUM(amount) + FROM cust_tax_exempt_pkg + LEFT JOIN cust_bill_pkg USING ( billpkgnum ) + LEFT JOIN cust_bill USING ( invnum ) + WHERE custnum = ? + AND taxnum = ? + AND year = ? + AND month = ? + "; + my $sth = dbh->prepare($sql) or do { + $dbh->rollback if $oldAutoCommit; + return "fatal: can't lookup exising exemption: ". dbh->errstr; + }; + $sth->execute( + $self->custnum, + $tax->taxnum, + 1900+$year, + $mon, + ) or do { + $dbh->rollback if $oldAutoCommit; + return "fatal: can't lookup exising exemption: ". dbh->errstr; + }; + my $existing_exemption = $sth->fetchrow_arrayref->[0] || 0; + + my $remaining_exemption = + $tax->exempt_amount - $existing_exemption; if ( $remaining_exemption > 0 ) { my $addl = $remaining_exemption > $taxable_per_month ? $taxable_per_month : $remaining_exemption; $taxable_charged -= $addl; - my $new_cust_tax_exempt = new FS::cust_tax_exempt ( { - $cust_tax_exempt->hash, - 'amount' => - sprintf("%.2f", $cust_tax_exempt->amount + $addl), + + my $cust_tax_exempt_pkg = new FS::cust_tax_exempt_pkg ( { + 'billpkgnum' => $cust_bill_pkg->billpkgnum, + 'taxnum' => $tax->taxnum, + 'year' => 1900+$year, + 'month' => $mon, + 'amount' => sprintf("%.2f", $addl ), } ); - $error = $new_cust_tax_exempt->exemptnum - ? $new_cust_tax_exempt->replace($cust_tax_exempt) - : $new_cust_tax_exempt->insert; + $error = $cust_tax_exempt_pkg->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "fatal: can't update cust_tax_exempt: $error"; + return "fatal: can't insert cust_tax_exempt_pkg: $error"; } - } # if $remaining_exemption > 0 + + #++ + $mon++; + #until ( $mon < 12 ) { $mon -= 12; $year++; } + until ( $mon < 13 ) { $mon -= 12; $year++; } } #foreach $which_month @@ -1863,85 +1965,50 @@ sub bill { } #foreach my $cust_pkg - my $charged = sprintf( "%.2f", $total_setup + $total_recur ); -# my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur ); - - unless ( @cust_bill_pkg ) { #don't create invoices with no line items + unless ( $cust_bill->cust_bill_pkg ) { + $cust_bill->delete; #don't create an invoice w/o line items $dbh->commit or die $dbh->errstr if $oldAutoCommit; return ''; - } - -# unless ( $self->tax =~ /Y/i -# || $self->payby eq 'COMP' -# || $taxable_charged == 0 ) { -# my $cust_main_county = qsearchs('cust_main_county',{ -# 'state' => $self->state, -# 'county' => $self->county, -# 'country' => $self->country, -# } ) or die "fatal: can't find tax rate for state/county/country ". -# $self->state. "/". $self->county. "/". $self->country. "\n"; -# my $tax = sprintf( "%.2f", -# $taxable_charged * ( $cust_main_county->getfield('tax') / 100 ) -# ); - - if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema - - foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) { - my $tax = sprintf("%.2f", $tax{$taxname} ); - $charged = sprintf( "%.2f", $charged+$tax ); - - my $cust_bill_pkg = new FS::cust_bill_pkg ({ - 'pkgnum' => 0, - 'setup' => $tax, - 'recur' => 0, - 'sdate' => '', - 'edate' => '', - 'itemdesc' => $taxname, - }); - push @cust_bill_pkg, $cust_bill_pkg; - } + } + + my $charged = sprintf( "%.2f", $total_setup + $total_recur ); + + foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) { + my $tax = sprintf("%.2f", $tax{$taxname} ); + $charged = sprintf( "%.2f", $charged+$tax ); - } else { #1.4 schema - - my $tax = 0; - foreach ( values %tax ) { $tax += $_ }; - $tax = sprintf("%.2f", $tax); - if ( $tax > 0 ) { - $charged = sprintf( "%.2f", $charged+$tax ); - - my $cust_bill_pkg = new FS::cust_bill_pkg ({ - 'pkgnum' => 0, - 'setup' => $tax, - 'recur' => 0, - 'sdate' => '', - 'edate' => '', - }); - push @cust_bill_pkg, $cust_bill_pkg; + my $cust_bill_pkg = new FS::cust_bill_pkg ({ + 'invnum' => $invnum, + 'pkgnum' => 0, + 'setup' => $tax, + 'recur' => 0, + 'sdate' => '', + 'edate' => '', + 'itemdesc' => $taxname, + }); + $error = $cust_bill_pkg->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "can't create invoice line item for invoice #$invnum: $error"; } + $total_setup += $tax; } - my $cust_bill = new FS::cust_bill ( { - 'custnum' => $self->custnum, - '_date' => $time, - 'charged' => $charged, - } ); - $error = $cust_bill->insert; + $cust_bill->charged( sprintf( "%.2f", $total_setup + $total_recur ) ); + $error = $cust_bill->replace; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "can't create invoice for customer #". $self->custnum. ": $error"; + return "can't update charged for invoice #$invnum: $error"; } - my $invnum = $cust_bill->invnum; - my $cust_bill_pkg; - foreach $cust_bill_pkg ( @cust_bill_pkg ) { - #warn $invnum; - $cust_bill_pkg->invnum($invnum); - $error = $cust_bill_pkg->insert; - if ( $error ) { + foreach my $hook ( @precommit_hooks ) { + eval { + &{$hook}; #($self) ? + }; + if ( $@ ) { $dbh->rollback if $oldAutoCommit; - return "can't create invoice line item for customer #". $self->custnum. - ": $error"; + return "$@ running precommit hook $hook\n"; } } @@ -1974,17 +2041,11 @@ for conversion functions. retry - Retry card/echeck/LEC transactions even when not scheduled by invoice events. -retry_card - Deprecated alias for 'retry' - -batch_card - This option is deprecated. See the invoice events web interface -to control whether cards are batched or run against a realtime gateway. - -report_badcard - This option is deprecated. - -force_print - This option is deprecated; see the invoice events web interface. - quiet - set true to surpress email card/ACH decline notices. +freq - "1d" for the traditional, daily events (the default), or "1m" for the +new monthly events + =cut sub collect { @@ -2025,6 +2086,13 @@ sub collect { } } + my $extra_sql = ''; + if ( defined $options{'freq'} && $options{'freq'} eq '1m' ) { + $extra_sql = " AND freq = '1m' "; + } else { + $extra_sql = " AND ( freq = '1d' OR freq IS NULL OR freq = '' ) "; + } + foreach my $cust_bill ( $self->open_cust_bill ) { # don't try to charge for the same invoice if it's already in a batch @@ -2046,8 +2114,12 @@ sub collect { 'status' => 'done', } ) } - qsearch('part_bill_event', { 'payby' => $self->payby, - 'disabled' => '', } ) + qsearch( { + 'table' => 'part_bill_event', + 'hashref' => { 'payby' => $self->payby, + 'disabled' => '', }, + 'extra_sql' => $extra_sql, + } ) ) { last if $cust_bill->owed <= 0 # don't run subsequent events if owed<=0 @@ -2181,7 +2253,7 @@ if set, will override the value from the customer record. I is a free-text field passed to the gateway. It defaults to "Internet services". -If an I is specified, this payment (if sucessful) is applied to the +If an I is specified, this payment (if successful) is applied to the specified invoice. If you don't specify an I you might want to call the B method. @@ -2435,7 +2507,7 @@ sub realtime_bop { $capture->submit(); unless ( $capture->is_success ) { - my $e = "Authorization sucessful but capture failed, custnum #". + my $e = "Authorization successful but capture failed, custnum #". $self->custnum. ': '. $capture->result_code. ": ". $capture->error_message; warn $e; @@ -2615,7 +2687,7 @@ gateway is attempted. #I, I and I are also available. Any of these options, #if set, will override the value from the customer record. -#If an I is specified, this payment (if sucessful) is applied to the +#If an I is specified, this payment (if successful) is applied to the #specified invoice. If you don't specify an I you might want to #call the B method. @@ -3121,6 +3193,7 @@ This interface may change in the future. sub invoicing_list { my( $self, $arrayref ) = @_; + if ( $arrayref ) { my @cust_main_invoice; if ( $self->custnum ) { @@ -3155,12 +3228,14 @@ sub invoicing_list { warn $error if $error; } } + if ( $self->custnum ) { map { $_->address } qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } ); } else { (); } + } =item check_invoicing_list ARRAYREF @@ -3238,6 +3313,18 @@ sub invoicing_list_addpost { $self->invoicing_list(\@invoicing_list); } +=item invoicing_list_emailonly + +Returns the list of email invoice recipients (invoicing_list without non-email +destinations such as POST and FAX). + +=cut + +sub invoicing_list_emailonly { + my $self = shift; + grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list; +} + =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ] Returns an array of customers referred by this customer (referral_custnum set @@ -3535,6 +3622,17 @@ sub ship_contact { : $self->contact; } +=item country_full + +Returns this customer's full country name + +=cut + +sub country_full { + my $self = shift; + code2country($self->country); +} + =item status Returns a status string for this customer, currently: @@ -3545,6 +3643,8 @@ Returns a status string for this customer, currently: =item active - One or more recurring packages is active +=item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled) + =item suspended - All non-cancelled recurring packages are suspended =item cancelled - All recurring packages are cancelled @@ -3555,7 +3655,7 @@ Returns a status string for this customer, currently: sub status { my $self = shift; - for my $status (qw( prospect active suspended cancelled )) { + for my $status (qw( prospect active inactive suspended cancelled )) { my $method = $status.'_sql'; my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g; my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr; @@ -3570,14 +3670,18 @@ Returns a hex triplet color string for this customer's status. =cut -my %statuscolor = ( - 'prospect' => '000000', - 'active' => '00CC00', - 'suspended' => 'FF9900', - 'cancelled' => 'FF0000', -); + sub statuscolor { my $self = shift; + + my %statuscolor = ( + 'prospect' => '7e0079', #'000000', #black? naw, purple + 'active' => '00CC00', #green + 'inactive' => '0000CC', #blue + 'suspended' => 'FF9900', #yellow + 'cancelled' => 'FF0000', #red + ); + $statuscolor{$self->status}; } @@ -3594,25 +3698,40 @@ with no packages ever ordered) =cut +use vars qw($select_count_pkgs); +$select_count_pkgs = + "SELECT COUNT(*) FROM cust_pkg + WHERE cust_pkg.custnum = cust_main.custnum"; + sub prospect_sql { " - 0 = ( SELECT COUNT(*) FROM cust_pkg - WHERE cust_pkg.custnum = cust_main.custnum - ) + 0 = ( $select_count_pkgs ) "; } =item active_sql -Returns an SQL expression identifying active cust_main records. +Returns an SQL expression identifying active cust_main records (customers with +no active recurring packages, but otherwise unsuspended/uncancelled). =cut sub active_sql { " - 0 < ( SELECT COUNT(*) FROM cust_pkg - WHERE cust_pkg.custnum = cust_main.custnum - AND ". FS::cust_pkg->active_sql. " + 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) "; } +=item inactive_sql + +Returns an SQL expression identifying inactive cust_main records (customers with +active recurring packages). + +=cut + +sub inactive_sql { " + 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) + AND + 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) +"; } + =item susp_sql =item suspended_sql @@ -3620,23 +3739,12 @@ Returns an SQL expression identifying suspended cust_main records. =cut -#my $recurring_sql = FS::cust_pkg->recurring_sql; -my $recurring_sql = " - '0' != ( select freq from part_pkg - where cust_pkg.pkgpart = part_pkg.pkgpart ) -"; sub suspended_sql { susp_sql(@_); } sub susp_sql { " - 0 < ( SELECT COUNT(*) FROM cust_pkg - WHERE cust_pkg.custnum = cust_main.custnum - AND $recurring_sql - AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) - ) - AND 0 = ( SELECT COUNT(*) FROM cust_pkg - WHERE cust_pkg.custnum = cust_main.custnum - AND ". FS::cust_pkg->active_sql. " - ) + 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) + AND + 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) "; } =item cancel_sql @@ -3647,15 +3755,38 @@ Returns an SQL expression identifying cancelled cust_main records. =cut sub cancelled_sql { cancel_sql(@_); } -sub cancel_sql { " - 0 < ( SELECT COUNT(*) FROM cust_pkg - WHERE cust_pkg.custnum = cust_main.custnum - ) - AND 0 = ( SELECT COUNT(*) FROM cust_pkg - WHERE cust_pkg.custnum = cust_main.custnum - AND $recurring_sql - AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) - ) +sub cancel_sql { + + my $recurring_sql = FS::cust_pkg->recurring_sql; + #my $recurring_sql = " + # '0' != ( select freq from part_pkg + # where cust_pkg.pkgpart = part_pkg.pkgpart ) + #"; + + " + 0 < ( $select_count_pkgs ) + AND 0 = ( $select_count_pkgs AND $recurring_sql + AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) + ) + "; +} + +=item uncancel_sql +=item uncancelled_sql + +Returns an SQL expression identifying un-cancelled cust_main records. + +=cut + +sub uncancelled_sql { uncancel_sql(@_); } +sub uncancel_sql { " + ( 0 < ( $select_count_pkgs + AND ( cust_pkg.cancel IS NULL + OR cust_pkg.cancel = 0 + ) + ) + OR 0 = ( $select_count_pkgs ) + ) "; } =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ] @@ -3716,11 +3847,18 @@ Returns a (possibly empty) array of FS::cust_main objects. sub smart_search { my %options = @_; my $search = delete $options{'search'}; - my @cust_main = (); + #here is the agent virtualization + my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql; + + my @cust_main = (); if ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search - push @cust_main, qsearch('cust_main', { 'custnum' => $1, %options } ); + push @cust_main, qsearch( { + 'table' => 'cust_main', + 'hashref' => { 'custnum' => $1, %options }, + 'extra_sql' => " AND $agentnums_sql", #agent virtualization + } ); } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { #value search @@ -3734,50 +3872,65 @@ sub smart_search { if defined dbdef->table('cust_main')->column('ship_last'); $sql .= ' )'; - push @cust_main, qsearch( 'cust_main', \%options, '', $sql ); + push @cust_main, qsearch( { + 'table' => 'cust_main', + 'hashref' => \%options, + 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization + } ); unless ( @cust_main ) { #no exact match, trying substring/fuzzy #still some false laziness w/ search/cust_main.cgi #substring - push @cust_main, qsearch( 'cust_main', - { 'last' => { 'op' => 'ILIKE', - 'value' => "%$q_value%" }, - %options, - } - ); - push @cust_main, qsearch( 'cust_main', - { 'ship_last' => { 'op' => 'ILIKE', - 'value' => "%$q_value%" }, - %options, - - } - ) + push @cust_main, qsearch( { + 'table' => 'cust_main', + 'hashref' => { 'last' => { 'op' => 'ILIKE', + 'value' => "%$value%" }, + %options, + }, + 'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton + } ); + push @cust_main, qsearch( { + 'table' => 'cust_main', + 'hashref' => { 'ship_last' => { 'op' => 'ILIKE', + 'value' => "%$value%" }, + %options, + }, + 'extra_sql' => " AND $agentnums_sql", #agent virtualization + } ) if defined dbdef->table('cust_main')->column('ship_last'); - push @cust_main, qsearch( 'cust_main', - { 'company' => { 'op' => 'ILIKE', - 'value' => "%$q_value%" }, - %options, - } - ); - push @cust_main, qsearch( 'cust_main', - { 'ship_company' => { 'op' => 'ILIKE', - 'value' => "%$q_value%" }, - %options, - } - ) + push @cust_main, qsearch( { + 'table' => 'cust_main', + 'hashref' => { 'company' => { 'op' => 'ILIKE', + 'value' => "%$value%" }, + %options, + }, + 'extra_sql' => " AND $agentnums_sql", #agent virtualization + } ); + push @cust_main, qsearch( { + 'table' => 'cust_main', + 'hashref' => { 'ship_company' => { 'op' => 'ILIKE', + 'value' => "%$value%" }, + %options, + }, + 'extra_sql' => " AND $agentnums_sql", #agent virtualization + } ) if defined dbdef->table('cust_main')->column('ship_last'); #fuzzy push @cust_main, FS::cust_main->fuzzy_search( - { 'last' => $value }, - \%options, + { 'last' => $value }, #fuzzy hashref + \%options, #hashref + '', #select + " AND $agentnums_sql", #extra_sql #agent virtualization ); push @cust_main, FS::cust_main->fuzzy_search( - { 'company' => $value }, - \%options, + { 'company' => $value }, #fuzzy hashref + \%options, #hashref + '', #select + " AND $agentnums_sql", #extra_sql #agent virtualization ); } @@ -3807,6 +3960,7 @@ sub rebuild_fuzzyfiles { use Fcntl qw(:flock); my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; + mkdir $dir, 0700 unless -d $dir; #last @@ -3934,8 +4088,6 @@ sub batch_import { my $pkgpart = $param->{pkgpart}; my @fields = @{$param->{fields}}; - eval "use Date::Parse;"; - die $@ if $@; eval "use Text::CSV_XS;"; die $@ if $@; @@ -4041,8 +4193,6 @@ sub batch_charge { my $fh = $param->{filehandle}; my @fields = @{$param->{fields}}; - eval "use Date::Parse;"; - die $@ if $@; eval "use Text::CSV_XS;"; die $@ if $@;