untested code to suck in CDRs in from VoIP RADIUS exports, RT#4100
[freeside.git] / FS / FS / part_export / sqlradius.pm
index 4190b03..87c5739 100644 (file)
@@ -49,7 +49,7 @@ END
 
 $notes2 = <<'END';
 An existing RADIUS database will be updated in realtime, but you can use
-<a href="../docs/man/bin/freeside-sqlradius-reset">freeside-sqlradius-reset</a>
+<a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.9:Documentation:Developer/bin/freeside-sqlradius-reset">freeside-sqlradius-reset</a>
 to delete the entire RADIUS database and repopulate the tables from the
 Freeside database.  See the
 <a href="http://search.cpan.org/dist/DBI/DBI.pm#connect">DBI documentation</a>
@@ -95,24 +95,24 @@ sub export_username {
 }
 
 sub _export_insert {
-  my($self, $svc_acct) = (shift, shift);
+  my($self, $svc_x) = (shift, shift);
 
   foreach my $table (qw(reply check)) {
     my $method = "radius_$table";
-    my %attrib = $svc_acct->$method();
+    my %attrib = $svc_x->$method();
     next unless keys %attrib;
-    my $err_or_queue = $self->sqlradius_queue( $svc_acct->svcnum, 'insert',
-      $table, $self->export_username($svc_acct), %attrib );
+    my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'insert',
+      $table, $self->export_username($svc_x), %attrib );
     return $err_or_queue unless ref($err_or_queue);
   }
-  my @groups = $svc_acct->radius_groups;
+  my @groups = $svc_x->radius_groups;
   if ( @groups ) {
-    cluck localtime(). ": queuing usergroup_insert for ". $svc_acct->svcnum.
-          " (". $self->export_username($svc_acct). " with ". join(", ", @groups)
+    cluck localtime(). ": queuing usergroup_insert for ". $svc_x->svcnum.
+          " (". $self->export_username($svc_x). " with ". join(", ", @groups)
       if $DEBUG;
     my $err_or_queue = $self->sqlradius_queue(
-      $svc_acct->svcnum, 'usergroup_insert',
-      $self->export_username($svc_acct), @groups );
+      $svc_x->svcnum, 'usergroup_insert',
+      $self->export_username($svc_x), @groups );
     return $err_or_queue unless ref($err_or_queue);
   }
   '';
@@ -283,9 +283,9 @@ sub _export_unsuspend {
 }
 
 sub _export_delete {
-  my( $self, $svc_acct ) = (shift, shift);
-  my $err_or_queue = $self->sqlradius_queue( $svc_acct->svcnum, 'delete',
-    $self->export_username($svc_acct) );
+  my( $self, $svc_x ) = (shift, shift);
+  my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'delete',
+    $self->export_username($svc_x) );
   ref($err_or_queue) ? '' : $err_or_queue;
 }
 
