X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=62759be69416386793da35d3d399daf326129e9f;hb=4137519a5a1a9380c59385536883e3e228627ee8;hp=01a47d0d26e88d675a29e73c26bc4b04ed0ed595;hpb=c112a7e56557acce5a54d3b57e4cdbab7c43ecc5;p=freeside.git diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 01a47d0d2..62759be69 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -14,7 +14,7 @@ use base qw( FS::cust_main::Packages FS::cust_main::Status FS::o2m_Common FS::Record ); -use vars qw( $DEBUG $me $conf +use vars qw( $DEBUG $me $conf $default_agent_custid $custnum_display_length @encrypted_fields $import $ignore_expired_card $ignore_banned_card $ignore_illegal_zip @@ -33,10 +33,9 @@ use Date::Format; #use Date::Manip; use File::Temp; #qw( tempfile ); use Business::CreditCard 0.28; -use Locale::Country; use FS::UID qw( getotaker dbh driver_name ); use FS::Record qw( qsearchs qsearch dbdef regexp_sql ); -use FS::Misc qw( generate_email send_email generate_ps do_print ); +use FS::Misc qw( generate_email send_email generate_ps do_print money_pretty card_types ); use FS::Msgcat qw(gettext); use FS::CurrentUser; use FS::TicketSystem; @@ -98,7 +97,8 @@ sub nohistory_fields { ('payinfo', 'paycvv'); } #$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) + $default_agent_custid = $conf->exists('cust_main-default_agent_custid'); + $custnum_display_length = $conf->config('cust_main-custnum-display_length'); }; sub _cache { @@ -456,7 +456,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"; @@ -541,6 +542,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; @@ -1531,6 +1542,33 @@ 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; + + 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" if $old->locale && ! $self->locale @@ -2121,6 +2159,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 $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. @@ -2564,7 +2621,13 @@ sub batch_card { }else{ $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments); } - return '' unless $amount > 0; + if ($amount <= 0) { + warn(sprintf("Customer balance %.2f - in transit amount %.2f is <= 0.\n", + $self->balance, + $self->in_transit_payments + )); + return; + } my $invnum = delete $options{invnum}; my $payby = $options{payby} || $self->payby; #still dubious @@ -2974,6 +3037,7 @@ sub in_transit_payments { foreach my $cust_pay_batch ( qsearch('cust_pay_batch', { 'batchnum' => $pay_batch->batchnum, 'custnum' => $self->custnum, + 'status' => '', } ) ) { $in_transit_payments += $cust_pay_batch->amount; } @@ -3328,6 +3392,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 @@ -4060,34 +4209,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; } @@ -4214,26 +4345,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 ] @@ -4292,13 +4411,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; + } } } @@ -4395,6 +4518,30 @@ sub tickets { (@tickets); } +=item appointments [ STATUS ] + +Returns an array of hashes representing the customer's RT tickets which +are appointments. + +=cut + +sub appointments { + my $self = shift; + my $status = ( @_ && $_[0] ) ? shift : ''; + + return () unless $conf->config('ticket_system'); + + my $queueid = $conf->config('ticket_system-appointment-queueid'); + + @{ FS::TicketSystem->customer_tickets( $self->custnum, + 99, + undef, + $status, + $queueid, + ) + }; +} + # Return services representing svc_accts in customer support packages sub support_services { my $self = shift; @@ -4517,7 +4664,7 @@ sub payment_history { 'amount' => sprintf('%.2f', $_->setup + $_->recur ), 'charged' => sprintf('%.2f', $_->setup + $_->recur ), 'date' => $cust_bill->_date, - 'date_pretty' => time2str('%m/%d/%Y', $cust_bill->_date ), + 'date_pretty' => $self->time2str_local('short', $cust_bill->_date ), } foreach $cust_bill->cust_bill_pkg; @@ -4531,7 +4678,7 @@ sub payment_history { 'amount' => sprintf('%.2f', $_->charged ), 'charged' => sprintf('%.2f', $_->charged ), 'date' => $_->_date, - 'date_pretty' => time2str('%m/%d/%Y', $_->_date ), + 'date_pretty' => $self->time2str_local('short', $_->_date ), } foreach $self->cust_bill; @@ -4543,7 +4690,7 @@ sub payment_history { 'amount' => sprintf('%.2f', 0 - $_->paid ), 'paid' => sprintf('%.2f', $_->paid ), 'date' => $_->_date, - 'date_pretty' => time2str('%m/%d/%Y', $_->_date ), + 'date_pretty' => $self->time2str_local('short', $_->_date ), } foreach $self->cust_pay; @@ -4553,7 +4700,7 @@ sub payment_history { 'amount' => sprintf('%.2f', 0 -$_->amount ), 'credit' => sprintf('%.2f', $_->amount ), 'date' => $_->_date, - 'date_pretty' => time2str('%m/%d/%Y', $_->_date ), + 'date_pretty' => $self->time2str_local('short', $_->_date ), } foreach $self->cust_credit; @@ -4563,7 +4710,7 @@ sub payment_history { 'amount' => $_->refund, 'refund' => $_->refund, 'date' => $_->_date, - 'date_pretty' => time2str('%m/%d/%Y', $_->_date ), + 'date_pretty' => $self->time2str_local('short', $_->_date ), } foreach $self->cust_refund; @@ -4583,8 +4730,7 @@ sub payment_history { } $$item{'balance'} = sprintf("%.2f",$balance); foreach my $key ( qw(amount balance) ) { - $$item{$key.'_pretty'} = $$item{$key}; - $$item{$key.'_pretty'} =~ s/^(-?)/$1$money_char/; + $$item{$key.'_pretty'} = money_pretty($$item{$key}); } push(@out,$item); } @@ -4596,6 +4742,8 @@ sub payment_history { 'description' => 'Previous balance', 'amount' => sprintf("%.2f",$previous), 'balance' => sprintf("%.2f",$previous), + 'date' => $$opt{'start_date'}, + 'date_pretty' => $self->time2str_local('short', $$opt{'start_date'} ), }; #false laziness with above foreach my $key ( qw(amount balance) ) { @@ -5137,6 +5285,8 @@ I - a hashref of name/value pairs which will be substituted into the template. These values may override values mentioned below and those from the customer record. +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. @@ -5152,11 +5302,16 @@ I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or sub generate_letter { my ($self, $template, %options) = @_; - return unless $conf->exists($template); + warn "Template $template does not exist" && return + unless $conf->exists($template) || $options{'template_text'}; + + my $template_source = $options{'template_text'} + ? [ $options{'template_text'} ] + : [ map "$_\n", $conf->config($template) ]; my $letter_template = new Text::Template ( TYPE => 'ARRAY', - SOURCE => [ map "$_\n", $conf->config($template)], + SOURCE => $template_source, DELIMITERS => [ '[@--', '--@]' ], ) or die "can't create new Text::Template object: Text::Template::ERROR";