X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=8647c829a1436d0ac9828cbd30864a27c0370235;hp=bf5baa98665688c57b4448b8d8f9049a1f3b2241;hb=1fe87434632f2627de487ca2aed6cfadea2c6061;hpb=c6c6f758f1699388bca7705fd66fb7139955b532 diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index bf5baa986..8647c829a 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -20,15 +20,17 @@ use base qw( FS::cust_main::Packages require 5.006; use strict; use Carp; +use Try::Tiny; use Scalar::Util qw( blessed ); -use Time::Local qw(timelocal); -use Data::Dumper; +use List::Util qw(min); use Tie::IxHash; +use File::Temp; #qw( tempfile ); +use Data::Dumper; +use Time::Local qw(timelocal); use Date::Format; #use Date::Manip; -use File::Temp; #qw( tempfile ); +use Email::Address; use Business::CreditCard 0.28; -use List::Util qw(min); use FS::UID qw( dbh driver_name ); use FS::Record qw( qsearchs qsearch dbdef regexp_sql ); use FS::Cursor; @@ -76,6 +78,8 @@ use FS::upgrade_journal; use FS::sales; use FS::cust_payby; use FS::contact; +use FS::reason; +use FS::Misc::Savepoint; # 1 is mostly method/subroutine entry and options # 2 traces progress of some operations @@ -374,6 +378,10 @@ sub insert { join(', ', map { "$_: $options{$_}" } keys %options ). "\n" if $DEBUG; + return "You are not permitted to change customer invoicing terms." + if $self->invoice_terms #i.e. not the default + && ! $FS::CurrentUser::CurrentUser->access_right('Edit customer invoice terms'); + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -532,6 +540,7 @@ sub insert { 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 @@ -554,7 +563,10 @@ sub insert { 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" @@ -578,8 +590,7 @@ sub insert { custnum => $self->custnum, }); $cust_contact->set('invoice_dest', 'Y'); - my $error = $cust_contact->contactnum ? - $cust_contact->replace : $cust_contact->insert; + my $error = $cust_contact->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; return "$error (linking to email address $dest)"; @@ -593,17 +604,21 @@ sub insert { } } - 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 ( $email ) { + + 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; + } + } } @@ -728,20 +743,6 @@ sub insert { } } - # 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; @@ -1315,7 +1316,7 @@ set as the contact email address for a default contact with the same name as the customer. Currently available options are: I, I, -I, I. +I, I, and I. 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 @@ -1329,6 +1330,9 @@ and L for the fields these can contain. I is a synonym for the INVOICING_LIST_ARYREF parameter, and should be used instead if possible. +If I is an arrayref, it will override the list of packages +to be moved to the new address (see L.) + =cut sub replace { @@ -1372,6 +1376,10 @@ sub replace { && ! $self->locale && $conf->exists('cust_main-require_locale'); + return "You are not permitted to change customer invoicing terms." + if $old->invoice_terms ne $self->invoice_terms + && ! $curuser->access_right('Edit customer invoice terms'); + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -1496,6 +1504,16 @@ sub replace { $implicit_contact->set('emailaddress', $email); $implicit_contact->set('invoice_dest', 'Y'); $implicit_contact->set('custnum', $self->custnum); + my $i_cust_contact = + qsearchs('cust_contact', { + contactnum => $implicit_contact->contactnum, + custnum => $self->custnum, + } + ); + if ( $i_cust_contact ) { + $implicit_contact->set($_, $i_cust_contact->$_) + foreach qw( classnum selfservice_access comment ); + } my $error; if ( $implicit_contact->contactnum ) { @@ -1523,7 +1541,7 @@ sub replace { $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); + $error = $old->ship_location->move_to($self->ship_location, move_pkgs => $options{'move_pkgs'}); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -1766,6 +1784,7 @@ sub check { || $self->ut_floatn('credit_limit') || $self->ut_numbern('billday') || $self->ut_numbern('prorate_day') + || $self->ut_flag('force_prorate_day') || $self->ut_flag('edit_subject') || $self->ut_flag('calling_list_exempt') || $self->ut_flag('invoice_noemail') @@ -1860,6 +1879,10 @@ sub check { && ! $self->custnum && $conf->exists('cust_main-require_locale'); + return "Please select a customer class" + if ! $self->classnum + && $conf->exists('cust_main-require_classnum'); + 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); @@ -1881,7 +1904,7 @@ sub check_payinfo_cardtype { my $payinfo = $self->payinfo; $payinfo =~ s/\D//g; - return '' if $payinfo =~ /^99\d{14}$/; #token + return '' if $self->tokenized($payinfo); #token my %bop_card_types = map { $_=>1 } values %{ card_types() }; my $cardtype = cardtype($payinfo); @@ -1991,7 +2014,9 @@ sub 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) . ' ) ' + $search->{'extra_sql'} = ' AND payby IN ( '. + join(',', map dbh->quote($_), @payby). + ' ) ' if @payby; qsearch($search); @@ -2025,7 +2050,7 @@ Returns a list: an empty list on success or a list of errors. sub unsuspend { my $self = shift; - grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs; + grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs(@_); } =item release_hold @@ -2121,33 +2146,67 @@ sub suspend_unless_pkgpart { =item cancel [ OPTION => VALUE ... ] Cancels all uncancelled packages (see L) 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), 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, reason - Text of the new reason. +=item reason - can be set to a cancellation reason (see L), 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) +reason - Text of the new reason. + +=item cust_pkg_reason - can be an arrayref of L objects +for the individual packages, parallel to the C 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 + # unless exports are suppressed + die "cancel_pkgs cannot be run inside a transaction" + if !$FS::UID::AutoCommit && !$FS::svc_Common::noexport_hack; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + + savepoint_create('cancel_pkgs'); return ( 'access denied' ) unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer'); @@ -2164,26 +2223,114 @@ sub cancel { my $ban = new FS::banned_pay $cust_payby->_new_banned_pay_hashref; my $error = $ban->insert; - return ( $error ) if $error; + if ($error) { + savepoint_rollback_and_release('cancel_pkgs'); + dbh->rollback if $oldAutoCommit; + 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"; + savepoint_rollback_and_release('cancel_pkgs'); + dbh->rollback if $oldAutoCommit; + return ( "Error billing during cancellation: $error" ); + } + } + savepoint_release('cancel_pkgs'); + dbh->commit if $oldAutoCommit; + + 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; + my $i = 0; + foreach my $cust_svc (@sorted_cust_svc) { + my $savepoint = 'cancel_pkgs_'.$i++; + savepoint_create( $savepoint ); + 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 ) { + savepoint_rollback_and_release( $savepoint ); + dbh->rollback if $oldAutoCommit; + push @errors, $error; + } else { + savepoint_release( $savepoint ); + dbh->commit if $oldAutoCommit; + } + } + if (@errors) { + return @errors; } - warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/". - scalar(@pkgs). " packages for customer ". $self->custnum. "\n" + warn "$me cancelling ". scalar(@pkgs) ." package(s) for customer ". + $self->custnum. "\n" if $DEBUG; - grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs; + my @cprs; + if ($opt{'cust_pkg_reason'}) { + @cprs = @{ delete $opt{'cust_pkg_reason'} }; + } + my $null_reason; + $i = 0; + foreach (@pkgs) { + my %lopt = %opt; + my $savepoint = 'cancel_pkgs_'.$i++; + savepoint_create( $savepoint ); + 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 ) { + savepoint_rollback_and_release( $savepoint ); + dbh->rollback if $oldAutoCommit; + push @errors, 'pkgnum '.$_->pkgnum.': '.$error; + } else { + savepoint_release( $savepoint ); + dbh->commit if $oldAutoCommit; + } + } + + return @errors; } sub _banned_pay_hashref { @@ -2336,6 +2483,8 @@ Removes the I field from the database directly. If there is an error, returns the error, otherwise returns false. +DEPRECATED. Use L instead. + =cut sub remove_cvv { @@ -2877,48 +3026,104 @@ sub invoicing_list_emailonly_scalar { join(', ', $self->invoicing_list_emailonly); } -=item contact_list [ CLASSNUM, ... ] +=item contact_list [ CLASSNUM, DEST_FLAG... ] -Returns a list of contacts (L 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. +Returns a list of contacts (L objects) for the customer. If no arguments are given, returns all contacts for the customer. +Arguments may contain classnums. When classnums are specified, only +contacts with a matching cust_contact.classnum are returned. When a +classnum of 0 is given, contacts with a null classnum are also included. + +Arguments may also contain the dest flag names 'invoice' or 'message'. +If given, contacts who's invoice_dest and/or message_dest flags are +not set to 'Y' will be excluded. + =cut sub contact_list { my $self = shift; my $search = { table => 'contact', - select => 'contact.*, cust_contact.invoice_dest', + select => join(', ',( + 'contact.*', + 'cust_contact.invoice_dest', + 'cust_contact.message_dest', + )), addl_from => ' JOIN cust_contact USING (contactnum)', extra_sql => ' WHERE cust_contact.custnum = '.$self->custnum, }; - my @orwhere; + # Bugfix notes: + # Calling methods were relying on this method to use invoice_dest to + # block e-mail messages. Depending on parameters, this may or may not + # have actually happened. + # + # The bug could cause this SQL to be used to filter e-mail addresses: + # + # AND ( + # cust_contact.classnums IN (1,2,3) + # OR cust_contact.invoice_dest = 'Y' + # ) + # + # improperly including everybody with the opt-in flag AND everybody + # in the contact classes + # + # Possibility to introduce new bugs: + # If callers of this method called it incorrectly, and didn't notice + # because it seemed to send the e-mails they wanted. + + # WHERE ... + # AND ( + # ( + # cust_contact.classnum IN (1,2,3) + # OR + # cust_contact.classnum IS NULL + # ) + # AND ( + # cust_contact.invoice_dest = 'Y' + # OR + # cust_contact.message_dest = 'Y' + # ) + # ) + + my @and_dest; + my @or_classnum; my @classnums; - foreach (@_) { - if ( $_ eq 'invoice' ) { - push @orwhere, 'cust_contact.invoice_dest = \'Y\''; - } elsif ( $_ eq '0' ) { - push @orwhere, 'cust_contact.classnum is null'; + for (@_) { + if ($_ eq 'invoice' || $_ eq 'message') { + push @and_dest, " cust_contact.${_}_dest = 'Y' "; + } elsif ($_ eq '0') { + push @or_classnum, ' cust_contact.classnum IS NULL '; } elsif ( /^\d+$/ ) { push @classnums, $_; } else { - die "bad classnum argument '$_'"; + croak "bad classnum argument '$_'"; } } - if (@classnums) { - push @orwhere, 'cust_contact.classnum IN ('.join(',', @classnums).')'; - } - if (@orwhere) { - $search->{extra_sql} .= ' AND (' . - join(' OR ', map "( $_ )", @orwhere) . - ')'; + push @or_classnum, 'cust_contact.classnum IN ('.join(',',@classnums).')' + if @classnums; + + if (@or_classnum || @and_dest) { # catch, no arguments given + $search->{extra_sql} .= ' AND ( '; + + if (@or_classnum) { + $search->{extra_sql} .= ' ( '; + $search->{extra_sql} .= join ' OR ', map {" $_ "} @or_classnum; + $search->{extra_sql} .= ' ) '; + $search->{extra_sql} .= ' AND ( ' if @and_dest; + } + + if (@and_dest) { + $search->{extra_sql} .= join ' OR ', map {" $_ "} @and_dest; + $search->{extra_sql} .= ' ) ' if @or_classnum; + } + + $search->{extra_sql} .= ' ) '; + + warn "\$extra_sql: $search->{extra_sql} \n" if $DEBUG; } qsearch($search); @@ -2937,13 +3142,109 @@ sub contact_list_email { my @emails; foreach my $contact (@contacts) { foreach my $contact_email ($contact->contact_email) { - push @emails, - $contact->firstlast . ' <' . $contact_email->emailaddress . '>'; + push @emails, Email::Address->new( $contact->firstlast, + $contact_email->emailaddress + )->format; } } @emails; } +=item contact_list_email_destinations + +Returns a list of emails and whether they receive invoices or messages destinations. +{ emailaddress => 'email.com', invoice => 'Y', message => '', } + +=cut + +sub contact_list_email_destinations { + my $self = shift; + warn "$me contact_list_email_destinations" + if $DEBUG; + return () if !$self->custnum; # not yet inserted + return map { $_ } + qsearch({ + table => 'cust_contact', + select => 'emailaddress, cust_contact.invoice_dest as invoice, cust_contact.message_dest as message', + addl_from => ' JOIN contact USING (contactnum) '. + ' JOIN contact_email USING (contactnum)', + hashref => { 'custnum' => $self->custnum, }, + order_by => 'ORDER BY custcontactnum DESC', + extra_sql => '', + }); +} + +=item contact_list_emailonly + +Returns an array of hashes containing the emails. Used for displaying contact email field in advanced customer reports. +[ { data => 'email.com', }, ] + +=cut + +sub contact_list_emailonly { + my $self = shift; + warn "$me contact_list_emailonly called" + if $DEBUG; + my @emails; + foreach ($self->contact_list_email_destinations) { + my $data = [ + { + 'data' => $_->emailaddress, + }, + ]; + push @emails, $data; + } + return \@emails; +} + +=item contact_list_cust_invoice_only + +Returns an array of hashes containing cust_contact.invoice_dest. Does this email receive invoices. Used for displaying email Invoice field in advanced customer reports. +[ { data => 'Yes', }, ] + +=cut + +sub contact_list_cust_invoice_only { + my $self = shift; + warn "$me contact_list_cust_invoice_only called" + if $DEBUG; + my @emails; + foreach ($self->contact_list_email_destinations) { + my $invoice = $_->invoice ? 'Yes' : 'No'; + my $data = [ + { + 'data' => $invoice, + }, + ]; + push @emails, $data; + } + return \@emails; +} + +=item contact_list_cust_message_only + +Returns an array of hashes containing cust_contact.message_dest. Does this email receive message notifications. Used for displaying email Message field in advanced customer reports. +[ { data => 'Yes', }, ] + +=cut + +sub contact_list_cust_message_only { + my $self = shift; + warn "$me contact_list_cust_message_only called" + if $DEBUG; + my @emails; + foreach ($self->contact_list_email_destinations) { + my $message = $_->message ? 'Yes' : 'No'; + my $data = [ + { + 'data' => $message, + }, + ]; + push @emails, $data; + } + return \@emails; +} + =item referral_custnum_cust_main Returns the customer who referred this customer (or the empty string, if @@ -3139,6 +3440,7 @@ sub charge { my $cust_pkg_ref = ''; my ( $bill_now, $invoice_terms ) = ( 0, '' ); my $locationnum; + my ( $discountnum, $discountnum_amount, $discountnum_percent ) = ( '','','' ); if ( ref( $_[0] ) ) { $amount = $_[0]->{amount}; $setup_cost = $_[0]->{setup_cost}; @@ -3159,6 +3461,9 @@ sub charge { $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : ''; $locationnum = $_[0]->{locationnum} || $self->ship_locationnum; $separate_bill = $_[0]->{separate_bill} || ''; + $discountnum = $_[0]->{setup_discountnum}; + $discountnum_amount = $_[0]->{setup_discountnum_amount}; + $discountnum_percent = $_[0]->{setup_discountnum_percent}; } else { # yuck $amount = shift; $setup_cost = ''; @@ -3222,13 +3527,16 @@ sub charge { } my $cust_pkg = new FS::cust_pkg ( { - 'custnum' => $self->custnum, - 'pkgpart' => $pkgpart, - 'quantity' => $quantity, - 'start_date' => $start_date, - 'no_auto' => $no_auto, - 'separate_bill' => $separate_bill, - 'locationnum'=> $locationnum, + 'custnum' => $self->custnum, + 'pkgpart' => $pkgpart, + 'quantity' => $quantity, + 'start_date' => $start_date, + 'no_auto' => $no_auto, + 'separate_bill' => $separate_bill, + 'locationnum' => $locationnum, + 'setup_discountnum' => $discountnum, + 'setup_discountnum_amount' => $discountnum_amount, + 'setup_discountnum_percent' => $discountnum_percent, } ); $error = $cust_pkg->insert; @@ -3281,6 +3589,36 @@ sub charge_postal_fee { $error ? $error : $cust_pkg; } +=item num_cust_attachment_deleted + +Returns the number of deleted attachments for this customer (see +L). + +=cut + +sub num_cust_attachments_deleted { + my $self = shift; + $self->scalar_sql( + " SELECT COUNT(*) FROM cust_attachment ". + " WHERE custnum = ? AND disabled IS NOT NULL AND disabled > 0", + $self->custnum + ); +} + +=item max_invnum + +Returns the most recent invnum (invoice number) for this customer. + +=cut + +sub max_invnum { + my $self = shift; + $self->scalar_sql( + " SELECT MAX(invnum) FROM cust_bill WHERE custnum = ?", + $self->custnum + ); +} + =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ] Returns all the invoices (see L) for this customer. @@ -3683,6 +4021,27 @@ sub name { $name; } +=item batch_payment_payname + +Returns a name string for this customer, either "cust_batch_payment->payname" or "First Last" or "Company, +based on if a company name exists and is the account being used a business account. + +=cut + +sub batch_payment_payname { + my $self = shift; + my $cust_pay_batch = shift; + my $name; + + if ($cust_pay_batch->{Hash}->{payby} eq "CARD") { $name = $cust_pay_batch->payname; } + else { $name = $self->first .' '. $self->last; } + + $name = $self->company + if (($cust_pay_batch->{Hash}->{paytype} eq "Business checking" || $cust_pay_batch->{Hash}->{paytype} eq "Business savings") && $self->company); + + $name; +} + =item service_contact Returns the L object for this customer that has the 'Service' @@ -4321,6 +4680,10 @@ CHEK only CHEK only +=item saved_cust_payby + +scalar reference, for returning saved object + =back =cut @@ -4430,6 +4793,8 @@ PAYBYLOOP: next if grep(/^$field$/, qw( custpaybynum payby weight ) ); next if grep(/^$field$/, @preserve ); next PAYBYLOOP unless $new->get($field) eq $cust_payby->get($field); + # check if paymask exists, if so stop and don't save, no need for a duplicate. + return '' if $new->get('paymask') eq $cust_payby->get('paymask'); } # now check fields that can replace if one value is blank my $replace = 0; @@ -4517,11 +4882,41 @@ PAYBYLOOP: return $error; } + ${$opt{'saved_cust_payby'}} = $new + if $opt{'saved_cust_payby'}; + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } +=item remove_cvv_from_cust_payby PAYINFO + +Removes paycvv from associated cust_payby with matching PAYINFO. + +=cut + +sub remove_cvv_from_cust_payby { + my ($self,$payinfo) = @_; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + 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 =head1 CLASS METHODS @@ -4659,15 +5054,10 @@ Returns an SQL expression identifying un-cancelled cust_main records. =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 @@ -5120,7 +5510,68 @@ sub process_bill_and_collect { $param->{'fatal'} = 1; # runs from job queue, will be caught $param->{'retry'} = 1; - $cust_main->bill_and_collect( %$param ); + local $@; + eval { $cust_main->bill_and_collect( %$param) }; + if ( $@ ) { + die $@ =~ /cancel_pkgs cannot be run inside a transaction/ + ? "Bill Now unavailable for customer with pending package expiration\n" + : $@; + } +} + +=item pending_invoice_count + +Return number of cust_bill with pending=Y for this customer + +=cut + +sub pending_invoice_count { + FS::cust_bill->count( 'custnum = '.shift->custnum."AND pending = 'Y'" ); +} + +=item cust_locations_missing_district + +Always returns empty list, unless tax_district_method eq 'wa_sales' + +Return cust_location rows for this customer, associated with active +customer packages, where tax district column is empty. Presense of +these rows should block billing, because invoice would be generated +with incorrect taxes + +=cut + +sub cust_locations_missing_district { + my ( $self ) = @_; + + my $tax_district_method = FS::Conf->new->config('tax_district_method'); + + return () + unless $tax_district_method + && $tax_district_method eq 'wa_sales'; + + qsearch({ + table => 'cust_location', + select => 'cust_location.*', + addl_from => ' + LEFT JOIN cust_main USING (custnum) + LEFT JOIN cust_pkg ON cust_location.locationnum = cust_pkg.locationnum + ', + extra_sql => sprintf(q{ + WHERE cust_location.state = 'WA' + AND cust_location.custnum = %s + AND ( + cust_location.district IS NULL + or cust_location.district = '' + ) + AND cust_pkg.pkgnum IS NOT NULL + AND ( + cust_pkg.cancel > %s + OR cust_pkg.cancel IS NULL + ) + }, + $self->custnum, time() + ), + }); } #starting to take quite a while for big dbs @@ -5184,6 +5635,116 @@ sub _upgrade_data { #class method $class->_upgrade_otaker(%opts); + # turn on encryption as part of regular upgrade, so all new records are immediately encrypted + # existing records will be encrypted in queueable_upgrade (below) + unless ($conf->exists('encryptionpublickey') || $conf->exists('encryptionprivatekey')) { + eval "use FS::Setup"; + die $@ if $@; + FS::Setup::enable_encryption(); + } + +} + +sub queueable_upgrade { + my $class = shift; + + ### encryption gets turned on in _upgrade_data, above + + eval "use FS::upgrade_journal"; + die $@ if $@; + + # prior to 2013 (commit f16665c9) payinfo was stored in history if not + # encrypted, clear that out before encrypting/tokenizing anything else + if (!FS::upgrade_journal->is_done('clear_payinfo_history')) { + foreach my $table (qw( + cust_payby cust_pay_pending cust_pay cust_pay_void cust_refund + )) { + my $sql = + 'UPDATE h_'.$table.' SET payinfo = NULL WHERE payinfo IS NOT NULL'; + my $sth = dbh->prepare($sql) or die dbh->errstr; + $sth->execute or die $sth->errstr; + } + FS::upgrade_journal->set_done('clear_payinfo_history'); + } + + # fix Tokenized paycardtype and encrypt old records + if ( ! FS::upgrade_journal->is_done('paycardtype_Tokenized') + || ! FS::upgrade_journal->is_done('encryption_check') + ) + { + + # allow replacement of closed cust_pay/cust_refund records + local $FS::payinfo_Mixin::allow_closed_replace = 1; + + # because it looks like nothing's changing + local $FS::Record::no_update_diff = 1; + + # commit everything immediately + local $FS::UID::AutoCommit = 1; + + # encrypt what's there + foreach my $table (qw( + cust_payby cust_pay_pending cust_pay cust_pay_void cust_refund + )) { + my $tclass = 'FS::'.$table; + my $lastrecnum = 0; + my @recnums = (); + while ( + my $recnum = _upgrade_next_recnum(dbh,$table,\$lastrecnum,\@recnums) + ) { + my $record = $tclass->by_key($recnum); + next unless $record; # small chance it's been deleted, that's ok + next unless grep { $record->payby eq $_ } @FS::Record::encrypt_payby; + # window for possible conflict is practically nonexistant, + # but just in case... + $record = $record->select_for_update; + if (!$record->custnum && $table eq 'cust_pay_pending') { + $record->set('custnum_pending',1); + } + $record->paycardtype('') if $record->paycardtype eq 'Tokenized'; + + local($ignore_expired_card) = 1; + local($ignore_banned_card) = 1; + local($skip_fuzzyfiles) = 1; + local($import) = 1;#prevent automatic geocoding (need its own variable?) + + my $error = $record->replace; + die "Error replacing $table ".$record->get($record->primary_key).": $error" if $error; + } + } + + FS::upgrade_journal->set_done('paycardtype_Tokenized'); + FS::upgrade_journal->set_done('encryption_check') if $conf->exists('encryption'); + } + + # now that everything's encrypted, tokenize... + FS::cust_main::Billing_Realtime::token_check(@_); +} + +# not entirely false laziness w/ Billing_Realtime::_token_check_next_recnum +# cust_payby might get deleted while this runs +# not a method! +sub _upgrade_next_recnum { + my ($dbh,$table,$lastrecnum,$recnums) = @_; + my $recnum = shift @$recnums; + return $recnum if $recnum; + my $tclass = 'FS::'.$table; + my $paycardtypecheck = ($table ne 'cust_pay_pending') ? q( OR paycardtype = 'Tokenized') : ''; + my $sql = 'SELECT '.$tclass->primary_key. + ' FROM '.$table. + ' WHERE '.$tclass->primary_key.' > '.$$lastrecnum. + " AND payby IN ( 'CARD', 'DCRD', 'CHEK', 'DCHK' ) ". + " AND ( length(payinfo) < 80$paycardtypecheck ) ". + ' ORDER BY '.$tclass->primary_key.' LIMIT 500'; + my $sth = $dbh->prepare($sql) or die $dbh->errstr; + $sth->execute() or die $sth->errstr; + my @recnums; + while (my $rec = $sth->fetchrow_hashref) { + push @$recnums, $rec->{$tclass->primary_key}; + } + $sth->finish(); + $$lastrecnum = $$recnums[-1]; + return shift @$recnums; } =back @@ -5216,4 +5777,3 @@ L, L, schema.html from the base documentation. =cut 1; -