@@ -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) {
@@ -364,7 +364,7 @@ sub sqlradius_insert { #subroutine, not method
       $i_sth->execute(
         $username,
         $attribute,
-        ( $attribute =~ /Password/i ? '==' : ':=' ),
+        ( $attribute eq 'Password' ? '==' : ':=' ),
         $attributes{$attribute},
       ) or die $i_sth->errstr;
 
@@ -503,8 +503,34 @@ sub sqlreplace_usergroups {
 
 #--
 
+=item usage_sessions HASHREF
+
 =item usage_sessions TIMESTAMP_START TIMESTAMP_END [ SVC_ACCT [ IP [ PREFIX [ SQL_SELECT ] ] ] ]
 
+New-style: pass a hashref with the following keys:
+
+=over 4
+
+=item stoptime_start - Lower bound for AcctStopTime, as a UNIX timestamp
+
+=item stoptime_end - Upper bound for AcctStopTime, as a UNIX timestamp
+
+=item open_sessions - Only show records with no AcctStopTime (typically used without stoptime_* options and with starttime_* options instead)
+
+=item starttime_start - Lower bound for AcctStartTime, as a UNIX timestamp
+
+=item starttime_end - Upper bound for AcctStartTime, as a UNIX timestamp
+
+=item svc_acct
+
+=item ip
+
+=item prefix
+
+=back
+
+Old-style: 
+
 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
 functions.
@@ -546,11 +572,24 @@ Returns an arrayref of hashrefs with the following fields:
 #some false laziness w/cust_svc::seconds_since_sqlradacct
 
 sub usage_sessions {
-  my( $self, $start, $end ) = splice(@_, 0, 3);
-  my $svc_acct = @_ ? shift : '';
-  my $ip = @_ ? shift : '';
-  my $prefix = @_ ? shift : '';
-  #my $select = @_ ? shift : '*';
+  my( $self ) = shift;
+
+  my $opt = {};
+  my($start, $end, $svc_acct, $ip, $prefix) = ( '', '', '', '', '');
+  if ( ref($_[0]) ) {
+    my $opt = shift;
+    $start    = $opt->{stoptime_start};
+    $end      = $opt->{stoptime_end};
+    $svc_acct = $opt->{svc_acct};
+    $ip       = $opt->{ip};
+    $prefix   = $opt->{prefix};
+  } else {
+    ( $start, $end ) = splice(@_, 0, 2);
+    $svc_acct = @_ ? shift : '';
+    $ip = @_ ? shift : '';
+    $prefix = @_ ? shift : '';
+    #my $select = @_ ? shift : '*';
+  }
 
   $end ||= 2147483647;
 
@@ -572,37 +611,56 @@ sub usage_sessions {
                );
 
   my @param = ();
-  my $where = '';
+  my @where = '';
 
   if ( $svc_acct ) {
     my $username = $self->export_username($svc_acct);
     if ( $svc_acct =~ /^([^@]+)\@([^@]+)$/ ) {
-      $where = '( UserName = ? OR ( UserName = ? AND Realm = ? ) ) AND';
+      push @where, '( UserName = ? OR ( UserName = ? AND Realm = ? ) )';
       push @param, $username, $1, $2;
     } else {
-      $where = 'UserName = ? AND';
+      push @where, 'UserName = ?';
       push @param, $username;
     }
   }
 
   if ( length($ip) ) {
-    $where .= ' FramedIPAddress = ? AND';
+    push @where, ' FramedIPAddress = ?';
     push @param, $ip;
   }
 
   if ( length($prefix) ) {
     #assume sip: for now, else things get ugly trying to match /^\w+:$prefix/
-    $where .= " CalledStationID LIKE 'sip:$prefix\%' AND";
+    push @where, " CalledStationID LIKE 'sip:$prefix\%'";
+  }
+
+  if ( $start ) {
+    push @where, "$str2time AcctStopTime ) >= ?";
+    push @param, $start;
+  }
+  if ( $end ) {
+    push @where, "$str2time AcctStopTime ) <= ?";
+    push @param, $end;
+  }
+  if ( $opt->{open_sessions} ) {
+    push @where, 'AcctStopTime IS NULL';
+  }
+  if ( $opt->{starttime_start} ) {
+    push @where, "$str2time AcctStartTime ) >= ?";
+    push @param, $opt->{starttime_start};
+  }
+  if ( $opt->{starttime_end} ) {
+    push @where, "$str2time AcctStartTime ) <= ?";
+    push @param, $opt->{starttime_end};
   }
 
-  push @param, $start, $end;
+  my $where = join(' AND ', @where);
+  $where = "WHERE $where" if $where;
 
   my $sth = $dbh->prepare('SELECT '. join(', ', @fields).
                           "  FROM radacct
-                             WHERE $where
-                                   $str2time AcctStopTime ) >= ?
-                               AND $str2time AcctStopTime ) <=  ?
-                               ORDER BY AcctStartTime DESC
+                             $where
+                             ORDER BY AcctStartTime DESC
   ") or die $dbh->errstr;                                 
   $sth->execute(@param) or die $sth->errstr;
 
@@ -614,14 +672,16 @@ sub usage_sessions {
 
 =cut
 
-sub update_svc_acct {
+sub update_svc {
   my $self = shift;
 
   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 +689,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,15 +698,15 @@ 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;
 
     $UserName = lc($UserName) unless $conf->exists('username-uppercase');
 
-    my %search = ( 'username' => $UserName );
+    #my %search = ( 'username' => $UserName );
 
     my $extra_sql = '';
     if ( ref($self) =~ /withdomain/ ) { #well...
@@ -653,6 +714,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 +735,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 +764,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 +783,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 phone_sqlradius );
+  @part_export;
+}
+
+sub all_sqlradius_withaccounting {
+  my $class = shift;
+  grep { ! $_->option('ignore_accounting') } $class->all_sqlradius;
 }
 
 1;