scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
}
+=item location_hash
+
+Returns a list of key/value pairs, with the following keys: address1, adddress2,
+city, county, state, zip, country. The shipping address is used if present.
+
+=cut
+
+#geocode? dependent on tax-ship_address config, not available in cust_location
+#mostly. not yet then.
+
+sub location_hash {
+ my $self = shift;
+ my $prefix = $self->has_ship_address ? 'ship_' : '';
+
+ map { $_ => $self->get($prefix.$_) }
+ qw( address1 address2 city county state zip country geocode );
+ #fields that cust_location has
+}
+
=item all_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
Returns all packages (see L<FS::cust_pkg>) for this customer.
qsearch('cust_location', { 'custnum' => $self->custnum } );
}
+=item location_label [ OPTION => VALUE ... ]
+
+Returns the label of the service location (see analog in L<FS::cust_location>) for this customer.
+
+Options are
+
+=over 4
+
+=item join_string
+
+used to separate the address elements (defaults to ', ')
+
+=item escape_function
+
+a callback used for escaping the text of the address elements
+
+=back
+
+=cut
+
+# false laziness with FS::cust_location::line
+
+sub location_label {
+ my $self = shift;
+ my %opt = @_;
+
+ my $separator = $opt{join_string} || ', ';
+ my $escape = $opt{escape_function} || sub{ shift };
+ my $line = '';
+ my $cydefault = FS::conf->new->config('countrydefault') || 'US';
+ my $prefix = length($self->ship_last) ? 'ship_' : '';
+
+ my $notfirst = 0;
+ foreach (qw ( address1 address2 ) ) {
+ my $method = "$prefix$_";
+ $line .= ($notfirst ? $separator : ''). &$escape($self->$method)
+ if $self->$method;
+ $notfirst++;
+ }
+ $notfirst = 0;
+ foreach (qw ( city county state zip ) ) {
+ my $method = "$prefix$_";
+ if ( $self->$method ) {
+ $line .= ' (' if $method eq 'county';
+ $line .= ($notfirst ? ' ' : $separator). &$escape($self->$method);
+ $line .= ' )' if $method eq 'county';
+ $notfirst++;
+ }
+ }
+ $line .= $separator. &$escape(code2country($self->country))
+ if $self->country ne $cydefault;
+
+ $line;
+}
+
=item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
# This should be generalized to use config options to determine order.
sub sort_packages {
+ my $locationsort = ( $a->locationnum || 0 ) <=> ( $b->locationnum || 0 );
+ return $locationsort if $locationsort;
+
if ( $a->get('cancel') xor $b->get('cancel') ) {
return -1 if $b->get('cancel');
return 1 if $a->get('cancel');
=item bill_and_collect
Cancels and suspends any packages due, generates bills, applies payments and
-cred
+credits, and applies collection events to run cards, send bills and notices,
+etc.
-Warns on errors (Does not currently: If there is an error, returns the error, otherwise returns false.)
+By default, warns on errors and continues with the next operation (but see the
+"fatal" flag below).
Options are passed as name-value pairs. Currently available options are:
If set true, re-charges setup fees.
+=item fatal
+
+If set any errors prevent subsequent operations from continusing. If set
+specifically to "return", returns the error (or false, if there is no error).
+Any other true value causes errors to die.
+
=item debug
Debugging level. Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
sub bill_and_collect {
my( $self, %options ) = @_;
+ my $error;
+
#$options{actual_time} not $options{time} because freeside-daily -d is for
#pre-printing invoices
- $self->cancel_expired_pkgs( $options{actual_time} );
- $self->suspend_adjourned_pkgs( $options{actual_time} );
- my $error = $self->bill( %options );
- warn "Error billing, custnum ". $self->custnum. ": $error" if $error;
+ $options{'actual_time'} ||= time;
- $self->apply_payments_and_credits;
+ $error = $self->cancel_expired_pkgs( $options{actual_time} );
+ if ( $error ) {
+ $error = "Error expiring custnum ". $self->custnum. ": $error";
+ if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
+ elsif ( $options{fatal} ) { die $error; }
+ else { warn $error; }
+ }
+
+ $error = $self->suspend_adjourned_pkgs( $options{actual_time} );
+ if ( $error ) {
+ $error = "Error adjourning custnum ". $self->custnum. ": $error";
+ if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
+ elsif ( $options{fatal} ) { die $error; }
+ else { warn $error; }
+ }
+
+ $error = $self->bill( %options );
+ if ( $error ) {
+ $error = "Error billing custnum ". $self->custnum. ": $error";
+ if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
+ elsif ( $options{fatal} ) { die $error; }
+ else { warn $error; }
+ }
+
+ $error = $self->apply_payments_and_credits;
+ if ( $error ) {
+ $error = "Error applying custnum ". $self->custnum. ": $error";
+ if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
+ elsif ( $options{fatal} ) { die $error; }
+ else { warn $error; }
+ }
unless ( $conf->exists('cancelled_cust-noevents')
&& ! $self->num_ncancelled_pkgs
) {
-
$error = $self->collect( %options );
- warn "Error collecting, custnum". $self->custnum. ": $error" if $error;
-
+ if ( $error ) {
+ $error = "Error collecting custnum ". $self->custnum. ": $error";
+ if ($options{fatal} && $options{fatal} eq 'return') { return $error; }
+ elsif ($options{fatal} ) { die $error; }
+ else { warn $error; }
+ }
}
+ '';
+
}
sub cancel_expired_pkgs {
- my ( $self, $time ) = @_;
+ my ( $self, $time, %options ) = @_;
my @cancel_pkgs = $self->ncancelled_pkgs( {
'extra_sql' => " AND expire IS NOT NULL AND expire > 0 AND expire <= $time "
} );
+ my @errors = ();
+
foreach my $cust_pkg ( @cancel_pkgs ) {
my $cpr = $cust_pkg->last_cust_pkg_reason('expire');
my $error = $cust_pkg->cancel($cpr ? ( 'reason' => $cpr->reasonnum,
)
: ()
);
- warn "Error cancelling expired pkg ". $cust_pkg->pkgnum.
- " for custnum ". $self->custnum. ": $error"
- if $error;
+ push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
}
+ scalar(@errors) ? join(' / ', @errors) : '';
+
}
sub suspend_adjourned_pkgs {
- my ( $self, $time ) = @_;
+ my ( $self, $time, %options ) = @_;
my @susp_pkgs = $self->ncancelled_pkgs( {
'extra_sql' =>
}
@susp_pkgs;
+ my @errors = ();
+
foreach my $cust_pkg ( @susp_pkgs ) {
my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
)
: ()
);
-
- warn "Error suspending package ". $cust_pkg->pkgnum.
- " for custnum ". $self->custnum. ": $error"
- if $error;
+ push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
}
+ scalar(@errors) ? join(' / ', @errors) : '';
+
}
=item bill OPTIONS
=item invoice_terms
-Options terms to be printed on this invocice. Otherwise, customer-specific
+Optional terms to be printed on this invoice. Otherwise, customer-specific
terms or the default terms are used.
=back
warn " invalid conditions not eliminated with condition_sql:\n".
join('', map " $_: ".$unsat{$_}."\n", keys %unsat )
- if $DEBUG; # > 1;
+ if keys %unsat && $DEBUG; # > 1;
##
# insert
if set, will override the value from the customer record.
I<description> is a free-text field passed to the gateway. It defaults to
-"Internet services".
+the value defined by the business-onlinepayment-description configuration
+option, or "Internet services" if that is unset.
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
warn " $_ => $options{$_}\n" foreach keys %options;
}
- $options{'description'} ||= 'Internet services';
+ return "Amount must be greater than 0" unless $amount > 0;
+
+ unless ( $options{'description'} ) {
+ if ( $conf->exists('business-onlinepayment-description') ) {
+ my $dtempl = $conf->config('business-onlinepayment-description');
+
+ my $agent = $self->agent->agent;
+ #$pkgs... not here
+ $options{'description'} = eval qq("$dtempl");
+ } else {
+ $options{'description'} = 'Internet services';
+ }
+ }
return $self->fake_bop($method, $amount, %options) if $options{'fake'};
) {
warn " attempting void\n" if $DEBUG > 1;
my $void = new Business::OnlinePayment( $processor, @bop_options );
+ if ( $void->can('info') ) {
+ if ( $cust_pay->payby eq 'CARD'
+ && $void->info('CC_void_requires_card') )
+ {
+ $content{'card_number'} = $cust_pay->payinfo
+ } elsif ( $cust_pay->payby eq 'CHEK'
+ && $void->info('ECHECK_void_requires_account') )
+ {
+ ( $content{'account_number'}, $content{'routing_code'} ) =
+ split('@', $cust_pay->payinfo);
+ $content{'name'} = $self->get('first'). ' '. $self->get('last');
+ }
+ }
$void->content( 'action' => 'void', %content );
$void->submit();
if ( $void->is_success ) {
my $botpp = 'Business::OnlineThirdPartyPayment';
return 1
- if ( $conf->config('business-onlinepayment-namespace') eq $botpp ||
- scalar( grep { $_->gateway_namespace eq $botpp }
- qsearch( 'payment_gateway', { 'disabled' => '' } )
- )
+ if ( ( $conf->exists('business-onlinepayment-namespace')
+ && $conf->config('business-onlinepayment-namespace') eq $botpp
+ )
+ or scalar( grep { $_->gateway_namespace eq $botpp }
+ qsearch( 'payment_gateway', { 'disabled' => '' } )
+ )
)
;
if set, will override the value from the customer record.
I<description> is a free-text field passed to the gateway. It defaults to
-"Internet services".
+the value defined by the business-onlinepayment-description configuration
+option, or "Internet services" if that is unset.
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
if set, will override the value from the customer record.
I<description> is a free-text field passed to the gateway. It defaults to
-"Internet services".
+the value defined by the business-onlinepayment-description configuration
+option, or "Internet services" if that is unset.
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
sub _bop_defaults {
my ($self, $options) = @_;
- $options->{description} ||= 'Internet services';
+ unless ( $options->{'description'} ) {
+ if ( $conf->exists('business-onlinepayment-description') ) {
+ my $dtempl = $conf->config('business-onlinepayment-description');
+
+ my $agent = $self->agent->agent;
+ #$pkgs... not here
+ $options->{'description'} = eval qq("$dtempl");
+ } else {
+ $options->{'description'} = 'Internet services';
+ }
+ }
+
$options->{payinfo} = $self->payinfo unless exists( $options->{payinfo} );
$options->{invnum} ||= '';
$options->{payname} = $self->payname unless exists( $options->{payname} );
) {
warn " attempting void\n" if $DEBUG > 1;
my $void = new Business::OnlinePayment( $processor, @bop_options );
+ if ( $void->can('info') ) {
+ if ( $cust_pay->payby eq 'CARD'
+ && $void->info('CC_void_requires_card') )
+ {
+ $content{'card_number'} = $cust_pay->payinfo;
+ } elsif ( $cust_pay->payby eq 'CHEK'
+ && $void->info('ECHECK_void_requires_account') )
+ {
+ ( $content{'account_number'}, $content{'routing_code'} ) =
+ split('@', $cust_pay->payinfo);
+ $content{'name'} = $self->get('first'). ' '. $self->get('last');
+ }
+ }
$void->content( 'action' => 'void', %content );
$void->submit();
if ( $void->is_success ) {
);
}
+=item balance_date_range START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
+
+Returns the balance for this customer, only considering invoices with date
+earlier than START_TIME, and optionally not later than END_TIME
+(total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
+
+Times are specified as SQL fragments or numeric
+UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
+L<Date::Parse> for conversion functions. The empty string can be passed
+to disable that time constraint completely.
+
+Available options are:
+
+=over 4
+
+=item unapplied_date
+
+set to true to disregard unapplied credits, payments and refunds outside the specified time period - by default the time period restriction only applies to invoices (useful for reporting, probably a bad idea for event triggering)
+
+=back
+
+=cut
+
+sub balance_date_range {
+ my $self = shift;
+ my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
+ ') FROM cust_main WHERE custnum='. $self->custnum;
+ sprintf( "%.2f", $self->scalar_sql($sql) );
+}
+
=item balance_pkgnum PKGNUM
Returns the balance for this customer's specific package when using
Like referral_cust_main, except returns a flat list of all unsuspended (and
uncancelled) packages for each customer. The number of items in this list may
-be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
+be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
=cut
$cust_credit->set('reason', $reason)
}
- $cust_credit->addlinfo( delete $options{'addlinfo'} )
- if exists($options{'addlinfo'});
+ for (qw( addlinfo eventnum )) {
+ $cust_credit->$_( delete $options{$_} )
+ if exists($options{$_});
+ }
$cust_credit->insert(%options);
}
=item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
+=item cutoff
+
+An absolute cutoff time. Payments, credits, and refunds I<applied> after this
+time will be ignored. Note that START_TIME and END_TIME only limit the date
+range for invoices and I<unapplied> payments, credits, and refunds.
+
Creates a one-time charge for this customer. If there is an error, returns
the error, otherwise returns false.
? 'ship_'
: '';
- my ($zip,$plus4) = split /-/, $self->get("${prefix}zip")
+ my($zip,$plus4) = split /-/, $self->get("${prefix}zip")
if $self->country eq 'US';
+ $zip ||= '';
+ $plus4 ||= '';
#CCH specific location stuff
my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
sub balance_date_sql {
my( $class, $start, $end, %opt ) = @_;
- my $owed = FS::cust_bill->owed_sql;
- my $unapp_refund = FS::cust_refund->unapplied_sql;
- my $unapp_credit = FS::cust_credit->unapplied_sql;
- my $unapp_pay = FS::cust_pay->unapplied_sql;
+ my $cutoff = $opt{'cutoff'};
+
+ my $owed = FS::cust_bill->owed_sql($cutoff);
+ my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
+ my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
+ my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
my $j = $opt{'join'} || '';
=cut
sub unapplied_payments_date_sql {
- my( $class, $start, $end, ) = @_;
+ my( $class, $start, $end, %opt ) = @_;
+
+ my $cutoff = $opt{'cutoff'};
- my $unapp_pay = FS::cust_pay->unapplied_sql;
+ my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
'unapplied_date'=>1 );
}
-=item search_sql HASHREF
+=item search HASHREF
(Class method)
-Returns a qsearch hash expression to search for parameters specified in HREF.
-Valid parameters are
+Returns a qsearch hash expression to search for parameters specified in
+HASHREF. Valid parameters are
=over 4
=cut
-sub search_sql {
+sub search {
my ($class, $params) = @_;
my $dbh = dbh;
# payby
###
+ if ( $params->{'payby'} ) {
+
+ my @payby = ref( $params->{'payby'} )
+ ? @{ $params->{'payby'} }
+ : ( $params->{'payby'} );
+
+ @payby = grep /^([A-Z]{4})$/, @{ $params->{'payby'} };
+
+ push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )'
+ if @payby;
+
+ }
+
my @payby = grep /^([A-Z]{4})$/, @{ $params->{'payby'} };
if ( @payby ) {
push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )';
;
}
+ ###
+ # invoice terms
+ ###
+
+ if ( $params->{'invoice_terms'} =~ /^([\w ]+)$/ ) {
+ my $terms = $1;
+ if ( $1 eq 'NULL' ) {
+ push @where,
+ "( cust_main.invoice_terms IS NULL OR cust_main.invoice_terms = '' )";
+ } else {
+ push @where,
+ "cust_main.invoice_terms IS NOT NULL",
+ "cust_main.invoice_terms = '$1'";
+ }
+ }
+
##
# amounts
##
- #my $balance_sql = $class->balance_sql();
- my $balance_sql = FS::cust_main->balance_sql();
+ if ( $params->{'current_balance'} ) {
+
+ #my $balance_sql = $class->balance_sql();
+ my $balance_sql = FS::cust_main->balance_sql();
+
+ my @current_balance =
+ ref( $params->{'current_balance'} )
+ ? @{ $params->{'current_balance'} }
+ : ( $params->{'current_balance'} );
- push @where, map { s/current_balance/$balance_sql/; $_ }
- @{ $params->{'current_balance'} };
+ push @where, map { s/current_balance/$balance_sql/; $_ }
+ @current_balance;
+
+ }
##
# custbatch
}
-=item email_search_sql HASHREF
+=item email_search_result HASHREF
(Class method)
Emails a notice to the specified customers.
-Valid parameters are those of the L<search_sql> method, plus the following:
+Valid parameters are those of the L<search> method, plus the following:
=over 4
=cut
-sub email_search_sql {
+sub email_search_result {
my($class, $params) = @_;
my $from = delete $params->{from};
$params->{'payby'} = [ split(/\0/, $params->{'payby'}) ]
unless ref($params->{'payby'});
- my $sql_query = $class->search_sql($params);
+ my $sql_query = $class->search($params);
my $count_query = delete($sql_query->{'count_query'});
my $count_sth = dbh->prepare($count_query)
use Storable qw(thaw);
use Data::Dumper;
use MIME::Base64;
-sub process_email_search_sql {
+sub process_email_search_result {
my $job = shift;
#warn "$me process_re_X $method for job $job\n" if $DEBUG;
$param->{'payby'} = [ split(/\0/, $param->{'payby'}) ]
unless ref($param->{'payby'});
- my $error = FS::cust_main->email_search_sql( $param );
+ my $error = FS::cust_main->email_search_result( $param );
die $error if $error;
}
# "Company (Last, First)"
#this is probably something a browser remembered,
- #so just do an exact (but case-insensitive) 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( {
'table' => 'cust_main',
- 'hashref' => { $prefix.'first' => $first,
- $prefix.'last' => $last,
- $prefix.'company' => $company,
- %options,
- },
- 'extra_sql' => " AND $agentnums_sql",
+ '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,
+ ),
} );
}
#getting complaints searches are not returning enough
unless ( @cust_main && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
- #still some false laziness w/search_sql (was search/cust_main.cgi)
+ #still some false laziness w/search (was search/cust_main.cgi)
#substring
}
+=item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
+
+Subroutine (not a method), designed to be called from the queue.
+
+Takes a list of options and values.
+
+Pulls up the customer record via the custnum option and calls bill_and_collect.
+
+=cut
+
sub queued_bill {
- ## actual sub, not a method, designed to be called from the queue.
- ## sets up the customer, and calls the bill_and_collect
my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
+
my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
- $cust_main->bill_and_collect(
- %args,
- );
+ warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
+
+ $cust_main->bill_and_collect( %args );
}
sub _upgrade_data { #class method