X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=b8d8f102f94970adf646d1a4b7daa3306a1cc25d;hp=f6b6862afcab5526996e1ad642c165d0d8ef07be;hb=4747bfbea3f4abb66d05a2bd1abed69e28a4aa3d;hpb=571291dda91dd92db80660aa3d67333b0c88fc34 diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index f6b6862af..b8d8f102f 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -11,7 +11,7 @@ use base qw( FS::cust_main::Packages FS::cust_main::Credit_Limit FS::cust_main::Merge FS::cust_main::API - FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin + FS::otaker_Mixin FS::cust_main_Mixin FS::geocode_Mixin FS::Quotable_Mixin FS::Sales_Mixin FS::o2m_Common FS::Record @@ -20,18 +20,21 @@ 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 FS::UID qw( dbh driver_name ); use FS::Record qw( qsearchs qsearch dbdef regexp_sql ); use FS::Cursor; -use FS::Misc qw( generate_ps do_print money_pretty ); +use FS::Misc qw( generate_ps do_print money_pretty card_types ); use FS::Msgcat qw(gettext); use FS::CurrentUser; use FS::TicketSystem; @@ -75,6 +78,7 @@ use FS::upgrade_journal; use FS::sales; use FS::cust_payby; use FS::contact; +use FS::reason; # 1 is mostly method/subroutine entry and options # 2 traces progress of some operations @@ -97,12 +101,15 @@ our @encrypted_fields = ('payinfo', 'paycvv'); sub nohistory_fields { ('payinfo', 'paycvv'); } our $conf; +our $default_agent_custid; +our $custnum_display_length; #ask FS::UID to run this stuff for us later #$FS::UID::callback{'FS::cust_main'} = sub { install_callback FS::UID sub { $conf = new FS::Conf; - #yes, need it for stuff below (prolly should be cached) - $ignore_invalid_card = $conf->exists('allow_invalid_cards'); + $ignore_invalid_card = $conf->exists('allow_invalid_cards'); + $default_agent_custid = $conf->exists('cust_main-default_agent_custid'); + $custnum_display_length = $conf->config('cust_main-custnum-display_length'); }; sub _cache { @@ -370,6 +377,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'; @@ -468,7 +479,8 @@ sub insert { $self->auto_agent_custid() if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid; - my $error = $self->SUPER::insert; + my $error = $self->check_payinfo_cardtype + || $self->SUPER::insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; #return "inserting cust_main record (transaction rolled back): $error"; @@ -527,6 +539,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 @@ -549,7 +562,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" @@ -573,8 +589,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)"; @@ -588,17 +603,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; + } + } } @@ -1310,7 +1329,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 @@ -1324,6 +1343,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 { @@ -1354,11 +1376,23 @@ sub replace { || $old->payby =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ ) && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask ); + if ( $self->payby =~ /^(CARD|DCRD)$/ + && $old->payinfo ne $self->payinfo + && $old->paymask ne $self->paymask ) + { + my $error = $self->check_payinfo_cardtype; + return $error if $error; + } + return "Invoicing locale is required" if $old->locale && ! $self->locale && $conf->exists('cust_main-require_locale'); + 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'; @@ -1483,6 +1517,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 ) { @@ -1510,7 +1554,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; @@ -1753,13 +1797,14 @@ 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') || $self->ut_flag('message_noemail') || $self->ut_enum('locale', [ '', FS::Locales->locales ]) || $self->ut_currencyn('currency') - || $self->ut_alphan('po_number') + || $self->ut_textn('po_number') || $self->ut_enum('complimentary', [ '', 'Y' ]) || $self->ut_flag('invoice_ship_address') || $self->ut_flag('invoice_dest') @@ -1842,243 +1887,15 @@ sub check { } - ### 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(''); - } - - $error = $self->ut_numbern('paystart_month') - || $self->ut_numbern('paystart_year') - || $self->ut_numbern('payissue') - || $self->ut_textn('paytype') - ; - return $error if $error; - - if ( $self->payip eq '' ) { - $self->payip(''); - } else { - $error = $self->ut_ip('payip'); - return $error if $error; - } - - # If it is encrypted and the private key is not availaible then we can't - # check the credit card. - my $check_payinfo = ! $self->is_encrypted($self->payinfo); - - # 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; - $payinfo =~ /^(\d{13,16}|\d{8,9})$/ - or return gettext('invalid_card'); # . ": ". $self->payinfo; - $payinfo = $1; - $self->payinfo($payinfo); - validate($payinfo) - or return gettext('invalid_card'); # . ": ". $self->payinfo; - - return gettext('unknown_card_type') - if $self->payinfo !~ /^99\d{14}$/ #token - && cardtype($self->payinfo) eq "Unknown"; - - unless ( $ignore_banned_card ) { - my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } ); - if ( $ban ) { - if ( $ban->bantype eq 'warn' ) { - #or others depending on value of $ban->reason ? - return '_duplicate_card'. - ': disabled from'. time2str('%a %h %o at %r', $ban->_date). - ' until '. time2str('%a %h %o at %r', $ban->_end_date). - ' (ban# '. $ban->bannum. ')' - unless $self->override_ban_warn; - } else { - return 'Banned credit card: banned on '. - time2str('%a %h %o at %r', $ban->_date). - ' by '. $ban->otaker. - ' (ban# '. $ban->bannum. ')'; - } - } - } - - if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) { - if ( cardtype($self->payinfo) eq 'American Express card' ) { - $self->paycvv =~ /^(\d{4})$/ - or return "CVV2 (CID) for American Express cards is four digits."; - $self->paycvv($1); - } else { - $self->paycvv =~ /^(\d{3})$/ - or return "CVV2 (CVC2/CID) is three digits."; - $self->paycvv($1); - } - } else { - $self->paycvv(''); - } - - my $cardtype = cardtype($payinfo); - if ( $cardtype =~ /^(Switch|Solo)$/i ) { - - return "Start date or issue number is required for $cardtype cards" - unless $self->paystart_month && $self->paystart_year or $self->payissue; - - return "Start month must be between 1 and 12" - if $self->paystart_month - and $self->paystart_month < 1 || $self->paystart_month > 12; - - return "Start year must be 1990 or later" - if $self->paystart_year - and $self->paystart_year < 1990; - - return "Issue number must be beween 1 and 99" - if $self->payissue - and $self->payissue < 1 || $self->payissue > 99; - - } else { - $self->paystart_month(''); - $self->paystart_year(''); - $self->payissue(''); - } - - } elsif ( !$ignore_invalid_card && $check_payinfo && - $self->payby =~ /^(CHEK|DCHK)$/ ) { - - my $payinfo = $self->payinfo; - $payinfo =~ s/[^\d\@\.]//g; - if ( $conf->config('echeck-country') eq 'CA' ) { - $payinfo =~ /^(\d+)\@(\d{5})\.(\d{3})$/ - or return 'invalid echeck account@branch.bank'; - $payinfo = "$1\@$2.$3"; - } elsif ( $conf->config('echeck-country') eq 'US' ) { - $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba'; - $payinfo = "$1\@$2"; - } else { - $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@routing'; - $payinfo = "$1\@$2"; - } - $self->payinfo($payinfo); - $self->paycvv(''); - - unless ( $ignore_banned_card ) { - my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } ); - if ( $ban ) { - if ( $ban->bantype eq 'warn' ) { - #or others depending on value of $ban->reason ? - return '_duplicate_ach' unless $self->override_ban_warn; - } else { - return 'Banned ACH account: banned on '. - time2str('%a %h %o at %r', $ban->_date). - ' by '. $ban->otaker. - ' (ban# '. $ban->bannum. ')'; - } - } - } - - } elsif ( $self->payby eq 'LECB' ) { - - my $payinfo = $self->payinfo; - $payinfo =~ s/\D//g; - $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number'; - $payinfo = $1; - $self->payinfo($payinfo); - $self->paycvv(''); - - } elsif ( $self->payby eq 'BILL' ) { - - $error = $self->ut_textn('payinfo'); - return "Illegal P.O. number: ". $self->payinfo if $error; - $self->paycvv(''); - - } elsif ( $self->payby eq 'COMP' ) { - - my $curuser = $FS::CurrentUser::CurrentUser; - if ( ! $self->custnum - && ! $curuser->access_right('Complimentary customer') - ) - { - return "You are not permitted to create complimentary accounts." - } - - $error = $self->ut_textn('payinfo'); - return "Illegal comp account issuer: ". $self->payinfo if $error; - $self->paycvv(''); - - } elsif ( $self->payby eq 'PREPAY' ) { - - my $payinfo = $self->payinfo; - $payinfo =~ s/\W//g; #anything else would just confuse things - $self->payinfo($payinfo); - $error = $self->ut_alpha('payinfo'); - return "Illegal prepayment identifier: ". $self->payinfo if $error; - return "Unknown prepayment identifier" - unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } ); - $self->paycvv(''); - - } - - return "You are not permitted to create complimentary accounts." - if ! $self->custnum - && $self->complimentary eq 'Y' - && ! $FS::CurrentUser::CurrentUser->access_right('Complimentary customer'); - - if ( $self->paydate eq '' || $self->paydate eq '-' ) { - return "Expiration date required" - # shouldn't payinfo_check do this? - unless ! $self->payby - || $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD|PPAL)$/; - $self->paydate(''); - } else { - my( $m, $y ); - if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) { - ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" ); - } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) { - ( $m, $y ) = ( $2, "19$1" ); - } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) { - ( $m, $y ) = ( $3, "20$2" ); - } else { - return "Illegal expiration date: ". $self->paydate; - } - $m = sprintf('%02d',$m); - $self->paydate("$y-$m-01"); - my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900; - return gettext('expired_card') - if !$import - && !$ignore_expired_card - && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) ); - } - - if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ && - ( ! $conf->exists('require_cardname') - || $self->payby !~ /^(CARD|DCRD)$/ ) - ) { - $self->payname( $self->first. " ". $self->getfield('last') ); - } else { - - 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'); + 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); @@ -2092,6 +1909,25 @@ sub check { $self->SUPER::check; } +sub check_payinfo_cardtype { + my $self = shift; + + return '' unless $self->payby =~ /^(CARD|DCRD)$/; + + my $payinfo = $self->payinfo; + $payinfo =~ s/\D//g; + + return '' if $self->tokenized($payinfo); #token + + my %bop_card_types = map { $_=>1 } values %{ card_types() }; + my $cardtype = cardtype($payinfo); + + return "$cardtype not accepted" unless $bop_card_types{$cardtype}; + + ''; + +} + =item replace_check Additional checks for replace only. @@ -2154,8 +1990,13 @@ Returns all locations (see L) for this customer. sub cust_location { my $self = shift; - qsearch('cust_location', { 'custnum' => $self->custnum, - 'prospectnum' => '' } ); + qsearch({ + 'table' => 'cust_location', + 'hashref' => { 'custnum' => $self->custnum, + 'prospectnum' => '', + }, + 'order_by' => 'ORDER BY country, LOWER(state), LOWER(city), LOWER(county), LOWER(address1), LOWER(address2)', + }); } =item cust_contact @@ -2169,21 +2010,37 @@ sub cust_contact { qsearch('cust_contact', { 'custnum' => $self->custnum } ); } -=item cust_payby +=item cust_payby PAYBY Returns all payment methods (see L) for this customer. +If one or more PAYBY are specified, returns only payment methods for specified PAYBY. +Does not validate PAYBY. + =cut sub cust_payby { my $self = shift; - qsearch({ + my @payby = @_; + my $search = { 'table' => 'cust_payby', 'hashref' => { 'custnum' => $self->custnum }, 'order_by' => "ORDER BY payby IN ('CARD','CHEK') DESC, weight ASC", - }); + }; + $search->{'extra_sql'} = ' AND payby IN ( '. + join(',', map dbh->quote($_), @payby). + ' ) ' + if @payby; + + qsearch($search); } +=item has_cust_payby_auto + +Returns true if customer has an automatic payment method ('CARD' or 'CHEK') + +=cut + sub has_cust_payby_auto { my $self = shift; scalar( qsearch({ @@ -2302,33 +2159,63 @@ 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 + die "cancel_pkgs cannot be run inside a transaction" + if $FS::UID::AutoCommit == 0; + + local $FS::UID::AutoCommit = 0; return ( 'access denied' ) unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer'); @@ -2345,29 +2232,106 @@ sub cancel { my $ban = new FS::banned_pay $cust_payby->_new_banned_pay_hashref; my $error = $ban->insert; - return ( $error ) if $error; + if ($error) { + dbh->rollback; + return ( $error ); + } } } - my @pkgs = $self->ncancelled_pkgs; + my @pkgs = @{ delete $opt{'cust_pkg'} }; + my $cancel_time = $opt{'time'} || time; + # bill all packages first, so we don't lose usage, service counts for + # bulk billing, etc. if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) { $opt{nobill} = 1; - my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 ); - warn "Error billing during cancel, custnum ". $self->custnum. ": $error" - if $error; + my $error = $self->bill( 'pkg_list' => [ @pkgs ], + 'cancel' => 1, + 'time' => $cancel_time ); + if ($error) { + warn "Error billing during cancel, custnum ". $self->custnum. ": $error"; + dbh->rollback; + return ( "Error billing during cancellation: $error" ); + } + } + dbh->commit; + + my @errors; + # try to cancel each service, the same way we would for individual packages, + # but in cancel weight order. + my @cust_svc = map { $_->cust_svc } @pkgs; + my @sorted_cust_svc = + map { $_->[0] } + sort { $a->[1] <=> $b->[1] } + map { [ $_, $_->svc_x ? $_->svc_x->table_info->{'cancel_weight'} : -1 ]; } @cust_svc + ; + warn "$me removing ".scalar(@sorted_cust_svc)." service(s) for customer ". + $self->custnum."\n" + if $DEBUG; + foreach my $cust_svc (@sorted_cust_svc) { + my $part_svc = $cust_svc->part_svc; + next if ( defined($part_svc) and $part_svc->preserve ); + # immediate cancel, no date option + # transactionize individually + my $error = try { $cust_svc->cancel } catch { $_ }; + if ( $error ) { + dbh->rollback; + push @errors, $error; + } else { + dbh->commit; + } + } + if (@errors) { + return @errors; } - warn "$me cancelling ". scalar($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; + foreach (@pkgs) { + my %lopt = %opt; + if (@cprs) { + my $cpr = shift @cprs; + if ( $cpr ) { + $lopt{'reason'} = $cpr->reasonnum; + $lopt{'reason_otaker'} = $cpr->otaker; + } else { + warn "no reason found when canceling package ".$_->pkgnum."\n"; + # we're not actually required to pass a reason to cust_pkg::cancel, + # but if we're getting to this point, something has gone awry. + $null_reason ||= FS::reason->new_or_existing( + reason => 'unknown reason', + type => 'Cancel Reason', + class => 'C', + ); + $lopt{'reason'} = $null_reason->reasonnum; + $lopt{'reason_otaker'} = $FS::CurrentUser::CurrentUser->username; + } + } + my $error = $_->cancel(%lopt); + if ( $error ) { + dbh->rollback; + push @errors, 'pkgnum '.$_->pkgnum.': '.$error; + } else { + dbh->commit; + } + } + + return @errors; } sub _banned_pay_hashref { + die 'cust_main->_banned_pay_hashref deprecated'; + my $self = shift; my %payby2ban = ( @@ -2515,9 +2479,12 @@ 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 { + die 'cust_main->remove_cvv deprecated'; my $self = shift; my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?") or return dbh->errstr; @@ -2844,6 +2811,7 @@ For electronic check transactions: =cut +#XXX i need to be updated for 4.x+ sub payment_info { my $self = shift; @@ -2885,82 +2853,36 @@ sub payment_info { } -=item paydate_monthyear - -Returns a two-element list consisting of the month and year of this customer's -paydate (credit card expiration date for CARD customers) - -=cut - -sub paydate_monthyear { - my $self = shift; - if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format - ( $2, $1 ); - } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) { - ( $1, $3 ); - } else { - ('', ''); - } -} - =item paydate_epoch -Returns the exact time in seconds corresponding to the payment method -expiration date. For CARD/DCRD customers this is the end of the month; -for others (COMP is the only other payby that uses paydate) it's the start. -Returns 0 if the paydate is empty or set to the far future. +Returns the next payment expiration date for this customer. If they have no +payment methods that will expire, returns 0. =cut sub paydate_epoch { my $self = shift; - my ($month, $year) = $self->paydate_monthyear; - return 0 if !$year or $year >= 2037; - if ( $self->payby eq 'CARD' or $self->payby eq 'DCRD' ) { - $month++; - if ( $month == 13 ) { - $month = 1; - $year++; - } - return timelocal(0,0,0,1,$month-1,$year) - 1; - } - else { - return timelocal(0,0,0,1,$month-1,$year); - } + # filter out the ones that individually return 0, but then return 0 if + # there are no results + my @epochs = grep { $_ > 0 } map { $_->paydate_epoch } $self->cust_payby; + min( @epochs ) || 0; } =item paydate_epoch_sql -Class method. Returns an SQL expression to obtain the payment expiration date -as a number of seconds. +Returns an SQL expression to get the next payment expiration date for a +customer. Returns 2143260000 (2037-12-01) if there are no payment expiration +dates, so that it's safe to test for "will it expire before date X" for any +date up to then. =cut -# Special expiration date behavior for non-CARD/DCRD customers has been -# carefully preserved. Do we really use that? sub paydate_epoch_sql { my $class = shift; - my $table = shift || 'cust_main'; - my ($case1, $case2); - if ( driver_name eq 'Pg' ) { - $case1 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) + INTERVAL '1 month') - 1"; - $case2 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) )"; - } - elsif ( lc(driver_name) eq 'mysql' ) { - $case1 = "UNIX_TIMESTAMP( DATE_ADD( CAST( $table.paydate AS DATETIME ), INTERVAL 1 month ) ) - 1"; - $case2 = "UNIX_TIMESTAMP( CAST( $table.paydate AS DATETIME ) )"; - } - else { return '' } - return "CASE WHEN $table.payby IN('CARD','DCRD') - THEN ($case1) - ELSE ($case2) - END" + my $paydate = FS::cust_payby->paydate_epoch_sql; + "(SELECT COALESCE(MIN($paydate), 2143260000) FROM cust_payby WHERE cust_payby.custnum = cust_main.custnum)"; } -=item tax_exemption TAXNAME - -=cut - sub tax_exemption { my( $self, $taxname ) = @_; @@ -3100,6 +3022,127 @@ sub invoicing_list_emailonly_scalar { join(', ', $self->invoicing_list_emailonly); } +=item contact_list [ CLASSNUM, DEST_FLAG... ] + +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 invoice_message flags are +not set to 'Y' will be excluded. + +=cut + +sub contact_list { + my $self = shift; + my $search = { + table => 'contact', + 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, + }; + + # 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; + 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 { + croak "bad classnum argument '$_'"; + } + } + + 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} .= join ' OR ', map {" ($_) "} @or_classnum; + $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); +} + +=item contact_list_email [ CLASSNUM, ... ] + +Same as L, but returns email destinations instead of contact +objects. + +=cut + +sub contact_list_email { + my $self = shift; + my @contacts = $self->contact_list(@_); + my @emails; + foreach my $contact (@contacts) { + foreach my $contact_email ($contact->contact_email) { + push @emails, Email::Address->new( $contact->firstlast, + $contact_email->emailaddress + )->format; + } + } + @emails; +} + =item referral_custnum_cust_main Returns the customer who referred this customer (or the empty string, if @@ -3295,6 +3338,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}; @@ -3315,6 +3359,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 = ''; @@ -3378,13 +3425,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; @@ -3437,6 +3487,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. @@ -3595,9 +3675,12 @@ Returns all the credits (see L) for this customer. sub cust_credit { my $self = shift; - map { $_ } #return $self->num_cust_credit unless wantarray; - sort { $a->_date <=> $b->_date } - qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) + + #return $self->num_cust_credit unless wantarray; + + map { $_ } #behavior of sort undefined in scalar context + sort { $a->_date <=> $b->_date } + qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) } =item cust_credit_pkgnum @@ -3807,34 +3890,16 @@ cust_main-default_agent_custid is set and it has a value, custnum otherwise. sub display_custnum { my $self = shift; + return $self->agent_custid + if $default_agent_custid && $self->agent_custid; + 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 ( $prefix ) { - $length = 8 if !defined($length); + if ( $prefix ) { return $prefix . - sprintf('%0'.$length.'d', $self->custnum) - } elsif ( $length ) { - return sprintf('%0'.$length.'d', $self->custnum); + sprintf('%0'.($custnum_display_length||8).'d', $self->custnum) + } elsif ( $custnum_display_length ) { + return sprintf('%0'.$custnum_display_length.'d', $self->custnum); } else { return $self->custnum; } @@ -4041,13 +4106,17 @@ sub status { shift->cust_status(@_); } sub cust_status { my $self = shift; + return $self->hashref->{cust_status} if $self->hashref->{cust_status}; for my $status ( FS::cust_main->statuses() ) { my $method = $status.'_sql'; my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g; my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr; $sth->execute( ($self->custnum) x $numnum ) or die "Error executing 'SELECT $sql': ". $sth->errstr; - return $status if $sth->fetchrow_arrayref->[0]; + if ( $sth->fetchrow_arrayref->[0] ) { + $self->hashref->{cust_status} = $status; + return $status; + } } } @@ -4406,6 +4475,325 @@ sub payment_history { return @out; } +=item save_cust_payby + +Saves a new cust_payby for this customer, replacing an existing entry only +in select circumstances. Does not validate input. + +If auto is specified, marks this as the customer's primary method, or the +specified weight. Existing payment methods have their weight incremented as +appropriate. + +If bill_location is specified with auto, also sets location in cust_main. + +Will not insert complete duplicates of existing records, or records in which the +only difference from an existing record is to turn off automatic payment (will +return without error.) Will replace existing records in which the only difference +is to add a value to a previously empty preserved field and/or turn on automatic payment. +Fields marked as preserved are optional, and existing values will not be overwritten with +blanks when replacing. + +Accepts the following named parameters: + +=over 4 + +=item payment_payby + +either CARD or CHEK + +=item auto + +save as an automatic payment type (CARD/CHEK if true, DCRD/DCHK if false) + +=item weight + +optional, set higher than 1 for secondary, etc. + +=item payinfo + +required + +=item paymask + +optional, but should be specified for anything that might be tokenized, will be preserved when replacing + +=item payname + +required + +=item payip + +optional, will be preserved when replacing + +=item paydate + +CARD only, required + +=item bill_location + +CARD only, required, FS::cust_location object + +=item paystart_month + +CARD only, optional, will be preserved when replacing + +=item paystart_year + +CARD only, optional, will be preserved when replacing + +=item payissue + +CARD only, optional, will be preserved when replacing + +=item paycvv + +CARD only, only used if conf cvv-save is set appropriately + +=item paytype + +CHEK only + +=item paystate + +CHEK only + +=item saved_cust_payby + +scalar reference, for returning saved object + +=back + +=cut + +#The code for this option is in place, but it's not currently used +# +# =item replace +# +# existing cust_payby object to be replaced (must match custnum) + +# stateid/stateid_state/ss are not currently supported in cust_payby, +# might not even work properly in 4.x, but will need to work here if ever added + +sub save_cust_payby { + my $self = shift; + my %opt = @_; + + my $old = $opt{'replace'}; + my $new = new FS::cust_payby { $old ? $old->hash : () }; + return "Customer number does not match" if $new->custnum and $new->custnum != $self->custnum; + $new->set( 'custnum' => $self->custnum ); + + my $payby = $opt{'payment_payby'}; + return "Bad payby" unless grep(/^$payby$/,('CARD','CHEK')); + + # don't allow turning off auto when replacing + $opt{'auto'} ||= 1 if $old and $old->payby !~ /^D/; + + my @check_existing; # payby relevant to this payment_payby + + # set payby based on auto + if ( $payby eq 'CARD' ) { + $new->set( 'payby' => ( $opt{'auto'} ? 'CARD' : 'DCRD' ) ); + @check_existing = qw( CARD DCRD ); + } elsif ( $payby eq 'CHEK' ) { + $new->set( 'payby' => ( $opt{'auto'} ? 'CHEK' : 'DCHK' ) ); + @check_existing = qw( CHEK DCHK ); + } + + $new->set( 'weight' => $opt{'auto'} ? $opt{'weight'} : '' ); + + # basic fields + $new->payinfo($opt{'payinfo'}); # sets default paymask, but not if it's already tokenized + $new->paymask($opt{'paymask'}) if $opt{'paymask'}; # in case it's been tokenized, override with loaded paymask + $new->set( 'payname' => $opt{'payname'} ); + $new->set( 'payip' => $opt{'payip'} ); # will be preserved below + + my $conf = new FS::Conf; + + # compare to FS::cust_main::realtime_bop - check both to make sure working correctly + if ( $payby eq 'CARD' && + ( (grep { $_ eq cardtype($opt{'payinfo'}) } $conf->config('cvv-save')) + || $conf->exists('business-onlinepayment-verification') + ) + ) { + $new->set( 'paycvv' => $opt{'paycvv'} ); + } else { + $new->set( 'paycvv' => ''); + } + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + # set fields specific to payment_payby + if ( $payby eq 'CARD' ) { + if ($opt{'bill_location'}) { + $opt{'bill_location'}->set('custnum' => $self->custnum); + my $error = $opt{'bill_location'}->find_or_insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + $new->set( 'locationnum' => $opt{'bill_location'}->locationnum ); + } + foreach my $field ( qw( paydate paystart_month paystart_year payissue ) ) { + $new->set( $field => $opt{$field} ); + } + } else { + foreach my $field ( qw(paytype paystate) ) { + $new->set( $field => $opt{$field} ); + } + } + + # other cust_payby to compare this to + my @existing = $self->cust_payby(@check_existing); + + # fields that can overwrite blanks with values, but not values with blanks + my @preserve = qw( paymask locationnum paystart_month paystart_year payissue payip ); + + my $skip_cust_payby = 0; # true if we don't need to save or reweight cust_payby + unless ($old) { + # generally, we don't want to overwrite existing cust_payby with this, + # but we can replace if we're only marking it auto or adding a preserved field + # and we can avoid saving a total duplicate or merely turning off auto +PAYBYLOOP: + foreach my $cust_payby (@existing) { + # check fields that absolutely should not change + foreach my $field ($new->fields) { + next if grep(/^$field$/, qw( custpaybynum payby weight ) ); + next if grep(/^$field$/, @preserve ); + next PAYBYLOOP unless $new->get($field) eq $cust_payby->get($field); + # 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; + foreach my $field (@preserve) { + if ( + ( $new->get($field) and !$cust_payby->get($field) ) or + ( $cust_payby->get($field) and !$new->get($field) ) + ) { + # prevention of overwriting values with blanks happens farther below + $replace = 1; + } elsif ( $new->get($field) ne $cust_payby->get($field) ) { + next PAYBYLOOP; + } + } + unless ( $replace ) { + # nearly identical, now check weight + if ($new->get('weight') eq $cust_payby->get('weight') or !$new->get('weight')) { + # ignore identical cust_payby, and ignore attempts to turn off auto + # no need to save or re-weight cust_payby (but still need to update/commit $self) + $skip_cust_payby = 1; + last PAYBYLOOP; + } + # otherwise, only change is to mark this as primary + } + # if we got this far, we're definitely replacing + $old = $cust_payby; + last PAYBYLOOP; + } #PAYBYLOOP + } + + if ($old) { + $new->set( 'custpaybynum' => $old->custpaybynum ); + # don't turn off automatic payment (but allow it to be turned on) + if ($new->payby =~ /^D/ and $new->payby ne $old->payby) { + $opt{'auto'} = 1; + $new->set( 'payby' => $old->payby ); + $new->set( 'weight' => 1 ); + } + # make sure we're not overwriting values with blanks + foreach my $field (@preserve) { + if ( $old->get($field) and !$new->get($field) ) { + $new->set( $field => $old->get($field) ); + } + } + } + + # only overwrite cust_main bill_location if auto + if ($opt{'auto'} && $opt{'bill_location'}) { + $self->set('bill_location' => $opt{'bill_location'}); + my $error = $self->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + # done with everything except reweighting and saving cust_payby + # still need to commit changes to cust_main and cust_location + if ($skip_cust_payby) { + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + return ''; + } + + # re-weight existing primary cust_pay for this payby + if ($opt{'auto'}) { + foreach my $cust_payby (@existing) { + # relies on cust_payby return order + last unless $cust_payby->payby !~ /^D/; + last if $cust_payby->weight > 1; + next if $new->custpaybynum eq $cust_payby->custpaybynum; + next if $cust_payby->weight < ($opt{'weight'} || 1); + $cust_payby->weight( $cust_payby->weight + 1 ); + my $error = $cust_payby->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error reweighting cust_payby: $error"; + } + } + } + + # finally, save cust_payby + my $error = $old ? $new->replace($old) : $new->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + 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 @@ -4543,15 +4931,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 @@ -4711,103 +5094,6 @@ sub search { =over 4 -#=item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS - -#Deprecated. Use event notification and message templates -#(L) instead. - -#Sends a templated email notification to the customer (see L). - -#OPTIONS is a hash and may include - -#I - the email sender (default is invoice_from) - -#I - comma-separated scalar or arrayref of recipients -# (default is invoicing_list) - -#I - The subject line of the sent email notification -# (default is "Notice from company_name") - -#I - a hashref of name/value pairs which will be substituted -# into the template - -#The following variables are vavailable in the template. - -#I<$first> - the customer first name -#I<$last> - the customer last name -#I<$company> - the customer company -#I<$payby> - a description of the method of payment for the customer -# # would be nice to use FS::payby::shortname -#I<$payinfo> - the account information used to collect for this customer -#I<$expdate> - the expiration of the customer payment in seconds from epoch - -#=cut - -#sub notify { -# my ($self, $template, %options) = @_; - -# return unless $conf->exists($template); - -# my $from = $conf->invoice_from_full($self->agentnum) -# if $conf->exists('invoice_from', $self->agentnum); -# $from = $options{from} if exists($options{from}); - -# my $to = join(',', $self->invoicing_list_emailonly); -# $to = $options{to} if exists($options{to}); -# -# my $subject = "Notice from " . $conf->config('company_name', $self->agentnum) -# if $conf->exists('company_name', $self->agentnum); -# $subject = $options{subject} if exists($options{subject}); - -# my $notify_template = new Text::Template (TYPE => 'ARRAY', -# SOURCE => [ map "$_\n", -# $conf->config($template)] -# ) -# or die "can't create new Text::Template object: Text::Template::ERROR"; -# $notify_template->compile() -# or die "can't compile template: Text::Template::ERROR"; - -# $FS::notify_template::_template::company_name = -# $conf->config('company_name', $self->agentnum); -# $FS::notify_template::_template::company_address = -# join("\n", $conf->config('company_address', $self->agentnum) ). "\n"; - -# my $paydate = $self->paydate || '2037-12-31'; -# $FS::notify_template::_template::first = $self->first; -# $FS::notify_template::_template::last = $self->last; -# $FS::notify_template::_template::company = $self->company; -# $FS::notify_template::_template::payinfo = $self->mask_payinfo; -# my $payby = $self->payby; -# my ($payyear,$paymonth,$payday) = split (/-/,$paydate); -# my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear); - -# #credit cards expire at the end of the month/year of their exp date -# if ($payby eq 'CARD' || $payby eq 'DCRD') { -# $FS::notify_template::_template::payby = 'credit card'; -# ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++); -# $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear); -# $expire_time--; -# }elsif ($payby eq 'COMP') { -# $FS::notify_template::_template::payby = 'complimentary account'; -# }else{ -# $FS::notify_template::_template::payby = 'current method'; -# } -# $FS::notify_template::_template::expdate = $expire_time; - -# for (keys %{$options{extra_fields}}){ -# no strict "refs"; -# ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_}; -# } - -# send_email(from => $from, -# to => $to, -# subject => $subject, -# body => $notify_template->fill_in( PACKAGE => -# 'FS::notify_template::_template' ), -# ); - -#} - =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS Generates a templated notification to the customer (see L). @@ -4823,10 +5109,6 @@ I - if present, ignores TEMPLATE_NAME and uses the provided text The following variables are available in the template instead of or in addition to the fields of the customer record. -I<$payby> - a description of the method of payment for the customer - # would be nice to use FS::payby::shortname -I<$payinfo> - the masked account information used to collect for this customer -I<$expdate> - the expiration of the customer payment method in seconds from epoch I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address =cut @@ -4853,27 +5135,6 @@ sub generate_letter { or die "can't compile template: Text::Template::ERROR"; my %letter_data = map { $_ => $self->$_ } $self->fields; - $letter_data{payinfo} = $self->mask_payinfo; - - #my $paydate = $self->paydate || '2037-12-31'; - my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31'; - - my $payby = $self->payby; - my ($payyear,$paymonth,$payday) = split (/-/,$paydate); - my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear); - - #credit cards expire at the end of the month/year of their exp date - if ($payby eq 'CARD' || $payby eq 'DCRD') { - $letter_data{payby} = 'credit card'; - ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++); - $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear); - $expire_time--; - }elsif ($payby eq 'COMP') { - $letter_data{payby} = 'complimentary account'; - }else{ - $letter_data{payby} = 'current method'; - } - $letter_data{expdate} = $expire_time; for (keys %{$options{extra_fields}}){ $letter_data{$_} = $options{extra_fields}->{$_}; @@ -5145,9 +5406,7 @@ sub process_bill_and_collect { sub _upgrade_data { #class method my ($class, %opts) = @_; - my @statements = ( - 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL', - ); + my @statements = (); #this seems to be the only expensive one.. why does it take so long? unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) { @@ -5156,29 +5415,6 @@ sub _upgrade_data { #class method FS::upgrade_journal->set_done('cust_main__signupdate'); } - 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'); - } - - 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; @@ -5213,59 +5449,118 @@ sub _upgrade_data { #class method } - 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; + $class->_upgrade_otaker(%opts); - my @payfields = qw( payby payinfo paycvv paymask - paydate paystart_month paystart_year payissue - payname paystate paytype payip - ); + # 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(); + } - my $search = new FS::Cursor { - 'table' => 'cust_main', - 'extra_sql' => " WHERE ( payby IS NOT NULL AND payby != '' ) ", - }; +} - while (my $cust_main = $search->fetch) { +sub queueable_upgrade { + my $class = shift; - unless ( $cust_main->payby =~ /^(BILL|COMP)$/ ) { + ### 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'); + } - my $cust_payby = new FS::cust_payby { - 'custnum' => $cust_main->custnum, - 'weight' => 1, - map { $_ => $cust_main->$_(); } @payfields - }; + # fix Tokenized paycardtype and encrypt old records + if ( ! FS::upgrade_journal->is_done('paycardtype_Tokenized') + || ! FS::upgrade_journal->is_done('encryption_check') + ) + { - my $error = $cust_payby->insert; - die $error if $error; + # 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; - $cust_main->complimentary('Y') if $cust_main->payby eq 'COMP'; + # commit everything immediately + local $FS::UID::AutoCommit = 1; - $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; + # 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'; - $cust_main->setfield($_, '') foreach @payfields; - my $error = $cust_main->replace; - die "Error upgradging payment information for custnum ". - $cust_main->custnum. ": $error" - if $error; + 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('cust_main__cust_payby'); + FS::upgrade_journal->set_done('paycardtype_Tokenized'); + FS::upgrade_journal->set_done('encryption_check') if $conf->exists('encryption'); } - $class->_upgrade_otaker(%opts); - + # 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 @@ -5285,13 +5580,8 @@ card types. No multiple currency support (probably a larger project than just this module). -payinfo_masked false laziness with cust_pay.pm and cust_refund.pm - Birthdates rely on negative epoch values. -The payby for card/check batches is broken. With mixed batching, bad -things will happen. - B I should be renamed I