X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=79e674d56a7d187d62e185da293c8b9849df85b9;hb=8d0e15c1c73639374443f5fd2c06334eb12bea44;hp=270c544ef5b6e750e46a23bfe0b983b453b309c0;hpb=7bac56be80a6323073566c6e3c0d87c90801036b;p=freeside.git diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 270c544ef..79e674d56 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1,61 +1,80 @@ package FS::cust_main; +require 5.006; use strict; -use vars qw( @ISA @EXPORT_OK $DEBUG $me $conf @encrypted_fields - $import $skip_fuzzyfiles $ignore_expired_card ); -use vars qw( $realtime_bop_decline_quiet ); #ugh -use Safe; +use base qw( FS::cust_main::Packages FS::cust_main::Status + FS::cust_main::NationalID + FS::cust_main::Billing FS::cust_main::Billing_Realtime + FS::cust_main::Billing_Discount + FS::cust_main::Billing_ThirdParty + FS::cust_main::Location + FS::cust_main::Credit_Limit + FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin + FS::geocode_Mixin FS::Quotable_Mixin FS::Sales_Mixin + FS::o2m_Common + FS::Record + ); +use vars qw( $DEBUG $me $conf $default_agent_custid $custnum_display_length + @encrypted_fields + $import + $ignore_expired_card $ignore_banned_card $ignore_illegal_zip + $skip_fuzzyfiles + @paytypes + ); use Carp; -use Exporter; -BEGIN { - eval "use Time::Local;"; - die "Time::Local minimum version 1.05 required with Perl versions before 5.6" - if $] < 5.006 && !defined($Time::Local::VERSION); - #eval "use Time::Local qw(timelocal timelocal_nocheck);"; - eval "use Time::Local qw(timelocal_nocheck);"; -} +use Scalar::Util qw( blessed ); +use Time::Local qw(timelocal); +use Storable qw(thaw); +use MIME::Base64; +use Data::Dumper; +use Tie::IxHash; use Digest::MD5 qw(md5_base64); use Date::Format; -use Date::Parse; #use Date::Manip; -use String::Approx qw(amatch); +use File::Temp; #qw( tempfile ); use Business::CreditCard 0.28; -use Locale::Country; -use FS::UID qw( getotaker dbh ); -use FS::Record qw( qsearchs qsearch dbdef ); -use FS::Misc qw( send_email ); +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 money_pretty card_types ); use FS::Msgcat qw(gettext); +use FS::CurrentUser; +use FS::TicketSystem; +use FS::payby; use FS::cust_pkg; use FS::cust_svc; use FS::cust_bill; -use FS::cust_bill_pkg; +use FS::cust_bill_void; +use FS::legacy_cust_bill; use FS::cust_pay; +use FS::cust_pay_pending; use FS::cust_pay_void; +use FS::cust_pay_batch; use FS::cust_credit; use FS::cust_refund; use FS::part_referral; use FS::cust_main_county; +use FS::cust_location; +use FS::cust_class; +use FS::cust_main_exemption; +use FS::cust_tax_adjustment; +use FS::cust_tax_location; use FS::agent; use FS::cust_main_invoice; -use FS::cust_credit_bill; -use FS::cust_bill_pay; +use FS::cust_tag; use FS::prepay_credit; use FS::queue; use FS::part_pkg; -use FS::part_bill_event; -use FS::cust_bill_event; -use FS::cust_tax_exempt; -use FS::cust_tax_exempt_pkg; +use FS::part_export; +#use FS::cust_event; use FS::type_pkgs; use FS::payment_gateway; use FS::agent_payment_gateway; use FS::banned_pay; - -@ISA = qw( FS::Record ); - -@EXPORT_OK = qw( smart_search ); - -$realtime_bop_decline_quiet = 0; +use FS::cust_main_note; +use FS::cust_attachment; +use FS::contact; +use FS::Locales; +use FS::upgrade_journal; # 1 is mostly method/subroutine entry and options # 2 traces progress of some operations @@ -64,16 +83,22 @@ $DEBUG = 0; $me = '[FS::cust_main]'; $import = 0; -$skip_fuzzyfiles = 0; $ignore_expired_card = 0; +$ignore_banned_card = 0; + +$skip_fuzzyfiles = 0; @encrypted_fields = ('payinfo', 'paycvv'); +sub nohistory_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 { 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 { @@ -129,163 +154,129 @@ FS::Record. The following fields are currently supported: =over 4 -=item custnum - primary key (assigned automatically for new customers) +=item custnum -=item agentnum - agent (see L) +Primary key (assigned automatically for new customers) -=item refnum - Advertising source (see L) +=item agentnum -=item first - name +Agent (see L) -=item last - name +=item refnum -=item ss - social security number (optional) +Advertising source (see L) -=item company - (optional) +=item first -=item address1 +First name -=item address2 - (optional) +=item last -=item city +Last name -=item county - (optional, see L) +=item ss -=item state - (see L) +Cocial security number (optional) -=item zip +=item company -=item country - (see L) +(optional) -=item daytime - phone (optional) +=item daytime -=item night - phone (optional) +phone (optional) -=item fax - phone (optional) +=item night -=item ship_first - name +phone (optional) -=item ship_last - name +=item fax -=item ship_company - (optional) +phone (optional) -=item ship_address1 +=item mobile -=item ship_address2 - (optional) +phone (optional) -=item ship_city +=item payby -=item ship_county - (optional, see L) +Payment Type (See L for valid payby values) -=item ship_state - (see L) +=item payinfo -=item ship_zip +Payment Information (See L for data format) -=item ship_country - (see L) +=item paymask -=item ship_daytime - phone (optional) +Masked payinfo (See L for how this works) -=item ship_night - phone (optional) - -=item ship_fax - phone (optional) +=item paycvv -=item payby +Card Verification Value, "CVV2" (also known as CVC2 or CID), the 3 or 4 digit number on the back (or front, for American Express) of the credit card -I (credit card - automatic), I (credit card - on-demand), I (electronic check - automatic), I (electronic check - on-demand), I (Phone bill billing), I (billing), I (free), or I (special billing type: applies a credit - see L and sets billing type to I) +=item paydate -=item payinfo +Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy -Card Number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L) +=item paystart_month -=cut +Start date month (maestro/solo cards only) -sub payinfo { - my($self,$payinfo) = @_; - if ( defined($payinfo) ) { - $self->paymask($payinfo); - $self->setfield('payinfo', $payinfo); # This is okay since we are the 'setter' - } else { - $payinfo = $self->getfield('payinfo'); # This is okay since we are the 'getter' - return $payinfo; - } -} +=item paystart_year +Start date year (maestro/solo cards only) -=item paycvv - -Card Verification Value, "CVV2" (also known as CVC2 or CID), the 3 or 4 digit number on the back (or front, for American Express) of the credit card +=item payissue -=cut +Issue number (maestro/solo cards only) -=item paymask - Masked payment type +=item payname -=over 4 +Name on card or billing name -=item Credit Cards +=item payip -Mask all but the last four characters. +IP address from which payment information was received -=item Checks +=item tax -Mask all but last 2 of account number and bank routing number. +Tax exempt, empty or `Y' -=item Others +=item usernum -Do nothing, return the unmasked string. +Order taker (see L) -=back +=item comments -=cut +Comments (optional) -sub paymask { - my($self,$value)=@_; +=item referral_custnum - # If it doesn't exist then generate it - my $paymask=$self->getfield('paymask'); - if (!defined($value) && (!defined($paymask) || $paymask eq '')) { - $value = $self->payinfo; - } +Referring customer number - if ( defined($value) && !$self->is_encrypted($value)) { - my $payinfo = $value; - my $payby = $self->payby; - if ($payby eq 'CARD' || $payby eq 'DCRD') { # Credit Cards (Show last four) - $paymask = 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4)); - } elsif ($payby eq 'CHEK' || - $payby eq 'DCHK' ) { # Checks (Show last 2 @ bank) - my( $account, $aba ) = split('@', $payinfo ); - $paymask = 'x'x(length($account)-2). substr($account,(length($account)-2))."@".$aba; - } else { # Tie up loose ends - $paymask = $payinfo; - } - $self->setfield('paymask', $paymask); # This is okay since we are the 'setter' - } elsif (defined($value) && $self->is_encrypted($value)) { - $paymask = 'N/A'; - } - return $paymask; -} +=item spool_cdr -=item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy +Enable individual CDR spooling, empty or `Y' -=item paystart_month - start date month (maestro/solo cards only) +=item dundate -=item paystart_year - start date year (maestro/solo cards only) +A suggestion to events (see L) to delay until this unix timestamp -=item payissue - issue number (maestro/solo cards only) +=item squelch_cdr -=item payname - name on card or billing name +Discourage individual CDR printing, empty or `Y' -=item payip - IP address from which payment information was received +=item edit_subject -=item tax - tax exempt, empty or `Y' +Allow self-service editing of ticket subjects, empty or 'Y' -=item otaker - order taker (assigned automatically, see L) +=item calling_list_exempt -=item comments - comments (optional) +Do not call, empty or 'Y' -=item referral_custnum - referring customer number +=item invoice_ship_address -=item spool_cdr - Enable individual CDR spooling, empty or `Y' +Display ship_address ("Service address") on invoices for this customer, empty or 'Y' =back @@ -309,6 +300,12 @@ sub table { 'cust_main'; } Adds this customer to the database. If there is an error, returns the error, otherwise returns false. +Usually the customer's location will not yet exist in the database, and +the C and C pseudo-fields must be set to +uninserted L objects. These will be inserted and linked +(in both directions) to the new customer record. If they're references +to the same object, they will become the same location. + CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert method containing FS::cust_pkg and FS::svc_I objects, all records are inserted atomicly, or the transaction is rolled back. Passing an empty @@ -332,7 +329,8 @@ invoicing_list destination to the newly-created svc_acct. Here's an example: $cust_main->insert( {}, [ $email, 'POST' ] ); -Currently available options are: I and I. +Currently available options are: I, I, +I and I. If I is set, all provisioning jobs will have a dependancy on the supplied jobnum (they will not run until the specific job completes). @@ -343,6 +341,12 @@ The I option is deprecated. If I is set true, no provisioning jobs (exports) are scheduled. (You can schedule them later with the B method.) +The I option can be set to an arrayref of tax names or a hashref +of tax names and exemption numbers. FS::cust_main_exemption records will be +created and inserted. + +If I is set, moves contacts and locations from that prospect. + =cut sub insert { @@ -366,7 +370,7 @@ sub insert { my $dbh = dbh; my $prepay_identifier = ''; - my( $amount, $seconds ) = ( 0, 0 ); + my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0); my $payby = ''; if ( $self->payby eq 'PREPAY' ) { @@ -377,7 +381,13 @@ sub insert { warn " looking up prepaid card $prepay_identifier\n" if $DEBUG > 1; - my $error = $self->get_prepay($prepay_identifier, \$amount, \$seconds); + my $error = $self->get_prepay( $prepay_identifier, + 'amount_ref' => \$amount, + 'seconds_ref' => \$seconds, + 'upbytes_ref' => \$upbytes, + 'downbytes_ref' => \$downbytes, + 'totalbytes_ref' => \$totalbytes, + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; #return "error applying prepaid card (transaction rolled back): $error"; @@ -386,7 +396,7 @@ sub insert { $payby = 'PREP' if $amount; - } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) { + } elsif ( $self->payby =~ /^(CASH|WEST|MCRD|MCHK|PPAL)$/ ) { $payby = $1; $self->payby('BILL'); @@ -394,16 +404,82 @@ sub insert { } + # insert locations + foreach my $l (qw(bill_location ship_location)) { + + my $loc = delete $self->hashref->{$l} or return "$l not set"; + + if ( !$loc->locationnum ) { + # warn the location that we're going to insert it with no custnum + $loc->set(custnum_pending => 1); + warn " inserting $l\n" + if $DEBUG > 1; + my $error = $loc->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + my $label = $l eq 'ship_location' ? 'service' : 'billing'; + return "$error (in $label location)"; + } + + } elsif ( $loc->prospectnum ) { + + $loc->prospectnum(''); + $loc->set(custnum_pending => 1); + my $error = $loc->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + my $label = $l eq 'ship_location' ? 'service' : 'billing'; + return "$error (moving $label location)"; + } + + } elsif ( ($loc->custnum || 0) > 0 ) { + # then it somehow belongs to another customer--shouldn't happen + $dbh->rollback if $oldAutoCommit; + return "$l belongs to customer ".$loc->custnum; + } + # else it already belongs to this customer + # (happens when ship_location is identical to bill_location) + + $self->set($l.'num', $loc->locationnum); + + if ( $self->get($l.'num') eq '' ) { + $dbh->rollback if $oldAutoCommit; + return "$l not set"; + } + } + warn " inserting $self\n" if $DEBUG > 1; - my $error = $self->SUPER::insert; + $self->signupdate(time) unless $self->signupdate; + + $self->auto_agent_custid() + if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid; + + my $error = $self->check_payinfo_cardtype + || $self->SUPER::insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; #return "inserting cust_main record (transaction rolled back): $error"; return $error; } + # now set cust_location.custnum + foreach my $l (qw(bill_location ship_location)) { + warn " setting $l.custnum\n" + if $DEBUG > 1; + my $loc = $self->$l; + unless ( $loc->custnum ) { + $loc->set(custnum => $self->custnum); + $error ||= $loc->replace; + } + + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error setting $l custnum: $error"; + } + } + warn " setting invoicing list\n" if $DEBUG > 1; @@ -411,29 +487,131 @@ sub insert { $error = $self->check_invoicing_list( $invoicing_list ); if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "checking invoicing_list (transaction rolled back): $error"; + #return "checking invoicing_list (transaction rolled back): $error"; + return $error; } $self->invoicing_list( $invoicing_list ); } - if ( $conf->config('cust_main-skeleton_tables') - && $conf->config('cust_main-skeleton_custnum') ) { + warn " setting customer tags\n" + if $DEBUG > 1; + + foreach my $tagnum ( @{ $self->tagnum || [] } ) { + my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum, + 'custnum' => $self->custnum }; + my $error = $cust_tag->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + my $prospectnum = delete $options{'prospectnum'}; + if ( $prospectnum ) { - warn " inserting skeleton records\n" + warn " moving contacts and locations from prospect $prospectnum\n" if $DEBUG > 1; - my $error = $self->start_copy_skel; + my $prospect_main = + qsearchs('prospect_main', { 'prospectnum' => $prospectnum } ); + unless ( $prospect_main ) { + $dbh->rollback if $oldAutoCommit; + return "Unknown prospectnum $prospectnum"; + } + $prospect_main->custnum($self->custnum); + $prospect_main->disabled('Y'); + my $error = $prospect_main->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + my @contact = $prospect_main->contact; + my @cust_location = $prospect_main->cust_location; + my @qual = $prospect_main->qual; + + foreach my $r ( @contact, @cust_location, @qual ) { + $r->prospectnum(''); + $r->custnum($self->custnum); + my $error = $r->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + } + + # 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; + + if ( my $contact = delete $options{'contact'} ) { + + foreach my $c ( @$contact ) { + $c->custnum($self->custnum); + my $error = $c->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + } + + } elsif ( my $contact_params = delete $options{'contact_params'} ) { + + my $error = $self->process_o2m( 'table' => 'contact', + 'fields' => FS::contact->cgi_contact_fields, + 'params' => $contact_params, + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } + } + + warn " setting cust_main_exemption\n" + if $DEBUG > 1; + my $tax_exemption = delete $options{'tax_exemption'}; + if ( $tax_exemption ) { + + $tax_exemption = { map { $_ => '' } @$tax_exemption } + if ref($tax_exemption) eq 'ARRAY'; + + foreach my $taxname ( keys %$tax_exemption ) { + my $cust_main_exemption = new FS::cust_main_exemption { + 'custnum' => $self->custnum, + 'taxname' => $taxname, + 'exempt_number' => $tax_exemption->{$taxname}, + }; + my $error = $cust_main_exemption->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "inserting cust_main_exemption (transaction rolled back): $error"; + } + } } warn " ordering packages\n" if $DEBUG > 1; - $error = $self->order_pkgs($cust_pkgs, \$seconds, %options); + $error = $self->order_pkgs( $cust_pkgs, + %options, + 'seconds_ref' => \$seconds, + 'upbytes_ref' => \$upbytes, + 'downbytes_ref' => \$downbytes, + 'totalbytes_ref' => \$totalbytes, + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -443,6 +621,10 @@ sub insert { $dbh->rollback if $oldAutoCommit; return "No svc_acct record to apply pre-paid time"; } + if ( $upbytes || $downbytes || $totalbytes ) { + $dbh->rollback if $oldAutoCommit; + return "No svc_acct record to apply pre-paid data"; + } if ( $amount ) { warn " inserting initial $payby payment of $amount\n" @@ -464,221 +646,119 @@ sub insert { } } - warn " insert complete; committing transaction\n" - if $DEBUG > 1; - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; + # FS::geocode_Mixin::after_insert or something? + if ( $conf->config('tax_district_method') and !$import ) { + # if anything non-empty, try to look it up + my $queue = new FS::queue { + 'job' => 'FS::geocode_Mixin::process_district_update', + 'custnum' => $self->custnum, + }; + my $error = $queue->insert( ref($self), $self->custnum ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing tax district update: $error"; + } + } -} + # cust_main exports! + warn " exporting\n" if $DEBUG > 1; -sub start_copy_skel { - my $self = shift; + my $export_args = $options{'export_args'} || []; - #'mg_user_preference' => {}, - #'mg_user_indicator_profile' => { 'mg_profile_indicator' => { 'mg_profile_details' }, }, - #'mg_watchlist_header' => { 'mg_watchlist_details' }, - #'mg_user_grid_header' => { 'mg_user_grid_details' }, - #'mg_portfolio_header' => { 'mg_portfolio_trades' => { 'mg_portfolio_trades_positions' } }, - my @tables = eval($conf->config('cust_main-skeleton_tables')); - die $@ if $@; + my @part_export = + map qsearch( 'part_export', {exportnum=>$_} ), + $conf->config('cust_main-exports'); #, $agentnum - _copy_skel( 'cust_main', #tablename - $conf->config('cust_main-skeleton_custnum'), #sourceid - $self->custnum, #destid - @tables, #child tables - ); -} + foreach my $part_export ( @part_export ) { + my $error = $part_export->export_insert($self, @$export_args); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "exporting to ". $part_export->exporttype. + " (transaction rolled back): $error"; + } + } -#recursive subroutine, not a method -sub _copy_skel { - my( $table, $sourceid, $destid, %child_tables ) = @_; + #foreach my $depend_jobnum ( @$depend_jobnums ) { + # warn "[$me] inserting dependancies on supplied job $depend_jobnum\n" + # if $DEBUG; + # foreach my $jobnum ( @jobnums ) { + # my $queue = qsearchs('queue', { 'jobnum' => $jobnum } ); + # warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n" + # if $DEBUG; + # my $error = $queue->depend_insert($depend_jobnum); + # if ( $error ) { + # $dbh->rollback if $oldAutoCommit; + # return "error queuing job dependancy: $error"; + # } + # } + # } + # + #} + # + #if ( exists $options{'jobnums'} ) { + # push @{ $options{'jobnums'} }, @jobnums; + #} - my $dbdef_table = dbdef->table($table); - my $primary_key = $dbdef_table->primary_key - or return "$table has no primary key". - " (or do you need to run dbdef-create?)"; + warn " insert complete; committing transaction\n" + if $DEBUG > 1; - warn " _copy_skel: $table.$primary_key $sourceid to $destid for ". - join (', ', keys %child_tables). "\n" - if $DEBUG > 2; + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; - foreach my $child_table ( keys %child_tables ) { +} - my $child_pkey = dbdef->table($child_table)->primary_key; - # or return "$table has no primary key". - # " (or do you need to run dbdef-create?)\n"; - my $sequence = ''; - if ( keys %{ $child_tables{$child_table} } ) { +use File::CounterFile; +sub auto_agent_custid { + my $self = shift; - return "$child_table has no primary key\n" unless $child_pkey; + my $format = $conf->config('cust_main-auto_agent_custid'); + my $agent_custid; + if ( $format eq '1YMMXXXXXXXX' ) { - #false laziness w/Record::insert and only works on Pg - #refactor the proper last-inserted-id stuff out of Record::insert if this - # ever gets use for anything besides a quick kludge for one customer - my $default = dbdef->table($child_table)->column($child_pkey)->default; - $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i - or return "can't parse $child_table.$child_pkey default value ". - " for sequence name: $default"; - $sequence = $1; + my $counter = new File::CounterFile 'cust_main.agent_custid'; + $counter->lock; + my $ym = 100000000000 + time2str('%y%m00000000', time); + if ( $ym > $counter->value ) { + $counter->{'value'} = $agent_custid = $ym; + $counter->{'updated'} = 1; + } else { + $agent_custid = $counter->inc; } - - my @sel_columns = grep { $_ ne $primary_key } - dbdef->table($child_table)->columns; - my $sel_columns = ' ( '. join(', ', @sel_columns ). ' ) '; - - my @ins_columns = grep { $_ ne $child_pkey } @sel_columns; - my $ins_columns = ' ( ', join(', ', $primary_key, @ins_columns ). ' ) ', - my $placeholders = ' ( ?, '. join(', ', map '?', @ins_columns ). ' ) '; - - my $sel_sth = dbh->prepare( "SELECT $sel_columns FROM $child_table". - " WHERE $primary_key = $sourceid") - or return dbh->errstr; - - $sel_sth->execute or return $sel_sth->errstr; - - while ( my $row = $sel_sth->fetchrow_hashref ) { - - my $ins_sth = - dbh->prepare("INSERT INTO $child_table $ins_columns". - " VALUES $placeholders") - or return dbh->errstr; - $ins_sth->execute( $destid, map $row->{$_}, @ins_columns ) - or return $ins_sth->errstr; - - #next unless keys %{ $child_tables{$child_table} }; - next unless $sequence; - - #another section of that laziness - my $seq_sql = "SELECT currval('$sequence')"; - my $seq_sth = dbh->prepare($seq_sql) or return dbh->errstr; - $seq_sth->execute or return $seq_sth->errstr; - my $insertid = $seq_sth->fetchrow_arrayref->[0]; - - # don't drink soap! recurse! recurse! okay! - my $error = - _copy_skel( $child_table, - $row->{$child_pkey}, #sourceid - $insertid, #destid - %{ $child_tables{$child_table} }, - ); - return $error if $error; - } + $counter->unlock; + } else { + die "Unknown cust_main-auto_agent_custid format: $format"; } - return ''; + $self->agent_custid($agent_custid); } -=item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ] - -Like the insert method on an existing record, this method orders a package -and included services atomicaly. Pass a Tie::RefHash data structure to this -method containing FS::cust_pkg and FS::svc_I objects. There should -be a better explanation of this, but until then, here's an example: - - use Tie::RefHash; - tie %hash, 'Tie::RefHash'; #this part is important - %hash = ( - $cust_pkg => [ $svc_acct ], - ... - ); - $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 ); - -Services can be new, in which case they are inserted, or existing unaudited -services, in which case they are linked to the newly-created package. - -Currently available options are: I and I. - -If I is set, all provisioning jobs will have a dependancy -on the supplied jobnum (they will not run until the specific job completes). -This can be used to defer provisioning until some action completes (such -as running the customer's credit card successfully). - -The I option is deprecated. If I is set true, no -provisioning jobs (exports) are scheduled. (You can schedule them later with -the B method for each cust_pkg object. Using the B method -on the cust_main object is not recommended, as existing services will also be -reexported.) - -=cut - -sub order_pkgs { - my $self = shift; - my $cust_pkgs = shift; - my $seconds = shift; - my %options = @_; - my %svc_options = (); - $svc_options{'depend_jobnum'} = $options{'depend_jobnum'} - if exists $options{'depend_jobnum'}; - warn "$me order_pkgs called with options ". - join(', ', map { "$_: $options{$_}" } keys %options ). "\n" - if $DEBUG; - - 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; - - local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'}; - - foreach my $cust_pkg ( keys %$cust_pkgs ) { - $cust_pkg->custnum( $self->custnum ); - my $error = $cust_pkg->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "inserting cust_pkg (transaction rolled back): $error"; - } - foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) { - if ( $svc_something->svcnum ) { - my $old_cust_svc = $svc_something->cust_svc; - my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash }; - $new_cust_svc->pkgnum( $cust_pkg->pkgnum); - $error = $new_cust_svc->replace($old_cust_svc); - } else { - $svc_something->pkgnum( $cust_pkg->pkgnum ); - if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) { - $svc_something->seconds( $svc_something->seconds + $$seconds ); - $$seconds = 0; - } - $error = $svc_something->insert(%svc_options); - } - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - #return "inserting svc_ (transaction rolled back): $error"; - return $error; - } - } - } +=item PACKAGE METHODS - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; #no error -} +Documentation on customer package methods has been moved to +L. -=item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF ] +=item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ] Recharges this (existing) customer with the specified prepaid card (see L), specified either by I or as an FS::prepay_credit object. If there is an error, returns the error, otherwise returns false. -Optionally, two scalar references can be passed as well. They will have their -values filled in with the amount and number of seconds applied by this prepaid -card. +Optionally, five scalar references can be passed as well. They will have their +values filled in with the amount, number of seconds, and number of upload, +download, and total bytes applied by this prepaid card. =cut +#the ref bullshit here should be refactored like get_prepay. MyAccount.pm is +#the only place that uses these args sub recharge_prepay { - my( $self, $prepay_credit, $amountref, $secondsref ) = @_; + my( $self, $prepay_credit, $amountref, $secondsref, + $upbytesref, $downbytesref, $totalbytesref ) = @_; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -691,10 +771,19 @@ sub recharge_prepay { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my( $amount, $seconds ) = ( 0, 0 ); + my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 ); - my $error = $self->get_prepay($prepay_credit, \$amount, \$seconds) + my $error = $self->get_prepay( $prepay_credit, + 'amount_ref' => \$amount, + 'seconds_ref' => \$seconds, + 'upbytes_ref' => \$upbytes, + 'downbytes_ref' => \$downbytes, + 'totalbytes_ref' => \$totalbytes, + ) || $self->increment_seconds($seconds) + || $self->increment_upbytes($upbytes) + || $self->increment_downbytes($downbytes) + || $self->increment_totalbytes($totalbytes) || $self->insert_cust_pay_prepay( $amount, ref($prepay_credit) ? $prepay_credit->identifier @@ -708,19 +797,22 @@ sub recharge_prepay { if ( defined($amountref) ) { $$amountref = $amount; } if ( defined($secondsref) ) { $$secondsref = $seconds; } + if ( defined($upbytesref) ) { $$upbytesref = $upbytes; } + if ( defined($downbytesref) ) { $$downbytesref = $downbytes; } + if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; } $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } -=item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ , AMOUNTREF, SECONDSREF +=item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ] Looks up and deletes a prepaid card (see L), specified either by I or as an FS::prepay_credit object. -References to I and I scalars should be passed as arguments -and will be incremented by the values of the prepaid card. +Available options are: I, I, I, I, and I. The scalars (provided by references) will be +incremented by the values of the prepaid card. If the prepaid card specifies an I (see L), it is used to check or set this customer's I. @@ -731,7 +823,7 @@ If there is an error, returns the error, otherwise returns false. sub get_prepay { - my( $self, $prepay_credit, $amountref, $secondsref ) = @_; + my( $self, $prepay_credit, %opt ) = @_; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -750,7 +842,7 @@ sub get_prepay { $prepay_credit = qsearchs( 'prepay_credit', - { 'identifier' => $prepay_credit }, + { 'identifier' => $identifier }, '', 'FOR UPDATE' ); @@ -776,14 +868,50 @@ sub get_prepay { return "removing prepay_credit (transaction rolled back): $error"; } - $$amountref += $prepay_credit->amount; - $$secondsref += $prepay_credit->seconds; + ${ $opt{$_.'_ref'} } += $prepay_credit->$_() + for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes ); $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } +=item increment_upbytes SECONDS + +Updates this customer's single or primary account (see L) by +the specified number of upbytes. If there is an error, returns the error, +otherwise returns false. + +=cut + +sub increment_upbytes { + _increment_column( shift, 'upbytes', @_); +} + +=item increment_downbytes SECONDS + +Updates this customer's single or primary account (see L) by +the specified number of downbytes. If there is an error, returns the error, +otherwise returns false. + +=cut + +sub increment_downbytes { + _increment_column( shift, 'downbytes', @_); +} + +=item increment_totalbytes SECONDS + +Updates this customer's single or primary account (see L) by +the specified number of totalbytes. If there is an error, returns the error, +otherwise returns false. + +=cut + +sub increment_totalbytes { + _increment_column( shift, 'totalbytes', @_); +} + =item increment_seconds SECONDS Updates this customer's single or primary account (see L) by @@ -793,10 +921,24 @@ otherwise returns false. =cut sub increment_seconds { - my( $self, $seconds ) = @_; - warn "$me increment_seconds called: $seconds seconds\n" + _increment_column( shift, 'seconds', @_); +} + +=item _increment_column AMOUNT + +Updates this customer's single or primary account (see L) by +the specified number of seconds or bytes. If there is an error, returns +the error, otherwise returns false. + +=cut + +sub _increment_column { + my( $self, $column, $amount ) = @_; + warn "$me increment_column called: $column, $amount\n" if $DEBUG; + return '' unless $amount; + my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') } $self->ncancelled_pkgs; @@ -826,7 +968,8 @@ sub increment_seconds { ' ('. $svc_acct->email. ")\n" if $DEBUG > 1; - $svc_acct->increment_seconds($seconds); + $column = "increment_$column"; + $svc_acct->$column($amount); } @@ -922,7 +1065,7 @@ sub reexport { } -=item delete NEW_CUSTNUM +=item delete [ OPTION => VALUE ... ] This deletes the customer. If there is an error, returns the error, otherwise returns false. @@ -932,18 +1075,20 @@ what you want when a customer cancels service; for that, cancel all of the customer's packages (see L). If the customer has any uncancelled packages, you need to pass a new (valid) -customer number for those packages to be transferred to. Cancelled packages -will be deleted. Did I mention that this is NOT what you want when a customer -cancels service and that you really should be looking see L? +customer number for those packages to be transferred to, as the "new_customer" +option. Cancelled packages will be deleted. Did I mention that this is NOT +what you want when a customer cancels service and that you really should be +looking at L? You can't delete a customer with invoices (see L), -or credits (see L), payments (see L) or -refunds (see L). +statements (see L), credits (see L), +payments (see L) or refunds (see L), unless you +set the "delete_financials" option to a true value. =cut sub delete { - my $self = shift; + my( $self, %opt ) = @_; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -956,26 +1101,47 @@ sub delete { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - if ( $self->cust_bill ) { - $dbh->rollback if $oldAutoCommit; - return "Can't delete a customer with invoices"; - } - if ( $self->cust_credit ) { - $dbh->rollback if $oldAutoCommit; - return "Can't delete a customer with credits"; + if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) { + $dbh->rollback if $oldAutoCommit; + return "Can't delete a master agent customer"; } - if ( $self->cust_pay ) { - $dbh->rollback if $oldAutoCommit; - return "Can't delete a customer with payments"; + + #use FS::access_user + if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) { + $dbh->rollback if $oldAutoCommit; + return "Can't delete a master employee customer"; } - if ( $self->cust_refund ) { - $dbh->rollback if $oldAutoCommit; - return "Can't delete a customer with refunds"; + + tie my %financial_tables, 'Tie::IxHash', + 'cust_bill' => 'invoices', + 'cust_statement' => 'statements', + 'cust_credit' => 'credits', + 'cust_pay' => 'payments', + 'cust_refund' => 'refunds', + ; + + foreach my $table ( keys %financial_tables ) { + + my @records = $self->$table(); + + if ( @records && ! $opt{'delete_financials'} ) { + $dbh->rollback if $oldAutoCommit; + return "Can't delete a customer with ". $financial_tables{$table}; + } + + foreach my $record ( @records ) { + my $error = $record->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error deleting ". $financial_tables{$table}. ": $error\n"; + } + } + } my @cust_pkg = $self->ncancelled_pkgs; if ( @cust_pkg ) { - my $new_custnum = shift; + my $new_custnum = $opt{'new_custnum'}; unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) { $dbh->rollback if $oldAutoCommit; return "Invalid new customer number: $new_custnum"; @@ -984,7 +1150,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; @@ -1000,32 +1168,334 @@ sub delete { } } - foreach my $cust_main_invoice ( #(email invoice destinations, not invoices) - qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } ) - ) { - my $error = $cust_main_invoice->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; + #cust_tax_adjustment in financials? + #cust_pay_pending? ouch + #cust_recon? + foreach my $table (qw( + cust_main_invoice cust_main_exemption cust_tag cust_attachment contact + cust_location cust_main_note cust_tax_adjustment + cust_pay_void cust_pay_batch queue cust_tax_exempt + )) { + foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) { + my $error = $record->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } } } + my $sth = $dbh->prepare( + 'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?' + ) or do { + my $errstr = $dbh->errstr; + $dbh->rollback if $oldAutoCommit; + return $errstr; + }; + $sth->execute($self->custnum) or do { + my $errstr = $sth->errstr; + $dbh->rollback if $oldAutoCommit; + return $errstr; + }; + + #tickets + + my $ticket_dbh = ''; + if ($conf->config('ticket_system') eq 'RT_Internal') { + $ticket_dbh = $dbh; + } elsif ($conf->config('ticket_system') eq 'RT_External') { + my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc'); + $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 }); + #or die "RT_External DBI->connect error: $DBI::errstr\n"; + } + + if ( $ticket_dbh ) { + + my $ticket_sth = $ticket_dbh->prepare( + 'DELETE FROM Links WHERE Target = ?' + ) or do { + my $errstr = $ticket_dbh->errstr; + $dbh->rollback if $oldAutoCommit; + return $errstr; + }; + $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum) + or do { + my $errstr = $ticket_sth->errstr; + $dbh->rollback if $oldAutoCommit; + return $errstr; + }; + + #check and see if the customer is the only link on the ticket, and + #if so, set the ticket to deleted status in RT? + #maybe someday, for now this will at least fix tickets not displaying + + } + + #delete the customer record + my $error = $self->SUPER::delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } + # cust_main exports! + + #my $export_args = $options{'export_args'} || []; + + my @part_export = + map qsearch( 'part_export', {exportnum=>$_} ), + $conf->config('cust_main-exports'); #, $agentnum + + foreach my $part_export ( @part_export ) { + my $error = $part_export->export_delete( $self ); #, @$export_args); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "exporting to ". $part_export->exporttype. + " (transaction rolled back): $error"; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + +=item merge NEW_CUSTNUM [ , OPTION => VALUE ... ] + +This merges this customer into the provided new custnum, and then deletes the +customer. If there is an error, returns the error, otherwise returns false. + +The source customer's name, company name, phone numbers, agent, +referring customer, customer class, advertising source, order taker, and +billing information (except balance) are discarded. + +All packages are moved to the target customer. Packages with package locations +are preserved. Packages without package locations are moved to a new package +location with the source customer's service/shipping address. + +All invoices, statements, payments, credits and refunds are moved to the target +customer. The source customer's balance is added to the target customer. + +All notes, attachments, tickets and customer tags are moved to the target +customer. + +Change history is not currently moved. + +=cut + +sub merge { + my( $self, $new_custnum, %opt ) = @_; + + return "Can't merge a customer into self" if $self->custnum == $new_custnum; + + my $new_cust_main = qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) + or return "Invalid new customer number: $new_custnum"; + + return 'Access denied: "Merge customer across agents" access right required to merge into a customer of a different agent' + if $self->agentnum != $new_cust_main->agentnum + && ! $FS::CurrentUser::CurrentUser->access_right('Merge customer across agents'); + + 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; + + if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) { + $dbh->rollback if $oldAutoCommit; + return "Can't merge a master agent customer"; + } + + #use FS::access_user + if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) { + $dbh->rollback if $oldAutoCommit; + return "Can't merge a master employee customer"; + } + + if ( qsearch('cust_pay_pending', { 'custnum' => $self->custnum, + 'status' => { op=>'!=', value=>'done' }, + } + ) + ) { + $dbh->rollback if $oldAutoCommit; + return "Can't merge a customer with pending payments"; + } + + tie my %financial_tables, 'Tie::IxHash', + 'cust_bill' => 'invoices', + 'cust_bill_void' => 'voided invoices', + 'cust_statement' => 'statements', + 'cust_credit' => 'credits', + 'cust_credit_void' => 'voided credits', + 'cust_pay' => 'payments', + 'cust_pay_void' => 'voided payments', + 'cust_refund' => 'refunds', + ; + + foreach my $table ( keys %financial_tables ) { + + my @records = $self->$table(); + + foreach my $record ( @records ) { + $record->custnum($new_custnum); + my $error = $record->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error merging ". $financial_tables{$table}. ": $error\n"; + } + } + + } + + my $name = $self->ship_name; #? + + my $locationnum = ''; + foreach my $cust_pkg ( $self->all_pkgs ) { + $cust_pkg->custnum($new_custnum); + + unless ( $cust_pkg->locationnum ) { + unless ( $locationnum ) { + my $cust_location = new FS::cust_location { + $self->location_hash, + 'custnum' => $new_custnum, + }; + my $error = $cust_location->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + $locationnum = $cust_location->locationnum; + } + $cust_pkg->locationnum($locationnum); + } + + my $error = $cust_pkg->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + # add customer (ship) name to svc_phone.phone_name if blank + my @cust_svc = $cust_pkg->cust_svc; + foreach my $cust_svc (@cust_svc) { + my($label, $value, $svcdb) = $cust_svc->label; + next unless $svcdb eq 'svc_phone'; + my $svc_phone = $cust_svc->svc_x; + next if $svc_phone->phone_name; + $svc_phone->phone_name($name); + my $error = $svc_phone->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + } + + #not considered: + # cust_tax_exempt (texas tax exemptions) + # cust_recon (some sort of not-well understood thing for OnPac) + + #these are moved over + foreach my $table (qw( + cust_tag cust_location contact cust_attachment cust_main_note + cust_tax_adjustment cust_pay_batch queue + )) { + foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) { + $record->custnum($new_custnum); + my $error = $record->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + } + + #these aren't preserved + foreach my $table (qw( + cust_main_exemption cust_main_invoice + )) { + foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) { + my $error = $record->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + } + + + my $sth = $dbh->prepare( + 'UPDATE cust_main SET referral_custnum = ? WHERE referral_custnum = ?' + ) or do { + my $errstr = $dbh->errstr; + $dbh->rollback if $oldAutoCommit; + return $errstr; + }; + $sth->execute($new_custnum, $self->custnum) or do { + my $errstr = $sth->errstr; + $dbh->rollback if $oldAutoCommit; + return $errstr; + }; + + #tickets + + my $ticket_dbh = ''; + if ($conf->config('ticket_system') eq 'RT_Internal') { + $ticket_dbh = $dbh; + } elsif ($conf->config('ticket_system') eq 'RT_External') { + my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc'); + $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 }); + #or die "RT_External DBI->connect error: $DBI::errstr\n"; + } + + if ( $ticket_dbh ) { + + my $ticket_sth = $ticket_dbh->prepare( + 'UPDATE Links SET Target = ? WHERE Target = ?' + ) or do { + my $errstr = $ticket_dbh->errstr; + $dbh->rollback if $oldAutoCommit; + return $errstr; + }; + $ticket_sth->execute('freeside://freeside/cust_main/'.$new_custnum, + 'freeside://freeside/cust_main/'.$self->custnum) + or do { + my $errstr = $ticket_sth->errstr; + $dbh->rollback if $oldAutoCommit; + return $errstr; + }; + + } + + #delete the customer record + + my $error = $self->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } -=item replace OLD_RECORD [ INVOICING_LIST_ARYREF ] +=item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ] Replaces the OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. +To change the customer's address, set the pseudo-fields C and +C. The address will still only change if at least one of the +address fields differs from the existing values. + INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will be set as the invoicing list (see L<"invoicing_list">). Errors return as expected and rollback the entire transaction; it is not necessary to call @@ -1033,31 +1503,25 @@ check_invoicing_list first. Here's an example: $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] ); +Currently available options are: I. + +The I option can be set to an arrayref of tax names or a hashref +of tax names and exemption numbers. FS::cust_main_exemption records will be +deleted and inserted as appropriate. + =cut sub replace { my $self = shift; - my $old = shift; - my @param = @_; - warn "$me replace called\n" - if $DEBUG; - 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 $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') ) + ? shift + : $self->replace_old; - # If the mask is blank then try to set it - if we can... - if (!defined($self->getfield('paymask')) || $self->getfield('paymask') eq '') { - $self->paymask($self->payinfo); - } + my @param = @_; - # We absolutely have to have an old vs. new record to make this work. - if (!defined($old)) { - $old = qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); - } + warn "$me replace called\n" + if $DEBUG; my $curuser = $FS::CurrentUser::CurrentUser; if ( $self->payby eq 'COMP' @@ -1071,12 +1535,71 @@ sub replace { local($ignore_expired_card) = 1 if $old->payby =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/ - && $old->payinfo eq $self->payinfo; + && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask ); + + local($ignore_banned_card) = 1 + if ( $old->payby =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/ + || $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 + && $conf->exists('cust_main-require_locale'); + + 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; + for my $l (qw(bill_location ship_location)) { + my $old_loc = $old->$l; + my $new_loc = $self->$l; + + # find the existing location if there is one + $new_loc->set('custnum' => $self->custnum); + my $error = $new_loc->find_or_insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + $self->set($l.'num', $new_loc->locationnum); + } #for $l + + # replace the customer record my $error = $self->SUPER::replace($old); if ( $error ) { @@ -1084,7 +1607,28 @@ sub replace { return $error; } - if ( @param ) { # INVOICING_LIST_ARYREF + # now move packages to the new service location + $self->set('ship_location', ''); #flush cache + if ( $old->ship_locationnum and # should only be null during upgrade... + $old->ship_locationnum != $self->ship_locationnum ) { + $error = $old->ship_location->move_to($self->ship_location); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + # don't move packages based on the billing location, but + # disable it if it's no longer in use + if ( $old->bill_locationnum and + $old->bill_locationnum != $self->bill_locationnum ) { + $error = $old->bill_location->disable_if_unused; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF my $invoicing_list = shift @param; $error = $self->check_invoicing_list( $invoicing_list ); if ( $error ) { @@ -1094,8 +1638,81 @@ sub replace { $self->invoicing_list( $invoicing_list ); } - if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ && - grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) { + if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident + + #this could be more efficient than deleting and re-inserting, if it matters + foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) { + my $error = $cust_tag->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + foreach my $tagnum ( @{ $self->tagnum || [] } ) { + my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum, + 'custnum' => $self->custnum }; + my $error = $cust_tag->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + } + + my %options = @param; + + my $tax_exemption = delete $options{'tax_exemption'}; + if ( $tax_exemption ) { + + $tax_exemption = { map { $_ => '' } @$tax_exemption } + if ref($tax_exemption) eq 'ARRAY'; + + my %cust_main_exemption = + map { $_->taxname => $_ } + qsearch('cust_main_exemption', { 'custnum' => $old->custnum } ); + + foreach my $taxname ( keys %$tax_exemption ) { + + if ( $cust_main_exemption{$taxname} && + $cust_main_exemption{$taxname}->exempt_number eq $tax_exemption->{$taxname} + ) + { + delete $cust_main_exemption{$taxname}; + next; + } + + my $cust_main_exemption = new FS::cust_main_exemption { + 'custnum' => $self->custnum, + 'taxname' => $taxname, + 'exempt_number' => $tax_exemption->{$taxname}, + }; + my $error = $cust_main_exemption->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "inserting cust_main_exemption (transaction rolled back): $error"; + } + } + + foreach my $cust_main_exemption ( values %cust_main_exemption ) { + my $error = $cust_main_exemption->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "deleting cust_main_exemption (transaction rolled back): $error"; + } + } + + } + + if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ + && ( ( $self->get('payinfo') ne $old->get('payinfo') + && $self->get('payinfo') !~ /^99\d{14}$/ + ) + || grep { $self->get($_) ne $old->get($_) } qw(paydate payname) + ) + ) + { + # card/check/lec info has changed, want to retry realtime_ invoice events my $error = $self->retry_realtime; if ( $error ) { @@ -1112,6 +1729,25 @@ sub replace { } } + # tax district update in cust_location + + # cust_main exports! + + my $export_args = $options{'export_args'} || []; + + my @part_export = + map qsearch( 'part_export', {exportnum=>$_} ), + $conf->config('cust_main-exports'); #, $agentnum + + foreach my $part_export ( @part_export ) { + my $error = $part_export->export_replace( $self, $old, @$export_args); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "exporting to ". $part_export->exporttype. + " (transaction rolled back): $error"; + } + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -1123,6 +1759,7 @@ Used by insert & replace to update the fuzzy search cache =cut +use FS::cust_main::Search; sub queue_fuzzyfiles_update { my $self = shift; @@ -1137,20 +1774,26 @@ sub queue_fuzzyfiles_update { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; - my $error = $queue->insert( map $self->getfield($_), - qw(first last company) - ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; + foreach my $field ( 'first', 'last', 'company', 'ship_company' ) { + my $queue = new FS::queue { + 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield' + }; + my @args = "cust_main.$field", $self->get($field); + my $error = $queue->insert( @args ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } } - if ( $self->ship_last ) { - $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; - $error = $queue->insert( map $self->getfield("ship_$_"), - qw(first last company) - ); + my @locations = $self->bill_location; + push @locations, $self->ship_location if $self->has_ship_address; + foreach my $location (@locations) { + my $queue = new FS::queue { + 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield' + }; + my @args = 'cust_location.address1', $location->address1; + my $error = $queue->insert( @args ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "queueing job (transaction rolled back): $error"; @@ -1181,18 +1824,46 @@ sub check { || $self->ut_number('agentnum') || $self->ut_textn('agent_custid') || $self->ut_number('refnum') + || $self->ut_foreign_key('bill_locationnum', 'cust_location','locationnum') + || $self->ut_foreign_key('ship_locationnum', 'cust_location','locationnum') + || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum') + || $self->ut_foreign_keyn('salesnum', 'sales', 'salesnum') + || $self->ut_textn('custbatch') || $self->ut_name('last') || $self->ut_name('first') + || $self->ut_snumbern('signupdate') + || $self->ut_snumbern('birthdate') + || $self->ut_namen('spouse_last') + || $self->ut_namen('spouse_first') + || $self->ut_snumbern('spouse_birthdate') + || $self->ut_snumbern('anniversary_date') || $self->ut_textn('company') - || $self->ut_text('address1') - || $self->ut_textn('address2') - || $self->ut_text('city') - || $self->ut_textn('county') - || $self->ut_textn('state') - || $self->ut_country('country') + || $self->ut_textn('ship_company') || $self->ut_anything('comments') || $self->ut_numbern('referral_custnum') + || $self->ut_textn('stateid') + || $self->ut_textn('stateid_state') + || $self->ut_textn('invoice_terms') + || $self->ut_floatn('cdr_termination_percentage') + || $self->ut_floatn('credit_limit') + || $self->ut_numbern('billday') + || $self->ut_numbern('prorate_day') + || $self->ut_flag('edit_subject') + || $self->ut_flag('calling_list_exempt') + || $self->ut_flag('invoice_noemail') + || $self->ut_flag('message_noemail') + || $self->ut_enum('locale', [ '', FS::Locales->locales ]) + || $self->ut_flag('invoice_ship_address') ; + + foreach (qw(company ship_company)) { + my $company = $self->get($_); + $company =~ s/^\s+//; + $company =~ s/\s+$//; + $company =~ s/\s+/ /g; + $self->set($_, $company); + } + #barf. need message catalogs. i18n. etc. $error .= "Please select an advertising source." if $error =~ /^Illegal or empty \(numeric\) refnum: /; @@ -1218,91 +1889,51 @@ sub check { $self->ss("$1-$2-$3"); } + #turn off invoice_ship_address if ship & bill are the same + if ($self->bill_locationnum eq $self->ship_locationnum) { + $self->invoice_ship_address(''); + } -# bad idea to disable, causes billing to fail because of no tax rates later -# unless ( $import ) { - unless ( qsearch('cust_main_county', { - 'country' => $self->country, - 'state' => '', - } ) ) { - return "Unknown state/county/country: ". - $self->state. "/". $self->county. "/". $self->country - unless qsearch('cust_main_county',{ - 'state' => $self->state, - 'county' => $self->county, - 'country' => $self->country, - } ); - } -# } + # cust_main_county verification now handled by cust_location check $error = - $self->ut_phonen('daytime', $self->country) - || $self->ut_phonen('night', $self->country) - || $self->ut_phonen('fax', $self->country) - || $self->ut_zip('zip', $self->country) + $self->ut_phonen('daytime', $self->country) + || $self->ut_phonen('night', $self->country) + || $self->ut_phonen('fax', $self->country) + || $self->ut_phonen('mobile', $self->country) ; return $error if $error; - my @addfields = qw( - last first company address1 address2 city county state zip - country daytime night fax - ); + if ( $conf->exists('cust_main-require_phone', $self->agentnum) + && ! $import + && ! length($self->daytime) && ! length($self->night) && ! length($self->mobile) + ) { - if ( defined $self->dbdef_table->column('ship_last') ) { - if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") } - @addfields ) - && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields ) - ) - { - my $error = - $self->ut_name('ship_last') - || $self->ut_name('ship_first') - || $self->ut_textn('ship_company') - || $self->ut_text('ship_address1') - || $self->ut_textn('ship_address2') - || $self->ut_text('ship_city') - || $self->ut_textn('ship_county') - || $self->ut_textn('ship_state') - || $self->ut_country('ship_country') - ; - return $error if $error; + my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/ + ? 'Day Phone' + : FS::Msgcat::_gettext('daytime'); + my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/ + ? 'Night Phone' + : FS::Msgcat::_gettext('night'); - #false laziness with above - unless ( qsearchs('cust_main_county', { - 'country' => $self->ship_country, - 'state' => '', - } ) ) { - return "Unknown ship_state/ship_county/ship_country: ". - $self->ship_state. "/". $self->ship_county. "/". $self->ship_country - unless qsearch('cust_main_county',{ - 'state' => $self->ship_state, - 'county' => $self->ship_county, - 'country' => $self->ship_country, - } ); - } - #eofalse - - $error = - $self->ut_phonen('ship_daytime', $self->ship_country) - || $self->ut_phonen('ship_night', $self->ship_country) - || $self->ut_phonen('ship_fax', $self->ship_country) - || $self->ut_zip('ship_zip', $self->ship_country) - ; - return $error if $error; + my $mobile_label = FS::Msgcat::_gettext('mobile') =~ /^(mobile)?$/ + ? 'Mobile Phone' + : FS::Msgcat::_gettext('mobile'); - } else { # ship_ info eq billing info, so don't store dup info in database - $self->setfield("ship_$_", '') - foreach qw( last first company address1 address2 city county state zip - country daytime night fax ); - } + return "$daytime_label, $night_label or $mobile_label is required" + } - $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/ + #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/ + # or return "Illegal payby: ". $self->payby; + #$self->payby($1); + FS::payby->can_payby($self->table, $self->payby) or return "Illegal payby: ". $self->payby; $error = $self->ut_numbern('paystart_month') || $self->ut_numbern('paystart_year') || $self->ut_numbern('payissue') + || $self->ut_textn('paytype') ; return $error if $error; @@ -1315,20 +1946,15 @@ sub check { # If it is encrypted and the private key is not availaible then we can't # check the credit card. + my $check_payinfo = ! $self->is_encrypted($self->payinfo); - my $check_payinfo = 1; - - if ($self->is_encrypted($self->payinfo)) { - $check_payinfo = 0; - } - - $self->payby($1); - - if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) { + # Need some kind of global flag to accept invalid cards, for testing + # on scrubbed data. + if ( !$import && $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) { my $payinfo = $self->payinfo; $payinfo =~ s/\D//g; - $payinfo =~ /^(\d{13,16})$/ + $payinfo =~ /^(\d{13,16}|\d{8,9})$/ or return gettext('invalid_card'); # . ": ". $self->payinfo; $payinfo = $1; $self->payinfo($payinfo); @@ -1336,30 +1962,40 @@ sub check { or return gettext('invalid_card'); # . ": ". $self->payinfo; return gettext('unknown_card_type') - if cardtype($self->payinfo) eq "Unknown"; - - my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref); - if ( $ban ) { - return 'Banned credit card: banned on '. - time2str('%a %h %o at %r', $ban->_date). - ' by '. $ban->otaker. - ' (ban# '. $ban->bannum. ')'; - } - - if ( defined $self->dbdef_table->column('paycvv') ) { - if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) { - if ( cardtype($self->payinfo) eq 'American Express card' ) { - $self->paycvv =~ /^(\d{4})$/ - or return "CVV2 (CID) for American Express cards is four digits."; - $self->paycvv($1); + if $self->payinfo !~ /^99\d{14}$/ #token + && cardtype($self->payinfo) eq "Unknown"; + + unless ( $ignore_banned_card ) { + my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } ); + if ( $ban ) { + if ( $ban->bantype eq 'warn' ) { + #or others depending on value of $ban->reason ? + return '_duplicate_card'. + ': disabled from'. time2str('%a %h %o at %r', $ban->_date). + ' until '. time2str('%a %h %o at %r', $ban->_end_date). + ' (ban# '. $ban->bannum. ')' + unless $self->override_ban_warn; } else { - $self->paycvv =~ /^(\d{3})$/ - or return "CVV2 (CVC2/CID) is three digits."; - $self->paycvv($1); + return 'Banned credit card: banned on '. + time2str('%a %h %o at %r', $ban->_date). + ' by '. $ban->otaker. + ' (ban# '. $ban->bannum. ')'; } + } + } + + if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) { + if ( cardtype($self->payinfo) eq 'American Express card' ) { + $self->paycvv =~ /^(\d{4})$/ + or return "CVV2 (CID) for American Express cards is four digits."; + $self->paycvv($1); } else { - $self->paycvv(''); + $self->paycvv =~ /^(\d{3})$/ + or return "CVV2 (CVC2/CID) is three digits."; + $self->paycvv($1); } + } else { + $self->paycvv(''); } my $cardtype = cardtype($payinfo); @@ -1389,23 +2025,34 @@ sub check { } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) { my $payinfo = $self->payinfo; - $payinfo =~ s/[^\d\@]//g; - if ( $conf->exists('echeck-nonus') ) { - $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba'; + $payinfo =~ s/[^\d\@\.]//g; + if ( $conf->config('echeck-country') eq 'CA' ) { + $payinfo =~ /^(\d+)\@(\d{5})\.(\d{3})$/ + or return 'invalid echeck account@branch.bank'; + $payinfo = "$1\@$2.$3"; + } elsif ( $conf->config('echeck-country') eq 'US' ) { + $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba'; $payinfo = "$1\@$2"; } else { - $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba'; + $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@routing'; $payinfo = "$1\@$2"; } $self->payinfo($payinfo); - $self->paycvv('') if $self->dbdef_table->column('paycvv'); - - my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref); - if ( $ban ) { - return 'Banned ACH account: banned on '. - time2str('%a %h %o at %r', $ban->_date). - ' by '. $ban->otaker. - ' (ban# '. $ban->bannum. ')'; + $self->paycvv(''); + + unless ( $ignore_banned_card ) { + my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } ); + if ( $ban ) { + if ( $ban->bantype eq 'warn' ) { + #or others depending on value of $ban->reason ? + return '_duplicate_ach' unless $self->override_ban_warn; + } else { + return 'Banned ACH account: banned on '. + time2str('%a %h %o at %r', $ban->_date). + ' by '. $ban->otaker. + ' (ban# '. $ban->bannum. ')'; + } + } } } elsif ( $self->payby eq 'LECB' ) { @@ -1415,13 +2062,13 @@ sub check { $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number'; $payinfo = $1; $self->payinfo($payinfo); - $self->paycvv('') if $self->dbdef_table->column('paycvv'); + $self->paycvv(''); } elsif ( $self->payby eq 'BILL' ) { $error = $self->ut_textn('payinfo'); return "Illegal P.O. number: ". $self->payinfo if $error; - $self->paycvv('') if $self->dbdef_table->column('paycvv'); + $self->paycvv(''); } elsif ( $self->payby eq 'COMP' ) { @@ -1435,7 +2082,7 @@ sub check { $error = $self->ut_textn('payinfo'); return "Illegal comp account issuer: ". $self->payinfo if $error; - $self->paycvv('') if $self->dbdef_table->column('paycvv'); + $self->paycvv(''); } elsif ( $self->payby eq 'PREPAY' ) { @@ -1446,23 +2093,27 @@ sub check { return "Illegal prepayment identifier: ". $self->payinfo if $error; return "Unknown prepayment identifier" unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } ); - $self->paycvv('') if $self->dbdef_table->column('paycvv'); + $self->paycvv(''); } if ( $self->paydate eq '' || $self->paydate eq '-' ) { return "Expiration date required" - unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/; + # shouldn't payinfo_check do this? + unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD|PPAL)$/; $self->paydate(''); } else { 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"); my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900; return gettext('expired_card') @@ -1477,17 +2128,30 @@ sub check { ) { $self->payname( $self->first. " ". $self->getfield('last') ); } else { - $self->payname =~ /^([\w \,\.\-\'\&]+)$/ - or return gettext('illegal_name'). " payname: ". $self->payname; - $self->payname($1); + + if ( $self->payby =~ /^(CHEK|DCHK)$/ ) { + $self->payname =~ /^([\w \,\.\-\']*)$/ + or return gettext('illegal_name'). " payname: ". $self->payname; + $self->payname($1); + } else { + $self->payname =~ /^([\w \,\.\-\'\&]*)$/ + or return gettext('illegal_name'). " payname: ". $self->payname; + $self->payname($1); + } + } - foreach my $flag (qw( tax spool_cdr )) { + return "Please select an invoicing locale" + if ! $self->locale + && ! $self->custnum + && $conf->exists('cust_main-require_locale'); + + 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); } - $self->otaker(getotaker) unless $self->otaker; + $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum; warn "$me check AFTER: \n". $self->_dump if $DEBUG > 2; @@ -1495,114 +2159,127 @@ sub check { $self->SUPER::check; } -=item all_pkgs +sub check_payinfo_cardtype { + my $self = shift; + + return '' unless $self->payby =~ /^(CARD|DCRD)$/; -Returns all packages (see L) for this customer. + my $payinfo = $self->payinfo; + $payinfo =~ s/\D//g; -=cut + 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}; + + ''; -sub all_pkgs { - my $self = shift; - if ( $self->{'_pkgnum'} ) { - values %{ $self->{'_pkgnum'}->cache }; - } else { - qsearch( 'cust_pkg', { 'custnum' => $self->custnum }); - } } -=item ncancelled_pkgs +=item replace_check -Returns all non-cancelled packages (see L) for this customer. +Additional checks for replace only. =cut -sub ncancelled_pkgs { - my $self = shift; - if ( $self->{'_pkgnum'} ) { - grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache }; - } else { - @{ [ # force list context - qsearch( 'cust_pkg', { - 'custnum' => $self->custnum, - 'cancel' => '', - }), - qsearch( 'cust_pkg', { - 'custnum' => $self->custnum, - 'cancel' => 0, - }), - ] }; +sub replace_check { + my ($new,$old) = @_; + #preserve old value if global config is set + if ($old && $conf->exists('invoice-ship_address')) { + $new->invoice_ship_address($old->invoice_ship_address); } + return ''; } -=item suspended_pkgs +=item addr_fields -Returns all suspended packages (see L) for this customer. +Returns a list of fields which have ship_ duplicates. =cut -sub suspended_pkgs { - my $self = shift; - grep { $_->susp } $self->ncancelled_pkgs; +sub addr_fields { + qw( last first company + locationname + address1 address2 city county state zip country + latitude longitude + daytime night fax mobile + ); } -=item unflagged_suspended_pkgs +=item has_ship_address -Returns all unflagged suspended packages (see L) for this -customer (thouse packages without the `manual_flag' set). +Returns true if this customer record has a separate shipping address. =cut -sub unflagged_suspended_pkgs { +sub has_ship_address { my $self = shift; - return $self->suspended_pkgs - unless dbdef->table('cust_pkg')->column('manual_flag'); - grep { ! $_->manual_flag } $self->suspended_pkgs; + $self->bill_locationnum != $self->ship_locationnum; } -=item unsuspended_pkgs +=item location_hash -Returns all unsuspended (and uncancelled) packages (see L) for -this customer. +Returns a list of key/value pairs, with the following keys: address1, +adddress2, city, county, state, zip, country, district, and geocode. The +shipping address is used if present. =cut -sub unsuspended_pkgs { +sub location_hash { my $self = shift; - grep { ! $_->susp } $self->ncancelled_pkgs; + $self->ship_location->location_hash; } -=item num_cancelled_pkgs +=item cust_location -Returns the number of cancelled packages (see L) for this -customer. +Returns all locations (see L) for this customer. =cut -sub num_cancelled_pkgs { +sub cust_location { my $self = shift; - $self->num_pkgs("cancel IS NOT NULL AND cust_pkg.cancel != 0"); + qsearch('cust_location', { 'custnum' => $self->custnum, + 'prospectnum' => '' } ); } -sub num_pkgs { - my( $self, $sql ) = @_; - my $sth = dbh->prepare( - "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? AND $sql" - ) or die dbh->errstr; - $sth->execute($self->custnum) or die $sth->errstr; - $sth->fetchrow_arrayref->[0]; +=item cust_contact + +Returns all contacts (see L) for this customer. + +=cut + +#already used :/ sub contact { +sub cust_contact { + my $self = shift; + qsearch('contact', { 'custnum' => $self->custnum } ); } =item unsuspend Unsuspends all unflagged suspended packages (see L -and L) for this customer. Always returns a list: an empty list -on success or a list of errors. +and L) for this customer, except those on hold. + +Returns a list: an empty list on success or a list of errors. =cut sub unsuspend { my $self = shift; - grep { $_->unsuspend } $self->suspended_pkgs; + grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs; +} + +=item release_hold + +Unsuspends all suspended packages in the on-hold state (those without setup +dates) for this customer. + +=cut + +sub release_hold { + my $self = shift; + grep { (!$_->setup) && $_->unsuspend } $self->suspended_pkgs; } =item suspend @@ -1615,13 +2292,23 @@ Returns a list: an empty list on success or a list of errors. sub suspend { my $self = shift; - grep { $_->suspend } $self->unsuspended_pkgs; + grep { $_->suspend(@_) } $self->unsuspended_pkgs; } -=item suspend_if_pkgpart PKGPART [ , PKGPART ... ] +=item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ] Suspends all unsuspended packages (see L) matching the listed -PKGPARTs (see L). +PKGPARTs (see L). Preferred usage is to pass a hashref instead +of a list of pkgparts; the hashref has the following keys: + +=over 4 + +=item pkgparts - listref of pkgparts + +=item (other options are passed to the suspend method) + +=back + Returns a list: an empty list on success or a list of errors. @@ -1629,16 +2316,31 @@ Returns a list: an empty list on success or a list of errors. sub suspend_if_pkgpart { my $self = shift; - my @pkgparts = @_; - grep { $_->suspend } + my (@pkgparts, %opt); + if (ref($_[0]) eq 'HASH'){ + @pkgparts = @{$_[0]{pkgparts}}; + %opt = %{$_[0]}; + }else{ + @pkgparts = @_; + } + grep { $_->suspend(%opt) } grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts } $self->unsuspended_pkgs; } -=item suspend_unless_pkgpart PKGPART [ , PKGPART ... ] +=item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ] Suspends all unsuspended packages (see L) unless they match the -listed PKGPARTs (see L). +given PKGPARTs (see L). Preferred usage is to pass a hashref +instead of a list of pkgparts; the hashref has the following keys: + +=over 4 + +=item pkgparts - listref of pkgparts + +=item (other options are passed to the suspend method) + +=back Returns a list: an empty list on success or a list of errors. @@ -1646,8 +2348,14 @@ Returns a list: an empty list on success or a list of errors. sub suspend_unless_pkgpart { my $self = shift; - my @pkgparts = @_; - grep { $_->suspend } + my (@pkgparts, %opt); + if (ref($_[0]) eq 'HASH'){ + @pkgparts = @{$_[0]{pkgparts}}; + %opt = %{$_[0]}; + }else{ + @pkgparts = @_; + } + grep { $_->suspend(%opt) } grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts } $self->unsuspended_pkgs; } @@ -1655,15 +2363,9 @@ 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: I, I, and I - -I can be set true to supress email cancellation notices. - -# I can be set to a cancellation reason (see L) - -I can be set true to ban this customer's credit card or ACH information, -if present. +=back Always returns a list: an empty list on success or a list of errors. @@ -1672,6 +2374,52 @@ Always returns a list: an empty list on success or a list of errors. 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 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. + +=cut + +sub cancel_pkgs { + my( $self, %opt ) = @_; + + # 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'); if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) { @@ -1680,13 +2428,76 @@ sub cancel { return ( "Can't (yet) ban encrypted credit cards" ) if $self->is_encrypted($self->payinfo); - my $ban = new FS::banned_pay $self->_banned_pay_hashref; + 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 = @{ 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, + '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(@pkgs) ." package(s) for customer ". + $self->custnum. "\n" + if $DEBUG; + my @cprs; + if ($opt{'cust_pkg_reason'}) { + @cprs = @{ delete $opt{'cust_pkg_reason'} }; + } + foreach (@pkgs) { + my %lopt = %opt; + if (@cprs) { + my $cpr = shift @cprs; + $lopt{'reason'} = $cpr->reasonnum; + $lopt{'reason_otaker'} = $cpr->otaker; + } + my $error = $_->cancel(%lopt); + push @errors, 'pkgnum '.$_->pkgnum.': '.$error if $error; } - grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs; + return @errors; } sub _banned_pay_hashref { @@ -1701,11 +2512,35 @@ sub _banned_pay_hashref { { 'payby' => $payby2ban{$self->payby}, - 'payinfo' => md5_base64($self->payinfo), - #'reason' => + 'payinfo' => $self->payinfo, + #don't ever *search* on reason! #'reason' => }; } +sub _new_banned_pay_hashref { + my $self = shift; + my $hr = $self->_banned_pay_hashref; + $hr->{payinfo} = md5_base64($hr->{payinfo}); + $hr; +} + +=item notes + +Returns all notes (see L) for this customer. + +=cut + +sub notes { + my($self,$orderby_classnum) = (shift,shift); + my $orderby = "sticky DESC, _date DESC"; + $orderby = "classnum ASC, $orderby" if $orderby_classnum; + qsearch( 'cust_main_note', + { 'custnum' => $self->custnum }, + '', + "ORDER BY $orderby", + ); +} + =item agent Returns the agent (see L) for this customer. @@ -1717,1629 +2552,749 @@ sub agent { qsearchs( 'agent', { 'agentnum' => $self->agentnum } ); } -=item bill OPTIONS +=item agent_name -Generates invoices (see L) for this customer. Usually used in -conjunction with the collect method. +Returns the agent name (see L) for this customer. -Options are passed as name-value pairs. +=cut + +sub agent_name { + my $self = shift; + $self->agent->agent; +} -Currently available options are: +=item cust_tag -resetup - if set true, re-charges setup fees. +Returns any tags associated with this customer, as FS::cust_tag objects, +or an empty list if there are no tags. -time - bills the customer as if it were that time. Specified as a UNIX -timestamp; see L). Also see L and -L for conversion functions. For example: +=cut - use Date::Parse; - ... - $cust_main->bill( 'time' => str2time('April 20th, 2001') ); +sub cust_tag { + my $self = shift; + qsearch('cust_tag', { 'custnum' => $self->custnum } ); +} +=item part_tag -If there is an error, returns the error, otherwise returns false. +Returns any tags associated with this customer, as FS::part_tag objects, +or an empty list if there are no tags. =cut -sub bill { - my( $self, %options ) = @_; - return '' if $self->payby eq 'COMP'; - warn "$me bill customer ". $self->custnum. "\n" - if $DEBUG; +sub part_tag { + my $self = shift; + map $_->part_tag, $self->cust_tag; +} - my $time = $options{'time'} || time; - my $error; +=item cust_class - #put below somehow? - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; +Returns the customer class, as an FS::cust_class object, or the empty string +if there is no customer class. - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; +=cut - $self->select_for_update; #mutex +sub cust_class { + my $self = shift; + if ( $self->classnum ) { + qsearchs('cust_class', { 'classnum' => $self->classnum } ); + } else { + return ''; + } +} - #create a new invoice - #(we'll remove it later if it doesn't actually need to be generated [contains - # no line items] and we're inside a transaciton so nothing else will see it) - my $cust_bill = new FS::cust_bill ( { - 'custnum' => $self->custnum, - '_date' => $time, - #'charged' => $charged, - 'charged' => 0, - } ); - $error = $cust_bill->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "can't create invoice for customer #". $self->custnum. ": $error"; - } - my $invnum = $cust_bill->invnum; +=item categoryname - ### - # find the packages which are due for billing, find out how much they are - # & generate invoice database. - ### +Returns the customer category name, or the empty string if there is no customer +category. - my( $total_setup, $total_recur ) = ( 0, 0 ); - my %tax; - my @precommit_hooks = (); +=cut - foreach my $cust_pkg ( - qsearch('cust_pkg', { 'custnum' => $self->custnum } ) - ) { +sub categoryname { + my $self = shift; + my $cust_class = $self->cust_class; + $cust_class + ? $cust_class->categoryname + : ''; +} - #NO!! next if $cust_pkg->cancel; - next if $cust_pkg->getfield('cancel'); +=item classname - warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1; +Returns the customer class name, or the empty string if there is no customer +class. - #? to avoid use of uninitialized value errors... ? - $cust_pkg->setfield('bill', '') - unless defined($cust_pkg->bill); - - my $part_pkg = $cust_pkg->part_pkg; +=cut - my %hash = $cust_pkg->hash; - my $old_cust_pkg = new FS::cust_pkg \%hash; +sub classname { + my $self = shift; + my $cust_class = $self->cust_class; + $cust_class + ? $cust_class->classname + : ''; +} - my @details = (); +=item BILLING METHODS - ### - # bill setup - ### +Documentation on billing methods has been moved to +L. - my $setup = 0; - if ( !$cust_pkg->setup || $options{'resetup'} ) { - - warn " bill setup\n" if $DEBUG > 1; +=item REALTIME BILLING METHODS - $setup = eval { $cust_pkg->calc_setup( $time ) }; - if ( $@ ) { - $dbh->rollback if $oldAutoCommit; - return "$@ running calc_setup for $cust_pkg\n"; - } +Documentation on realtime billing methods has been moved to +L. - $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup; - } +=item remove_cvv - ### - # bill recurring fee - ### +Removes the I field from the database directly. - my $recur = 0; - my $sdate; - if ( $part_pkg->getfield('freq') ne '0' && - ! $cust_pkg->getfield('susp') && - ( $cust_pkg->getfield('bill') || 0 ) <= $time - ) { +If there is an error, returns the error, otherwise returns false. - warn " bill recur\n" if $DEBUG > 1; +=cut - # XXX shared with $recur_prog - $sdate = $cust_pkg->bill || $cust_pkg->setup || $time; +sub remove_cvv { + my $self = shift; + my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?") + or return dbh->errstr; + $sth->execute($self->custnum) + or return $sth->errstr; + $self->paycvv(''); + ''; +} - #over two params! lets at least switch to a hashref for the rest... - my %param = ( 'precommit_hooks' => \@precommit_hooks, ); +=item batch_card OPTION => VALUE... - $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) }; - if ( $@ ) { - $dbh->rollback if $oldAutoCommit; - return "$@ running calc_recur for $cust_pkg\n"; - } +Adds a payment for this invoice to the pending credit card batch (see +L), or, if the B option is set to a true value, +runs the payment using a realtime gateway. - #change this bit to use Date::Manip? CAREFUL with timezones (see - # mailing list archive) - my ($sec,$min,$hour,$mday,$mon,$year) = - (localtime($sdate) )[0,1,2,3,4,5]; - - #pro-rating magic - if $recur_prog fiddles $sdate, want to use that - # only for figuring next bill date, nothing else, so, reset $sdate again - # here - $sdate = $cust_pkg->bill || $cust_pkg->setup || $time; - $cust_pkg->last_bill($sdate) - if $cust_pkg->dbdef_table->column('last_bill'); - - if ( $part_pkg->freq =~ /^\d+$/ ) { - $mon += $part_pkg->freq; - until ( $mon < 12 ) { $mon -= 12; $year++; } - } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) { - my $weeks = $1; - $mday += $weeks * 7; - } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) { - my $days = $1; - $mday += $days; - } elsif ( $part_pkg->freq =~ /^(\d+)h$/ ) { - my $hours = $1; - $hour += $hours; - } else { - $dbh->rollback if $oldAutoCommit; - return "unparsable frequency: ". $part_pkg->freq; - } - $cust_pkg->setfield('bill', - timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year)); - } +Options may include: - warn "\$setup is undefined" unless defined($setup); - warn "\$recur is undefined" unless defined($recur); - warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill); +B: the amount to be paid; defaults to the customer's balance minus +any payments in transit. - ### - # If $cust_pkg has been modified, update it and create cust_bill_pkg records - ### +B: the payment method; defaults to cust_main.payby - if ( $cust_pkg->modified ) { +B: runs this as a realtime payment instead of adding it to a +batch. Deprecated. - warn " package ". $cust_pkg->pkgnum. " modified; updating\n" - if $DEBUG >1; +B: sets cust_pay_batch.invnum. - $error=$cust_pkg->replace($old_cust_pkg); - if ( $error ) { #just in case - $dbh->rollback if $oldAutoCommit; - return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"; - } +B, B, B, B, B, B: sets +the billing address for the payment; defaults to the customer's billing +location. - $setup = sprintf( "%.2f", $setup ); - $recur = sprintf( "%.2f", $recur ); - if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) { - $dbh->rollback if $oldAutoCommit; - return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum; - } - if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) { - $dbh->rollback if $oldAutoCommit; - return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum; - } +B, B, B: sets the payment account, expiration +date, and name; defaults to those fields in cust_main. - if ( $setup != 0 || $recur != 0 ) { - - warn " charges (setup=$setup, recur=$recur); adding line items\n" - if $DEBUG > 1; - my $cust_bill_pkg = new FS::cust_bill_pkg ({ - 'invnum' => $invnum, - 'pkgnum' => $cust_pkg->pkgnum, - 'setup' => $setup, - 'recur' => $recur, - 'sdate' => $sdate, - 'edate' => $cust_pkg->bill, - 'details' => \@details, - }); - $error = $cust_bill_pkg->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "can't create invoice line item for invoice #$invnum: $error"; - } - $total_setup += $setup; - $total_recur += $recur; - - ### - # handle taxes - ### - - unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) { - - my $prefix = - ( $conf->exists('tax-ship_address') && length($self->ship_last) ) - ? 'ship_' - : ''; - my %taxhash = map { $_ => $self->get("$prefix$_") } - qw( state county country ); - - $taxhash{'taxclass'} = $part_pkg->taxclass; - - my @taxes = qsearch( 'cust_main_county', \%taxhash ); - - unless ( @taxes ) { - $taxhash{'taxclass'} = ''; - @taxes = qsearch( 'cust_main_county', \%taxhash ); - } - - #one more try at a whole-country tax rate - unless ( @taxes ) { - $taxhash{$_} = '' foreach qw( state county ); - @taxes = qsearch( 'cust_main_county', \%taxhash ); - } - - # maybe eliminate this entirely, along with all the 0% records - unless ( @taxes ) { - $dbh->rollback if $oldAutoCommit; - return - "fatal: can't find tax rate for state/county/country/taxclass ". - join('/', ( map $self->get("$prefix$_"), - qw(state county country) - ), - $part_pkg->taxclass ). "\n"; - } - - foreach my $tax ( @taxes ) { - - my $taxable_charged = 0; - $taxable_charged += $setup - unless $part_pkg->setuptax =~ /^Y$/i - || $tax->setuptax =~ /^Y$/i; - $taxable_charged += $recur - unless $part_pkg->recurtax =~ /^Y$/i - || $tax->recurtax =~ /^Y$/i; - next unless $taxable_charged; - - if ( $tax->exempt_amount && $tax->exempt_amount > 0 ) { - #my ($mon,$year) = (localtime($sdate) )[4,5]; - my ($mon,$year) = (localtime( $sdate || $cust_bill->_date ) )[4,5]; - $mon++; - my $freq = $part_pkg->freq || 1; - if ( $freq !~ /(\d+)$/ ) { - $dbh->rollback if $oldAutoCommit; - return "daily/weekly package definitions not (yet?)". - " compatible with monthly tax exemptions"; - } - my $taxable_per_month = - sprintf("%.2f", $taxable_charged / $freq ); - - #call the whole thing off if this customer has any old - #exemption records... - my @cust_tax_exempt = - qsearch( 'cust_tax_exempt' => { custnum=> $self->custnum } ); - if ( @cust_tax_exempt ) { - $dbh->rollback if $oldAutoCommit; - return - 'this customer still has old-style tax exemption records; '. - 'run bin/fs-migrate-cust_tax_exempt?'; - } - - foreach my $which_month ( 1 .. $freq ) { - - #maintain the new exemption table now - my $sql = " - SELECT SUM(amount) - FROM cust_tax_exempt_pkg - LEFT JOIN cust_bill_pkg USING ( billpkgnum ) - LEFT JOIN cust_bill USING ( invnum ) - WHERE custnum = ? - AND taxnum = ? - AND year = ? - AND month = ? - "; - my $sth = dbh->prepare($sql) or do { - $dbh->rollback if $oldAutoCommit; - return "fatal: can't lookup exising exemption: ". dbh->errstr; - }; - $sth->execute( - $self->custnum, - $tax->taxnum, - 1900+$year, - $mon, - ) or do { - $dbh->rollback if $oldAutoCommit; - return "fatal: can't lookup exising exemption: ". dbh->errstr; - }; - my $existing_exemption = $sth->fetchrow_arrayref->[0] || 0; - - my $remaining_exemption = - $tax->exempt_amount - $existing_exemption; - if ( $remaining_exemption > 0 ) { - my $addl = $remaining_exemption > $taxable_per_month - ? $taxable_per_month - : $remaining_exemption; - $taxable_charged -= $addl; - - my $cust_tax_exempt_pkg = new FS::cust_tax_exempt_pkg ( { - 'billpkgnum' => $cust_bill_pkg->billpkgnum, - 'taxnum' => $tax->taxnum, - 'year' => 1900+$year, - 'month' => $mon, - 'amount' => sprintf("%.2f", $addl ), - } ); - $error = $cust_tax_exempt_pkg->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "fatal: can't insert cust_tax_exempt_pkg: $error"; - } - } # if $remaining_exemption > 0 - - #++ - $mon++; - #until ( $mon < 12 ) { $mon -= 12; $year++; } - until ( $mon < 13 ) { $mon -= 12; $year++; } - - } #foreach $which_month +=cut + +sub batch_card { + my ($self, %options) = @_; + + my $amount; + if (exists($options{amount})) { + $amount = $options{amount}; + }else{ + $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments); + } + if ($amount <= 0) { + warn(sprintf("Customer balance %.2f - in transit amount %.2f is <= 0.\n", + $self->balance, + $self->in_transit_payments + )); + return; + } - } #if $tax->exempt_amount + my $invnum = delete $options{invnum}; + my $payby = $options{payby} || $self->payby; #still dubious + + if ($options{'realtime'}) { + return $self->realtime_bop( FS::payby->payby2bop($self->payby), + $amount, + %options, + ); + } - $taxable_charged = sprintf( "%.2f", $taxable_charged); + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; - #$tax += $taxable_charged * $cust_main_county->tax / 100 - $tax{ $tax->taxname || 'Tax' } += - $taxable_charged * $tax->tax / 100 + #this needs to handle mysql as well as Pg, like svc_acct.pm + #(make it into a common function if folks need to do batching with mysql) + $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE") + or return "Cannot lock pay_batch: " . $dbh->errstr; - } #foreach my $tax ( @taxes ) + my %pay_batch = ( + 'status' => 'O', + 'payby' => FS::payby->payby2payment($payby), + ); + $pay_batch{agentnum} = $self->agentnum if $conf->exists('batch-spoolagent'); - } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP' + my $pay_batch = qsearchs( 'pay_batch', \%pay_batch ); - } #if $setup != 0 || $recur != 0 - - } #if $cust_pkg->modified + unless ( $pay_batch ) { + $pay_batch = new FS::pay_batch \%pay_batch; + my $error = $pay_batch->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + die "error creating new batch: $error\n"; + } + } - } #foreach my $cust_pkg + my $old_cust_pay_batch = qsearchs('cust_pay_batch', { + 'batchnum' => $pay_batch->batchnum, + 'custnum' => $self->custnum, + } ); - unless ( $cust_bill->cust_bill_pkg ) { - $cust_bill->delete; #don't create an invoice w/o line items - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - return ''; + foreach (qw( address1 address2 city state zip country latitude longitude + payby payinfo paydate payname )) + { + $options{$_} = '' unless exists($options{$_}); } - my $charged = sprintf( "%.2f", $total_setup + $total_recur ); + my $loc = $self->bill_location; - foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) { - my $tax = sprintf("%.2f", $tax{$taxname} ); - $charged = sprintf( "%.2f", $charged+$tax ); + my $cust_pay_batch = new FS::cust_pay_batch ( { + 'batchnum' => $pay_batch->batchnum, + 'invnum' => $invnum || 0, # is there a better value? + # this field should be + # removed... + # cust_bill_pay_batch now + 'custnum' => $self->custnum, + 'last' => $self->getfield('last'), + 'first' => $self->getfield('first'), + 'address1' => $options{address1} || $loc->address1, + 'address2' => $options{address2} || $loc->address2, + 'city' => $options{city} || $loc->city, + 'state' => $options{state} || $loc->state, + 'zip' => $options{zip} || $loc->zip, + 'country' => $options{country} || $loc->country, + 'payby' => $options{payby} || $self->payby, + 'payinfo' => $options{payinfo} || $self->payinfo, + 'exp' => $options{paydate} || $self->paydate, + 'payname' => $options{payname} || $self->payname, + 'amount' => $amount, # consolidating + } ); - my $cust_bill_pkg = new FS::cust_bill_pkg ({ - 'invnum' => $invnum, - 'pkgnum' => 0, - 'setup' => $tax, - 'recur' => 0, - 'sdate' => '', - 'edate' => '', - 'itemdesc' => $taxname, - }); - $error = $cust_bill_pkg->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "can't create invoice line item for invoice #$invnum: $error"; - } - $total_setup += $tax; + $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum) + if $old_cust_pay_batch; + my $error; + if ($old_cust_pay_batch) { + $error = $cust_pay_batch->replace($old_cust_pay_batch) + } else { + $error = $cust_pay_batch->insert; } - $cust_bill->charged( sprintf( "%.2f", $total_setup + $total_recur ) ); - $error = $cust_bill->replace; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "can't update charged for invoice #$invnum: $error"; + die $error; } - foreach my $hook ( @precommit_hooks ) { - eval { - &{$hook}; #($self) ? + my $unapplied = $self->total_unapplied_credits + + $self->total_unapplied_payments + + $self->in_transit_payments; + foreach my $cust_bill ($self->open_cust_bill) { + #$dbh->commit or die $dbh->errstr if $oldAutoCommit; + my $cust_bill_pay_batch = new FS::cust_bill_pay_batch { + 'invnum' => $cust_bill->invnum, + 'paybatchnum' => $cust_pay_batch->paybatchnum, + 'amount' => $cust_bill->owed, + '_date' => time, }; - if ( $@ ) { + if ($unapplied >= $cust_bill_pay_batch->amount){ + $unapplied -= $cust_bill_pay_batch->amount; + next; + }else{ + $cust_bill_pay_batch->amount(sprintf ( "%.2f", + $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0; + } + $error = $cust_bill_pay_batch->insert; + if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "$@ running precommit hook $hook\n"; + die $error; } } - + $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; #no error + ''; } -=item collect OPTIONS +=item total_owed -(Attempt to) collect money for this customer's outstanding invoices (see -L). Usually used after the bill method. +Returns the total owed for this customer on all invoices +(see L). -Depending on the value of `payby', this may print or email an invoice (I, -I, or I), charge a credit card (I), charge via electronic -check/ACH (I), or just add any necessary (pseudo-)payment (I). +=cut -Most actions are now triggered by invoice events; see L -and the invoice events web interface. +sub total_owed { + my $self = shift; + $self->total_owed_date(2145859200); #12/31/2037 +} -If there is an error, returns the error, otherwise returns false. +=item total_owed_date TIME -Options are passed as name-value pairs. +Returns the total owed for this customer on all invoices with date earlier than +TIME. TIME is specified as a UNIX timestamp; see L). Also +see L and L for conversion functions. -Currently available options are: +=cut -invoice_time - Use this time when deciding when to print invoices and -late notices on those invoices. The default is now. It is specified as a UNIX timestamp; see L). Also see L and L -for conversion functions. +sub total_owed_date { + my $self = shift; + my $time = shift; -retry - Retry card/echeck/LEC transactions even when not scheduled by invoice -events. + my $custnum = $self->custnum; -quiet - set true to surpress email card/ACH decline notices. + my $owed_sql = FS::cust_bill->owed_sql; -freq - "1d" for the traditional, daily events (the default), or "1m" for the -new monthly events + my $sql = " + SELECT SUM($owed_sql) FROM cust_bill + WHERE custnum = $custnum + AND _date <= $time + "; -payby - allows for one time override of normal customer billing method + sprintf( "%.2f", $self->scalar_sql($sql) || 0 ); -=cut +} -sub collect { - my( $self, %options ) = @_; - my $invoice_time = $options{'invoice_time'} || time; +=item total_owed_pkgnum PKGNUM - #put below somehow? - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; +Returns the total owed on all invoices for this customer's specific package +when using experimental package balances (see L). - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - $self->select_for_update; #mutex - - my $balance = $self->balance; - warn "$me collect customer ". $self->custnum. ": balance $balance\n" - if $DEBUG; - unless ( $balance > 0 ) { #redundant????? - $dbh->rollback if $oldAutoCommit; #hmm - return ''; - } - - if ( exists($options{'retry_card'}) ) { - carp 'retry_card option passed to collect is deprecated; use retry'; - $options{'retry'} ||= $options{'retry_card'}; - } - if ( exists($options{'retry'}) && $options{'retry'} ) { - my $error = $self->retry_realtime; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - my $extra_sql = ''; - if ( defined $options{'freq'} && $options{'freq'} eq '1m' ) { - $extra_sql = " AND freq = '1m' "; - } else { - $extra_sql = " AND ( freq = '1d' OR freq IS NULL OR freq = '' ) "; - } - - foreach my $cust_bill ( $self->open_cust_bill ) { - - # don't try to charge for the same invoice if it's already in a batch - #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } ); - - last if $self->balance <= 0; - - warn " invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")\n" - if $DEBUG > 1; - - foreach my $part_bill_event ( - sort { $a->seconds <=> $b->seconds - || $a->weight <=> $b->weight - || $a->eventpart <=> $b->eventpart } - grep { $_->seconds <= ( $invoice_time - $cust_bill->_date ) - && ! qsearch( 'cust_bill_event', { - 'invnum' => $cust_bill->invnum, - 'eventpart' => $_->eventpart, - 'status' => 'done', - } ) - } - qsearch( { - 'table' => 'part_bill_event', - 'hashref' => { 'payby' => (exists($options{'payby'}) - ? $options{'payby'} - : $self->payby - ), - 'disabled' => '', }, - 'extra_sql' => $extra_sql, - } ) - ) { - - last if $cust_bill->owed <= 0 # don't run subsequent events if owed<=0 - || $self->balance <= 0; # or if balance<=0 - - warn " calling invoice event (". $part_bill_event->eventcode. ")\n" - if $DEBUG > 1; - my $cust_main = $self; #for callback - - my $error; - { - local $realtime_bop_decline_quiet = 1 if $options{'quiet'}; - local $SIG{__DIE__}; # don't want Mason __DIE__ handler active - $error = eval $part_bill_event->eventcode; - } - - my $status = ''; - my $statustext = ''; - if ( $@ ) { - $status = 'failed'; - $statustext = $@; - } elsif ( $error ) { - $status = 'done'; - $statustext = $error; - } else { - $status = 'done' - } - - #add cust_bill_event - my $cust_bill_event = new FS::cust_bill_event { - 'invnum' => $cust_bill->invnum, - 'eventpart' => $part_bill_event->eventpart, - #'_date' => $invoice_time, - '_date' => time, - 'status' => $status, - 'statustext' => $statustext, - }; - $error = $cust_bill_event->insert; - if ( $error ) { - #$dbh->rollback if $oldAutoCommit; - #return "error: $error"; - - # gah, even with transactions. - $dbh->commit if $oldAutoCommit; #well. - my $e = 'WARNING: Event run but database not updated - '. - 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum. - ', eventpart '. $part_bill_event->eventpart. - ": $error"; - warn $e; - return $e; - } - - - } - - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; +=cut +sub total_owed_pkgnum { + my( $self, $pkgnum ) = @_; + $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037 } -=item retry_realtime - -Schedules realtime credit card / electronic check / LEC billing events for -for retry. Useful if card information has changed or manual retry is desired. -The 'collect' method must be called to actually retry the transaction. +=item total_owed_date_pkgnum TIME PKGNUM -Implementation details: For each of this customer's open invoices, changes -the status of the first "done" (with statustext error) realtime processing -event to "failed". +Returns the total owed for this customer's specific package when using +experimental package balances on all invoices with date earlier than +TIME. TIME is specified as a UNIX timestamp; see L). Also +see L and L for conversion functions. =cut -sub retry_realtime { - my $self = shift; - - 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; +sub total_owed_date_pkgnum { + my( $self, $time, $pkgnum ) = @_; + my $total_bill = 0; foreach my $cust_bill ( - grep { $_->cust_bill_event } - $self->open_cust_bill + grep { $_->_date <= $time } + qsearch('cust_bill', { 'custnum' => $self->custnum, } ) ) { - my @cust_bill_event = - sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds } - grep { - #$_->part_bill_event->plan eq 'realtime-card' - $_->part_bill_event->eventcode =~ - /\$cust_bill\->realtime_(card|ach|lec)/ - && $_->status eq 'done' - && $_->statustext - } - $cust_bill->cust_bill_event; - next unless @cust_bill_event; - my $error = $cust_bill_event[0]->retry; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error scheduling invoice event for retry: $error"; - } - + $total_bill += $cust_bill->owed_pkgnum($pkgnum); } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; + sprintf( "%.2f", $total_bill ); } -=item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ] - -Runs a realtime credit card, ACH (electronic check) or phone bill transaction -via a Business::OnlinePayment realtime gateway. See -L for supported gateways. +=item total_paid -Available methods are: I, I and I +Returns the total amount of all payments. -Available options are: I, I, I +=cut -The additional options I, I, I, I, I, -I, I and I are also available. Any of these options, -if set, will override the value from the customer record. +sub total_paid { + my $self = shift; + my $total = 0; + $total += $_->paid foreach $self->cust_pay; + sprintf( "%.2f", $total ); +} -I is a free-text field passed to the gateway. It defaults to -"Internet services". +=item total_unapplied_credits -If an I is specified, this payment (if successful) is applied to the -specified invoice. If you don't specify an I you might want to -call the B method. +Returns the total outstanding credit (see L) for this +customer. See L. -I can be set true to surpress email decline notices. +=item total_credited -(moved from cust_bill) (probably should get realtime_{card,ach,lec} here too) +Old name for total_unapplied_credits. Don't use. =cut -sub realtime_bop { - my( $self, $method, $amount, %options ) = @_; - if ( $DEBUG ) { - warn "$me realtime_bop: $method $amount\n"; - warn " $_ => $options{$_}\n" foreach keys %options; - } - - $options{'description'} ||= 'Internet services'; - - eval "use Business::OnlinePayment"; - die $@ if $@; +sub total_credited { + #carp "total_credited deprecated, use total_unapplied_credits"; + shift->total_unapplied_credits(@_); +} - my $payinfo = exists($options{'payinfo'}) - ? $options{'payinfo'} - : $self->payinfo; - - ### - # select a gateway - ### - - my $taxclass = ''; - if ( $options{'invnum'} ) { - my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } ); - die "invnum ". $options{'invnum'}. " not found" unless $cust_bill; - my @taxclasses = - map { $_->part_pkg->taxclass } - grep { $_ } - map { $_->cust_pkg } - $cust_bill->cust_bill_pkg; - unless ( grep { $taxclasses[0] ne $_ } @taxclasses ) { #unless there are - #different taxclasses - $taxclass = $taxclasses[0]; - } - } +sub total_unapplied_credits { + my $self = shift; - #look for an agent gateway override first - my $cardtype; - if ( $method eq 'CC' ) { - $cardtype = cardtype($payinfo); - } elsif ( $method eq 'ECHECK' ) { - $cardtype = 'ACH'; - } else { - $cardtype = $method; - } - - my $override = - qsearchs('agent_payment_gateway', { agentnum => $self->agentnum, - cardtype => $cardtype, - taxclass => $taxclass, } ) - || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum, - cardtype => '', - taxclass => $taxclass, } ) - || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum, - cardtype => $cardtype, - taxclass => '', } ) - || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum, - cardtype => '', - taxclass => '', } ); - - my $payment_gateway = ''; - my( $processor, $login, $password, $action, @bop_options ); - if ( $override ) { #use a payment gateway override - - $payment_gateway = $override->payment_gateway; - - $processor = $payment_gateway->gateway_module; - $login = $payment_gateway->gateway_username; - $password = $payment_gateway->gateway_password; - $action = $payment_gateway->gateway_action; - @bop_options = $payment_gateway->options; - - } else { #use the standard settings from the config - - ( $processor, $login, $password, $action, @bop_options ) = - $self->default_payment_gateway($method); - - } - - ### - # massage data - ### - - my $address = exists($options{'address1'}) - ? $options{'address1'} - : $self->address1; - my $address2 = exists($options{'address2'}) - ? $options{'address2'} - : $self->address2; - $address .= ", ". $address2 if length($address2); - - my $o_payname = exists($options{'payname'}) - ? $options{'payname'} - : $self->payname; - my($payname, $payfirst, $paylast); - if ( $o_payname && $method ne 'ECHECK' ) { - ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/ - or return "Illegal payname $payname"; - ($payfirst, $paylast) = ($1, $2); - } else { - $payfirst = $self->getfield('first'); - $paylast = $self->getfield('last'); - $payname = "$payfirst $paylast"; - } - - my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list; - if ( $conf->exists('emailinvoiceauto') - || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) { - push @invoicing_list, $self->all_emails; - } - - my $email = ($conf->exists('business-onlinepayment-email-override')) - ? $conf->config('business-onlinepayment-email-override') - : $invoicing_list[0]; - - my %content = (); - - my $payip = exists($options{'payip'}) - ? $options{'payip'} - : $self->payip; - $content{customer_ip} = $payip - if length($payip); - - if ( $method eq 'CC' ) { - - $content{card_number} = $payinfo; - my $paydate = exists($options{'paydate'}) - ? $options{'paydate'} - : $self->paydate; - $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; - $content{expiration} = "$2/$1"; - - my $paycvv = exists($options{'paycvv'}) - ? $options{'paycvv'} - : $self->paycvv; - $content{cvv2} = $self->paycvv - if length($paycvv); - - my $paystart_month = exists($options{'paystart_month'}) - ? $options{'paystart_month'} - : $self->paystart_month; - - my $paystart_year = exists($options{'paystart_year'}) - ? $options{'paystart_year'} - : $self->paystart_year; - - $content{card_start} = "$paystart_month/$paystart_year" - if $paystart_month && $paystart_year; - - my $payissue = exists($options{'payissue'}) - ? $options{'payissue'} - : $self->payissue; - $content{issue_number} = $payissue if $payissue; - - $content{recurring_billing} = 'YES' - if qsearch('cust_pay', { 'custnum' => $self->custnum, - 'payby' => 'CARD', - 'payinfo' => $payinfo, - } ); - - } elsif ( $method eq 'ECHECK' ) { - ( $content{account_number}, $content{routing_code} ) = - split('@', $payinfo); - $content{bank_name} = $o_payname; - $content{account_type} = 'CHECKING'; - $content{account_name} = $payname; - $content{customer_org} = $self->company ? 'B' : 'I'; - $content{customer_ssn} = exists($options{'ss'}) - ? $options{'ss'} - : $self->ss; - } elsif ( $method eq 'LEC' ) { - $content{phone} = $payinfo; - } - - ### - # run transaction(s) - ### - - my( $action1, $action2 ) = split(/\s*\,\s*/, $action ); - - my $transaction = new Business::OnlinePayment( $processor, @bop_options ); - $transaction->content( - 'type' => $method, - 'login' => $login, - 'password' => $password, - 'action' => $action1, - 'description' => $options{'description'}, - 'amount' => $amount, - 'invoice_number' => $options{'invnum'}, - 'customer_id' => $self->custnum, - 'last_name' => $paylast, - 'first_name' => $payfirst, - 'name' => $payname, - 'address' => $address, - 'city' => ( exists($options{'city'}) - ? $options{'city'} - : $self->city ), - 'state' => ( exists($options{'state'}) - ? $options{'state'} - : $self->state ), - 'zip' => ( exists($options{'zip'}) - ? $options{'zip'} - : $self->zip ), - 'country' => ( exists($options{'country'}) - ? $options{'country'} - : $self->country ), - 'referer' => 'http://cleanwhisker.420.am/', - 'email' => $email, - 'phone' => $self->daytime || $self->night, - %content, #after - ); - $transaction->submit(); - - if ( $transaction->is_success() && $action2 ) { - my $auth = $transaction->authorization; - my $ordernum = $transaction->can('order_number') - ? $transaction->order_number - : ''; - - my $capture = - new Business::OnlinePayment( $processor, @bop_options ); - - my %capture = ( - %content, - type => $method, - action => $action2, - login => $login, - password => $password, - order_number => $ordernum, - amount => $amount, - authorization => $auth, - description => $options{'description'}, - ); + my $custnum = $self->custnum; - foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code - transaction_sequence_num local_transaction_date - local_transaction_time AVS_result_code )) { - $capture{$field} = $transaction->$field() if $transaction->can($field); - } + my $unapplied_sql = FS::cust_credit->unapplied_sql; - $capture->content( %capture ); + my $sql = " + SELECT SUM($unapplied_sql) FROM cust_credit + WHERE custnum = $custnum + "; - $capture->submit(); + sprintf( "%.2f", $self->scalar_sql($sql) || 0 ); - unless ( $capture->is_success ) { - my $e = "Authorization successful but capture failed, custnum #". - $self->custnum. ': '. $capture->result_code. - ": ". $capture->error_message; - warn $e; - return $e; - } +} - } +=item total_unapplied_credits_pkgnum PKGNUM - ### - # remove paycvv after initial transaction - ### +Returns the total outstanding credit (see L) for this +customer. See L. - #false laziness w/misc/process/payment.cgi - check both to make sure working - # correctly - if ( defined $self->dbdef_table->column('paycvv') - && length($self->paycvv) - && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save') - ) { - my $error = $self->remove_cvv; - if ( $error ) { - warn "WARNING: error removing cvv: $error\n"; - } - } +=cut - ### - # result handling - ### +sub total_unapplied_credits_pkgnum { + my( $self, $pkgnum ) = @_; + my $total_credit = 0; + $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum); + sprintf( "%.2f", $total_credit ); +} - if ( $transaction->is_success() ) { - my %method2payby = ( - 'CC' => 'CARD', - 'ECHECK' => 'CHEK', - 'LEC' => 'LECB', - ); +=item total_unapplied_payments - my $paybatch = ''; - if ( $payment_gateway ) { # agent override - $paybatch = $payment_gateway->gatewaynum. '-'; - } +Returns the total unapplied payments (see L) for this customer. +See L. - $paybatch .= "$processor:". $transaction->authorization; +=cut - $paybatch .= ':'. $transaction->order_number - if $transaction->can('order_number') - && length($transaction->order_number); +sub total_unapplied_payments { + my $self = shift; - my $cust_pay = new FS::cust_pay ( { - 'custnum' => $self->custnum, - 'invnum' => $options{'invnum'}, - 'paid' => $amount, - '_date' => '', - 'payby' => $method2payby{$method}, - 'payinfo' => $payinfo, - 'paybatch' => $paybatch, - } ); - my $error = $cust_pay->insert; - if ( $error ) { - $cust_pay->invnum(''); #try again with no specific invnum - my $error2 = $cust_pay->insert; - if ( $error2 ) { - # gah, even with transactions. - my $e = 'WARNING: Card/ACH debited but database not updated - '. - "error inserting payment ($processor): $error2". - " (previously tried insert with invnum #$options{'invnum'}" . - ": $error )"; - warn $e; - return $e; - } - } - return ''; #no error + my $custnum = $self->custnum; - } else { + my $unapplied_sql = FS::cust_pay->unapplied_sql; - my $perror = "$processor error: ". $transaction->error_message; - - if ( !$options{'quiet'} && !$realtime_bop_decline_quiet - && $conf->exists('emaildecline') - && grep { $_ ne 'POST' } $self->invoicing_list - && ! grep { $transaction->error_message =~ /$_/ } - $conf->config('emaildecline-exclude') - ) { - my @templ = $conf->config('declinetemplate'); - my $template = new Text::Template ( - TYPE => 'ARRAY', - SOURCE => [ map "$_\n", @templ ], - ) or return "($perror) can't create template: $Text::Template::ERROR"; - $template->compile() - or return "($perror) can't compile template: $Text::Template::ERROR"; - - my $templ_hash = { error => $transaction->error_message }; - - my $error = send_email( - 'from' => $conf->config('invoice_from'), - 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ], - 'subject' => 'Your payment could not be processed', - 'body' => [ $template->fill_in(HASH => $templ_hash) ], - ); - - $perror .= " (also received error sending decline notification: $error)" - if $error; + my $sql = " + SELECT SUM($unapplied_sql) FROM cust_pay + WHERE custnum = $custnum + "; - } - - return $perror; - } + sprintf( "%.2f", $self->scalar_sql($sql) || 0 ); } -=item default_payment_gateway +=item total_unapplied_payments_pkgnum PKGNUM -=cut - -sub default_payment_gateway { - my( $self, $method ) = @_; - - die "Real-time processing not enabled\n" - unless $conf->exists('business-onlinepayment'); +Returns the total unapplied payments (see L) for this customer's +specific package when using experimental package balances. See +L. - #load up config - my $bop_config = 'business-onlinepayment'; - $bop_config .= '-ach' - if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach'); - my ( $processor, $login, $password, $action, @bop_options ) = - $conf->config($bop_config); - $action ||= 'normal authorization'; - pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/; - die "No real-time processor is enabled - ". - "did you set the business-onlinepayment configuration value?\n" - unless $processor; +=cut - ( $processor, $login, $password, $action, @bop_options ) +sub total_unapplied_payments_pkgnum { + my( $self, $pkgnum ) = @_; + my $total_unapplied = 0; + $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum); + sprintf( "%.2f", $total_unapplied ); } -=item remove_cvv -Removes the I field from the database directly. +=item total_unapplied_refunds -If there is an error, returns the error, otherwise returns false. +Returns the total unrefunded refunds (see L) for this +customer. See L. =cut -sub remove_cvv { +sub total_unapplied_refunds { my $self = shift; - my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?") - or return dbh->errstr; - $sth->execute($self->custnum) - or return $sth->errstr; - $self->paycvv(''); - ''; -} - -=item realtime_refund_bop METHOD [ OPTION => VALUE ... ] - -Refunds a realtime credit card, ACH (electronic check) or phone bill transaction -via a Business::OnlinePayment realtime gateway. See -L for supported gateways. + my $custnum = $self->custnum; -Available methods are: I, I and I + my $unapplied_sql = FS::cust_refund->unapplied_sql; -Available options are: I, I, I - -Most gateways require a reference to an original payment transaction to refund, -so you probably need to specify a I. - -I defaults to the original amount of the payment if not specified. + my $sql = " + SELECT SUM($unapplied_sql) FROM cust_refund + WHERE custnum = $custnum + "; -I specifies a reason for the refund. + sprintf( "%.2f", $self->scalar_sql($sql) || 0 ); -Implementation note: If I is unspecified or equal to the amount of the -orignal payment, first an attempt is made to "void" the transaction via -the gateway (to cancel a not-yet settled transaction) and then if that fails, -the normal attempt is made to "refund" ("credit") the transaction via the -gateway is attempted. +} -#The additional options I, I, I, I, I, -#I, I and I are also available. Any of these options, -#if set, will override the value from the customer record. +=item balance -#If an I is specified, this payment (if successful) is applied to the -#specified invoice. If you don't specify an I you might want to -#call the B method. +Returns the balance for this customer (total_owed plus total_unrefunded, minus +total_unapplied_credits minus total_unapplied_payments). =cut -#some false laziness w/realtime_bop, not enough to make it worth merging -#but some useful small subs should be pulled out -sub realtime_refund_bop { - my( $self, $method, %options ) = @_; - if ( $DEBUG ) { - warn "$me realtime_refund_bop: $method refund\n"; - warn " $_ => $options{$_}\n" foreach keys %options; - } - - eval "use Business::OnlinePayment"; - die $@ if $@; - - ### - # look up the original payment and optionally a gateway for that payment - ### - - my $cust_pay = ''; - my $amount = $options{'amount'}; - - my( $processor, $login, $password, @bop_options ) ; - my( $auth, $order_number ) = ( '', '', '' ); - - if ( $options{'paynum'} ) { - - warn " paynum: $options{paynum}\n" if $DEBUG > 1; - $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } ) - or return "Unknown paynum $options{'paynum'}"; - $amount ||= $cust_pay->paid; - - $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-]*)(:([\w\-]+))?$/ - or return "Can't parse paybatch for paynum $options{'paynum'}: ". - $cust_pay->paybatch; - my $gatewaynum = ''; - ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 ); - - if ( $gatewaynum ) { #gateway for the payment to be refunded - - my $payment_gateway = - qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } ); - die "payment gateway $gatewaynum not found" - unless $payment_gateway; +sub balance { + my $self = shift; + $self->balance_date_range; +} - $processor = $payment_gateway->gateway_module; - $login = $payment_gateway->gateway_username; - $password = $payment_gateway->gateway_password; - @bop_options = $payment_gateway->options; +=item balance_date TIME - } else { #try the default gateway +Returns the balance for this customer, only considering invoices with date +earlier than TIME (total_owed_date minus total_credited minus +total_unapplied_payments). TIME is specified as a UNIX timestamp; see +L). Also see L and L for conversion +functions. - my( $conf_processor, $unused_action ); - ( $conf_processor, $login, $password, $unused_action, @bop_options ) = - $self->default_payment_gateway($method); +=cut - return "processor of payment $options{'paynum'} $processor does not". - " match default processor $conf_processor" - unless $processor eq $conf_processor; +sub balance_date { + my $self = shift; + $self->balance_date_range(shift); +} - } +=item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ] +Returns the balance for this customer, optionally considering invoices with +date earlier than START_TIME, and not later than END_TIME +(total_owed_date minus total_unapplied_credits minus total_unapplied_payments). - } else { # didn't specify a paynum, so look for agent gateway overrides - # like a normal transaction +Times are specified as SQL fragments or numeric +UNIX timestamps; see L). Also see L and +L for conversion functions. The empty string can be passed +to disable that time constraint completely. - my $cardtype; - if ( $method eq 'CC' ) { - $cardtype = cardtype($self->payinfo); - } elsif ( $method eq 'ECHECK' ) { - $cardtype = 'ACH'; - } else { - $cardtype = $method; - } - my $override = - qsearchs('agent_payment_gateway', { agentnum => $self->agentnum, - cardtype => $cardtype, - taxclass => '', } ) - || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum, - cardtype => '', - taxclass => '', } ); - - if ( $override ) { #use a payment gateway override - - my $payment_gateway = $override->payment_gateway; - - $processor = $payment_gateway->gateway_module; - $login = $payment_gateway->gateway_username; - $password = $payment_gateway->gateway_password; - #$action = $payment_gateway->gateway_action; - @bop_options = $payment_gateway->options; - - } else { #use the standard settings from the config - - my $unused_action; - ( $processor, $login, $password, $unused_action, @bop_options ) = - $self->default_payment_gateway($method); +Accepts the same options as L: - } +=over 4 - } - return "neither amount nor paynum specified" unless $amount; +=item unapplied_date - my %content = ( - 'type' => $method, - 'login' => $login, - 'password' => $password, - 'order_number' => $order_number, - 'amount' => $amount, - 'referer' => 'http://cleanwhisker.420.am/', - ); - $content{authorization} = $auth - if length($auth); #echeck/ACH transactions have an order # but no auth - #(at least with authorize.net) - - #first try void if applicable - if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates? - warn " attempting void\n" if $DEBUG > 1; - my $void = new Business::OnlinePayment( $processor, @bop_options ); - $void->content( 'action' => 'void', %content ); - $void->submit(); - if ( $void->is_success ) { - my $error = $cust_pay->void($options{'reason'}); - if ( $error ) { - # gah, even with transactions. - my $e = 'WARNING: Card/ACH voided but database not updated - '. - "error voiding payment: $error"; - warn $e; - return $e; - } - warn " void successful\n" if $DEBUG > 1; - return ''; - } - } +set to true to disregard unapplied credits, payments and refunds outside the specified time period - by default the time period restriction only applies to invoices (useful for reporting, probably a bad idea for event triggering) - warn " void unsuccessful, trying refund\n" - if $DEBUG > 1; +=item cutoff - #massage data - my $address = $self->address1; - $address .= ", ". $self->address2 if $self->address2; +An absolute cutoff time. Payments, credits, and refunds I after this +time will be ignored. Note that START_TIME and END_TIME only limit the date +range for invoices and I payments, credits, and refunds. - my($payname, $payfirst, $paylast); - if ( $self->payname && $method ne 'ECHECK' ) { - $payname = $self->payname; - $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/ - or return "Illegal payname $payname"; - ($payfirst, $paylast) = ($1, $2); - } else { - $payfirst = $self->getfield('first'); - $paylast = $self->getfield('last'); - $payname = "$payfirst $paylast"; - } - - my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list; - if ( $conf->exists('emailinvoiceauto') - || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) { - push @invoicing_list, $self->all_emails; - } +=back - my $email = ($conf->exists('business-onlinepayment-email-override')) - ? $conf->config('business-onlinepayment-email-override') - : $invoicing_list[0]; +=cut - my $payip = exists($options{'payip'}) - ? $options{'payip'} - : $self->payip; - $content{customer_ip} = $payip - if length($payip); +sub balance_date_range { + my $self = shift; + my $sql = 'SELECT SUM('. $self->balance_date_sql(@_). + ') FROM cust_main WHERE custnum='. $self->custnum; + sprintf( '%.2f', $self->scalar_sql($sql) || 0 ); +} - my $payinfo = ''; - if ( $method eq 'CC' ) { +=item balance_pkgnum PKGNUM - if ( $cust_pay ) { - $content{card_number} = $payinfo = $cust_pay->payinfo; - #$self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; - #$content{expiration} = "$2/$1"; - } else { - $content{card_number} = $payinfo = $self->payinfo; - $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; - $content{expiration} = "$2/$1"; - } +Returns the balance for this customer's specific package when using +experimental package balances (total_owed plus total_unrefunded, minus +total_unapplied_credits minus total_unapplied_payments) - } elsif ( $method eq 'ECHECK' ) { - ( $content{account_number}, $content{routing_code} ) = - split('@', $payinfo = $self->payinfo); - $content{bank_name} = $self->payname; - $content{account_type} = 'CHECKING'; - $content{account_name} = $payname; - $content{customer_org} = $self->company ? 'B' : 'I'; - $content{customer_ssn} = $self->ss; - } elsif ( $method eq 'LEC' ) { - $content{phone} = $payinfo = $self->payinfo; - } - - #then try refund - my $refund = new Business::OnlinePayment( $processor, @bop_options ); - my %sub_content = $refund->content( - 'action' => 'credit', - 'customer_id' => $self->custnum, - 'last_name' => $paylast, - 'first_name' => $payfirst, - 'name' => $payname, - 'address' => $address, - 'city' => $self->city, - 'state' => $self->state, - 'zip' => $self->zip, - 'country' => $self->country, - 'email' => $email, - 'phone' => $self->daytime || $self->night, - %content, #after - ); - warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content ) - if $DEBUG > 1; - $refund->submit(); +=cut - return "$processor error: ". $refund->error_message - unless $refund->is_success(); +sub balance_pkgnum { + my( $self, $pkgnum ) = @_; - my %method2payby = ( - 'CC' => 'CARD', - 'ECHECK' => 'CHEK', - 'LEC' => 'LECB', + sprintf( "%.2f", + $self->total_owed_pkgnum($pkgnum) +# n/a - refunds aren't part of pkg-balances since they don't apply to invoices +# + $self->total_unapplied_refunds_pkgnum($pkgnum) + - $self->total_unapplied_credits_pkgnum($pkgnum) + - $self->total_unapplied_payments_pkgnum($pkgnum) ); - - my $paybatch = "$processor:". $refund->authorization; - $paybatch .= ':'. $refund->order_number - if $refund->can('order_number') && $refund->order_number; - - while ( $cust_pay && $cust_pay->unappled < $amount ) { - my @cust_bill_pay = $cust_pay->cust_bill_pay; - last unless @cust_bill_pay; - my $cust_bill_pay = pop @cust_bill_pay; - my $error = $cust_bill_pay->delete; - last if $error; - } - - my $cust_refund = new FS::cust_refund ( { - 'custnum' => $self->custnum, - 'paynum' => $options{'paynum'}, - 'refund' => $amount, - '_date' => '', - 'payby' => $method2payby{$method}, - 'payinfo' => $payinfo, - 'paybatch' => $paybatch, - 'reason' => $options{'reason'} || 'card or ACH refund', - } ); - my $error = $cust_refund->insert; - if ( $error ) { - $cust_refund->paynum(''); #try again with no specific paynum - my $error2 = $cust_refund->insert; - if ( $error2 ) { - # gah, even with transactions. - my $e = 'WARNING: Card/ACH refunded but database not updated - '. - "error inserting refund ($processor): $error2". - " (previously tried insert with paynum #$options{'paynum'}" . - ": $error )"; - warn $e; - return $e; - } - } - - ''; #no error - } -=item total_owed +=item in_transit_payments -Returns the total owed for this customer on all invoices -(see L). +Returns the total of requests for payments for this customer pending in +batches in transit to the bank. See L and L =cut -sub total_owed { +sub in_transit_payments { my $self = shift; - $self->total_owed_date(2145859200); #12/31/2037 + my $in_transit_payments = 0; + foreach my $pay_batch ( qsearch('pay_batch', { + 'status' => 'I', + } ) ) { + foreach my $cust_pay_batch ( qsearch('cust_pay_batch', { + 'batchnum' => $pay_batch->batchnum, + 'custnum' => $self->custnum, + 'status' => '', + } ) ) { + $in_transit_payments += $cust_pay_batch->amount; + } + } + sprintf( "%.2f", $in_transit_payments ); } -=item total_owed_date TIME +=item payment_info -Returns the total owed for this customer on all invoices with date earlier than -TIME. TIME is specified as a UNIX timestamp; see L). Also -see L and L for conversion functions. +Returns a hash of useful information for making a payment. -=cut - -sub total_owed_date { - my $self = shift; - my $time = shift; - my $total_bill = 0; - foreach my $cust_bill ( - grep { $_->_date <= $time } - qsearch('cust_bill', { 'custnum' => $self->custnum, } ) - ) { - $total_bill += $cust_bill->owed; - } - sprintf( "%.2f", $total_bill ); -} +=over 4 -=item apply_credits OPTION => VALUE ... +=item balance -Applies (see L) unapplied credits (see L) -to outstanding invoice balances in chronological order (or reverse -chronological order if the I option is set to B) and returns the -value of any remaining unapplied credits available for refund (see -L). +Current balance. -=cut +=item payby -sub apply_credits { - my $self = shift; - my %opt = @_; +'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand), +'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand), +'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free). - return 0 unless $self->total_credited; +=back - my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 } - qsearch('cust_credit', { 'custnum' => $self->custnum } ) ); +For credit card transactions: - my @invoices = $self->open_cust_bill; - @invoices = sort { $b->_date <=> $a->_date } @invoices - if defined($opt{'order'}) && $opt{'order'} eq 'newest'; +=over 4 - my $credit; - foreach my $cust_bill ( @invoices ) { - my $amount; +=item card_type 1 - if ( !defined($credit) || $credit->credited == 0) { - $credit = pop @credits or last; - } +=item payname - if ($cust_bill->owed >= $credit->credited) { - $amount=$credit->credited; - }else{ - $amount=$cust_bill->owed; - } - - my $cust_credit_bill = new FS::cust_credit_bill ( { - 'crednum' => $credit->crednum, - 'invnum' => $cust_bill->invnum, - 'amount' => $amount, - } ); - my $error = $cust_credit_bill->insert; - die $error if $error; - - redo if ($cust_bill->owed > 0); +Exact name on card - } +=back - return $self->total_credited; -} +For electronic check transactions: -=item apply_payments +=over 4 -Applies (see L) unapplied payments (see L) -to outstanding invoice balances in chronological order. +=item stateid_state - #and returns the value of any remaining unapplied payments. +=back =cut -sub apply_payments { +sub payment_info { my $self = shift; - #return 0 unless - - my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 } - qsearch('cust_pay', { 'custnum' => $self->custnum } ) ); + my %return = (); - my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 } - qsearch('cust_bill', { 'custnum' => $self->custnum } ) ); + $return{balance} = $self->balance; - my $payment; + $return{payname} = $self->payname + || ( $self->first. ' '. $self->get('last') ); - foreach my $cust_bill ( @invoices ) { - my $amount; + $return{$_} = $self->bill_location->$_ + for qw(address1 address2 city state zip); - if ( !defined($payment) || $payment->unapplied == 0 ) { - $payment = pop @payments or last; - } + $return{payby} = $self->payby; + $return{stateid_state} = $self->stateid_state; - if ( $cust_bill->owed >= $payment->unapplied ) { - $amount = $payment->unapplied; - } else { - $amount = $cust_bill->owed; - } - - my $cust_bill_pay = new FS::cust_bill_pay ( { - 'paynum' => $payment->paynum, - 'invnum' => $cust_bill->invnum, - 'amount' => $amount, - } ); - my $error = $cust_bill_pay->insert; - die $error if $error; + if ( $self->payby =~ /^(CARD|DCRD)$/ ) { + $return{card_type} = cardtype($self->payinfo); + $return{payinfo} = $self->paymask; - redo if ( $cust_bill->owed > 0); + @return{'month', 'year'} = $self->paydate_monthyear; } - return $self->total_unapplied_payments; -} + if ( $self->payby =~ /^(CHEK|DCHK)$/ ) { + my ($payinfo1, $payinfo2) = split '@', $self->paymask; + $return{payinfo1} = $payinfo1; + $return{payinfo2} = $payinfo2; + $return{paytype} = $self->paytype; + $return{paystate} = $self->paystate; -=item total_credited + } -Returns the total outstanding credit (see L) for this -customer. See L. + #doubleclick protection + my $_date = time; + $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32; -=cut + %return; -sub total_credited { - my $self = shift; - my $total_credit = 0; - foreach my $cust_credit ( qsearch('cust_credit', { - 'custnum' => $self->custnum, - } ) ) { - $total_credit += $cust_credit->credited; - } - sprintf( "%.2f", $total_credit ); } -=item total_unapplied_payments +=item paydate_monthyear -Returns the total unapplied payments (see L) for this customer. -See L. +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 total_unapplied_payments { +sub paydate_monthyear { my $self = shift; - my $total_unapplied = 0; - foreach my $cust_pay ( qsearch('cust_pay', { - 'custnum' => $self->custnum, - } ) ) { - $total_unapplied += $cust_pay->unapplied; + 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 { + ('', ''); } - sprintf( "%.2f", $total_unapplied ); } -=item balance +=item paydate_epoch -Returns the balance for this customer (total_owed minus total_credited -minus total_unapplied_payments). +Returns the exact time in seconds corresponding to the payment method +expiration date. For CARD/DCRD customers this is the end of the month; +for others (COMP is the only other payby that uses paydate) it's the start. +Returns 0 if the paydate is empty or set to the far future. =cut -sub balance { +sub paydate_epoch { my $self = shift; - sprintf( "%.2f", - $self->total_owed - $self->total_credited - $self->total_unapplied_payments - ); -} - -=item balance_date TIME - -Returns the balance for this customer, only considering invoices with date -earlier than TIME (total_owed_date minus total_credited minus -total_unapplied_payments). TIME is specified as a UNIX timestamp; see -L). Also see L and L for conversion -functions. - -=cut - -sub balance_date { - my $self = shift; - my $time = shift; - sprintf( "%.2f", - $self->total_owed_date($time) - - $self->total_credited - - $self->total_unapplied_payments - ); + my ($month, $year) = $self->paydate_monthyear; + return 0 if !$year or $year >= 2037; + if ( $self->payby eq 'CARD' or $self->payby eq 'DCRD' ) { + $month++; + if ( $month == 13 ) { + $month = 1; + $year++; + } + return timelocal(0,0,0,1,$month-1,$year) - 1; + } + else { + return timelocal(0,0,0,1,$month-1,$year); + } } -=item in_transit_payments +=item paydate_epoch_sql -Returns the total of requests for payments for this customer pending in -batches in transit to the bank. See L and L +Class method. Returns an SQL expression to obtain the payment expiration date +as a number of seconds. =cut -sub in_transit_payments { - my $self = shift; - my $in_transit_payments = 0; - foreach my $pay_batch ( qsearch('pay_batch', { - 'status' => 'I', - } ) ) { - foreach my $cust_pay_batch ( qsearch('cust_pay_batch', { - 'batchnum' => $pay_batch->batchnum, - 'custnum' => $self->custnum, - } ) ) { - $in_transit_payments += $cust_pay_batch->amount; - } +# Special expiration date behavior for non-CARD/DCRD customers has been +# carefully preserved. Do we really use that? +sub paydate_epoch_sql { + my $class = shift; + my $table = shift || 'cust_main'; + my ($case1, $case2); + if ( driver_name eq 'Pg' ) { + $case1 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) + INTERVAL '1 month') - 1"; + $case2 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) )"; } - sprintf( "%.2f", $in_transit_payments ); + elsif ( lc(driver_name) eq 'mysql' ) { + $case1 = "UNIX_TIMESTAMP( DATE_ADD( CAST( $table.paydate AS DATETIME ), INTERVAL 1 month ) ) - 1"; + $case2 = "UNIX_TIMESTAMP( CAST( $table.paydate AS DATETIME ) )"; + } + else { return '' } + return "CASE WHEN $table.payby IN('CARD','DCRD') + THEN ($case1) + ELSE ($case2) + END" } -=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) +=item tax_exemption TAXNAME =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 payinfo_masked +sub tax_exemption { + my( $self, $taxname ) = @_; -Returns a "masked" payinfo field appropriate to the payment type. Masked characters are replaced by 'x'es. Use this to display publicly accessable account Information. + qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum, + 'taxname' => $taxname, + }, + ); +} -Credit Cards - Mask all but the last four characters. -Checks - Mask all but last 2 of account number and bank routing number. -Others - Do nothing, return the unmasked string. +=item cust_main_exemption =cut -sub payinfo_masked { +sub cust_main_exemption { my $self = shift; - return $self->paymask; + qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } ); } =item invoicing_list [ ARRAYREF ] @@ -3413,7 +3368,8 @@ is an error, returns the error, otherwise returns false. sub check_invoicing_list { my( $self, $arrayref ) = @_; - foreach my $address ( @{$arrayref} ) { + + foreach my $address ( @$arrayref ) { if ($address eq 'FAX' and $self->getfield('fax') eq '') { return 'Can\'t add FAX invoice destination with a blank FAX number.'; @@ -3428,7 +3384,13 @@ sub check_invoicing_list { : $cust_main_invoice->checkdest ; return $error if $error; + } + + return "Email address required" + if $conf->exists('cust_main-require_invoicing_list_email', $self->agentnum) + && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref; + ''; } @@ -3488,9 +3450,128 @@ 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 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 +this customer was not referred). + +Note the difference with referral_cust_main method: This method, +referral_custnum_cust_main returns the single customer (if any) who referred +this customer, while referral_cust_main returns an array of customers referred +BY this customer. + +=cut + +sub referral_custnum_cust_main { + my $self = shift; + return '' unless $self->referral_custnum; + qsearchs('cust_main', { 'custnum' => $self->referral_custnum } ); +} + =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ] Returns an array of customers referred by this customer (referral_custnum set @@ -3498,6 +3579,11 @@ to this custnum). If DEPTH is given, recurses up to the given depth, returning customers referred by customers referred by this customer and so on, inclusive. The default behavior is DEPTH 1 (no recursion). +Note the difference with referral_custnum_cust_main method: This method, +referral_cust_main, returns an array of customers referred BY this customer, +while referral_custnum_cust_main returns the single customer (if any) who +referred this customer. + =cut sub referral_cust_main { @@ -3535,7 +3621,7 @@ sub referral_cust_main_ncancelled { Like referral_cust_main, except returns a flat list of all unsuspended (and uncancelled) packages for each customer. The number of items in this list may -be useful for comission calculations (perhaps after a Cpkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ). +be useful for commission calculations (perhaps after a Cpkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ). =cut @@ -3561,35 +3647,139 @@ sub referring_cust_main { qsearchs('cust_main', { 'custnum' => $self->referral_custnum } ); } -=item credit AMOUNT, REASON +=item credit AMOUNT, REASON [ , OPTION => VALUE ... ] Applies a credit to this customer. If there is an error, returns the error, otherwise returns false. +REASON can be a text string, an FS::reason object, or a scalar reference to +a reasonnum. If a text string, it will be automatically inserted as a new +reason, and a 'reason_type' option must be passed to indicate the +FS::reason_type for the new reason. + +An I option may be passed to set the credit's I field. +Likewise for I, I, I and +I. + +Any other options are passed to FS::cust_credit::insert. + =cut sub credit { - my( $self, $amount, $reason ) = @_; + my( $self, $amount, $reason, %options ) = @_; + my $cust_credit = new FS::cust_credit { 'custnum' => $self->custnum, 'amount' => $amount, - 'reason' => $reason, }; - $cust_credit->insert; + + if ( ref($reason) ) { + + if ( ref($reason) eq 'SCALAR' ) { + $cust_credit->reasonnum( $$reason ); + } else { + $cust_credit->reasonnum( $reason->reasonnum ); + } + + } else { + $cust_credit->set('reason', $reason) + } + + $cust_credit->$_( delete $options{$_} ) + foreach grep exists($options{$_}), + qw( addlinfo eventnum ), + map "commission_$_", qw( agentnum salesnum pkgnum ); + + $cust_credit->insert(%options); + } -=item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ] +=item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ] Creates a one-time charge for this customer. If there is an error, returns the error, otherwise returns false. +New-style, with a hashref of options: + + my $error = $cust_main->charge( + { + 'amount' => 54.32, + 'quantity' => 1, + 'start_date' => str2time('7/4/2009'), + 'pkg' => 'Description', + 'comment' => 'Comment', + 'additional' => [], #extra invoice detail + 'classnum' => 1, #pkg_class + + 'setuptax' => '', # or 'Y' for tax exempt + + 'locationnum'=> 1234, # optional + + #internal taxation + 'taxclass' => 'Tax class', + + #vendor taxation + 'taxproduct' => 2, #part_pkg_taxproduct + 'override' => {}, #XXX describe + + #will be filled in with the new object + 'cust_pkg_ref' => \$cust_pkg, + + #generate an invoice immediately + 'bill_now' => 0, + 'invoice_terms' => '', #with these terms + } + ); + +Old-style: + + my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' ); + =cut +#super false laziness w/quotation::charge 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, $setup_cost, $quantity, $start_date, $classnum ); + my ( $pkg, $comment, $additional ); + my ( $setuptax, $taxclass ); #internal taxes + my ( $taxproduct, $override ); #vendor (CCH) taxes + my $no_auto = ''; + my $separate_bill = ''; + my $cust_pkg_ref = ''; + my ( $bill_now, $invoice_terms ) = ( 0, '' ); + my $locationnum; + if ( ref( $_[0] ) ) { + $amount = $_[0]->{amount}; + $setup_cost = $_[0]->{setup_cost}; + $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1; + $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : ''; + $no_auto = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : ''; + $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge'; + $comment = exists($_[0]->{comment}) ? $_[0]->{comment} + : '$'. sprintf("%.2f",$amount); + $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : ''; + $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : ''; + $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : ''; + $additional = $_[0]->{additional} || []; + $taxproduct = $_[0]->{taxproductnum}; + $override = { '' => $_[0]->{tax_override} }; + $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : ''; + $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : ''; + $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : ''; + $locationnum = $_[0]->{locationnum} || $self->ship_locationnum; + $separate_bill = $_[0]->{separate_bill} || ''; + } else { # yuck + $amount = shift; + $setup_cost = ''; + $quantity = 1; + $start_date = ''; + $pkg = @_ ? shift : 'One-time charge'; + $comment = @_ ? shift : '$'. sprintf("%.2f",$amount); + $setuptax = ''; + $taxclass = @_ ? shift : ''; + $additional = []; + } local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -3603,18 +3793,28 @@ sub charge { my $dbh = dbh; 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, + 'pkg' => $pkg, + 'comment' => $comment, + 'plan' => 'flat', + 'freq' => 0, + 'disabled' => 'Y', + 'classnum' => ( $classnum ? $classnum : '' ), + 'setuptax' => $setuptax, + 'taxclass' => $taxclass, + 'taxproductnum' => $taxproduct, + 'setup_cost' => $setup_cost, } ); - 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, + tax_overrides => $override, + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -3632,31 +3832,88 @@ sub charge { } my $cust_pkg = new FS::cust_pkg ( { - 'custnum' => $self->custnum, - 'pkgpart' => $pkgpart, + 'custnum' => $self->custnum, + 'pkgpart' => $pkgpart, + 'quantity' => $quantity, + 'start_date' => $start_date, + 'no_auto' => $no_auto, + 'separate_bill' => $separate_bill, + 'locationnum'=> $locationnum, } ); $error = $cust_pkg->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; + } elsif ( $cust_pkg_ref ) { + ${$cust_pkg_ref} = $cust_pkg; + } + + if ( $bill_now ) { + my $error = $self->bill( 'invoice_terms' => $invoice_terms, + 'pkg_list' => [ $cust_pkg ], + ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } } $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; + return ''; + +} + +#=item charge_postal_fee +# +#Applies a one time charge this customer. If there is an error, +#returns the error, returns the cust_pkg charge object or false +#if there was no charge. +# +#=cut +# +# This should be a customer event. For that to work requires that bill +# also be a customer event. + +sub charge_postal_fee { + my $self = shift; + + my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum); + return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list); + + my $cust_pkg = new FS::cust_pkg ( { + 'custnum' => $self->custnum, + 'pkgpart' => $pkgpart, + 'quantity' => 1, + } ); + my $error = $cust_pkg->insert; + $error ? $error : $cust_pkg; } -=item cust_bill +=item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ] Returns all the invoices (see L) for this customer. +Optionally, a list or hashref of additional arguments to the qsearch call can +be passed. + =cut sub cust_bill { my $self = shift; - sort { $a->_date <=> $b->_date } - qsearch('cust_bill', { 'custnum' => $self->custnum, } ) + my $opt = ref($_[0]) ? shift : { @_ }; + + #return $self->num_cust_bill unless wantarray || keys %$opt; + + $opt->{'table'} = 'cust_bill'; + $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway... + $opt->{'hashref'}{'custnum'} = $self->custnum; + $opt->{'order_by'} ||= 'ORDER BY _date ASC'; + + map { $_ } #behavior of sort undefined in scalar context + sort { $a->_date <=> $b->_date } + qsearch($opt); } =item open_cust_bill @@ -3668,7 +3925,120 @@ customer. sub open_cust_bill { my $self = shift; - grep { $_->owed > 0 } $self->cust_bill; + + $self->cust_bill( + 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0', + #@_ + ); + +} + +=item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ] + +Returns all the legacy invoices (see L) for this customer. + +=cut + +sub legacy_cust_bill { + my $self = shift; + + #return $self->num_legacy_cust_bill unless wantarray; + + map { $_ } #behavior of sort undefined in scalar context + sort { $a->_date <=> $b->_date } + qsearch({ 'table' => 'legacy_cust_bill', + 'hashref' => { 'custnum' => $self->custnum, }, + 'order_by' => 'ORDER BY _date ASC', + }); +} + +=item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ] + +Returns all the statements (see L) for this customer. + +Optionally, a list or hashref of additional arguments to the qsearch call can +be passed. + +=cut + +=item cust_bill_void + +Returns all the voided invoices (see L) for this customer. + +=cut + +sub cust_bill_void { + my $self = shift; + + map { $_ } #return $self->num_cust_bill_void unless wantarray; + sort { $a->_date <=> $b->_date } + qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } ) +} + +sub cust_statement { + my $self = shift; + my $opt = ref($_[0]) ? shift : { @_ }; + + #return $self->num_cust_statement unless wantarray || keys %$opt; + + $opt->{'table'} = 'cust_statement'; + $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway... + $opt->{'hashref'}{'custnum'} = $self->custnum; + $opt->{'order_by'} ||= 'ORDER BY _date ASC'; + + map { $_ } #behavior of sort undefined in scalar context + sort { $a->_date <=> $b->_date } + qsearch($opt); +} + +=item svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ] + +Returns all services of type SVCDB (such as 'svc_acct') for this customer. + +Optionally, a list or hashref of additional arguments to the qsearch call can +be passed following the SVCDB. + +=cut + +sub svc_x { + my $self = shift; + my $svcdb = shift; + if ( ! $svcdb =~ /^svc_\w+$/ ) { + warn "$me svc_x requires a svcdb"; + return; + } + my $opt = ref($_[0]) ? shift : { @_ }; + + $opt->{'table'} = $svcdb; + $opt->{'addl_from'} = + 'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '. + ($opt->{'addl_from'} || ''); + + my $custnum = $self->custnum; + $custnum =~ /^\d+$/ or die "bad custnum '$custnum'"; + my $where = "cust_pkg.custnum = $custnum"; + + my $extra_sql = $opt->{'extra_sql'} || ''; + if ( keys %{ $opt->{'hashref'} } ) { + $extra_sql = " AND $where $extra_sql"; + } + else { + if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) { + $extra_sql = "WHERE $where AND $1"; + } + else { + $extra_sql = "WHERE $where $extra_sql"; + } + } + $opt->{'extra_sql'} = $extra_sql; + + qsearch($opt); +} + +# required for use as an eventtable; +sub svc_acct { + my $self = shift; + $self->svc_x('svc_acct', @_); } =item cust_credit @@ -3679,35 +4049,220 @@ Returns all the credits (see L) for this customer. sub cust_credit { my $self = shift; + map { $_ } #return $self->num_cust_credit unless wantarray; + sort { $a->_date <=> $b->_date } + qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) +} + +=item cust_credit_pkgnum + +Returns all the credits (see L) for this customer's specific +package when using experimental package balances. + +=cut + +sub cust_credit_pkgnum { + my( $self, $pkgnum ) = @_; + map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray; + sort { $a->_date <=> $b->_date } + qsearch( 'cust_credit', { 'custnum' => $self->custnum, + 'pkgnum' => $pkgnum, + } + ); +} + +=item cust_credit_void + +Returns all voided credits (see L) for this customer. + +=cut + +sub cust_credit_void { + my $self = shift; + map { $_ } + sort { $a->_date <=> $b->_date } + qsearch( 'cust_credit_void', { 'custnum' => $self->custnum } ) +} + +=item cust_pay + +Returns all the payments (see L) for this customer. + +=cut + +sub cust_pay { + my $self = shift; + my $opt = ref($_[0]) ? shift : { @_ }; + + return $self->num_cust_pay unless wantarray || keys %$opt; + + $opt->{'table'} = 'cust_pay'; + $opt->{'hashref'}{'custnum'} = $self->custnum; + + map { $_ } #behavior of sort undefined in scalar context + sort { $a->_date <=> $b->_date } + qsearch($opt); + +} + +=item num_cust_pay + +Returns the number of payments (see L) for this customer. Also +called automatically when the cust_pay method is used in a scalar context. + +=cut + +sub num_cust_pay { + my $self = shift; + my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?"; + my $sth = dbh->prepare($sql) or die dbh->errstr; + $sth->execute($self->custnum) or die $sth->errstr; + $sth->fetchrow_arrayref->[0]; +} + +=item unapplied_cust_pay + +Returns all the unapplied payments (see L) for this customer. + +=cut + +sub unapplied_cust_pay { + my $self = shift; + + $self->cust_pay( + 'extra_sql' => ' AND '. FS::cust_pay->unapplied_sql. ' > 0', + #@_ + ); + +} + +=item cust_pay_pkgnum + +Returns all the payments (see L) for this customer's specific +package when using experimental package balances. + +=cut + +sub cust_pay_pkgnum { + my( $self, $pkgnum ) = @_; + map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray; + sort { $a->_date <=> $b->_date } + qsearch( 'cust_pay', { 'custnum' => $self->custnum, + 'pkgnum' => $pkgnum, + } + ); +} + +=item cust_pay_void + +Returns all voided payments (see L) for this customer. + +=cut + +sub cust_pay_void { + my $self = shift; + map { $_ } #return $self->num_cust_pay_void unless wantarray; + sort { $a->_date <=> $b->_date } + qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } ) +} + +=item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ] + +Returns all batched payments (see L) for this customer. + +Optionally, a list or hashref of additional arguments to the qsearch call can +be passed. + +=cut + +sub cust_pay_batch { + my $self = shift; + my $opt = ref($_[0]) ? shift : { @_ }; + + #return $self->num_cust_statement unless wantarray || keys %$opt; + + $opt->{'table'} = 'cust_pay_batch'; + $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway... + $opt->{'hashref'}{'custnum'} = $self->custnum; + $opt->{'order_by'} ||= 'ORDER BY paybatchnum ASC'; + + map { $_ } #behavior of sort undefined in scalar context + sort { $a->paybatchnum <=> $b->paybatchnum } + qsearch($opt); +} + +=item cust_pay_pending + +Returns all pending payments (see L) for this customer +(without status "done"). + +=cut + +sub cust_pay_pending { + my $self = shift; + return $self->num_cust_pay_pending unless wantarray; + sort { $a->_date <=> $b->_date } + qsearch( 'cust_pay_pending', { + 'custnum' => $self->custnum, + 'status' => { op=>'!=', value=>'done' }, + }, + ); +} + +=item cust_pay_pending_attempt + +Returns all payment attempts / declined payments for this customer, as pending +payments objects (see L), with status "done" but without +a corresponding payment (see L). + +=cut + +sub cust_pay_pending_attempt { + my $self = shift; + return $self->num_cust_pay_pending_attempt unless wantarray; sort { $a->_date <=> $b->_date } - qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) + qsearch( 'cust_pay_pending', { + 'custnum' => $self->custnum, + 'status' => 'done', + 'paynum' => '', + }, + ); } -=item cust_pay +=item num_cust_pay_pending -Returns all the payments (see L) for this customer. +Returns the number of pending payments (see L) for this +customer (without status "done"). Also called automatically when the +cust_pay_pending method is used in a scalar context. =cut -sub cust_pay { +sub num_cust_pay_pending { my $self = shift; - sort { $a->_date <=> $b->_date } - qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) + $self->scalar_sql( + " SELECT COUNT(*) FROM cust_pay_pending ". + " WHERE custnum = ? AND status != 'done' ", + $self->custnum + ); } -=item cust_pay_void +=item num_cust_pay_pending_attempt -Returns all voided payments (see L) for this customer. +Returns the number of pending payments (see L) for this +customer, with status "done" but without a corresp. Also called automatically when the +cust_pay_pending method is used in a scalar context. =cut -sub cust_pay_void { +sub num_cust_pay_pending_attempt { my $self = shift; - sort { $a->_date <=> $b->_date } - qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } ) + $self->scalar_sql( + " SELECT COUNT(*) FROM cust_pay_pending ". + " WHERE custnum = ? AND status = 'done' AND paynum IS NULL", + $self->custnum + ); } - =item cust_refund Returns all the refunds (see L) for this customer. @@ -3716,20 +4271,34 @@ Returns all the refunds (see L) for this customer. sub cust_refund { my $self = shift; + map { $_ } #return $self->num_cust_refund unless wantarray; sort { $a->_date <=> $b->_date } qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) } -=item select_for_update +=item display_custnum -Selects this record with the SQL "FOR UPDATE" command. This can be useful as -a mutex. +Returns the displayed customer number for this customer: agent_custid if +cust_main-default_agent_custid is set and it has a value, custnum otherwise. =cut -sub select_for_update { +sub display_custnum { my $self = shift; - qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' ); + + return $self->agent_custid + if $default_agent_custid && $self->agent_custid; + + my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || ''; + + if ( $prefix ) { + return $prefix . + 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; + } } =item name @@ -3746,6 +4315,27 @@ sub name { $name; } +=item service_contact + +Returns the L object for this customer that has the 'Service' +contact class, or undef if there is no such contact. Deprecated; don't use +this in new code. + +=cut + +sub service_contact { + my $self = shift; + if ( !exists($self->{service_contact}) ) { + my $classnum = $self->scalar_sql( + 'SELECT classnum FROM contact_class WHERE classname = \'Service\'' + ) || 0; #if it's zero, qsearchs will return nothing + $self->{service_contact} = qsearchs('contact', { + 'classnum' => $classnum, 'custnum' => $self->custnum + }) || undef; + } + $self->{service_contact}; +} + =item ship_name Returns a name string for this (service/shipping) contact, either @@ -3755,13 +4345,35 @@ Returns a name string for this (service/shipping) contact, either sub ship_name { my $self = shift; - if ( $self->get('ship_last') ) { - my $name = $self->ship_contact; - $name = $self->ship_company. " ($name)" if $self->ship_company; - $name; - } else { - $self->name; - } + + my $name = $self->ship_contact; + $name = $self->company. " ($name)" if $self->company; + $name; +} + +=item name_short + +Returns a name string for this customer, either "Company" or "First Last". + +=cut + +sub name_short { + my $self = shift; + $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast; +} + +=item ship_name_short + +Returns a name string for this (service/shipping) contact, either "Company" +or "First Last". + +=cut + +sub ship_name_short { + my $self = shift; + $self->service_contact + ? $self->ship_contact_firstlast + : $self->name_short } =item contact @@ -3783,22 +4395,70 @@ Returns this customer's full (shipping) contact name only, "Last, First" sub ship_contact { my $self = shift; - $self->get('ship_last') - ? $self->get('ship_last'). ', '. $self->ship_first - : $self->contact; + my $contact = $self->service_contact || $self; + $contact->get('last') . ', ' . $contact->get('first'); +} + +=item contact_firstlast + +Returns this customers full (billing) contact name only, "First Last". + +=cut + +sub contact_firstlast { + my $self = shift; + $self->first. ' '. $self->get('last'); +} + +=item ship_contact_firstlast + +Returns this customer's full (shipping) contact name only, "First Last". + +=cut + +sub ship_contact_firstlast { + my $self = shift; + my $contact = $self->service_contact || $self; + $contact->get('first') . ' '. $contact->get('last'); +} + +sub bill_country_full { + my $self = shift; + $self->bill_location->country_full; +} + +sub ship_country_full { + my $self = shift; + $self->ship_location->country_full; } -=item country_full +=item county_state_county [ PREFIX ] -Returns this customer's full country name +Returns a string consisting of just the county, state and country. =cut -sub country_full { +sub county_state_country { my $self = shift; - code2country($self->country); + my $locationnum; + if ( @_ && $_[0] && $self->has_ship_address ) { + $locationnum = $self->ship_locationnum; + } else { + $locationnum = $self->bill_locationnum; + } + my $cust_location = qsearchs('cust_location', { locationnum=>$locationnum }); + $cust_location->county_state_country; } +=item geocode DATA_VENDOR + +Returns a value for the customer location as encoded by DATA_VENDOR. +Currently this only makes sense for "CCH" as DATA_VENDOR. + +=cut + +=item cust_status + =item status Returns a status string for this customer, currently: @@ -3807,6 +4467,8 @@ Returns a status string for this customer, currently: =item prospect - No packages have ever been ordered +=item ordered - Recurring packages all are new (not yet billed). + =item active - One or more recurring packages is active =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled) @@ -3817,17 +4479,63 @@ Returns a status string for this customer, currently: =back +Behavior of inactive vs. cancelled edge cases can be adjusted with the +cust_main-status_module configuration option. + =cut -sub status { +sub status { shift->cust_status(@_); } + +sub cust_status { my $self = shift; - for my $status (qw( prospect active inactive suspended cancelled )) { + 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 $sth->errstr; - return $status if $sth->fetchrow_arrayref->[0]; + $sth->execute( ($self->custnum) x $numnum ) + or die "Error executing 'SELECT $sql': ". $sth->errstr; + if ( $sth->fetchrow_arrayref->[0] ) { + $self->hashref->{cust_status} = $status; + return $status; + } + } +} + +=item is_status_delay_cancel + +Returns true if customer status is 'suspended' +and all suspended cust_pkg return true for +cust_pkg->is_status_delay_cancel. + +This is not a real status, this only meant for hacking display +values, because otherwise treating the customer as suspended is +really the whole point of the delay_cancel option. + +=cut + +sub is_status_delay_cancel { + my ($self) = @_; + return 0 unless $self->status eq 'suspended'; + foreach my $cust_pkg ($self->ncancelled_pkgs) { + return 0 unless $cust_pkg->is_status_delay_cancel; } + return 1; +} + +=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 @@ -3836,540 +4544,618 @@ Returns a hex triplet color string for this customer's status. =cut -use vars qw(%statuscolor); -%statuscolor = ( - 'prospect' => '7e0079', #'000000', #black? naw, purple - 'active' => '00CC00', #green - 'inactive' => '0000CC', #blue - 'suspended' => 'FF9900', #yellow - 'cancelled' => 'FF0000', #red -); +sub statuscolor { shift->cust_statuscolor(@_); } -sub statuscolor { +sub cust_statuscolor { my $self = shift; - $statuscolor{$self->status}; + __PACKAGE__->statuscolors->{$self->cust_status}; } -=back +=item tickets [ STATUS ] -=head1 CLASS METHODS +Returns an array of hashes representing the customer's RT tickets. -=over 4 +An optional status (or arrayref or hashref of statuses) may be specified. -=item prospect_sql +=cut -Returns an SQL expression identifying prospective cust_main records (customers -with no packages ever ordered) +sub tickets { + my $self = shift; + my $status = ( @_ && $_[0] ) ? shift : ''; -=cut + my $num = $conf->config('cust_main-max_tickets') || 10; + my @tickets = (); -use vars qw($select_count_pkgs); -$select_count_pkgs = - "SELECT COUNT(*) FROM cust_pkg - WHERE cust_pkg.custnum = cust_main.custnum"; + if ( $conf->config('ticket_system') ) { + unless ( $conf->config('ticket_system-custom_priority_field') ) { -sub select_count_pkgs_sql { - $select_count_pkgs; -} + @tickets = @{ FS::TicketSystem->customer_tickets( $self->custnum, + $num, + undef, + $status, + ) + }; -sub prospect_sql { " - 0 = ( $select_count_pkgs ) -"; } + } else { -=item active_sql + foreach my $priority ( + $conf->config('ticket_system-custom_priority_field-values'), '' + ) { + last if scalar(@tickets) >= $num; + push @tickets, + @{ FS::TicketSystem->customer_tickets( $self->custnum, + $num - scalar(@tickets), + $priority, + $status, + ) + }; + } + } + } + (@tickets); +} -Returns an SQL expression identifying active cust_main records (customers with -no active recurring packages, but otherwise unsuspended/uncancelled). +=item appointments [ STATUS ] + +Returns an array of hashes representing the customer's RT tickets which +are appointments. =cut -sub active_sql { " - 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " - ) -"; } +sub appointments { + my $self = shift; + my $status = ( @_ && $_[0] ) ? shift : ''; -=item inactive_sql + return () unless $conf->config('ticket_system'); -Returns an SQL expression identifying inactive cust_main records (customers with -active recurring packages). + my $queueid = $conf->config('ticket_system-appointment-queueid'); -=cut + @{ FS::TicketSystem->customer_tickets( $self->custnum, + 99, + undef, + $status, + $queueid, + ) + }; +} -sub inactive_sql { " - 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) - AND - 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) -"; } +# Return services representing svc_accts in customer support packages +sub support_services { + my $self = shift; + my %packages = map { $_ => 1 } $conf->config('support_packages'); -=item susp_sql -=item suspended_sql + grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' } + grep { $_->part_svc->svcdb eq 'svc_acct' } + map { $_->cust_svc } + grep { exists $packages{ $_->pkgpart } } + $self->ncancelled_pkgs; -Returns an SQL expression identifying suspended cust_main records. +} -=cut +# Return a list of latitude/longitude for one of the services (if any) +sub service_coordinates { + my $self = shift; + my @svc_X = + grep { $_->latitude && $_->longitude } + map { $_->svc_x } + map { $_->cust_svc } + $self->ncancelled_pkgs; -sub suspended_sql { susp_sql(@_); } -sub susp_sql { " - 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) - AND - 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) -"; } + scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : () +} -=item cancel_sql -=item cancelled_sql +=item masked FIELD -Returns an SQL expression identifying cancelled cust_main records. +Returns a masked version of the named field =cut -sub cancelled_sql { cancel_sql(@_); } -sub cancel_sql { +sub masked { +my ($self,$field) = @_; - my $recurring_sql = FS::cust_pkg->recurring_sql; - #my $recurring_sql = " - # '0' != ( select freq from part_pkg - # where cust_pkg.pkgpart = part_pkg.pkgpart ) - #"; +# Show last four + +'x'x(length($self->getfield($field))-4). + substr($self->getfield($field), (length($self->getfield($field))-4)); - " - 0 < ( $select_count_pkgs ) - AND 0 = ( $select_count_pkgs AND $recurring_sql - AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) - ) - "; } -=item uncancel_sql -=item uncancelled_sql +=item payment_history -Returns an SQL expression identifying un-cancelled cust_main records. +Returns an array of hashrefs standardizing information from cust_bill, cust_pay, +cust_credit and cust_refund objects. Each hashref has the following fields: -=cut +I - one of 'Line item', 'Invoice', 'Payment', 'Credit', 'Refund' or 'Previous' -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 ) - ) -"; } +I - value of _date field, unix timestamp + +I - user-friendly date + +I - user-friendly description of item -=item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ] +I - impact of item on user's balance +(positive for Invoice/Refund/Line item, negative for Payment/Credit.) +Not to be confused with the native 'amount' field in cust_credit, see below. -Performs a fuzzy (approximate) search and returns the matching FS::cust_main -records. Currently, I, I and/or I may be specified (the -appropriate ship_ field is also searched). +I - includes money char -Additional options are the same as FS::Record::qsearch +I - customer balance, chronologically as of this item + +I - includes money char + +I - amount charged for cust_bill (Invoice or Line item) records, undef for other types + +I - amount paid for cust_pay records, undef for other types + +I - amount credited for cust_credit records, undef for other types. +Literally the 'amount' field from cust_credit, renamed here to avoid confusion. + +I - amount refunded for cust_refund records, undef for other types + +The four table-specific keys always have positive values, whether they reflect charges or payments. + +The following options may be passed to this method: + +I - if true, returns charges ('Line item') rather than invoices + +I - unix timestamp, only include records on or after. +If specified, an item of type 'Previous' will also be included. +It does not have table-specific fields. + +I - unix timestamp, only include records before + +I - order from newest to oldest (default is oldest to newest) + +I - optional already-loaded FS::Conf object. =cut -sub fuzzy_search { - my( $self, $fuzzy, $hash, @opt) = @_; - #$self - $hash ||= {}; - my @cust_main = (); +# Caution: this gets used by FS::ClientAPI::MyAccount::billing_history, +# and also for sending customer statements, which should both be kept customer-friendly. +# If you add anything that shouldn't be passed on through the API or exposed +# to customers, add a new option to include it, don't include it by default +sub payment_history { + my $self = shift; + my $opt = ref($_[0]) ? $_[0] : { @_ }; + + my $conf = $$opt{'conf'} || new FS::Conf; + my $money_char = $conf->config("money_char") || '$', + + #first load entire history, + #need previous to calculate previous balance + #loading after end_date shouldn't hurt too much? + my @history = (); + if ( $$opt{'line_items'} ) { + + foreach my $cust_bill ( $self->cust_bill ) { + + push @history, { + 'type' => 'Line item', + 'description' => $_->desc( $self->locale ). + ( $_->sdate && $_->edate + ? ' '. time2str('%d-%b-%Y', $_->sdate). + ' To '. time2str('%d-%b-%Y', $_->edate) + : '' + ), + 'amount' => sprintf('%.2f', $_->setup + $_->recur ), + 'charged' => sprintf('%.2f', $_->setup + $_->recur ), + 'date' => $cust_bill->_date, + 'date_pretty' => $self->time2str_local('short', $cust_bill->_date ), + } + foreach $cust_bill->cust_bill_pkg; + + } + + } else { + + push @history, { + 'type' => 'Invoice', + 'description' => 'Invoice #'. $_->display_invnum, + 'amount' => sprintf('%.2f', $_->charged ), + 'charged' => sprintf('%.2f', $_->charged ), + 'date' => $_->_date, + 'date_pretty' => $self->time2str_local('short', $_->_date ), + } + foreach $self->cust_bill; - check_and_rebuild_fuzzyfiles(); - foreach my $field ( keys %$fuzzy ) { - my %match = (); - $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, - ['i'], - @{ $self->all_X($field) } - ) - ); + } - my @fcust = (); - foreach ( keys %match ) { - push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt); - push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt); + push @history, { + 'type' => 'Payment', + 'description' => 'Payment', #XXX type + 'amount' => sprintf('%.2f', 0 - $_->paid ), + 'paid' => sprintf('%.2f', $_->paid ), + 'date' => $_->_date, + 'date_pretty' => $self->time2str_local('short', $_->_date ), + } + foreach $self->cust_pay; + + push @history, { + 'type' => 'Credit', + 'description' => 'Credit', #more info? + 'amount' => sprintf('%.2f', 0 -$_->amount ), + 'credit' => sprintf('%.2f', $_->amount ), + 'date' => $_->_date, + 'date_pretty' => $self->time2str_local('short', $_->_date ), + } + foreach $self->cust_credit; + + push @history, { + 'type' => 'Refund', + 'description' => 'Refund', #more info? type, like payment? + 'amount' => $_->refund, + 'refund' => $_->refund, + 'date' => $_->_date, + 'date_pretty' => $self->time2str_local('short', $_->_date ), + } + foreach $self->cust_refund; + + #put it all in chronological order + @history = sort { $a->{'date'} <=> $b->{'date'} } @history; + + #calculate balance, filter items outside date range + my $previous = 0; + my $balance = 0; + my @out = (); + foreach my $item (@history) { + last if $$opt{'end_date'} && ($$item{'date'} >= $$opt{'end_date'}); + $balance += $$item{'amount'}; + if ($$opt{'start_date'} && ($$item{'date'} < $$opt{'start_date'})) { + $previous += $$item{'amount'}; + next; } - my %fsaw = (); - push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust; + $$item{'balance'} = sprintf("%.2f",$balance); + foreach my $key ( qw(amount balance) ) { + $$item{$key.'_pretty'} = money_pretty($$item{$key}); + } + push(@out,$item); } - # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes - my %saw = (); - @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main; + # start with previous balance, if there was one + if ($previous) { + my $item = { + 'type' => 'Previous', + '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) ) { + $$item{$key.'_pretty'} = $$item{$key}; + $$item{$key.'_pretty'} =~ s/^(-?)/$1$money_char/; + } + unshift(@out,$item); + } - @cust_main; + @out = reverse @history if $$opt{'reverse_sort'}; + return @out; } =back -=head1 SUBROUTINES +=head1 CLASS METHODS =over 4 -=item smart_search OPTION => VALUE ... +=item statuses + +Class method that returns the list of possible status strings for customers +(see L). For example: + + @statuses = FS::cust_main->statuses(); + +=cut + +sub statuses { + my $self = shift; + keys %{ $self->statuscolors }; +} + +=item cust_status_sql + +Returns an SQL fragment to determine the status of a cust_main record, as a +string. + +=cut + +sub cust_status_sql { + my $sql = 'CASE'; + for my $status ( FS::cust_main->statuses() ) { + my $method = $status.'_sql'; + $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'"; + } + $sql .= ' END'; + return $sql; +} -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, -first searching for an exact match then fuzzy and substring matches (in some -cases - see the source code for the exact heuristics used). -Any additional options treated as an additional qualifier on the search -(i.e. I). +=item prospect_sql -Returns a (possibly empty) array of FS::cust_main objects. +Returns an SQL expression identifying prospective cust_main records (customers +with no packages ever ordered) =cut -sub smart_search { - my %options = @_; +use vars qw($select_count_pkgs); +$select_count_pkgs = + "SELECT COUNT(*) FROM cust_pkg + WHERE cust_pkg.custnum = cust_main.custnum"; - #here is the agent virtualization - my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql; +sub select_count_pkgs_sql { + $select_count_pkgs; +} - my @cust_main = (); +sub prospect_sql { + " 0 = ( $select_count_pkgs ) "; +} - my $search = delete $options{'search'}; - ( my $alphanum_search = $search ) =~ s/\W//g; - - if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search - - #false laziness w/Record::ut_phone - my $phonen = "$1-$2-$3"; - $phonen .= " x$4" if $4; - - push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => { %options }, - 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ). - ' ( '. - join(' OR ', map "$_ = '$phonen'", - qw( daytime night fax - ship_daytime ship_night ship_fax ) - ). - ' ) '. - " AND $agentnums_sql", #agent virtualization - } ); +=item ordered_sql - unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match - #try looking for matches with extensions unless one was specified - - push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => { %options }, - 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ). - ' ( '. - join(' OR ', map "$_ LIKE '$phonen\%'", - qw( daytime night - ship_daytime ship_night ) - ). - ' ) '. - " AND $agentnums_sql", #agent virtualization - } ); +Returns an SQL expression identifying ordered cust_main records (customers with +no active packages, but recurring packages not yet setup or one time charges +not yet billed). - } +=cut + +sub ordered_sql { + FS::cust_main->none_active_sql. + " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) "; +} - } elsif ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search +=item active_sql - push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => { 'custnum' => $1, %options }, - 'extra_sql' => " AND $agentnums_sql", #agent virtualization - } ); +Returns an SQL expression identifying active cust_main records (customers with +active recurring packages). - } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) { +=cut - my($company, $last, $first) = ( $1, $2, $3 ); +sub active_sql { + " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) "; +} - # "Company (Last, First)" - #this is probably something a browser remembered, - #so just do an exact search +=item none_active_sql - foreach my $prefix ( '', 'ship_' ) { - push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => { $prefix.'first' => $first, - $prefix.'last' => $last, - $prefix.'company' => $company, - %options, - }, - 'extra_sql' => " AND $agentnums_sql", - } ); - } +Returns an SQL expression identifying cust_main records with no active +recurring packages. This includes customers of status prospect, ordered, +inactive, and suspended. - } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search - # try (ship_){last,company} +=cut - my $value = lc($1); +sub none_active_sql { + " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) "; +} - # # remove "(Last, First)" in "Company (Last, First)", otherwise the - # # full strings the browser remembers won't work - # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name +=item inactive_sql - use Lingua::EN::NameParse; - my $NameParse = new Lingua::EN::NameParse( - auto_clean => 1, - allow_reversed => 1, - ); +Returns an SQL expression identifying inactive cust_main records (customers with +no active recurring packages, but otherwise unsuspended/uncancelled). - my($last, $first) = ( '', '' ); - #maybe disable this too and just rely on NameParse? - if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First - - ($last, $first) = ( $1, $2 ); - - #} elsif ( $value =~ /^(.+)\s+(.+)$/ ) { - } elsif ( ! $NameParse->parse($value) ) { +=cut - my %name = $NameParse->components; - $first = $name{'given_name_1'}; - $last = $name{'surname_1'}; +sub inactive_sql { + FS::cust_main->none_active_sql. + " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) "; +} - } +=item susp_sql +=item suspended_sql + +Returns an SQL expression identifying suspended cust_main records. - if ( $first && $last ) { +=cut - my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) ); - #exact - my $sql = scalar(keys %options) ? ' AND ' : ' WHERE '; - $sql .= " - ( ( LOWER(last) = $q_last AND LOWER(first) = $q_first ) - OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first ) - )"; +sub suspended_sql { susp_sql(@_); } +sub susp_sql { + FS::cust_main->none_active_sql. + " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) "; +} - push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => \%options, - 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization - } ); +=item cancel_sql +=item cancelled_sql + +Returns an SQL expression identifying cancelled cust_main records. + +=cut + +sub cancel_sql { shift->cancelled_sql(@_); } + +=item uncancel_sql +=item uncancelled_sql - # or it just be something that was typed in... (try that in a sec) +Returns an SQL expression identifying un-cancelled cust_main records. - } +=cut - my $q_value = dbh->quote($value); +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 ) + ) +"; } - #exact - my $sql = scalar(keys %options) ? ' AND ' : ' WHERE '; - $sql .= " ( LOWER(last) = $q_value - OR LOWER(company) = $q_value - OR LOWER(ship_last) = $q_value - OR LOWER(ship_company) = $q_value - )"; +=item balance_sql - push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => \%options, - 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization - } ); +Returns an SQL fragment to retreive the balance. - unless ( @cust_main ) { #no exact match, trying substring/fuzzy +=cut - #still some false laziness w/ search/cust_main.cgi +sub balance_sql { " + ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill + WHERE cust_bill.custnum = cust_main.custnum ) + - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay + WHERE cust_pay.custnum = cust_main.custnum ) + - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit + WHERE cust_credit.custnum = cust_main.custnum ) + + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund + WHERE cust_refund.custnum = cust_main.custnum ) +"; } - #substring +=item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ] - my @hashrefs = ( - { 'company' => { op=>'ILIKE', value=>"%$value%" }, }, - { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, }, - ); +Returns an SQL fragment to retreive the balance for this customer, optionally +considering invoices with date earlier than START_TIME, and not +later than END_TIME (total_owed_date minus total_unapplied_credits minus +total_unapplied_payments). - if ( $first && $last ) { +Times are specified as SQL fragments or numeric +UNIX timestamps; see L). Also see L and +L for conversion functions. The empty string can be passed +to disable that time constraint completely. - push @hashrefs, - { 'first' => { op=>'ILIKE', value=>"%$first%" }, - 'last' => { op=>'ILIKE', value=>"%$last%" }, - }, - { 'ship_first' => { op=>'ILIKE', value=>"%$first%" }, - 'ship_last' => { op=>'ILIKE', value=>"%$last%" }, - }, - ; +Available options are: - } else { +=over 4 - push @hashrefs, - { 'last' => { op=>'ILIKE', value=>"%$value%" }, }, - { 'ship_last' => { op=>'ILIKE', value=>"%$value%" }, }, - ; - } +=item unapplied_date - foreach my $hashref ( @hashrefs ) { +set to true to disregard unapplied credits, payments and refunds outside the specified time period - by default the time period restriction only applies to invoices (useful for reporting, probably a bad idea for event triggering) - push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => { %$hashref, - %options, - }, - 'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton - } ); +=item total - } +(unused. obsolete?) +set to true to remove all customer comparison clauses, for totals - #fuzzy - my @fuzopts = ( - \%options, #hashref - '', #select - " AND $agentnums_sql", #extra_sql #agent virtualization - ); - - if ( $first && $last ) { - push @cust_main, FS::cust_main->fuzzy_search( - { 'last' => $last, #fuzzy hashref - 'first' => $first }, # - @fuzopts - ); - } - foreach my $field ( 'last', 'company' ) { - push @cust_main, - FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts ); - } +=item where - } +(unused. obsolete?) +WHERE clause hashref (elements "AND"ed together) (typically used with the total option) - #eliminate duplicates - my %saw = (); - @cust_main = grep { !$saw{$_->custnum}++ } @cust_main; +=item join - } +(unused. obsolete?) +JOIN clause (typically used with the total option) - @cust_main; +=item cutoff -} +An absolute cutoff time. Payments, credits, and refunds I after this +time will be ignored. Note that START_TIME and END_TIME only limit the date +range for invoices and I payments, credits, and refunds. -=item check_and_rebuild_fuzzyfiles +=back =cut -use vars qw(@fuzzyfields); -@fuzzyfields = ( 'last', 'first', 'company' ); - -sub check_and_rebuild_fuzzyfiles { - my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; - rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields -} +sub balance_date_sql { + my( $class, $start, $end, %opt ) = @_; -=item rebuild_fuzzyfiles + my $cutoff = $opt{'cutoff'}; -=cut + my $owed = FS::cust_bill->owed_sql($cutoff); + my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff); + my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff); + my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff); -sub rebuild_fuzzyfiles { + my $j = $opt{'join'} || ''; - use Fcntl qw(:flock); + my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt ); + my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt ); + my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt ); + my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt ); - my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; - mkdir $dir, 0700 unless -d $dir; + " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh ) + + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh ) + - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh ) + - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh ) + "; - foreach my $fuzzy ( @fuzzyfields ) { +} - open(LOCK,">>$dir/cust_main.$fuzzy") - or die "can't open $dir/cust_main.$fuzzy: $!"; - flock(LOCK,LOCK_EX) - or die "can't lock $dir/cust_main.$fuzzy: $!"; +=item unapplied_payments_date_sql START_TIME [ END_TIME ] - open (CACHE,">$dir/cust_main.$fuzzy.tmp") - or die "can't open $dir/cust_main.$fuzzy.tmp: $!"; +Returns an SQL fragment to retreive the total unapplied payments for this +customer, only considering payments with date earlier than START_TIME, and +optionally not later than END_TIME. - foreach my $field ( $fuzzy, "ship_$fuzzy" ) { - my $sth = dbh->prepare("SELECT $field FROM cust_main". - " WHERE $field != '' AND $field IS NOT NULL"); - $sth->execute or die $sth->errstr; +Times are specified as SQL fragments or numeric +UNIX timestamps; see L). Also see L and +L for conversion functions. The empty string can be passed +to disable that time constraint completely. - while ( my $row = $sth->fetchrow_arrayref ) { - print CACHE $row->[0]. "\n"; - } +Available options are: - } +=cut - close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!"; - - rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy"; - close LOCK; - } +sub unapplied_payments_date_sql { + my( $class, $start, $end, %opt ) = @_; -} + my $cutoff = $opt{'cutoff'}; -=item all_X + my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff); -=cut + my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end, + 'unapplied_date'=>1 ); -sub all_X { - my( $self, $field ) = @_; - my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; - open(CACHE,"<$dir/cust_main.$field") - or die "can't open $dir/cust_main.$field: $!"; - my @array = map { chomp; $_; } ; - close CACHE; - \@array; + " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) "; } -=item append_fuzzyfiles LASTNAME COMPANY +=item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ] -=cut +Helper method for balance_date_sql; name (and usage) subject to change +(suggestions welcome). -sub append_fuzzyfiles { - #my( $first, $last, $company ) = @_; +Returns a WHERE clause for the specified monetary TABLE (cust_bill, +cust_refund, cust_credit or cust_pay). - &check_and_rebuild_fuzzyfiles; +If TABLE is "cust_bill" or the unapplied_date option is true, only +considers records with date earlier than START_TIME, and optionally not +later than END_TIME . - use Fcntl qw(:flock); +=cut - my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; +sub _money_table_where { + my( $class, $table, $start, $end, %opt ) = @_; - foreach my $field (qw( first last company )) { - my $value = shift; + my @where = (); + push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'}; + if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) { + push @where, "$table._date <= $start" if defined($start) && length($start); + push @where, "$table._date > $end" if defined($end) && length($end); + } + push @where, @{$opt{'where'}} if $opt{'where'}; + my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : ''; - if ( $value ) { + $where; - open(CACHE,">>$dir/cust_main.$field") - or die "can't open $dir/cust_main.$field: $!"; - flock(CACHE,LOCK_EX) - or die "can't lock $dir/cust_main.$field: $!"; +} - print CACHE "$value\n"; +#for dyanmic FS::$table->search in httemplate/misc/email_customers.html +use FS::cust_main::Search; +sub search { + my $class = shift; + FS::cust_main::Search->search(@_); +} - flock(CACHE,LOCK_UN) - or die "can't unlock $dir/cust_main.$field: $!"; - close CACHE; - } +=back - } +=head1 SUBROUTINES - 1; -} +=over 4 -=item batch_import +=item batch_charge =cut -sub batch_import { +sub batch_charge { my $param = shift; #warn join('-',keys %$param); my $fh = $param->{filehandle}; my $agentnum = $param->{agentnum}; + my $format = $param->{format}; - my $refnum = $param->{refnum}; - my $pkgpart = $param->{pkgpart}; + my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql; - #my @fields = @{$param->{fields}}; - my $format = $param->{'format'}; my @fields; - my $payby; if ( $format eq 'simple' ) { - @fields = qw( cust_pkg.setup dayphone first last - address1 address2 city state zip comments ); - $payby = 'BILL'; - } elsif ( $format eq 'extended' ) { - @fields = qw( agent_custid refnum - last first address1 address2 city state zip country - daytime night - ship_last ship_first ship_address1 ship_address2 - ship_city ship_state ship_zip ship_country - payinfo paycvv paydate - invoicing_list - cust_pkg.pkgpart - svc_acct.username svc_acct._password - ); - $payby = 'CARD'; + @fields = qw( custnum agent_custid amount pkg ); } else { die "unknown format $format"; } @@ -4407,106 +5193,58 @@ sub batch_import { my @columns = $csv->fields(); #warn join('-',@columns); - my %cust_main = ( - agentnum => $agentnum, - refnum => $refnum, - country => $conf->config('countrydefault') || 'US', - payby => $payby, #default - paydate => '12/2037', #default - ); - my $billtime = time; - my %cust_pkg = ( pkgpart => $pkgpart ); - my %svc_acct = (); + my %row = (); foreach my $field ( @fields ) { - - if ( $field =~ /^cust_pkg\.(pkgpart|setup|bill|susp|expire|cancel)$/ ) { - - #$cust_pkg{$1} = str2time( shift @$columns ); - if ( $1 eq 'pkgpart' ) { - $cust_pkg{$1} = shift @columns; - } elsif ( $1 eq 'setup' ) { - $billtime = str2time(shift @columns); - } else { - $cust_pkg{$1} = str2time( shift @columns ); - } - - } elsif ( $field =~ /^svc_acct\.(username|_password)$/ ) { - - $svc_acct{$1} = shift @columns; - - } else { - - #refnum interception - if ( $field eq 'refnum' && $columns[0] !~ /^\s*(\d+)\s*$/ ) { - - my $referral = $columns[0]; - my $part_referral = new FS::part_referral { - 'referral' => $referral, - 'agentnum' => $agentnum, - }; - - my $error = $part_referral->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "can't auto-insert advertising source: $referral: $error"; - } - $columns[0] = $part_referral->refnum; - } - - #$cust_main{$field} = shift @$columns; - $cust_main{$field} = shift @columns; - } + $row{$field} = shift @columns; } - my $invoicing_list = $cust_main{'invoicing_list'} - ? [ delete $cust_main{'invoicing_list'} ] - : []; - - my $cust_main = new FS::cust_main ( \%cust_main ); - - use Tie::RefHash; - tie my %hash, 'Tie::RefHash'; #this part is important - - if ( $cust_pkg{'pkgpart'} ) { - my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ); - - my @svc_acct = (); - if ( $svc_acct{'username'} ) { - $svc_acct{svcpart} = $cust_pkg->part_pkg->svcpart( 'svc_acct' ); - push @svc_acct, new FS::svc_acct ( \%svc_acct ) - } + if ( $row{custnum} && $row{agent_custid} ) { + dbh->rollback if $oldAutoCommit; + return "can't specify custnum with agent_custid $row{agent_custid}"; + } - $hash{$cust_pkg} = \@svc_acct; + my %hash = (); + if ( $row{agent_custid} && $agentnum ) { + %hash = ( 'agent_custid' => $row{agent_custid}, + 'agentnum' => $agentnum, + ); } - my $error = $cust_main->insert( \%hash, $invoicing_list ); + if ( $row{custnum} ) { + %hash = ( 'custnum' => $row{custnum} ); + } - if ( $error ) { + unless ( scalar(keys %hash) ) { $dbh->rollback if $oldAutoCommit; - return "can't insert customer for $line: $error"; + return "can't find customer without custnum or agent_custid and agentnum"; } - if ( $format eq 'simple' ) { + my $cust_main = qsearchs('cust_main', { %hash } ); + unless ( $cust_main ) { + $dbh->rollback if $oldAutoCommit; + my $custnum = $row{custnum} || $row{agent_custid}; + return "unknown custnum $custnum"; + } - #false laziness w/bill.cgi - $error = $cust_main->bill( 'time' => $billtime ); + if ( $row{'amount'} > 0 ) { + my $error = $cust_main->charge($row{'amount'}, $row{'pkg'}); if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "can't bill customer for $line: $error"; + return $error; } - - $cust_main->apply_payments; - $cust_main->apply_credits; - - $error = $cust_main->collect(); + $imported++; + } elsif ( $row{'amount'} < 0 ) { + my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ), + $row{'pkg'} ); if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "can't collect customer for $line: $error"; + return $error; } - + $imported++; + } else { + #hmm? } - $imported++; } $dbh->commit or die $dbh->errstr if $oldAutoCommit; @@ -4517,86 +5255,455 @@ sub batch_import { } -=item batch_charge +=item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS -=cut +Deprecated. Use event notification and message templates +(L) instead. -sub batch_charge { - my $param = shift; - #warn join('-',keys %$param); - my $fh = $param->{filehandle}; - my @fields = @{$param->{fields}}; +Sends a templated email notification to the customer (see L). - eval "use Text::CSV_XS;"; - die $@ if $@; +OPTIONS is a hash and may include - my $csv = new Text::CSV_XS; - #warn $csv; - #warn $fh; +I - the email sender (default is invoice_from) - my $imported = 0; - #my $columns; +I - comma-separated scalar or arrayref of recipients + (default is invoicing_list) - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; +I - The subject line of the sent email notification + (default is "Notice from company_name") - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; +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 ($self, $template, %options) = @_; + + return unless $conf->exists($template); + + my $from = $conf->invoice_from_full($self->agentnum) + if $conf->exists('invoice_from', $self->agentnum); + $from = $options{from} if exists($options{from}); + + my $to = join(',', $self->invoicing_list_emailonly); + $to = $options{to} if exists($options{to}); - #while ( $columns = $csv->getline($fh) ) { - my $line; - while ( defined($line=<$fh>) ) { + my $subject = "Notice from " . $conf->config('company_name', $self->agentnum) + if $conf->exists('company_name', $self->agentnum); + $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"; + + $FS::notify_template::_template::company_name = + $conf->config('company_name', $self->agentnum); + $FS::notify_template::_template::company_address = + join("\n", $conf->config('company_address', $self->agentnum) ). "\n"; + + my $paydate = $self->paydate || '2037-12-31'; + $FS::notify_template::_template::first = $self->first; + $FS::notify_template::_template::last = $self->last; + $FS::notify_template::_template::company = $self->company; + $FS::notify_template::_template::payinfo = $self->mask_payinfo; + my $payby = $self->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; - $csv->parse($line) or do { - $dbh->rollback if $oldAutoCommit; - return "can't parse: ". $csv->error_input(); - }; + for (keys %{$options{extra_fields}}){ + no strict "refs"; + ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_}; + } - my @columns = $csv->fields(); - #warn join('-',@columns); + send_email(from => $from, + to => $to, + subject => $subject, + body => $notify_template->fill_in( PACKAGE => + 'FS::notify_template::_template' ), + ); - my %row = (); - foreach my $field ( @fields ) { - $row{$field} = shift @columns; - } +} - my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } ); - unless ( $cust_main ) { - $dbh->rollback if $oldAutoCommit; - return "unknown custnum $row{'custnum'}"; - } +=item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS - if ( $row{'amount'} > 0 ) { - my $error = $cust_main->charge($row{'amount'}, $row{'pkg'}); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - $imported++; - } elsif ( $row{'amount'} < 0 ) { - my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ), - $row{'pkg'} ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - $imported++; +Generates a templated notification to the customer (see L). + +OPTIONS is a hash and may include + +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. + +I<$payby> - a description of the method of payment for the customer + # would be nice to use FS::payby::shortname +I<$payinfo> - the masked account information used to collect for this customer +I<$expdate> - the expiration of the customer payment method in seconds from epoch +I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address + +=cut + +# a lot like cust_bill::print_latex +sub generate_letter { + my ($self, $template, %options) = @_; + + 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 => $template_source, + DELIMITERS => [ '[@--', '--@]' ], + ) + or die "can't create new Text::Template object: Text::Template::ERROR"; + + $letter_template->compile() + or die "can't compile template: Text::Template::ERROR"; + + my %letter_data = map { $_ => $self->$_ } $self->fields; + $letter_data{payinfo} = $self->mask_payinfo; + + #my $paydate = $self->paydate || '2037-12-31'; + my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31'; + + my $payby = $self->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') { + $letter_data{payby} = 'credit card'; + ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++); + $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear); + $expire_time--; + }elsif ($payby eq 'COMP') { + $letter_data{payby} = 'complimentary account'; + }else{ + $letter_data{payby} = 'current method'; + } + $letter_data{expdate} = $expire_time; + + for (keys %{$options{extra_fields}}){ + $letter_data{$_} = $options{extra_fields}->{$_}; + } + + unless(exists($letter_data{returnaddress})){ + my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress', + $self->agent_template) + ); + if ( length($retadd) ) { + $letter_data{returnaddress} = $retadd; + } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) { + $letter_data{returnaddress} = + join( "\n", map { s/( {2,})/'~' x length($1)/eg; + s/$/\\\\\*/; + $_; + } + ( $conf->config('company_name', $self->agentnum), + $conf->config('company_address', $self->agentnum), + ) + ); } else { - #hmm? + $letter_data{returnaddress} = '~'; + } + } + + $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc"; + + $letter_data{company_name} = $conf->config('company_name', $self->agentnum); + + my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc; + + my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX', + DIR => $dir, + SUFFIX => '.eps', + UNLINK => 0, + ) or die "can't open temp file: $!\n"; + print $lh $conf->config_binary('logo.eps', $self->agentnum) + or die "can't write temp file: $!\n"; + close $lh; + $letter_data{'logo_file'} = $lh->filename; + + my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX', + DIR => $dir, + SUFFIX => '.tex', + UNLINK => 0, + ) or die "can't open temp file: $!\n"; + + $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data ); + close $fh; + $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename; + return ($1, $letter_data{'logo_file'}); + +} + +=item print_ps TEMPLATE + +Returns an postscript letter filled in from TEMPLATE, as a scalar. + +=cut + +sub print_ps { + my $self = shift; + my($file, $lfile) = $self->generate_letter(@_); + my $ps = FS::Misc::generate_ps($file); + unlink($file.'.tex'); + unlink($lfile); + + $ps; +} + +=item print TEMPLATE + +Prints the filled in template. + +TEMPLATE is the name of a L to fill in and print. + +=cut + +sub queueable_print { + my %opt = @_; + + my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } ) + or die "invalid customer number: " . $opt{custnum}; + + my $error = $self->print( { 'template' => $opt{template} } ); + die $error if $error; +} + +sub print { + my ($self, $template) = (shift, shift); + do_print( + [ $self->print_ps($template) ], + 'agentnum' => $self->agentnum, + ); +} + +#these three subs should just go away once agent stuff is all config overrides + +sub agent_template { + my $self = shift; + $self->_agent_plandata('agent_templatename'); +} + +sub agent_invoice_from { + my $self = shift; + $self->_agent_plandata('agent_invoice_from'); +} + +sub _agent_plandata { + my( $self, $option ) = @_; + + #yuck. this whole thing needs to be reconciled better with 1.9's idea of + #agent-specific Conf + + use FS::part_event::Condition; + + my $agentnum = $self->agentnum; + + my $regexp = regexp_sql(); + + my $part_event_option = + qsearchs({ + 'select' => 'part_event_option.*', + 'table' => 'part_event_option', + 'addl_from' => q{ + LEFT JOIN part_event USING ( eventpart ) + LEFT JOIN part_event_option AS peo_agentnum + ON ( part_event.eventpart = peo_agentnum.eventpart + AND peo_agentnum.optionname = 'agentnum' + AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)' + ) + LEFT JOIN part_event_condition + ON ( part_event.eventpart = part_event_condition.eventpart + AND part_event_condition.conditionname = 'cust_bill_age' + ) + LEFT JOIN part_event_condition_option + ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum + AND part_event_condition_option.optionname = 'age' + ) + }, + #'hashref' => { 'optionname' => $option }, + #'hashref' => { 'part_event_option.optionname' => $option }, + 'extra_sql' => + " WHERE part_event_option.optionname = ". dbh->quote($option). + " AND action = 'cust_bill_send_agent' ". + " AND ( disabled IS NULL OR disabled != 'Y' ) ". + " AND peo_agentnum.optionname = 'agentnum' ". + " AND ( agentnum IS NULL OR agentnum = $agentnum ) ". + " ORDER BY + CASE WHEN part_event_condition_option.optionname IS NULL + THEN -1 + ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue'). + " END + , part_event.weight". + " LIMIT 1" + }); + + unless ( $part_event_option ) { + return $self->agent->invoice_template || '' + if $option eq 'agent_templatename'; + return ''; + } + + $part_event_option->optionvalue; + +} + +=item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ] + +Subroutine (not a method), designed to be called from the queue. + +Takes a list of options and values. + +Pulls up the customer record via the custnum option and calls bill_and_collect. + +=cut + +sub queued_bill { + my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_; + + my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } ); + warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid + + #without this errors don't get rolled back + $args{'fatal'} = 1; # runs from job queue, will be caught + + $cust_main->bill_and_collect( %args ); +} + +sub process_bill_and_collect { + my $job = shift; + my $param = thaw(decode_base64(shift)); + my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } ) + or die "custnum '$param->{custnum}' not found!\n"; + $param->{'job'} = $job; + $param->{'fatal'} = 1; # runs from job queue, will be caught + $param->{'retry'} = 1; + + $cust_main->bill_and_collect( %$param ); +} + +#starting to take quite a while for big dbs +# (JRNL: journaled so it only happens once per database) +# - seq scan of h_cust_main (yuck), but not going to index paycvv, so +# JRNL seq scan of cust_main on signupdate... index signupdate? will that help? +# JRNL seq scan of cust_main on paydate... index on substrings? maybe set an +# JRNL seq scan of cust_main on payinfo.. certainly not going toi ndex that... +# JRNL leading/trailing spaces in first, last, company +# - otaker upgrade? journal and call it good? (double check to make sure +# we're not still setting otaker here) +# +#only going to get worse with new location stuff... + +sub _upgrade_data { #class method + my ($class, %opts) = @_; + + my @statements = ( + 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL', + ); + + #this seems to be the only expensive one.. why does it take so long? + unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) { + push @statements, + 'UPDATE cust_main SET signupdate = (SELECT signupdate FROM h_cust_main WHERE signupdate IS NOT NULL AND h_cust_main.custnum = cust_main.custnum ORDER BY historynum DESC LIMIT 1) WHERE signupdate IS NULL'; + FS::upgrade_journal->set_done('cust_main__signupdate'); + } + + unless ( FS::upgrade_journal->is_done('cust_main__paydate') ) { + + # fix yyyy-m-dd formatted paydates + if ( driver_name =~ /^mysql/i ) { + push @statements, + "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'"; + } else { # the SQL standard + push @statements, + "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'"; } + FS::upgrade_journal->set_done('cust_main__paydate'); + } + + unless ( FS::upgrade_journal->is_done('cust_main__payinfo') ) { + + push @statements, #fix the weird BILL with a cc# in payinfo problem + #DCRD to be safe + "UPDATE cust_main SET payby = 'DCRD' WHERE payby = 'BILL' and length(payinfo) = 16 and payinfo ". regexp_sql. q( '^[0-9]*$' ); + FS::upgrade_journal->set_done('cust_main__payinfo'); + } - $dbh->commit or die $dbh->errstr if $oldAutoCommit; + my $t = time; + foreach my $sql ( @statements ) { + my $sth = dbh->prepare($sql) or die dbh->errstr; + $sth->execute or die $sth->errstr; + #warn ( (time - $t). " seconds\n" ); + #$t = time; + } - return "Empty file!" unless $imported; + local($ignore_expired_card) = 1; + local($ignore_banned_card) = 1; + local($skip_fuzzyfiles) = 1; + local($import) = 1; #prevent automatic geocoding (need its own variable?) + + FS::cust_main::Location->_upgrade_data(%opts); + + unless ( FS::upgrade_journal->is_done('cust_main__trimspaces') ) { + + foreach my $cust_main ( qsearch({ + 'table' => 'cust_main', + 'hashref' => {}, + 'extra_sql' => 'WHERE '. + join(' OR ', + map "$_ LIKE ' %' OR $_ LIKE '% ' OR $_ LIKE '% %'", + qw( first last company ) + ), + }) ) { + my $error = $cust_main->replace; + die $error if $error; + } - ''; #no error + FS::upgrade_journal->set_done('cust_main__trimspaces'); + + } + + $class->_upgrade_otaker(%opts); } @@ -4619,6 +5726,13 @@ No multiple currency support (probably a larger project than just this module). payinfo_masked false laziness with cust_pay.pm and cust_refund.pm +Birthdates rely on negative epoch values. + +The payby for card/check batches is broken. With mixed batching, bad +things will happen. + +B I should be renamed I