1# $File: //depot/libOurNet/BBS/lib/OurNet/BBS/MAPLE2/Session.pm $ $Author: autrijus $ 2# $Revision: #2 $ $Change: 3792 $ $DateTime: 2003/01/24 19:34:06 $ 3 4package OurNet::BBS::MAPLE2::Session; 5 6use strict; 7no warnings 'deprecated'; 8use fields qw/bbsroot recno shmid shm chatport registered myshm _ego _hash/; 9use POSIX qw/SIGUSR2/; 10 11use OurNet::BBS::Base ( 12 'SessionGroup' => [qw/$packsize $packstring @packlist/], 13); 14 15sub refresh_meta { 16 my ($self, $key) = @_; 17 18 my $buf; 19 shmread($self->{shmid}, $buf, $packsize * $self->{recno}, $packsize) 20 or die "shmread: $!"; 21 @{$self->{_hash}}{@packlist} = unpack($packstring, $buf); 22} 23 24sub refresh_chat { 25 my $self = shift; 26 return if exists $self->{_hash}{chat}; 27 28 require OurNet::BBS::SocketScalar; 29 $self->refresh_meta('userid'); 30 31 tie $self->{_hash}{chat}, 'OurNet::BBS::SocketScalar', 32 (index($self->{chatport}, ':') > -1) ? $self->{chatport} 33 : ('localhost', $self->{chatport}); 34 35 $self->{_hash}{chat} = "/! 9 9 $self->{_hash}{userid} ". 36 "$self->{_hash}{userid}\n"; 37 $self->{_hash}{chatid} = $self->{_hash}{userid}; 38 39 $self->_shmwrite(); 40} 41 42sub _shmwrite { 43 my $self = shift; 44 shmwrite($self->{shmid}, pack($packstring, @{$self->{_hash}}{@packlist}), 45 $packsize*$self->{recno}, $packsize); 46} 47 48sub dispatch { 49 my ($self, $from, $message) = @_; 50 51 --$self->{_hash}{msgcount}; 52 $self->_shmwrite(); 53 54 $self->{_hash}{cb_msg} ($from, $message) if $self->{_hash}{cb_msg}; 55} 56 57sub remove { 58 my $self = shift; 59 $self->{_hash}{pid} = 0; 60 $self->_shmwrite(); 61 --$self->{shm}{number}; 62} 63 64sub STORE { 65 my ($self, $key, $value) = @_; 66 67 no warnings 'uninitialized'; 68 print "setting $key $value\n" if $OurNet::BBS::DEBUG; 69 70 if ($key eq 'msg') { 71 $self->{_hash}{msgs} = 72 pack('LZ13Z80', getpid(), $value->[0], $value->[1]); 73 $self->{_hash}{msgcount}++; 74 kill SIGUSR2, $self->{_hash}{pid}; 75 $self->_shmwrite(); 76 77 return; 78 } 79 elsif ($key eq 'cb_msg') { 80 if (ref($value) eq 'CODE') { 81 print "register callback from $self->{registered}\n" 82 if $OurNet::BBS::DEBUG; 83 $self->{registered}{$self->{recno}} = $self; 84 } 85 else { 86 delete $self->{registered}{$self->{recno}}; 87 } 88 } 89 90 $self->refresh_meta($key); 91 $self->{_hash}{$key} = $value; 92 93 return unless $self->contains($key); 94 $self->_shmwrite(); 95} 96 97sub DESTROY { 98 my $self = shift; 99 return unless exists $self->{registered}{$self->{recno}}; 100 $self->{_hash}{pid} = 0; 101 $self->_shmwrite(); 102 delete $self->{registered}{$self->{recno}}; 103} 104 1051; 106