better conf classification
[freeside.git] / FS / FS / session.pm
index 0d766bd..78af2e9 100644 (file)
@@ -1,12 +1,19 @@
 package FS::session;
 
 use strict;
-use vars qw( @ISA );
+use vars qw( @ISA $conf );
+use FS::UID qw( dbh );
 use FS::Record qw( qsearchs );
 use FS::svc_acct;
+use FS::port;
+use FS::nas;
 
 @ISA = qw(FS::Record);
 
+$FS::UID::callback{'FS::session'} = sub {
+  $conf = new FS::Conf;
+};
+
 =head1 NAME
 
 FS::session - Object methods for session records
@@ -31,6 +38,8 @@ FS::session - Object methods for session records
 
   $error = $record->check;
 
+  $error = $record->nas_heartbeat($timestamp);
+
 =head1 DESCRIPTION
 
 An FS::session object represents an user login session.  FS::session inherits
@@ -57,7 +66,7 @@ from FS::Record.  The following fields are currently supported:
 
 =item new HASHREF
 
-Creates a new example.  To add the example to the database, see L<"insert">.
+Creates a new session.  To add the session to the database, see L<"insert">.
 
 Note that this stores the hash reference, not a distinct copy of the hash it
 points to.  You can ask the object for a copy with the I<hash> method.
@@ -90,13 +99,33 @@ sub insert {
   $error = $self->check;
   return $error if $error;
 
-  $self->setfield('login', time()) unless $self->getfield('login');
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
 
-  $error = $self->SUPER::insert;
-  return $error if $error;
+  if ( qsearchs('session', { 'portnum' => $self->portnum, 'logout' => '' } ) ) {
+    $dbh->rollback if $oldAutoCommit;
+    return "a session on that port is already open!";
+  }
 
-  #session-starting callback!
+  $self->setfield('login', time()) unless $self->getfield('login');
 
+  $error = $self->SUPER::insert;
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+
+  $self->nas_heartbeat($self->getfield('login'));
+
+  #session-starting callback
+    #redundant with heartbeat, yuck
+  my $port = qsearchs('port',{'portnum'=>$self->portnum});
+  my $nas = qsearchs('nas',{'nasnum'=>$port->nasnum});
+    #kcuy
+  my( $ip, $nasip, $nasfqdn ) = ( $port->ip, $nas->nasip, $nas->nasfqdn );
+  
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
   '';
 
 }
@@ -118,7 +147,7 @@ it is replaced with the current time.
 =cut
 
 sub replace {
-  my $self = shift;
+  my($self, $old) = @_;
   my $error;
 
   local $SIG{HUP} = 'IGNORE';
@@ -128,22 +157,41 @@ sub replace {
   local $SIG{TSTP} = 'IGNORE';
   local $SIG{PIPE} = 'IGNORE';
 
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
   $error = $self->check;
-  return $error if $error;
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
 
   $self->setfield('logout', time()) unless $self->getfield('logout');
 
-  $error = $self->SUPER::replace;
-  return $error if $error;
+  $error = $self->SUPER::replace($old);
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+
+  $self->nas_heartbeat($self->getfield('logout'));
 
-  #session-ending callback!
+  #session-ending callback
+  #redundant with heartbeat, yuck
+  my $port = qsearchs('port',{'portnum'=>$self->portnum});
+  my $nas = qsearchs('nas',{'nasnum'=>$port->nasnum});
+    #kcuy
+  my( $ip, $nasip, $nasfqdn ) = ( $port->ip, $nas->nasip, $nas->nasfqdn );
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
   '';
 }
 
 =item check
 
-Checks all fields to make sure this is a valid example.  If there is
+Checks all fields to make sure this is a valid session.  If there is
 an error, returns the error, otherwise returns false.  Called by the insert
 and replace methods.
 
@@ -164,18 +212,44 @@ sub check {
   return $error if $error;
   return "Unknown svcnum"
     unless qsearchs('svc_acct', { 'svcnum' => $self->svcnum } );
-  '';
+  $self->SUPER::check;
 }
 
-=back
+=item nas_heartbeat
 
-=head1 VERSION
+Heartbeats the nas associated with this session (see L<FS::nas>).
 
-$Id: session.pm,v 1.1 2000-10-27 20:18:32 ivan Exp $
+=cut
+
+sub nas_heartbeat {
+  my $self = shift;
+  my $port = qsearchs('port',{'portnum'=>$self->portnum});
+  my $nas = qsearchs('nas',{'nasnum'=>$port->nasnum});
+  $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 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