package FS::cust_main;
-
-require 5.006;
-use strict;
- #FS::cust_main:_Marketgear when they're ready to move to 2.1
use base qw( FS::cust_main::Packages
- FS::cust_main::Billing FS::cust_main::Billing_Realtime
- FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin
+ FS::cust_main::Status
+ 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::cust_main_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_illegal_zip $ignore_banned_card
- $skip_fuzzyfiles @fuzzyfields
- @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 File::Temp; #qw( tempfile );
use Business::CreditCard 0.28;
-use Locale::Country;
-use FS::UID qw( getotaker dbh driver_name );
+use List::Util qw(min);
+use Try::Tiny;
+use FS::UID qw( dbh driver_name );
use FS::Record qw( qsearchs qsearch dbdef regexp_sql );
-use FS::Misc qw( generate_email send_email generate_ps do_print );
+use FS::Cursor;
+use FS::Misc qw( generate_ps do_print money_pretty card_types );
use FS::Msgcat qw(gettext);
use FS::CurrentUser;
+use FS::TicketSystem;
use FS::payby;
use FS::cust_pkg;
use FS::cust_svc;
use FS::cust_bill;
+use FS::cust_bill_void;
+use FS::legacy_cust_bill;
use FS::cust_pay;
use FS::cust_pay_pending;
use FS::cust_pay_void;
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::prepay_credit;
use FS::payment_gateway;
use FS::agent_payment_gateway;
use FS::banned_pay;
-use FS::TicketSystem;
+use FS::cust_main_note;
+use FS::cust_attachment;
+use FS::cust_contact;
+use FS::Locales;
+use FS::upgrade_journal;
+use FS::sales;
+use FS::cust_payby;
+use FS::contact;
+use FS::reason;
# 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_illegal_zip = 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;
-@fuzzyfields = ( 'first', 'last', 'company', 'address1' );
+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;
+our $default_agent_custid;
+our $custnum_display_length;
#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');
+ $default_agent_custid = $conf->exists('cust_main-default_agent_custid');
+ $custnum_display_length = $conf->config('cust_main-custnum-display_length');
};
sub _cache {
(optional)
-=item address1
-
-=item address2
-
-(optional)
-
-=item city
-
-=item county
-
-(optional, see L<FS::cust_main_county>)
-
-=item state
-
-(see L<FS::cust_main_county>)
-
-=item zip
-
-=item country
-
-(see L<FS::cust_main_county>)
-
=item daytime
phone (optional)
phone (optional)
-=item ship_first
-
-Shipping first name
-
-=item ship_last
-
-Shipping last name
-
-=item ship_company
-
-(optional)
-
-=item ship_address1
-
-=item ship_address2
-
-(optional)
-
-=item ship_city
-
-=item ship_county
-
-(optional, see L<FS::cust_main_county>)
-
-=item ship_state
-
-(see L<FS::cust_main_county>)
-
-=item ship_zip
-
-=item ship_country
-
-(see L<FS::cust_main_county>)
-
-=item ship_daytime
-
-phone (optional)
-
-=item ship_night
-
-phone (optional)
-
-=item ship_fax
+=item mobile
phone (optional)
Discourage individual CDR printing, empty or `Y'
+=item edit_subject
+
+Allow self-service editing of ticket subjects, empty or 'Y'
+
+=item calling_list_exempt
+
+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
Adds this customer to the database. If there is an error, returns the error,
otherwise returns false.
+Usually the customer's location will not yet exist in the database, and
+the C<bill_location> and C<ship_location> pseudo-fields must be set to
+uninserted L<FS::cust_location> objects. These will be inserted and linked
+(in both directions) to the new customer record. If they're references
+to the same object, they will become the same location.
+
CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
are inserted atomicly, or the transaction is rolled back. Passing an empty
);
$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> and I<tax_exemption>.
+Currently available options are: I<depend_jobnum>, I<noexport>,
+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).
provisioning jobs (exports) are scheduled. (You can schedule them later with
the B<reexport> method.)
-The I<tax_exemption> option can be set to an arrayref of tax names.
-FS::cust_main_exemption records will be created and inserted.
+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
+created and inserted.
+
+If I<prospectnum> is set, moves contacts and locations from that prospect.
+
+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)$/ ) {
+ } 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} or next;
+
+ if ( !$loc->locationnum ) {
+ # warn the location that we're going to insert it with no custnum
+ $loc->set(custnum_pending => 1);
+ warn " inserting $l\n"
+ if $DEBUG > 1;
+ my $error = $loc->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ my $label = $l eq 'ship_location' ? 'service' : 'billing';
+ return "$error (in $label location)";
+ }
+
+ } 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;
+ }
+ # else it already belongs to this customer
+ # (happens when ship_location is identical to bill_location)
+
+ $self->set($l.'num', $loc->locationnum);
+
+ if ( $self->get($l.'num') eq '' ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "$l not set";
+ }
+ }
+
warn " inserting $self\n"
if $DEBUG > 1;
$self->auto_agent_custid()
if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
- my $error = $self->SUPER::insert;
+ my $error = $self->check_payinfo_cardtype
+ || $self->SUPER::insert;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
#return "inserting cust_main record (transaction rolled back): $error";
return $error;
}
- warn " setting invoicing list\n"
- if $DEBUG > 1;
+ # now set cust_location.custnum
+ foreach my $l (qw(bill_location ship_location)) {
+ warn " setting $l.custnum\n"
+ if $DEBUG > 1;
+ my $loc = $self->$l or next;
+ unless ( $loc->custnum ) {
+ $loc->set(custnum => $self->custnum);
+ $error ||= $loc->replace;
+ }
- 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;
+ return "error setting $l custnum: $error";
}
- $self->invoicing_list( $invoicing_list );
}
warn " setting customer tags\n"
}
}
+ my $prospectnum = delete $options{'prospectnum'};
+ if ( $prospectnum ) {
+
+ warn " moving contacts and locations from prospect $prospectnum\n"
+ if $DEBUG > 1;
+
+ my $prospect_main =
+ qsearchs('prospect_main', { 'prospectnum' => $prospectnum } );
+ unless ( $prospect_main ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Unknown prospectnum $prospectnum";
+ }
+ $prospect_main->custnum($self->custnum);
+ $prospect_main->disabled('Y');
+ my $error = $prospect_main->replace;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ foreach my $prospect_contact ( $prospect_main->prospect_contact ) {
+ my $cust_contact = new FS::cust_contact {
+ 'custnum' => $self->custnum,
+ 'invoice_dest' => 'Y', # invoice_dest currently not set for prospect contacts
+ 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 ( @cust_location, @qual ) {
+ $r->prospectnum('');
+ $r->custnum($self->custnum);
+ my $error = $r->replace;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+ # since we set invoice_dest on all migrated prospect contacts (for now),
+ # don't process invoicing_list.
+ delete $options{'invoicing_list'};
+ $invoicing_list = undef;
+ }
+
+ warn " setting contacts\n"
+ if $DEBUG > 1;
+
+ $invoicing_list ||= $options{'invoicing_list'};
if ( $invoicing_list ) {
- $error = $self->check_invoicing_list( $invoicing_list );
+
+ $invoicing_list = [ $invoicing_list ] if !ref($invoicing_list);
+
+ my $email = '';
+ foreach my $dest (@$invoicing_list ) {
+ if ($dest eq 'POST') {
+ $self->set('postal_invoice', 'Y');
+ } else {
+
+ my $contact_email = qsearchs('contact_email', { emailaddress => $dest });
+ if ( $contact_email ) {
+ my $cust_contact = FS::cust_contact->new({
+ contactnum => $contact_email->contactnum,
+ custnum => $self->custnum,
+ });
+ $cust_contact->set('invoice_dest', 'Y');
+ my $error = $cust_contact->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "$error (linking to email address $dest)";
+ }
+
+ } else {
+ # this email address is not yet linked to any contact
+ $email .= ',' if length($email);
+ $email .= $dest;
+ }
+ }
+ }
+
+ my $contact = FS::contact->new({
+ 'custnum' => $self->get('custnum'),
+ 'last' => $self->get('last'),
+ 'first' => $self->get('first'),
+ 'emailaddress' => $email,
+ 'invoice_dest' => 'Y', # yes, you can set this via the contact
+ });
+ 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);
+ 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 "checking invoicing_list (transaction rolled back): $error";
return $error;
}
- $self->invoicing_list( $invoicing_list );
}
+ 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"
if $DEBUG > 1;
my $tax_exemption = delete $options{'tax_exemption'};
if ( $tax_exemption ) {
- foreach my $taxname ( @$tax_exemption ) {
+
+ $tax_exemption = { map { $_ => '' } @$tax_exemption }
+ if ref($tax_exemption) eq 'ARRAY';
+
+ foreach my $taxname ( keys %$tax_exemption ) {
my $cust_main_exemption = new FS::cust_main_exemption {
- 'custnum' => $self->custnum,
- 'taxname' => $taxname,
+ 'custnum' => $self->custnum,
+ 'taxname' => $taxname,
+ 'exempt_number' => $tax_exemption->{$taxname},
};
my $error = $cust_main_exemption->insert;
if ( $error ) {
}
}
- if ( $self->can('start_copy_skel') ) {
- my $error = $self->start_copy_skel;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
warn " ordering packages\n"
if $DEBUG > 1;
}
}
+ # FS::geocode_Mixin::after_insert or something?
+ if ( $conf->config('tax_district_method') and !$import ) {
+ # if anything non-empty, try to look it up
+ my $queue = new FS::queue {
+ 'job' => 'FS::geocode_Mixin::process_district_update',
+ 'custnum' => $self->custnum,
+ };
+ my $error = $queue->insert( ref($self), $self->custnum );
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "queueing tax district update: $error";
+ }
+ }
+
# cust_main exports!
warn " exporting\n" if $DEBUG > 1;
$prepay_credit = qsearchs(
'prepay_credit',
- { 'identifier' => $prepay_credit },
+ { 'identifier' => $identifier },
'',
'FOR UPDATE'
);
}
-=item reexport
-
-This method is deprecated. See the I<depend_jobnum> option to the insert and
-order_pkgs methods for a better way to defer provisioning.
-
-Re-schedules all exports by calling the B<reexport> method of all associated
-packages (see L<FS::cust_pkg>). If there is an error, returns the error;
-otherwise returns false.
-
-=cut
-
-sub reexport {
- my $self = shift;
-
- carp "WARNING: FS::cust_main::reexport is deprectated; ".
- "use the depend_jobnum option to insert or order_pkgs to delay export";
-
- 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;
-
- foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
- my $error = $cust_pkg->reexport;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-
-}
-
=item delete [ OPTION => VALUE ... ]
This deletes the customer. If there is an error, returns the error, otherwise
#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 replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
-
Replaces the OLD_RECORD with this one in the database. If there is an error,
returns the error, otherwise returns false.
-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:
+To change the customer's address, set the pseudo-fields C<bill_location> and
+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 arrayref to this method, it will be
+set as the contact email address for a default contact with the same name as
+the customer.
+
+Currently available options are: I<tax_exemption>, I<cust_payby_params>,
+I<contact_params>, I<invoicing_list>.
- $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
+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.
-Currently available options are: I<tax_exemption>.
+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.
-The I<tax_exemption> option can be set to an arrayref of tax names.
-FS::cust_main_exemption records will be deleted and inserted as appropriate.
+I<invoicing_list> is a synonym for the INVOICING_LIST_ARYREF parameter, and
+should be used instead if possible.
=cut
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)$/
&& $self->payby =~ /^(CARD|DCRD)$/
&& ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
+ local($ignore_banned_card) = 1
+ if ( $old->payby =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/
+ || $old->payby =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ )
+ && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
+
+ if ( $self->payby =~ /^(CARD|DCRD)$/
+ && $old->payinfo ne $self->payinfo
+ && $old->paymask ne $self->paymask )
+ {
+ my $error = $self->check_payinfo_cardtype;
+ return $error if $error;
+ }
+
+ return "Invoicing locale is required"
+ if $old->locale
+ && ! $self->locale
+ && $conf->exists('cust_main-require_locale');
+
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $SIG{QUIT} = 'IGNORE';
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
- my $error = $self->SUPER::replace($old);
-
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
+ for my $l (qw(bill_location ship_location)) {
+ #my $old_loc = $old->$l;
+ my $new_loc = $self->$l or next;
- if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
- my $invoicing_list = shift @param;
- $error = $self->check_invoicing_list( $invoicing_list );
+ # find the existing location if there is one
+ $new_loc->set('custnum' => $self->custnum);
+ my $error = $new_loc->find_or_insert;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
}
- $self->invoicing_list( $invoicing_list );
+ $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;
}
- if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
+ my %options = @param;
- #this could be more efficient than deleting and re-inserting, if it matters
- foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
- my $error = $cust_tag->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
- foreach my $tagnum ( @{ $self->tagnum || [] } ) {
- my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
- 'custnum' => $self->custnum };
- my $error = $cust_tag->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
+ $invoicing_list ||= $options{invoicing_list};
+
+ my @contacts = map { $_->contact } $self->cust_contact;
+ # find a contact that matches the customer's name
+ my ($implicit_contact) = grep { $_->first eq $old->get('first')
+ and $_->last eq $old->get('last') }
+ @contacts;
+ $implicit_contact ||= FS::contact->new({
+ 'custnum' => $self->custnum,
+ 'locationnum' => $self->get('bill_locationnum'),
+ });
+
+ # for any of these that are already contact emails, link to the existing
+ # contact
+ if ( $invoicing_list ) {
+ my $email = '';
+
+ # kind of like process_m2m on these, except:
+ # - the other side is two tables in a join
+ # - and we might have to create new contact_emails
+ # - and possibly a new contact
+ #
+ # Find existing invoice emails that aren't on the implicit contact.
+ # Any of these that are not on the new invoicing list will be removed.
+ my %old_email_cust_contact;
+ foreach my $cust_contact ($self->cust_contact) {
+ next if !$cust_contact->invoice_dest;
+ next if $cust_contact->contactnum == ($implicit_contact->contactnum || 0);
+
+ foreach my $contact_email ($cust_contact->contact->contact_email) {
+ $old_email_cust_contact{ $contact_email->emailaddress } = $cust_contact;
}
}
- }
+ foreach my $dest (@$invoicing_list) {
- my %options = @param;
+ if ($dest eq 'POST') {
- my $tax_exemption = delete $options{'tax_exemption'};
- if ( $tax_exemption ) {
+ $self->set('postal_invoice', 'Y');
- my %cust_main_exemption =
- map { $_->taxname => $_ }
- qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
+ } elsif ( exists($old_email_cust_contact{$dest}) ) {
- foreach my $taxname ( @$tax_exemption ) {
+ delete $old_email_cust_contact{$dest}; # don't need to remove it, then
- next if delete $cust_main_exemption{$taxname};
+ } else {
- my $cust_main_exemption = new FS::cust_main_exemption {
- 'custnum' => $self->custnum,
- 'taxname' => $taxname,
- };
- my $error = $cust_main_exemption->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
+ # See if it belongs to some other contact; if so, link it.
+ my $contact_email = qsearchs('contact_email', { emailaddress => $dest });
+ if ( $contact_email
+ and $contact_email->contactnum != ($implicit_contact->contactnum || 0) ) {
+ my $cust_contact = qsearchs('cust_contact', {
+ contactnum => $contact_email->contactnum,
+ custnum => $self->custnum,
+ }) || FS::cust_contact->new({
+ contactnum => $contact_email->contactnum,
+ custnum => $self->custnum,
+ });
+ $cust_contact->set('invoice_dest', 'Y');
+ my $error = $cust_contact->custcontactnum ?
+ $cust_contact->replace : $cust_contact->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "$error (linking to email address $dest)";
+ }
+
+ } else {
+ # This email address is not yet linked to any contact, so it will
+ # be added to the implicit contact.
+ $email .= ',' if length($email);
+ $email .= $dest;
+ }
+ }
+ }
+
+ foreach my $remove_dest (keys %old_email_cust_contact) {
+ my $cust_contact = $old_email_cust_contact{$remove_dest};
+ # These were not in the list of requested destinations, so take them off.
+ $cust_contact->set('invoice_dest', '');
+ my $error = $cust_contact->replace;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "$error (unlinking email address $remove_dest)";
+ }
+ }
+
+ # make sure it keeps up with the changed customer name, if any
+ $implicit_contact->set('last', $self->get('last'));
+ $implicit_contact->set('first', $self->get('first'));
+ $implicit_contact->set('emailaddress', $email);
+ $implicit_contact->set('invoice_dest', 'Y');
+ $implicit_contact->set('custnum', $self->custnum);
+
+ my $error;
+ if ( $implicit_contact->contactnum ) {
+ $error = $implicit_contact->replace;
+ } elsif ( length($email) ) { # don't create a new contact if not needed
+ $error = $implicit_contact->insert;
+ }
+
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "$error (adding email address $email)";
+ }
+
+ }
+
+ # replace the customer record
+ my $error = $self->SUPER::replace($old);
+
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ # now move packages to the new service location
+ $self->set('ship_location', ''); #flush cache
+ if ( $old->ship_locationnum and # should only be null during upgrade...
+ $old->ship_locationnum != $self->ship_locationnum ) {
+ $error = $old->ship_location->move_to($self->ship_location);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+ # don't move packages based on the billing location, but
+ # disable it if it's no longer in use
+ if ( $old->bill_locationnum and
+ $old->bill_locationnum != $self->bill_locationnum ) {
+ $error = $old->bill_location->disable_if_unused;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ 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
+ foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
+ my $error = $cust_tag->delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+ foreach my $tagnum ( @{ $self->tagnum || [] } ) {
+ my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
+ 'custnum' => $self->custnum };
+ my $error = $cust_tag->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ }
+
+ my $tax_exemption = delete $options{'tax_exemption'};
+ if ( $tax_exemption ) {
+
+ $tax_exemption = { map { $_ => '' } @$tax_exemption }
+ if ref($tax_exemption) eq 'ARRAY';
+
+ my %cust_main_exemption =
+ map { $_->taxname => $_ }
+ qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
+
+ foreach my $taxname ( keys %$tax_exemption ) {
+
+ if ( $cust_main_exemption{$taxname} &&
+ $cust_main_exemption{$taxname}->exempt_number eq $tax_exemption->{$taxname}
+ )
+ {
+ delete $cust_main_exemption{$taxname};
+ next;
+ }
+
+ my $cust_main_exemption = new FS::cust_main_exemption {
+ 'custnum' => $self->custnum,
+ 'taxname' => $taxname,
+ 'exempt_number' => $tax_exemption->{$taxname},
+ };
+ my $error = $cust_main_exemption->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
return "inserting cust_main_exemption (transaction rolled back): $error";
}
}
}
- 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 ) {
}
}
+ # tax district update in cust_location
+
# cust_main exports!
my $export_args = $options{'export_args'} || [];
=cut
+use FS::cust_main::Search;
sub queue_fuzzyfiles_update {
my $self = shift;
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
- my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
- my $error = $queue->insert( map $self->getfield($_), @fuzzyfields );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "queueing job (transaction rolled back): $error";
+ 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";
+ }
}
- if ( $self->ship_last ) {
- $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
- $error = $queue->insert( map $self->getfield("ship_$_"), @fuzzyfields );
+ 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_fuzzyfield'
+ };
+ my @args = 'cust_location.address1', $location->address1;
+ my $error = $queue->insert( @args );
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return "queueing job (transaction rolled back): $error";
|| $self->ut_number('agentnum')
|| $self->ut_textn('agent_custid')
|| $self->ut_number('refnum')
+ || $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('birthdate')
|| $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_text('address1')
- || $self->ut_textn('address2')
- || $self->ut_text('city')
- || $self->ut_textn('county')
- || $self->ut_textn('state')
- || $self->ut_country('country')
+ || $self->ut_textn('ship_company')
|| $self->ut_anything('comments')
|| $self->ut_numbern('referral_custnum')
|| $self->ut_textn('stateid')
|| $self->ut_textn('stateid_state')
|| $self->ut_textn('invoice_terms')
- || $self->ut_alphan('geocode')
|| $self->ut_floatn('cdr_termination_percentage')
|| $self->ut_floatn('credit_limit')
+ || $self->ut_numbern('billday')
+ || $self->ut_numbern('prorate_day')
+ || $self->ut_flag('edit_subject')
+ || $self->ut_flag('calling_list_exempt')
+ || $self->ut_flag('invoice_noemail')
+ || $self->ut_flag('message_noemail')
+ || $self->ut_enum('locale', [ '', FS::Locales->locales ])
+ || $self->ut_currencyn('currency')
+ || $self->ut_textn('po_number')
+ || $self->ut_enum('complimentary', [ '', 'Y' ])
+ || $self->ut_flag('invoice_ship_address')
+ || $self->ut_flag('invoice_dest')
;
+ 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."
if $error =~ /^Illegal or empty \(numeric\) refnum: /;
return $error if $error;
- return "Unknown agent"
- unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
+ my $agent = qsearchs( 'agent', { 'agentnum' => $self->agentnum } )
+ or return "Unknown agent";
+
+ if ( $self->currency ) {
+ my $agent_currency = qsearchs( 'agent_currency', {
+ 'agentnum' => $agent->agentnum,
+ 'currency' => $self->currency,
+ })
+ or return "Agent ". $agent->agent.
+ " not permitted to offer ". $self->currency. " invoicing";
+ }
return "Unknown refnum"
unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
unless ! $self->referral_custnum
|| qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
- if ( $self->censustract ne '' ) {
- $self->censustract =~ /^\s*(\d{9})\.?(\d{2})\s*$/
- or return "Illegal census tract: ". $self->censustract;
-
- $self->censustract("$1.$2");
- }
-
if ( $self->ss eq '' ) {
$self->ss('');
} else {
$self->ss("$1-$2-$3");
}
-
-# bad idea to disable, causes billing to fail because of no tax rates later
-# except we don't fail any more
- unless ( $import ) {
- unless ( qsearch('cust_main_county', {
- 'country' => $self->country,
- 'state' => '',
- } ) ) {
- return "Unknown state/county/country: ".
- $self->state. "/". $self->county. "/". $self->country
- unless qsearch('cust_main_county',{
- 'state' => $self->state,
- 'county' => $self->county,
- 'country' => $self->country,
- } );
- }
+ #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 =
- $self->ut_phonen('daytime', $self->country)
- || $self->ut_phonen('night', $self->country)
- || $self->ut_phonen('fax', $self->country)
+ $self->ut_phonen('daytime', $self->country)
+ || $self->ut_phonen('night', $self->country)
+ || $self->ut_phonen('fax', $self->country)
+ || $self->ut_phonen('mobile', $self->country)
;
return $error if $error;
- unless ( $ignore_illegal_zip ) {
- $error = $self->ut_zip('zip', $self->country);
- return $error if $error;
- }
-
- if ( $conf->exists('cust_main-require_phone')
- && ! length($self->daytime) && ! length($self->night)
+ if ( $conf->exists('cust_main-require_phone', $self->agentnum)
+ && ! $import
+ && ! length($self->daytime) && ! length($self->night) && ! length($self->mobile)
) {
my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
? 'Night Phone'
: FS::Msgcat::_gettext('night');
-
- return "$daytime_label or $night_label is required"
-
- }
-
- if ( $self->has_ship_address
- && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
- $self->addr_fields )
- )
- {
- my $error =
- $self->ut_name('ship_last')
- || $self->ut_name('ship_first')
- || $self->ut_textn('ship_company')
- || $self->ut_text('ship_address1')
- || $self->ut_textn('ship_address2')
- || $self->ut_text('ship_city')
- || $self->ut_textn('ship_county')
- || $self->ut_textn('ship_state')
- || $self->ut_country('ship_country')
- ;
- return $error if $error;
-
- #false laziness with above
- unless ( qsearchs('cust_main_county', {
- 'country' => $self->ship_country,
- 'state' => '',
- } ) ) {
- return "Unknown ship_state/ship_county/ship_country: ".
- $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
- unless qsearch('cust_main_county',{
- 'state' => $self->ship_state,
- 'county' => $self->ship_county,
- 'country' => $self->ship_country,
- } );
- }
- #eofalse
- $error =
- $self->ut_phonen('ship_daytime', $self->ship_country)
- || $self->ut_phonen('ship_night', $self->ship_country)
- || $self->ut_phonen('ship_fax', $self->ship_country)
- ;
- return $error if $error;
-
- unless ( $ignore_illegal_zip ) {
- $error = $self->ut_zip('ship_zip', $self->ship_country);
- return $error if $error;
- }
- return "Unit # is required."
- if $self->ship_address2 =~ /^\s*$/
- && $conf->exists('cust_main-require_address2');
-
- } else { # ship_ info eq billing info, so don't store dup info in database
-
- $self->setfield("ship_$_", '')
- foreach $self->addr_fields;
-
- return "Unit # is required."
- if $self->address2 =~ /^\s*$/
- && $conf->exists('cust_main-require_address2');
+ my $mobile_label = FS::Msgcat::_gettext('mobile') =~ /^(mobile)?$/
+ ? 'Mobile Phone'
+ : FS::Msgcat::_gettext('mobile');
+ return "$daytime_label, $night_label or $mobile_label is required"
+
}
- #$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;
+ return "Please select an invoicing locale"
+ if ! $self->locale
+ && ! $self->custnum
+ && $conf->exists('cust_main-require_locale');
- $error = $self->ut_numbern('paystart_month')
- || $self->ut_numbern('paystart_year')
- || $self->ut_numbern('payissue')
- || $self->ut_textn('paytype')
- ;
- return $error if $error;
-
- if ( $self->payip eq '' ) {
- $self->payip('');
- } else {
- $error = $self->ut_ip('payip');
- return $error if $error;
+ foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
+ $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
+ $self->$flag($1);
}
- # If it is encrypted and the private key is not availaible then we can't
- # check the credit card.
- my $check_payinfo = ! $self->is_encrypted($self->payinfo);
-
- if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
-
- my $payinfo = $self->payinfo;
- $payinfo =~ s/\D//g;
- $payinfo =~ /^(\d{13,16})$/
- or return gettext('invalid_card'); # . ": ". $self->payinfo;
- $payinfo = $1;
- $self->payinfo($payinfo);
- validate($payinfo)
- or return gettext('invalid_card'); # . ": ". $self->payinfo;
-
- return gettext('unknown_card_type')
- if $self->payinfo !~ /^99\d{14}$/ #token
- && cardtype($self->payinfo) eq "Unknown";
-
- unless ( $ignore_banned_card ) {
- my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
- if ( $ban ) {
- return 'Banned credit card: banned on '.
- time2str('%a %h %o at %r', $ban->_date).
- ' by '. $ban->otaker.
- ' (ban# '. $ban->bannum. ')';
- }
- }
-
- if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
- if ( cardtype($self->payinfo) eq 'American Express card' ) {
- $self->paycvv =~ /^(\d{4})$/
- or return "CVV2 (CID) for American Express cards is four digits.";
- $self->paycvv($1);
- } else {
- $self->paycvv =~ /^(\d{3})$/
- or return "CVV2 (CVC2/CID) is three digits.";
- $self->paycvv($1);
- }
- } else {
- $self->paycvv('');
- }
-
- my $cardtype = cardtype($payinfo);
- if ( $cardtype =~ /^(Switch|Solo)$/i ) {
-
- return "Start date or issue number is required for $cardtype cards"
- unless $self->paystart_month && $self->paystart_year or $self->payissue;
-
- return "Start month must be between 1 and 12"
- if $self->paystart_month
- and $self->paystart_month < 1 || $self->paystart_month > 12;
-
- return "Start year must be 1990 or later"
- if $self->paystart_year
- and $self->paystart_year < 1990;
-
- return "Issue number must be beween 1 and 99"
- if $self->payissue
- and $self->payissue < 1 || $self->payissue > 99;
-
- } else {
- $self->paystart_month('');
- $self->paystart_year('');
- $self->payissue('');
- }
-
- } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
+ $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
- my $payinfo = $self->payinfo;
- $payinfo =~ s/[^\d\@]//g;
- if ( $conf->exists('echeck-nonus') ) {
- $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
- $payinfo = "$1\@$2";
- } else {
- $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
- $payinfo = "$1\@$2";
- }
- $self->payinfo($payinfo);
- $self->paycvv('');
-
- unless ( $ignore_banned_card ) {
- my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
- if ( $ban ) {
- return 'Banned ACH account: banned on '.
- time2str('%a %h %o at %r', $ban->_date).
- ' by '. $ban->otaker.
- ' (ban# '. $ban->bannum. ')';
- }
- }
+ warn "$me check AFTER: \n". $self->_dump
+ if $DEBUG > 2;
- } elsif ( $self->payby eq 'LECB' ) {
+ $self->SUPER::check;
+}
- my $payinfo = $self->payinfo;
- $payinfo =~ s/\D//g;
- $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
- $payinfo = $1;
- $self->payinfo($payinfo);
- $self->paycvv('');
+sub check_payinfo_cardtype {
+ my $self = shift;
- } elsif ( $self->payby eq 'BILL' ) {
+ return '' unless $self->payby =~ /^(CARD|DCRD)$/;
- $error = $self->ut_textn('payinfo');
- return "Illegal P.O. number: ". $self->payinfo if $error;
- $self->paycvv('');
+ my $payinfo = $self->payinfo;
+ $payinfo =~ s/\D//g;
- } elsif ( $self->payby eq 'COMP' ) {
+ return '' if $payinfo =~ /^99\d{14}$/; #token
- my $curuser = $FS::CurrentUser::CurrentUser;
- if ( ! $self->custnum
- && ! $curuser->access_right('Complimentary customer')
- )
- {
- return "You are not permitted to create complimentary accounts."
- }
+ my %bop_card_types = map { $_=>1 } values %{ card_types() };
+ my $cardtype = cardtype($payinfo);
- $error = $self->ut_textn('payinfo');
- return "Illegal comp account issuer: ". $self->payinfo if $error;
- $self->paycvv('');
+ return "$cardtype not accepted" unless $bop_card_types{$cardtype};
- } elsif ( $self->payby eq 'PREPAY' ) {
+ '';
- my $payinfo = $self->payinfo;
- $payinfo =~ s/\W//g; #anything else would just confuse things
- $self->payinfo($payinfo);
- $error = $self->ut_alpha('payinfo');
- return "Illegal prepayment identifier: ". $self->payinfo if $error;
- return "Unknown prepayment identifier"
- unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
- $self->paycvv('');
+}
- }
+=item replace_check
- if ( $self->paydate eq '' || $self->paydate eq '-' ) {
- return "Expiration date required"
- unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
- $self->paydate('');
- } else {
- my( $m, $y );
- if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
- ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
- } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
- ( $m, $y ) = ( $2, "19$1" );
- } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
- ( $m, $y ) = ( $3, "20$2" );
- } else {
- return "Illegal expiration date: ". $self->paydate;
- }
- $self->paydate("$y-$m-01");
- my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
- return gettext('expired_card')
- if !$import
- && !$ignore_expired_card
- && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
- }
+Additional checks for replace only.
- if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
- ( ! $conf->exists('require_cardname')
- || $self->payby !~ /^(CARD|DCRD)$/ )
- ) {
- $self->payname( $self->first. " ". $self->getfield('last') );
- } else {
- $self->payname =~ /^([\w \,\.\-\'\&]+)$/
- or return gettext('illegal_name'). " payname: ". $self->payname;
- $self->payname($1);
- }
+=cut
- foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
- $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
- $self->$flag($1);
+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);
}
-
- $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
-
- warn "$me check AFTER: \n". $self->_dump
- if $DEBUG > 2;
-
- $self->SUPER::check;
+ return '';
}
=item addr_fields
sub addr_fields {
qw( last first company
+ locationname
address1 address2 city county state zip country
- daytime night fax
+ latitude longitude
+ daytime night fax mobile
);
}
sub has_ship_address {
my $self = shift;
- scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
+ $self->bill_locationnum != $self->ship_locationnum;
}
=item location_hash
-Returns a list of key/value pairs, with the following keys: address1, adddress2,
-city, county, state, zip, country. The shipping address is used if present.
+Returns a list of key/value pairs, with the following keys: address1,
+adddress2, city, county, state, zip, country, district, and geocode. The
+shipping address is used if present.
=cut
-#geocode? dependent on tax-ship_address config, not available in cust_location
-#mostly. not yet then.
-
sub location_hash {
my $self = shift;
- my $prefix = $self->has_ship_address ? 'ship_' : '';
-
- map { $_ => $self->get($prefix.$_) }
- qw( address1 address2 city county state zip country geocode );
- #fields that cust_location has
+ $self->ship_location->location_hash;
}
=item cust_location
sub cust_location {
my $self = shift;
- qsearch('cust_location', { 'custnum' => $self->custnum } );
+ qsearch({
+ 'table' => 'cust_location',
+ 'hashref' => { 'custnum' => $self->custnum,
+ 'prospectnum' => '',
+ },
+ 'order_by' => 'ORDER BY country, LOWER(state), LOWER(city), LOWER(county), LOWER(address1), LOWER(address2)',
+ });
}
-=item location_label [ OPTION => VALUE ... ]
+=item cust_contact
-Returns the label of the service location (see analog in L<FS::cust_location>) for this customer.
+Returns all contact associations (see L<FS::cust_contact>) for this customer.
-Options are
+=cut
-=over 4
+sub cust_contact {
+ my $self = shift;
+ qsearch('cust_contact', { 'custnum' => $self->custnum } );
+}
-=item join_string
+=item cust_payby PAYBY
-used to separate the address elements (defaults to ', ')
+Returns all payment methods (see L<FS::cust_payby>) for this customer.
-=item escape_function
+If one or more PAYBY are specified, returns only payment methods for specified PAYBY.
+Does not validate PAYBY.
-a callback used for escaping the text of the address elements
+=cut
-=back
+sub cust_payby {
+ my $self = shift;
+ my @payby = @_;
+ my $search = {
+ 'table' => 'cust_payby',
+ 'hashref' => { 'custnum' => $self->custnum },
+ 'order_by' => "ORDER BY payby IN ('CARD','CHEK') DESC, weight ASC",
+ };
+ $search->{'extra_sql'} = ' AND payby IN ( '.
+ join(',', map dbh->quote($_), @payby).
+ ' ) '
+ if @payby;
-=cut
+ qsearch($search);
+}
-# false laziness with FS::cust_location::line
+=item has_cust_payby_auto
-sub location_label {
- my $self = shift;
- my %opt = @_;
+Returns true if customer has an automatic payment method ('CARD' or 'CHEK')
- my $separator = $opt{join_string} || ', ';
- my $escape = $opt{escape_function} || sub{ shift };
- my $line = '';
- my $cydefault = FS::conf->new->config('countrydefault') || 'US';
- my $prefix = length($self->ship_last) ? 'ship_' : '';
-
- my $notfirst = 0;
- foreach (qw ( address1 address2 ) ) {
- my $method = "$prefix$_";
- $line .= ($notfirst ? $separator : ''). &$escape($self->$method)
- if $self->$method;
- $notfirst++;
- }
- $notfirst = 0;
- foreach (qw ( city county state zip ) ) {
- my $method = "$prefix$_";
- if ( $self->$method ) {
- $line .= ' (' if $method eq 'county';
- $line .= ($notfirst ? ' ' : $separator). &$escape($self->$method);
- $line .= ' )' if $method eq 'county';
- $notfirst++;
- }
- }
- $line .= $separator. &$escape(code2country($self->country))
- if $self->country ne $cydefault;
+=cut
+
+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',
+ }) );
- $line;
}
=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
=item cancel [ OPTION => VALUE ... ]
Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
+The cancellation time will be now.
-Available options are:
+=back
+
+Always returns a list: an empty list on success or a list of errors.
+
+=cut
+
+sub cancel {
+ my $self = shift;
+ my %opt = @_;
+ warn "$me cancel called on customer ". $self->custnum. " with options ".
+ join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
+ if $DEBUG;
+ my @pkgs = $self->ncancelled_pkgs;
+
+ $self->cancel_pkgs( %opt, 'cust_pkg' => \@pkgs );
+}
+
+=item cancel_pkgs OPTIONS
+
+Cancels a specified list of packages. OPTIONS can include:
=over 4
+=item cust_pkg - an arrayref of the packages. Required.
+
+=item time - the cancellation time, used to calculate final bills and
+unused-time credits if any. Will be passed through to the bill() and
+FS::cust_pkg::cancel() methods.
+
=item quiet - can be set true to supress email cancellation notices.
-=item reason - can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason. The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
+=item reason - can be set to a cancellation reason (see L<FS:reason>), either a
+reasonnum of an existing reason, or passing a hashref will create a new reason.
+The hashref should have the following keys:
+typenum - Reason type (see L<FS::reason_type>)
+reason - Text of the new reason.
+
+=item cust_pkg_reason - can be an arrayref of L<FS::cust_pkg_reason> objects
+for the individual packages, parallel to the C<cust_pkg> argument. The
+reason and reason_otaker arguments will be taken from those objects.
=item ban - can be set true to ban this customer's credit card or ACH information, if present.
=item nobill - can be set true to skip billing if it might otherwise be done.
-=back
-
-Always returns a list: an empty list on success or a list of errors.
-
=cut
-# nb that dates are not specified as valid options to this method
-
-sub cancel {
+sub cancel_pkgs {
my( $self, %opt ) = @_;
- warn "$me cancel called on customer ". $self->custnum. " with options ".
- join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
- if $DEBUG;
+ # we're going to cancel services, which is not reversible
+ die "cancel_pkgs cannot be run inside a transaction"
+ if $FS::UID::AutoCommit == 0;
+
+ local $FS::UID::AutoCommit = 0;
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->_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;
+ if ($error) {
+ dbh->rollback;
+ return ( $error );
+ }
+
+ }
}
- my @pkgs = $self->ncancelled_pkgs;
+ my @pkgs = @{ delete $opt{'cust_pkg'} };
+ my $cancel_time = $opt{'time'} || time;
+ # bill all packages first, so we don't lose usage, service counts for
+ # bulk billing, etc.
if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
$opt{nobill} = 1;
- my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
- warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
- if $error;
+ my $error = $self->bill( 'pkg_list' => [ @pkgs ],
+ 'cancel' => 1,
+ 'time' => $cancel_time );
+ if ($error) {
+ warn "Error billing during cancel, custnum ". $self->custnum. ": $error";
+ dbh->rollback;
+ return ( "Error billing during cancellation: $error" );
+ }
}
-
- warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
- scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
+ dbh->commit;
+
+ my @errors;
+ # try to cancel each service, the same way we would for individual packages,
+ # but in cancel weight order.
+ my @cust_svc = map { $_->cust_svc } @pkgs;
+ my @sorted_cust_svc =
+ map { $_->[0] }
+ sort { $a->[1] <=> $b->[1] }
+ map { [ $_, $_->svc_x ? $_->svc_x->table_info->{'cancel_weight'} : -1 ]; } @cust_svc
+ ;
+ warn "$me removing ".scalar(@sorted_cust_svc)." service(s) for customer ".
+ $self->custnum."\n"
if $DEBUG;
-
- grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
+ foreach my $cust_svc (@sorted_cust_svc) {
+ my $part_svc = $cust_svc->part_svc;
+ next if ( defined($part_svc) and $part_svc->preserve );
+ # immediate cancel, no date option
+ # transactionize individually
+ my $error = try { $cust_svc->cancel } catch { $_ };
+ if ( $error ) {
+ dbh->rollback;
+ push @errors, $error;
+ } else {
+ dbh->commit;
+ }
+ }
+ if (@errors) {
+ return @errors;
+ }
+
+ warn "$me cancelling ". scalar(@pkgs) ." package(s) for customer ".
+ $self->custnum. "\n"
+ if $DEBUG;
+
+ my @cprs;
+ if ($opt{'cust_pkg_reason'}) {
+ @cprs = @{ delete $opt{'cust_pkg_reason'} };
+ }
+ my $null_reason;
+ foreach (@pkgs) {
+ my %lopt = %opt;
+ if (@cprs) {
+ my $cpr = shift @cprs;
+ if ( $cpr ) {
+ $lopt{'reason'} = $cpr->reasonnum;
+ $lopt{'reason_otaker'} = $cpr->otaker;
+ } else {
+ warn "no reason found when canceling package ".$_->pkgnum."\n";
+ # we're not actually required to pass a reason to cust_pkg::cancel,
+ # but if we're getting to this point, something has gone awry.
+ $null_reason ||= FS::reason->new_or_existing(
+ reason => 'unknown reason',
+ type => 'Cancel Reason',
+ class => 'C',
+ );
+ $lopt{'reason'} = $null_reason->reasonnum;
+ $lopt{'reason_otaker'} = $FS::CurrentUser::CurrentUser->username;
+ }
+ }
+ my $error = $_->cancel(%lopt);
+ if ( $error ) {
+ dbh->rollback;
+ push @errors, 'pkgnum '.$_->pkgnum.': '.$error;
+ } else {
+ dbh->commit;
+ }
+ }
+
+ return @errors;
}
sub _banned_pay_hashref {
+ die 'cust_main->_banned_pay_hashref deprecated';
+
my $self = shift;
my %payby2ban = (
{
'payby' => $payby2ban{$self->payby},
- 'payinfo' => md5_base64($self->payinfo),
+ 'payinfo' => $self->payinfo,
#don't ever *search* on reason! #'reason' =>
};
}
=cut
sub notes {
- my $self = shift;
- #order by?
+ my($self,$orderby_classnum) = (shift,shift);
+ my $orderby = "sticky DESC, _date DESC";
+ $orderby = "classnum ASC, $orderby" if $orderby_classnum;
qsearch( 'cust_main_note',
{ 'custnum' => $self->custnum },
- '',
- 'ORDER BY _DATE DESC'
- );
+ '',
+ "ORDER BY $orderby",
+ );
}
=item agent
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 tax_status
+
+Returns the external tax status, as an FS::tax_status object, or the empty
+string if there is no tax status.
+
+=cut
+
+sub tax_status {
+ my $self = shift;
+ if ( $self->taxstatusnum ) {
+ qsearchs('tax_status', { 'taxstatusnum' => $self->taxstatusnum } );
+ } else {
+ return '';
+ }
+}
+
+=item taxstatus
+
+Returns the tax status code if there is one.
+
+=cut
+
+sub taxstatus {
+ my $self = shift;
+ my $tax_status = $self->tax_status;
+ $tax_status
+ ? $tax_status->taxstatus
+ : '';
+}
+
=item BILLING METHODS
Documentation on billing methods has been moved to
If there is an error, returns the error, otherwise returns false.
+DEPRECATED. Use L</remove_cvv_from_cust_payby> instead.
+
=cut
sub remove_cvv {
+ die 'cust_main->remove_cvv deprecated';
my $self = shift;
my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
or return dbh->errstr;
'';
}
-=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.
-
-=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),
- );
-
- 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";
- }
- }
-
- my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
- 'batchnum' => $pay_batch->batchnum,
- 'custnum' => $self->custnum,
- } );
-
- foreach (qw( address1 address2 city state zip country payby payinfo paydate
- payname )) {
- $options{$_} = '' unless exists($options{$_});
- }
-
- 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} || $self->address1,
- 'address2' => $options{address2} || $self->address2,
- 'city' => $options{city} || $self->city,
- 'state' => $options{state} || $self->state,
- 'zip' => $options{zip} || $self->zip,
- 'country' => $options{country} || $self->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;
-
- my $error;
- if ($old_cust_pay_batch) {
- $error = $cust_pay_batch->replace($old_cust_pay_batch)
- } else {
- $error = $cust_pay_batch->insert;
- }
-
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- die $error;
- }
-
- 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;
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-}
-
=item total_owed
Returns the total owed for this customer on all invoices
AND _date <= $time
";
- sprintf( "%.2f", $self->scalar_sql($sql) );
+ sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
}
WHERE custnum = $custnum
";
- #XXX fix harmless but loud: Argument "" isn't numeric in sprintf
- sprintf( "%.2f", $self->scalar_sql($sql) );
+ sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
}
WHERE custnum = $custnum
";
- #XXX fix harmless but loud: Argument "" isn't numeric in sprintf
- sprintf( "%.2f", $self->scalar_sql($sql) );
+ sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
}
WHERE custnum = $custnum
";
- #XXX fix harmless but loud: Argument "" isn't numeric in sprintf
- sprintf( "%.2f", $self->scalar_sql($sql) );
+ sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
}
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
my $self = shift;
my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
') FROM cust_main WHERE custnum='. $self->custnum;
- sprintf( '%.2f', $self->scalar_sql($sql) );
+ sprintf( '%.2f', $self->scalar_sql($sql) || 0 );
}
=item balance_pkgnum PKGNUM
);
}
-=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.
=cut
+#XXX i need to be updated for 4.x+
sub payment_info {
my $self = shift;
$return{payname} = $self->payname
|| ( $self->first. ' '. $self->get('last') );
- $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
+ $return{$_} = $self->bill_location->$_
+ for qw(address1 address2 city state zip);
$return{payby} = $self->payby;
$return{stateid_state} = $self->stateid_state;
}
-=item paydate_monthyear
+=item paydate_epoch
-Returns a two-element list consisting of the month and year of this customer's
-paydate (credit card expiration date for CARD customers)
+Returns the next payment expiration date for this customer. If they have no
+payment methods that will expire, returns 0.
=cut
-sub paydate_monthyear {
+sub paydate_epoch {
my $self = shift;
- if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
- ( $2, $1 );
- } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
- ( $1, $3 );
- } else {
- ('', '');
- }
+ # filter out the ones that individually return 0, but then return 0 if
+ # there are no results
+ my @epochs = grep { $_ > 0 } map { $_->paydate_epoch } $self->cust_payby;
+ min( @epochs ) || 0;
}
-=item tax_exemption TAXNAME
+=item paydate_epoch_sql
+
+Returns an SQL expression to get the next payment expiration date for a
+customer. Returns 2143260000 (2037-12-01) if there are no payment expiration
+dates, so that it's safe to test for "will it expire before date X" for any
+date up to then.
=cut
+sub paydate_epoch_sql {
+ my $class = shift;
+ my $paydate = FS::cust_payby->paydate_epoch_sql;
+ "(SELECT COALESCE(MIN($paydate), 2143260000) FROM cust_payby WHERE cust_payby.custnum = cust_main.custnum)";
+}
+
sub tax_exemption {
my( $self, $taxname ) = @_;
=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
-(see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
-(except as warnings), so use check_invoicing_list first.
+=item invoicing_list
-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.
-
-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
}
return "Email address required"
- if $conf->exists('cust_main-require_invoicing_list_email')
+ if $conf->exists('cust_main-require_invoicing_list_email', $self->agentnum)
&& ! grep { $_ !~ /^([A-Z]+)$/ } @$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 cust_contact.invoice_dest = 'Y'),
+ });
}
=item invoicing_list_emailonly_scalar
join(', ', $self->invoicing_list_emailonly);
}
+=item contact_list [ CLASSNUM, ... ]
+
+Returns a list of contacts (L<FS::contact> objects) for the customer. If
+a list of contact classnums is given, returns only contacts in those
+classes. If the pseudo-classnum 'invoice' is given, returns contacts that
+are marked as invoice destinations. If '0' is given, also returns contacts
+with no class.
+
+If no arguments are given, returns all contacts for the customer.
+
+=cut
+
+sub contact_list {
+ my $self = shift;
+ my $search = {
+ table => 'contact',
+ select => 'contact.*, cust_contact.invoice_dest',
+ addl_from => ' JOIN cust_contact USING (contactnum)',
+ extra_sql => ' WHERE cust_contact.custnum = '.$self->custnum,
+ };
+
+ my @orwhere;
+ my @classnums;
+ foreach (@_) {
+ if ( $_ eq 'invoice' ) {
+ push @orwhere, 'cust_contact.invoice_dest = \'Y\'';
+ } elsif ( $_ eq '0' ) {
+ push @orwhere, 'cust_contact.classnum is null';
+ } elsif ( /^\d+$/ ) {
+ push @classnums, $_;
+ } else {
+ die "bad classnum argument '$_'";
+ }
+ }
+
+ if (@classnums) {
+ push @orwhere, 'cust_contact.classnum IN ('.join(',', @classnums).')';
+ }
+ if (@orwhere) {
+ $search->{extra_sql} .= ' AND (' .
+ join(' OR ', map "( $_ )", @orwhere) .
+ ')';
+ }
+
+ qsearch($search);
+}
+
+=item contact_list_email [ CLASSNUM, ... ]
+
+Same as L</contact_list>, but returns email destinations instead of contact
+objects.
+
+=cut
+
+sub contact_list_email {
+ my $self = shift;
+ my @contacts = $self->contact_list(@_);
+ my @emails;
+ foreach my $contact (@contacts) {
+ foreach my $contact_email ($contact->contact_email) {
+ push @emails,
+ $contact->firstlast . ' <' . $contact_email->emailaddress . '>';
+ }
+ }
+ @emails;
+}
+
=item referral_custnum_cust_main
Returns the customer who referred this customer (or the empty string, if
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);
'setuptax' => '', # or 'Y' for tax exempt
+ 'locationnum'=> 1234, # optional
+
#internal taxation
'taxclass' => 'Tax class',
=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} : '';
$cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
$bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
$invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
- } else {
+ $locationnum = $_[0]->{locationnum} || $self->ship_locationnum;
+ $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,
} );
$error = $cust_pkg->insert;
sub charge_postal_fee {
my $self = shift;
- my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
+ my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
my $cust_pkg = new FS::cust_pkg ( {
}
+=item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
+
+Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
+
+=cut
+
+sub legacy_cust_bill {
+ my $self = shift;
+
+ #return $self->num_legacy_cust_bill unless wantarray;
+
+ map { $_ } #behavior of sort undefined in scalar context
+ sort { $a->_date <=> $b->_date }
+ qsearch({ 'table' => 'legacy_cust_bill',
+ 'hashref' => { 'custnum' => $self->custnum, },
+ 'order_by' => 'ORDER BY _date ASC',
+ });
+}
+
=item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
Returns all the statements (see L<FS::cust_statement>) for this customer.
=cut
+=item cust_bill_void
+
+Returns all the voided invoices (see L<FS::cust_bill_void>) for this customer.
+
+=cut
+
+sub cust_bill_void {
+ my $self = shift;
+
+ map { $_ } #return $self->num_cust_bill_void unless wantarray;
+ sort { $a->_date <=> $b->_date }
+ qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } )
+}
+
sub cust_statement {
my $self = shift;
my $opt = ref($_[0]) ? shift : { @_ };
qsearch($opt);
}
+=item svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ]
+
+Returns all services of type SVCDB (such as 'svc_acct') for this customer.
+
+Optionally, a list or hashref of additional arguments to the qsearch call can
+be passed following the SVCDB.
+
+=cut
+
+sub svc_x {
+ my $self = shift;
+ my $svcdb = shift;
+ if ( ! $svcdb =~ /^svc_\w+$/ ) {
+ warn "$me svc_x requires a svcdb";
+ return;
+ }
+ my $opt = ref($_[0]) ? shift : { @_ };
+
+ $opt->{'table'} = $svcdb;
+ $opt->{'addl_from'} =
+ 'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '.
+ ($opt->{'addl_from'} || '');
+
+ my $custnum = $self->custnum;
+ $custnum =~ /^\d+$/ or die "bad custnum '$custnum'";
+ my $where = "cust_pkg.custnum = $custnum";
+
+ my $extra_sql = $opt->{'extra_sql'} || '';
+ if ( keys %{ $opt->{'hashref'} } ) {
+ $extra_sql = " AND $where $extra_sql";
+ }
+ else {
+ if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) {
+ $extra_sql = "WHERE $where AND $1";
+ }
+ else {
+ $extra_sql = "WHERE $where $extra_sql";
+ }
+ }
+ $opt->{'extra_sql'} = $extra_sql;
+
+ qsearch($opt);
+}
+
+# required for use as an eventtable;
+sub svc_acct {
+ my $self = shift;
+ $self->svc_x('svc_acct', @_);
+}
+
=item cust_credit
Returns all the credits (see L<FS::cust_credit>) for this customer.
sub cust_credit {
my $self = shift;
- map { $_ } #return $self->num_cust_credit unless wantarray;
- sort { $a->_date <=> $b->_date }
- qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
+
+ #return $self->num_cust_credit unless wantarray;
+
+ map { $_ } #behavior of sort undefined in scalar context
+ sort { $a->_date <=> $b->_date }
+ qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
}
=item cust_credit_pkgnum
);
}
+=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 cust_pay_pkgnum
+=item unapplied_cust_pay
-Returns all the payments (see L<FS::cust_pay>) for this customer's specific
-package when using experimental package balances.
+Returns all the unapplied payments (see L<FS::cust_pay>) for this customer.
=cut
-sub cust_pay_pkgnum {
- my( $self, $pkgnum ) = @_;
+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
+package when using experimental package balances.
+
+=cut
+
+sub cust_pay_pkgnum {
+ my( $self, $pkgnum ) = @_;
map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
sort { $a->_date <=> $b->_date }
qsearch( 'cust_pay', { 'custnum' => $self->custnum,
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_void>) 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
sub display_custnum {
my $self = shift;
- if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
- return $self->agent_custid;
+
+ return $self->agent_custid
+ if $default_agent_custid && $self->agent_custid;
+
+ my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
+
+ if ( $prefix ) {
+ return $prefix .
+ sprintf('%0'.($custnum_display_length||8).'d', $self->custnum)
+ } elsif ( $custnum_display_length ) {
+ return sprintf('%0'.$custnum_display_length.'d', $self->custnum);
} else {
return $self->custnum;
}
$name;
}
+=item service_contact
+
+Returns the L<FS::contact> object for this customer that has the 'Service'
+contact class, or undef if there is no such contact. Deprecated; don't use
+this in new code.
+
+=cut
+
+sub service_contact {
+ my $self = shift;
+ if ( !exists($self->{service_contact}) ) {
+ my $classnum = $self->scalar_sql(
+ 'SELECT classnum FROM contact_class WHERE classname = \'Service\''
+ ) || 0; #if it's zero, qsearchs will return nothing
+ my $cust_contact = qsearchs('cust_contact', {
+ 'classnum' => $classnum,
+ 'custnum' => $self->custnum,
+ });
+ $self->{service_contact} = $cust_contact->contact if $cust_contact;
+ }
+ $self->{service_contact};
+}
+
=item ship_name
Returns a name string for this (service/shipping) contact, either
sub ship_name {
my $self = shift;
- if ( $self->get('ship_last') ) {
- my $name = $self->ship_contact;
- $name = $self->ship_company. " ($name)" if $self->ship_company;
- $name;
- } else {
- $self->name;
- }
+
+ my $name = $self->ship_contact;
+ $name = $self->company. " ($name)" if $self->company;
+ $name;
}
=item name_short
sub ship_name_short {
my $self = shift;
- if ( $self->get('ship_last') ) {
- $self->ship_company !~ /^\s*$/
- ? $self->ship_company
- : $self->ship_contact_firstlast;
- } else {
- $self->name_company_or_firstlast;
- }
+ $self->service_contact
+ ? $self->ship_contact_firstlast
+ : $self->name_short
}
=item contact
sub ship_contact {
my $self = shift;
- $self->get('ship_last')
- ? $self->get('ship_last'). ', '. $self->ship_first
- : $self->contact;
+ my $contact = $self->service_contact || $self;
+ $contact->get('last') . ', ' . $contact->get('first');
}
=item contact_firstlast
sub ship_contact_firstlast {
my $self = shift;
- $self->get('ship_last')
- ? $self->first. ' '. $self->get('ship_last')
- : $self->contact_firstlast;
+ my $contact = $self->service_contact || $self;
+ $contact->get('first') . ' '. $contact->get('last');
+}
+
+sub bill_country_full {
+ my $self = shift;
+ $self->bill_location->country_full;
+}
+
+sub ship_country_full {
+ my $self = shift;
+ $self->ship_location->country_full;
}
-=item country_full
+=item county_state_county [ PREFIX ]
-Returns this customer's full country name
+Returns a string consisting of just the county, state and country.
=cut
-sub country_full {
+sub county_state_country {
my $self = shift;
- code2country($self->country);
+ my $locationnum;
+ if ( @_ && $_[0] && $self->has_ship_address ) {
+ $locationnum = $self->ship_locationnum;
+ } else {
+ $locationnum = $self->bill_locationnum;
+ }
+ my $cust_location = qsearchs('cust_location', { locationnum=>$locationnum });
+ $cust_location->county_state_country;
}
=item geocode DATA_VENDOR
=cut
-sub geocode {
- my ($self, $data_vendor) = (shift, shift); #always cch for now
-
- my $geocode = $self->get('geocode'); #XXX only one data_vendor for geocode
- return $geocode if $geocode;
+=item cust_status
- my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
- ? 'ship_'
- : '';
+=item status
- my($zip,$plus4) = split /-/, $self->get("${prefix}zip")
- if $self->country eq 'US';
+Returns a status string for this customer, currently:
- $zip ||= '';
- $plus4 ||= '';
- #CCH specific location stuff
- my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
+=over 4
- my @cust_tax_location =
- qsearch( {
- 'table' => 'cust_tax_location',
- 'hashref' => { 'zip' => $zip, 'data_vendor' => $data_vendor },
- 'extra_sql' => $extra_sql,
- 'order_by' => 'ORDER BY plus4hi',#overlapping with distinct ends
- }
- );
- $geocode = $cust_tax_location[0]->geocode
- if scalar(@cust_tax_location);
+=item prospect
- $geocode;
-}
+No packages have ever been ordered. Displayed as "No packages".
-=item cust_status
+=item ordered
-=item status
+Recurring packages all are new (not yet billed).
-Returns a status string for this customer, currently:
+=item active
-=over 4
+One or more recurring packages is active.
-=item prospect - No packages have ever been ordered
+=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
+Behavior of inactive vs. cancelled edge cases can be adjusted with the
+cust_main-status_module configuration option.
+
=cut
sub status { shift->cust_status(@_); }
sub cust_status {
my $self = shift;
- # prospect ordered active inactive suspended cancelled
+ return $self->hashref->{cust_status} if $self->hashref->{cust_status};
for my $status ( FS::cust_main->statuses() ) {
my $method = $status.'_sql';
my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
$sth->execute( ($self->custnum) x $numnum )
or die "Error executing 'SELECT $sql': ". $sth->errstr;
- return $status if $sth->fetchrow_arrayref->[0];
+ if ( $sth->fetchrow_arrayref->[0] ) {
+ $self->hashref->{cust_status} = $status;
+ return $status;
+ }
+ }
+}
+
+=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.
=cut
-use vars qw(%statuscolor);
-tie %statuscolor, 'Tie::IxHash',
- 'prospect' => '7e0079', #'000000', #black? naw, purple
- 'active' => '00CC00', #green
- 'ordered' => '009999', #teal? cyan?
- 'inactive' => '0000CC', #blue
- 'suspended' => 'FF9900', #yellow
- 'cancelled' => 'FF0000', #red
-;
-
sub statuscolor { shift->cust_statuscolor(@_); }
sub cust_statuscolor {
my $self = shift;
- $statuscolor{$self->cust_status};
+ __PACKAGE__->statuscolors->{$self->cust_status};
}
-=item tickets
+=item tickets [ STATUS ]
Returns an array of hashes representing the customer's RT tickets.
+An optional status (or arrayref or hashref of statuses) may be specified.
+
=cut
sub tickets {
my $self = shift;
+ my $status = ( @_ && $_[0] ) ? shift : '';
my $num = $conf->config('cust_main-max_tickets') || 10;
my @tickets = ();
- if ( $conf->config('ticket_system') ) {
- unless ( $conf->config('ticket_system-custom_priority_field') ) {
+ if ( $conf->config('ticket_system') ) {
+ unless ( $conf->config('ticket_system-custom_priority_field') ) {
+
+ @tickets = @{ FS::TicketSystem->customer_tickets( $self->custnum,
+ $num,
+ undef,
+ $status,
+ )
+ };
+
+ } else {
+
+ foreach my $priority (
+ $conf->config('ticket_system-custom_priority_field-values'), ''
+ ) {
+ last if scalar(@tickets) >= $num;
+ push @tickets,
+ @{ FS::TicketSystem->customer_tickets( $self->custnum,
+ $num - scalar(@tickets),
+ $priority,
+ $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;
+ my %packages = map { $_ => 1 } $conf->config('support_packages');
+
+ grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
+ grep { $_->part_svc->svcdb eq 'svc_acct' }
+ map { $_->cust_svc }
+ grep { exists $packages{ $_->pkgpart } }
+ $self->ncancelled_pkgs;
+
+}
+
+# Return a list of latitude/longitude for one of the services (if any)
+sub service_coordinates {
+ my $self = shift;
+
+ my @svc_X =
+ grep { $_->latitude && $_->longitude }
+ map { $_->svc_x }
+ map { $_->cust_svc }
+ $self->ncancelled_pkgs;
+
+ scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
+}
+
+=item masked FIELD
+
+Returns a masked version of the named field
+
+=cut
+
+sub masked {
+my ($self,$field) = @_;
+
+# Show last four
+
+'x'x(length($self->getfield($field))-4).
+ substr($self->getfield($field), (length($self->getfield($field))-4));
+
+}
+
+=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;
+}
+
+=item save_cust_payby
+
+Saves a new cust_payby for this customer, replacing an existing entry only
+in select circumstances. Does not validate input.
+
+If auto is specified, marks this as the customer's primary method, or the
+specified weight. Existing payment methods have their weight incremented as
+appropriate.
+
+If bill_location is specified with auto, also sets location in cust_main.
+
+Will not insert complete duplicates of existing records, or records in which the
+only difference from an existing record is to turn off automatic payment (will
+return without error.) Will replace existing records in which the only difference
+is to add a value to a previously empty preserved field and/or turn on automatic payment.
+Fields marked as preserved are optional, and existing values will not be overwritten with
+blanks when replacing.
+
+Accepts the following named parameters:
+
+=over 4
+
+=item payment_payby
+
+either CARD or CHEK
+
+=item auto
+
+save as an automatic payment type (CARD/CHEK if true, DCRD/DCHK if false)
+
+=item weight
+
+optional, set higher than 1 for secondary, etc.
+
+=item payinfo
+
+required
+
+=item paymask
+
+optional, but should be specified for anything that might be tokenized, will be preserved when replacing
+
+=item payname
+
+required
+
+=item payip
+
+optional, will be preserved when replacing
+
+=item paydate
+
+CARD only, required
+
+=item bill_location
+
+CARD only, required, FS::cust_location object
+
+=item paystart_month
+
+CARD only, optional, will be preserved when replacing
+
+=item paystart_year
+
+CARD only, optional, will be preserved when replacing
+
+=item payissue
+
+CARD only, optional, will be preserved when replacing
+
+=item paycvv
+
+CARD only, only used if conf cvv-save is set appropriately
+
+=item paytype
+
+CHEK only
+
+=item paystate
+
+CHEK only
+
+=back
+
+=cut
+
+#The code for this option is in place, but it's not currently used
+#
+# =item replace
+#
+# existing cust_payby object to be replaced (must match custnum)
+
+# stateid/stateid_state/ss are not currently supported in cust_payby,
+# might not even work properly in 4.x, but will need to work here if ever added
+
+sub save_cust_payby {
+ my $self = shift;
+ my %opt = @_;
+
+ my $old = $opt{'replace'};
+ my $new = new FS::cust_payby { $old ? $old->hash : () };
+ return "Customer number does not match" if $new->custnum and $new->custnum != $self->custnum;
+ $new->set( 'custnum' => $self->custnum );
+
+ my $payby = $opt{'payment_payby'};
+ return "Bad payby" unless grep(/^$payby$/,('CARD','CHEK'));
+
+ # don't allow turning off auto when replacing
+ $opt{'auto'} ||= 1 if $old and $old->payby !~ /^D/;
+
+ my @check_existing; # payby relevant to this payment_payby
+
+ # set payby based on auto
+ if ( $payby eq 'CARD' ) {
+ $new->set( 'payby' => ( $opt{'auto'} ? 'CARD' : 'DCRD' ) );
+ @check_existing = qw( CARD DCRD );
+ } elsif ( $payby eq 'CHEK' ) {
+ $new->set( 'payby' => ( $opt{'auto'} ? 'CHEK' : 'DCHK' ) );
+ @check_existing = qw( CHEK DCHK );
+ }
+
+ $new->set( 'weight' => $opt{'auto'} ? $opt{'weight'} : '' );
+
+ # basic fields
+ $new->payinfo($opt{'payinfo'}); # sets default paymask, but not if it's already tokenized
+ $new->paymask($opt{'paymask'}) if $opt{'paymask'}; # in case it's been tokenized, override with loaded paymask
+ $new->set( 'payname' => $opt{'payname'} );
+ $new->set( 'payip' => $opt{'payip'} ); # will be preserved below
+
+ my $conf = new FS::Conf;
+
+ # compare to FS::cust_main::realtime_bop - check both to make sure working correctly
+ if ( $payby eq 'CARD' &&
+ ( (grep { $_ eq cardtype($opt{'payinfo'}) } $conf->config('cvv-save'))
+ || $conf->exists('business-onlinepayment-verification')
+ )
+ ) {
+ $new->set( 'paycvv' => $opt{'paycvv'} );
+ } else {
+ $new->set( 'paycvv' => '');
+ }
+
+ 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;
- @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
+ # set fields specific to payment_payby
+ if ( $payby eq 'CARD' ) {
+ if ($opt{'bill_location'}) {
+ $opt{'bill_location'}->set('custnum' => $self->custnum);
+ my $error = $opt{'bill_location'}->find_or_insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ $new->set( 'locationnum' => $opt{'bill_location'}->locationnum );
+ }
+ foreach my $field ( qw( paydate paystart_month paystart_year payissue ) ) {
+ $new->set( $field => $opt{$field} );
+ }
+ } else {
+ foreach my $field ( qw(paytype paystate) ) {
+ $new->set( $field => $opt{$field} );
+ }
+ }
- } else {
+ # other cust_payby to compare this to
+ my @existing = $self->cust_payby(@check_existing);
+
+ # fields that can overwrite blanks with values, but not values with blanks
+ my @preserve = qw( paymask locationnum paystart_month paystart_year payissue payip );
+
+ my $skip_cust_payby = 0; # true if we don't need to save or reweight cust_payby
+ unless ($old) {
+ # generally, we don't want to overwrite existing cust_payby with this,
+ # but we can replace if we're only marking it auto or adding a preserved field
+ # and we can avoid saving a total duplicate or merely turning off auto
+PAYBYLOOP:
+ foreach my $cust_payby (@existing) {
+ # check fields that absolutely should not change
+ foreach my $field ($new->fields) {
+ next if grep(/^$field$/, qw( custpaybynum payby weight ) );
+ next if grep(/^$field$/, @preserve );
+ next PAYBYLOOP unless $new->get($field) eq $cust_payby->get($field);
+ }
+ # now check fields that can replace if one value is blank
+ my $replace = 0;
+ foreach my $field (@preserve) {
+ if (
+ ( $new->get($field) and !$cust_payby->get($field) ) or
+ ( $cust_payby->get($field) and !$new->get($field) )
+ ) {
+ # prevention of overwriting values with blanks happens farther below
+ $replace = 1;
+ } elsif ( $new->get($field) ne $cust_payby->get($field) ) {
+ next PAYBYLOOP;
+ }
+ }
+ unless ( $replace ) {
+ # nearly identical, now check weight
+ if ($new->get('weight') eq $cust_payby->get('weight') or !$new->get('weight')) {
+ # ignore identical cust_payby, and ignore attempts to turn off auto
+ # no need to save or re-weight cust_payby (but still need to update/commit $self)
+ $skip_cust_payby = 1;
+ last PAYBYLOOP;
+ }
+ # otherwise, only change is to mark this as primary
+ }
+ # if we got this far, we're definitely replacing
+ $old = $cust_payby;
+ last PAYBYLOOP;
+ } #PAYBYLOOP
+ }
- foreach my $priority (
- $conf->config('ticket_system-custom_priority_field-values'), ''
- ) {
- last if scalar(@tickets) >= $num;
- push @tickets,
- @{ FS::TicketSystem->customer_tickets( $self->custnum,
- $num - scalar(@tickets),
- $priority,
- )
- };
+ if ($old) {
+ $new->set( 'custpaybynum' => $old->custpaybynum );
+ # don't turn off automatic payment (but allow it to be turned on)
+ if ($new->payby =~ /^D/ and $new->payby ne $old->payby) {
+ $opt{'auto'} = 1;
+ $new->set( 'payby' => $old->payby );
+ $new->set( 'weight' => 1 );
+ }
+ # make sure we're not overwriting values with blanks
+ foreach my $field (@preserve) {
+ if ( $old->get($field) and !$new->get($field) ) {
+ $new->set( $field => $old->get($field) );
}
}
}
- (@tickets);
-}
-# Return services representing svc_accts in customer support packages
-sub support_services {
- my $self = shift;
- my %packages = map { $_ => 1 } $conf->config('support_packages');
+ # only overwrite cust_main bill_location if auto
+ if ($opt{'auto'} && $opt{'bill_location'}) {
+ $self->set('bill_location' => $opt{'bill_location'});
+ my $error = $self->replace;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
- grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
- grep { $_->part_svc->svcdb eq 'svc_acct' }
- map { $_->cust_svc }
- grep { exists $packages{ $_->pkgpart } }
- $self->ncancelled_pkgs;
+ # done with everything except reweighting and saving cust_payby
+ # still need to commit changes to cust_main and cust_location
+ if ($skip_cust_payby) {
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ return '';
+ }
-}
+ # re-weight existing primary cust_pay for this payby
+ if ($opt{'auto'}) {
+ foreach my $cust_payby (@existing) {
+ # relies on cust_payby return order
+ last unless $cust_payby->payby !~ /^D/;
+ last if $cust_payby->weight > 1;
+ next if $new->custpaybynum eq $cust_payby->custpaybynum;
+ next if $cust_payby->weight < ($opt{'weight'} || 1);
+ $cust_payby->weight( $cust_payby->weight + 1 );
+ my $error = $cust_payby->replace;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error reweighting cust_payby: $error";
+ }
+ }
+ }
-# Return a list of latitude/longitude for one of the services (if any)
-sub service_coordinates {
- my $self = shift;
+ # finally, save cust_payby
+ my $error = $old ? $new->replace($old) : $new->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
- my @svc_X =
- grep { $_->latitude && $_->longitude }
- map { $_->svc_x }
- map { $_->cust_svc }
- $self->ncancelled_pkgs;
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
- scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
}
-=item masked FIELD
+=item remove_cvv_from_cust_payby PAYINFO
-Returns a masked version of the named field
+Removes paycvv from associated cust_payby with matching PAYINFO.
=cut
-sub masked {
-my ($self,$field) = @_;
+sub remove_cvv_from_cust_payby {
+ my ($self,$payinfo) = @_;
-# Show last four
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
-'x'x(length($self->getfield($field))-4).
- substr($self->getfield($field), (length($self->getfield($field))-4));
+ foreach my $cust_payby ( qsearch('cust_payby',{ custnum => $self->custnum }) ) {
+ next unless $cust_payby->payinfo eq $payinfo; # can't qsearch on payinfo
+ $cust_payby->paycvv('');
+ my $error = $cust_payby->replace;
+ if ($error) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
}
=back
=cut
sub statuses {
- #my $self = shift; #could be class...
- keys %statuscolor;
+ my $self = shift;
+ keys %{ $self->statuscolors };
+}
+
+=item cust_status_sql
+
+Returns an SQL fragment to determine the status of a cust_main record, as a
+string.
+
+=cut
+
+sub cust_status_sql {
+ my $sql = 'CASE';
+ for my $status ( FS::cust_main->statuses() ) {
+ my $method = $status.'_sql';
+ $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
+ }
+ $sql .= ' END';
+ return $sql;
}
+
=item prospect_sql
Returns an SQL expression identifying prospective cust_main records (customers
=item ordered_sql
Returns an SQL expression identifying ordered cust_main records (customers with
-recurring packages not yet setup).
+no active packages, but recurring packages not yet setup or one time charges
+not yet billed).
=cut
sub ordered_sql {
FS::cust_main->none_active_sql.
- " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->ordered_sql. " ) ";
+ " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) ";
}
=item active_sql
=cut
-sub cancelled_sql { cancel_sql(@_); }
-sub cancel_sql {
-
- my $recurring_sql = FS::cust_pkg->recurring_sql;
- my $cancelled_sql = FS::cust_pkg->cancelled_sql;
-
- "
- 0 < ( $select_count_pkgs )
- AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql )
- AND 0 = ( $select_count_pkgs AND $recurring_sql
- AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
- )
- AND 0 = ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
- ";
-
-}
+sub cancel_sql { shift->cancelled_sql(@_); }
=item uncancel_sql
=item uncancelled_sql
=cut
sub uncancelled_sql { uncancel_sql(@_); }
-sub uncancel_sql { "
- ( 0 < ( $select_count_pkgs
- AND ( cust_pkg.cancel IS NULL
- OR cust_pkg.cancel = 0
- )
- )
- OR 0 = ( $select_count_pkgs )
- )
-"; }
+sub uncancel_sql {
+ my $self = shift;
+ "( NOT (".$self->cancelled_sql.") )"; #sensitive to cust_main-status_module
+}
=item balance_sql
=item unapplied_payments_date_sql START_TIME [ END_TIME ]
Returns an SQL fragment to retreive the total unapplied payments for this
-customer, only considering invoices with date earlier than START_TIME, and
+customer, only considering payments with date earlier than START_TIME, and
optionally not later than END_TIME.
Times are specified as SQL fragments or numeric
=over 4
-=item append_fuzzyfiles FIRSTNAME LASTNAME COMPANY ADDRESS1
-
-=cut
-
-use FS::cust_main::Search;
-sub append_fuzzyfiles {
- #my( $first, $last, $company ) = @_;
-
- FS::cust_main::Search::check_and_rebuild_fuzzyfiles();
-
- use Fcntl qw(:flock);
-
- my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
-
- foreach my $field (@fuzzyfields) {
- my $value = shift;
-
- if ( $value ) {
-
- open(CACHE,">>$dir/cust_main.$field")
- or die "can't open $dir/cust_main.$field: $!";
- flock(CACHE,LOCK_EX)
- or die "can't lock $dir/cust_main.$field: $!";
-
- print CACHE "$value\n";
-
- flock(CACHE,LOCK_UN)
- or die "can't unlock $dir/cust_main.$field: $!";
- close CACHE;
- }
-
- }
-
- 1;
-}
-
-=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
-(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")
-
-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
-
-=cut
-
-sub notify {
- my ($self, $template, %options) = @_;
-
- return unless $conf->exists($template);
-
- my $from = $conf->config('invoice_from', $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
Generates a templated notification to the customer (see L<Text::Template>).
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.
-I<$payby> - a description of the method of payment for the customer
- # would be nice to use FS::payby::shortname
-I<$payinfo> - the masked account information used to collect for this customer
-I<$expdate> - the expiration of the customer payment method in seconds from epoch
I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
=cut
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";
or die "can't compile template: Text::Template::ERROR";
my %letter_data = map { $_ => $self->$_ } $self->fields;
- $letter_data{payinfo} = $self->mask_payinfo;
-
- #my $paydate = $self->paydate || '2037-12-31';
- my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
-
- 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') {
- $letter_data{payby} = 'credit card';
- ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
- $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
- $expire_time--;
- }elsif ($payby eq 'COMP') {
- $letter_data{payby} = 'complimentary account';
- }else{
- $letter_data{payby} = 'current method';
- }
- $letter_data{expdate} = $expire_time;
for (keys %{$options{extra_fields}}){
$letter_data{$_} = $options{extra_fields}->{$_};
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} );
+#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 print {
my ($self, $template) = (shift, shift);
- do_print [ $self->print_ps($template) ];
+ do_print(
+ [ $self->print_ps($template) ],
+ 'agentnum' => $self->agentnum,
+ );
}
#these three subs should just go away once agent stuff is all config overrides
" ORDER BY
CASE WHEN part_event_condition_option.optionname IS NULL
THEN -1
- ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
+ ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
" END
, part_event.weight".
" LIMIT 1"
}
+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;
$cust_main->bill_and_collect( %$param );
}
+#starting to take quite a while for big dbs
+# (JRNL: journaled so it only happens once per database)
+# - seq scan of h_cust_main (yuck), but not going to index paycvv, so
+# JRNL seq scan of cust_main on signupdate... index signupdate? will that help?
+# 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)
+#
+#only going to get worse with new location stuff...
+
sub _upgrade_data { #class method
my ($class, %opts) = @_;
- foreach my $sql (
- 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
- 'UPDATE cust_main SET signupdate = (SELECT signupdate FROM h_cust_main WHERE signupdate IS NOT NULL AND h_cust_main.custnum = cust_main.custnum ORDER BY historynum DESC LIMIT 1) WHERE signupdate IS NULL',
- ) {
+ my @statements = ();
+
+ #this seems to be the only expensive one.. why does it take so long?
+ unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) {
+ push @statements,
+ 'UPDATE cust_main SET signupdate = (SELECT signupdate FROM h_cust_main WHERE signupdate IS NOT NULL AND h_cust_main.custnum = cust_main.custnum ORDER BY historynum DESC LIMIT 1) WHERE signupdate IS NULL';
+ FS::upgrade_journal->set_done('cust_main__signupdate');
+ }
+
+ my $t = time;
+ foreach my $sql ( @statements ) {
my $sth = dbh->prepare($sql) or die dbh->errstr;
$sth->execute or die $sth->errstr;
+ #warn ( (time - $t). " seconds\n" );
+ #$t = time;
}
local($ignore_expired_card) = 1;
- local($ignore_illegal_zip) = 1;
local($ignore_banned_card) = 1;
local($skip_fuzzyfiles) = 1;
+ local($import) = 1; #prevent automatic geocoding (need its own variable?)
+
+ FS::cust_main::Location->_upgrade_data(%opts);
+
+ unless ( FS::upgrade_journal->is_done('cust_main__trimspaces') ) {
+
+ foreach my $cust_main ( qsearch({
+ 'table' => 'cust_main',
+ 'hashref' => {},
+ 'extra_sql' => 'WHERE '.
+ join(' OR ',
+ map "$_ LIKE ' %' OR $_ LIKE '% ' OR $_ LIKE '% %'",
+ qw( first last company )
+ ),
+ }) ) {
+ my $error = $cust_main->replace;
+ die $error if $error;
+ }
+
+ FS::upgrade_journal->set_done('cust_main__trimspaces');
+
+ }
+
$class->_upgrade_otaker(%opts);
}
No multiple currency support (probably a larger project than just this module).
-payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
-
Birthdates rely on negative epoch values.
-The payby for card/check batches is broken. With mixed batching, bad
-things will happen.
-
B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
=head1 SEE ALSO