Codebase list libio-bufferedselect-perl / e080e9d
[svn-inject] Installing original source of libio-bufferedselect-perl Ignace Mouzannar 14 years ago
6 changed file(s) with 266 addition(s) and 0 deletion(s). Raw diff Collapse all Expand all
+6
-0
Changes less more
0 Revision history for Perl extension IO::BufferedSelect.
1
2 1.0 Tue Mar 13 00:37:49 2007
3 - original version; created by h2xs 1.23 with options
4 -v 1.0 -X -n IO::BufferedSelect
5
+6
-0
MANIFEST less more
0 Changes
1 Makefile.PL
2 MANIFEST
3 README
4 t/IO-BufferedSelect.t
5 lib/IO/BufferedSelect.pm
+12
-0
Makefile.PL less more
0 use 5.008008;
1 use ExtUtils::MakeMaker;
2 # See lib/ExtUtils/MakeMaker.pm for details of how to influence
3 # the contents of the Makefile that is written.
4 WriteMakefile(
5 NAME => 'IO::BufferedSelect',
6 VERSION_FROM => 'lib/IO/BufferedSelect.pm', # finds $VERSION
7 PREREQ_PM => {}, # e.g., Module::Name => 1.1
8 ($] >= 5.005 ? ## Add these new keywords supported since 5.005
9 (ABSTRACT_FROM => 'lib/IO/BufferedSelect.pm', # retrieve abstract from module
10 AUTHOR => 'Antal Novak <afn@cpan.org>') : ()),
11 );
+40
-0
README less more
0 IO-BufferedSelect version 1.0
1 =============================
2
3 The README is used to introduce the module and provide instructions on
4 how to install the module, any machine dependencies it may have (for
5 example C compilers and installed libraries) and any other information
6 that should be provided before the module is installed.
7
8 A README file is required for CPAN modules since CPAN extracts the
9 README file from a module distribution so that people browsing the
10 archive can use it get an idea of the modules uses. It is usually a
11 good idea to provide version information here so that people can
12 decide whether fixes for the module are worth downloading.
13
14 INSTALLATION
15
16 To install this module type the following:
17
18 perl Makefile.PL
19 make
20 make test
21 make install
22
23 DEPENDENCIES
24
25 This module requires these other modules and libraries:
26
27 blah blah blah
28
29 COPYRIGHT AND LICENCE
30
31 Put the correct copyright and licence information here.
32
33 Copyright (C) 2007 by Antal Novak
34
35 This library is free software; you can redistribute it and/or modify
36 it under the same terms as Perl itself, either Perl version 5.8.8 or,
37 at your option, any later version of Perl 5 you may have available.
38
39
+187
-0
lib/IO/BufferedSelect.pm less more
0 package IO::BufferedSelect;
1
2 use strict;
3 use warnings;
4 use IO::Select;
5
6 =head1 NAME
7
8 IO::BufferedSelect - Line-buffered select interface
9
10 =head1 SYNOPSIS
11
12 use IO::BufferedSelect;
13 my $bs = new BufferedSelect($fh1, $fh2);
14 while(1)
15 {
16 my @ready = $bs->read_line();
17 foreach(@ready)
18 {
19 my ($fh, $line) = @$_;
20 my $fh_name = ($fh == $fh1 ? "fh1" : "fh2");
21 print "$fh_name: $line";
22 }
23 }
24
25 =head1 DESCRIPTION
26
27 The C<select> system call (and the C<IO::Select> interface) allows us to process
28 multiple streams simultaneously, blocking until one or more of them is ready for
29 reading or writing. Unfortunately, this requires us to use C<sysread> and
30 C<syswrite> rather than Perl's buffered I/O functions. In the case of reading,
31 there are two issues with combining C<select> with C<readline>: (1) C<select>
32 might block but the data we want is already in Perl's input buffer, ready to
33 be slurped in by C<readline>; and (2) C<select> might indicate that data is
34 available, but C<readline> will block because there isn't a full
35 C<$/>-terminated line available.
36
37 The purpose of this module is to implement a buffered version of the C<select>
38 interface that operates on I<lines>, rather than characters. Given a set of
39 filehandles, it will block until a full line is available on one or more of
40 them.
41
42 Note that this module is currently limited, in that (1) it only does C<select>
43 for readability, not writability or exceptions; and (2) it does not support
44 arbitrary line separators (C<$/>): lines must be delimited by newlines.
45
46 =cut
47
48 our $VERSION = '1.0';
49
50 =head1 CONSTRUCTOR
51
52 =over
53
54 =item new ( HANDLES )
55
56 Create a C<BufferedSelect> object for a set of filehandles. Note that because
57 this class buffers input from these filehandles internally, you should B<only>
58 use the C<BufferedSelect> object for reading from them (you shouldn't read from
59 them directly or pass them to other BufferedSelect instances).
60
61 =back
62
63 =cut
64
65 sub new($@)
66 {
67 my $class = shift;
68 my @handles = @_;
69
70 my $self = { handles => \@handles,
71 buffers => [ map { '' } @handles ],
72 eof => [ map { 0 } @handles ],
73 selector => new IO::Select( @handles ) };
74
75 return bless $self;
76 }
77
78 =head1 METHODS
79
80 =over
81
82 =item read_line
83
84 =item read_line ($timeout)
85
86 =item read_line ($timeout, @handles)
87
88 Block until a line is available on one of the filehandles. If C<$timeout> is
89 C<undef>, it blocks indefinitely; otherwise, it returns after at most
90 C<$timeout> seconds.
91
92 If C<@handles> is specified, then only these filehandles will be considered;
93 otherwise, it will use all filehandles passed to the constructor.
94
95 Returns a list of pairs S<C<[$fh, $line]>>, where C<$fh> is a filehandle and
96 C<$line> is the line that was read (including the newline, ala C<readline>). If
97 the filehandle reached EOF, then C<$line> will be undef. Note that "reached
98 EOF" is to be interpreted in the buffered sense: if a filehandle is at EOF but
99 there are newline-terminated lines in C<BufferedSelect>'s buffer, C<read_line>
100 will continue to return lines until the buffer is empty.
101
102 =cut
103
104 sub read_line($;$@)
105 {
106 my $self = shift;
107 my ($timeout, @handles) = @_;
108
109 # Convert @handles to a "set" of indices
110 my %use_idx = ();
111 if(@handles)
112 {
113 foreach my $idx( 0..$#{$self->{handles}} )
114 {
115 $use_idx{$idx} = 1 if grep { $_ == $self->{handles}->[$idx] } @handles;
116 }
117 }
118 else
119 {
120 $use_idx{$_} = 1 foreach( 0..$#{$self->{handles}} );
121 }
122
123 for( my $is_first = 1 ; 1 ; $is_first = 0 )
124 {
125 # If we have any lines in buffers, return those first
126 my @result = ();
127
128 foreach my $idx( 0..$#{$self->{handles}} )
129 {
130 next unless $use_idx{$idx};
131
132 if($self->{buffers}->[$idx] =~ s/(.*\n)//)
133 {
134 push @result, [ $self->{handles}->[$idx], $1 ];
135 }
136 elsif($self->{eof}->[$idx])
137 {
138 # NOTE: we discard any unterminated data at EOF
139 push @result, [ $self->{handles}->[$idx], undef ];
140 }
141 }
142
143 # Only give it one shot if $timeout is defined
144 return @result if ( @result or (defined($timeout) and !$is_first) );
145
146 # Do a select(), optionally with a timeout
147 my @ready = $self->{selector}->can_read( $timeout );
148
149 # Read into $self->{buffers}
150 foreach my $fh( @ready )
151 {
152 foreach my $idx( 0..$#{$self->{handles}} )
153 {
154 next unless $fh == $self->{handles}->[$idx];
155 next unless $use_idx{$idx};
156 my $bytes = sysread $fh, $self->{buffers}->[$idx], 1024, length $self->{buffers}->[$idx];
157 $self->{eof}->[$idx] = 1 if($bytes == 0);
158 }
159 }
160 }
161 }
162
163
164 1;
165
166 __END__
167
168 =back
169
170 =head1 SEE ALSO
171
172 L<IO::Select>
173
174 =head1 AUTHOR
175
176 Antal Novak, E<lt>afn@cpan.orgE<gt>
177
178 =head1 COPYRIGHT AND LICENSE
179
180 Copyright (C) 2007 by Antal Novak
181
182 This library is free software; you can redistribute it and/or modify
183 it under the same terms as Perl itself, either Perl version 5.8.8 or,
184 at your option, any later version of Perl 5 you may have available.
185
186 =cut
+15
-0
t/IO-BufferedSelect.t less more
0 # Before `make install' is performed this script should be runnable with
1 # `make test'. After `make install' it should work as `perl IO-BufferedSelect.t'
2
3 #########################
4
5 # change 'tests => 1' to 'tests => last_test_to_print';
6
7 use Test::More tests => 1;
8 BEGIN { use_ok('IO::BufferedSelect') };
9
10 #########################
11
12 # Insert your test code below, the Test::More module is use()ed here so read
13 # its man page ( perldoc Test::More ) for help writing this test script.
14