Netrunner 2004 October/NETRUNNER0410.ISO/regular/ActivePerl-5.8.4.810-MSWin32-x86.msi/_d2da7a50d6c69d7ac042fa8858c9037b

Text File | 2004-06-01 | 5.0 KB | 156 lines

# ======================================================================
#
# Copyright (C) 2000 Lincoln D. Stein
#
# ======================================================================

package IO::SessionSet;

use strict;
use Carp;
use IO::Select;
use IO::Handle;
use IO::SessionData;

use vars '$DEBUG';
$DEBUG = 0;

# Class method new()
# Create a new Session set.
# If passed a listening socket, use that to
# accept new IO::SessionData objects automatically.
sub new {
  my $pack = shift;
  my $listen = shift;
  my $self = bless {
                    sessions     => {},
                    readers      => IO::Select->new(),
                    writers      => IO::Select->new(),
                   },$pack;
  # if initialized with an IO::Handle object (or subclass)
  # then we treat it as a listening socket.
  if ( defined($listen) and $listen->can('accept') ) {
    $self->{listen_socket} = $listen;
    $self->{readers}->add($listen);
  }
  return $self;
}

# Object method: sessions()
# Return list of all the sessions currently in the set.
sub sessions { return values %{shift->{sessions}} };

# Object method: add()
# Add a handle to the session set.  Will automatically
# create a IO::SessionData wrapper around the handle.
sub add {
  my $self = shift;
  my ($handle,$writeonly) = @_;
  warn "Adding a new session for $handle.\n" if $DEBUG;
  return $self->{sessions}{$handle} = $self->SessionDataClass->new($self,$handle,$writeonly);
}

# Object method: delete()
# Remove a session from the session set.  May pass either a handle or
# a corresponding IO::SessionData wrapper.
sub delete {
  my $self = shift;
  my $thing = shift;
  my $handle = $self->to_handle($thing);
  my $sess = $self->to_session($thing);
  warn "Deleting session $sess handle $handle.\n" if $DEBUG;
  delete $self->{sessions}{$handle};
  $self->{readers}->remove($handle);
  $self->{writers}->remove($handle);
}

# Object method: to_handle()
# Return a handle, given either a handle or a IO::SessionData object.
sub to_handle {
  my $self = shift;
  my $thing = shift;
  return $thing->handle if $thing->isa('IO::SessionData');
  return $thing if defined (fileno $thing);
  return;  # undefined value
}

# Object method: to_session
# Return a IO::SessionData object, given either a handle or the object itself.
sub to_session {
  my $self = shift;
  my $thing = shift;
  return $thing if $thing->isa('IO::SessionData');
  return $self->{sessions}{$thing} if defined (fileno $thing);
  return;  # undefined value
}

# Object method: activate()
# Called with parameters ($session,'read'|'write' [,$activate])
# If called without the $activate argument, will return true
# if the indicated handle is on the read or write IO::Select set.
# May use either a session object or a handle as first argument.
sub activate {
  my $self = shift;
  my ($thing,$rw,$act) = @_;
  croak 'Usage $obj->activate($session,"read"|"write" [,$activate])'
    unless @_ >= 2;
  my $handle = $self->to_handle($thing);
  my $select = lc($rw) eq 'read' ? 'readers' : 'writers';
  my $prior = defined $self->{$select}->exists($handle);
  if (defined $act && $act != $prior) {
    $self->{$select}->add($handle)        if $act;
    $self->{$select}->remove($handle) unless $act;
    warn $act ? 'Activating' : 'Inactivating',
           " handle $handle for ",
            $rw eq 'read' ? 'reading':'writing',".\n" if $DEBUG;
  }
  return $prior;
}

# Object method: wait()
# Wait for I/O.  Handles writes automatically.  Returns a list of IO::SessionData
# objects ready for reading.
# If there is a listen socket, then will automatically do an accept() and return
# a new IO::SessionData object for that.
sub wait {
  my $self = shift;
  my $timeout = shift;

  # Call select() to get the list of sessions that are ready for reading/writing.
  croak "IO::Select->select() returned error: $!"
    unless my ($read,$write) =
      IO::Select->select($self->{readers},$self->{writers},undef,$timeout);

  # handle queued writes automatically
  foreach (@$write) {
    my $session = $self->to_session($_);
    warn "Writing pending data (",$session->pending+0," bytes) for $_.\n" if $DEBUG;
    my $rc = $session->write;
  }

  # Return list of sessions that are ready for reading.
  # If one of the ready handles is the listen socket, then
  # create a new session.
  # Otherwise return the ready handles as a list of IO::SessionData objects.
  my @sessions;
  foreach (@$read) {
    if ($_ eq $self->{listen_socket}) {
      my $newhandle = $_->accept;
      warn "Accepting a new handle $newhandle.\n" if $DEBUG;
      my $newsess = $self->add($newhandle) if $newhandle;
      push @sessions,$newsess;
    } else {
      push @sessions,$self->to_session($_);
    }
  }
  return @sessions;
}

# Class method: SessionDataClass
# Return the string containing the name of the session data
# wrapper class.  Subclass and override to use a different
# session data class.
sub SessionDataClass {  return 'IO::SessionData'; }

1;