X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=eb2cd4dec01550505771b2a8dc6ae496e503fa54;hp=95614e7c84125bb8a53c43498fd1ae47e50018d1;hb=ad3bcb39580173f0ac1b6357cb49515d48af7ddf;hpb=63e0d5a83730aa164db54a17f90d5f5bdba025b8 diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 95614e7c8..f102d97ee 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1,37 +1,37 @@ 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::Status - FS::cust_main::Billing FS::cust_main::Billing_Realtime +use base qw( FS::cust_main::Packages + FS::cust_main::Status + FS::cust_main::NationalID + FS::cust_main::Billing + FS::cust_main::Billing_Realtime + FS::cust_main::Billing_Batch FS::cust_main::Billing_Discount + FS::cust_main::Billing_ThirdParty + FS::cust_main::Location + FS::cust_main::Credit_Limit + FS::cust_main::Merge + FS::cust_main::API FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin - FS::geocode_Mixin + FS::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 - @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 Business::CreditCard 0.28; use Locale::Country; -use FS::UID qw( getotaker dbh driver_name ); +use FS::UID qw( dbh driver_name ); use FS::Record qw( qsearchs qsearch dbdef regexp_sql ); +use FS::Cursor; use FS::Misc qw( generate_email send_email generate_ps do_print ); use FS::Msgcat qw(gettext); use FS::CurrentUser; @@ -40,6 +40,7 @@ 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; @@ -51,10 +52,11 @@ use FS::part_referral; 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; @@ -68,32 +70,40 @@ use FS::agent_payment_gateway; use FS::banned_pay; use FS::cust_main_note; use FS::cust_attachment; -use FS::contact; +use FS::cust_contact; use FS::Locales; +use FS::upgrade_journal; +use FS::sales; +use FS::cust_payby; +use FS::contact; # 1 is mostly method/subroutine entry and options # 2 traces progress of some operations # 3 is even more information including possibly sensitive data -$DEBUG = 0; -$me = '[FS::cust_main]'; +our $DEBUG = 0; +our $me = '[FS::cust_main]'; -$import = 0; -$ignore_expired_card = 0; -$ignore_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; +our $skip_fuzzyfiles = 0; -@encrypted_fields = ('payinfo', 'paycvv'); -sub nohistory_fields { ('payinfo', 'paycvv'); } +our $ucfirst_nowarn = 0; -@paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings'); +#this info is in cust_payby as of 4.x +#this and the fields themselves can be removed in 5.x +our @encrypted_fields = ('payinfo', 'paycvv'); +sub nohistory_fields { ('payinfo', 'paycvv'); } +our $conf; #ask FS::UID to run this stuff for us later #$FS::UID::callback{'FS::cust_main'} = sub { install_callback FS::UID sub { $conf = new FS::Conf; #yes, need it for stuff below (prolly should be cached) + $ignore_invalid_card = $conf->exists('allow_invalid_cards'); }; sub _cache { @@ -177,28 +187,6 @@ Cocial security number (optional) (optional) -=item address1 - -=item address2 - -(optional) - -=item city - -=item county - -(optional, see L) - -=item state - -(see L) - -=item zip - -=item country - -(see L) - =item daytime phone (optional) @@ -215,56 +203,6 @@ 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) - -=item ship_state - -(see L) - -=item ship_zip - -=item ship_country - -(see L) - -=item ship_daytime - -phone (optional) - -=item ship_night - -phone (optional) - -=item ship_fax - -phone (optional) - -=item ship_mobile - -phone (optional) - =item payby Payment Type (See L for valid payby values) @@ -341,6 +279,10 @@ Allow self-service editing of ticket subjects, empty or 'Y' 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 @@ -363,6 +305,12 @@ sub table { 'cust_main'; } 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 and C pseudo-fields must be set to +uninserted L 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 objects, all records are inserted atomicly, or the transaction is rolled back. Passing an empty @@ -387,7 +335,7 @@ invoicing_list destination to the newly-created svc_acct. Here's an example: $cust_main->insert( {}, [ $email, 'POST' ] ); Currently available options are: I, I, -I and I. +I, I, I and I. If I is set, all provisioning jobs will have a dependancy on the supplied jobnum (they will not run until the specific job completes). @@ -398,11 +346,23 @@ The I option is deprecated. If I is set true, no provisioning jobs (exports) are scheduled. (You can schedule them later with the B method.) -The I option can be set to an arrayref of tax names. -FS::cust_main_exemption records will be created and inserted. +The I 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 is set, moves contacts and locations from that prospect. +If I is set to an arrayref of FS::contact objects, inserts those +new contacts with this new customer. + +If I is set to a hashref of CGI parameters (and I 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 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 { @@ -430,7 +390,7 @@ sub insert { my $payby = ''; if ( $self->payby eq 'PREPAY' ) { - $self->payby('BILL'); + $self->payby(''); #'BILL'); $prepay_identifier = $self->payinfo; $self->payinfo(''); @@ -452,21 +412,63 @@ sub insert { $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->signupdate(time) unless $self->signupdate; - $self->censusyear($conf->config('census_year')) if $self->censustract; - $self->auto_agent_custid() if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid; @@ -477,6 +479,22 @@ sub insert { return $error; } + # 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 ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error setting $l custnum: $error"; + } + } + warn " setting invoicing list\n" if $DEBUG > 1; @@ -523,11 +541,23 @@ sub insert { return $error; } - my @contact = $prospect_main->contact; + foreach my $prospect_contact ( $prospect_main->prospect_contact ) { + my $cust_contact = new FS::cust_contact { + 'custnum' => $self->custnum, + map { $_ => $prospect_contact->$_() } qw( contactnum classnum comment ) + }; + my $error = $cust_contact->insert + || $prospect_contact->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + my @cust_location = $prospect_main->cust_location; my @qual = $prospect_main->qual; - foreach my $r ( @contact, @cust_location, @qual ) { + foreach my $r ( @cust_location, @qual ) { $r->prospectnum(''); $r->custnum($self->custnum); my $error = $r->replace; @@ -539,15 +569,65 @@ sub insert { } + warn " setting contacts\n" + if $DEBUG > 1; + + if ( my $contact = delete $options{'contact'} ) { + + foreach my $c ( @$contact ) { + $c->custnum($self->custnum); + my $error = $c->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + } + + } elsif ( my $contact_params = delete $options{'contact_params'} ) { + + my $error = $self->process_o2m( 'table' => 'contact', + 'fields' => FS::contact->cgi_contact_fields, + 'params' => $contact_params, + ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + warn " setting cust_payby\n" + if $DEBUG > 1; + + if ( my $cust_payby_params = delete $options{'cust_payby_params'} ) { + + my $error = $self->process_o2m( + 'table' => 'cust_payby', + 'fields' => FS::cust_payby->cgi_cust_payby_fields, + 'params' => $cust_payby_params, + 'hash_callback' => \&FS::cust_payby::cgi_hash_callback, + ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + } + warn " setting cust_main_exemption\n" if $DEBUG > 1; 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 ) { @@ -557,14 +637,6 @@ sub insert { } } - 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; @@ -987,47 +1059,6 @@ sub insert_cust_pay { } -=item reexport - -This method is deprecated. See the I option to the insert and -order_pkgs methods for a better way to defer provisioning. - -Re-schedules all exports by calling the B method of all associated -packages (see L). 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 @@ -1133,10 +1164,9 @@ sub delete { #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 } ) ) { @@ -1224,37 +1254,62 @@ sub delete { } -=item merge NEW_CUSTNUM [ , OPTION => VALUE ... ] +=item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ] -This merges this customer into the provided new custnum, and then deletes the -customer. If there is an error, returns the error, otherwise returns false. +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. -The source customer's name, company name, phone numbers, agent, -referring customer, customer class, advertising source, order taker, and -billing information (except balance) are discarded. +To change the customer's address, set the pseudo-fields C and +C. The address will still only change if at least one of the +address fields differs from the existing values. -All packages are moved to the target customer. Packages with package locations -are preserved. Packages without package locations are moved to a new package -location with the source customer's service/shipping address. +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: -All invoices, statements, payments, credits and refunds are moved to the target -customer. The source customer's balance is added to the target customer. + $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] ); -All notes, attachments, tickets and customer tags are moved to the target -customer. +Currently available options are: I. -Change history is not currently moved. +The I 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. =cut -sub merge { - my( $self, $new_custnum, %opt ) = @_; +sub replace { + my $self = shift; + + my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') ) + ? shift + : $self->replace_old; - return "Can't merge a customer into self" if $self->custnum == $new_custnum; + my @param = @_; - unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) { - return "Invalid new customer number: $new_custnum"; - } + warn "$me replace called\n" + if $DEBUG; + + my $curuser = $FS::CurrentUser::CurrentUser; + 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 ); + + return "Invoicing locale is required" + if $old->locale + && ! $self->locale + && $conf->exists('cust_main-require_locale'); local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -1267,310 +1322,64 @@ sub merge { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) { - $dbh->rollback if $oldAutoCommit; - return "Can't merge a master agent customer"; - } - - #use FS::access_user - if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) { - $dbh->rollback if $oldAutoCommit; - return "Can't merge a master employee customer"; - } + for my $l (qw(bill_location ship_location)) { + #my $old_loc = $old->$l; + my $new_loc = $self->$l or next; - if ( qsearch('cust_pay_pending', { 'custnum' => $self->custnum, - 'status' => { op=>'!=', value=>'done' }, - } - ) - ) { - $dbh->rollback if $oldAutoCommit; - return "Can't merge a customer with pending payments"; - } + # 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->set($l.'num', $new_loc->locationnum); + } #for $l - tie my %financial_tables, 'Tie::IxHash', - 'cust_bill' => 'invoices', - 'cust_statement' => 'statements', - 'cust_credit' => 'credits', - 'cust_pay' => 'payments', - 'cust_pay_void' => 'voided payments', - 'cust_refund' => 'refunds', - ; - - foreach my $table ( keys %financial_tables ) { + # replace the customer record + my $error = $self->SUPER::replace($old); - my @records = $self->$table(); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } - foreach my $record ( @records ) { - $record->custnum($new_custnum); - my $error = $record->replace; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Error merging ". $financial_tables{$table}. ": $error\n"; - } + # 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; } - } - - my $name = $self->ship_name; - - my $locationnum = ''; - foreach my $cust_pkg ( $self->all_pkgs ) { - $cust_pkg->custnum($new_custnum); - - unless ( $cust_pkg->locationnum ) { - unless ( $locationnum ) { - my $cust_location = new FS::cust_location { - $self->location_hash, - 'custnum' => $new_custnum, - }; - my $error = $cust_location->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - $locationnum = $cust_location->locationnum; - } - $cust_pkg->locationnum($locationnum); + # 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; } + } - my $error = $cust_pkg->replace; + if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF + my $invoicing_list = shift @param; + $error = $self->check_invoicing_list( $invoicing_list ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } + $self->invoicing_list( $invoicing_list ); + } + + if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident - # add customer (ship) name to svc_phone.phone_name if blank - my @cust_svc = $cust_pkg->cust_svc; - foreach my $cust_svc (@cust_svc) { - my($label, $value, $svcdb) = $cust_svc->label; - next unless $svcdb eq 'svc_phone'; - my $svc_phone = $cust_svc->svc_x; - next if $svc_phone->phone_name; - $svc_phone->phone_name($name); - my $error = $svc_phone->replace; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - } - - #not considered: - # cust_tax_exempt (texas tax exemptions) - # cust_recon (some sort of not-well understood thing for OnPac) - - #these are moved over - foreach my $table (qw( - cust_tag cust_location contact cust_attachment cust_main_note - cust_tax_adjustment cust_pay_batch queue - )) { - foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) { - $record->custnum($new_custnum); - my $error = $record->replace; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - } - - #these aren't preserved - foreach my $table (qw( - cust_main_exemption cust_main_invoice - )) { - foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) { - my $error = $record->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - } - - - my $sth = $dbh->prepare( - 'UPDATE cust_main SET referral_custnum = ? WHERE referral_custnum = ?' - ) or do { - my $errstr = $dbh->errstr; - $dbh->rollback if $oldAutoCommit; - return $errstr; - }; - $sth->execute($new_custnum, $self->custnum) or do { - my $errstr = $sth->errstr; - $dbh->rollback if $oldAutoCommit; - return $errstr; - }; - - #tickets - - my $ticket_dbh = ''; - if ($conf->config('ticket_system') eq 'RT_Internal') { - $ticket_dbh = $dbh; - } elsif ($conf->config('ticket_system') eq 'RT_External') { - my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc'); - $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 }); - #or die "RT_External DBI->connect error: $DBI::errstr\n"; - } - - if ( $ticket_dbh ) { - - my $ticket_sth = $ticket_dbh->prepare( - 'UPDATE Links SET Target = ? WHERE Target = ?' - ) or do { - my $errstr = $ticket_dbh->errstr; - $dbh->rollback if $oldAutoCommit; - return $errstr; - }; - $ticket_sth->execute('freeside://freeside/cust_main/'.$new_custnum, - 'freeside://freeside/cust_main/'.$self->custnum) - or do { - my $errstr = $ticket_sth->errstr; - $dbh->rollback if $oldAutoCommit; - return $errstr; - }; - - } - - #delete the customer record - - my $error = $self->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - -} - -=item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ] - - -Replaces the OLD_RECORD with this one in the database. If there is an error, -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: - - $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] ); - -Currently available options are: I. - -The I option can be set to an arrayref of tax names. -FS::cust_main_exemption records will be deleted and inserted as appropriate. - -=cut - -sub replace { - my $self = shift; - - my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') ) - ? shift - : $self->replace_old; - - my @param = @_; - - warn "$me replace called\n" - 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."; - } - - if ( $old->get('geocode') && $old->get('geocode') eq $self->get('geocode') - && $conf->exists('enable_taxproducts') - ) - { - my $pre = ($conf->exists('tax-ship_address') && $self->ship_zip) - ? 'ship_' : ''; - $self->set('geocode', '') - if $old->get($pre.'zip') ne $self->get($pre.'zip') - && length($self->get($pre.'zip')) >= 10; - } - - for my $pre ( grep $old->get($_.'coord_auto'), ( '', 'ship_' ) ) { - - $self->set($pre.'coord_auto', '') && next - if $self->get($pre.'latitude') && $self->get($pre.'longitude') - && ( $self->get($pre.'latitude') != $old->get($pre.'latitude') - || $self->get($pre.'longitude') != $old->get($pre.'longitude') - ); - - $self->set_coord($pre) - if $old->get($pre.'address1') ne $self->get($pre.'address1') - || $old->get($pre.'city') ne $self->get($pre.'city') - || $old->get($pre.'state') ne $self->get($pre.'state') - || $old->get($pre.'country') ne $self->get($pre.'country'); - - } - - unless ( $import ) { - $self->set_coord - if ! $self->coord_auto && ! $self->latitude && ! $self->longitude; - - $self->set_coord('ship_') - if $self->has_ship_address && ! $self->ship_coord_auto - && ! $self->ship_latitude && ! $self->ship_longitude; - } - - 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->censustract ne '' and $self->censustract ne $old->censustract ) { - # update censusyear whenever tract code changes - $self->censusyear($conf->config('census_year')); - } - - - 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; - - my $error = $self->SUPER::replace($old); - - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF - my $invoicing_list = shift @param; - $error = $self->check_invoicing_list( $invoicing_list ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - $self->invoicing_list( $invoicing_list ); - } - - if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident - - #this could be more efficient than deleting and re-inserting, if it matters - foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) { - my $error = $cust_tag->delete; + #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; @@ -1593,17 +1402,27 @@ sub replace { 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 ( @$tax_exemption ) { + foreach my $taxname ( keys %$tax_exemption ) { - next if delete $cust_main_exemption{$taxname}; + 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, + 'custnum' => $self->custnum, + 'taxname' => $taxname, + 'exempt_number' => $tax_exemption->{$taxname}, }; my $error = $cust_main_exemption->insert; if ( $error ) { @@ -1622,21 +1441,19 @@ sub replace { } - if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ - && ( ( $self->get('payinfo') ne $old->get('payinfo') - && $self->get('payinfo') !~ /^99\d{14}$/ - ) - || grep { $self->get($_) ne $old->get($_) } qw(paydate payname) - ) - ) - { + if ( my $cust_payby_params = delete $options{'cust_payby_params'} ) { - # card/check/lec info has changed, want to retry realtime_ invoice events - my $error = $self->retry_realtime; + my $error = $self->process_o2m( + 'table' => 'cust_payby', + 'fields' => FS::cust_payby->cgi_cust_payby_fields, + 'params' => $cust_payby_params, + 'hash_callback' => \&FS::cust_payby::cgi_hash_callback, + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } + } unless ( $import || $skip_fuzzyfiles ) { @@ -1647,24 +1464,7 @@ sub replace { } } - # FS::geocode_Mixin::after_replace ? - # though this will go away anyway once we move customer bill/service - # locations into cust_location - # We can trigger this on any address change--just have to make sure - # not to trigger it on itself. - if ( $conf->config('tax_district_method') and !$import - and ( $self->get('ship_address1') ne $old->get('ship_address1') - or $self->get('address1') ne $old->get('address1') ) ) { - 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"; - } - } + # tax district update in cust_location # cust_main exports! @@ -1709,16 +1509,27 @@ sub queue_fuzzyfiles_update { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $queue = new FS::queue { 'job' => 'FS::cust_main::Search::append_fuzzyfiles' }; - my $error = $queue->insert( map $self->getfield($_), @FS::cust_main::Search::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::Search::append_fuzzyfiles' }; - $error = $queue->insert( map $self->getfield("ship_$_"), @FS::cust_main::Search::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"; @@ -1749,48 +1560,66 @@ sub check { || $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_coordn('latitude') - || $self->ut_coordn('longitude') - || $self->ut_enum('coord_auto', [ '', 'Y' ]) - || $self->ut_numbern('censusyear') + || $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_alphan('district') || $self->ut_floatn('cdr_termination_percentage') || $self->ut_floatn('credit_limit') || $self->ut_numbern('billday') - || $self->ut_enum('edit_subject', [ '', 'Y' ] ) - || $self->ut_enum('calling_list_exempt', [ '', 'Y' ] ) + || $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_alphan('po_number') + || $self->ut_enum('complimentary', [ '', 'Y' ]) + || $self->ut_flag('invoice_ship_address') ; - $self->set_coord - unless $import || ($self->latitude && $self->longitude); + 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 } ); @@ -1799,13 +1628,6 @@ sub check { 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 { @@ -1816,24 +1638,13 @@ sub check { $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) @@ -1842,12 +1653,8 @@ sub check { ; 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') + if ( $conf->exists('cust_main-require_phone', $self->agentnum) + && ! $import && ! length($self->daytime) && ! length($self->night) && ! length($self->mobile) ) { @@ -1866,78 +1673,17 @@ sub check { } - 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') - || $self->ut_coordn('ship_latitude') - || $self->ut_coordn('ship_longitude') - || $self->ut_enum('ship_coord_auto', [ '', 'Y' ] ) - ; - return $error if $error; - - $self->set_coord('ship_') - unless $import || ($self->ship_latitude && $self->ship_longitude); - - #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) - || $self->ut_phonen('ship_mobile', $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'); + ### start of stuff moved to cust_payby + # then mostly kept here to support upgrades (can remove in 5.x) + # but modified to allow everything to be empty + if ( $self->payby ) { + FS::payby->can_payby($self->table, $self->payby) + or return "Illegal payby: ". $self->payby; + } else { + $self->payby(''); } - #$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; - $error = $self->ut_numbern('paystart_month') || $self->ut_numbern('paystart_year') || $self->ut_numbern('payissue') @@ -1956,7 +1702,10 @@ sub check { # check the credit card. my $check_payinfo = ! $self->is_encrypted($self->payinfo); - if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) { + # Need some kind of global flag to accept invalid cards, for testing + # on scrubbed data. + if ( !$import && !$ignore_invalid_card && $check_payinfo && + $self->payby =~ /^(CARD|DCRD)$/ ) { my $payinfo = $self->payinfo; $payinfo =~ s/\D//g; @@ -2028,7 +1777,8 @@ sub check { $self->payissue(''); } - } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) { + } elsif ( !$ignore_invalid_card && $check_payinfo && + $self->payby =~ /^(CHEK|DCHK)$/ ) { my $payinfo = $self->payinfo; $payinfo =~ s/[^\d\@\.]//g; @@ -2103,9 +1853,16 @@ sub check { } + return "You are not permitted to create complimentary accounts." + if ! $self->custnum + && $self->complimentary eq 'Y' + && ! $FS::CurrentUser::CurrentUser->access_right('Complimentary customer'); + if ( $self->paydate eq '' || $self->paydate eq '-' ) { return "Expiration date required" - unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/; + # shouldn't payinfo_check do this? + unless ! $self->payby + || $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD|PPAL)$/; $self->paydate(''); } else { my( $m, $y ); @@ -2133,11 +1890,26 @@ sub check { ) { $self->payname( $self->first. " ". $self->getfield('last') ); } else { - $self->payname =~ /^([\w \,\.\-\'\&]+)$/ - or return gettext('illegal_name'). " payname: ". $self->payname; - $self->payname($1); + + if ( $self->payby =~ /^(CHEK|DCHK)$/ ) { + $self->payname =~ /^([\w \,\.\-\']*)$/ + or return gettext('illegal_name'). " payname: ". $self->payname; + $self->payname($1); + } else { + $self->payname =~ /^([\w \,\.\-\'\&]*)$/ + or return gettext('illegal_name'). " payname: ". $self->payname; + $self->payname($1); + } + } + ### end of stuff moved to cust_payby + + return "Please select an invoicing locale" + if ! $self->locale + && ! $self->custnum + && $conf->exists('cust_main-require_locale'); + 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); @@ -2151,6 +1923,21 @@ sub check { $self->SUPER::check; } +=item replace_check + +Additional checks for replace only. + +=cut + +sub replace_check { + my ($new,$old) = @_; + #preserve old value if global config is set + if ($old && $conf->exists('invoice-ship_address')) { + $new->invoice_ship_address($old->invoice_ship_address); + } + return ''; +} + =item addr_fields Returns a list of fields which have ship_ duplicates. @@ -2159,6 +1946,7 @@ Returns a list of fields which have ship_ duplicates. sub addr_fields { qw( last first company + locationname address1 address2 city county state zip country latitude longitude daytime night fax mobile @@ -2173,7 +1961,7 @@ Returns true if this customer record has a separate shipping address. 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 @@ -2184,6 +1972,11 @@ shipping address is used if present. =cut +sub location_hash { + my $self = shift; + $self->ship_location->location_hash; +} + =item cust_location Returns all locations (see L) for this customer. @@ -2192,32 +1985,71 @@ Returns all locations (see L) for this customer. sub cust_location { my $self = shift; - qsearch('cust_location', { 'custnum' => $self->custnum } ); + qsearch('cust_location', { 'custnum' => $self->custnum, + 'prospectnum' => '' } ); } =item cust_contact -Returns all contacts (see L) for this customer. +Returns all contact associations (see L) for this customer. =cut -#already used :/ sub contact { sub cust_contact { my $self = shift; - qsearch('contact', { 'custnum' => $self->custnum } ); + qsearch('cust_contact', { 'custnum' => $self->custnum } ); +} + +=item cust_payby + +Returns all payment methods (see L) for this customer. + +=cut + +sub cust_payby { + my $self = shift; + qsearch({ + 'table' => 'cust_payby', + 'hashref' => { 'custnum' => $self->custnum }, + 'order_by' => "ORDER BY payby IN ('CARD','CHEK') DESC, weight ASC", + }); +} + +sub has_cust_payby_auto { + my $self = shift; + scalar( qsearch({ + 'table' => 'cust_payby', + 'hashref' => { 'custnum' => $self->custnum, }, + 'extra_sql' => " AND payby IN ( 'CARD', 'CHEK' ) ", + 'order_by' => 'LIMIT 1', + }) ); + } =item unsuspend Unsuspends all unflagged suspended packages (see L -and L) for this customer. Always returns a list: an empty list -on success or a list of errors. +and L) 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 @@ -2332,16 +2164,21 @@ sub cancel { return ( 'access denied' ) unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer'); - if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) { + if ( $opt{'ban'} ) { - #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); + foreach my $cust_payby ( $self->cust_payby ) { - my $ban = new FS::banned_pay $self->_new_banned_pay_hashref; - my $error = $ban->insert; - return ( $error ) if $error; + #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 $cust_payby->_new_banned_pay_hashref; + my $error = $ban->insert; + return ( $error ) if $error; + + } } @@ -2378,13 +2215,6 @@ sub _banned_pay_hashref { }; } -sub _new_banned_pay_hashref { - my $self = shift; - my $hr = $self->_banned_pay_hashref; - $hr->{payinfo} = md5_base64($hr->{payinfo}); - $hr; -} - =item notes Returns all notes (see L) for this customer. @@ -2393,8 +2223,8 @@ Returns all notes (see L) for this customer. sub notes { my($self,$orderby_classnum) = (shift,shift); - my $orderby = "_DATE DESC"; - $orderby = "CLASSNUM ASC, $orderby" if $orderby_classnum; + my $orderby = "sticky DESC, _date DESC"; + $orderby = "classnum ASC, $orderby" if $orderby_classnum; qsearch( 'cust_main_note', { 'custnum' => $self->custnum }, '', @@ -2406,13 +2236,6 @@ sub notes { Returns the agent (see L) for this customer. -=cut - -sub agent { - my $self = shift; - qsearchs( 'agent', { 'agentnum' => $self->agentnum } ); -} - =item agent_name Returns the agent name (see L) for this customer. @@ -2429,13 +2252,6 @@ sub agent_name { 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, @@ -2454,17 +2270,6 @@ sub part_tag { 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 @@ -2495,6 +2300,36 @@ sub classname { : ''; } +=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 @@ -2523,138 +2358,6 @@ sub remove_cvv { ''; } -=item batch_card OPTION => VALUE... - -Adds a payment for this invoice to the pending credit card batch (see -L), or, if the B 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), - ); - $pay_batch{agentnum} = $self->agentnum if $conf->exists('batch-spoolagent'); - - my $pay_batch = qsearchs( 'pay_batch', \%pay_batch ); - - unless ( $pay_batch ) { - $pay_batch = new FS::pay_batch \%pay_batch; - my $error = $pay_batch->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - die "error creating new batch: $error\n"; - } - } - - my $old_cust_pay_batch = qsearchs('cust_pay_batch', { - 'batchnum' => $pay_batch->batchnum, - 'custnum' => $self->custnum, - } ); - - foreach (qw( address1 address2 city state zip country latitude longitude - 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 @@ -2887,7 +2590,7 @@ UNIX timestamps; see L). Also see L and L for conversion functions. The empty string can be passed to disable that time constraint completely. -Available options are: +Accepts the same options as L: =over 4 @@ -2895,6 +2598,12 @@ Available options are: 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 after this +time will be ignored. Note that START_TIME and END_TIME only limit the date +range for invoices and I payments, credits, and refunds. + =back =cut @@ -2919,34 +2628,11 @@ sub balance_pkgnum { sprintf( "%.2f", $self->total_owed_pkgnum($pkgnum) -# n/a - refunds aren't part of pkg-balances since they don't apply to invoices -# + $self->total_unapplied_refunds_pkgnum($pkgnum) - - $self->total_unapplied_credits_pkgnum($pkgnum) - - $self->total_unapplied_payments_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 and L - -=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 ); +# n/a - refunds aren't part of pkg-balances since they don't apply to invoices +# + $self->total_unapplied_refunds_pkgnum($pkgnum) + - $self->total_unapplied_credits_pkgnum($pkgnum) + - $self->total_unapplied_payments_pkgnum($pkgnum) + ); } =item payment_info @@ -2999,7 +2685,8 @@ sub payment_info { $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; @@ -3116,13 +2803,6 @@ sub tax_exemption { =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 @@ -3214,7 +2894,7 @@ sub check_invoicing_list { } 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; ''; @@ -3399,6 +3079,8 @@ reason, and a 'reason_type' option must be passed to indicate the FS::reason_type for the new reason. An I option may be passed to set the credit's I field. +Likewise for I, I, I and +I. Any other options are passed to FS::cust_credit::insert. @@ -3424,10 +3106,10 @@ sub credit { $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); @@ -3452,6 +3134,8 @@ New-style, with a hashref of options: 'setuptax' => '', # or 'Y' for tax exempt + 'locationnum'=> 1234, # optional + #internal taxation 'taxclass' => 'Tax class', @@ -3474,17 +3158,21 @@ Old-style: =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} : ''; @@ -3500,8 +3188,11 @@ sub charge { $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'; @@ -3532,6 +3223,7 @@ sub charge { 'setuptax' => $setuptax, 'taxclass' => $taxclass, 'taxproductnum' => $taxproduct, + 'setup_cost' => $setup_cost, } ); my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) } @@ -3566,6 +3258,8 @@ sub charge { 'quantity' => $quantity, 'start_date' => $start_date, 'no_auto' => $no_auto, + 'separate_bill' => $separate_bill, + 'locationnum'=> $locationnum, } ); $error = $cust_pkg->insert; @@ -3688,6 +3382,20 @@ be passed. =cut +=item cust_bill_void + +Returns all the voided invoices (see L) 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 : { @_ }; @@ -3784,6 +3492,19 @@ sub cust_credit_pkgnum { ); } +=item cust_credit_void + +Returns all voided credits (see L) 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) for this customer. @@ -3792,9 +3513,17 @@ Returns all the payments (see L) 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 @@ -3812,6 +3541,22 @@ sub num_cust_pay { $sth->fetchrow_arrayref->[0]; } +=item unapplied_cust_pay + +Returns all the unapplied payments (see L) for this customer. + +=cut + +sub unapplied_cust_pay { + my $self = shift; + + $self->cust_pay( + 'extra_sql' => ' AND '. FS::cust_pay->unapplied_sql. ' > 0', + #@_ + ); + +} + =item cust_pay_pkgnum Returns all the payments (see L) for this customer's specific @@ -3842,31 +3587,6 @@ sub cust_pay_void { qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } ) } -=item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ] - -Returns all batched payments (see L) 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) for this customer @@ -3961,11 +3681,35 @@ cust_main-default_agent_custid is set and it has a value, custnum otherwise. sub display_custnum { my $self = shift; + + my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || ''; + if ( my $special = $conf->config('cust_main-custnum-display_special') ) { + if ( $special eq 'CoStAg' ) { + $prefix = uc( join('', + $self->country, + ($self->state =~ /^(..)/), + $prefix || ($self->agent->agent =~ /^(..)/) + ) ); + } + elsif ( $special eq 'CoStCl' ) { + $prefix = uc( join('', + $self->country, + ($self->state =~ /^(..)/), + ($self->classnum ? $self->cust_class->classname =~ /^(..)/ : '__') + ) ); + } + # add any others here if needed + } + + my $length = $conf->config('cust_main-custnum-display_length'); if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){ return $self->agent_custid; - } elsif ( $conf->config('cust_main-custnum-display_prefix') ) { - return $conf->config('cust_main-custnum-display_prefix'). - sprintf('%08d', $self->custnum) + } elsif ( $prefix ) { + $length = 8 if !defined($length); + return $prefix . + sprintf('%0'.$length.'d', $self->custnum) + } elsif ( $length ) { + return sprintf('%0'.$length.'d', $self->custnum); } else { return $self->custnum; } @@ -3985,6 +3729,29 @@ sub name { $name; } +=item service_contact + +Returns the L 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 @@ -3994,13 +3761,10 @@ 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 @@ -4023,13 +3787,9 @@ or "First Last". 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 @@ -4051,9 +3811,8 @@ Returns this customer's full (shipping) contact name only, "Last, First" 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 @@ -4075,20 +3834,48 @@ Returns this customer's full (shipping) contact name only, "First Last". 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'); +} + +#XXX this doesn't work in 3.x+ +#=item country_full +# +#Returns this customer's full country name +# +#=cut +# +#sub country_full { +# my $self = shift; +# code2country($self->country); +#} + +sub bill_country_full { + my $self = shift; + code2country($self->bill_location->country); +} + +sub ship_country_full { + my $self = shift; + code2country($self->ship_location->country); } -=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 @@ -4106,17 +3893,29 @@ Returns a status string for this customer, currently: =over 4 -=item prospect - No packages have ever been ordered +=item prospect -=item ordered - Recurring packages all are new (not yet billed). +No packages have ever been ordered. Displayed as "No packages". -=item active - One or more recurring packages is active +=item ordered -=item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled) +Recurring packages all are new (not yet billed). -=item suspended - All non-cancelled recurring packages are suspended +=item active -=item cancelled - All recurring packages are cancelled +One or more recurring packages is active. + +=item inactive + +No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled). + +=item suspended + +All non-cancelled recurring packages are suspended. + +=item cancelled + +All recurring packages are cancelled. =back @@ -4139,21 +3938,64 @@ sub cust_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. @@ -4167,14 +4009,17 @@ sub cust_statuscolor { __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 = (); @@ -4182,7 +4027,12 @@ sub tickets { if ( $conf->config('ticket_system') ) { unless ( $conf->config('ticket_system-custom_priority_field') ) { - @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) }; + @tickets = @{ FS::TicketSystem->customer_tickets( $self->custnum, + $num, + undef, + $status, + ) + }; } else { @@ -4194,6 +4044,7 @@ sub tickets { @{ FS::TicketSystem->customer_tickets( $self->custnum, $num - scalar(@tickets), $priority, + $status, ) }; } @@ -4549,121 +4400,6 @@ sub search { =over 4 -=item batch_charge - -=cut - -sub batch_charge { - my $param = shift; - #warn join('-',keys %$param); - my $fh = $param->{filehandle}; - my $agentnum = $param->{agentnum}; - my $format = $param->{format}; - - my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql; - - my @fields; - if ( $format eq 'simple' ) { - @fields = qw( custnum agent_custid amount pkg ); - } else { - die "unknown format $format"; - } - - eval "use Text::CSV_XS;"; - die $@ if $@; - - my $csv = new Text::CSV_XS; - #warn $csv; - #warn $fh; - - my $imported = 0; - #my $columns; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - #while ( $columns = $csv->getline($fh) ) { - my $line; - while ( defined($line=<$fh>) ) { - - $csv->parse($line) or do { - $dbh->rollback if $oldAutoCommit; - return "can't parse: ". $csv->error_input(); - }; - - my @columns = $csv->fields(); - #warn join('-',@columns); - - my %row = (); - foreach my $field ( @fields ) { - $row{$field} = shift @columns; - } - - if ( $row{custnum} && $row{agent_custid} ) { - dbh->rollback if $oldAutoCommit; - return "can't specify custnum with agent_custid $row{agent_custid}"; - } - - my %hash = (); - if ( $row{agent_custid} && $agentnum ) { - %hash = ( 'agent_custid' => $row{agent_custid}, - 'agentnum' => $agentnum, - ); - } - - if ( $row{custnum} ) { - %hash = ( 'custnum' => $row{custnum} ); - } - - unless ( scalar(keys %hash) ) { - $dbh->rollback if $oldAutoCommit; - return "can't find customer without custnum or agent_custid and agentnum"; - } - - my $cust_main = qsearchs('cust_main', { %hash } ); - unless ( $cust_main ) { - $dbh->rollback if $oldAutoCommit; - my $custnum = $row{custnum} || $row{agent_custid}; - return "unknown custnum $custnum"; - } - - if ( $row{'amount'} > 0 ) { - my $error = $cust_main->charge($row{'amount'}, $row{'pkg'}); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - $imported++; - } elsif ( $row{'amount'} < 0 ) { - my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ), - $row{'pkg'} ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - $imported++; - } else { - #hmm? - } - - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - return "Empty file!" unless $imported; - - ''; #no error - -} - =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS Deprecated. Use event notification and message templates @@ -4701,7 +4437,7 @@ sub notify { return unless $conf->exists($template); - my $from = $conf->config('invoice_from', $self->agentnum) + my $from = $conf->invoice_from_full($self->agentnum) if $conf->exists('invoice_from', $self->agentnum); $from = $options{from} if exists($options{from}); @@ -4903,15 +4639,18 @@ sub queueable_print { my %opt = @_; my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } ) - or die "invalid customer number: " . $opt{custvnum}; + or die "invalid customer number: " . $opt{custnum}; - my $error = $self->print( $opt{template} ); + my $error = $self->print( { 'template' => $opt{template} } ); die $error if $error; } sub 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 @@ -4985,6 +4724,42 @@ sub _agent_plandata { } +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. @@ -5001,12 +4776,30 @@ sub queued_bill { 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, just runs the +C 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; @@ -5016,73 +4809,141 @@ sub process_bill_and_collect { $cust_main->bill_and_collect( %$param ); } -=item process_censustract_update CUSTNUM - -Queueable function to update the census tract to the current year (as set in -the 'census_year' configuration variable) and retrieve the new tract code. - -=cut - -sub process_censustract_update { - eval "use FS::Misc::Geo qw(get_censustract)"; - die $@ if $@; - my $custnum = shift; - my $cust_main = qsearchs( 'cust_main', { custnum => $custnum }) - or die "custnum '$custnum' not found!\n"; - - my $new_year = $conf->config('census_year') or return; - my $new_tract = get_censustract({ $cust_main->location_hash }, $new_year); - if ( $new_tract =~ /^\d/ ) { - # then it's a tract code - $cust_main->set('censustract', $new_tract); - $cust_main->set('censusyear', $new_year); - - 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?) - my $error = $cust_main->replace; - die $error if $error; - } - else { - # it's an error message - die $new_tract; - } - return; -} +#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) = @_; my @statements = ( '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', ); - # fix yyyy-m-dd formatted paydates - if ( driver_name =~ /^mysql/i ) { + + #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 paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'"; + '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'); } - else { # the SQL standard - push @statements, - "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'"; + + unless ( FS::upgrade_journal->is_done('cust_main__paydate') ) { + + # fix yyyy-m-dd formatted paydates + if ( driver_name =~ /^mysql/i ) { + push @statements, + "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'"; + } else { # the SQL standard + push @statements, + "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'"; + } + FS::upgrade_journal->set_done('cust_main__paydate'); } - push @statements, #fix the weird BILL with a cc# in payinfo problem - #DCRD to be safe - "UPDATE cust_main SET payby = 'DCRD' WHERE payby = 'BILL' and length(payinfo) = 16 and payinfo ". regexp_sql. q( '^[0-9]*$' ); + unless ( FS::upgrade_journal->is_done('cust_main__payinfo') ) { + + push @statements, #fix the weird BILL with a cc# in payinfo problem + #DCRD to be safe + "UPDATE cust_main SET payby = 'DCRD' WHERE payby = 'BILL' and length(payinfo) = 16 and payinfo ". regexp_sql. q( '^[0-9]*$' ); + + FS::upgrade_journal->set_done('cust_main__payinfo'); + + } + 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'); + + } + + unless ( FS::upgrade_journal->is_done('cust_main__cust_payby') ) { + + #we don't want to decrypt them, just stuff them as-is into cust_payby + local(@encrypted_fields) = (); + + local($FS::cust_payby::ignore_expired_card) = 1; + local($FS::cust_payby::ignore_banned_card) = 1; + + my @payfields = qw( payby payinfo paycvv paymask + paydate paystart_month paystart_year payissue + payname paystate paytype payip + ); + + my $search = new FS::Cursor { + 'table' => 'cust_main', + 'extra_sql' => " WHERE ( payby IS NOT NULL AND payby != '' ) ", + }; + + while (my $cust_main = $search->fetch) { + + unless ( $cust_main->payby =~ /^(BILL|COMP)$/ ) { + + my $cust_payby = new FS::cust_payby { + 'custnum' => $cust_main->custnum, + 'weight' => 1, + map { $_ => $cust_main->$_(); } @payfields + }; + + my $error = $cust_payby->insert; + die $error if $error; + + } + + $cust_main->complimentary('Y') if $cust_main->payby eq 'COMP'; + + $cust_main->invoice_attn( $cust_main->payname ) + if $cust_main->payby eq 'BILL' && $cust_main->payname; + $cust_main->po_number( $cust_main->payinfo ) + if $cust_main->payby eq 'BILL' && $cust_main->payinfo; + + $cust_main->setfield($_, '') foreach @payfields; + my $error = $cust_main->replace; + die "Error upgradging payment information for custnum ". + $cust_main->custnum. ": $error" + if $error; + + }; + + FS::upgrade_journal->set_done('cust_main__cust_payby'); + } + $class->_upgrade_otaker(%opts); }