1# ====================================================================== 2# 3# Copyright (C) 2000 Lincoln D. Stein 4# Formatting changed to match the layout layed out in Perl Best Practices 5# (by Damian Conway) by Martin Kutter in 2008 6# 7# ====================================================================== 8 9package IO::SessionSet; 10 11use strict; 12use Carp; 13use IO::Select; 14use IO::Handle; 15use IO::SessionData; 16 17use vars '$DEBUG'; 18$DEBUG = 0; 19 20# Class method new() 21# Create a new Session set. 22# If passed a listening socket, use that to 23# accept new IO::SessionData objects automatically. 24sub new { 25 my $pack = shift; 26 my $listen = shift; 27 my $self = bless { 28 sessions => {}, 29 readers => IO::Select->new(), 30 writers => IO::Select->new(), 31 }, $pack; 32 # if initialized with an IO::Handle object (or subclass) 33 # then we treat it as a listening socket. 34 if ( defined($listen) and $listen->can('accept') ) { 35 $self->{listen_socket} = $listen; 36 $self->{readers}->add($listen); 37 } 38 return $self; 39} 40 41# Object method: sessions() 42# Return list of all the sessions currently in the set. 43sub sessions { 44 return values %{shift->{sessions}} 45}; 46 47# Object method: add() 48# Add a handle to the session set. Will automatically 49# create a IO::SessionData wrapper around the handle. 50sub add { 51 my $self = shift; 52 my ($handle,$writeonly) = @_; 53 warn "Adding a new session for $handle.\n" if $DEBUG; 54 return $self->{sessions}{$handle} = 55 $self->SessionDataClass->new($self,$handle,$writeonly); 56} 57 58# Object method: delete() 59# Remove a session from the session set. May pass either a handle or 60# a corresponding IO::SessionData wrapper. 61sub delete { 62 my $self = shift; 63 my $thing = shift; 64 my $handle = $self->to_handle($thing); 65 my $sess = $self->to_session($thing); 66 warn "Deleting session $sess handle $handle.\n" if $DEBUG; 67 delete $self->{sessions}{$handle}; 68 $self->{readers}->remove($handle); 69 $self->{writers}->remove($handle); 70} 71 72# Object method: to_handle() 73# Return a handle, given either a handle or a IO::SessionData object. 74sub to_handle { 75 my $self = shift; 76 my $thing = shift; 77 return $thing->handle if $thing->isa('IO::SessionData'); 78 return $thing if defined (fileno $thing); 79 return; # undefined value 80} 81 82# Object method: to_session 83# Return a IO::SessionData object, given either a handle or the object itself. 84sub to_session { 85 my $self = shift; 86 my $thing = shift; 87 return $thing if $thing->isa('IO::SessionData'); 88 return $self->{sessions}{$thing} if defined (fileno $thing); 89 return; # undefined value 90} 91 92# Object method: activate() 93# Called with parameters ($session,'read'|'write' [,$activate]) 94# If called without the $activate argument, will return true 95# if the indicated handle is on the read or write IO::Select set. 96# May use either a session object or a handle as first argument. 97sub activate { 98 my $self = shift; 99 my ($thing,$rw,$act) = @_; 100 croak 'Usage $obj->activate($session,"read"|"write" [,$activate])' 101 unless @_ >= 2; 102 my $handle = $self->to_handle($thing); 103 my $select = lc($rw) eq 'read' ? 'readers' : 'writers'; 104 my $prior = defined $self->{$select}->exists($handle); 105 if (defined $act && $act != $prior) { 106 $self->{$select}->add($handle) if $act; 107 $self->{$select}->remove($handle) unless $act; 108 warn $act ? 'Activating' : 'Inactivating', 109 " handle $handle for ", 110 $rw eq 'read' ? 'reading':'writing',".\n" if $DEBUG; 111 } 112 return $prior; 113} 114 115# Object method: wait() 116# Wait for I/O. Handles writes automatically. Returns a list of 117# IO::SessionData objects ready for reading. 118# If there is a listen socket, then will automatically do an accept() 119# and return a new IO::SessionData object for that. 120sub wait { 121 my $self = shift; 122 my $timeout = shift; 123 124 # Call select() to get the list of sessions that are ready for 125 # reading/writing. 126 warn "IO::Select->select() returned error: $!" 127 unless my ($read,$write) = 128 IO::Select->select($self->{readers},$self->{writers},undef,$timeout); 129 130 # handle queued writes automatically 131 foreach (@$write) { 132 my $session = $self->to_session($_); 133 warn "Writing pending data (",$session->pending+0," bytes) for $_.\n" 134 if $DEBUG; 135 my $rc = $session->write; 136 } 137 138 # Return list of sessions that are ready for reading. 139 # If one of the ready handles is the listen socket, then 140 # create a new session. 141 # Otherwise return the ready handles as a list of IO::SessionData objects. 142 my @sessions; 143 foreach (@$read) { 144 if ($_ eq $self->{listen_socket}) { 145 my $newhandle = $_->accept; 146 warn "Accepting a new handle $newhandle.\n" if $DEBUG; 147 my $newsess = $self->add($newhandle) if $newhandle; 148 push @sessions,$newsess; 149 } 150 else { 151 push @sessions,$self->to_session($_); 152 } 153 } 154 return @sessions; 155} 156 157# Class method: SessionDataClass 158# Return the string containing the name of the session data 159# wrapper class. Subclass and override to use a different 160# session data class. 161sub SessionDataClass { return 'IO::SessionData'; } 162 1631; 164