X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=d437db69481a102e8dd74e6cbc898d230fdd810e;hb=fce19eeca97b74dbc3706da931d6cdf4bf7f0337;hp=32da745fe636f3940e81aca833afb26727afde47;hpb=633c48448d9468690b7ad77eb6ff7c660a286658;p=freeside.git diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 32da745fe..d437db694 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -21,6 +21,7 @@ use Date::Parse; use String::Approx qw(amatch); use Business::CreditCard 0.28; use Locale::Country; +use Data::Dumper; use FS::UID qw( getotaker dbh ); use FS::Record qw( qsearchs qsearch dbdef ); use FS::Misc qw( send_email ); @@ -417,7 +418,7 @@ sub start_copy_skel { #'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' }, #'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' }, #'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } }, - my @tables = eval($conf->config_binary('cust_main-skeleton_tables')); + my @tables = eval(join('\n',$conf->config('cust_main-skeleton_tables'))); die $@ if $@; _copy_skel( 'cust_main', #tablename @@ -1011,7 +1012,9 @@ sub delete { my %hash = $cust_pkg->hash; $hash{'custnum'} = $new_custnum; my $new_cust_pkg = new FS::cust_pkg ( \%hash ); - my $error = $new_cust_pkg->replace($cust_pkg); + my $error = $new_cust_pkg->replace($cust_pkg, + options => { $cust_pkg->options }, + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -1641,8 +1644,9 @@ sub num_ncancelled_pkgs { sub num_pkgs { my( $self, $sql ) = @_; + $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i; my $sth = dbh->prepare( - "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? AND $sql" + "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql" ) or die dbh->errstr; $sth->execute($self->custnum) or die $sth->errstr; $sth->fetchrow_arrayref->[0]; @@ -1899,11 +1903,18 @@ sub bill { ### my $setup = 0; - if ( !$cust_pkg->setup || $options{'resetup'} ) { + if ( ! $cust_pkg->setup && + ( + ( $conf->exists('disable_setup_suspended_pkgs') && + ! $cust_pkg->getfield('susp') + ) || ! $conf->exists('disable_setup_suspended_pkgs') + ) + || $options{'resetup'} + ) { warn " bill setup\n" if $DEBUG > 1; - $setup = eval { $cust_pkg->calc_setup( $time ) }; + $setup = eval { $cust_pkg->calc_setup( $time, \@details ) }; if ( $@ ) { $dbh->rollback if $oldAutoCommit; return "$@ running calc_setup for $cust_pkg\n"; @@ -1977,12 +1988,14 @@ sub bill { # If $cust_pkg has been modified, update it and create cust_bill_pkg records ### - if ( $cust_pkg->modified ) { + if ( $cust_pkg->modified ) { # hmmm.. and if the options are modified? warn " package ". $cust_pkg->pkgnum. " modified; updating\n" if $DEBUG >1; - $error=$cust_pkg->replace($old_cust_pkg); + $error=$cust_pkg->replace($old_cust_pkg, + options => { $cust_pkg->options }, + ); if ( $error ) { #just in case $dbh->rollback if $oldAutoCommit; return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"; @@ -2526,8 +2539,9 @@ sub realtime_bop { $payname = "$payfirst $paylast"; } - my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list; - if ( $conf->exists('emailinvoiceauto') + my @invoicing_list = $self->invoicing_list_emailonly; + if ( $conf->exists('emailinvoiceautoalways') + || $conf->exists('emailinvoiceauto') && ! @invoicing_list || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) { push @invoicing_list, $self->all_emails; } @@ -2732,10 +2746,12 @@ sub realtime_bop { 'payinfo' => $payinfo, 'paybatch' => $paybatch, } ); - my $error = $cust_pay->insert; + my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () ); if ( $error ) { $cust_pay->invnum(''); #try again with no specific invnum - my $error2 = $cust_pay->insert; + my $error2 = $cust_pay->insert( $options{'manual'} ? + ( 'manual' => 1 ) : () + ); if ( $error2 ) { # gah, even with transactions. my $e = 'WARNING: Card/ACH debited but database not updated - '. @@ -2752,6 +2768,42 @@ sub realtime_bop { my $perror = "$processor error: ". $transaction->error_message; + unless ( $transaction->error_message ) { + + my $t_response; + #this should be normalized :/ + # + # bad, ad-hoc B:OP:PayflowPro "transaction_response" BS + if ( $transaction->can('param') + && $transaction->param('transaction_response') ) { + $t_response = $transaction->param('transaction_response') + + # slightly better, ad-hoc B:OP:TransactionCentral without "param" + } elsif ( $transaction->can('response_page') ) { + $t_response = { + 'page' => ( $transaction->can('response_page') + ? $transaction->response_page + : '' + ), + 'code' => ( $transaction->can('response_code') + ? $transaction->response_code + : '' + ), + 'headers' => ( $transaction->can('response_headers') + ? $transaction->response_headers + : '' + ), + }; + } else { + $t_response .= + "No additional debugging information available for $processor"; + } + + $perror .= "No error_message returned from $processor -- ". + ( ref($t_response) ? Dumper($t_response) : $t_response ); + + } + if ( !$options{'quiet'} && !$realtime_bop_decline_quiet && $conf->exists('emaildecline') && grep { $_ ne 'POST' } $self->invoicing_list @@ -2890,7 +2942,7 @@ sub realtime_refund_bop { or return "Unknown paynum $options{'paynum'}"; $amount ||= $cust_pay->paid; - $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-]*)(:([\w\-]+))?$/ + $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/ or return "Can't parse paybatch for paynum $options{'paynum'}: ". $cust_pay->paybatch; my $gatewaynum = ''; @@ -3012,8 +3064,9 @@ sub realtime_refund_bop { $payname = "$payfirst $paylast"; } - my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list; - if ( $conf->exists('emailinvoiceauto') + my @invoicing_list = $self->invoicing_list_emailonly; + if ( $conf->exists('emailinvoiceautoalways') + || $conf->exists('emailinvoiceauto') && ! @invoicing_list || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) { push @invoicing_list, $self->all_emails; } @@ -3087,7 +3140,7 @@ sub realtime_refund_bop { $paybatch .= ':'. $refund->order_number if $refund->can('order_number') && $refund->order_number; - while ( $cust_pay && $cust_pay->unappled < $amount ) { + while ( $cust_pay && $cust_pay->unapplied < $amount ) { my @cust_bill_pay = $cust_pay->cust_bill_pay; last unless @cust_bill_pay; my $cust_bill_pay = pop @cust_bill_pay; @@ -3157,6 +3210,24 @@ sub total_owed_date { sprintf( "%.2f", $total_bill ); } +=item apply_payments_and_credits + +Applies unapplied payments and credits. + +In most cases, this new method should be used in place of sequential +apply_payments and apply_credits methods. + +=cut + +sub apply_payments_and_credits { + my $self = shift; + + foreach my $cust_bill ( $self->open_cust_bill ) { + $cust_bill->apply_payments_and_credits; + } + +} + =item apply_credits OPTION => VALUE ... Applies (see L) unapplied credits (see L) @@ -3516,9 +3587,25 @@ destinations such as POST and FAX). sub invoicing_list_emailonly { my $self = shift; + warn "$me invoicing_list_emailonly called" + if $DEBUG; grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list; } +=item invoicing_list_emailonly_scalar + +Returns the list of email invoice recipients (invoicing_list without non-email +destinations such as POST and FAX) as a comma-separated scalar. + +=cut + +sub invoicing_list_emailonly_scalar { + my $self = shift; + warn "$me invoicing_list_emailonly_scalar called" + if $DEBUG; + join(', ', $self->invoicing_list_emailonly); +} + =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ] Returns an array of customers referred by this customer (referral_custnum set @@ -3614,10 +3701,22 @@ the error, otherwise returns false. =cut sub charge { - my ( $self, $amount ) = ( shift, shift ); - my $pkg = @_ ? shift : 'One-time charge'; - my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount); - my $taxclass = @_ ? shift : ''; + my $self = shift; + my ( $amount, $pkg, $comment, $taxclass, $additional ); + if ( ref( $_[0] ) ) { + $amount = $_[0]->{amount}; + $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge'; + $comment = exists($_[0]->{comment}) ? $_[0]->{comment} + : '$'. sprintf("%.2f",$amount); + $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : ''; + $additional = $_[0]->{additional}; + }else{ + $amount = shift; + $pkg = @_ ? shift : 'One-time charge'; + $comment = @_ ? shift : '$'. sprintf("%.2f",$amount); + $taxclass = @_ ? shift : ''; + $additional = []; + } local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -3633,16 +3732,20 @@ sub charge { my $part_pkg = new FS::part_pkg ( { 'pkg' => $pkg, 'comment' => $comment, - #'setup' => $amount, - #'recur' => '0', 'plan' => 'flat', - 'plandata' => "setup_fee=$amount", 'freq' => 0, 'disabled' => 'Y', 'taxclass' => $taxclass, } ); - my $error = $part_pkg->insert; + my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) } + ( 0 .. @$additional - 1 ) + ), + 'additional_count' => scalar(@$additional), + 'setup_fee' => $amount, + ); + + my $error = $part_pkg->insert( options => \%options ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -3748,18 +3851,6 @@ sub cust_refund { qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) } -=item select_for_update - -Selects this record with the SQL "FOR UPDATE" command. This can be useful as -a mutex. - -=cut - -sub select_for_update { - my $self = shift; - qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' ); -} - =item name Returns a name string for this customer, either "Company (Last, First)" or @@ -3827,6 +3918,8 @@ sub country_full { code2country($self->country); } +=item cust_status + =item status Returns a status string for this customer, currently: @@ -3847,17 +3940,35 @@ Returns a status string for this customer, currently: =cut -sub status { +sub status { shift->cust_status(@_); } + +sub cust_status { my $self = shift; for my $status (qw( prospect active inactive suspended cancelled )) { 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 $sth->errstr; + $sth->execute( ($self->custnum) x $numnum ) + or die "Error executing 'SELECT $sql': ". $sth->errstr; return $status if $sth->fetchrow_arrayref->[0]; } } +=item ucfirst_cust_status + +=item ucfirst_status + +Returns the status with the first character capitalized. + +=cut + +sub ucfirst_status { shift->ucfirst_cust_status(@_); } + +sub ucfirst_cust_status { + my $self = shift; + ucfirst($self->cust_status); +} + =item statuscolor Returns a hex triplet color string for this customer's status. @@ -3873,9 +3984,11 @@ use vars qw(%statuscolor); 'cancelled' => 'FF0000', #red ); -sub statuscolor { +sub statuscolor { shift->cust_statuscolor(@_); } + +sub cust_statuscolor { my $self = shift; - $statuscolor{$self->status}; + $statuscolor{$self->cust_status}; } =back @@ -4039,7 +4152,8 @@ sub fuzzy_search { Accepts the following options: I, the string to search for. The string will be searched for as a customer number, phone number, name or company name, as an exact, or, in some cases, a substring or fuzzy match (see the source code -for the exact heuristics used). +for the exact heuristics used); I, causes smart_search to +skip fuzzy matching when an exact match is found. Any additional options are treated as an additional qualifier on the search (i.e. I). @@ -4056,6 +4170,7 @@ sub smart_search { my @cust_main = (); + my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'}; my $search = delete $options{'search'}; ( my $alphanum_search = $search ) =~ s/\W//g; @@ -4193,7 +4308,7 @@ sub smart_search { #always do substring & fuzzy, #getting complains searches are not returning enough - #unless ( @cust_main ) { #no exact match, trying substring/fuzzy + unless ( @cust_main && $skip_fuzzy ) { #no exact match, trying substring/fuzzy #still some false laziness w/ search/cust_main.cgi @@ -4254,7 +4369,7 @@ sub smart_search { FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts ); } - #} + } #eliminate duplicates my %saw = (); @@ -4538,8 +4653,7 @@ sub batch_import { return "can't bill customer for $line: $error"; } - $cust_main->apply_payments; - $cust_main->apply_credits; + $cust_main->apply_payments_and_credits; $error = $cust_main->collect(); if ( $error ) { @@ -4643,6 +4757,94 @@ sub batch_charge { } +=item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS + +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 ($customer, $template, %options) = @_; + + return unless $conf->exists($template); + + my $from = $conf->config('invoice_from') if $conf->exists('invoice_from'); + $from = $options{from} if exists($options{from}); + + my $to = join(',', $customer->invoicing_list_emailonly); + $to = $options{to} if exists($options{to}); + + my $subject = "Notice from " . $conf->config('company_name') + if $conf->exists('company_name'); + $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"; + + my $paydate = $customer->paydate; + $FS::notify_template::_template::first = $customer->first; + $FS::notify_template::_template::last = $customer->last; + $FS::notify_template::_template::company = $customer->company; + $FS::notify_template::_template::payinfo = $customer->mask_payinfo; + my $payby = $customer->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' ), + ); + +} + =back =head1 BUGS