correct internal reason searching, prevent interleaved suspend/cancel/expire/adjourn...

[freeside.git] / FS / FS / part_export / sqlradius.pm

diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm
index 4190b03..88b7ed3 100644 (file)
--- a/FS/FS/part_export/sqlradius.pm
+++ b/FS/FS/part_export/sqlradius.pm
@@ -311,7 +311,7 @@ sub suspended_usergroups {
   #false laziness with FS::part_export::shellcommands
   #subclass part_export?
 
-  my $r = $svc_acct->cust_svc->cust_pkg->last_reason;
+  my $r = $svc_acct->cust_svc->cust_pkg->last_reason('susp');
   my %reasonmap = $self->_groups_susp_reason_map;
   my $userspec = '';
   if ($r) {
@@ -619,9 +619,11 @@ sub update_svc_acct {
 
   my $conf = new FS::Conf;
 
+  my $fdbh = dbh;
   my $dbh = sqlradius_connect( map $self->option($_),
                                    qw( datasrc username password ) );
 
+  my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
   my @fields = qw( radacctid username realm acctsessiontime );
 
   my @param = ();
@@ -629,6 +631,7 @@ sub update_svc_acct {
 
   my $sth = $dbh->prepare("
     SELECT RadAcctId, UserName, Realm, AcctSessionTime,
+           $str2time AcctStartTime),  $str2time AcctStopTime), 
            AcctInputOctets, AcctOutputOctets
       FROM radacct
       WHERE FreesideStatus IS NULL
@@ -637,8 +640,8 @@ sub update_svc_acct {
   $sth->execute() or die $sth->errstr;
 
   while ( my $row = $sth->fetchrow_arrayref ) {
-    my($RadAcctId, $UserName, $Realm, $AcctSessionTime,
-       $AcctInputOctets, $AcctOutputOctets) = @$row;
+    my($RadAcctId, $UserName, $Realm, $AcctSessionTime, $AcctStartTime,
+       $AcctStopTime, $AcctInputOctets, $AcctOutputOctets) = @$row;
     warn "processing record: ".
          "$RadAcctId ($UserName\@$Realm for ${AcctSessionTime}s"
       if $DEBUG;
@@ -653,6 +656,9 @@ sub update_svc_acct {
                           WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
     }
 
+    my $oldAutoCommit = $FS::UID::AutoCommit; # can't undo side effects, but at
+    local $FS::UID::AutoCommit = 0;           # least we can avoid over counting
+
     my @svc_acct =
       grep { qsearch( 'export_svc', { 'exportnum' => $self->exportnum,
                                       'svcpart'   => $_->cust_svc->svcpart, } )
@@ -671,16 +677,26 @@ sub update_svc_acct {
     } elsif ( scalar(@svc_acct) > 1 ) {
       warn "WARNING: multiple svc_acct records found $errinfo - skipping\n";
     } else {
-      warn "found svc_acct ". $svc_acct[0]->svcnum. " $errinfo\n" if $DEBUG;
-      _try_decrement($svc_acct[0], 'seconds', $AcctSessionTime) 
-        and $status='done';
-      _try_decrement($svc_acct[0], 'upbytes', $AcctInputOctets)
-        and $status='done';
-      _try_decrement($svc_acct[0], 'downbytes', $AcctOutputOctets)
-        and $status='done';
-      _try_decrement($svc_acct[0], 'totalbytes', $AcctInputOctets + 
-                     $AcctOutputOctets)
-        and $status='done';
+
+      my $svc_acct = $svc_acct[0];
+      warn "found svc_acct ". $svc_acct->svcnum. " $errinfo\n" if $DEBUG;
+
+      $svc_acct->last_login($AcctStartTime);
+      $svc_acct->last_logout($AcctStopTime);
+
+      my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
+      if ( $cust_pkg && $AcctStopTime < (    $cust_pkg->last_bill
+                                          || $cust_pkg->setup     )  ) {
+        $status = 'skipped (too old)';
+      } else {
+        my @st;
+        push @st, _try_decrement($svc_acct, 'seconds',    $AcctSessionTime   );
+        push @st, _try_decrement($svc_acct, 'upbytes',    $AcctInputOctets   );
+        push @st, _try_decrement($svc_acct, 'downbytes',  $AcctOutputOctets  );
+        push @st, _try_decrement($svc_acct, 'totalbytes', $AcctInputOctets
+                                                          + $AcctOutputOctets);
+        $status=join(' ', @st);
+      }
     }
 
     warn "setting FreesideStatus to $status $errinfo\n" if $DEBUG; 
@@ -690,6 +706,8 @@ sub update_svc_acct {
     ) or die $dbh->errstr;
     $psth->execute($status, $RadAcctId) or die $psth->errstr;
 
+    $fdbh->commit or die $fdbh->errstr if $oldAutoCommit;
+
   }
 
 }
@@ -707,7 +725,29 @@ sub _try_decrement {
   } else {
     warn "  no existing $column value for svc_acct - skipping\n" if $DEBUG;
   }
-  return '';
+  return 'skipped';
+}
+
+###
+#class methods
+###
+
+sub all_sqlradius {
+  #my $class = shift;
+
+  #don't just look for ->can('usage_sessions'), we're sqlradius-specific
+  # (radiator is supposed to be setup with a radacct table)
+  #i suppose it would be more slick to look for things that inherit from us..
+
+  my @part_export = ();
+  push @part_export, qsearch('part_export', { 'exporttype' => $_ } )
+    foreach qw(sqlradius sqlradius_withdomain radiator);
+  @part_export;
+}
+
+sub all_sqlradius_withaccounting {
+  my $class = shift;
+  grep { ! $_->option('ignore_accounting') } $class->all_sqlradius;
 }
 
 1;