FS::cust_main::NationalID
FS::cust_main::Billing
FS::cust_main::Billing_Realtime
+ FS::cust_main::Billing_Batch
FS::cust_main::Billing_Discount
FS::cust_main::Billing_ThirdParty
FS::cust_main::Location
FS::cust_main::Credit_Limit
+ FS::cust_main::Merge
FS::cust_main::API
FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin
FS::geocode_Mixin FS::Quotable_Mixin FS::Sales_Mixin
require 5.006;
use strict;
-use vars qw( $DEBUG $me $conf
- @encrypted_fields
- $import
- $ignore_expired_card $ignore_banned_card $ignore_illegal_zip
- $ignore_invalid_card
- $skip_fuzzyfiles
- @paytypes
- );
use Carp;
use Scalar::Util qw( blessed );
use Time::Local qw(timelocal);
-use Storable qw(thaw);
-use MIME::Base64;
use Data::Dumper;
use Tie::IxHash;
-use Digest::MD5 qw(md5_base64);
use Date::Format;
#use Date::Manip;
use File::Temp; #qw( tempfile );
use Business::CreditCard 0.28;
-use Locale::Country;
use FS::UID qw( dbh driver_name );
use FS::Record qw( qsearchs qsearch dbdef regexp_sql );
use FS::Cursor;
-use FS::Misc qw( generate_email send_email generate_ps do_print );
+use FS::Misc qw( generate_ps do_print money_pretty );
use FS::Msgcat qw(gettext);
use FS::CurrentUser;
use FS::TicketSystem;
use FS::cust_main_county;
use FS::cust_location;
use FS::cust_class;
+use FS::tax_status;
use FS::cust_main_exemption;
use FS::cust_tax_adjustment;
use FS::cust_tax_location;
use FS::banned_pay;
use FS::cust_main_note;
use FS::cust_attachment;
-use FS::contact;
+use FS::cust_contact;
use FS::Locales;
use FS::upgrade_journal;
use FS::sales;
use FS::cust_payby;
+use FS::contact;
# 1 is mostly method/subroutine entry and options
# 2 traces progress of some operations
# 3 is even more information including possibly sensitive data
-$DEBUG = 0;
-$me = '[FS::cust_main]';
+our $DEBUG = 0;
+our $me = '[FS::cust_main]';
-$import = 0;
-$ignore_expired_card = 0;
-$ignore_banned_card = 0;
-$ignore_invalid_card = 0;
+our $import = 0;
+our $ignore_expired_card = 0;
+our $ignore_banned_card = 0;
+our $ignore_invalid_card = 0;
-$skip_fuzzyfiles = 0;
+our $skip_fuzzyfiles = 0;
-@encrypted_fields = ('payinfo', 'paycvv');
-sub nohistory_fields { ('payinfo', 'paycvv'); }
+our $ucfirst_nowarn = 0;
-@paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
+#this info is in cust_payby as of 4.x
+#this and the fields themselves can be removed in 5.x
+our @encrypted_fields = ('payinfo', 'paycvv');
+sub nohistory_fields { ('payinfo', 'paycvv'); }
+our $conf;
#ask FS::UID to run this stuff for us later
#$FS::UID::callback{'FS::cust_main'} = sub {
install_callback FS::UID sub {
Do not call, empty or 'Y'
+=item invoice_ship_address
+
+Display ship_address ("Service address") on invoices for this customer, empty or 'Y'
+
=back
=head1 METHODS
);
$cust_main->insert( \%hash );
-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
-check_invoicing_list first. The invoicing_list is set after the records in the
-CUST_PKG_HASHREF above are inserted, so it is now possible to set an
-invoicing_list destination to the newly-created svc_acct. Here's an example:
-
- $cust_main->insert( {}, [ $email, 'POST' ] );
+INVOICING_LIST_ARYREF: No longer supported.
Currently available options are: I<depend_jobnum>, I<noexport>,
-I<tax_exemption> and I<prospectnum>.
+I<tax_exemption>, I<prospectnum>, I<contact> and I<contact_params>.
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).
If I<prospectnum> is set, moves contacts and locations from that prospect.
-If I<contact> is set to an arrayref of FS::contact objects, inserts those
-new contacts with this new customer.
+If I<contact> is set to an arrayref of FS::contact objects, those will be
+inserted.
+
+If I<contact_params> is set to a hashref of CGI parameters (and I<contact> is
+unset), inserts those new contacts with this new customer. Handles CGI
+paramaters for an "m2" multiple entry field as passed by edit/cust_main.cgi
+
+If I<cust_payby_params> is set to a hashref o fCGI parameters, inserts those
+new stored payment records with this new customer. Handles CGI parameters
+for an "m2" multiple entry field as passed by edit/cust_main.cgi
=cut
sub insert {
my $self = shift;
my $cust_pkgs = @_ ? shift : {};
- my $invoicing_list = @_ ? shift : '';
+ my $invoicing_list;
+ if ( $_[0] and ref($_[0]) eq 'ARRAY' ) {
+ warn "cust_main::insert using deprecated invoicing list argument";
+ $invoicing_list = shift;
+ }
my %options = @_;
warn "$me insert called with options ".
join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
my $payby = '';
if ( $self->payby eq 'PREPAY' ) {
- $self->payby('BILL');
+ $self->payby(''); #'BILL');
$prepay_identifier = $self->payinfo;
$self->payinfo('');
$payby = 'PREP' if $amount;
- } elsif ( $self->payby =~ /^(CASH|WEST|MCRD|PPAL)$/ ) {
+ } elsif ( $self->payby =~ /^(CASH|WEST|MCRD|MCHK|PPAL)$/ ) {
$payby = $1;
- $self->payby('BILL');
+ $self->payby(''); #'BILL');
$amount = $self->paid;
}
# 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";
- #location-less customer records are now permitted
- next;
- }
-
+
+ my $loc = delete $self->hashref->{$l} or next;
+
if ( !$loc->locationnum ) {
# warn the location that we're going to insert it with no custnum
$loc->set(custnum_pending => 1);
my $label = $l eq 'ship_location' ? 'service' : 'billing';
return "$error (in $label location)";
}
- }
- elsif ( ($loc->custnum || 0) > 0 or $loc->prospectnum ) {
+
+ } elsif ( $loc->prospectnum ) {
+
+ $loc->prospectnum('');
+ $loc->set(custnum_pending => 1);
+ my $error = $loc->replace;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ my $label = $l eq 'ship_location' ? 'service' : 'billing';
+ return "$error (moving $label location)";
+ }
+
+ } elsif ( ($loc->custnum || 0) > 0 ) {
# then it somehow belongs to another customer--shouldn't happen
$dbh->rollback if $oldAutoCommit;
return "$l belongs to customer ".$loc->custnum;
}
}
- warn " setting invoicing list\n"
- if $DEBUG > 1;
-
- if ( $invoicing_list ) {
- $error = $self->check_invoicing_list( $invoicing_list );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- #return "checking invoicing_list (transaction rolled back): $error";
- return $error;
- }
- $self->invoicing_list( $invoicing_list );
- }
-
warn " setting customer tags\n"
if $DEBUG > 1;
return $error;
}
- my @contact = $prospect_main->contact;
+ foreach my $prospect_contact ( $prospect_main->prospect_contact ) {
+ my $cust_contact = new FS::cust_contact {
+ 'custnum' => $self->custnum,
+ map { $_ => $prospect_contact->$_() } qw( contactnum classnum comment )
+ };
+ my $error = $cust_contact->insert
+ || $prospect_contact->delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
my @cust_location = $prospect_main->cust_location;
my @qual = $prospect_main->qual;
- foreach my $r ( @contact, @cust_location, @qual ) {
+ foreach my $r ( @cust_location, @qual ) {
$r->prospectnum('');
$r->custnum($self->custnum);
my $error = $r->replace;
}
- my $contact = delete $options{'contact'};
- if ( $contact ) {
+ warn " setting contacts\n"
+ if $DEBUG > 1;
+
+ $invoicing_list ||= $options{'invoicing_list'};
+ if ( $invoicing_list ) {
+
+ $invoicing_list = join(',', @$invoicing_list) if ref $invoicing_list;
+ my $contact = FS::contact->new({
+ 'custnum' => $self->get('custnum'),
+ 'last' => $self->get('last'),
+ 'first' => $self->get('first'),
+ 'emailaddress' => $invoicing_list,
+ 'invoice_dest' => 'Y',
+ });
+ my $error = $contact->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ }
+
+ if ( my $contact = delete $options{'contact'} ) {
foreach my $c ( @$contact ) {
$c->custnum($self->custnum);
}
+ } elsif ( my $contact_params = delete $options{'contact_params'} ) {
+
+ my $error = $self->process_o2m( 'table' => 'contact',
+ 'fields' => FS::contact->cgi_contact_fields,
+ 'params' => $contact_params,
+ );
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ warn " setting cust_payby\n"
+ if $DEBUG > 1;
+
+ if ( $options{cust_payby} ) {
+
+ foreach my $cust_payby ( @{ $options{cust_payby} } ) {
+ $cust_payby->custnum($self->custnum);
+ my $error = $cust_payby->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ } elsif ( my $cust_payby_params = delete $options{'cust_payby_params'} ) {
+
+ my $error = $self->process_o2m(
+ 'table' => 'cust_payby',
+ 'fields' => FS::cust_payby->cgi_cust_payby_fields,
+ 'params' => $cust_payby_params,
+ 'hash_callback' => \&FS::cust_payby::cgi_hash_callback,
+ );
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
}
warn " setting cust_main_exemption\n"
#cust_tax_adjustment in financials?
#cust_pay_pending? ouch
- #cust_recon?
foreach my $table (qw(
cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
- cust_location cust_main_note cust_tax_adjustment
+ cust_payby cust_location cust_main_note cust_tax_adjustment
cust_pay_void cust_pay_batch queue cust_tax_exempt
)) {
foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
}
-=item merge NEW_CUSTNUM [ , OPTION => VALUE ... ]
-
-This merges this customer into the provided new custnum, and then deletes the
-customer. If there is an error, returns the error, otherwise returns false.
-
-The source customer's name, company name, phone numbers, agent,
-referring customer, customer class, advertising source, order taker, and
-billing information (except balance) are discarded.
-
-All packages are moved to the target customer. Packages with package locations
-are preserved. Packages without package locations are moved to a new package
-location with the source customer's service/shipping address.
-
-All invoices, statements, payments, credits and refunds are moved to the target
-customer. The source customer's balance is added to the target customer.
-
-All notes, attachments, tickets and customer tags are moved to the target
-customer.
-
-Change history is not currently moved.
-
-=cut
-
-sub merge {
- my( $self, $new_custnum, %opt ) = @_;
-
- return "Can't merge a customer into self" if $self->custnum == $new_custnum;
-
- my $new_cust_main = qsearchs( 'cust_main', { 'custnum' => $new_custnum } )
- or return "Invalid new customer number: $new_custnum";
-
- return 'Access denied: "Merge customer across agents" access right required to merge into a customer of a different agent'
- if $self->agentnum != $new_cust_main->agentnum
- && ! $FS::CurrentUser::CurrentUser->access_right('Merge customer across agents');
-
- 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;
-
- if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
- $dbh->rollback if $oldAutoCommit;
- return "Can't merge a master agent customer";
- }
-
- #use FS::access_user
- if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
- $dbh->rollback if $oldAutoCommit;
- return "Can't merge a master employee customer";
- }
-
- if ( qsearch('cust_pay_pending', { 'custnum' => $self->custnum,
- 'status' => { op=>'!=', value=>'done' },
- }
- )
- ) {
- $dbh->rollback if $oldAutoCommit;
- return "Can't merge a customer with pending payments";
- }
-
- tie my %financial_tables, 'Tie::IxHash',
- 'cust_bill' => 'invoices',
- 'cust_bill_void' => 'voided invoices',
- 'cust_statement' => 'statements',
- 'cust_credit' => 'credits',
- 'cust_credit_void' => 'voided credits',
- 'cust_pay' => 'payments',
- 'cust_pay_void' => 'voided payments',
- 'cust_refund' => 'refunds',
- ;
-
- foreach my $table ( keys %financial_tables ) {
-
- my @records = $self->$table();
-
- foreach my $record ( @records ) {
- $record->custnum($new_custnum);
- my $error = $record->replace;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error merging ". $financial_tables{$table}. ": $error\n";
- }
- }
-
- }
-
- my $name = $self->ship_name; #?
-
- my $locationnum = '';
- foreach my $cust_pkg ( $self->all_pkgs ) {
- $cust_pkg->custnum($new_custnum);
-
- unless ( $cust_pkg->locationnum ) {
- unless ( $locationnum ) {
- my $cust_location = new FS::cust_location {
- $self->location_hash,
- 'custnum' => $new_custnum,
- };
- my $error = $cust_location->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- $locationnum = $cust_location->locationnum;
- }
- $cust_pkg->locationnum($locationnum);
- }
-
- my $error = $cust_pkg->replace;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- # add customer (ship) name to svc_phone.phone_name if blank
- my @cust_svc = $cust_pkg->cust_svc;
- foreach my $cust_svc (@cust_svc) {
- my($label, $value, $svcdb) = $cust_svc->label;
- next unless $svcdb eq 'svc_phone';
- my $svc_phone = $cust_svc->svc_x;
- next if $svc_phone->phone_name;
- $svc_phone->phone_name($name);
- my $error = $svc_phone->replace;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- }
-
- #not considered:
- # cust_tax_exempt (texas tax exemptions)
- # cust_recon (some sort of not-well understood thing for OnPac)
-
- #these are moved over
- foreach my $table (qw(
- cust_tag cust_location contact cust_attachment cust_main_note
- cust_tax_adjustment cust_pay_batch queue
- )) {
- foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
- $record->custnum($new_custnum);
- my $error = $record->replace;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
- }
-
- #these aren't preserved
- foreach my $table (qw(
- cust_main_exemption cust_main_invoice
- )) {
- foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
- my $error = $record->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
- }
-
-
- my $sth = $dbh->prepare(
- 'UPDATE cust_main SET referral_custnum = ? WHERE referral_custnum = ?'
- ) or do {
- my $errstr = $dbh->errstr;
- $dbh->rollback if $oldAutoCommit;
- return $errstr;
- };
- $sth->execute($new_custnum, $self->custnum) or do {
- my $errstr = $sth->errstr;
- $dbh->rollback if $oldAutoCommit;
- return $errstr;
- };
-
- #tickets
-
- my $ticket_dbh = '';
- if ($conf->config('ticket_system') eq 'RT_Internal') {
- $ticket_dbh = $dbh;
- } elsif ($conf->config('ticket_system') eq 'RT_External') {
- my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
- $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
- #or die "RT_External DBI->connect error: $DBI::errstr\n";
- }
-
- if ( $ticket_dbh ) {
-
- my $ticket_sth = $ticket_dbh->prepare(
- 'UPDATE Links SET Target = ? WHERE Target = ?'
- ) or do {
- my $errstr = $ticket_dbh->errstr;
- $dbh->rollback if $oldAutoCommit;
- return $errstr;
- };
- $ticket_sth->execute('freeside://freeside/cust_main/'.$new_custnum,
- 'freeside://freeside/cust_main/'.$self->custnum)
- or do {
- my $errstr = $ticket_sth->errstr;
- $dbh->rollback if $oldAutoCommit;
- return $errstr;
- };
-
- }
-
- #delete the customer record
-
- my $error = $self->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-
-}
-
=item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
Replaces the OLD_RECORD with this one in the database. If there is an error,
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
-check_invoicing_list first. Here's an example:
+INVOICING_LIST_ARYREF: If you pass an arrayref to this method, it will be
+set as the contact email address for a default contact with the same name as
+the customer.
- $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
-
-Currently available options are: I<tax_exemption>.
+Currently available options are: I<tax_exemption>, I<cust_payby_params>,
+I<contact_params>, I<invoicing_list>.
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.
+I<cust_payby_params> and I<contact_params> can be hashrefs of named parameter
+groups (describing the customer's payment methods and contacts, respectively)
+in the style supported by L<FS::o2m_Common/process_o2m>. See L<FS::cust_payby>
+and L<FS::contact> for the fields these can contain.
+
+I<invoicing_list> is a synonym for the INVOICING_LIST_ARYREF parameter, and
+should be used instead if possible.
+
=cut
sub replace {
if $DEBUG;
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.";
- }
+ return "You are not permitted to create complimentary accounts."
+ if $self->complimentary eq 'Y'
+ && $self->complimentary ne $old->complimentary
+ && ! $curuser->access_right('Complimentary customer');
local($ignore_expired_card) = 1
if $old->payby =~ /^(CARD|DCRD)$/
my $dbh = dbh;
for my $l (qw(bill_location ship_location)) {
- my $old_loc = $old->$l;
- my $new_loc = $self->$l;
+ #my $old_loc = $old->$l;
+ my $new_loc = $self->$l or next;
# find the existing location if there is one
$new_loc->set('custnum' => $self->custnum);
$self->set($l.'num', $new_loc->locationnum);
} #for $l
+ my $invoicing_list;
+ if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
+ warn "cust_main::replace: using deprecated invoicing list argument";
+ $invoicing_list = shift @param;
+ }
+
+ my %options = @param;
+
+ $invoicing_list ||= $options{invoicing_list};
+
+ if ( $invoicing_list ) {
+ my $email = '';
+ foreach (@$invoicing_list) {
+ if ($_ eq 'POST') {
+ $self->set('postal_invoice', 'Y');
+ } else {
+ $email .= ',' if length($email);
+ $email .= $_;
+ }
+ }
+ my @contacts = map { $_->contact } $self->cust_contact;
+ # if possible, use a contact that matches the customer's name
+ my ($contact) = grep { $_->first eq $old->get('first') and
+ $_->last eq $old->get('last') }
+ @contacts;
+ $contact ||= FS::contact->new({
+ 'custnum' => $self->custnum,
+ 'locationnum' => $self->get('bill_locationnum'),
+ });
+ $contact->set('last', $self->get('last'));
+ $contact->set('first', $self->get('first'));
+ $contact->set('emailaddress', $email);
+ $contact->set('invoice_dest', 'Y');
+
+ my $error;
+ if ( $contact->contactnum ) {
+ $error = $contact->replace;
+ } elsif ( length($email) ) { # don't create a new contact if email is empty
+ $error = $contact->insert;
+ }
+
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ }
+
# replace the customer record
my $error = $self->SUPER::replace($old);
}
}
- if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
- my $invoicing_list = shift @param;
- $error = $self->check_invoicing_list( $invoicing_list );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- $self->invoicing_list( $invoicing_list );
- }
-
if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
#this could be more efficient than deleting and re-inserting, if it matters
}
- my %options = @param;
-
my $tax_exemption = delete $options{'tax_exemption'};
if ( $tax_exemption ) {
}
- if ( $self->payby =~ /^(CARD|CHEK|LECB)$/
- && ( ( $self->get('payinfo') ne $old->get('payinfo')
- && $self->get('payinfo') !~ /^99\d{14}$/
- )
- || grep { $self->get($_) ne $old->get($_) } qw(paydate payname)
- )
- )
- {
+ if ( my $cust_payby_params = delete $options{'cust_payby_params'} ) {
+
+ my $error = $self->process_o2m(
+ 'table' => 'cust_payby',
+ 'fields' => FS::cust_payby->cgi_cust_payby_fields,
+ 'params' => $cust_payby_params,
+ 'hash_callback' => \&FS::cust_payby::cgi_hash_callback,
+ );
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ }
+
+ if ( my $contact_params = delete $options{'contact_params'} ) {
- # card/check/lec info has changed, want to retry realtime_ invoice events
- my $error = $self->retry_realtime;
+ # this can potentially replace contacts that were created by the
+ # invoicing list argument, but the UI shouldn't allow both of them
+ # to be specified
+
+ my $error = $self->process_o2m(
+ 'table' => 'contact',
+ 'fields' => FS::contact->cgi_contact_fields,
+ 'params' => $contact_params,
+ );
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
}
+
}
unless ( $import || $skip_fuzzyfiles ) {
|| $self->ut_foreign_keyn('ship_locationnum', 'cust_location','locationnum')
|| $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
|| $self->ut_foreign_keyn('salesnum', 'sales', 'salesnum')
+ || $self->ut_foreign_keyn('taxstatusnum', 'tax_status', 'taxstatusnum')
|| $self->ut_textn('custbatch')
|| $self->ut_name('last')
|| $self->ut_name('first')
|| $self->ut_flag('message_noemail')
|| $self->ut_enum('locale', [ '', FS::Locales->locales ])
|| $self->ut_currencyn('currency')
+ || $self->ut_alphan('po_number')
+ || $self->ut_enum('complimentary', [ '', 'Y' ])
+ || $self->ut_flag('invoice_ship_address')
+ || $self->ut_flag('invoice_dest')
;
foreach (qw(company ship_company)) {
$self->ss("$1-$2-$3");
}
+ #turn off invoice_ship_address if ship & bill are the same
+ if ($self->bill_locationnum eq $self->ship_locationnum) {
+ $self->invoice_ship_address('');
+ }
+
# cust_main_county verification now handled by cust_location check
$error =
}
+ return "You are not permitted to create complimentary accounts."
+ if ! $self->custnum
+ && $self->complimentary eq 'Y'
+ && ! $FS::CurrentUser::CurrentUser->access_right('Complimentary customer');
+
if ( $self->paydate eq '' || $self->paydate eq '-' ) {
return "Expiration date required"
# shouldn't payinfo_check do this?
$self->SUPER::check;
}
+=item replace_check
+
+Additional checks for replace only.
+
+=cut
+
+sub replace_check {
+ my ($new,$old) = @_;
+ #preserve old value if global config is set
+ if ($old && $conf->exists('invoice-ship_address')) {
+ $new->invoice_ship_address($old->invoice_ship_address);
+ }
+ return '';
+}
+
=item addr_fields
Returns a list of fields which have ship_ duplicates.
sub addr_fields {
qw( last first company
+ locationname
address1 address2 city county state zip country
latitude longitude
daytime night fax mobile
=item cust_contact
-Returns all contacts (see L<FS::contact>) for this customer.
+Returns all contact associations (see L<FS::cust_contact>) for this customer.
=cut
-#already used :/ sub contact {
sub cust_contact {
my $self = shift;
- qsearch('contact', { 'custnum' => $self->custnum } );
+ qsearch('cust_contact', { 'custnum' => $self->custnum } );
}
=item cust_payby
qsearch({
'table' => 'cust_payby',
'hashref' => { 'custnum' => $self->custnum },
- 'order_by' => 'ORDER BY weight ASC',
+ 'order_by' => "ORDER BY payby IN ('CARD','CHEK') DESC, weight ASC",
});
}
+sub has_cust_payby_auto {
+ my $self = shift;
+ scalar( qsearch({
+ 'table' => 'cust_payby',
+ 'hashref' => { 'custnum' => $self->custnum, },
+ 'extra_sql' => " AND payby IN ( 'CARD', 'CHEK' ) ",
+ 'order_by' => 'LIMIT 1',
+ }) );
+
+}
+
=item unsuspend
Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
-and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
-on success or a list of errors.
+and L<FS::cust_pkg>) for this customer, except those on hold.
+
+Returns a list: an empty list on success or a list of errors.
=cut
sub unsuspend {
my $self = shift;
- grep { $_->unsuspend } $self->suspended_pkgs;
+ grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs;
+}
+
+=item release_hold
+
+Unsuspends all suspended packages in the on-hold state (those without setup
+dates) for this customer.
+
+=cut
+
+sub release_hold {
+ my $self = shift;
+ grep { (!$_->setup) && $_->unsuspend } $self->suspended_pkgs;
}
=item suspend
return ( 'access denied' )
unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
- if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
+ if ( $opt{'ban'} ) {
+
+ foreach my $cust_payby ( $self->cust_payby ) {
- #should try decryption (we might have the private key)
- # and if not maybe queue a job for the server that does?
- return ( "Can't (yet) ban encrypted credit cards" )
- if $self->is_encrypted($self->payinfo);
+ #well, if they didn't get decrypted on search, then we don't have to
+ # try again... queue a job for the server that does have decryption
+ # capability if we're in a paranoid multi-server implementation?
+ return ( "Can't (yet) ban encrypted credit cards" )
+ if $cust_payby->is_encrypted($cust_payby->payinfo);
- my $ban = new FS::banned_pay $self->_new_banned_pay_hashref;
- my $error = $ban->insert;
- return ( $error ) if $error;
+ my $ban = new FS::banned_pay $cust_payby->_new_banned_pay_hashref;
+ my $error = $ban->insert;
+ return ( $error ) if $error;
+
+ }
}
};
}
-sub _new_banned_pay_hashref {
- my $self = shift;
- my $hr = $self->_banned_pay_hashref;
- $hr->{payinfo} = md5_base64($hr->{payinfo});
- $hr;
-}
-
=item notes
Returns all notes (see L<FS::cust_main_note>) for this customer.
sub notes {
my($self,$orderby_classnum) = (shift,shift);
- my $orderby = "_DATE DESC";
- $orderby = "CLASSNUM ASC, $orderby" if $orderby_classnum;
+ my $orderby = "sticky DESC, _date DESC";
+ $orderby = "classnum ASC, $orderby" if $orderby_classnum;
qsearch( 'cust_main_note',
{ 'custnum' => $self->custnum },
'',
: '';
}
-=item BILLING METHODS
-
-Documentation on billing methods has been moved to
-L<FS::cust_main::Billing>.
-
-=item REALTIME BILLING METHODS
-
-Documentation on realtime billing methods has been moved to
-L<FS::cust_main::Billing_Realtime>.
-
-=item remove_cvv
-
-Removes the I<paycvv> field from the database directly.
+=item tax_status
-If there is an error, returns the error, otherwise returns false.
+Returns the external tax status, as an FS::tax_status object, or the empty
+string if there is no tax status.
=cut
-sub remove_cvv {
+sub tax_status {
my $self = shift;
- my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
- or return dbh->errstr;
- $sth->execute($self->custnum)
- or return $sth->errstr;
- $self->paycvv('');
- '';
+ if ( $self->taxstatusnum ) {
+ qsearchs('tax_status', { 'taxstatusnum' => $self->taxstatusnum } );
+ } else {
+ return '';
+ }
}
-=item batch_card OPTION => VALUE...
-
-Adds a payment for this invoice to the pending credit card batch (see
-L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
-runs the payment using a realtime gateway.
+=item taxstatus
-Options may include:
-
-B<amount>: the amount to be paid; defaults to the customer's balance minus
-any payments in transit.
-
-B<payby>: the payment method; defaults to cust_main.payby
-
-B<realtime>: runs this as a realtime payment instead of adding it to a
-batch. Deprecated.
-
-B<invnum>: sets cust_pay_batch.invnum.
-
-B<address1>, B<address2>, B<city>, B<state>, B<zip>, B<country>: sets
-the billing address for the payment; defaults to the customer's billing
-location.
-
-B<payinfo>, B<paydate>, B<payname>: sets the payment account, expiration
-date, and name; defaults to those fields in cust_main.
+Returns the tax status code if there is one.
=cut
-sub batch_card {
- my ($self, %options) = @_;
-
- my $amount;
- if (exists($options{amount})) {
- $amount = $options{amount};
- }else{
- $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
- }
- return '' unless $amount > 0;
-
- my $invnum = delete $options{invnum};
- my $payby = $options{payby} || $self->payby; #still dubious
-
- if ($options{'realtime'}) {
- return $self->realtime_bop( FS::payby->payby2bop($self->payby),
- $amount,
- %options,
- );
- }
-
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
- my $dbh = dbh;
-
- #this needs to handle mysql as well as Pg, like svc_acct.pm
- #(make it into a common function if folks need to do batching with mysql)
- $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
- or return "Cannot lock pay_batch: " . $dbh->errstr;
-
- my %pay_batch = (
- 'status' => 'O',
- 'payby' => FS::payby->payby2payment($payby),
- );
- $pay_batch{agentnum} = $self->agentnum if $conf->exists('batch-spoolagent');
-
- my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
-
- unless ( $pay_batch ) {
- $pay_batch = new FS::pay_batch \%pay_batch;
- my $error = $pay_batch->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- die "error creating new batch: $error\n";
- }
- }
+sub taxstatus {
+ my $self = shift;
+ my $tax_status = $self->tax_status;
+ $tax_status
+ ? $tax_status->taxstatus
+ : '';
+}
- my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
- 'batchnum' => $pay_batch->batchnum,
- 'custnum' => $self->custnum,
- } );
+=item BILLING METHODS
- foreach (qw( address1 address2 city state zip country latitude longitude
- payby payinfo paydate payname ))
- {
- $options{$_} = '' unless exists($options{$_});
- }
+Documentation on billing methods has been moved to
+L<FS::cust_main::Billing>.
- my $loc = $self->bill_location;
+=item REALTIME BILLING METHODS
- my $cust_pay_batch = new FS::cust_pay_batch ( {
- 'batchnum' => $pay_batch->batchnum,
- 'invnum' => $invnum || 0, # is there a better value?
- # this field should be
- # removed...
- # cust_bill_pay_batch now
- 'custnum' => $self->custnum,
- 'last' => $self->getfield('last'),
- 'first' => $self->getfield('first'),
- '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} || $self->payby,
- 'payinfo' => $options{payinfo} || $self->payinfo,
- 'exp' => $options{paydate} || $self->paydate,
- 'payname' => $options{payname} || $self->payname,
- 'amount' => $amount, # consolidating
- } );
-
- $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
- if $old_cust_pay_batch;
+Documentation on realtime billing methods has been moved to
+L<FS::cust_main::Billing_Realtime>.
- my $error;
- if ($old_cust_pay_batch) {
- $error = $cust_pay_batch->replace($old_cust_pay_batch)
- } else {
- $error = $cust_pay_batch->insert;
- }
+=item remove_cvv
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- die $error;
- }
+Removes the I<paycvv> field from the database directly.
- my $unapplied = $self->total_unapplied_credits
- + $self->total_unapplied_payments
- + $self->in_transit_payments;
- foreach my $cust_bill ($self->open_cust_bill) {
- #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
- my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
- 'invnum' => $cust_bill->invnum,
- 'paybatchnum' => $cust_pay_batch->paybatchnum,
- 'amount' => $cust_bill->owed,
- '_date' => time,
- };
- if ($unapplied >= $cust_bill_pay_batch->amount){
- $unapplied -= $cust_bill_pay_batch->amount;
- next;
- }else{
- $cust_bill_pay_batch->amount(sprintf ( "%.2f",
- $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
- }
- $error = $cust_bill_pay_batch->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- die $error;
- }
- }
+If there is an error, returns the error, otherwise returns false.
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+=cut
+
+sub remove_cvv {
+ my $self = shift;
+ my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
+ or return dbh->errstr;
+ $sth->execute($self->custnum)
+ or return $sth->errstr;
+ $self->paycvv('');
'';
}
);
}
-=item in_transit_payments
-
-Returns the total of requests for payments for this customer pending in
-batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
-
-=cut
-
-sub in_transit_payments {
- my $self = shift;
- my $in_transit_payments = 0;
- foreach my $pay_batch ( qsearch('pay_batch', {
- 'status' => 'I',
- } ) ) {
- foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
- 'batchnum' => $pay_batch->batchnum,
- 'custnum' => $self->custnum,
- } ) ) {
- $in_transit_payments += $cust_pay_batch->amount;
- }
- }
- sprintf( "%.2f", $in_transit_payments );
-}
-
=item payment_info
Returns a hash of useful information for making a payment.
=item cust_main_exemption
-=item invoicing_list [ ARRAYREF ]
-
-If an arguement is given, sets these email addresses as invoice recipients
-(see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
-(except as warnings), so use check_invoicing_list first.
-
-Returns a list of email addresses (with svcnum entries expanded).
-
-Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
-check it without disturbing anything by passing nothing.
+=item invoicing_list
-This interface may change in the future.
+Returns a list of email addresses (with svcnum entries expanded), and the word
+'POST' if the customer receives postal invoices.
=cut
my( $self, $arrayref ) = @_;
if ( $arrayref ) {
- my @cust_main_invoice;
- if ( $self->custnum ) {
- @cust_main_invoice =
- qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
- } else {
- @cust_main_invoice = ();
- }
- foreach my $cust_main_invoice ( @cust_main_invoice ) {
- #warn $cust_main_invoice->destnum;
- unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
- #warn $cust_main_invoice->destnum;
- my $error = $cust_main_invoice->delete;
- warn $error if $error;
- }
- }
- if ( $self->custnum ) {
- @cust_main_invoice =
- qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
- } else {
- @cust_main_invoice = ();
- }
- my %seen = map { $_->address => 1 } @cust_main_invoice;
- foreach my $address ( @{$arrayref} ) {
- next if exists $seen{$address} && $seen{$address};
- $seen{$address} = 1;
- my $cust_main_invoice = new FS::cust_main_invoice ( {
- 'custnum' => $self->custnum,
- 'dest' => $address,
- } );
- my $error = $cust_main_invoice->insert;
- warn $error if $error;
- }
+ warn "FS::cust_main::invoicing_list(ARRAY) is no longer supported.";
}
- if ( $self->custnum ) {
- map { $_->address }
- qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
- } else {
- ();
- }
+ my @emails = $self->invoicing_list_emailonly;
+ push @emails, 'POST' if $self->get('postal_invoice');
+ @emails;
}
=item check_invoicing_list ARRAYREF
'';
}
-=item set_default_invoicing_list
-
-Sets the invoicing list to all accounts associated with this customer,
-overwriting any previous invoicing list.
-
-=cut
-
-sub set_default_invoicing_list {
- my $self = shift;
- $self->invoicing_list($self->all_emails);
-}
-
=item all_emails
Returns the email addresses of all accounts provisioned for this customer.
sub invoicing_list_addpost {
my $self = shift;
- return if grep { $_ eq 'POST' } $self->invoicing_list;
- my @invoicing_list = $self->invoicing_list;
- push @invoicing_list, 'POST';
- $self->invoicing_list(\@invoicing_list);
+ if ( $self->get('postal_invoice') eq '' ) {
+ $self->set('postal_invoice', 'Y');
+ my $error = $self->replace;
+ warn $error if $error; # should fail harder, but this is traditional
+ }
}
=item invoicing_list_emailonly
my $self = shift;
warn "$me invoicing_list_emailonly called"
if $DEBUG;
- grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
+ return () if !$self->custnum; # not yet inserted
+ return map { $_->emailaddress }
+ qsearch({
+ table => 'cust_contact',
+ select => 'emailaddress',
+ addl_from => ' JOIN contact USING (contactnum) '.
+ ' JOIN contact_email USING (contactnum)',
+ hashref => { 'custnum' => $self->custnum, },
+ extra_sql => q( AND invoice_dest = 'Y'),
+ });
}
=item invoicing_list_emailonly_scalar
=cut
+#super false laziness w/quotation::charge
sub charge {
my $self = shift;
- my ( $amount, $quantity, $start_date, $classnum );
+ my ( $amount, $setup_cost, $quantity, $start_date, $classnum );
my ( $pkg, $comment, $additional );
my ( $setuptax, $taxclass ); #internal taxes
my ( $taxproduct, $override ); #vendor (CCH) taxes
my $no_auto = '';
+ my $separate_bill = '';
my $cust_pkg_ref = '';
my ( $bill_now, $invoice_terms ) = ( 0, '' );
my $locationnum;
if ( ref( $_[0] ) ) {
$amount = $_[0]->{amount};
+ $setup_cost = $_[0]->{setup_cost};
$quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
$start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
$no_auto = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
$bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
$invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
$locationnum = $_[0]->{locationnum} || $self->ship_locationnum;
- } else {
+ $separate_bill = $_[0]->{separate_bill} || '';
+ } else { # yuck
$amount = shift;
+ $setup_cost = '';
$quantity = 1;
$start_date = '';
$pkg = @_ ? shift : 'One-time charge';
'setuptax' => $setuptax,
'taxclass' => $taxclass,
'taxproductnum' => $taxproduct,
+ 'setup_cost' => $setup_cost,
} );
my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
'quantity' => $quantity,
'start_date' => $start_date,
'no_auto' => $no_auto,
+ 'separate_bill' => $separate_bill,
'locationnum'=> $locationnum,
} );
sub cust_pay {
my $self = shift;
- return $self->num_cust_pay unless wantarray;
- sort { $a->_date <=> $b->_date }
- qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
+ my $opt = ref($_[0]) ? shift : { @_ };
+
+ return $self->num_cust_pay unless wantarray || keys %$opt;
+
+ $opt->{'table'} = 'cust_pay';
+ $opt->{'hashref'}{'custnum'} = $self->custnum;
+
+ map { $_ } #behavior of sort undefined in scalar context
+ sort { $a->_date <=> $b->_date }
+ qsearch($opt);
+
}
=item num_cust_pay
$sth->fetchrow_arrayref->[0];
}
+=item unapplied_cust_pay
+
+Returns all the unapplied payments (see L<FS::cust_pay>) for this customer.
+
+=cut
+
+sub unapplied_cust_pay {
+ my $self = shift;
+
+ $self->cust_pay(
+ 'extra_sql' => ' AND '. FS::cust_pay->unapplied_sql. ' > 0',
+ #@_
+ );
+
+}
+
=item cust_pay_pkgnum
Returns all the payments (see L<FS::cust_pay>) for this customer's specific
qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
}
-=item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
-
-Returns all batched payments (see L<FS::cust_pay_batch>) for this customer.
-
-Optionally, a list or hashref of additional arguments to the qsearch call can
-be passed.
-
-=cut
-
-sub cust_pay_batch {
- my $self = shift;
- my $opt = ref($_[0]) ? shift : { @_ };
-
- #return $self->num_cust_statement unless wantarray || keys %$opt;
-
- $opt->{'table'} = 'cust_pay_batch';
- $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
- $opt->{'hashref'}{'custnum'} = $self->custnum;
- $opt->{'order_by'} ||= 'ORDER BY paybatchnum ASC';
-
- map { $_ } #behavior of sort undefined in scalar context
- sort { $a->paybatchnum <=> $b->paybatchnum }
- qsearch($opt);
-}
-
=item cust_pay_pending
Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
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;
+ my $cust_contact = qsearchs('cust_contact', {
+ 'classnum' => $classnum,
+ 'custnum' => $self->custnum,
+ });
+ $self->{service_contact} = $cust_contact->contact if $cust_contact;
}
$self->{service_contact};
}
$contact->get('first') . ' '. $contact->get('last');
}
-#XXX this doesn't work in 3.x+
-#=item country_full
-#
-#Returns this customer's full country name
-#
-#=cut
-#
-#sub country_full {
-# my $self = shift;
-# code2country($self->country);
-#}
-
sub bill_country_full {
my $self = shift;
- code2country($self->bill_location->country);
+ $self->bill_location->country_full;
}
sub ship_country_full {
my $self = shift;
- code2country($self->ship_location->country);
+ $self->ship_location->country_full;
}
=item county_state_county [ PREFIX ]
=over 4
-=item prospect - No packages have ever been ordered
+=item prospect
+
+No packages have ever been ordered. Displayed as "No packages".
-=item ordered - Recurring packages all are new (not yet billed).
+=item ordered
-=item active - One or more recurring packages is active
+Recurring packages all are new (not yet billed).
-=item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
+=item active
-=item suspended - All non-cancelled recurring packages are suspended
+One or more recurring packages is active.
-=item cancelled - All recurring packages are cancelled
+=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.
=back
}
}
+=item is_status_delay_cancel
+
+Returns true if customer status is 'suspended'
+and all suspended cust_pkg return true for
+cust_pkg->is_status_delay_cancel.
+
+This is not a real status, this only meant for hacking display
+values, because otherwise treating the customer as suspended is
+really the whole point of the delay_cancel option.
+
+=cut
+
+sub is_status_delay_cancel {
+ my ($self) = @_;
+ return 0 unless $self->status eq 'suspended';
+ foreach my $cust_pkg ($self->ncancelled_pkgs) {
+ return 0 unless $cust_pkg->is_status_delay_cancel;
+ }
+ return 1;
+}
+
=item ucfirst_cust_status
=item ucfirst_status
+Deprecated, use the cust_status_label method instead.
+
Returns the status with the first character capitalized.
=cut
-sub ucfirst_status { shift->ucfirst_cust_status(@_); }
+sub ucfirst_status {
+ carp "ucfirst_status deprecated, use cust_status_label" unless $ucfirst_nowarn;
+ local($ucfirst_nowarn) = 1;
+ shift->ucfirst_cust_status(@_);
+}
sub ucfirst_cust_status {
+ carp "ucfirst_cust_status deprecated, use cust_status_label" unless $ucfirst_nowarn;
my $self = shift;
ucfirst($self->cust_status);
}
+=item cust_status_label
+
+=item status_label
+
+Returns the display label for this status.
+
+=cut
+
+sub status_label { shift->cust_status_label(@_); }
+
+sub cust_status_label {
+ my $self = shift;
+ __PACKAGE__->statuslabels->{$self->cust_status};
+}
+
=item statuscolor
Returns a hex triplet color string for this customer's status.
(@tickets);
}
+=item appointments [ STATUS ]
+
+Returns an array of hashes representing the customer's RT tickets which
+are appointments.
+
+=cut
+
+sub appointments {
+ my $self = shift;
+ my $status = ( @_ && $_[0] ) ? shift : '';
+
+ return () unless $conf->config('ticket_system');
+
+ my $queueid = $conf->config('ticket_system-appointment-queueid');
+
+ @{ FS::TicketSystem->customer_tickets( $self->custnum,
+ 99,
+ undef,
+ $status,
+ $queueid,
+ )
+ };
+}
+
# Return services representing svc_accts in customer support packages
sub support_services {
my $self = shift;
}
+=item payment_history
+
+Returns an array of hashrefs standardizing information from cust_bill, cust_pay,
+cust_credit and cust_refund objects. Each hashref has the following fields:
+
+I<type> - one of 'Line item', 'Invoice', 'Payment', 'Credit', 'Refund' or 'Previous'
+
+I<date> - value of _date field, unix timestamp
+
+I<date_pretty> - user-friendly date
+
+I<description> - user-friendly description of item
+
+I<amount> - impact of item on user's balance
+(positive for Invoice/Refund/Line item, negative for Payment/Credit.)
+Not to be confused with the native 'amount' field in cust_credit, see below.
+
+I<amount_pretty> - includes money char
+
+I<balance> - customer balance, chronologically as of this item
+
+I<balance_pretty> - includes money char
+
+I<charged> - amount charged for cust_bill (Invoice or Line item) records, undef for other types
+
+I<paid> - amount paid for cust_pay records, undef for other types
+
+I<credit> - amount credited for cust_credit records, undef for other types.
+Literally the 'amount' field from cust_credit, renamed here to avoid confusion.
+
+I<refund> - amount refunded for cust_refund records, undef for other types
+
+The four table-specific keys always have positive values, whether they reflect charges or payments.
+
+The following options may be passed to this method:
+
+I<line_items> - if true, returns charges ('Line item') rather than invoices
+
+I<start_date> - unix timestamp, only include records on or after.
+If specified, an item of type 'Previous' will also be included.
+It does not have table-specific fields.
+
+I<end_date> - unix timestamp, only include records before
+
+I<reverse_sort> - order from newest to oldest (default is oldest to newest)
+
+I<conf> - optional already-loaded FS::Conf object.
+
+=cut
+
+# Caution: this gets used by FS::ClientAPI::MyAccount::billing_history,
+# and also for sending customer statements, which should both be kept customer-friendly.
+# If you add anything that shouldn't be passed on through the API or exposed
+# to customers, add a new option to include it, don't include it by default
+sub payment_history {
+ my $self = shift;
+ my $opt = ref($_[0]) ? $_[0] : { @_ };
+
+ my $conf = $$opt{'conf'} || new FS::Conf;
+ my $money_char = $conf->config("money_char") || '$',
+
+ #first load entire history,
+ #need previous to calculate previous balance
+ #loading after end_date shouldn't hurt too much?
+ my @history = ();
+ if ( $$opt{'line_items'} ) {
+
+ foreach my $cust_bill ( $self->cust_bill ) {
+
+ push @history, {
+ 'type' => 'Line item',
+ 'description' => $_->desc( $self->locale ).
+ ( $_->sdate && $_->edate
+ ? ' '. time2str('%d-%b-%Y', $_->sdate).
+ ' To '. time2str('%d-%b-%Y', $_->edate)
+ : ''
+ ),
+ 'amount' => sprintf('%.2f', $_->setup + $_->recur ),
+ 'charged' => sprintf('%.2f', $_->setup + $_->recur ),
+ 'date' => $cust_bill->_date,
+ 'date_pretty' => $self->time2str_local('short', $cust_bill->_date ),
+ }
+ foreach $cust_bill->cust_bill_pkg;
+
+ }
+
+ } else {
+
+ push @history, {
+ 'type' => 'Invoice',
+ 'description' => 'Invoice #'. $_->display_invnum,
+ 'amount' => sprintf('%.2f', $_->charged ),
+ 'charged' => sprintf('%.2f', $_->charged ),
+ 'date' => $_->_date,
+ 'date_pretty' => $self->time2str_local('short', $_->_date ),
+ }
+ foreach $self->cust_bill;
+
+ }
+
+ push @history, {
+ 'type' => 'Payment',
+ 'description' => 'Payment', #XXX type
+ 'amount' => sprintf('%.2f', 0 - $_->paid ),
+ 'paid' => sprintf('%.2f', $_->paid ),
+ 'date' => $_->_date,
+ 'date_pretty' => $self->time2str_local('short', $_->_date ),
+ }
+ foreach $self->cust_pay;
+
+ push @history, {
+ 'type' => 'Credit',
+ 'description' => 'Credit', #more info?
+ 'amount' => sprintf('%.2f', 0 -$_->amount ),
+ 'credit' => sprintf('%.2f', $_->amount ),
+ 'date' => $_->_date,
+ 'date_pretty' => $self->time2str_local('short', $_->_date ),
+ }
+ foreach $self->cust_credit;
+
+ push @history, {
+ 'type' => 'Refund',
+ 'description' => 'Refund', #more info? type, like payment?
+ 'amount' => $_->refund,
+ 'refund' => $_->refund,
+ 'date' => $_->_date,
+ 'date_pretty' => $self->time2str_local('short', $_->_date ),
+ }
+ foreach $self->cust_refund;
+
+ #put it all in chronological order
+ @history = sort { $a->{'date'} <=> $b->{'date'} } @history;
+
+ #calculate balance, filter items outside date range
+ my $previous = 0;
+ my $balance = 0;
+ my @out = ();
+ foreach my $item (@history) {
+ last if $$opt{'end_date'} && ($$item{'date'} >= $$opt{'end_date'});
+ $balance += $$item{'amount'};
+ if ($$opt{'start_date'} && ($$item{'date'} < $$opt{'start_date'})) {
+ $previous += $$item{'amount'};
+ next;
+ }
+ $$item{'balance'} = sprintf("%.2f",$balance);
+ foreach my $key ( qw(amount balance) ) {
+ $$item{$key.'_pretty'} = money_pretty($$item{$key});
+ }
+ push(@out,$item);
+ }
+
+ # start with previous balance, if there was one
+ if ($previous) {
+ my $item = {
+ 'type' => 'Previous',
+ 'description' => 'Previous balance',
+ 'amount' => sprintf("%.2f",$previous),
+ 'balance' => sprintf("%.2f",$previous),
+ 'date' => $$opt{'start_date'},
+ 'date_pretty' => $self->time2str_local('short', $$opt{'start_date'} ),
+ };
+ #false laziness with above
+ foreach my $key ( qw(amount balance) ) {
+ $$item{$key.'_pretty'} = $$item{$key};
+ $$item{$key.'_pretty'} =~ s/^(-?)/$1$money_char/;
+ }
+ unshift(@out,$item);
+ }
+
+ @out = reverse @history if $$opt{'reverse_sort'};
+
+ return @out;
+}
+
=back
=head1 CLASS METHODS
=over 4
-=item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
-
-Deprecated. Use event notification and message templates
-(L<FS::msg_template>) instead.
-
-Sends a templated email notification to the customer (see L<Text::Template>).
-
-OPTIONS is a hash and may include
-
-I<from> - the email sender (default is invoice_from)
-
-I<to> - comma-separated scalar or arrayref of recipients
- (default is invoicing_list)
-
-I<subject> - The subject line of the sent email notification
- (default is "Notice from company_name")
+#=item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
-I<extra_fields> - a hashref of name/value pairs which will be substituted
- into the template
-
-The following variables are vavailable in the template.
-
-I<$first> - the customer first name
-I<$last> - the customer last name
-I<$company> - the customer company
-I<$payby> - a description of the method of payment for the customer
- # would be nice to use FS::payby::shortname
-I<$payinfo> - the account information used to collect for this customer
-I<$expdate> - the expiration of the customer payment in seconds from epoch
+#Deprecated. Use event notification and message templates
+#(L<FS::msg_template>) instead.
-=cut
+#Sends a templated email notification to the customer (see L<Text::Template>).
-sub notify {
- my ($self, $template, %options) = @_;
+#OPTIONS is a hash and may include
- return unless $conf->exists($template);
+#I<from> - the email sender (default is invoice_from)
- my $from = $conf->config('invoice_from', $self->agentnum)
- if $conf->exists('invoice_from', $self->agentnum);
- $from = $options{from} if exists($options{from});
+#I<to> - comma-separated scalar or arrayref of recipients
+# (default is invoicing_list)
- my $to = join(',', $self->invoicing_list_emailonly);
- $to = $options{to} if exists($options{to});
-
- my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
- if $conf->exists('company_name', $self->agentnum);
- $subject = $options{subject} if exists($options{subject});
-
- my $notify_template = new Text::Template (TYPE => 'ARRAY',
- SOURCE => [ map "$_\n",
- $conf->config($template)]
- )
- or die "can't create new Text::Template object: Text::Template::ERROR";
- $notify_template->compile()
- or die "can't compile template: Text::Template::ERROR";
+#I<subject> - The subject line of the sent email notification
+# (default is "Notice from company_name")
- $FS::notify_template::_template::company_name =
- $conf->config('company_name', $self->agentnum);
- $FS::notify_template::_template::company_address =
- join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
+#I<extra_fields> - a hashref of name/value pairs which will be substituted
+# into the template
- my $paydate = $self->paydate || '2037-12-31';
- $FS::notify_template::_template::first = $self->first;
- $FS::notify_template::_template::last = $self->last;
- $FS::notify_template::_template::company = $self->company;
- $FS::notify_template::_template::payinfo = $self->mask_payinfo;
- my $payby = $self->payby;
- my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
- my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
+#The following variables are vavailable in the template.
- #credit cards expire at the end of the month/year of their exp date
- if ($payby eq 'CARD' || $payby eq 'DCRD') {
- $FS::notify_template::_template::payby = 'credit card';
- ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
- $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
- $expire_time--;
- }elsif ($payby eq 'COMP') {
- $FS::notify_template::_template::payby = 'complimentary account';
- }else{
- $FS::notify_template::_template::payby = 'current method';
- }
- $FS::notify_template::_template::expdate = $expire_time;
+#I<$first> - the customer first name
+#I<$last> - the customer last name
+#I<$company> - the customer company
+#I<$payby> - a description of the method of payment for the customer
+# # would be nice to use FS::payby::shortname
+#I<$payinfo> - the account information used to collect for this customer
+#I<$expdate> - the expiration of the customer payment in seconds from epoch
- for (keys %{$options{extra_fields}}){
- no strict "refs";
- ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
- }
+#=cut
- send_email(from => $from,
- to => $to,
- subject => $subject,
- body => $notify_template->fill_in( PACKAGE =>
- 'FS::notify_template::_template' ),
- );
+#sub notify {
+# my ($self, $template, %options) = @_;
+
+# return unless $conf->exists($template);
+
+# my $from = $conf->invoice_from_full($self->agentnum)
+# if $conf->exists('invoice_from', $self->agentnum);
+# $from = $options{from} if exists($options{from});
+
+# my $to = join(',', $self->invoicing_list_emailonly);
+# $to = $options{to} if exists($options{to});
+#
+# my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
+# if $conf->exists('company_name', $self->agentnum);
+# $subject = $options{subject} if exists($options{subject});
+
+# my $notify_template = new Text::Template (TYPE => 'ARRAY',
+# SOURCE => [ map "$_\n",
+# $conf->config($template)]
+# )
+# or die "can't create new Text::Template object: Text::Template::ERROR";
+# $notify_template->compile()
+# or die "can't compile template: Text::Template::ERROR";
+
+# $FS::notify_template::_template::company_name =
+# $conf->config('company_name', $self->agentnum);
+# $FS::notify_template::_template::company_address =
+# join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
+
+# my $paydate = $self->paydate || '2037-12-31';
+# $FS::notify_template::_template::first = $self->first;
+# $FS::notify_template::_template::last = $self->last;
+# $FS::notify_template::_template::company = $self->company;
+# $FS::notify_template::_template::payinfo = $self->mask_payinfo;
+# my $payby = $self->payby;
+# my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
+# my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
+
+# #credit cards expire at the end of the month/year of their exp date
+# if ($payby eq 'CARD' || $payby eq 'DCRD') {
+# $FS::notify_template::_template::payby = 'credit card';
+# ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
+# $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
+# $expire_time--;
+# }elsif ($payby eq 'COMP') {
+# $FS::notify_template::_template::payby = 'complimentary account';
+# }else{
+# $FS::notify_template::_template::payby = 'current method';
+# }
+# $FS::notify_template::_template::expdate = $expire_time;
+
+# for (keys %{$options{extra_fields}}){
+# no strict "refs";
+# ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
+# }
+
+# send_email(from => $from,
+# to => $to,
+# subject => $subject,
+# body => $notify_template->fill_in( PACKAGE =>
+# 'FS::notify_template::_template' ),
+# );
-}
+#}
=item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
into the template. These values may override values mentioned below
and those from the customer record.
+I<template_text> - if present, ignores TEMPLATE_NAME and uses the provided text
+
The following variables are available in the template instead of or in addition
to the fields of the customer record.
sub generate_letter {
my ($self, $template, %options) = @_;
- return unless $conf->exists($template);
+ warn "Template $template does not exist" && return
+ unless $conf->exists($template) || $options{'template_text'};
+
+ my $template_source = $options{'template_text'}
+ ? [ $options{'template_text'} ]
+ : [ map "$_\n", $conf->config($template) ];
my $letter_template = new Text::Template
( TYPE => 'ARRAY',
- SOURCE => [ map "$_\n", $conf->config($template)],
+ SOURCE => $template_source,
DELIMITERS => [ '[@--', '--@]' ],
)
or die "can't create new Text::Template object: Text::Template::ERROR";
my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
or die "invalid customer number: " . $opt{custnum};
- my $error = $self->print( { 'template' => $opt{template} } );
+#do not backport this change to 3.x
+# my $error = $self->print( { 'template' => $opt{template} } );
+ my $error = $self->print( $opt{'template'} );
die $error if $error;
}
}
+sub process_o2m_qsearch {
+ my $self = shift;
+ my $table = shift;
+ return qsearch($table, @_) unless $table eq 'contact';
+
+ my $hashref = shift;
+ my %hash = %$hashref;
+ ( my $custnum = delete $hash{'custnum'} ) =~ /^(\d+)$/
+ or die 'guru meditation #4343';
+
+ qsearch({ 'table' => 'contact',
+ 'addl_from' => 'LEFT JOIN cust_contact USING ( contactnum )',
+ 'hashref' => \%hash,
+ 'extra_sql' => ( keys %hash ? ' AND ' : ' WHERE ' ).
+ " cust_contact.custnum = $custnum "
+ });
+}
+
+sub process_o2m_qsearchs {
+ my $self = shift;
+ my $table = shift;
+ return qsearchs($table, @_) unless $table eq 'contact';
+
+ my $hashref = shift;
+ my %hash = %$hashref;
+ ( my $custnum = delete $hash{'custnum'} ) =~ /^(\d+)$/
+ or die 'guru meditation #2121';
+
+ qsearchs({ 'table' => 'contact',
+ 'addl_from' => 'LEFT JOIN cust_contact USING ( contactnum )',
+ 'hashref' => \%hash,
+ 'extra_sql' => ( keys %hash ? ' AND ' : ' WHERE ' ).
+ " cust_contact.custnum = $custnum "
+ });
+}
+
=item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
Subroutine (not a method), designed to be called from the queue.
$cust_main->bill_and_collect( %args );
}
+=item queued_collect 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
+
+Like queued_bill, but instead of C<bill_and_collect>, just runs the
+C<collect> part. This is used in batch tax calculation, where invoice
+generation and collection events have to be completely separated.
+
+=cut
+
+sub queued_collect {
+ my (%args) = @_;
+ my $cust_main = FS::cust_main->by_key($args{'custnum'});
+
+ $cust_main->collect(%args);
+}
+
sub process_bill_and_collect {
my $job = shift;
- my $param = thaw(decode_base64(shift));
+ my $param = shift;
my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
or die "custnum '$param->{custnum}' not found!\n";
$param->{'job'} = $job;
while (my $cust_main = $search->fetch) {
- my $cust_payby = new FS::cust_payby {
- 'custnum' => $cust_main->custnum,
- 'weight' => 1,
- map { $_ => $cust_main->$_(); } @payfields
- };
+ unless ( $cust_main->payby =~ /^(BILL|COMP)$/ ) {
- my $error = $cust_payby->insert;
- die $error if $error;
+ my $cust_payby = new FS::cust_payby {
+ 'custnum' => $cust_main->custnum,
+ 'weight' => 1,
+ map { $_ => $cust_main->$_(); } @payfields
+ };
+
+ my $error = $cust_payby->insert;
+ die $error if $error;
+
+ }
+
+ $cust_main->complimentary('Y') if $cust_main->payby eq 'COMP';
+
+ $cust_main->invoice_attn( $cust_main->payname )
+ if $cust_main->payby eq 'BILL' && $cust_main->payname;
+ $cust_main->po_number( $cust_main->payinfo )
+ if $cust_main->payby eq 'BILL' && $cust_main->payinfo;
$cust_main->setfield($_, '') foreach @payfields;
- $error = $cust_main->replace;
- die $error if $error;
+ my $error = $cust_main->replace;
+ die "Error upgradging payment information for custnum ".
+ $cust_main->custnum. ": $error"
+ if $error;
};
projects / freeside.git / blobdiff