X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=7e1a25d2379bbeaa49785e5d64efe63ec3b103c1;hb=4321924ff5a68868a7ee622920fd4bbd53d6475f;hp=cfcd5f43f74139bdb7339f8ac0a1d37c7eb05343;hpb=a003b8c5b495cdcd0d79440a5613bcbcca17035e;p=freeside.git diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index cfcd5f43f..7e1a25d23 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -75,6 +75,7 @@ use FS::cust_attachment; use FS::contact; use FS::Locales; use FS::upgrade_journal; +use FS::reason; # 1 is mostly method/subroutine entry and options # 2 traces progress of some operations @@ -238,6 +239,10 @@ Name on card or billing name IP address from which payment information was received +=item paycardtype + +The credit card type (deduced from the card number). + =item tax Tax exempt, empty or `Y' @@ -542,6 +547,16 @@ sub insert { } + # validate card (needs custnum already set) + if ( $self->payby =~ /^(CARD|DCRD)$/ + && $conf->exists('business-onlinepayment-verification') ) { + $error = $self->realtime_verify_bop({ 'method'=>'CC' }); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + warn " setting contacts\n" if $DEBUG > 1; @@ -1538,6 +1553,25 @@ sub replace { { my $error = $self->check_payinfo_cardtype; return $error if $error; + + if ( $conf->exists('business-onlinepayment-verification') ) { + #need to standardize paydate for this, false laziness with check + 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"); + + $error = $self->realtime_verify_bop({ 'method'=>'CC' }); + return $error if $error; + } } return "Invoicing locale is required" @@ -1819,6 +1853,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') @@ -1932,9 +1967,12 @@ sub check { 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"; + my $cardtype = cardtype($payinfo); + $cardtype = 'Tokenized' if $self->payinfo =~ /^99\d{14}$/; # token + + return gettext('unknown_card_type') if $cardtype eq 'Unknown'; + + $self->set('paycardtype', $cardtype); unless ( $ignore_banned_card ) { my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } ); @@ -1956,7 +1994,7 @@ sub check { } if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) { - if ( cardtype($self->payinfo) eq 'American Express card' ) { + if ( $cardtype eq 'American Express card' ) { $self->paycvv =~ /^(\d{4})$/ or return "CVV2 (CID) for American Express cards is four digits."; $self->paycvv($1); @@ -1969,7 +2007,6 @@ sub check { $self->paycvv(''); } - my $cardtype = cardtype($payinfo); if ( $cardtype =~ /^(Switch|Solo)$/i ) { return "Start date or issue number is required for $cardtype cards" @@ -2066,6 +2103,11 @@ sub check { unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } ); $self->paycvv(''); + } elsif ( $self->payby =~ /^CARD|DCRD$/ and $self->paymask ) { + # either ignoring invalid cards, or we can't decrypt the payinfo, but + # try to detect the card type anyway. this never returns failure, so + # the contract of $ignore_invalid_cards is maintained. + $self->set('paycardtype', cardtype($self->paymask)); } if ( $self->paydate eq '' || $self->paydate eq '-' ) { @@ -2117,6 +2159,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); @@ -2138,10 +2184,14 @@ sub check_payinfo_cardtype { my $payinfo = $self->payinfo; $payinfo =~ s/\D//g; - return '' if $payinfo =~ /^99\d{14}$/; #token + if ( $payinfo =~ /^99\d{14}$/ ) { + $self->set('paycardtype', 'Tokenized'); + return ''; + } my %bop_card_types = map { $_=>1 } values %{ card_types() }; my $cardtype = cardtype($payinfo); + $self->set('paycardtype', $cardtype); return "$cardtype not accepted" unless $bop_card_types{$cardtype}; @@ -2334,33 +2384,64 @@ 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 + # but on 3.x, don't strictly enforce this + warn "cancel_pkgs should not 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'); @@ -2374,24 +2455,80 @@ sub cancel { my $ban = new FS::banned_pay $self->_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; + + $FS::UID::AutoCommit = 1; + my @errors; + # now cancel all services, the same way we would for individual packages. + # if any of them fail, cancel the rest anyway. + 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 ); + my $error = $cust_svc->cancel; # immediate cancel, no date option + push @errors, $error if $error; + } + 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"; + $lopt{'reason'} = ''; + } + } + my $error = $_->cancel(%lopt); + push @errors, 'pkgnum '.$_->pkgnum.': '.$error if $error; + } + + return @errors; } sub _banned_pay_hashref { @@ -3363,6 +3500,91 @@ sub invoicing_list_emailonly_scalar { join(', ', $self->invoicing_list_emailonly); } +=item contact_list [ CLASSNUM, ... ] + +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 '0' is given, also returns contacts with no class. + +If no arguments are given, returns all contacts for the customer. + +=cut + +sub contact_list { + my $self = shift; + my $search = { + table => 'contact', + select => 'contact.*', + extra_sql => ' WHERE contact.custnum = '.$self->custnum, + }; + + my @orwhere; + my @classnums; + foreach (@_) { + if ( $_ eq '0' ) { + push @orwhere, 'contact.classnum is null'; + } elsif ( /^\d+$/ ) { + push @classnums, $_; + } else { + die "bad classnum argument '$_'"; + } + } + + if (@classnums) { + push @orwhere, 'contact.classnum IN ('.join(',', @classnums).')'; + } + if (@orwhere) { + $search->{extra_sql} .= ' AND (' . + join(' OR ', map "( $_ )", @orwhere) . + ')'; + } + + qsearch($search); +} + +=item contact_list_email [ CLASSNUM, ... ] + +Same as L, but returns email destinations instead of contact +objects. Also accepts 'invoice' as an argument, in which case this will also +return the invoice email address if any. + +=cut + +sub contact_list_email { + my $self = shift; + my @classnums; + my $and_invoice; + foreach (@_) { + if (/^invoice$/) { + $and_invoice = 1; + } else { + push @classnums, $_; + } + } + my %emails; + # if the only argument passed was 'invoice' then no classnums are + # intended, so skip this. + if ( @classnums ) { + my @contacts = $self->contact_list(@classnums); + foreach my $contact (@contacts) { + foreach my $contact_email ($contact->contact_email) { + # unlike on 4.x, we have a separate list of invoice email + # destinations. + # make sure they're not redundant with contact emails + my $dest = $contact->firstlast . ' <' . $contact_email->emailaddress . '>'; + $emails{ $contact_email->emailaddress } = $dest; + } + } + } + if ( $and_invoice ) { + foreach my $email ($self->invoicing_list_emailonly) { + my $dest = $self->name_short . ' <' . $email . '>'; + $emails{ $email } ||= $dest; + } + } + values %emails; +} + =item referral_custnum_cust_main Returns the customer who referred this customer (or the empty string, if @@ -4781,15 +5003,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