package FS::cust_main;
-
-require 5.006;
-use strict;
-use base qw( FS::cust_main::Packages FS::cust_main::Status
+use base qw( FS::cust_main::Packages
+ FS::cust_main::Status
FS::cust_main::NationalID
- FS::cust_main::Billing FS::cust_main::Billing_Realtime
+ 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::geocode_Mixin FS::Quotable_Mixin FS::Sales_Mixin
FS::o2m_Common
FS::Record
);
-use vars qw( $DEBUG $me $conf
- @encrypted_fields
- $import
- $ignore_expired_card $ignore_banned_card $ignore_illegal_zip
- $skip_fuzzyfiles
- @paytypes
- );
+
+require 5.006;
+use strict;
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 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::Msgcat qw(gettext);
use FS::CurrentUser;
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::agent;
use FS::agent_currency;
use FS::cust_main_invoice;
use FS::cust_tag;
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;
+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 {
$conf = new FS::Conf;
#yes, need it for stuff below (prolly should be cached)
+ $ignore_invalid_card = $conf->exists('allow_invalid_cards');
};
sub _cache {
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( {}, [ $email, 'POST' ] );
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_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 $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";
- }
-
+
+ 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;
foreach my $l (qw(bill_location ship_location)) {
warn " setting $l.custnum\n"
if $DEBUG > 1;
- my $loc = $self->$l;
+ my $loc = $self->$l or next;
unless ( $loc->custnum ) {
$loc->set(custnum => $self->custnum);
$error ||= $loc->replace;
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;
}
+ warn " setting contacts\n"
+ if $DEBUG > 1;
+
+ if ( my $contact = delete $options{'contact'} ) {
+
+ foreach my $c ( @$contact ) {
+ $c->custnum($self->custnum);
+ my $error = $c->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ }
+
+ } 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 ( 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"
if $DEBUG > 1;
#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_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,
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);
}
- 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'} ) {
- # card/check/lec info has changed, want to retry realtime_ invoice events
- my $error = $self->retry_realtime;
+ 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;
}
+
}
unless ( $import || $skip_fuzzyfiles ) {
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
- my @locations = $self->bill_location;
- push @locations, $self->ship_location if $self->has_ship_address;
+ foreach my $field ( 'first', 'last', 'company', 'ship_company' ) {
+ my $queue = new FS::queue {
+ 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
+ };
+ my @args = "cust_main.$field", $self->get($field);
+ my $error = $queue->insert( @args );
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "queueing job (transaction rolled back): $error";
+ }
+ }
+
+ my @locations = ();
+ push @locations, $self->bill_location if $self->bill_locationnum;
+ push @locations, $self->ship_location if @locations && $self->has_ship_address;
foreach my $location (@locations) {
my $queue = new FS::queue {
- 'job' => 'FS::cust_main::Search::append_fuzzyfiles'
+ 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
};
- my @args = map $location->get($_), @FS::cust_main::Search::fuzzyfields;
+ my @args = 'cust_location.address1', $location->address1;
my $error = $queue->insert( @args );
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
|| $self->ut_number('agentnum')
|| $self->ut_textn('agent_custid')
|| $self->ut_number('refnum')
- || $self->ut_foreign_key('bill_locationnum', 'cust_location','locationnum')
- || $self->ut_foreign_key('ship_locationnum', 'cust_location','locationnum')
+ || $self->ut_foreign_keyn('bill_locationnum', 'cust_location','locationnum')
+ || $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_snumbern('signupdate')
|| $self->ut_snumbern('birthdate')
+ || $self->ut_namen('spouse_last')
+ || $self->ut_namen('spouse_first')
|| $self->ut_snumbern('spouse_birthdate')
|| $self->ut_snumbern('anniversary_date')
|| $self->ut_textn('company')
+ || $self->ut_textn('ship_company')
|| $self->ut_anything('comments')
|| $self->ut_numbern('referral_custnum')
|| $self->ut_textn('stateid')
|| $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')
;
- my $company = $self->company;
- $company =~ s/^\s+//;
- $company =~ s/\s+$//;
- $company =~ s/\s+/ /g;
- $self->company($company);
+ foreach (qw(company ship_company)) {
+ my $company = $self->get($_);
+ $company =~ s/^\s+//;
+ $company =~ s/\s+$//;
+ $company =~ s/\s+/ /g;
+ $self->set($_, $company);
+ }
#barf. need message catalogs. i18n. etc.
$error .= "Please select an advertising source."
$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 =
}
### start of stuff moved to cust_payby
+ # then mostly kept here to support upgrades (can remove in 5.x)
+ # but modified to allow everything to be empty
- #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
- # or return "Illegal payby: ". $self->payby;
- #$self->payby($1);
- FS::payby->can_payby($self->table, $self->payby)
- or return "Illegal payby: ". $self->payby;
+ if ( $self->payby ) {
+ FS::payby->can_payby($self->table, $self->payby)
+ or return "Illegal payby: ". $self->payby;
+ } else {
+ $self->payby('');
+ }
$error = $self->ut_numbern('paystart_month')
|| $self->ut_numbern('paystart_year')
# Need some kind of global flag to accept invalid cards, for testing
# on scrubbed data.
- if ( !$import && $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
+ if ( !$import && !$ignore_invalid_card && $check_payinfo &&
+ $self->payby =~ /^(CARD|DCRD)$/ ) {
my $payinfo = $self->payinfo;
$payinfo =~ s/\D//g;
$self->payissue('');
}
- } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
+ } elsif ( !$ignore_invalid_card && $check_payinfo &&
+ $self->payby =~ /^(CHEK|DCHK)$/ ) {
my $payinfo = $self->payinfo;
$payinfo =~ s/[^\d\@\.]//g;
}
+ 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?
- unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD|PPAL)$/;
+ unless ! $self->payby
+ || $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD|PPAL)$/;
$self->paydate('');
} else {
my( $m, $y );
) {
$self->payname( $self->first. " ". $self->getfield('last') );
} else {
- $self->payname =~ /^([\w \,\.\-\'\&]+)$/
- or return gettext('illegal_name'). " payname: ". $self->payname;
- $self->payname($1);
+
+ if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
+ $self->payname =~ /^([\w \,\.\-\']*)$/
+ or return gettext('illegal_name'). " payname: ". $self->payname;
+ $self->payname($1);
+ } else {
+ $self->payname =~ /^([\w \,\.\-\'\&]*)$/
+ or return gettext('illegal_name'). " payname: ". $self->payname;
+ $self->payname($1);
+ }
+
}
### end of stuff moved to cust_payby
$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
sub cust_location {
my $self = shift;
- qsearch('cust_location', { 'custnum' => $self->custnum,
+ qsearch('cust_location', { 'custnum' => $self->custnum,
'prospectnum' => '' } );
}
=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
+
+Returns all payment methods (see L<FS::cust_payby>) for this customer.
+
+=cut
+
+sub cust_payby {
+ my $self = shift;
+ qsearch({
+ 'table' => 'cust_payby',
+ 'hashref' => { 'custnum' => $self->custnum },
+ '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 },
'',
Returns the agent (see L<FS::agent>) for this customer.
-=cut
-
-sub agent {
- my $self = shift;
- qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
-}
-
=item agent_name
Returns the agent name (see L<FS::agent>) for this customer.
Returns any tags associated with this customer, as FS::cust_tag objects,
or an empty list if there are no tags.
-=cut
-
-sub cust_tag {
- my $self = shift;
- qsearch('cust_tag', { 'custnum' => $self->custnum } );
-}
-
=item part_tag
Returns any tags associated with this customer, as FS::part_tag objects,
Returns the customer class, as an FS::cust_class object, or the empty string
if there is no customer class.
-=cut
-
-sub cust_class {
- my $self = shift;
- if ( $self->classnum ) {
- qsearchs('cust_class', { 'classnum' => $self->classnum } );
- } else {
- return '';
- }
-}
-
=item categoryname
Returns the customer category name, or the empty string if there is no customer
: '';
}
-=item BILLING METHODS
+=item tax_status
-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.
-
-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('');
- '';
-}
-
-=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.
-
-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.
-
-=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,
- );
- }
+ if ( $self->taxstatusnum ) {
+ qsearchs('tax_status', { 'taxstatusnum' => $self->taxstatusnum } );
+ } else {
+ return '';
+ }
+}
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
- my $dbh = dbh;
+=item taxstatus
- #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;
+Returns the tax status code if there is one.
- my %pay_batch = (
- 'status' => 'O',
- 'payby' => FS::payby->payby2payment($payby),
- );
- $pay_batch{agentnum} = $self->agentnum if $conf->exists('batch-spoolagent');
+=cut
- my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
+sub taxstatus {
+ my $self = shift;
+ my $tax_status = $self->tax_status;
+ $tax_status
+ ? $tax_status->taxstatus
+ : '';
+}
- 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";
- }
- }
+=item BILLING METHODS
- my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
- 'batchnum' => $pay_batch->batchnum,
- 'custnum' => $self->custnum,
- } );
+Documentation on billing methods has been moved to
+L<FS::cust_main::Billing>.
- foreach (qw( address1 address2 city state zip country latitude longitude
- payby payinfo paydate payname ))
- {
- $options{$_} = '' unless exists($options{$_});
- }
+=item REALTIME BILLING METHODS
- my $loc = $self->bill_location;
+Documentation on realtime billing methods has been moved to
+L<FS::cust_main::Billing_Realtime>.
- 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;
+=item remove_cvv
- my $error;
- if ($old_cust_pay_batch) {
- $error = $cust_pay_batch->replace($old_cust_pay_batch)
- } else {
- $error = $cust_pay_batch->insert;
- }
+Removes the I<paycvv> field from the database directly.
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- die $error;
- }
+If there is an error, returns the error, otherwise returns false.
- 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;
- }
- }
+=cut
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+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('');
'';
}
L<Date::Parse> for conversion functions. The empty string can be passed
to disable that time constraint completely.
-Available options are:
+Accepts the same options as L<balance_date_sql>:
=over 4
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)
+=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.
+
=back
=cut
);
}
-=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
-=cut
-
-sub cust_main_exemption {
- my $self = shift;
- qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
-}
-
=item invoicing_list [ ARRAYREF ]
If an arguement is given, sets these email addresses as invoice recipients
FS::reason_type for the new reason.
An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
+Likewise for I<eventnum>, I<commission_agentnum>, I<commission_salesnum> and
+I<commission_pkgnum>.
Any other options are passed to FS::cust_credit::insert.
$cust_credit->set('reason', $reason)
}
- for (qw( addlinfo eventnum )) {
- $cust_credit->$_( delete $options{$_} )
- if exists($options{$_});
- }
+ $cust_credit->$_( delete $options{$_} )
+ foreach grep exists($options{$_}),
+ qw( addlinfo eventnum ),
+ map "commission_$_", qw( agentnum salesnum pkgnum );
$cust_credit->insert(%options);
=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,
} );
);
}
+=item cust_credit_void
+
+Returns all voided credits (see L<FS::cust_credit_void>) for this customer.
+
+=cut
+
+sub cust_credit_void {
+ my $self = shift;
+ map { $_ }
+ sort { $a->_date <=> $b->_date }
+ qsearch( 'cust_credit_void', { 'custnum' => $self->custnum } )
+}
+
=item cust_pay
Returns all the payments (see L<FS::cust_pay>) for this customer.
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};
}
# code2country($self->country);
#}
+sub bill_country_full {
+ my $self = shift;
+ code2country($self->bill_location->country);
+}
+
+sub ship_country_full {
+ my $self = shift;
+ code2country($self->ship_location->country);
+}
+
=item county_state_county [ PREFIX ]
Returns a string consisting of just the county, state and country.
=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 active
+
+One or more recurring packages is active.
+
+=item inactive
-=item ordered - Recurring packages all are new (not yet billed).
+No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled).
-=item active - One or more recurring packages is active
+=item suspended
-=item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
+All non-cancelled recurring packages are suspended.
-=item suspended - All non-cancelled recurring packages are suspended
+=item cancelled
-=item cancelled - All recurring packages are 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.
=over 4
-=item batch_charge
-
-=cut
-
-sub batch_charge {
- my $param = shift;
- #warn join('-',keys %$param);
- my $fh = $param->{filehandle};
- my $agentnum = $param->{agentnum};
- my $format = $param->{format};
-
- my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
-
- my @fields;
- if ( $format eq 'simple' ) {
- @fields = qw( custnum agent_custid amount pkg );
- } else {
- die "unknown format $format";
- }
-
- eval "use Text::CSV_XS;";
- die $@ if $@;
-
- my $csv = new Text::CSV_XS;
- #warn $csv;
- #warn $fh;
-
- my $imported = 0;
- #my $columns;
-
- 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;
-
- #while ( $columns = $csv->getline($fh) ) {
- my $line;
- while ( defined($line=<$fh>) ) {
-
- $csv->parse($line) or do {
- $dbh->rollback if $oldAutoCommit;
- return "can't parse: ". $csv->error_input();
- };
-
- my @columns = $csv->fields();
- #warn join('-',@columns);
-
- my %row = ();
- foreach my $field ( @fields ) {
- $row{$field} = shift @columns;
- }
-
- if ( $row{custnum} && $row{agent_custid} ) {
- dbh->rollback if $oldAutoCommit;
- return "can't specify custnum with agent_custid $row{agent_custid}";
- }
-
- my %hash = ();
- if ( $row{agent_custid} && $agentnum ) {
- %hash = ( 'agent_custid' => $row{agent_custid},
- 'agentnum' => $agentnum,
- );
- }
-
- if ( $row{custnum} ) {
- %hash = ( 'custnum' => $row{custnum} );
- }
-
- unless ( scalar(keys %hash) ) {
- $dbh->rollback if $oldAutoCommit;
- return "can't find customer without custnum or agent_custid and agentnum";
- }
-
- my $cust_main = qsearchs('cust_main', { %hash } );
- unless ( $cust_main ) {
- $dbh->rollback if $oldAutoCommit;
- my $custnum = $row{custnum} || $row{agent_custid};
- return "unknown custnum $custnum";
- }
-
- if ( $row{'amount'} > 0 ) {
- my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- $imported++;
- } elsif ( $row{'amount'} < 0 ) {
- my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
- $row{'pkg'} );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- $imported++;
- } else {
- #hmm?
- }
-
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- return "Empty file!" unless $imported;
-
- ''; #no error
-
-}
-
=item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
Deprecated. Use event notification and message templates
return unless $conf->exists($template);
- my $from = $conf->config('invoice_from', $self->agentnum)
+ my $from = $conf->invoice_from_full($self->agentnum)
if $conf->exists('invoice_from', $self->agentnum);
$from = $options{from} if exists($options{from});
my %opt = @_;
my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
- or die "invalid customer number: " . $opt{custvnum};
+ or die "invalid customer number: " . $opt{custnum};
- my $error = $self->print( $opt{template} );
+ my $error = $self->print( { 'template' => $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.
my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
+ #without this errors don't get rolled back
+ $args{'fatal'} = 1; # runs from job queue, will be caught
+
$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;
# JRNL seq scan of cust_main on paydate... index on substrings? maybe set an
# JRNL seq scan of cust_main on payinfo.. certainly not going toi ndex that...
# JRNL leading/trailing spaces in first, last, company
+# JRNL migrate to cust_payby
# - otaker upgrade? journal and call it good? (double check to make sure
# we're not still setting otaker here)
#
}
+ unless ( FS::upgrade_journal->is_done('cust_main__cust_payby') ) {
+
+ #we don't want to decrypt them, just stuff them as-is into cust_payby
+ local(@encrypted_fields) = ();
+
+ local($FS::cust_payby::ignore_expired_card) = 1;
+ local($FS::cust_payby::ignore_banned_card) = 1;
+
+ my @payfields = qw( payby payinfo paycvv paymask
+ paydate paystart_month paystart_year payissue
+ payname paystate paytype payip
+ );
+
+ my $search = new FS::Cursor {
+ 'table' => 'cust_main',
+ 'extra_sql' => " WHERE ( payby IS NOT NULL AND payby != '' ) ",
+ };
+
+ while (my $cust_main = $search->fetch) {
+
+ unless ( $cust_main->payby =~ /^(BILL|COMP)$/ ) {
+
+ 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;
+ my $error = $cust_main->replace;
+ die "Error upgradging payment information for custnum ".
+ $cust_main->custnum. ": $error"
+ if $error;
+
+ };
+
+ FS::upgrade_journal->set_done('cust_main__cust_payby');
+ }
+
$class->_upgrade_otaker(%opts);
}
projects / freeside.git / blobdiff