add debugging and ->finish() before ->disconnect call
[freeside.git] / FS / FS / part_export / sqlradius.pm
index fca6e09..f1ba3d2 100644 (file)
@@ -1,6 +1,7 @@
 package FS::part_export::sqlradius;
 
-use vars qw(@ISA $DEBUG %info %options $notes1 $notes2);
+use vars qw(@ISA @EXPORT_OK $DEBUG %info %options $notes1 $notes2);
+use Exporter;
 use Tie::IxHash;
 use FS::Record qw( dbh qsearch qsearchs str2time_sql );
 use FS::part_export;
@@ -9,6 +10,7 @@ use FS::export_svc;
 use Carp qw( cluck );
 
 @ISA = qw(FS::part_export);
+@EXPORT_OK = qw( sqlradius_connect );
 
 $DEBUG = 0;
 
@@ -20,6 +22,15 @@ tie %options, 'Tie::IxHash',
     type  => 'checkbox',
     label => 'Ignore accounting records from this database'
   },
+  'process_single_realm' => {
+    type  => 'checkbox',
+    label => 'Only process one realm of accounting records',
+  },
+  'realm' => { label => 'The realm of of accounting records to be processed' },
+  'ignore_long_sessions' => {
+    type  => 'checkbox',
+    label => 'Ignore sessions which span billing periods',
+  },
   'hide_ip' => {
     type  => 'checkbox',
     label => 'Hide IP address information on session reports',
@@ -32,7 +43,7 @@ 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', } ,
+  'overlimit_groups' => { label => 'Radius groups to assign to svc_acct which has exceeded its bandwidth or time limit (if not overridden by overlimit_groups global or per-agent config)', } ,
   'groups_susp_reason' => { label =>
                              'Radius group mapping to reason (via template user) (svcnum|username|username@domain  reasonnum|reason)',
                             type  => 'textarea',
@@ -397,6 +408,14 @@ sub sqlradius_usergroup_insert { #subroutine, not method
     $sth->execute( $username, $group )
       or die "can't insert into groupname table: ". $sth->errstr;
   }
+  if ( $s_sth->{Active} ) {
+    warn "sqlradius s_sth still active; calling ->finish()";
+    $s_sth->finish;
+  }
+  if ( $sth->{Active} ) {
+    warn "sqlradius sth still active; calling ->finish()";
+    $sth->finish;
+  }
   $dbh->disconnect;
 }
 
@@ -577,7 +596,7 @@ sub usage_sessions {
   my $opt = {};
   my($start, $end, $svc_acct, $ip, $prefix) = ( '', '', '', '', '');
   if ( ref($_[0]) ) {
-    my $opt = shift;
+    $opt = shift;
     $start    = $opt->{stoptime_start};
     $end      = $opt->{stoptime_end};
     $svc_acct = $opt->{svc_acct};
@@ -611,11 +630,11 @@ sub usage_sessions {
                );
 
   my @param = ();
-  my @where = '';
+  my @where = ();
 
   if ( $svc_acct ) {
     my $username = $self->export_username($svc_acct);
-    if ( $svc_acct =~ /^([^@]+)\@([^@]+)$/ ) {
+    if ( $username =~ /^([^@]+)\@([^@]+)$/ ) {
       push @where, '( UserName = ? OR ( UserName = ? AND Realm = ? ) )';
       push @param, $username, $1, $2;
     } else {
@@ -624,6 +643,11 @@ sub usage_sessions {
     }
   }
 
+  if ($self->option('process_single_realm')) {
+    push @where, 'Realm = ?';
+    push @param, $self->option('realm');
+  }
+
   if ( length($ip) ) {
     push @where, ' FramedIPAddress = ?';
     push @param, $ip;
@@ -672,7 +696,7 @@ sub usage_sessions {
 
 =cut
 
-sub update_svc_acct {
+sub update_svc {
   my $self = shift;
 
   my $conf = new FS::Conf;
@@ -706,7 +730,7 @@ sub update_svc_acct {
 
     $UserName = lc($UserName) unless $conf->exists('username-uppercase');
 
-    my %search = ( 'username' => $UserName );
+    #my %search = ( 'username' => $UserName );
 
     my $extra_sql = '';
     if ( ref($self) =~ /withdomain/ ) { #well...
@@ -717,43 +741,53 @@ sub update_svc_acct {
     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, } )
-           }
-      qsearch( 'svc_acct',
-                 { 'username' => $UserName },
-                 '',
-                 $extra_sql
-               );
-
+    my $status = 'skipped';
     my $errinfo = "for RADIUS detail RadAcctID $RadAcctId ".
                   "(UserName $UserName, Realm $Realm)";
-    my $status = 'skipped';
-    if ( !@svc_acct ) {
-      warn "WARNING: no svc_acct record found $errinfo - skipping\n";
-    } 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;
 
-      $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)';
+    if (    $self->option('process_single_realm')
+         && $self->option('realm') ne $Realm )
+    {
+      warn "WARNING: wrong realm $errinfo - skipping\n" if $DEBUG;
+    } else {
+      my @svc_acct =
+        grep { qsearch( 'export_svc', { 'exportnum' => $self->exportnum,
+                                        'svcpart'   => $_->cust_svc->svcpart, } )
+             }
+        qsearch( 'svc_acct',
+                   { 'username' => $UserName },
+                   '',
+                   $extra_sql
+                 );
+
+      if ( !@svc_acct ) {
+        warn "WARNING: no svc_acct record found $errinfo - skipping\n";
+      } elsif ( scalar(@svc_acct) > 1 ) {
+        warn "WARNING: multiple svc_acct records found $errinfo - skipping\n";
       } 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
+
+        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 $session_time = $AcctStopTime;
+        $session_time = $AcctStartTime if $self->option('ignore_long_sessions');
+
+        my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
+        if ( $cust_pkg && $session_time < (    $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);
+          $status=join(' ', @st);
+        }
       }
     }
 
@@ -799,7 +833,7 @@ sub all_sqlradius {
 
   my @part_export = ();
   push @part_export, qsearch('part_export', { 'exporttype' => $_ } )
-    foreach qw(sqlradius sqlradius_withdomain radiator);
+    foreach qw( sqlradius sqlradius_withdomain radiator phone_sqlradius );
   @part_export;
 }