FS/FS/session.pm

   1 package FS::session;
   2
   3 use strict;
   4 use vars qw( @ISA $conf );
   5 use FS::UID qw( dbh );
   6 use FS::Record qw( qsearchs );
   7 use FS::svc_acct;
   8 use FS::port;
   9 use FS::nas;
  10
  11 @ISA = qw(FS::Record);
  12
  13 $FS::UID::callback{'FS::session'} = sub {
  14   $conf = new FS::Conf;
  15 };
  16
  17 =head1 NAME
  18
  19 FS::session - Object methods for session records
  20
  21 =head1 SYNOPSIS
  22
  23   use FS::session;
  24
  25   $record = new FS::session \%hash;
  26   $record = new FS::session {
  27     'portnum' => 1,
  28     'svcnum'  => 2,
  29     'login'   => $timestamp,
  30     'logout'  => $timestamp,
  31   };
  32
  33   $error = $record->insert;
  34
  35   $error = $new_record->replace($old_record);
  36
  37   $error = $record->delete;
  38
  39   $error = $record->check;
  40
  41   $error = $record->nas_heartbeat($timestamp);
  42
  43 =head1 DESCRIPTION
  44
  45 An FS::session object represents an user login session.  FS::session inherits
  46 from FS::Record.  The following fields are currently supported:
  47
  48 =over 4
  49
  50 =item sessionnum - primary key
  51
  52 =item portnum - NAS port for this session - see L<FS::port>
  53
  54 =item svcnum - User for this session - see L<FS::svc_acct>
  55
  56 =item login - timestamp indicating the beginning of this user session.
  57
  58 =item logout - timestamp indicating the end of this user session.  May be null,
  59                which indicates a currently open session.
  60
  61 =back
  62
  63 =head1 METHODS
  64
  65 =over 4
  66
  67 =item new HASHREF
  68
  69 Creates a new session.  To add the session to the database, see L<"insert">.
  70
  71 Note that this stores the hash reference, not a distinct copy of the hash it
  72 points to.  You can ask the object for a copy with the I<hash> method.
  73
  74 =cut
  75
  76 # the new method can be inherited from FS::Record, if a table method is defined
  77
  78 sub table { 'session'; }
  79
  80 =item insert
  81
  82 Adds this record to the database.  If there is an error, returns the error,
  83 otherwise returns false.  If the `login' field is empty, it is replaced with
  84 the current time.
  85
  86 =cut
  87
  88 sub insert {
  89   my $self = shift;
  90   my $error;
  91
  92   local $SIG{HUP} = 'IGNORE';
  93   local $SIG{INT} = 'IGNORE';
  94   local $SIG{QUIT} = 'IGNORE';
  95   local $SIG{TERM} = 'IGNORE';
  96   local $SIG{TSTP} = 'IGNORE';
  97   local $SIG{PIPE} = 'IGNORE';
  98
  99   $error = $self->check;
 100   return $error if $error;
 101
 102   my $oldAutoCommit = $FS::UID::AutoCommit;
 103   local $FS::UID::AutoCommit = 0;
 104   my $dbh = dbh;
 105
 106   if ( qsearchs('session', { 'portnum' => $self->portnum, 'logout' => '' } ) ) {
 107     $dbh->rollback if $oldAutoCommit;
 108     return "a session on that port is already open!";
 109   }
 110
 111   $self->setfield('login', time()) unless $self->getfield('login');
 112
 113   $error = $self->SUPER::insert;
 114   if ( $error ) {
 115     $dbh->rollback if $oldAutoCommit;
 116     return $error;
 117   }
 118
 119   $self->nas_heartbeat($self->getfield('login'));
 120
 121   #session-starting callback
 122     #redundant with heartbeat, yuck
 123   my $port = qsearchs('port',{'portnum'=>$self->portnum});
 124   my $nas = qsearchs('nas',{'nasnum'=>$port->nasnum});
 125     #kcuy
 126   my( $ip, $nasip, $nasfqdn ) = ( $port->ip, $nas->nasip, $nas->nasfqdn );
 127
 128   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 129   '';
 130
 131 }
 132
 133 =item delete
 134
 135 Delete this record from the database.
 136
 137 =cut
 138
 139 # the delete method can be inherited from FS::Record
 140
 141 =item replace OLD_RECORD
 142
 143 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 144 returns the error, otherwise returns false.  If the `logout' field is empty,
 145 it is replaced with the current time.
 146
 147 =cut
 148
 149 sub replace {
 150   my($self, $old) = @_;
 151   my $error;
 152
 153   local $SIG{HUP} = 'IGNORE';
 154   local $SIG{INT} = 'IGNORE';
 155   local $SIG{QUIT} = 'IGNORE';
 156   local $SIG{TERM} = 'IGNORE';
 157   local $SIG{TSTP} = 'IGNORE';
 158   local $SIG{PIPE} = 'IGNORE';
 159
 160   my $oldAutoCommit = $FS::UID::AutoCommit;
 161   local $FS::UID::AutoCommit = 0;
 162   my $dbh = dbh;
 163
 164   $error = $self->check;
 165   if ( $error ) {
 166     $dbh->rollback if $oldAutoCommit;
 167     return $error;
 168   }
 169
 170   $self->setfield('logout', time()) unless $self->getfield('logout');
 171
 172   $error = $self->SUPER::replace($old);
 173   if ( $error ) {
 174     $dbh->rollback if $oldAutoCommit;
 175     return $error;
 176   }
 177
 178   $self->nas_heartbeat($self->getfield('logout'));
 179
 180   #session-ending callback
 181   #redundant with heartbeat, yuck
 182   my $port = qsearchs('port',{'portnum'=>$self->portnum});
 183   my $nas = qsearchs('nas',{'nasnum'=>$port->nasnum});
 184     #kcuy
 185   my( $ip, $nasip, $nasfqdn ) = ( $port->ip, $nas->nasip, $nas->nasfqdn );
 186
 187   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 188
 189   '';
 190 }
 191
 192 =item check
 193
 194 Checks all fields to make sure this is a valid session.  If there is
 195 an error, returns the error, otherwise returns false.  Called by the insert
 196 and replace methods.
 197
 198 =cut
 199
 200 # the check method should currently be supplied - FS::Record contains some
 201 # data checking routines
 202
 203 sub check {
 204   my $self = shift;
 205   my $error =
 206     $self->ut_numbern('sessionnum')
 207     || $self->ut_number('portnum')
 208     || $self->ut_number('svcnum')
 209     || $self->ut_numbern('login')
 210     || $self->ut_numbern('logout')
 211   ;
 212   return $error if $error;
 213   return "Unknown svcnum"
 214     unless qsearchs('svc_acct', { 'svcnum' => $self->svcnum } );
 215   $self->SUPER::check;
 216 }
 217
 218 =item nas_heartbeat
 219
 220 Heartbeats the nas associated with this session (see L<FS::nas>).
 221
 222 =cut
 223
 224 sub nas_heartbeat {
 225   my $self = shift;
 226   my $port = qsearchs('port',{'portnum'=>$self->portnum});
 227   my $nas = qsearchs('nas',{'nasnum'=>$port->nasnum});
 228   $nas->heartbeat(shift);
 229 }
 230
 231 =item svc_acct
 232
 233 Returns the svc_acct record associated with this session (see L<FS::svc_acct>).
 234
 235 =cut
 236
 237 sub svc_acct {
 238   my $self = shift;
 239   qsearchs('svc_acct', { 'svcnum' => $self->svcnum } );
 240 }
 241
 242 =back
 243
 244 =head1 BUGS
 245
 246 Maybe you shouldn't be able to insert a session if there's currently an open
 247 session on that port.  Or maybe the open session on that port should be flagged
 248 as problematic?  autoclosed?  *sigh*
 249
 250 Hmm, sessions refer to current svc_acct records... probably need to constrain
 251 deletions to svc_acct records such that no svc_acct records are deleted which
 252 have a session (even if long-closed).
 253
 254 =head1 SEE ALSO
 255
 256 L<FS::Record>, schema.html from the base documentation.
 257
 258 =cut
 259
 260 1;
 261