X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=06f2c46369fa3c1f117ed567f8e2346f92a3ecd9;hb=804a4999a84b827ac4ec3fa34158e097da31ade3;hp=064190a33ee6da61b9aba2e5c21302220f359e06;hpb=fa50dcaf8b9f1bdfd8ff717b0acc8cb72937c8aa;p=freeside.git

diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm
index 064190a33..06f2c4636 100644
--- a/FS/FS/cust_main.pm
+++ b/FS/FS/cust_main.pm
@@ -19,7 +19,7 @@ use String::Approx qw(amatch);
 use Business::CreditCard 0.28;
 use Locale::Country;
 use Data::Dumper;
-use FS::UID qw( getotaker dbh );
+use FS::UID qw( getotaker dbh driver_name );
 use FS::Record qw( qsearchs qsearch dbdef );
 use FS::Misc qw( send_email generate_ps do_print );
 use FS::Msgcat qw(gettext);
@@ -1595,8 +1595,8 @@ sub ncancelled_pkgs {
 
   } else {
 
-    warn "$me ncancelled_pkgs: searching for packages for custnum ".
-         $self->custnum
+    warn "$me ncancelled_pkgs: searching for packages with custnum ".
+         $self->custnum. "\n"
       if $DEBUG > 1;
 
     @cust_pkg =
@@ -1888,17 +1888,29 @@ Options are passed as name-value pairs.  Currently available options are:
 
 =over 4
 
-=item time - bills the customer as if it were that time.  Specified as a UNIX timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion functions.  For example:
+=item time
+
+Bills the customer as if it were that time.  Specified as a UNIX timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion functions.  For example:
 
  use Date::Parse;
  ...
  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
 
-=item invoice_time - used in conjunction with the I<time> option, this option specifies the date of for the generated invoices.  Other calculations, such as whether or not to generate the invoice in the first place, are not affected.
+=item invoice_time
+
+Used in conjunction with the I<time> option, this option specifies the date of for the generated invoices.  Other calculations, such as whether or not to generate the invoice in the first place, are not affected.
+
+=item check_freq
+
+"1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
+
+=item resetup
 
-=item check_freq - "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
+If set true, re-charges setup fees.
 
-=item resetup - if set true, re-charges setup fees.
+=item debug
+
+Debugging level.  Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
 
 =back
 
@@ -1965,19 +1977,27 @@ Options are passed as name-value pairs.  Currently available options are:
 
 =over 4
 
-=item resetup - if set true, re-charges setup fees.
+=item resetup
+
+If set true, re-charges setup fees.
 
-=item time - bills the customer as if it were that time.  Specified as a UNIX timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion functions.  For example:
+=item time
+
+Bills the customer as if it were that time.  Specified as a UNIX timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion functions.  For example:
 
  use Date::Parse;
  ...
  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
 
-=item pkg_list - An array ref of specific packages (objects) to attempt billing, instead trying all of them.
+=item pkg_list
+
+An array ref of specific packages (objects) to attempt billing, instead trying all of them.
 
  $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
 
-=item invoice_time - used in conjunction with the I<time> option, this option specifies the date of for the generated invoices.  Other calculations, such as whether or not to generate the invoice in the first place, are not affected.
+=item invoice_time
+
+Used in conjunction with the I<time> option, this option specifies the date of for the generated invoices.  Other calculations, such as whether or not to generate the invoice in the first place, are not affected.
 
 =back
 
@@ -2423,15 +2443,30 @@ Currently available options are:
 
 =over 4
 
-=item 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<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion functions.
+=item 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<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion functions.
+
+=item retry
+
+Retry card/echeck/LEC transactions even when not scheduled by invoice events.
+
+=item quiet
+
+set true to surpress email card/ACH decline notices.
+
+=item check_freq
+
+"1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
+
+=item payby
 
-=item retry - Retry card/echeck/LEC transactions even when not scheduled by invoice events.
+allows for one time override of normal customer billing method
 
-=item quiet - set true to surpress email card/ACH decline notices.
+=item debug
 
-=item check_freq - "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
+Debugging level.  Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
 
-=item payby - allows for one time override of normal customer billing method
 
 =back
 
@@ -2475,6 +2510,7 @@ sub collect {
   # false laziness w/pay_batch::import_results
 
   my $due_cust_event = $self->due_cust_event(
+    'debug'      => ( $options{'debug'} || 0 ),
     'time'       => $invoice_time,
     'check_freq' => $options{'check_freq'},
   );
@@ -2488,7 +2524,16 @@ sub collect {
     #XXX lock event
     
     #re-eval event conditions (a previous event could have changed things)
-    next unless $cust_event->test_conditions( 'time' => $invoice_time );
+    unless ( $cust_event->test_conditions( 'time' => $invoice_time ) ) {
+      #don't leave stray "new/locked" records around
+      my $error = $cust_event->delete;
+      if ( $error ) {
+        #gah, even with transactions
+        $dbh->commit if $oldAutoCommit; #well.
+        return $error;
+      }
+      next;
+    }
 
     {
       local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
@@ -2528,15 +2573,25 @@ options are:
 
 =over 4
 
-=item check_freq - Search only for events of this check frequency (how often events of this type are checked); currently "1d" (daily, the default) and "1m" (monthly) are recognized.
+=item check_freq
+
+Search only for events of this check frequency (how often events of this type are checked); currently "1d" (daily, the default) and "1m" (monthly) are recognized.
+
+=item time
+
+"Current time" for the events.
+
+=item debug
 
-=item time - "Current time" for the events.
+Debugging level.  Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
 
-=item debug - Debugging level.  Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), or 3 (more information)
+=item eventtable
 
-=item eventtable - Only return events for the specified eventtable (by default, events of all eventtables are returned)
+Only return events for the specified eventtable (by default, events of all eventtables are returned)
 
-=item objects - Explicitly pass the objects to be tested (typically used with eventtable).
+=item objects
+
+Explicitly pass the objects to be tested (typically used with eventtable).
 
 =back
 
@@ -2626,7 +2681,10 @@ sub due_cust_event {
 
       $extra_sql .= " $order";
 
+      warn "searching for events for $eventtable ". $object->$pkey. "\n"
+        if $opt{'debug'} > 2;
       my @part_event = qsearch( {
+        'debug'     => ( $opt{'debug'} > 3 ? 1 : 0 ),
         'select'    => 'part_event.*',
         'table'     => 'part_event',
         'addl_from' => "$cross $join",
@@ -2648,7 +2706,7 @@ sub due_cust_event {
     }
 
     warn "    ". scalar(@e_cust_event).
-         " subtotal possible cust events found for $eventtable"
+         " subtotal possible cust events found for $eventtable\n"
       if $DEBUG > 1;
 
     push @cust_event, @e_cust_event;
@@ -2673,7 +2731,8 @@ sub due_cust_event {
     if $DEBUG; # > 1;
 
   warn "    invalid conditions not eliminated with condition_sql:\n".
-       join('', map "      $_: ".$unsat{$_}."\n", keys %unsat );
+       join('', map "      $_: ".$unsat{$_}."\n", keys %unsat )
+    if $DEBUG; # > 1;
 
   ##
   # 3: insert
@@ -2760,6 +2819,7 @@ sub retry_realtime {
 
   my @cust_event = qsearchs({
     'table'     => 'cust_event',
+    'select'    => 'cust_event.*',
     'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
     'hashref'   => { 'status' => 'done' },
     'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
@@ -2799,7 +2859,7 @@ L<http://420.am/business-onlinepayment> for supported gateways.
 
 Available methods are: I<CC>, I<ECHECK> and I<LEC>
 
-Available options are: I<description>, I<invnum>, I<quiet>
+Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>
 
 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
@@ -2814,6 +2874,9 @@ call the B<apply_payments> method.
 
 I<quiet> can be set true to surpress email decline notices.
 
+I<paynum_ref> can be set to a scalar reference.  It will be filled in with the
+resulting paynum, if any.
+
 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
 
 =cut
@@ -2827,6 +2890,8 @@ sub realtime_bop {
 
   $options{'description'} ||= 'Internet services';
 
+  return $self->fake_bop($method, $amount, %options) if $options{'fake'};
+
   eval "use Business::OnlinePayment";  
   die $@ if $@;
 
@@ -3152,7 +3217,7 @@ sub realtime_bop {
        'custnum'  => $self->custnum,
        'invnum'   => $options{'invnum'},
        'paid'     => $amount,
-       '_date'     => '',
+       '_date'    => '',
        'payby'    => $method2payby{$method},
        'payinfo'  => $payinfo,
        'paybatch' => $paybatch,
@@ -3177,6 +3242,11 @@ sub realtime_bop {
         return $e;
       }
     }
+
+    if ( $options{'paynum_ref'} ) {
+      ${ $options{'paynum_ref'} } = $cust_pay->paynum;
+    }
+
     return ''; #no error
 
   } else {
@@ -3244,6 +3314,76 @@ sub realtime_bop {
 
 }
 
+=item fake_bop
+
+=cut
+
+sub fake_bop {
+  my( $self, $method, $amount, %options ) = @_;
+
+  if ( $options{'fake_failure'} ) {
+     return "Error: No error; test failure requested with fake_failure";
+  }
+
+  my %method2payby = (
+    'CC'     => 'CARD',
+    'ECHECK' => 'CHEK',
+    'LEC'    => 'LECB',
+  );
+
+  #my $paybatch = '';
+  #if ( $payment_gateway ) { # agent override
+  #  $paybatch = $payment_gateway->gatewaynum. '-';
+  #}
+  #
+  #$paybatch .= "$processor:". $transaction->authorization;
+  #
+  #$paybatch .= ':'. $transaction->order_number
+  #  if $transaction->can('order_number')
+  #  && length($transaction->order_number);
+
+  my $paybatch = 'FakeProcessor:54:32';
+
+  my $cust_pay = new FS::cust_pay ( {
+     'custnum'  => $self->custnum,
+     'invnum'   => $options{'invnum'},
+     'paid'     => $amount,
+     '_date'    => '',
+     'payby'    => $method2payby{$method},
+     #'payinfo'  => $payinfo,
+     'payinfo'  => '4111111111111111',
+     'paybatch' => $paybatch,
+     #'paydate'  => $paydate,
+     'paydate'  => '2012-05-01',
+  } );
+  $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
+
+  my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
+
+  if ( $error ) {
+    $cust_pay->invnum(''); #try again with no specific invnum
+    my $error2 = $cust_pay->insert( $options{'manual'} ?
+                                    ( 'manual' => 1 ) : ()
+                                  );
+    if ( $error2 ) {
+      # gah, even with transactions.
+      my $e = 'WARNING: Card/ACH debited but database not updated - '.
+              "error inserting (fake!) payment: $error2".
+              " (previously tried insert with invnum #$options{'invnum'}" .
+              ": $error )";
+      warn $e;
+      return $e;
+    }
+  }
+
+  if ( $options{'paynum_ref'} ) {
+    ${ $options{'paynum_ref'} } = $cust_pay->paynum;
+  }
+
+  return ''; #no error
+
+}
+
 =item default_payment_gateway
 
 =cut
@@ -3257,7 +3397,7 @@ sub default_payment_gateway {
   #load up config
   my $bop_config = 'business-onlinepayment';
   $bop_config .= '-ach'
-    if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
+    if $method =~ /^(ECHECK|CHEK)$/ && $conf->exists($bop_config. '-ach');
   my ( $processor, $login, $password, $action, @bop_options ) =
     $conf->config($bop_config);
   $action ||= 'normal authorization';
@@ -5784,18 +5924,30 @@ sub _agent_plandata {
 
   #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 = '';
+  if ( driver_name =~ /^Pg/i ) {
+    $regexp = '~';
+  } elsif ( driver_name =~ /^mysql/i ) {
+    $regexp = 'REGEXP';
+  } else {
+    die "don't know how to use regular expressions in ". driver_name. " databases";
+  }
+
   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 ~ '(^|,)}. $agentnum. q{(,|$)'
+               AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
              )
         LEFT JOIN part_event_option AS peo_cust_bill_age
           ON ( part_event.eventpart = peo_cust_bill_age.eventpart
@@ -5806,27 +5958,22 @@ sub _agent_plandata {
       #'hashref'   => { 'part_event_option.optionname' => $option },
       'extra_sql' =>
         " WHERE part_event_option.optionname = ". dbh->quote($option).
-        " AND action = 'cust_bill_send_agent' "
+        " 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 peo_cust_bill_age.optionname != 'cust_bill_age'
            THEN -1
-           ELSE EXTRACT( EPOCH FROM
-                           REPLACE( peo_cust_bill_age.optionvalue,
-                                    'm',
-                                    'mon'
-                                  )::interval
-                       )
-          END
+	   ELSE ". FS::part_event::Condition->age2seconds_sql('peo_cust_bill_age.optionvalue').
+        " END
           , part_event.weight".
         " LIMIT 1"
     });
     
   unless ( $part_event_option ) {
     return $self->agent->invoice_template || ''
-      if $option eq '$agent_templatename';
+      if $option eq 'agent_templatename';
     return '';
   }