event refactor, landing on HEAD!
[freeside.git] / FS / FS / part_export / sqlradius.pm
index 04d6512..2615a16 100644 (file)
@@ -6,6 +6,7 @@ use FS::Record qw( dbh qsearch qsearchs );
 use FS::part_export;
 use FS::svc_acct;
 use FS::export_svc;
+use Carp qw( cluck );
 
 @ISA = qw(FS::part_export);
 
@@ -31,8 +32,9 @@ tie %options, 'Tie::IxHash',
     type  => 'checkbox',
     label => 'Show the Called-Station-ID on session reports',
   },
+  'overlimit_groups' => { label => 'Radius groups to assign to svc_acct which has exceeded its bandwidth or time limit', } ,
   'groups_susp_reason' => { label =>
-                             'Radius group mapping to reason (via template user)',
+                             'Radius group mapping to reason (via template user) (svcnum|username|username@domain  reasonnum|reason)',
                             type  => 'textarea',
                           },
 
@@ -105,6 +107,9 @@ sub _export_insert {
   }
   my @groups = $svc_acct->radius_groups;
   if ( @groups ) {
+    cluck localtime(). ": queuing usergroup_insert for ". $svc_acct->svcnum.
+          " (". $self->export_username($svc_acct). " with ". join(", ", @groups)
+      if $DEBUG;
     my $err_or_queue = $self->sqlradius_queue(
       $svc_acct->svcnum, 'usergroup_insert',
       $self->export_username($svc_acct), @groups );
@@ -202,7 +207,7 @@ sub _export_suspend {
   my( $self, $svc_acct ) = (shift, shift);
 
   my $new = $svc_acct->clone_suspended;
-
+  
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
   local $SIG{QUIT} = 'IGNORE';
@@ -373,10 +378,22 @@ sub sqlradius_usergroup_insert { #subroutine, not method
   my $dbh = sqlradius_connect(shift, shift, shift);
   my( $username, @groups ) = @_;
 
+  my $s_sth = $dbh->prepare(
+    "SELECT COUNT(*) FROM usergroup WHERE UserName = ? AND GroupName = ?"
+  ) or die $dbh->errstr;
+
   my $sth = $dbh->prepare( 
     "INSERT INTO usergroup ( UserName, GroupName ) VALUES ( ?, ? )"
   ) or die $dbh->errstr;
+
   foreach my $group ( @groups ) {
+    $s_sth->execute( $username, $group ) or die $s_sth->errstr;
+    if ($s_sth->fetchrow_arrayref->[0]) {
+      warn localtime() . ": sqlradius_usergroup_insert attempted to reinsert " .
+           "$group for $username\n"
+        if $DEBUG;
+      next;
+    }
     $sth->execute( $username, $group )
       or die "can't insert into groupname table: ". $sth->errstr;
   }
@@ -468,6 +485,9 @@ sub sqlreplace_usergroups {
   }
 
   if ( @newgroups ) {
+    cluck localtime(). ": queuing usergroup_insert for $svcnum ($username) ".
+          "with ".  join(", ", @newgroups)
+      if $DEBUG;
     my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_insert',
       $username, @newgroups );
     return $err_or_queue
@@ -615,7 +635,8 @@ sub update_svc_acct {
   my $where = '';
 
   my $sth = $dbh->prepare("
-    SELECT RadAcctId, UserName, Realm, AcctSessionTime
+    SELECT RadAcctId, UserName, Realm, AcctSessionTime,
+           AcctInputOctets, AcctOutputOctets
       FROM radacct
       WHERE FreesideStatus IS NULL
         AND AcctStopTime != 0
@@ -623,7 +644,8 @@ sub update_svc_acct {
   $sth->execute() or die $sth->errstr;
 
   while ( my $row = $sth->fetchrow_arrayref ) {
-    my($RadAcctId, $UserName, $Realm, $AcctSessionTime) = @$row;
+    my($RadAcctId, $UserName, $Realm, $AcctSessionTime,
+       $AcctInputOctets, $AcctOutputOctets) = @$row;
     warn "processing record: ".
          "$RadAcctId ($UserName\@$Realm for ${AcctSessionTime}s"
       if $DEBUG;
@@ -633,7 +655,6 @@ sub update_svc_acct {
     if ( ref($self) =~ /withdomain/ ) { #well...
       $extra_sql = " AND '$Realm' = ( SELECT domain FROM svc_domain
                           WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
-      my $svc_domain = qsearch
     }
 
     my @svc_acct =
@@ -654,18 +675,16 @@ sub update_svc_acct {
     } elsif ( scalar(@svc_acct) > 1 ) {
       warn "WARNING: multiple svc_acct records found $errinfo - skipping\n";
     } else {
-      my $svc_acct = $svc_acct[0];
-      warn "found svc_acct ". $svc_acct->svcnum. " $errinfo\n" if $DEBUG;
-      if ( $svc_acct->seconds !~ /^$/ ) {
-        warn "  svc_acct.seconds found (". $svc_acct->seconds.
-             ") - decrementing\n"
-          if $DEBUG;
-        my $error = $svc_acct->decrement_seconds($AcctSessionTime);
-        die $error if $error;
-        $status = 'done';
-      } else {
-        warn "  no existing seconds value for svc_acct - skiping\n" if $DEBUG;
-      }
+      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';
     }
 
     warn "setting FreesideStatus to $status $errinfo\n" if $DEBUG; 
@@ -679,5 +698,21 @@ sub update_svc_acct {
 
 }
 
+sub _try_decrement {
+  my ($svc_acct, $column, $amount) = @_;
+  if ( $svc_acct->$column !~ /^$/ ) {
+    warn "  svc_acct.$column found (". $svc_acct->$column.
+         ") - decrementing\n"
+      if $DEBUG;
+    my $method = 'decrement_' . $column;
+    my $error = $svc_acct->$method($amount);
+    die $error if $error;
+    return 'done';
+  } else {
+    warn "  no existing $column value for svc_acct - skipping\n" if $DEBUG;
+  }
+  return '';
+}
+
 1;