IO::LineBufferedSessionData (Chapter 13) This module works with IO::LineBufferedSet to provide line-oriented reading in a nonblocking multiplexed application. It inherits from IO::SessionData, which is listed in Chapter 13. 0 package IO::LineBufferedSessionData; 1 # file: IO/LineBufferedSessionData.pm 2 use strict; 3 use Carp; 4 use IO::SessionData; 5 use Errno 'EWOULDBLOCK'; 6 use IO::SessionData; 7 use IO::LineBufferedSet; 8 use vars '@ISA','$VERSION'; 9 @ISA = 'IO::SessionData'; 10 $VERSION = 1.00; 11 use constant BUFSIZE => 3000; 12 # override new() by adding new instance variables 13 sub new { 14 my $pack = shift; 15 my $self = $pack->SUPER::new(@_); 16 @{$self}{qw(read_limit inbuffer linemode index eof error)} = (BUFSIZE,' ', 0,0,0,  0); 17 return $self; 18 } 19 # line_mode is set to true if the package detects that you are doing 20 # line-oriented input. You can also set this yourself. 21 sub line_mode { 22 my $self = shift; 23 return defined $_[0] ? $self->{linemode} = $_[0] 24 : $self->{linemode}; 25 } 26 # Object method: read_limit([$bufsize]) 27 # Get or set the limit on the size of the read buffer. 28 # Only affects line-oriented reading. 29 sub read_limit { 30 my $self = shift; 31 return defined $_[0] ? $self->{read_limit} = $_[0] 32 : $self->{read_limit}; 33 } 34 # Add three new methods to tell us when there's buffered data available. 35 sub buffered { return length shift->{inbuffer} } 36 sub lines_pending { 37 my $self = shift; 38 return index($self->{inbuffer},$/,$self->{index}) >= 0; 39 } 40 sub has_buffered_data { 41 my $self = shift; 42 return $self->line_mode ? $self->lines_pending : $self->buffered; 43 } 44 # override read() to deal with buffered data 45 sub read { 46 my $self = shift; 47 $self->line_mode(0); # turn off line mode 48 $self->{index} = 0; # rezero our internal newline pointer 49 if ($self->buffered) { # buffered data from an earlier getline 50 my $data = substr($self->{inbuffer},0,$_[1]); 51 substr($_[0], $_[2]0, $_[1]) = $data; 52 substr($self->{inbuffer},0,$_[1]) = "; 53 return length $data; 54 } 55 # if we get here, do the inherited read 56 return $self->SUPER::read(@_); 57 } 58 # return the last error 59 sub error { $_[0]->{error} } 60 # $bytes = $reader->getline($data); 61 # returns bytes read on success 62 # returns undef on error 63 # returns 0 on EOF 64 # returns 0E0 if would block 65 sub getline { 66 my $self = shift; 67 croak "usage: getline($scalar)\n" unless @_ == 1; 68 $self->line_mode(1); # turn on line mode 69 return unless my $handle = $self->handle; 70 undef $_[0]; # empty the caller's scalar 71 # If inbuffer is gone, then we encountered a read error and returned 72 # everything we had on a previous pass. So return undef. 73 return 0 if $self->{eof}; 74 return if $self->{error}; 75 # Look up position of the line end character in the buffer. 76 my $i = index($self->{inbuffer},$/,$self->{index}); 77 # If the line end character is not there and the buffer is below the 78 # read length, then fetch more data. 79 if ($i < 0 and $self->buffered < $self->read_limit) { 80 $self->{index} = $self->buffered; 81 my $rc = $self->SUPER::read($self->{inbuffer},BUFSIZE,$self->buffered); 82 unless (defined $rc) { # we got an error 83 return '0E0' if $! == EWOULDBLOCK; # wouldblock is OK 84 $_[0] = $self->{buffer}; # return whatever we have left 85 $self->{error} = $!; # remember what happened 86 return length $_[0]; # and return the size 87 } 88 elsif ($rc == 0) { # we got EOF 89 $_[0] = $self->{buffer}; # return whatever we have left 90 $self->{eof}++; # remember what happened 91 return length $_[0]; 92 } 93 # try once again to find the newline 94 $i = index($self->{inbuffer},$/,$self->{index}); 95 } 96 # If $i < 0, then newline not found. If we've already buffered more 97 # than the limit, then return everything up to the limit 98 if ($i < 0) { 99 if ($self->buffered > $self->read_limit) { 100 $i = $self->read_limit-1; 101 } else { 102 # otherwise return "would block" and set the search index to the 103 # end of the buffer so that we don't search it again 104 $self->{index} = $self->buffered; 105 return '0E0'; 106 } 107 } 108 # remove the line from the input buffer and reset the search 109 # index. 110 $_[0] = substr($self->{inbuffer},0,$i+1); # save the line 111 substr($self->{inbuffer},0,$i+1) = ' '; # and chop off the rest 112 $self->{index} = 0; 113 return length $_[0]; 114 } 115 1; 116 =head1 NAME 117 IO::LineBufferedSessionData - Handling of nonblocking line-buffered I/O 118 =head1 SYNOPSIS 119 use IO::LineBufferedSet; 120 my $set = IO::LineBufferedSet->new(); 121 $set->add($_) foreach ($handle1,$handle2,$handle3); 122 my $line; 123 while ($set->sessions) { 124 my @ready = $set->wait; 125 for my $h (@ready) { 126 unless (my $bytes = $h->getline($line)) { # fetch a line 127 $h->close; # EOF or an error 128 next; 129 } 130 next unless $bytes > 0; # skip zero-length line 131 my $result = process_data($line); # do some processing on the line 132 $line->write($result); # write result to handle 133 } 134 } 135 =head1 DESCRIPTION 136 This package provides support for sets of nonblocking handles for use 137 in multiplexed applications. It is used in conjunction with 138 IO::LineBufferedSet, and inherits from IO::SessionData. 139 The IO::LineBufferedSessionData object, hereafter called a "session" 140 for simplicity, supports a small subset of IO::Handle methods, and can 141 be thought of as a smart, nonblocking handle. 142 =head1 CONSTRUCTOR 143 The new() constructor is not normally called by user applications, but 144 by IO::LineBufferedSet. 145 =head1 OBJECT METHODS 146 =over 4 147 =item $bytes = $session->read($scalar, $maxbytes [,$offset]]) 148 The read() method acts like IO::Handle->read(), reading up to 149 C<$maxbytes> bytes into the scalar variable indicated by C<$scalar>. 150 If C<$offset> is provided, the new data will be appended to C<$scalar> 151 at the position indicated. 152 If successful, read() returns the number of bytes read. On 153 end of file, the method returns numeric 0. If the read() 154 operation would block, the method returns 0E0 (zero but true), and on 155 other errors returns undef. 156 This is an idiom for handling the possible outcomes: 157 while (1) { 158 my $bytes = $session->read($data,1024); 159 die "I/O error: $!" unless defined $bytes; # error 160 last unless $bytes; # eof, leave loop 161 next unless $bytes > 0; # would block error 162 process_data($data); # otherwise ok 163 } 164 =item $bytes = $session->getline($scalar); 165 This method has the same semantics as read() except that it returns 166 whole lines, observing the current value of C<$/>. Be very alert for 167 the 0E0 result code (indicating that the operation would block) 168 because these occur whenever a partial line is read. 169 Unlike <> or getline(), the result is placed in C<$scalar>, not 170 returned as the function result. 171 =item $bytes = $session->write($scalar) 172 This method writes the contents of C<$scalar> to the session's 173 internal buffer, from where it is eventually written to the handle. 174 As much of the data as possible is written immediately. If not all 175 can be written at once, the remainder is written during one or more 176 subsequent calls to wait(). 177 =item $result = $session->close() 178 This method closes the session, and removes itself from the list of 179 sessions monitored by the IO::LineBufferedSet object that owns it. 180 The handle may not actually be closed until later, when 181 pending writes are finished. 182 Do B<not> call the handle's close() method yourself, or pending writes 183 may be lost. 184 The return code indicates whether the session was successfully closed. 185 Note that this returns true on delayed closes, and thus is not of 186 much use in detecting whether the close was actually successful. 187 =item $limit = $session->write_limit([$limit] 188 To prevent the outgoing write buffer from growing without 189 limit, you can call write_limit() to set a cap on its size. If the 190 number of unwritten bytes exceeds this value, then the I<choke function> 191 will be invoked to perform some action. 192 Called with a single argument, the method sets the write limit. 193 Called with no arguments, returns the current value. Call with 0 to 194 disable the limit. 195 =item $coderef = $session->set_choke([$coderef]) 196 The set_choke() method gets or sets the I<choke function>, which is 197 invoked when the size of the write buffer exceeds the size set by 198 write_limit(). Called with a coderef argument, set_choke() sets the 199 function; otherwise it returns its current value. 200 When the choke function is invoked, it will be called with two 201 arguments consisting of the session object and a flag indicating 202 whether writes should be choked or unchoked. The function should take 203 whatever action is necessary, and return. The default choke action is 204 to disallow further reads on the session (by calling readable() with a 205 false value) until the write buffer has returned to acceptable size. 206 Note that choking a session has no effect on the write() method, which 207 can continue to append data to the buffer. 208 =item $session->readable($flag) 209 This method flags the session set that this filehandle should be 210 monitored for reading. C<$flag> is true to allow reads, and false 211 to disallow them. 212 =item $session->writable($flag) 213 This method flags the session set that this filehandle should be 214 monitored for writing. C<$flag> is true to allow writes, and false 215 to disallow them. 216 =back 217 =head1 SEE ALSO 218 L<IO::LineBufferedSessionSet>, L<IO::SessionData>, L<IO::SessionSet >, 219 L<perl> 220 =head1 AUTHOR 221 Lincoln Stein <lstein@cshl.org> 222 =head1 COPYRIGHT 223 Copyright (c) 2000 Lincoln Stein. All rights reserved. This program is 224 free software; you can redistribute it and/or modify it under the same 225 terms as Perl itself. 226 =cut |
