add skip_dcontext_suffix to skip CDRs with dcontext ending in a definable string...

[freeside.git] / FS / FS / session.pm

diff --git a/FS/FS/session.pm b/FS/FS/session.pm
index 0d766bd..615c8ae 100644 (file)
--- a/FS/FS/session.pm
+++ b/FS/FS/session.pm
@@ -1,12 +1,21 @@
 package FS::session;
 
 use strict;
 package FS::session;
 
 use strict;

-use vars qw( @ISA );
+use vars qw( @ISA $conf $start $stop );
+use FS::UID qw( dbh );

 use FS::Record qw( qsearchs );
 use FS::svc_acct;
 use FS::Record qw( qsearchs );
 use FS::svc_acct;

+use FS::port;
+use FS::nas;

 
 @ISA = qw(FS::Record);
 
 
 @ISA = qw(FS::Record);
 

+$FS::UID::callback{'FS::session'} = sub {
+  $conf = new FS::Conf;
+  $start = $conf->exists('session-start') ? $conf->config('session-start') : '';
+  $stop = $conf->exists('session-stop') ? $conf->config('session-stop') : '';
+};
+

 =head1 NAME
 
 FS::session - Object methods for session records
 =head1 NAME
 
 FS::session - Object methods for session records


@@ -31,6 +40,8 @@ FS::session - Object methods for session records
 
   $error = $record->check;
 
 
   $error = $record->check;
 

+  $error = $record->nas_heartbeat($timestamp);
+

 =head1 DESCRIPTION
 
 An FS::session object represents an user login session.  FS::session inherits
 =head1 DESCRIPTION
 
 An FS::session object represents an user login session.  FS::session inherits


@@ -57,7 +68,7 @@ from FS::Record.  The following fields are currently supported:
 
 =item new HASHREF
 
 
 =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.
 
 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 +101,34 @@ sub insert {
   $error = $self->check;
   return $error if $error;
 
   $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 );
+  system( eval qq("$start") ) if $start;
+  
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;

   '';
 
 }
   '';
 
 }


@@ -118,7 +150,7 @@ it is replaced with the current time.
 =cut
 
 sub replace {
 =cut
 
 sub replace {

-  my $self = shift;
+  my($self, $old) = @_;

   my $error;
 
   local $SIG{HUP} = 'IGNORE';
   my $error;
 
   local $SIG{HUP} = 'IGNORE';


@@ -128,22 +160,42 @@ sub replace {
   local $SIG{TSTP} = 'IGNORE';
   local $SIG{PIPE} = 'IGNORE';
 
   local $SIG{TSTP} = 'IGNORE';
   local $SIG{PIPE} = 'IGNORE';
 

+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+

   $error = $self->check;
   $error = $self->check;

-  return $error if $error;
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }

 
   $self->setfield('logout', time()) unless $self->getfield('logout');
 
 
   $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 );
+  system( eval qq("$stop") ) if $stop;
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;

 
   '';
 }
 
 =item check
 
 
   '';
 }
 
 =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.
 
 an error, returns the error, otherwise returns false.  Called by the insert
 and replace methods.
 


@@ -164,18 +216,44 @@ sub check {
   return $error if $error;
   return "Unknown svcnum"
     unless qsearchs('svc_acct', { 'svcnum' => $self->svcnum } );
   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
 
 
 =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
 
 
 =head1 SEE ALSO