X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=8e098488290cf1c40cdfd511d2c4d5f873550dd4;hb=5d089cbe4980f7c9c25b83e164099b22bc59eead;hp=dcf642b9830ca0b5ba697217fa8a6dbda213166f;hpb=17c42abd0c3c836c3ae511867f1cac2417b6907e;p=freeside.git diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index dcf642b98..8e0984882 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -28,11 +28,10 @@ use Date::Format; #use Date::Manip; use File::Temp; #qw( tempfile ); use Business::CreditCard 0.28; -use Locale::Country; use FS::UID qw( dbh driver_name ); use FS::Record qw( qsearchs qsearch dbdef regexp_sql ); use FS::Cursor; -use FS::Misc qw( generate_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; @@ -469,7 +468,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"; @@ -559,13 +559,42 @@ sub insert { $invoicing_list ||= $options{'invoicing_list'}; if ( $invoicing_list ) { - $invoicing_list = join(',', @$invoicing_list) if ref $invoicing_list; + $invoicing_list = [ $invoicing_list ] if !ref($invoicing_list); + + my $email = ''; + foreach my $dest (@$invoicing_list ) { + if ($dest eq 'POST') { + $self->set('postal_invoice', 'Y'); + } else { + + my $contact_email = qsearchs('contact_email', { emailaddress => $dest }); + if ( $contact_email ) { + my $cust_contact = FS::cust_contact->new({ + contactnum => $contact_email->contactnum, + custnum => $self->custnum, + }); + $cust_contact->set('invoice_dest', 'Y'); + my $error = $cust_contact->contactnum ? + $cust_contact->replace : $cust_contact->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "$error (linking to email address $dest)"; + } + + } else { + # this email address is not yet linked to any contact + $email .= ',' if length($email); + $email .= $dest; + } + } + } + my $contact = FS::contact->new({ 'custnum' => $self->get('custnum'), 'last' => $self->get('last'), 'first' => $self->get('first'), - 'emailaddress' => $invoicing_list, - 'invoice_dest' => 'Y', + 'emailaddress' => $email, + 'invoice_dest' => 'Y', # yes, you can set this via the contact }); my $error = $contact->insert; if ( $error ) { @@ -1326,6 +1355,14 @@ 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 @@ -1366,40 +1403,106 @@ sub replace { $invoicing_list ||= $options{invoicing_list}; + my @contacts = map { $_->contact } $self->cust_contact; + # find a contact that matches the customer's name + my ($implicit_contact) = grep { $_->first eq $old->get('first') + and $_->last eq $old->get('last') } + @contacts; + $implicit_contact ||= FS::contact->new({ + 'custnum' => $self->custnum, + 'locationnum' => $self->get('bill_locationnum'), + }); + + # for any of these that are already contact emails, link to the existing + # contact if ( $invoicing_list ) { my $email = ''; - foreach (@$invoicing_list) { - if ($_ eq 'POST') { + + # kind of like process_m2m on these, except: + # - the other side is two tables in a join + # - and we might have to create new contact_emails + # - and possibly a new contact + # + # Find existing invoice emails that aren't on the implicit contact. + # Any of these that are not on the new invoicing list will be removed. + my %old_email_cust_contact; + foreach my $cust_contact ($self->cust_contact) { + next if !$cust_contact->invoice_dest; + next if $cust_contact->contactnum == ($implicit_contact->contactnum || 0); + + foreach my $contact_email ($cust_contact->contact->contact_email) { + $old_email_cust_contact{ $contact_email->emailaddress } = $cust_contact; + } + } + + foreach my $dest (@$invoicing_list) { + + if ($dest eq 'POST') { + $self->set('postal_invoice', 'Y'); + + } elsif ( exists($old_email_cust_contact{$dest}) ) { + + delete $old_email_cust_contact{$dest}; # don't need to remove it, then + } else { - $email .= ',' if length($email); - $email .= $_; + + # See if it belongs to some other contact; if so, link it. + my $contact_email = qsearchs('contact_email', { emailaddress => $dest }); + if ( $contact_email + and $contact_email->contactnum != ($implicit_contact->contactnum || 0) ) { + my $cust_contact = qsearchs('cust_contact', { + contactnum => $contact_email->contactnum, + custnum => $self->custnum, + }) || FS::cust_contact->new({ + contactnum => $contact_email->contactnum, + custnum => $self->custnum, + }); + $cust_contact->set('invoice_dest', 'Y'); + my $error = $cust_contact->custcontactnum ? + $cust_contact->replace : $cust_contact->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "$error (linking to email address $dest)"; + } + + } else { + # This email address is not yet linked to any contact, so it will + # be added to the implicit contact. + $email .= ',' if length($email); + $email .= $dest; + } } } - my @contacts = map { $_->contact } $self->cust_contact; - # if possible, use a contact that matches the customer's name - my ($contact) = grep { $_->first eq $old->get('first') and - $_->last eq $old->get('last') } - @contacts; - $contact ||= FS::contact->new({ - 'custnum' => $self->custnum, - 'locationnum' => $self->get('bill_locationnum'), - }); - $contact->set('last', $self->get('last')); - $contact->set('first', $self->get('first')); - $contact->set('emailaddress', $email); - $contact->set('invoice_dest', 'Y'); + + foreach my $remove_dest (keys %old_email_cust_contact) { + my $cust_contact = $old_email_cust_contact{$remove_dest}; + # These were not in the list of requested destinations, so take them off. + $cust_contact->set('invoice_dest', ''); + my $error = $cust_contact->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "$error (unlinking email address $remove_dest)"; + } + } + + # make sure it keeps up with the changed customer name, if any + $implicit_contact->set('last', $self->get('last')); + $implicit_contact->set('first', $self->get('first')); + $implicit_contact->set('emailaddress', $email); + $implicit_contact->set('invoice_dest', 'Y'); + $implicit_contact->set('custnum', $self->custnum); my $error; - if ( $contact->contactnum ) { - $error = $contact->replace; - } elsif ( length($email) ) { # don't create a new contact if email is empty - $error = $contact->insert; + if ( $implicit_contact->contactnum ) { + $error = $implicit_contact->replace; + } elsif ( length($email) ) { # don't create a new contact if not needed + $error = $implicit_contact->insert; } if ( $error ) { $dbh->rollback if $oldAutoCommit; - return $error; + return "$error (adding email address $email)"; } } @@ -1998,6 +2101,25 @@ sub check { $self->SUPER::check; } +sub check_payinfo_cardtype { + my $self = shift; + + return '' unless $self->payby =~ /^(CARD|CHEK)$/; + + my $payinfo = $self->payinfo; + $payinfo =~ s/\D//g; + + return '' if $payinfo =~ /^99\d{14}$/; #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. @@ -2075,21 +2197,35 @@ 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({ @@ -2791,24 +2927,6 @@ 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 @@ -2988,7 +3106,7 @@ sub invoicing_list_emailonly { addl_from => ' JOIN contact USING (contactnum) '. ' JOIN contact_email USING (contactnum)', hashref => { 'custnum' => $self->custnum, }, - extra_sql => q( AND invoice_dest = 'Y'), + extra_sql => q( AND cust_contact.invoice_dest = 'Y'), }); } @@ -3869,26 +3987,14 @@ sub ship_contact_firstlast { $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); + $self->bill_location->country_full; } sub ship_country_full { my $self = shift; - code2country($self->ship_location->country); + $self->ship_location->country_full; } =item county_state_county [ PREFIX ] @@ -4324,6 +4430,286 @@ 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 + +=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') ) { + $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); + } + # 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; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + =back =head1 CLASS METHODS @@ -5164,6 +5550,20 @@ sub _upgrade_data { #class method } + # at the time we do this, also migrate paytype into cust_pay_batch + # so that batches that are open before the migration can still be + # processed + my @cust_pay_batch = qsearch('cust_pay_batch', { + 'custnum' => $cust_main->custnum, + 'payby' => 'CHEK', + 'paytype' => '', + }); + foreach my $cust_pay_batch (@cust_pay_batch) { + $cust_pay_batch->set('paytype', $cust_main->get('paytype')); + my $error = $cust_pay_batch->replace; + die "$error (setting cust_pay_batch.paytype)" if $error; + } + $cust_main->complimentary('Y') if $cust_main->payby eq 'COMP'; $cust_main->invoice_attn( $cust_main->payname )