line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
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
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
package IO::SessionSet; |
10
|
|
|
|
|
|
|
|
11
|
2
|
|
|
2
|
|
711
|
use strict; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
68
|
|
12
|
2
|
|
|
2
|
|
11
|
use Carp; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
138
|
|
13
|
2
|
|
|
2
|
|
2295
|
use IO::Select; |
|
2
|
|
|
|
|
4126
|
|
|
2
|
|
|
|
|
109
|
|
14
|
2
|
|
|
2
|
|
2650
|
use IO::Handle; |
|
2
|
|
|
|
|
20878
|
|
|
2
|
|
|
|
|
118
|
|
15
|
2
|
|
|
2
|
|
654
|
use IO::SessionData; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
52
|
|
16
|
|
|
|
|
|
|
|
17
|
2
|
|
|
2
|
|
12
|
use vars '$DEBUG'; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
1946
|
|
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. |
24
|
|
|
|
|
|
|
sub new { |
25
|
1
|
|
|
1
|
0
|
4
|
my $pack = shift; |
26
|
1
|
|
|
|
|
2
|
my $listen = shift; |
27
|
1
|
|
|
|
|
11
|
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
|
1
|
50
|
33
|
|
|
25
|
if ( defined($listen) and $listen->can('accept') ) { |
35
|
0
|
|
|
|
|
0
|
$self->{listen_socket} = $listen; |
36
|
0
|
|
|
|
|
0
|
$self->{readers}->add($listen); |
37
|
|
|
|
|
|
|
} |
38
|
1
|
|
|
|
|
9
|
return $self; |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
# Object method: sessions() |
42
|
|
|
|
|
|
|
# Return list of all the sessions currently in the set. |
43
|
|
|
|
|
|
|
sub sessions { |
44
|
1
|
|
|
1
|
0
|
3
|
return values %{shift->{sessions}} |
|
1
|
|
|
|
|
6
|
|
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. |
50
|
|
|
|
|
|
|
sub add { |
51
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
52
|
0
|
|
|
|
|
0
|
my ($handle,$writeonly) = @_; |
53
|
0
|
0
|
|
|
|
0
|
warn "Adding a new session for $handle.\n" if $DEBUG; |
54
|
0
|
|
|
|
|
0
|
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. |
61
|
|
|
|
|
|
|
sub delete { |
62
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
63
|
0
|
|
|
|
|
0
|
my $thing = shift; |
64
|
0
|
|
|
|
|
0
|
my $handle = $self->to_handle($thing); |
65
|
0
|
|
|
|
|
0
|
my $sess = $self->to_session($thing); |
66
|
0
|
0
|
|
|
|
0
|
warn "Deleting session $sess handle $handle.\n" if $DEBUG; |
67
|
0
|
|
|
|
|
0
|
delete $self->{sessions}{$handle}; |
68
|
0
|
|
|
|
|
0
|
$self->{readers}->remove($handle); |
69
|
0
|
|
|
|
|
0
|
$self->{writers}->remove($handle); |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
# Object method: to_handle() |
73
|
|
|
|
|
|
|
# Return a handle, given either a handle or a IO::SessionData object. |
74
|
|
|
|
|
|
|
sub to_handle { |
75
|
1
|
|
|
1
|
0
|
2
|
my $self = shift; |
76
|
1
|
|
|
|
|
3
|
my $thing = shift; |
77
|
1
|
50
|
|
|
|
11
|
return $thing->handle if $thing->isa('IO::SessionData'); |
78
|
1
|
50
|
|
|
|
29
|
return $thing if defined (fileno $thing); |
79
|
1
|
|
|
|
|
5
|
return; # undefined value |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
# Object method: to_session |
83
|
|
|
|
|
|
|
# Return a IO::SessionData object, given either a handle or the object itself. |
84
|
|
|
|
|
|
|
sub to_session { |
85
|
1
|
|
|
1
|
0
|
3
|
my $self = shift; |
86
|
1
|
|
|
|
|
2
|
my $thing = shift; |
87
|
1
|
50
|
|
|
|
11
|
return $thing if $thing->isa('IO::SessionData'); |
88
|
1
|
50
|
|
|
|
8
|
return $self->{sessions}{$thing} if defined (fileno $thing); |
89
|
1
|
|
|
|
|
4
|
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. |
97
|
|
|
|
|
|
|
sub activate { |
98
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
99
|
0
|
|
|
|
|
0
|
my ($thing,$rw,$act) = @_; |
100
|
0
|
0
|
|
|
|
0
|
croak 'Usage $obj->activate($session,"read"|"write" [,$activate])' |
101
|
|
|
|
|
|
|
unless @_ >= 2; |
102
|
0
|
|
|
|
|
0
|
my $handle = $self->to_handle($thing); |
103
|
0
|
0
|
|
|
|
0
|
my $select = lc($rw) eq 'read' ? 'readers' : 'writers'; |
104
|
0
|
|
|
|
|
0
|
my $prior = defined $self->{$select}->exists($handle); |
105
|
0
|
0
|
0
|
|
|
0
|
if (defined $act && $act != $prior) { |
106
|
0
|
0
|
|
|
|
0
|
$self->{$select}->add($handle) if $act; |
107
|
0
|
0
|
|
|
|
0
|
$self->{$select}->remove($handle) unless $act; |
108
|
0
|
0
|
|
|
|
0
|
warn $act ? 'Activating' : 'Inactivating', |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
109
|
|
|
|
|
|
|
" handle $handle for ", |
110
|
|
|
|
|
|
|
$rw eq 'read' ? 'reading':'writing',".\n" if $DEBUG; |
111
|
|
|
|
|
|
|
} |
112
|
0
|
|
|
|
|
0
|
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. |
120
|
|
|
|
|
|
|
sub wait { |
121
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
122
|
0
|
|
|
|
|
0
|
my $timeout = shift; |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
# Call select() to get the list of sessions that are ready for |
125
|
|
|
|
|
|
|
# reading/writing. |
126
|
0
|
0
|
|
|
|
0
|
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
|
0
|
|
|
|
|
0
|
foreach (@$write) { |
132
|
0
|
|
|
|
|
0
|
my $session = $self->to_session($_); |
133
|
0
|
0
|
|
|
|
0
|
warn "Writing pending data (",$session->pending+0," bytes) for $_.\n" |
134
|
|
|
|
|
|
|
if $DEBUG; |
135
|
0
|
|
|
|
|
0
|
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
|
0
|
|
|
|
|
0
|
my @sessions; |
143
|
0
|
|
|
|
|
0
|
foreach (@$read) { |
144
|
0
|
0
|
|
|
|
0
|
if ($_ eq $self->{listen_socket}) { |
145
|
0
|
|
|
|
|
0
|
my $newhandle = $_->accept; |
146
|
0
|
0
|
|
|
|
0
|
warn "Accepting a new handle $newhandle.\n" if $DEBUG; |
147
|
0
|
0
|
|
|
|
0
|
my $newsess = $self->add($newhandle) if $newhandle; |
148
|
0
|
|
|
|
|
0
|
push @sessions,$newsess; |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
else { |
151
|
0
|
|
|
|
|
0
|
push @sessions,$self->to_session($_); |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
} |
154
|
0
|
|
|
|
|
0
|
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. |
161
|
1
|
|
|
1
|
0
|
766
|
sub SessionDataClass { return 'IO::SessionData'; } |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
1; |