session monitor updates

4 files changed, 79 insertions, 19 deletions

diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm
index 59472c898..18541d2db 100644
--- a/FS/FS/Record.pm
+++ b/FS/FS/Record.pm
@@ -149,22 +149,32 @@ sub create {
   }
 }
 
-=item qsearch TABLE, HASHREF
+=item qsearch TABLE, HASHREF, SELECT, EXTRA_SQL
 
 Searches the database for all records matching (at least) the key/value pairs
 in HASHREF.  Returns all the records found as `FS::TABLE' objects if that
 module is loaded (i.e. via `use FS::cust_main;'), otherwise returns FS::Record
 objects.
 
+###oops, argh, FS::Record::new only lets us create database fields.
+#Normal behaviour if SELECT is not specified is `*', as in
+#C<SELECT * FROM table WHERE ...>.  However, there is an experimental new
+#feature where you can specify SELECT - remember, the objects returned,
+#although blessed into the appropriate `FS::TABLE' package, will only have the
+#fields you specify.  This might have unwanted results if you then go calling
+#regular FS::TABLE methods
+#on it.
+
 =cut
 
 sub qsearch {
-  my($table, $record) = @_;
+  my($table, $record, $select, $extra_sql ) = @_;
+  $select ||= '*';
   my $dbh = dbh;
 
   my @fields = grep exists($record->{$_}), fields($table);
 
-  my $statement = "SELECT * FROM $table";
+  my $statement = "SELECT $select FROM $table";
   if ( @fields ) {
     $statement .= " WHERE ". join(' AND ', map {
       if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) {
@@ -178,6 +188,7 @@ sub qsearch {
       }
     } @fields );
   }
+  $statement .= " $extra_sql" if defined($extra_sql);
 
   warn $statement if $DEBUG;
   my $sth = $dbh->prepare_cached($statement) or croak $dbh->errstr;
@@ -895,7 +906,7 @@ sub hfields {
 
 =head1 VERSION
 
-$Id: Record.pm,v 1.9 2000-11-07 15:00:37 ivan Exp $
+$Id: Record.pm,v 1.10 2000-12-03 20:25:20 ivan Exp $
 
 =head1 BUGS
 
diff --git a/FS/FS/nas.pm b/FS/FS/nas.pm
index 873c9bce6..53e0fbc34 100644
--- a/FS/FS/nas.pm
+++ b/FS/FS/nas.pm
@@ -2,8 +2,8 @@ package FS::nas;
 
 use strict;
 use vars qw( @ISA );
-use FS::Record qw();
-#use FS::Record qw( qsearch qsearchs );
+use FS::Record qw(qsearchs); #qsearch);
+use FS::UID qw( dbh ); #to lock the tables for heartbeat; ugh, MySQL-specific
 
 @ISA = qw(FS::Record);
 
@@ -124,18 +124,32 @@ Updates the timestamp for this nas
 =cut
 
 sub heartbeat {
-  warn "warning: heartbeat unimplemented!"
+  my($self, $timestamp) = @_;
+  my $dbh = dbh;
+  my $sth = $dbh->prepare("LOCK TABLES nas WRITE");
+  $sth->execute or die $sth->errstr; #die?
+  my $lock_self = qsearchs('nas', { 'nasnum' => $self->nasnum } )
+    or die "can't find own record for $self nasnum ". $self->nasnum;
+  if ( $timestamp > $lock_self->last ) {
+    my $new_self = new FS::nas ( { $lock_self->hash } );
+    $new_self->last($timestamp);
+    #is there a reason to? #$self->last($timestamp);
+    $new_self->replace($lock_self);
+  };
+  $sth = $dbh->prepare("UNLOCK TABLES");
+  $sth->execute or die $sth->errstr; #die?
 }
 
 =back
 
 =head1 VERSION
 
-$Id: nas.pm,v 1.2 2000-11-07 15:00:37 ivan Exp $
+$Id: nas.pm,v 1.3 2000-12-03 20:25:20 ivan Exp $
 
 =head1 BUGS
 
-The author forgot to customize this manpage.
+The B<heartbeat> method is MySQL-specific.  Yuck.  It's also not quite
+perfectly subclassable, which is much less yuck.
 
 =head1 SEE ALSO
 
diff --git a/FS/FS/port.pm b/FS/FS/port.pm
index ee4611d21..e96e71c0f 100644
--- a/FS/FS/port.pm
+++ b/FS/FS/port.pm
@@ -118,23 +118,38 @@ sub check {
 
 =item session
 
-Returns the currently open session, or if no session is currently open, the
-most recent session.  See L<FS::session>.
+Returns the currently open session on this port, or if no session is currently
+open, the most recent session.  See L<FS::session>.
 
 =cut
 
-
+sub session {
+  my $self = shift;
+  qsearchs('session', { 'portnum' => $self->portnum }, '*',
+                     'ORDER BY login DESC LIMIT 1' );
+}
 
 =back
 
 =head1 VERSION
 
-$Id: port.pm,v 1.2 2000-12-03 13:44:05 ivan Exp $
+$Id: port.pm,v 1.3 2000-12-03 20:25:20 ivan Exp $
 
 =head1 BUGS
 
 The author forgot to customize this manpage.
 
+The session method won't deal well if you have multiple open sessions on a
+port, for example if your RADIUS server drops B<stop> records.  Suggestions for
+how to deal with this sort of lossage welcome; should we close the session
+when we get a new session on that port?  Tag it as invalid somehow?  Close it
+one second after it was opened?  *sigh*  Maybe FS::session shouldn't let you
+create overlapping sessions, at least folks will find out their logging is
+dropping records.
+
+If you think the above refers multiple user logins you need to read the
+manpages again.
+
 =head1 SEE ALSO
 
 L<FS::Record>, schema.html from the base documentation.
@@ -147,8 +162,8 @@ added hfields
 ivan@sisd.com 97-nov-13
 
 $Log: port.pm,v $
-Revision 1.2  2000-12-03 13:44:05  ivan
-beginnings of web status for session monitor
+Revision 1.3  2000-12-03 20:25:20  ivan
+session monitor updates
 
 Revision 1.1  2000/10/27 20:18:32  ivan
 oops, also necessary for session monitor
diff --git a/FS/FS/session.pm b/FS/FS/session.pm
index b85a5822f..027708d98 100644
--- a/FS/FS/session.pm
+++ b/FS/FS/session.pm
@@ -94,6 +94,9 @@ sub insert {
   $error = $self->check;
   return $error if $error;
 
+  return "a session on that port is already open!"
+    if qsearchs('session', { 'portnum' => $self->portnum, 'logout' => '' } );
+
   $self->setfield('login', time()) unless $self->getfield('login');
 
   $error = $self->SUPER::insert;
@@ -124,7 +127,7 @@ it is replaced with the current time.
 =cut
 
 sub replace {
-  my $self = shift;
+  my($self, $old) = @_;
   my $error;
 
   local $SIG{HUP} = 'IGNORE';
@@ -139,7 +142,7 @@ sub replace {
 
   $self->setfield('logout', time()) unless $self->getfield('logout');
 
-  $error = $self->SUPER::replace;
+  $error = $self->SUPER::replace($old);
   return $error if $error;
 
   $self->nas_heartbeat($self->getfield('logout'));
@@ -188,15 +191,32 @@ sub nas_heartbeat {
   $nas->heartbeat(shift);
 }
 
+=item svc_acct
+
+Returns the svc_acct record associated with this session (see L<FS::svc_acct>).
+
+=cut
+
+sub svc_acct {
+  my $self = shift;
+  qsearchs('svc_acct', { 'svcnum' => $self->svcnum } );
+}
+
 =back
 
 =head1 VERSION
 
-$Id: session.pm,v 1.2 2000-11-07 15:00:37 ivan Exp $
+$Id: session.pm,v 1.3 2000-12-03 20:25:20 ivan Exp $
 
 =head1 BUGS
 
-The author forgot to customize this manpage.
+Maybe you shouldn't be able to insert a session if there's currently an open
+session on that port.  Or maybe the open session on that port should be flagged
+as problematic?  autoclosed?  *sigh*
+
+Hmm, sessions refer to current svc_acct records... probably need to constrain
+deletions to svc_acct records such that no svc_acct records are deleted which
+have a session (even if long-closed).
 
 =head1 SEE ALSO