}
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 );
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'} },
$error = $record->collect;
$error = $record->collect %options;
$error = $record->collect 'invoice_time' => $time,
- 'batch_card' => 'yes',
- 'report_badcard' => 'yes',
;
=head1 DESCRIPTION
=item referral_custnum - referring customer number
+=item spool_cdr - Enable individual CDR spooling, empty or `Y'
+
=back
=head1 METHODS
If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
on the supplied jobnum (they will not run until the specific job completes).
This can be used to defer provisioning until some action completes (such
-as running the customer's credit card sucessfully).
+as running the customer's credit card successfully).
The I<noexport> option is deprecated. If I<noexport> is set true, no
provisioning jobs (exports) are scheduled. (You can schedule them later with
If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
on the supplied jobnum (they will not run until the specific job completes).
This can be used to defer provisioning until some action completes (such
-as running the customer's credit card sucessfully).
+as running the customer's credit card successfully).
The I<noexport> option is deprecated. If I<noexport> is set true, no
provisioning jobs (exports) are scheduled. (You can schedule them later with
my $self = shift;
my $old = shift;
my @param = @_;
+ warn "$me replace called\n"
+ if $DEBUG;
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
$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
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)) {
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' ) {
} 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');
}
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 {
$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;
my( $total_setup, $total_recur ) = ( 0, 0 );
my %tax;
+ my @precommit_hooks = ();
foreach my $cust_pkg (
qsearch('cust_pkg', { 'custnum' => $self->custnum } )
$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;
# 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
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
$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 ) {
$dbh->rollback if $oldAutoCommit;
return "fatal: can't lookup exising exemption: ". dbh->errstr;
};
- my $existing_exemption = $sth->fetchrow_arrayref->[0];
+ my $existing_exemption = $sth->fetchrow_arrayref->[0] || 0;
my $remaining_exemption =
$tax->exempt_amount - $existing_exemption;
$dbh->rollback if $oldAutoCommit;
return "can't update charged for invoice #$invnum: $error";
}
+
+ foreach my $hook ( @precommit_hooks ) {
+ eval {
+ &{$hook}; #($self) ?
+ };
+ if ( $@ ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "$@ running precommit hook $hook\n";
+ }
+ }
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
''; #no error
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 {
}
}
+ 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
'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
I<description> is a free-text field passed to the gateway. It defaults to
"Internet services".
-If an I<invnum> is specified, this payment (if sucessful) is applied to the
+If an I<invnum> is specified, this payment (if successful) is applied to the
specified invoice. If you don't specify an I<invnum> you might want to
call the B<apply_payments> method.
$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;
#I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
#if set, will override the value from the customer record.
-#If an I<invnum> is specified, this payment (if sucessful) is applied to the
+#If an I<invnum> is specified, this payment (if successful) is applied to the
#specified invoice. If you don't specify an I<invnum> you might want to
#call the B<apply_payments> method.
sub invoicing_list {
my( $self, $arrayref ) = @_;
+
if ( $arrayref ) {
my @cust_main_invoice;
if ( $self->custnum ) {
warn $error if $error;
}
}
+
if ( $self->custnum ) {
map { $_->address }
qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
} else {
();
}
+
}
=item check_invoicing_list ARRAYREF
$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
: $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:
=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
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;
=cut
-my %statuscolor = (
- 'prospect' => '000000',
- 'active' => '00CC00',
- 'suspended' => 'FF9900',
- 'cancelled' => 'FF0000',
+use vars qw(%statuscolor);
+%statuscolor = (
+ 'prospect' => '7e0079', #'000000', #black? naw, purple
+ 'active' => '00CC00', #green
+ 'inactive' => '0000CC', #blue
+ 'suspended' => 'FF9900', #yellow
+ 'cancelled' => 'FF0000', #red
);
+
sub statuscolor {
my $self = shift;
$statuscolor{$self->status};
=cut
+use vars qw($select_count_pkgs);
+$select_count_pkgs =
+ "SELECT COUNT(*) FROM cust_pkg
+ WHERE cust_pkg.custnum = cust_main.custnum";
+
+sub select_count_pkgs_sql {
+ $select_count_pkgs;
+}
+
sub prospect_sql { "
- 0 = ( SELECT COUNT(*) 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
=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
=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 ]
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
my $value = lc($1);
+
+ # remove "(Last, First)" in "Company (Last, First"), otherwise the
+ # full strings the browser remembers won't work
+ $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
+
my $q_value = dbh->quote($value);
#exact
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
);
}
+ #eliminate duplicates
+ my %saw = ();
+ @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
+
}
@cust_main;
use Fcntl qw(:flock);
my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
+ mkdir $dir, 0700 unless -d $dir;
#last
my $pkgpart = $param->{pkgpart};
my @fields = @{$param->{fields}};
- eval "use Date::Parse;";
- die $@ if $@;
eval "use Text::CSV_XS;";
die $@ if $@;
my $fh = $param->{filehandle};
my @fields = @{$param->{fields}};
- eval "use Date::Parse;";
- die $@ if $@;
eval "use Text::CSV_XS;";
die $@ if $@;
projects / freeside.git / blobdiff