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