X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=e834d59e493cd4f770f4816ae750466f776f92b1;hb=c42fe413bd1b9a38e4818dcd7117a8abeee674e8;hp=ebe4c242e9bd600c85c3d60c50d243b137904cd1;hpb=da757c2af713bedd8706e30ac002658b0c97ce28;p=freeside.git diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index ebe4c242e..e834d59e4 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -2,7 +2,7 @@ package FS::cust_main; use strict; use vars qw( @ISA @EXPORT_OK $DEBUG $me $conf @encrypted_fields - $import $skip_fuzzyfiles $ignore_expired_card ); + $import $skip_fuzzyfiles $ignore_expired_card @paytypes); use vars qw( $realtime_bop_decline_quiet ); #ugh use Safe; use Carp; @@ -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 ); @@ -69,6 +70,7 @@ $skip_fuzzyfiles = 0; $ignore_expired_card = 0; @encrypted_fields = ('payinfo', 'paycvv'); +@paytypes = ('Personal checking', 'Personal savings', 'Business checking', 'Business savings'); #ask FS::UID to run this stuff for us later #$FS::UID::callback{'FS::cust_main'} = sub { @@ -417,7 +419,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 +1013,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; @@ -1216,6 +1220,9 @@ sub check { || $self->ut_country('country') || $self->ut_anything('comments') || $self->ut_numbern('referral_custnum') + || $self->ut_textn('stateid') + || $self->ut_textn('stateid_state') + || $self->ut_textn('invoice_terms') ; #barf. need message catalogs. i18n. etc. $error .= "Please select an advertising source." @@ -1330,6 +1337,7 @@ sub check { $error = $self->ut_numbern('paystart_month') || $self->ut_numbern('paystart_year') || $self->ut_numbern('payissue') + || $self->ut_textn('paytype') ; return $error if $error; @@ -1526,11 +1534,17 @@ Returns all packages (see L) for this customer. sub all_pkgs { my $self = shift; + + return $self->num_pkgs unless wantarray; + + my @cust_pkg = (); if ( $self->{'_pkgnum'} ) { - values %{ $self->{'_pkgnum'}->cache }; + @cust_pkg = values %{ $self->{'_pkgnum'}->cache }; } else { - qsearch( 'cust_pkg', { 'custnum' => $self->custnum }); + @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum }); } + + sort sort_packages @cust_pkg; } =item ncancelled_pkgs @@ -1541,19 +1555,43 @@ Returns all non-cancelled packages (see L) for this customer. sub ncancelled_pkgs { my $self = shift; + + return $self->num_ncancelled_pkgs unless wantarray; + + my @cust_pkg = (); if ( $self->{'_pkgnum'} ) { - grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache }; + + @cust_pkg = grep { ! $_->getfield('cancel') } + values %{ $self->{'_pkgnum'}->cache }; + } else { - @{ [ # force list context + + @cust_pkg = qsearch( 'cust_pkg', { - 'custnum' => $self->custnum, - 'cancel' => '', - }), + 'custnum' => $self->custnum, + 'cancel' => '', + }); + push @cust_pkg, qsearch( 'cust_pkg', { - 'custnum' => $self->custnum, - 'cancel' => 0, - }), - ] }; + 'custnum' => $self->custnum, + 'cancel' => 0, + }); + } + + sort sort_packages @cust_pkg; + +} + +# This should be generalized to use config options to determine order. +sub sort_packages { + if ( $a->get('cancel') and $b->get('cancel') ) { + $a->pkgnum <=> $b->pkgnum; + } elsif ( $a->get('cancel') or $b->get('cancel') ) { + return -1 if $b->get('cancel'); + return 1 if $a->get('cancel'); + return 0; + } else { + $a->pkgnum <=> $b->pkgnum; } } @@ -1602,14 +1640,18 @@ customer. =cut sub num_cancelled_pkgs { - my $self = shift; - $self->num_pkgs("cancel IS NOT NULL AND cust_pkg.cancel != 0"); + shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0"); +} + +sub num_ncancelled_pkgs { + shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )"); } 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]; @@ -1737,7 +1779,7 @@ sub _banned_pay_hashref { { 'payby' => $payby2ban{$self->payby}, 'payinfo' => md5_base64($self->payinfo), - #'reason' => + #don't ever *search* on reason! #'reason' => }; } @@ -1866,11 +1908,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"; @@ -1944,12 +1993,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"; @@ -2493,8 +2544,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; } @@ -2699,10 +2751,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 - '. @@ -2719,6 +2773,34 @@ sub realtime_bop { my $perror = "$processor error: ". $transaction->error_message; + unless ( $transaction->error_message ) { + + my $t_response; + if ( $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 @@ -2857,7 +2939,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 = ''; @@ -2979,8 +3061,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; } @@ -3054,7 +3137,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; @@ -3124,6 +3207,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) @@ -3483,9 +3584,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 @@ -3581,10 +3698,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'; @@ -3600,16 +3729,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; @@ -3715,18 +3848,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 @@ -3794,6 +3915,8 @@ sub country_full { code2country($self->country); } +=item cust_status + =item status Returns a status string for this customer, currently: @@ -3814,17 +3937,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. @@ -3840,9 +3981,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 @@ -3995,6 +4138,22 @@ sub fuzzy_search { } +=item masked FIELD + +Returns a masked version of the named field + +=cut + +sub masked { +my ($self,$field) = @_; + +# Show last four + +'x'x(length($self->getfield($field))-4). + substr($self->getfield($field), (length($self->getfield($field))-4)); + +} + =back =head1 SUBROUTINES @@ -4006,7 +4165,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). @@ -4023,6 +4183,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; @@ -4160,7 +4321,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 @@ -4221,7 +4382,7 @@ sub smart_search { FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts ); } - #} + } #eliminate duplicates my %saw = (); @@ -4505,8 +4666,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 ) { @@ -4610,6 +4770,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