IO-Stream-v2.0.3/0000755000175000017500000000000013260723453013711 5ustar powermanpowermanIO-Stream-v2.0.3/Changes0000644000175000017500000000266313260723453015213 0ustar powermanpowermanRevision history for IO-Stream v2.0.3 2018-04-03 19:09:12 EEST - Fix compatibility with perl-5.26. v2.0.2 2016-03-05 01:39:23 EET - Fixed tests for portability. v2.0.1 2016-03-01 04:07:24 EET - Reformat doc. - Fixed tests for portability. v2.0.0 2016-02-20 10:27:47 EET - Switch to Dist::Milla. - Switch from EV::ADNS to AnyEvent::DNS. - Fixed tests for portability. 1.0.10 2016-01-21 14:42:34 EET - Fixed resolving to IPv6 instead of IPv4, thanks Tom Belfort. 1.0.9 2014-12-24 11:54:43 EET - Fixed tests for portability. 1.0.8 2014-11-26 06:03:40 EET - Fixed tests for portability. 1.0.7 2012-05-25 07:01:53 EEST - Export EREQINEOF and EREQINBUFLIMIT. 1.0.6 2012-05-14 16:46:48 EEST - Fixed tests for portability. 1.0.5 2010-07-29 16:20:34 EEST - Fixed timeout on write. 1.0.4 2008-11-22 15:47:23 EET - Fixed t/extra_fields.t on Freebsd-6.1. 1.0.3 2008-11-21 16:00:03 EET - Fixed typo in Makefile.PL. 1.0.2 2008-11-19 03:33:16 EET - Added compatibility with Win32. 1.0.1 2008-11-18 14:37:35 EET - Fixed bugs in tests on FreeBSD. 1.0.0 2008-11-16 02:16:54 EET - Added tests for timeouts and read/write errors. Test suite complete. - Added documentation. 0.2.0 2008-11-15 04:51:41 EET - Added a lot of tests, test suite nearly complete. - Added plugin examples: IO::Stream::Noop and IO::Stream::NoopAlias. 0.1.0 2008-11-11 00:02:30 EET - Interface stabilization. 0.0.1 2008-11- 3 18:31:29 - Initial release. IO-Stream-v2.0.3/Build.PL0000644000175000017500000000025713260723453015211 0ustar powermanpowerman# This Build.PL for IO-Stream was generated by Dist::Zilla::Plugin::ModuleBuildTiny 0.015. use strict; use warnings; use 5.010001; use Module::Build::Tiny 0.034; Build_PL(); IO-Stream-v2.0.3/lib/0000755000175000017500000000000013260723453014457 5ustar powermanpowermanIO-Stream-v2.0.3/lib/IO/0000755000175000017500000000000013260723453014766 5ustar powermanpowermanIO-Stream-v2.0.3/lib/IO/Stream.pm0000644000175000017500000005332213260723453016564 0ustar powermanpowermanpackage IO::Stream; use 5.010001; use warnings; use strict; use utf8; use Carp; our $VERSION = 'v2.0.3'; use Scalar::Util qw( weaken ); use IO::Stream::const; use IO::Stream::EV; # # Export constants. # # Usage: use IO::Stream qw( :ALL :DEFAULT :Event :Error IN EINBUFLIMIT ... ) # sub import { my %tags = ( Event => [ qw( RESOLVED CONNECTED IN OUT EOF SENT ) ], Error => [ qw( EINBUFLIMIT ETORESOLVE ETOCONNECT ETOWRITE EDNS EDNSNXDOMAIN EDNSNODATA EREQINBUFLIMIT EREQINEOF ) ], ); $tags{ALL} = $tags{DEFAULT} = [ map { @{$_} } values %tags ]; my %known = map { $_ => 1 } @{ $tags{ALL} }; my (undef, @p) = @_; if (!@p) { @p = (':DEFAULT'); } @p = map { /\A:(\w+)\z/xms ? @{ $tags{$1} || [] } : $_ } @p; my $pkg = caller; no strict 'refs'; for my $const (@p) { next if !$known{$const}; *{"${pkg}::$const"} = \&{$const}; } return; } my @Active; sub new { my (undef, $opt) = @_; croak 'usage: IO::Stream->new({ cb=>, wait_for=>, [fh=>, | host=>, port=>,] ... })' if ref $opt ne 'HASH' || !$opt->{cb} || !($opt->{fh} xor $opt->{host}) || ($opt->{host} xor $opt->{port}); my $self = bless { # no default values for these: cb => undef, wait_for => undef, fh => undef, host => undef, port => undef, # default values: method => 'IO', in_buf_limit=> undef, out_buf => q{}, # modified on: OUT out_pos => undef, # modified on: OUT # user shouldn't provide values for these, but it's ok if he want: out_bytes => 0, # modified on: OUT in_buf => q{}, # modified on: IN in_bytes => 0, # modified on: IN ip => undef, # modified on: RESOLVED is_eof => undef, # modified on: EOF # load user values: %{$opt}, # we'll setup these below: plugin => {}, _master => undef, _slave => undef, _id => undef, }, __PACKAGE__; # Create socket if needed. if (!$self->{fh}) { # Maybe it have sense instead or croak just send event to user? # (Most probable reason: error in socket because there no more fd.) socket $self->{fh}, AF_INET, SOCK_STREAM, PROTO_TCP or croak "socket: $!"; if (!WIN32) { fcntl $self->{fh}, F_SETFL, O_NONBLOCK or croak "fcntl: $!"; } else { my $nb=1; ioctl $self->{fh}, FIONBIO, \$nb or croak "ioctl: $!"; } } # Keep this object alive, even if user doesn't keep it himself. $self->{_id} = fileno $self->{fh}; if (!$self->{_id}) { croak q{can't get file descriptor}; } elsif ($Active[ $self->{_id} ]) { croak q{can't create second object for same fh}; } else { $Active[ $self->{_id} ] = $self; } # Connect plugins into chain and setup {plugin}. my $master = $self; if ($opt->{plugin}) { while (my ($name, $plugin) = splice @{ $opt->{plugin} }, 0, 2) { $self->{plugin}{$name} = $plugin; $master->{_slave} = $plugin; $plugin->{_master} = $master; weaken($plugin->{_master}); $master = $plugin; } } my $plugin = IO::Stream::EV->new(); $master->{_slave} = $plugin; $plugin->{_master} = $master; weaken($plugin->{_master}); # Ask plugin chain to continue with initialization: $self->{_slave}->PREPARE($self->{fh}, $self->{host}, $self->{port}); # Shortcuts for typical operations after creating new I/O object: if (length $self->{out_buf}) { $self->write(); } return $self; } # # Push user data down the stream, optionally adding new data to {out_buf}. # sub write { ## no critic (ProhibitBuiltinHomonyms) my ($self, $data) = @_; if ($#_ > 0) { $self->{out_buf} .= $data; } $self->{_slave}->WRITE(); return; } # # Free fh and Stream object. # sub close { ## no critic (ProhibitBuiltinHomonyms ProhibitAmbiguousNames) my ($self) = @_; undef $Active[ $self->{_id} ]; return close $self->{fh}; } # # Filter and deliver to user events (received from top plugin in the chain). # sub EVENT { my ($self, $e, $err) = @_; my $w = $self->{wait_for}; if ($e & IN && !($w & IN)) { # override $err in case of wrong config if (!($w & EOF)) { $err = EREQINEOF; } elsif (!defined $self->{in_buf_limit}) { $err = EREQINBUFLIMIT; } } if (!$err && $e & IN && !($w & IN)) { my $l = $self->{in_buf_limit}; if ($l > 0 && length $self->{in_buf} > $l) { $err = EINBUFLIMIT; } } $e &= $w; if ($e || $err) { if (ref $self->{cb} eq 'CODE') { $self->{cb}->($self, $e, $err); } else { my $method = $self->{method}; $self->{cb}->$method($self, $e, $err); } } return; } 1; # Magic true value required at end of module __END__ =encoding utf8 =for stopwords ip EREQINEOF EREQINBUFLIMIT EINBUFLIMIT =head1 NAME IO::Stream - ease non-blocking I/O streams based on EV =head1 VERSION This document describes IO::Stream version v2.0.3 =head1 SYNOPSIS use EV; use IO::Stream; IO::Stream->new({ host => 'google.com', port => 80, cb => \&client, wait_for => SENT|EOF, in_buf_limit=> 102400, out_buf => "GET / HTTP/1.0\nHost: google.com\n\n", }); $EV::DIED = sub { warn $@; EV::unloop }; EV::loop; sub client { my ($io, $e, $err) = @_; if ($err) { $io->close(); die $err; } if ($e & SENT) { print "request sent, waiting for reply...\n"; } if ($e & EOF) { print "server reply:\n", $io->{in_buf}; $io->close(); EV::unloop; # ALL DONE } } =head1 DESCRIPTION Non-blocking event-based low-level I/O is hard to get right. Code usually error-prone and complex... and it very similar in all applications. Things become much worse when you need to alter I/O stream in some way - use proxies, encryption, SSL, etc. This module designed to give user ability to work with I/O streams on higher level, using input/output buffers (just scalars) and high-level events like CONNECTED, SENT or EOF. As same time it doesn't hide low-level things, and user still able to work on low-level without any limitations. =head2 PLUGINS Architecture of this module make it ease to write plugins, which will alter I/O stream in any way - route it through proxies, encrypt, log, etc. Here are few available plugins, you may find more on CPAN: L, L, L, L. If you interested in writing own plugin, check source for "skeleton" plugins: L and L. =head1 EXPORTS This modules doesn't export any functions/methods/variables, but it exports a lot of constants. There two groups of constants: events and errors (which can be imported using tags ':Event' and ':Error'). By default all constants are exported. Events: RESOLVED CONNECTED IN OUT EOF SENT Errors: EINBUFLIMIT ETORESOLVE ETOCONNECT ETOWRITE EDNS EDNSNXDOMAIN EDNSNODATA EREQINBUFLIMIT EREQINEOF Errors are similar to $! - they're dualvars, having both textual and numeric values. B Since v2.0.0 C, C and C are not used anymore (C is used instead), but they're still exported for compatibility. =head1 OVERVIEW You can create IO::Stream object using any "stream" fh (file, TTY, UNIX socket, TCP socket, pipe, FIFO). Or, if you need TCP socket, you can create IO::Stream object using host+port instead of fh (in this case IO::Stream will do non-blocking host resolving, create TCP socket and do non-blocking connect). After you created IO::Stream object, it will handle read/write on this fh, and deliver only high-level events you asked for into your callback, where you will be able to operate with in/out buffers instead of doing sysread()/syswrite() manually. There no limitations on what you can do with fh after you've created IO::Stream object - you can even do sysread()/syswrite() (but there no reasons for you to do this anymore). B When you want to close this fh, Bclose() method for closing fh> instead of doing close($fh). This is because IO::Stream doesn't require from you to keep object returned by new(), and without call to $io->close() IO::Stream object will continue to exists and may receive/generate some events, which is not what you expect after closing fh. Also, if you keep object returned by IO::Stream->new() somewhere in your variables, you should either undef all such variables after you called $io->close(), or you should use Scalar::Util::weaken() on these variables after storing IO::Stream object. (The same is applicable for all plugin objects too.) =head2 EVENTS =over =item RESOLVED If you created IO::Stream object using {host}+{port} instead of {fh}, this event will be generated after resolving {host}. Resolved IP address will be stored in {ip}. =item CONNECTED If you created IO::Stream object using {host}+{port} instead of {fh}, this event will be generated after connecting socket to {ip}:{port}. =item IN Generated after each successful read. IO::Stream may execute several sysread() at once before generating IN event for optimization. Read data will be stored in {in_buf}, and {in_bytes} counter will be incremented by amount of bytes read. =item EOF Generated only B when EOF reached (sysread() return 0). Also will set {is_eof} to true. =item OUT Generated when some data from {out_buf} was written. Written bytes either removed from {out_buf} or just increment {out_pos} by amount of bytes written (see documentation about these fields below for more details). Also increment {out_bytes} counter by amount of bytes written. Here 'written' may be somewhat virtual, while {out_buf}/{out_pos} changes, the real data still can be in plugin buffers (if you use plugins) and real syswrite() may not be called yet. To detect when all data is B written you should use SENT event, not OUT. =item SENT Generated when all data from {out_buf} was written. It's usual and safe to call $io->close() on SENT event. =back =head2 TIMEOUTS IO::Stream has 30-second timeouts for connect and write, to timeout DNS resolve it use default AnyEvent::DNS timeout. If you need to timeout other operations, you have to create own timers using EV::timer(). Current version doesn't allow you to change these timeouts. =head2 SERVER If you need to run TCP/UNIX-server socket, then you should handle that socket manually. But you can create IO::Stream object for accept()'ed socket: my ($host, $port) = ('0.0.0.0', 1234); socket my $srv_sock, AF_INET, SOCK_STREAM, 0; setsockopt $srv_sock, SOL_SOCKET, SO_REUSEADDR, 1; bind $srv_sock, sockaddr_in($port, inet_aton($host)); listen $srv_sock, SOMAXCONN; fcntl $srv_sock, F_SETFL, O_NONBLOCK; $srv_w = EV::io($srv_sock, EV::READ, sub { if (accept my $sock, $srv_sock) { IO::Stream->new({ fh => $sock, cb => \&server, wait_for => IN, }); } elsif ($! != EAGAIN) { die "accept: $!"; } }); =head1 INTERFACE IO::Stream provide only three public methods: new(), write() and close(). new() will create new object, close() will destroy it and write() must be called when you want to modify (or just modified) output buffer. All other operations are done using IO::Stream object fields - for simplicity and performance reasons. Moreover, you can keep your own data in it. There convention on field names, to avoid conflicts: =over =item /^_/ Fields with names started with underscore are for internal use by IO::Stream, you shouldn't touch them or create your own field with such names. =item /^[a-z]/ Fields with names started with lower-case letter are part of IO::Stream public interface - you allowed to read/write these fields, but you should not store incorrect values in these fields. Check L below for description of available fields and their format. =item /^[A-Z]/ You can store your own data in IO::Stream object using field names started with upper-case letter. IO::Stream will not touch these fields. =back When some event arise which you're waited for, your callback will be called with 3 parameters: IO::Stream object, event mask, and error (if any): sub callback { my ($io, $e, $err) = @_; } =head1 METHODS =head2 new IO::Stream->new( \%opt ); Create and return IO::Stream object. You may not keep returned object - you will get it in your callback (in first parameter) when some interesting for your event happens, and will exists until to call method close(). See L for more details. Fields of %opt become fields of created IO::Stream object. There only few fields required, but you can set any other fields too, and can also set your custom fields (with names starting from upper-case letter). Only required fields in %opt are {cb} and either {fh} or {host}+{port}. The {wait_for} field also highly recommended to set when creating object. If {out_buf} will be set, then new() will automatically call write() after creating object. IO::Stream->new({ fh => \*STDIN, cb => \&console, wait_for => IN, }); =head2 write $io->write(); $io->write($data); Method write() B be called after any modifications of {out_buf} field, to ensure data in {out_buf} will be written to {fh} as soon as it will be possible. If {fh} available for writing when calling write(), then it will write (may be partially) {out_buf} and may immediately call your callback function delivering OUT|SENT events there. So, if you call write() from that callback (as it usually happens), keep in mind it may be called again while executing write(), and object state may significantly change (it even may be close()'d) after it return from write() into your callback. The write($data) is just a shortcut for: $io->{out_buf} .= $data; $io->write(); =head2 close $io->close() Method close() will close {fh} and destroy IO::Stream object. See L for more details. =head1 PUBLIC FIELDS If field marked *RO* that mean field is read-only and shouldn't be changed. Some field have default values (shown after equal sign). Some field modified on events. =over =item cb =item method ='IO' User callback which will be called when some listed in {wait_for} events arise or error happens. Field {cb} should be either CODE ref or object or class name. In last two cases method named {method} will be called. Field {method} should be string. =item wait_for Bitmask of events interesting for user. Can be changed at any time. For example: $io->{wait_for} = RESOLVED|CONNECTED|IN|EOF|OUT|SENT; When some data will be read from {fh}, {wait_for} must contain IN and/or EOF, or error EREQINEOF will be generated. So, it's better to always have IN and/or EOF in {wait_for}. If {wait_for} contain EOF and doesn't contain IN then {in_buf_limit} must be defined or error EREQINBUFLIMIT will be generated. =item fh *RO* File handle for doing I/O. It's either provided by user to new(), or created by new() (when user provided {host}+{port} instead). =item host *RO* =item port *RO* If user doesn't provide {fh} to new(), he should provide {host} and {port} instead. This way new() will create new TCP socket in {fh} and resolve {host} and connect this {fh} to resolved {ip} and {port}. Both resolving and connecting happens in non-blocking way, and will result in delivering RESOLVED and CONNECTED events into user callback (if user {wait_for} these events). =item in_buf_limit =undef Used to avoid DoS attach when user doesn't handle IN events and want his callback called only on EOF event. Must be defined if user have EOF without IN in {wait_for}. Any value >0 will defined amount of bytes which can be read into {in_buf} before EOF happens. When size of {in_buf} become larger than {in_buf_limit}, error EINBUFLIMIT will be delivered to user callback. In this case user can either remove some data from {in_buf} to make it smaller than {in_buf_limit} or increase {in_buf_limit}, and continue reading data. B Value 0 will switch off DoS protection, so there will be no limit on amount of data to read into {in_buf} until EOF happens. =item out_buf =q{} # modified on: OUT =item out_pos =undef # modified on: OUT Data from {out_buf} will be written to {fh}. If {out_pos} not defined, then data will be written from beginning of {out_buf}, and after successful write written bytes will be removed from beginning of {out_buf}. If {out_pos} defined, it should be >= 0. In this case data will be written from {out_pos} position in {out_buf}, and after successful write {out_pos} will be incremented by amount of bytes written. {out_buf} will not be changed! =item out_bytes =0 # modified on: OUT Each successful write will increment {out_bytes} by amount of written bytes. You can change {out_bytes} in any way, but it should always be a number. =item in_buf =q{} # modified on: IN Each successful read will concatenate read bytes to {in_buf}. You can change {in_buf} in any way, but it should always be a string. =item in_bytes =0 # modified on: IN Each successful read will increment {in_bytes} by amount of read bytes. You can change {in_bytes} in any way, but it should always be a number. =item ip *RO* =undef # modified on: RESOLVED When you call new() with {host}+{port} instead of {fh} then IP address resolved from {host} will be stored in {ip}, and event RESOLVED will be generated. =item is_eof *RO* =undef # modified on: EOF When EOF event happens {is_eof} will be set to true value. This allow you to detect is EOF already happens at any time, even if you doesn't have EOF in {wait_for}. =item plugin *RO* ={} Allow you to set list of plugins when creating object with new(), and later access these plugins. This field is somewhat special, because when you call new() you should set plugin to ARRAY ref, but in IO::Stream object {plugin} is HASH ref: my $io = IO::Stream->new({ host => 'www.google.com', port => 443, cb => \&google, wait_for => EOF, in_buf_limit=> 102400, out_buf => "GET / HTTP/1.0\nHost: www.google.com\n\n", plugin => [ # <------ it's ARRAY, but looks like HASH ssl => IO::Stream::MatrixSSL::Client->new(), proxy => IO::Stream::Proxy::HTTPS->new({ host => 'my.proxy.com', port => 3218, user => 'me', pass => 'my pass', }), ], MyField1 => 'my data1', MyField2 => \%mydata2, }); # access the "proxy" plugin: $io->{plugin}{proxy}; This is because when calling new() it's important to keep plugins in order, but later it's easier to access them using names. =back =head1 DIAGNOSTICS Exceptions may be thrown only in new(). All other errors will be delivered to user's callback in last parameter. =over =item C<< usage: IO::Stream->new({ cb=>, wait_for=>, [fh=>, | host=>, port=>,] ... }) >> You called new() with wrong parameters. =item C<< socket: %s >> =item C<< fcntl: %s >> Error happens while creating new socket. Usually this happens because you run out of file descriptors. =item C<< can't get file descriptor >> Failed to get fileno() for your fh. Either fh doesn't open, or this fh type is not supported (directory handle), or fh is not file handle at all. =item C<< can't create second object for same fh >> You can't have more than one IO::Stream object for same fh. IO::Stream keep all objects created by new() until $io->close() will be called. Probably you've closed fh in some way without calling $io->close(), then new fh was created with same file descriptor number, and you've tried to create IO::Stream object using new fh. =back =head1 SEE ALSO L =head1 SUPPORT =head2 Bugs / Feature Requests Please report any bugs or feature requests through the issue tracker at L. You will be notified automatically of any progress on your issue. =head2 Source Code This is open source software. The code repository is available for public review and contribution under the terms of the license. Feel free to fork the repository and submit pull requests. L git clone https://github.com/powerman/perl-IO-Stream.git =head2 Resources =over =item * MetaCPAN Search L =item * CPAN Ratings L =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Testers Matrix L =item * CPANTS: A CPAN Testing Service (Kwalitee) L =back =head1 AUTHOR Alex Efros Epowerman@cpan.orgE =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2008- by Alex Efros Epowerman@cpan.orgE. This is free software, licensed under: The MIT (X11) License =cut IO-Stream-v2.0.3/lib/IO/Stream/0000755000175000017500000000000013260723453016221 5ustar powermanpowermanIO-Stream-v2.0.3/lib/IO/Stream/const.pm0000644000175000017500000000437013260723453017711 0ustar powermanpowermanpackage IO::Stream::const; use 5.010001; use warnings; use strict; use utf8; use Carp; our $VERSION = 'v2.0.3'; use Scalar::Util qw( dualvar ); use Errno qw( EAGAIN ); use Fcntl (); use Socket (); use constant WIN32 => $^O =~ /Win32/msi ? 1 : 0; use constant BUFSIZE => 8192; # Events: use constant RESOLVED => 1<<0; use constant CONNECTED => 1<<1; use constant IN => 1<<2; use constant OUT => 1<<3; use constant EOF => 1<<4; use constant SENT => 1<<5; # Timeouts: use constant TOCONNECT => 30; use constant TOWRITE => 30; # Custom errors: use constant EINBUFLIMIT => dualvar(-100, 'in_buf_limit reached'); use constant ETORESOLVE => dualvar(-101, 'dns timeout'); # unused, keep for compatibility use constant ETOCONNECT => dualvar(-102, 'connect timeout'); use constant ETOWRITE => dualvar(-103, 'write timeout'); use constant EDNS => dualvar(-200, 'dns error'); use constant EDNSNXDOMAIN => dualvar(-201, 'dns nxdomain'); # unused, keep for compatibility use constant EDNSNODATA => dualvar(-202, 'dns nodata'); # unused, keep for compatibility use constant EREQINBUFLIMIT => dualvar(-300, 'in_buf_limit required'); use constant EREQINEOF => dualvar(-301, 'IN or EOF required in wait_for'); # Cache for speed: ## no critic (ProhibitStringyEval RequireCheckingReturnValueOfEval ProhibitImplicitNewlines) BEGIN { if (!WIN32) { eval ' use constant F_SETFL => Fcntl::F_SETFL(); use constant O_NONBLOCK => Fcntl::O_NONBLOCK(); '} else { eval ' use constant FIONBIO => 0x8004667E; '}} ## use critic use constant PROTO_TCP => scalar getprotobyname 'tcp'; use constant AF_INET => Socket::AF_INET(); use constant SOCK_STREAM => Socket::SOCK_STREAM(); sub import { my $pkg = caller; no strict 'refs'; for my $const (qw( WIN32 BUFSIZE EAGAIN RESOLVED CONNECTED IN OUT EOF SENT TOCONNECT TOWRITE EINBUFLIMIT ETORESOLVE ETOCONNECT ETOWRITE EDNS EDNSNXDOMAIN EDNSNODATA EREQINBUFLIMIT EREQINEOF F_SETFL O_NONBLOCK FIONBIO PROTO_TCP AF_INET SOCK_STREAM )) { *{"${pkg}::$const"} = \&{$const}; } return; } 1; IO-Stream-v2.0.3/lib/IO/Stream/EV.pm0000644000175000017500000001071513260723453017075 0ustar powermanpowermanpackage IO::Stream::EV; use 5.010001; use warnings; use strict; use utf8; use Carp; our $VERSION = 'v2.0.3'; use IO::Stream::const; use Scalar::Util qw( weaken ); use Socket qw( inet_aton sockaddr_in ); use EV; use AnyEvent::DNS; # States: use constant RESOLVING => 1; use constant CONNECTING => 2; use constant HANDLING => 3; sub new { my $self = bless { fh => undef, _state => 0, # RESOLVING -> CONNECTING -> HANDLING _r => undef, # read watcher _w => undef, # write watcher _t => undef, # timer watcher _cb_r => undef, # read callback _cb_w => undef, # write callback _cb_t => undef, # timer callback }, __PACKAGE__; my $this = $self; weaken($this); $self->{_cb_t} = sub { $this->T() }; $self->{_cb_r} = sub { $this->R() }; $self->{_cb_w} = sub { $this->W() }; return $self; } sub PREPARE { my ($self, $fh, $host, $port) = @_; $self->{fh} = $fh; if (!defined $host) { $self->{_state} = HANDLING; $self->{_r} = EV::io($fh, EV::READ, $self->{_cb_r}); } else { $self->{_state} = RESOLVING; _resolve($host, $self, sub { my ($self, $ip) = @_; $self->{_state} = CONNECTING; # TODO try other ip on failed connect? connect $self->{fh}, sockaddr_in($port, inet_aton($ip)); $self->{_r} = EV::io($fh, EV::READ, $self->{_cb_r}); $self->{_w} = EV::io($fh, EV::WRITE, $self->{_cb_w}); $self->{_t} = EV::timer(TOCONNECT, 0, $self->{_cb_t}); $self->{_master}{ip} = $ip; $self->{_master}->EVENT(RESOLVED); }); } return; } sub WRITE { my ($self) = @_; if ($self->{_state} == HANDLING) { $self->{_cb_w}->(); } return; } sub _resolve { my ($host, $plugin, $cb) = @_; if ($host =~ /\A\d{1,3}[.]\d{1,3}[.]\d{1,3}[.]\d{1,3}\z/xms) { $cb->($plugin, $host); } else { weaken($plugin); # AnyEvent::DNS has own timeouts, so we don't setup own here. AnyEvent::DNS::a $host, sub { my (@a) = @_; return if !$plugin; if (@a) { $cb->($plugin, @a); } else { $plugin->{_master}->EVENT(0, EDNS); } return; }; } return; } sub T { my ($self) = @_; my $m = $self->{_master}; $m->EVENT(0, $self->{_state} == CONNECTING ? ETOCONNECT : ETOWRITE); return; } sub R { my ($self) = @_; my $m = $self->{_master}; my $n = sysread $self->{fh}, $m->{in_buf}, BUFSIZE, length $m->{in_buf}; if (defined $n) { if ($n) { $m->{in_bytes} += $n; $m->EVENT(IN); } elsif (!$m->{is_eof}) { # EOF delivered only once $m->{is_eof} = 1; $m->EVENT(EOF); } } elsif ($! != EAGAIN) { # may need to handle EINTR too $m->EVENT(0, $!); } return; } sub W { my ($self) = @_; my $m = $self->{_master}; my $e = 0; if ($self->{_state} == CONNECTING) { $self->{_state} = HANDLING; undef $self->{_t}; undef $self->{_w}; $e |= CONNECTED; } my $len = length $m->{out_buf}; my $has_out = defined $m->{out_pos} ? ($len > $m->{out_pos}) : ($len>0); if ($has_out) { my $n = syswrite $self->{fh}, $m->{out_buf}, BUFSIZE, $m->{out_pos}||0; if (!defined $n) { if ($! != EAGAIN) { $m->EVENT($e, $!); return; # WARNING leave {_w} unchanged } } else { $m->{out_bytes} += $n; if (defined $m->{out_pos}) { $m->{out_pos} += $n; $has_out = $len > $m->{out_pos}; } else { substr $m->{out_buf}, 0, $n, q{}; $has_out = $len > $n; } if ($self->{_t}) { $self->{_t} = EV::timer(TOWRITE, 0, $self->{_cb_t}); } $e |= $has_out ? OUT : (OUT|SENT); } } if ($self->{_w} && !$has_out) { undef $self->{_w}; undef $self->{_t}; } elsif (!$self->{_w} && $has_out) { $self->{_w} = EV::io($self->{fh}, EV::WRITE, $self->{_cb_w}); $self->{_t} = EV::timer(TOWRITE, 0, $self->{_cb_t}); } $m->EVENT($e); return; } 1; IO-Stream-v2.0.3/lib/IO/Stream/NoopAlias.pm0000644000175000017500000000127113260723453020445 0ustar powermanpowerman# No-op plugin example based on Data::Alias. package IO::Stream::NoopAlias; use 5.010001; use warnings; use strict; use utf8; use Carp; our $VERSION = 'v2.0.3'; use Data::Alias 0.08; sub new { my ($class) = @_; my $self = bless {}, $class; return $self; } sub PREPARE { my ($self, $fh, $host, $port) = @_; for (qw( out_buf out_pos out_bytes in_buf in_bytes ip is_eof )) { alias $self->{$_} = $self->{_master}->{$_}; } $self->{_slave}->PREPARE($fh, $host, $port); return; } sub WRITE { my ($self) = @_; $self->{_slave}->WRITE(); return; } sub EVENT { my ($self, $e, $err) = @_; $self->{_master}->EVENT($e, $err); return; } 1; IO-Stream-v2.0.3/lib/IO/Stream/Noop.pm0000644000175000017500000000313613260723453017475 0ustar powermanpowerman# No-op plugin example. package IO::Stream::Noop; use 5.010001; use warnings; use strict; use utf8; use Carp; our $VERSION = 'v2.0.3'; use IO::Stream::const; sub new { my ($class) = @_; my $self = bless { out_buf => q{}, # modified on: OUT out_pos => undef, # modified on: OUT out_bytes => 0, # modified on: OUT in_buf => q{}, # modified on: IN in_bytes => 0, # modified on: IN ip => undef, # modified on: RESOLVED is_eof => undef, # modified on: EOF }, $class; return $self; } sub PREPARE { my ($self, $fh, $host, $port) = @_; $self->{_slave}->PREPARE($fh, $host, $port); return; } sub WRITE { my ($self) = @_; my $m = $self->{_master}; $self->{out_buf} = $m->{out_buf}; $self->{out_pos} = $m->{out_pos}; $self->{out_bytes} = $m->{out_bytes}; $self->{_slave}->WRITE(); return; } sub EVENT { my ($self, $e, $err) = @_; my $m = $self->{_master}; if ($e & OUT) { $m->{out_buf} = $self->{out_buf}; $m->{out_pos} = $self->{out_pos}; $m->{out_bytes} = $self->{out_bytes}; } if ($e & IN) { $m->{in_buf} .= $self->{in_buf}; $m->{in_bytes} += $self->{in_bytes}; $self->{in_buf} = q{}; $self->{in_bytes}= 0; } if ($e & RESOLVED) { $m->{ip} = $self->{ip}; } if ($e & EOF) { $m->{is_eof} = $self->{is_eof}; } $m->EVENT($e, $err); return; } 1; IO-Stream-v2.0.3/t/0000755000175000017500000000000013260723453014154 5ustar powermanpowermanIO-Stream-v2.0.3/t/01.export-event.t0000644000175000017500000000122313260723453017216 0ustar powermanpowermanuse warnings; use strict; use Test::More; use IO::Stream qw(:Event); my @exports = qw( RESOLVED CONNECTED IN EOF OUT SENT ); my @not_exports = qw( EINBUFLIMIT ETORESOLVE ETOCONNECT ETOWRITE EDNS EDNSNXDOMAIN EDNSNODATA BUFSIZE TOCONNECT TOWRITE EREQINBUFLIMIT EREQINEOF ); plan +(@exports + @not_exports) ? ( tests => @exports + @not_exports ) : ( skip_all => q{This module doesn't export anything} ) ; for my $export (@exports) { can_ok( __PACKAGE__, $export ); } for my $not_export (@not_exports) { ok( ! __PACKAGE__->can($not_export) ); } IO-Stream-v2.0.3/t/author-perlcritic.t0000644000175000017500000000063313260723453020003 0ustar powermanpowerman#!/usr/bin/perl BEGIN { unless ($ENV{AUTHOR_TESTING}) { print qq{1..0 # SKIP these tests are for testing by the author\n}; exit } } use strict; use warnings; use Test::More; eval { require Test::Perl::Critic; }; plan(skip_all=>'Test::Perl::Critic required to criticise code') if $@; Test::Perl::Critic->import( -verbose => 9, # verbose 6 will hide rule name ); all_critic_ok(); IO-Stream-v2.0.3/t/uc-google.t0000644000175000017500000000126613260723453016227 0ustar powermanpowerman# Use case: HTTP GET until EOF use warnings; use strict; use lib 't'; use share; IO::Stream->new({ # fh => tcp_client('www.google.com', 80), host => 'www.google.com', port => 80, cb => \&client, wait_for => EOF, out_buf => "GET / HTTP/1.0\nHost: www.google.com\n\n", in_buf_limit=> 1024000, }); @CheckPoint = ( [ 'client', EOF, undef ], 'client: got eof', ); plan tests => 1 + @CheckPoint/2; EV::loop; sub client { my ($io, $e, $err) = @_; checkpoint($e, $err); like($io->{in_buf}, qr{\AHTTP/\d+\.\d+ }, 'got reply from web server'); die "server error\n" if $e != EOF || $err; EV::unloop; } IO-Stream-v2.0.3/t/timeout-write-slowclient.t0000644000175000017500000000312113260723453021335 0ustar powermanpowerman# Write timeout. use warnings; use strict; use lib 't'; use IO::Stream::const (); BEGIN { local $SIG{__WARN__} = sub {}; # no 'constant redefined' warning *IO::Stream::const::TOWRITE = sub () { 1 }; } use share; @CheckPoint = ( [ 'client', RESOLVED, undef ], 'client: RESOLVED', [ 'client', CONNECTED|OUT, undef ], 'client: CONNECTED', [ 'server', 16, ], 'server: read 16 bytes', [ 'server', 16, ], 'server: read 16 bytes', [ 'server', 16, ], 'server: read 16 bytes', [ 'client', 0, 'write timeout' ], 'client: write timeout', ); plan tests => checkpoint_count(); my $srv_sock = tcp_server('127.0.0.1', 0); my %srv_t; my $srv_w = EV::io($srv_sock, EV::READ, sub { accept my $sock, $srv_sock or die "accept: $!"; nonblocking($sock); my $i = 3; $srv_t{$sock} = EV::timer 0, 0.1, sub { server($sock, \$i) }; }); IO::Stream->new({ host => '127.0.0.1', port => sockport($srv_sock), cb => \&client, wait_for => RESOLVED|CONNECTED|OUT|SENT, out_buf => ('x' x 2048000), }); EV::loop; sub server { my ($sock, $i) = @_; my $n = sysread $sock, my $buf, 16; checkpoint($n) if $$i > 0; EV::unloop if --$$i < -30; # client doesn't get 'write timeout' in 3 seconds return; } sub client { my ($io, $e, $err) = @_; # &diag_event; if ($e == OUT) { $io->{out_buf} .= 'x' x (2048000 - length $io->{out_buf}); } else { checkpoint($e, $err); } EV::unloop if $err; } IO-Stream-v2.0.3/t/uc-proxy-big-alias.t0000644000175000017500000001220513260723453017755 0ustar powermanpowerman# Use case: client connect to tr/x/y/ server and send/recv a lot of data. # Use case: client connect to tr/x/y/ server using tr/y/z/ proxy and # send/recv a lot of data, using Data::Alias to avoid needless # data copying in proxy. use warnings; use strict; use lib 't'; use share; BEGIN { eval { require Data::Alias; Data::Alias->VERSION('0.08'); Data::Alias->import(); 1 } or plan skip_all => 'Data::Alias required'; } my $SIZE = 204800; use constant ACCEPTED => 123; @CheckPoint = ( # first test: client connect to server without proxy ['listener_server', ACCEPTED ], 'server: new client', (( ['server', IN ], 'server: IN', ['server', ('x' x BUFSIZE) ], ' received "xxx..."', ) x ($SIZE/BUFSIZE)), ['server', SENT ], 'server: SENT', ['client', EOF ], 'client: EOF', ['client', ('y' x $SIZE) ], ' received "yyyyyyyyy..."', # second test: client connect to server using proxy ['listener_proxy', ACCEPTED ], 'proxy: new client', { win32_somefreebsd => [ ['listener_server', ACCEPTED ], 'server: new client', ['proxy2server', CONNECTED ], 'proxy2server: CONNECTED', ], other => [ ['proxy2server', CONNECTED ], 'proxy2server: CONNECTED', ['listener_server', ACCEPTED ], 'server: new client', ], }, (( ['server', IN ], 'server: IN', ['server', ('x' x BUFSIZE) ], ' received "xxx..."', ) x ($SIZE/BUFSIZE)), ['server', SENT ], 'server: SENT', ['proxy2server', EOF ], 'proxy2server: EOF', ['client2', EOF ], 'client2: EOF', ['client2', ('z' x $SIZE) ], ' received "zzzzzzzzz..."', ); plan tests => 2 # {is_eof} tests in client() and client2() + checkpoint_count(); my $srv_sock = tcp_server('127.0.0.1', 0); my $srv_w = EV::io($srv_sock, EV::READ, \&listener_server); my $prx_sock = tcp_server('127.0.0.1', 0); my $prx_w = EV::io($prx_sock, EV::READ, \&listener_proxy); sub new_client { my ($port, $cb) = @_; IO::Stream->new({ host => '127.0.0.1', port => $port, cb => $cb, wait_for => EOF, out_buf => ('x' x $SIZE), in_buf_limit=> 0, }); } new_client(sockport($srv_sock), \&client); EV::loop; sub listener_server { if (accept my $sock, $srv_sock) { checkpoint(ACCEPTED); IO::Stream->new({ fh => $sock, cb => \&server, wait_for => IN, }); } elsif ($! != EAGAIN) { die "accept: $!\n"; } } sub server { my ($io, $e, $err) = @_; die "server error: $err\n" if $err; checkpoint($e); if ($e & IN) { checkpoint($io->{in_buf}); if ($io->{in_bytes} == $SIZE) { $io->{wait_for} = SENT; } $io->write('y' x length $io->{in_buf}); $io->{in_buf} = q{}; } if ($e & SENT) { $io->close(); } } sub listener_proxy { if (accept my $sock, $prx_sock) { checkpoint(ACCEPTED); IO::Stream->new({ host => '127.0.0.1', port => sockport($srv_sock), cb => \&proxy2server, wait_for => CONNECTED|IN|EOF, Client => undef, ClientSock => $sock, }); } elsif ($! != EAGAIN) { die "accept: $!\n"; } } sub proxy2server { my ($io, $e, $err) = @_; die "proxy2server error: $err\n" if $err; checkpoint($e) if $e != IN && $e != SENT; if ($e & CONNECTED) { $io->{Client} = IO::Stream->new({ fh => $io->{ClientSock}, cb => \&proxy2client, wait_for => IN, out_pos => 0, Server => $io, }); weaken($io->{Client}->{Server}); weaken($io->{Client}); alias $io->{Client}->{out_buf} = $io->{in_buf}; alias $io->{out_buf} = $io->{Client}->{in_buf}; } if ($e & SENT) { shutdown $io->{fh}, 1; } if ($e & IN) { $io->{in_buf} =~ s/y/z/g; if ($io->{in_bytes} == $SIZE) { $io->{Client}->{wait_for} |= SENT; } $io->{Client}->write(); } if ($e & EOF) { $io->close(); } } sub proxy2client { my ($io, $e, $err) = @_; die "proxy2client error: $err\n" if $err; checkpoint($e) if $e != IN && $e != SENT; if ($e & IN) { if ($io->{in_bytes} == $SIZE) { $io->{Server}->{wait_for} |= SENT; } $io->{Server}->write(); } if ($e & SENT) { $io->close(); } } sub client { my ($io, $e, $err) = @_; die "client error: $err\n" if $err; checkpoint($e); checkpoint($io->{in_buf}); ok($io->{is_eof}, ' {is_eof} set'); $io->close(); new_client(sockport($prx_sock), \&client2); } sub client2 { my ($io, $e, $err) = @_; die "client2 error: $err\n" if $err; checkpoint($e); checkpoint($io->{in_buf}); ok($io->{is_eof}, ' {is_eof} set'); $io->close(); EV::unloop; } IO-Stream-v2.0.3/t/00.load.t0000644000175000017500000000016213260723453015475 0ustar powermanpowermanuse Test::More tests => 1; BEGIN { use_ok( 'IO::Stream' ); } diag( "Testing IO::Stream $IO::Stream::VERSION" ); IO-Stream-v2.0.3/t/01.export.t0000644000175000017500000000121013260723453016073 0ustar powermanpowermanuse warnings; use strict; use Test::More; use IO::Stream; my @exports = qw( RESOLVED CONNECTED IN EOF OUT SENT EINBUFLIMIT ETORESOLVE ETOCONNECT ETOWRITE EDNS EDNSNXDOMAIN EDNSNODATA EREQINBUFLIMIT EREQINEOF ); my @not_exports = qw( BUFSIZE TOCONNECT TOWRITE ); plan +(@exports + @not_exports) ? ( tests => @exports + @not_exports ) : ( skip_all => q{This module doesn't export anything} ) ; for my $export (@exports) { can_ok( __PACKAGE__, $export ); } for my $not_export (@not_exports) { ok( ! __PACKAGE__->can($not_export) ); } IO-Stream-v2.0.3/t/01.export-error.t0000644000175000017500000000122313260723453017226 0ustar powermanpowermanuse warnings; use strict; use Test::More; use IO::Stream qw(:Error); my @exports = qw( EINBUFLIMIT ETORESOLVE ETOCONNECT ETOWRITE EDNS EDNSNXDOMAIN EDNSNODATA EREQINBUFLIMIT EREQINEOF ); my @not_exports = qw( RESOLVED CONNECTED IN EOF OUT SENT BUFSIZE TOCONNECT TOWRITE ); plan +(@exports + @not_exports) ? ( tests => @exports + @not_exports ) : ( skip_all => q{This module doesn't export anything} ) ; for my $export (@exports) { can_ok( __PACKAGE__, $export ); } for my $not_export (@not_exports) { ok( ! __PACKAGE__->can($not_export) ); } IO-Stream-v2.0.3/t/01.export-custom.t0000644000175000017500000000127213260723453017413 0ustar powermanpowermanuse warnings; use strict; use Test::More; use IO::Stream qw(:Event EINBUFLIMIT EREQINEOF :BadTag BadConst); my @exports = qw( RESOLVED CONNECTED IN EOF OUT SENT EINBUFLIMIT EREQINEOF ); my @not_exports = qw( ETORESOLVE ETOCONNECT ETOWRITE EDNS EDNSNXDOMAIN EDNSNODATA BUFSIZE TOCONNECT TOWRITE EREQINBUFLIMIT ); plan +(@exports + @not_exports) ? ( tests => @exports + @not_exports ) : ( skip_all => q{This module doesn't export anything} ) ; for my $export (@exports) { can_ok( __PACKAGE__, $export ); } for my $not_export (@not_exports) { ok( ! __PACKAGE__->can($not_export) ); } IO-Stream-v2.0.3/t/uc-proxy.t0000644000175000017500000001124713260723453016134 0ustar powermanpowerman# Use case: client connect to echo server. # Use case: client connect to echo server using proxy. use warnings; use strict; use lib 't'; use share; use constant ACCEPTED => 123; @CheckPoint = ( # first test: client connect to server without proxy ['listener_server', ACCEPTED ], 'server: new client', ['server', IN ], 'server: IN', ['server', 'test' ], ' received "test"', ['server', SENT ], 'server: SENT', ['client', EOF ], 'client: EOF', ['client', 'passed' ], ' received "passed"', # second test: client connect to server using proxy ['listener_proxy', ACCEPTED ], 'proxy: new client', { win32_somefreebsd => [ ['listener_server', ACCEPTED ], 'server: new client', ['proxy2server', CONNECTED ], 'proxy2server: CONNECTED', ], other => [ ['proxy2server', CONNECTED ], 'proxy2server: CONNECTED', ['listener_server', ACCEPTED ], 'server: new client', ], }, ['proxy2client', IN ], 'proxy2client: IN', ['server', IN ], 'server: IN', ['server', 'test' ], ' received "test"', ['server', SENT ], 'server: SENT', ['proxy2server', IN ], 'proxy2server: IN', ['proxy2client', SENT ], 'proxy2client: SENT', ['proxy2server', EOF ], 'proxy2server: EOF', ['client2', EOF ], 'client2: EOF', ['client2', 'passed' ], ' received "passed"', ); plan tests => 2 # {is_eof} tests in client() and client2() + checkpoint_count(); my $srv_sock = tcp_server('127.0.0.1', 0); my $srv_w = EV::io($srv_sock, EV::READ, \&listener_server); my $prx_sock = tcp_server('127.0.0.1', 0); my $prx_w = EV::io($prx_sock, EV::READ, \&listener_proxy); sub new_client { my ($port, $cb) = @_; IO::Stream->new({ host => '127.0.0.1', port => $port, cb => $cb, wait_for => EOF, out_buf => 'test', in_buf_limit=> 1024, }); } new_client(sockport($srv_sock), \&client); EV::loop; sub listener_server { if (accept my $sock, $srv_sock) { checkpoint(ACCEPTED); IO::Stream->new({ fh => $sock, cb => \&server, wait_for => IN, }); } elsif ($! != EAGAIN) { die "accept: $!\n"; } } sub server { my ($io, $e, $err) = @_; die "server error: $err\n" if $err; checkpoint($e); if ($e & IN) { checkpoint($io->{in_buf}); $io->{wait_for} = SENT; $io->write('passed'); } if ($e & SENT) { $io->close(); } } sub listener_proxy { if (accept my $sock, $prx_sock) { checkpoint(ACCEPTED); IO::Stream->new({ host => '127.0.0.1', port => sockport($srv_sock), cb => \&proxy2server, wait_for => CONNECTED|IN|EOF, Client => undef, ClientSock => $sock, }); } elsif ($! != EAGAIN) { die "accept: $!\n"; } } sub proxy2server { my ($io, $e, $err) = @_; die "proxy2server error: $err\n" if $err; checkpoint($e); if ($e & CONNECTED) { $io->{Client} = IO::Stream->new({ fh => $io->{ClientSock}, cb => \&proxy2client, wait_for => IN|EOF|SENT, Server => $io, }); weaken($io->{Client}->{Server}); weaken($io->{Client}); } if ($e & SENT) { shutdown $io->{fh}, 1; } if ($e & IN) { $io->{Client}->write($io->{in_buf}); $io->{in_buf} = q{}; } if ($e & EOF) { $io->close(); } } sub proxy2client { my ($io, $e, $err) = @_; die "proxy2client error: $err\n" if $err; checkpoint($e); if ($e & IN) { $io->{Server}->write($io->{in_buf}); $io->{in_buf} = q{}; } if ($e & EOF) { if (length($io->{Server}->{out_buf})) { $io->{Server}->{wait_for} = IN|SENT; } else { shutdown $io->{Server}->{fh}, 1; } } if ($e & SENT) { $io->close(); } } sub client { my ($io, $e, $err) = @_; die "client error: $err\n" if $err; checkpoint($e); checkpoint($io->{in_buf}); ok($io->{is_eof}, ' {is_eof} set'); $io->close(); new_client(sockport($prx_sock), \&client2); } sub client2 { my ($io, $e, $err) = @_; die "client2 error: $err\n" if $err; checkpoint($e); checkpoint($io->{in_buf}); ok($io->{is_eof}, ' {is_eof} set'); $io->close(); EV::unloop; } IO-Stream-v2.0.3/t/leak.t0000644000175000017500000000253013260723453015255 0ustar powermanpowerman# Resources (mem/fd) shouldn't leak. use warnings; use strict; use lib 't'; use share; if ($^O !~ /linux/i) { plan skip_all => 'require /proc'; } if ( not $ENV{TEST_AUTHOR} ) { my $msg = 'Author test. Set $ENV{TEST_AUTHOR} to a true value to run.'; plan( skip_all => $msg ); } if ($INC{'Devel/Cover.pm'}) { plan skip_all => 'unable to test under Devel::Cover'; } plan tests => 2; leaktest('create_stream'); sub create_stream { IO::Stream->new({ host => '127.0.0.1', port => 1234, cb => sub {}, wait_for => 0, })->close(); } sub leaktest { my $test = shift; my %arg = (init=>100, test=>1000, max_mem_diff=>100, diag=>0, @_); my $code = do { no strict 'refs'; \&$test }; $code->() for 1 .. $arg{init}; my $fd = FD_used(); my $mem = MEM_used(); $code->() for 1 .. $arg{test}; diag sprintf "---- MEM\nWAS: %d\nNOW: %d\n", $mem, MEM_used() if $arg{diag}; ok( abs(MEM_used() - $mem) < $arg{max_mem_diff}, "MEM: $test" ); is(FD_used(), $fd, " FD: $test" ); } sub MEM_used { open my $f, '<', '/proc/self/status'; my $status = join q{}, <$f>; return ($status =~ /VmRSS:\s*(\d*)/)[0]; }; sub FD_used { opendir my $fd, '/proc/self/fd' or croak "opendir: $!"; return @{[ readdir $fd ]} - 2; }; IO-Stream-v2.0.3/t/wait_for.t0000644000175000017500000000171413260723453016156 0ustar powermanpowerman# EREQINEOF and EREQINBUFLIMIT. use warnings; use strict; use lib 't'; use share; @CheckPoint = ( [ 'reader', 0, EREQINEOF ], 'reader: EREQINEOF', [ 'reader', 0, EREQINBUFLIMIT ], 'reader: EREQINBUFLIMIT', [ 'reader', IN, '123' ], 'reader: IN "123"', ); plan tests => @CheckPoint/2; socketpair my $server, my $client, AF_UNIX, SOCK_STREAM, PF_UNSPEC or die "socketpair: $!"; nonblocking($server); nonblocking($client); my $r = IO::Stream->new({ fh => $server, cb => \&reader, wait_for => 0, }); my $w = IO::Stream->new({ fh => $client, cb => \&writer, wait_for => 0, }); $w->write('1'); EV::loop; $r->{wait_for} = EOF; $w->write('2'); EV::loop; $r->{wait_for} = IN; $w->write('3'); EV::loop; sub reader { my ($io, $e, $err) = @_; checkpoint($e, $err || $io->{in_buf}); EV::unloop; } sub writer { my ($io, $e, $err) = @_; checkpoint($e, $err); } IO-Stream-v2.0.3/t/dns-error.t0000644000175000017500000000045613260723453016261 0ustar powermanpowerman# DNS error. use warnings; use strict; use lib 't'; use share; # cover code which process stale DNS replies on closed streams IO::Stream->new({ host => 'no.such.host.q1w2e3', port => 80, cb => \&client, wait_for => IN, })->close(); ok(1); done_testing(); IO-Stream-v2.0.3/t/fh-types-posix.t0000644000175000017500000000633513260723453017247 0ustar powermanpowerman# All possible one- and two-way fh types: # - pipe # - fifo # - socket pair # - tcp socket # - unix socket use warnings; use strict; use lib 't'; use share; if (WIN32) { plan skip_all => 'OS unsupported'; } @CheckPoint = ( [ 'writer', SENT ], 'writer: SENT', [ 'reader', EOF ], 'reader: EOF', [ 'reader', 'pipe' ], ' got "pipe"', [ 'writer', SENT ], 'writer: SENT', [ 'reader', IN ], 'reader: IN', [ 'reader', 'fifo' ], ' got "fifo"', [ 'client', SENT ], 'client: SENT', [ 'server', EOF ], 'server: EOF', [ 'server', 'unix' ], ' got "unix"', [ 'server', SENT ], 'server: SENT', [ 'client', EOF ], 'client: EOF', [ 'client', 'echo: unix' ], ' got "echo: unix"', ); plan tests => @CheckPoint/2; pipe my $rd_pipe, my $wr_pipe or die "pipe: $!"; nonblocking($rd_pipe); nonblocking($wr_pipe); stream1('pipe', $rd_pipe, $wr_pipe); my $fifo = "/tmp/fifo.$$"; END { unlink $fifo } system("mkfifo \Q$fifo\E") and die "system: $!"; open my $tmp_fifo, '+>', $fifo or die "open: $!"; open my $rd_fifo, '<', $fifo or die "open: $!"; open my $wr_fifo, '>', $fifo or die "open: $!"; close $tmp_fifo or die "close: $!"; nonblocking($rd_fifo); nonblocking($wr_fifo); stream1('fifo', $rd_fifo, $wr_fifo, 1); my $lst_unix = unix_server("/tmp/sock.$$"); my $cln_unix = unix_client("/tmp/sock.$$"); accept my $srv_unix, $lst_unix or die "accept: $!"; close $lst_unix or die "close: $!"; stream2('unix', $srv_unix, $cln_unix); sub stream1 { my ($name, $read_fh, $write_fh, $is_fifo) = @_; IO::Stream->new({ fh => $read_fh, cb => \&reader, wait_for => $is_fifo ? IN : EOF, in_buf_limit=> 1024, }); IO::Stream->new({ fh => $write_fh, cb => \&writer, wait_for => SENT, out_buf => $name, in_buf_limit=> 1024, }); EV::loop; } sub reader { my ($io, $e, $err) = @_; die $err if $err; checkpoint($e); checkpoint($io->{in_buf}); $io->close(); EV::unloop; } sub writer { my ($io, $e, $err) = @_; die $err if $err; checkpoint($e); $io->close(); } sub stream2 { my ($name, $srv_fh, $cln_fh) = @_; IO::Stream->new({ fh => $srv_fh, cb => \&server, wait_for => EOF, in_buf_limit=> 1024, }); IO::Stream->new({ fh => $cln_fh, cb => \&client, wait_for => SENT, out_buf => $name, in_buf_limit=> 1024, }); EV::loop; } sub server { my ($io, $e, $err) = @_; die $err if $err; checkpoint($e); if ($e & EOF) { checkpoint($io->{in_buf}); $io->{wait_for} = SENT; $io->write("echo: $io->{in_buf}"); } if ($e & SENT) { $io->close(); } } sub client { my ($io, $e, $err) = @_; die $err if $err; checkpoint($e); if ($e & SENT) { $io->{wait_for} = EOF; shutdown $io->{fh}, 1; } if ($e & EOF) { checkpoint($io->{in_buf}); $io->close(); EV::unloop; } } IO-Stream-v2.0.3/t/err-EAGAIN.t0000644000175000017500000000300113260723453016045 0ustar powermanpowerman# EAGAIN in sysread/syswrite use warnings; use strict; use lib 't'; use share; @CheckPoint = ( [ 'timeout_write' ], 'force EAGAIN in syswrite', { win32 => [ [ 'writer', 0 ], '', [ 'timeout_read' ], 'force EAGAIN in sysread', [ 'reader', 0 ], '', ], other => [ [ 'timeout_read' ], 'force EAGAIN in sysread', ], }, ); plan tests => WIN32 ? 4 : 2; socketpair my $server, my $client, AF_UNIX, SOCK_STREAM, PF_UNSPEC or die "socketpair: $!"; nonblocking($server); nonblocking($client); my $timeout = $INC{'Devel/Cover.pm'} ? 2 : 0.5; my ($r, $w, $t); $w = IO::Stream->new({ fh => $client, cb => \&writer, wait_for => OUT, }); $w->write('x' x 204800); EV::loop; sub writer { my ($io, $e, $err) = @_; if ($e == OUT) { $t = EV::timer($timeout, 0, \&timeout_write); } else { checkpoint($e); } } sub reader { my ($io, $e, $err) = @_; if ($e == IN) { $t = EV::timer($timeout, 0, \&timeout_read); } else { checkpoint($e); } } sub timeout_write { checkpoint(); EV::feed_fd_event(fileno($w->{fh}), EV::WRITE); # force EAGAIN in syswrite $r = IO::Stream->new({ fh => $server, cb => \&reader, wait_for => IN, }); } sub timeout_read { checkpoint(); EV::feed_fd_event(fileno($r->{fh}), EV::READ); # force EAGAIN in sysread $t = EV::timer($timeout, 0, sub { EV::unloop }); } IO-Stream-v2.0.3/t/extra_fields.t0000644000175000017500000000450313260723453017014 0ustar powermanpowerman# Client push a lot of data to server, server got several EINBUFLIMIT # errors, dynamically increase {in_buf_limit}, and finally receive all data. # - EINBUFLIMIT # - dynamic tuning of {in_buf_limit} # - custom fields /^[A-Z]/ # - class/method names instead of CODE ref in {cb} use warnings; use strict; use lib 't'; use share; my $SIZE = 204800; plan tests => 1 # accept client + 3*4 # server got EINBUFLIMIT + 5 # server got EOF ; my $srv_sock = tcp_server('127.0.0.1', 0); my $srv_w = EV::io($srv_sock, EV::READ, sub { if (my $paddr = accept my $sock, $srv_sock) { my ($port,$iaddr) = sockaddr_in($paddr); my $ip = inet_ntoa($iaddr); is($ip, '127.0.0.1', 'ip correct'); IO::Stream->new({ fh => $sock, cb => 'Server', wait_for => EOF, in_buf_limit=> 1024, Prev_bytes => 0, LimitErrs => 3, }); } elsif ($! != EAGAIN) { die "accept: $!\n"; } }); my $io = IO::Stream->new({ host => '127.0.0.1', port => sockport($srv_sock), cb => 'Client', method => 'IO_client', wait_for => SENT, out_buf => 'x' x $SIZE, out_pos => 0, }); EV::loop(); package Server; use Test::More; use IO::Stream; sub IO { my ($self, $io, $e, $err) = @_; if ($err) { if ($err == EINBUFLIMIT) { ok($io->{LimitErrs} > 0, 'got error'); $io->{LimitErrs}--; $io->{in_buf_limit} *= 10; } else { die $err; } } ok($io->{in_bytes} > $io->{Prev_bytes}, ' in_bytes incremented, good'); is(length($io->{in_buf}), $io->{in_bytes}, ' in_bytes correct'); $io->{Prev_bytes} = $io->{in_bytes}; if ($io->{in_bytes} < $SIZE) { ok(!$io->{is_eof}, 'no eof yet'); } else { ok($io->{LimitErrs} == 0, 'got ALL errors'); ok($io->{is_eof}, 'now got {is_eof}!!!'); is($io->{in_bytes}, $SIZE, 'All data received'); exit; } } package Client; use Test::More; use IO::Stream; sub IO_client { my ($self, $io, $e, $err) = @_; die $err if $err; shutdown $io->{fh}, 1; } IO-Stream-v2.0.3/t/01.export-all.t0000644000175000017500000000122113260723453016643 0ustar powermanpowermanuse warnings; use strict; use Test::More; use IO::Stream qw(:ALL); my @exports = qw( RESOLVED CONNECTED IN EOF OUT SENT EINBUFLIMIT ETORESOLVE ETOCONNECT ETOWRITE EDNS EDNSNXDOMAIN EDNSNODATA EREQINBUFLIMIT EREQINEOF ); my @not_exports = qw( BUFSIZE TOCONNECT TOWRITE ); plan +(@exports + @not_exports) ? ( tests => @exports + @not_exports ) : ( skip_all => q{This module doesn't export anything} ) ; for my $export (@exports) { can_ok( __PACKAGE__, $export ); } for my $not_export (@not_exports) { ok( ! __PACKAGE__->can($not_export) ); } IO-Stream-v2.0.3/t/release-distribution.t0000644000175000017500000000064613260723453020504 0ustar powermanpowerman BEGIN { unless ($ENV{RELEASE_TESTING}) { print qq{1..0 # SKIP these tests are for release candidate testing\n}; exit } } use Test::More; eval { require Test::Distribution }; plan( skip_all => 'Test::Distribution not installed' ) if $@; Test::Distribution->import( podcoveropts => { also_private => [ qr/^(?:[A-Z_]+)$/, ], pod_from => 'lib/IO/Stream.pm', } ); IO-Stream-v2.0.3/t/fh-types-all.t0000644000175000017500000000446613260723453016660 0ustar powermanpowerman# All possible one- and two-way fh types: # - pipe # - fifo # - socket pair # - tcp socket # - unix socket use warnings; use strict; use lib 't'; use share; @CheckPoint = ( [ 'client', SENT ], 'client: SENT', [ 'server', EOF ], 'server: EOF', [ 'server', 'sockpair' ], ' got "sockpair"', [ 'server', SENT ], 'server: SENT', [ 'client', EOF ], 'client: EOF', [ 'client', 'echo: sockpair'], ' got "echo: sockpair"', [ 'client', SENT ], 'client: SENT', [ 'server', EOF ], 'server: EOF', [ 'server', 'socket' ], ' got "socket"', [ 'server', SENT ], 'server: SENT', [ 'client', EOF ], 'client: EOF', [ 'client', 'echo: socket' ], ' got "echo: socket"', ); plan tests => @CheckPoint/2; socketpair my $server, my $client, AF_UNIX, SOCK_STREAM, PF_UNSPEC or die "socketpair: $!"; nonblocking($server); nonblocking($client); stream2('sockpair', $server, $client); my $lst_sock = tcp_server('127.0.0.1', 0); my $cln_sock = tcp_client('127.0.0.1', sockport($lst_sock)); my $srv_sock; use Errno qw( EBADF ); until (accept $srv_sock, $lst_sock) { $! == EAGAIN or (WIN32 && $! == EBADF) or die "accept: $!"; sleep 1; } close $lst_sock or die "close: $!"; stream2('socket', $srv_sock, $cln_sock); sub stream2 { my ($name, $srv_fh, $cln_fh) = @_; IO::Stream->new({ fh => $srv_fh, cb => \&server, wait_for => EOF, in_buf_limit=> 1024, }); IO::Stream->new({ fh => $cln_fh, cb => \&client, wait_for => SENT, out_buf => $name, in_buf_limit=> 1024, }); EV::loop; } sub server { my ($io, $e, $err) = @_; die $err if $err; checkpoint($e); if ($e & EOF) { checkpoint($io->{in_buf}); $io->{wait_for} = SENT; $io->write("echo: $io->{in_buf}"); } if ($e & SENT) { $io->close(); } } sub client { my ($io, $e, $err) = @_; die $err if $err; checkpoint($e); if ($e & SENT) { $io->{wait_for} = EOF; shutdown $io->{fh}, 1; } if ($e & EOF) { checkpoint($io->{in_buf}); $io->close(); EV::unloop; } } IO-Stream-v2.0.3/t/uc-echo.t0000644000175000017500000000410313260723453015662 0ustar powermanpowerman# Use case: echo client/server use warnings; use strict; use lib 't'; use share; my $banner = "Server ready"; my $msg = "Test message!\0\n"; use constant ACCEPTED => 123; @CheckPoint = ( [ '__ANON__', ACCEPTED ], 'accept incoming connection', [ 'client', IN ], 'client: got server banner', [ 'client', $banner ], 'client: banner is correct', [ 'client', SENT ], 'client: request sent', [ 'server', EOF ], 'server: got eof', [ 'server', $msg ], 'server: requst is correct', [ 'server', SENT ], 'server: reply sent', [ 'client', EOF ], 'client: got eof', [ 'client', "echo: $msg" ], 'client: reply is correct', ); plan tests => @CheckPoint/2; my $srv_sock = tcp_server('127.0.0.1', 0); my $srv_w = EV::io($srv_sock, EV::READ, sub { if (accept my $sock, $srv_sock) { checkpoint(ACCEPTED); IO::Stream->new({ fh => $sock, cb => \&server, wait_for => EOF, in_buf_limit=> 1024, out_buf => $banner, }); } elsif ($! != EAGAIN) { die "accept: $!\n"; } }); IO::Stream->new({ host => '127.0.0.1', port => sockport($srv_sock), cb => \&client, wait_for => IN, in_buf_limit=> 1024, }); EV::loop; sub server { my ($io, $e, $err) = @_; # &diag_event; checkpoint($e); if ($err) { die $err; } if ($e & EOF) { checkpoint($io->{in_buf}); $io->{wait_for} = EOF|SENT; $io->write("echo: $io->{in_buf}"); } if ($e & SENT) { shutdown $io->{fh}, 1; } } sub client { my ($io, $e, $err) = @_; # &diag_event; checkpoint($e); if ($e & IN) { checkpoint($io->{in_buf}); $io->{in_buf} = q{}; $io->{wait_for} = SENT|EOF; $io->write($msg); } if ($e & SENT) { shutdown $io->{fh}, 1; } if ($e & EOF) { checkpoint($io->{in_buf}); exit; } } IO-Stream-v2.0.3/t/plugin.t0000644000175000017500000000473013260723453015643 0ustar powermanpowerman# No-op plugins in action. use warnings; use strict; use lib 't'; use share; use IO::Stream::Noop; @CheckPoint = ( [ 'EVENT', RESOLVED, undef ], 'EventLog::EVENT(RESOLVED)', [ 'WRITE' ], 'EventLog::WRITE', [ 'EVENT', CONNECTED|OUT|SENT, undef], 'EventLog::EVENT(CONNECTED|OUT|SENT)', [ 'client', SENT ], 'client: SENT', [ 'server', EOF ], 'server: EOF', [ 'server', 'test' ], ' got "test"', [ 'server', SENT ], 'server: SENT', [ 'EVENT', IN, undef ], 'EventLog::EVENT(IN)', [ 'EVENT', EOF, undef ], 'EventLog::EVENT(EOF)', [ 'client', EOF ], 'client: EOF', [ 'client', 'echo: test' ], ' got "echo: test"', ); plan tests => 2 + @CheckPoint/2; my $srv_sock = tcp_server('127.0.0.1', 0); my $srv_w = EV::io($srv_sock, EV::READ, sub { if (accept my $sock, $srv_sock) { IO::Stream->new({ fh => $sock, cb => \&server, wait_for => EOF, in_buf_limit=> 1024, }); } elsif ($! != EAGAIN) { die "accept: $!\n"; } }); my $io = IO::Stream->new({ host => '127.0.0.1', port => sockport($srv_sock), cb => \&client, wait_for => SENT, in_buf_limit=> 1024, out_buf => 'test', plugin => [ noop => IO::Stream::Noop->new(), eventlog => IO::Stream::EventLog->new(), ], }); is(ref $io->{plugin}{noop}, 'IO::Stream::Noop', '{plugin}{noop} available'); is(ref $io->{plugin}{eventlog}, 'IO::Stream::EventLog', '{plugin}{eventlog} available'); EV::loop; sub server { my ($io, $e, $err) = @_; die $err if $err; checkpoint($e); if ($e & EOF) { checkpoint($io->{in_buf}); $io->{wait_for} = SENT; $io->write("echo: $io->{in_buf}"); } if ($e & SENT) { $io->close(); } } sub client { my ($io, $e, $err) = @_; die $err if $err; checkpoint($e); if ($e & SENT) { $io->{wait_for} = EOF; shutdown $io->{fh}, 1; } if ($e & EOF) { checkpoint($io->{in_buf}); $io->close(); EV::unloop(); } } package IO::Stream::EventLog; use base 'IO::Stream::Noop'; sub WRITE { main::checkpoint(); shift->SUPER::WRITE(@_); } sub EVENT { main::checkpoint($_[1], $_[2]); shift->SUPER::EVENT(@_); } IO-Stream-v2.0.3/t/01.export-none.t0000644000175000017500000000121313260723453017033 0ustar powermanpowermanuse warnings; use strict; use Test::More; use IO::Stream (); my @exports = qw( ); my @not_exports = qw( RESOLVED CONNECTED IN EOF OUT SENT EINBUFLIMIT ETORESOLVE ETOCONNECT ETOWRITE EDNS EDNSNXDOMAIN EDNSNODATA BUFSIZE TOCONNECT TOWRITE EREQINBUFLIMIT EREQINEOF ); plan +(@exports + @not_exports) ? ( tests => @exports + @not_exports ) : ( skip_all => q{This module doesn't export anything} ) ; for my $export (@exports) { can_ok( __PACKAGE__, $export ); } for my $not_export (@not_exports) { ok( ! __PACKAGE__->can($not_export) ); } IO-Stream-v2.0.3/t/err-rw.t0000644000175000017500000000277613260723453015573 0ustar powermanpowerman# errors in sysread/syswrite use warnings; use strict; use lib 't'; use share; use Config; plan skip_all => 'unstable on CPAN Testers (libev crashes)' if !$ENV{RELEASE_TESTING} && ($ENV{AUTOMATED_TESTING} || $ENV{PERL_CPAN_REPORTER_CONFIG}) && $Config{osname} eq 'MSWin32' && $Config{osvers} eq '6.3'; @CheckPoint = ( { win32 => [ [ 'reader', 0, EBADF ], 'reader: Bad file descriptor', { unknown => [ [ 'writer', 0, 'Unknown error' ], 'writer: Unknown error', ], aborted => [ [ 'writer', 0, ECONNABORTED ], 'writer: established connection was aborted', ], }, [ 'writer', 0, EBADF ], 'writer: Bad file descriptor', ], other => [ [ 'writer', 0, EPIPE ], 'writer: Broken pipe', [ 'writer', 0, EBADF ], 'writer: Bad file descriptor', [ 'reader', 0, EBADF ], 'reader: Bad file descriptor', ], }, ); plan tests => checkpoint_count(); socketpair my $server, my $client, AF_UNIX, SOCK_STREAM, PF_UNSPEC or die "socketpair: $!"; nonblocking($server); nonblocking($client); my $r = IO::Stream->new({ fh => $server, cb => \&reader, wait_for => 0, }); close $server; my $w = IO::Stream->new({ fh => $client, cb => \&writer, wait_for => 0, }); $w->write('x' x 204800); EV::loop; EV::loop; sub writer { my ($io, $e, $err) = @_; checkpoint($e, 0+$err); $io->close(); EV::unloop; } sub reader { my ($io, $e, $err) = @_; checkpoint($e, 0+$err); $io->close(); EV::unloop; } IO-Stream-v2.0.3/t/plugin-alias.t0000644000175000017500000000515313260723453016732 0ustar powermanpowerman# No-op plugins in action. use warnings; use strict; use lib 't'; use share; BEGIN { eval { require Data::Alias; Data::Alias->VERSION('0.08') } or plan skip_all => 'Data::Alias required'; } use IO::Stream::NoopAlias; @CheckPoint = ( [ 'EVENT', RESOLVED, undef ], 'EventLog::EVENT(RESOLVED)', [ 'WRITE' ], 'EventLog::WRITE', [ 'EVENT', CONNECTED|OUT|SENT, undef], 'EventLog::EVENT(CONNECTED|OUT|SENT)', [ 'client', SENT ], 'client: SENT', [ 'server', EOF ], 'server: EOF', [ 'server', 'test' ], ' got "test"', [ 'server', SENT ], 'server: SENT', [ 'EVENT', IN, undef ], 'EventLog::EVENT(IN)', [ 'EVENT', EOF, undef ], 'EventLog::EVENT(EOF)', [ 'client', EOF ], 'client: EOF', [ 'client', 'echo: test' ], ' got "echo: test"', ); plan tests => 2 + @CheckPoint/2; my $srv_sock = tcp_server('127.0.0.1', 0); my $srv_w = EV::io($srv_sock, EV::READ, sub { if (accept my $sock, $srv_sock) { IO::Stream->new({ fh => $sock, cb => \&server, wait_for => EOF, in_buf_limit=> 1024, }); } elsif ($! != EAGAIN) { die "accept: $!\n"; } }); my $io = IO::Stream->new({ host => '127.0.0.1', port => sockport($srv_sock), cb => \&client, wait_for => SENT, in_buf_limit=> 1024, out_buf => 'test', plugin => [ noopalias => IO::Stream::NoopAlias->new(), eventlog => IO::Stream::EventLog->new(), ], }); is(ref $io->{plugin}{noopalias}, 'IO::Stream::NoopAlias', '{plugin}{noopalias} available'); is(ref $io->{plugin}{eventlog}, 'IO::Stream::EventLog', '{plugin}{eventlog} available'); EV::loop; sub server { my ($io, $e, $err) = @_; die $err if $err; checkpoint($e); if ($e & EOF) { checkpoint($io->{in_buf}); $io->{wait_for} = SENT; $io->write("echo: $io->{in_buf}"); } if ($e & SENT) { $io->close(); } } sub client { my ($io, $e, $err) = @_; die $err if $err; checkpoint($e); if ($e & SENT) { $io->{wait_for} = EOF; shutdown $io->{fh}, 1; } if ($e & EOF) { checkpoint($io->{in_buf}); $io->close(); EV::unloop(); } } package IO::Stream::EventLog; use base 'IO::Stream::NoopAlias'; sub WRITE { main::checkpoint(); shift->SUPER::WRITE(@_); } sub EVENT { main::checkpoint($_[1], $_[2]); shift->SUPER::EVENT(@_); } IO-Stream-v2.0.3/t/bench/0000755000175000017500000000000013260723453015233 5ustar powermanpowermanIO-Stream-v2.0.3/t/bench/cs_longio0000755000175000017500000000463613260723453017146 0ustar powermanpowerman#!/usr/bin/perl # Test configuration: IP, 1/10/100 simultaneous connections # WHAT THREADS SPEED CPU: # IO::Stream 1 100.2 MB/sec 100% # IO::Stream 10 101.1 MB/sec # IO::Stream 100 79.3 MB/sec # POWER::Event::IO 1 33.8 MB/sec # POWER::Event::IO 10 42.7 MB/sec # POWER::Event::IO 100 38.6 MB/sec use warnings; use strict; use Carp; use Socket; use Fcntl; use Errno qw( EAGAIN ); use blib; use EV; use IO::Stream; use Carp::Heavy; $SIG{PIPE} = 'IGNORE'; $EV::DIED = sub { warn $@; exit 255 }; warn "Testing IO::Stream-$IO::Stream::VERSION\n"; sub tcp_server { my ($host, $port) = @_; socket my $sock, AF_INET, SOCK_STREAM, 0 or croak qq{socket: $!}; setsockopt $sock, SOL_SOCKET, SO_REUSEADDR, 1 or croak qq{setsockopt: $!}; bind $sock, sockaddr_in($port, inet_aton($host))or croak qq{bind: $!}; listen $sock, SOMAXCONN or croak qq{listen: $!}; fcntl $sock, F_SETFL, O_NONBLOCK or croak qq{fcntl: $!}; return $sock; } my $srv_sock = tcp_server('127.0.0.1', 1234); my $srv_w = EV::io($srv_sock, EV::READ, sub { if (accept my $sock, $srv_sock) { IO::Stream->new({ fh => $sock, cb => \&server, wait_for => IN, }); } elsif ($! != EAGAIN) { die "accept: $!\n"; } }); sub new_client { IO::Stream->new({ host => '127.0.0.1', port => 1234, cb => \&client, wait_for => IN, out_buf => 'Hello, World!' x 10240, }) }; new_client() for 1 .. 1; my $BYTES = 0; my $alarm = 15; my $t = EV::timer $alarm, 0, sub { warn sprintf "BYTES=%d (%.1f MB/sec)\n", $BYTES, $BYTES/1024/1024/$alarm; EV::unloop; }; EV::loop; sub server { my ($io, $e, $err) = @_; if ($err) { $io->close(); die "server: $err\n"; } if ($e == IN) { $io->write($io->{in_buf}); $io->{in_buf} = q{}; } } sub client { my ($io, $e, $err) = @_; if ($err) { $io->close(); die "server: $err\n"; } if ($e == IN) { $BYTES += $io->{in_bytes}; $io->write($io->{in_buf}); $io->{in_buf} = q{}; $io->{in_bytes} = 0; } } IO-Stream-v2.0.3/t/bench/http0000755000175000017500000000266113260723453016145 0ustar powermanpowerman#!/usr/bin/perl # Test configuration: IP, 1/100 simultaneous connections # WHAT THREADS SPEED CPU: # IO::Stream 1 2600/sec 60% # IO::Stream 100 3100/sec 72% # POWER::Event::IO 1 2300/sec 70% # POWER::Event::IO 100 2900/sec 75% use warnings; use strict; use Socket; use Data::Dumper; use blib; use EV; use IO::Stream; use Carp::Heavy; $SIG{PIPE} = 'IGNORE'; $EV::DIED = \&EV::unloop; warn "Testing IO::Stream-$IO::Stream::VERSION\n"; sub new_http { IO::Stream->new({ host => '127.0.0.1', # host => 'localhost', port => $ARGV[0] || 80, cb => \&http, wait_for => EOF, out_buf => "GET http://127.0.0.1/ HTTP/1.0\r\nHost: 127.0.0.1\r\n\r\n", in_buf_limit=> 1024000, }) }; new_http() for 1 .. 100; my $RUNS = 0; my $alarm = 15; my $t = EV::timer $alarm, 0, sub { warn sprintf "RUNS=%d (%d/sec)\n", $RUNS, $RUNS/$alarm; EV::unloop; }; EV::loop; die "out of loop(): $@\n"; sub http { my ($io, $e, $err) = @_; die "err=$err\n" if $e != EOF; # warn "length = ".length($io->{in_buf})." bytes = $io->{in_bytes}\n"; # warn $io->{in_buf}; exit; warn "bad length: $io->{in_bytes}\n" if $io->{in_bytes} != 314; $io->close(); new_http(); $RUNS++; } IO-Stream-v2.0.3/t/bench/cs_echo0000755000175000017500000000474713260723453016600 0ustar powermanpowerman#!/usr/bin/perl # Test configuration: IP, 1/100 simultaneous connections # WHAT THREADS SPEED CPU: # IO::Stream 1 2919/sec 100% # IO::Stream 100 2938/sec # POWER::Event::IO 1 1896/sec # POWER::Event::IO 100 2209/sec use warnings; use strict; use Carp; use Socket; use Fcntl; use Errno qw( EAGAIN ); use blib; use EV; use IO::Stream; use Carp::Heavy; $SIG{PIPE} = 'IGNORE'; $EV::DIED = sub { warn $@; exit 255 }; warn "Testing IO::Stream-$IO::Stream::VERSION\n"; sub tcp_server { my ($host, $port) = @_; socket my $sock, AF_INET, SOCK_STREAM, 0 or croak qq{socket: $!}; setsockopt $sock, SOL_SOCKET, SO_REUSEADDR, 1 or croak qq{setsockopt: $!}; bind $sock, sockaddr_in($port, inet_aton($host))or croak qq{bind: $!}; listen $sock, SOMAXCONN or croak qq{listen: $!}; fcntl $sock, F_SETFL, O_NONBLOCK or croak qq{fcntl: $!}; return $sock; } my $srv_sock = tcp_server('127.0.0.1', 1234); my $srv_w = EV::io($srv_sock, EV::READ, sub { if (accept my $sock, $srv_sock) { IO::Stream->new({ fh => $sock, cb => \&server, wait_for => EOF|SENT, in_buf_limit=> 1024000, }); } elsif ($! != EAGAIN) { die "accept: $!\n"; } }); sub new_client { IO::Stream->new({ host => '127.0.0.1', port => 1234, cb => \&client, wait_for => EOF|SENT, out_buf => 'Hello, World!', out_pos => 0, in_buf_limit=> 1024000, }); } new_client() for 1 .. 1; my $RUNS = 0; my $alarm = 5; my $t = EV::timer $alarm, 0, sub { warn sprintf "RUNS=%d (%d/sec)\n", $RUNS, $RUNS/$alarm; EV::unloop; }; EV::loop; sub server { my ($io, $e, $err) = @_; if ($err) { $io->close(); die "server: $err\n"; } if ($e == EOF) { $io->write("echo: $io->{in_buf}"); } if ($e == SENT) { $io->close(); } } sub client { my ($io, $e, $err) = @_; if ($err) { $io->close(); die "client: $err\n"; } if ($e == EOF) { die "client: bad answer=$io->{in_buf}\n" if $io->{in_buf} ne 'echo: '.$io->{out_buf}; $io->close(); new_client(); $RUNS++; } if ($e == SENT) { shutdown $io->{fh}, 1; } } IO-Stream-v2.0.3/t/diagnostics.t0000644000175000017500000000352213260723453016652 0ustar powermanpowermanuse warnings; use strict; use lib 't'; use share; plan tests => 19; throws_ok { IO::Stream->new() } qr/usage:/; throws_ok { IO::Stream->new(undef) } qr/usage:/; throws_ok { IO::Stream->new(1) } qr/usage:/; throws_ok { IO::Stream->new({}) } qr/usage:/; throws_ok { IO::Stream->new({'cb'=>undef,fh=>1}) } qr/usage:/; throws_ok { IO::Stream->new({'cb'=>sub{}}) } qr/usage:/; throws_ok { IO::Stream->new({'cb'=>sub{},fh=>undef}) } qr/usage:/; throws_ok { IO::Stream->new({'cb'=>sub{},host=>undef}) } qr/usage:/; throws_ok { IO::Stream->new({'cb'=>sub{},host=>1}) } qr/usage:/; throws_ok { IO::Stream->new({'cb'=>sub{},host=>1,port=>undef}) } qr/usage:/; throws_ok { IO::Stream->new({'cb'=>sub{},fh=>1,host=>1}) } qr/usage:/; my ($io, $fh, $tmp); socketpair $fh, $tmp, AF_UNIX, SOCK_STREAM, PF_UNSPEC or die "socketpair: $!"; lives_ok { $io=IO::Stream->new({cb=>sub{},fh=>$fh}) }; throws_ok { IO::Stream->new({cb=>sub{},fh=>$fh}) } qr/same fh/; throws_ok { IO::Stream->new({cb=>sub{},fh=>$fh}) } qr/same fh/; close $fh; throws_ok { IO::Stream->new({cb=>sub{},fh=>$fh}) } qr/descriptor/; socketpair $fh, $tmp, AF_UNIX, SOCK_STREAM, PF_UNSPEC or die "socketpair: $!"; throws_ok { IO::Stream->new({cb=>sub{},fh=>$fh}) } qr/same fh/; $io->close(); # will close current $fh because they've same fileno()! throws_ok { IO::Stream->new({cb=>sub{},fh=>$fh}) } qr/descriptor/; socketpair $fh, $tmp, AF_UNIX, SOCK_STREAM, PF_UNSPEC or die "socketpair: $!"; lives_ok { IO::Stream->new({'cb'=>sub{},fh=>$fh})->close() }; throws_ok { IO::Stream->new({'cb'=>sub{},fh=>$fh}) } qr/descriptor/; IO-Stream-v2.0.3/t/author-pod-syntax.t0000644000175000017500000000045413260723453017752 0ustar powermanpowerman#!perl BEGIN { unless ($ENV{AUTHOR_TESTING}) { print qq{1..0 # SKIP these tests are for testing by the author\n}; exit } } # This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. use strict; use warnings; use Test::More; use Test::Pod 1.41; all_pod_files_ok(); IO-Stream-v2.0.3/t/timeout-connect.t0000644000175000017500000000133213260723453017455 0ustar powermanpowerman# Connect timeout (Looks like Google DROP incoming packets on port 21.) use warnings; use strict; use lib 't'; use IO::Stream::const (); BEGIN { local $SIG{__WARN__} = sub {}; # no 'constant redefined' warning *IO::Stream::const::TOCONNECT = sub () { 0.1 }; } use share; @CheckPoint = ( [ 'client', RESOLVED, undef ], 'client: RESOLVED', [ 'client', 0, 'connect timeout' ], 'client: connect timeout', ); plan tests => @CheckPoint/2; IO::Stream->new({ host => 'google.com', port => 2121, cb => \&client, wait_for => RESOLVED|CONNECTED, }); EV::loop; sub client { my ($io, $e, $err) = @_; checkpoint($e, $err); EV::unloop if $err; } IO-Stream-v2.0.3/t/uc-proxy-big.t0000644000175000017500000001156513260723453016676 0ustar powermanpowerman# Use case: client connect to tr/x/y/ server and send/recv a lot of data. # Use case: client connect to tr/x/y/ server using tr/y/z/ proxy and # send/recv a lot of data. use warnings; use strict; use lib 't'; use share; my $SIZE = 204800; use constant ACCEPTED => 123; @CheckPoint = ( # first test: client connect to server without proxy ['listener_server', ACCEPTED ], 'server: new client', (( ['server', IN ], 'server: IN', ['server', ('x' x BUFSIZE) ], ' received "xxx..."', ) x ($SIZE/BUFSIZE)), ['server', SENT ], 'server: SENT', ['client', EOF ], 'client: EOF', ['client', ('y' x $SIZE) ], ' received "yyyyyyyyy..."', # second test: client connect to server using proxy ['listener_proxy', ACCEPTED ], 'proxy: new client', { win32_somefreebsd => [ ['listener_server', ACCEPTED ], 'server: new client', ['proxy2server', CONNECTED ], 'proxy2server: CONNECTED', ], other => [ ['proxy2server', CONNECTED ], 'proxy2server: CONNECTED', ['listener_server', ACCEPTED ], 'server: new client', ], }, (( ['server', IN ], 'server: IN', ['server', ('x' x BUFSIZE) ], ' received "xxx..."', ) x ($SIZE/BUFSIZE)), ['server', SENT ], 'server: SENT', ['proxy2server', EOF ], 'proxy2server: EOF', ['client2', EOF ], 'client2: EOF', ['client2', ('z' x $SIZE) ], ' received "zzzzzzzzz..."', ); plan tests => 2 # {is_eof} tests in client() and client2() + checkpoint_count(); my $srv_sock = tcp_server('127.0.0.1', 0); my $srv_w = EV::io($srv_sock, EV::READ, \&listener_server); my $prx_sock = tcp_server('127.0.0.1', 0); my $prx_w = EV::io($prx_sock, EV::READ, \&listener_proxy); sub new_client { my ($port, $cb) = @_; IO::Stream->new({ host => '127.0.0.1', port => $port, cb => $cb, wait_for => EOF, out_buf => ('x' x $SIZE), in_buf_limit=> 0, }); } new_client(sockport($srv_sock), \&client); EV::loop; sub listener_server { if (accept my $sock, $srv_sock) { checkpoint(ACCEPTED); IO::Stream->new({ fh => $sock, cb => \&server, wait_for => IN, }); } elsif ($! != EAGAIN) { die "accept: $!\n"; } } sub server { my ($io, $e, $err) = @_; die "server error: $err\n" if $err; checkpoint($e); if ($e & IN) { checkpoint($io->{in_buf}); if ($io->{in_bytes} == $SIZE) { $io->{wait_for} = SENT; } $io->write('y' x length $io->{in_buf}); $io->{in_buf} = q{}; } if ($e & SENT) { $io->close(); } } sub listener_proxy { if (accept my $sock, $prx_sock) { checkpoint(ACCEPTED); IO::Stream->new({ host => '127.0.0.1', port => sockport($srv_sock), cb => \&proxy2server, wait_for => CONNECTED|IN|EOF, Client => undef, ClientSock => $sock, }); } elsif ($! != EAGAIN) { die "accept: $!\n"; } } sub proxy2server { my ($io, $e, $err) = @_; die "proxy2server error: $err\n" if $err; checkpoint($e) if $e != IN && $e != SENT; if ($e & CONNECTED) { $io->{Client} = IO::Stream->new({ fh => $io->{ClientSock}, cb => \&proxy2client, wait_for => IN, Server => $io, }); weaken($io->{Client}->{Server}); weaken($io->{Client}); } if ($e & SENT) { shutdown $io->{fh}, 1; } if ($e & IN) { $io->{in_buf} =~ s/y/z/g; if ($io->{in_bytes} == $SIZE) { $io->{Client}->{wait_for} |= SENT; } $io->{Client}->write($io->{in_buf}); $io->{in_buf} = q{}; } if ($e & EOF) { $io->close(); } } sub proxy2client { my ($io, $e, $err) = @_; die "proxy2client error: $err\n" if $err; checkpoint($e) if $e != IN && $e != SENT; if ($e & IN) { if ($io->{in_bytes} == $SIZE) { $io->{Server}->{wait_for} |= SENT; } $io->{Server}->write($io->{in_buf}); $io->{in_buf} = q{}; } if ($e & SENT) { $io->close(); } } sub client { my ($io, $e, $err) = @_; die "client error: $err\n" if $err; checkpoint($e); checkpoint($io->{in_buf}); ok($io->{is_eof}, ' {is_eof} set'); $io->close(); new_client(sockport($prx_sock), \&client2); } sub client2 { my ($io, $e, $err) = @_; die "client2 error: $err\n" if $err; checkpoint($e); checkpoint($io->{in_buf}); ok($io->{is_eof}, ' {is_eof} set'); $io->close(); EV::unloop; } IO-Stream-v2.0.3/t/timeout-write.t0000644000175000017500000000151113260723453017155 0ustar powermanpowerman# Write timeout. use warnings; use strict; use lib 't'; use IO::Stream::const (); BEGIN { local $SIG{__WARN__} = sub {}; # no 'constant redefined' warning *IO::Stream::const::TOWRITE = sub () { 0.1 }; } use share; @CheckPoint = ( [ 'client', RESOLVED, undef ], 'client: RESOLVED', [ 'client', CONNECTED, undef ], 'client: CONNECTED', [ 'client', 0, 'write timeout' ], 'client: write timeout', ); plan tests => @CheckPoint/2; my $srv_sock = tcp_server('127.0.0.1', 0); IO::Stream->new({ host => '127.0.0.1', port => sockport($srv_sock), cb => \&client, wait_for => RESOLVED|CONNECTED|SENT, out_buf => ('x' x 10_000_000), }); EV::loop; sub client { my ($io, $e, $err) = @_; checkpoint($e, $err); EV::unloop if $err; } IO-Stream-v2.0.3/t/dns.t0000644000175000017500000000130313260723453015122 0ustar powermanpowerman# DNS error. use warnings; use strict; use lib 't'; use share; @CheckPoint = ( { normal => [ [ 'client', 0, IO::Stream::EDNS ], 'no such host', ], misconfigured => [ # some systems are configured to resolve anything, just deal with it! [ 'client', RESOLVED, undef ], 'resolve junk', ], }, ); plan tests => checkpoint_count(); IO::Stream->new({ host => 'no.such.host.q1w2e3', port => 80, cb => \&client, wait_for => IN|EOF|OUT|SENT|CONNECTED|RESOLVED, }); EV::loop; sub client { my ($io, $e, $err) = @_; # &diag_event; checkpoint($e, $err); EV::unloop; } IO-Stream-v2.0.3/t/share.pm0000644000175000017500000001012713260723453015615 0ustar powermanpowermanuse Test::More; use Test::Exception; use Test::Differences; use Carp; use Scalar::Util qw( weaken ); use File::Temp qw( tempfile ); use Errno qw( EAGAIN EBADF EPIPE ECONNABORTED ); use Socket; use Fcntl; use POSIX qw(locale_h); BEGIN { setlocale(LC_ALL,'en_US.UTF-8') } # avoid UTF-8 in $! use EV; use IO::Stream; use Carp::Heavy; $SIG{PIPE} = 'IGNORE'; $EV::DIED = sub { diag $@; EV::unloop }; use constant WIN32 => IO::Stream::WIN32; use constant BUFSIZE => IO::Stream::BUFSIZE; ### Usage example: #@CheckPoint = ( # [ 'listener', ACCEPTED ], 'accept incoming connection', # [ 'ssl_client', IN ], 'client: got server banner', # [ 'ssl_client', $banner ], 'client: banner is correct', # [ 'ssl_client', SENT ], 'client: request sent', # [ 'ssl_server', EOF ], 'server: got eof', # [ 'ssl_server', $msg ], 'server: requst is correct', # { # win32 => [ # [ 'ssl_client', EOF ], 'client: got eof', # [ 'ssl_server', SENT ], 'server: reply sent', # ], # other => [ # [ 'ssl_server', SENT ], 'server: reply sent', # [ 'ssl_client', EOF ], 'client: got eof', # ], # }, # [ 'ssl_client', "echo: $msg" ], 'client: reply is correct', #); #plan tests => checkpoint_count(); # # NOTE Alternatives in @CheckPoint must have same amount of tests! use vars qw( @CheckPoint ); sub _checkpoint_unwrap { return @_ if !grep {ref eq 'HASH'} @_; return _checkpoint_unwrap(map{ref eq 'HASH' ? @{(values %$_)[0]} : $_}@_); } sub checkpoint_count { return _checkpoint_unwrap(@CheckPoint)/2; } sub checkpoint { my ($func) = (caller(1))[3]=~/.*::(.*)/; if (ref $CheckPoint[0] eq 'HASH') { my %alt = %{ $CheckPoint[0] }; for my $key (keys %alt) { if (eq_array([$func, @_], $alt{$key}[0])) { diag "Alternative match: $key"; shift @CheckPoint; unshift @CheckPoint, @{ $alt{$key} }; last; } } } if (ref $CheckPoint[0] eq 'HASH') { croak("No alternative to match: $func @_"); } eq_or_diff([$func, @_], shift @CheckPoint, shift @CheckPoint); return; } ### Usage example: #sub client { # my ($io, $e, $err) = @_; # &diag_event; #} sub diag_event { my ($io, $e, $err) = @_; my ($func) = (caller(1))[3]=~/.*::(.*)/; diag "$func : ".events2str($e, $err); } sub events2str { my ($e, $err) = @_; my @e = ($e & RESOLVED, $e & CONNECTED, $e & IN, $e & OUT, $e & EOF, $e & SENT, $e & ~(RESOLVED|CONNECTED|IN|OUT|EOF|SENT)); my @n = qw(RESOLVED CONNECTED IN OUT EOF SENT unk); my $s = join q{|}, map {$e[$_] ? $n[$_] : ()} 0 .. $#e; return $err ? "$s err=$err" : $s; } sub nonblocking { my ($fh) = @_; if (WIN32) { my $nb=1; ioctl $fh, 0x8004667e, \$nb; # FIONBIO } else { fcntl $fh, F_SETFL, O_NONBLOCK or croak qq{fcntl: $!}; } return; } sub sockport { my ($sock) = @_; my ($port) = sockaddr_in(getsockname $sock); return $port; } sub tcp_server { my ($host, $port) = @_; socket my $sock, AF_INET, SOCK_STREAM, 0 or croak qq{socket: $!}; setsockopt $sock, SOL_SOCKET, SO_REUSEADDR, 1 or croak qq{setsockopt: $!}; bind $sock, sockaddr_in($port, inet_aton($host))or croak qq{bind: $!}; listen $sock, SOMAXCONN or croak qq{listen: $!}; nonblocking($sock); return $sock; } sub tcp_client { my ($host, $port) = @_; socket my $sock, AF_INET, SOCK_STREAM, 0 or croak qq{socket: $!}; nonblocking($sock); connect $sock, sockaddr_in($port, inet_aton($host)); return $sock; } sub unix_server { my ($path) = @_; socket my $sock, AF_UNIX, SOCK_STREAM, 0 or croak qq{socket: $!}; unlink $path; bind $sock, sockaddr_un($path) or croak qq{bind: $!}; listen $sock, SOMAXCONN or croak qq{listen: $!}; nonblocking($sock); return $sock; } sub unix_client { my ($path) = @_; socket my $sock, AF_UNIX, SOCK_STREAM, 0 or croak qq{socket: $!}; nonblocking($sock); connect $sock, sockaddr_un($path); return $sock; } 1; IO-Stream-v2.0.3/README0000644000175000017500000004253313260723453014600 0ustar powermanpowermanNAME IO::Stream - ease non-blocking I/O streams based on EV VERSION This document describes IO::Stream version v2.0.3 SYNOPSIS use EV; use IO::Stream; IO::Stream->new({ host => 'google.com', port => 80, cb => \&client, wait_for => SENT|EOF, in_buf_limit=> 102400, out_buf => "GET / HTTP/1.0\nHost: google.com\n\n", }); $EV::DIED = sub { warn $@; EV::unloop }; EV::loop; sub client { my ($io, $e, $err) = @_; if ($err) { $io->close(); die $err; } if ($e & SENT) { print "request sent, waiting for reply...\n"; } if ($e & EOF) { print "server reply:\n", $io->{in_buf}; $io->close(); EV::unloop; # ALL DONE } } DESCRIPTION Non-blocking event-based low-level I/O is hard to get right. Code usually error-prone and complex... and it very similar in all applications. Things become much worse when you need to alter I/O stream in some way - use proxies, encryption, SSL, etc. This module designed to give user ability to work with I/O streams on higher level, using input/output buffers (just scalars) and high-level events like CONNECTED, SENT or EOF. As same time it doesn't hide low-level things, and user still able to work on low-level without any limitations. PLUGINS Architecture of this module make it ease to write plugins, which will alter I/O stream in any way - route it through proxies, encrypt, log, etc. Here are few available plugins, you may find more on CPAN: IO::Stream::Crypt::RC4, IO::Stream::Proxy::HTTPS, IO::Stream::MatrixSSL::Client, IO::Stream::MatrixSSL::Server. If you interested in writing own plugin, check source for "skeleton" plugins: IO::Stream::Noop and IO::Stream::NoopAlias. EXPORTS This modules doesn't export any functions/methods/variables, but it exports a lot of constants. There two groups of constants: events and errors (which can be imported using tags ':Event' and ':Error'). By default all constants are exported. Events: RESOLVED CONNECTED IN OUT EOF SENT Errors: EINBUFLIMIT ETORESOLVE ETOCONNECT ETOWRITE EDNS EDNSNXDOMAIN EDNSNODATA EREQINBUFLIMIT EREQINEOF Errors are similar to $! - they're dualvars, having both textual and numeric values. NOTE: Since v2.0.0 ETORESOLVE, EDNSNXDOMAIN and EDNSNODATA are not used anymore (EDNS is used instead), but they're still exported for compatibility. OVERVIEW You can create IO::Stream object using any "stream" fh (file, TTY, UNIX socket, TCP socket, pipe, FIFO). Or, if you need TCP socket, you can create IO::Stream object using host+port instead of fh (in this case IO::Stream will do non-blocking host resolving, create TCP socket and do non-blocking connect). After you created IO::Stream object, it will handle read/write on this fh, and deliver only high-level events you asked for into your callback, where you will be able to operate with in/out buffers instead of doing sysread()/syswrite() manually. There no limitations on what you can do with fh after you've created IO::Stream object - you can even do sysread()/syswrite() (but there no reasons for you to do this anymore). IMPORTANT! When you want to close this fh, you MUST use $io->close() method for closing fh instead of doing close($fh). This is because IO::Stream doesn't require from you to keep object returned by new(), and without call to $io->close() IO::Stream object will continue to exists and may receive/generate some events, which is not what you expect after closing fh. Also, if you keep object returned by IO::Stream->new() somewhere in your variables, you should either undef all such variables after you called $io->close(), or you should use Scalar::Util::weaken() on these variables after storing IO::Stream object. (The same is applicable for all plugin objects too.) EVENTS RESOLVED If you created IO::Stream object using {host}+{port} instead of {fh}, this event will be generated after resolving {host}. Resolved IP address will be stored in {ip}. CONNECTED If you created IO::Stream object using {host}+{port} instead of {fh}, this event will be generated after connecting socket to {ip}:{port}. IN Generated after each successful read. IO::Stream may execute several sysread() at once before generating IN event for optimization. Read data will be stored in {in_buf}, and {in_bytes} counter will be incremented by amount of bytes read. EOF Generated only ONCE when EOF reached (sysread() return 0). Also will set {is_eof} to true. OUT Generated when some data from {out_buf} was written. Written bytes either removed from {out_buf} or just increment {out_pos} by amount of bytes written (see documentation about these fields below for more details). Also increment {out_bytes} counter by amount of bytes written. Here 'written' may be somewhat virtual, while {out_buf}/{out_pos} changes, the real data still can be in plugin buffers (if you use plugins) and real syswrite() may not be called yet. To detect when all data is really written you should use SENT event, not OUT. SENT Generated when all data from {out_buf} was written. It's usual and safe to call $io->close() on SENT event. TIMEOUTS IO::Stream has 30-second timeouts for connect and write, to timeout DNS resolve it use default AnyEvent::DNS timeout. If you need to timeout other operations, you have to create own timers using EV::timer(). Current version doesn't allow you to change these timeouts. SERVER If you need to run TCP/UNIX-server socket, then you should handle that socket manually. But you can create IO::Stream object for accept()'ed socket: my ($host, $port) = ('0.0.0.0', 1234); socket my $srv_sock, AF_INET, SOCK_STREAM, 0; setsockopt $srv_sock, SOL_SOCKET, SO_REUSEADDR, 1; bind $srv_sock, sockaddr_in($port, inet_aton($host)); listen $srv_sock, SOMAXCONN; fcntl $srv_sock, F_SETFL, O_NONBLOCK; $srv_w = EV::io($srv_sock, EV::READ, sub { if (accept my $sock, $srv_sock) { IO::Stream->new({ fh => $sock, cb => \&server, wait_for => IN, }); } elsif ($! != EAGAIN) { die "accept: $!"; } }); INTERFACE IO::Stream provide only three public methods: new(), write() and close(). new() will create new object, close() will destroy it and write() must be called when you want to modify (or just modified) output buffer. All other operations are done using IO::Stream object fields - for simplicity and performance reasons. Moreover, you can keep your own data in it. There convention on field names, to avoid conflicts: /^_/ Fields with names started with underscore are for internal use by IO::Stream, you shouldn't touch them or create your own field with such names. /^[a-z]/ Fields with names started with lower-case letter are part of IO::Stream public interface - you allowed to read/write these fields, but you should not store incorrect values in these fields. Check "PUBLIC FIELDS" below for description of available fields and their format. /^[A-Z]/ You can store your own data in IO::Stream object using field names started with upper-case letter. IO::Stream will not touch these fields. When some event arise which you're waited for, your callback will be called with 3 parameters: IO::Stream object, event mask, and error (if any): sub callback { my ($io, $e, $err) = @_; } METHODS new IO::Stream->new( \%opt ); Create and return IO::Stream object. You may not keep returned object - you will get it in your callback (in first parameter) when some interesting for your event happens, and will exists until to call method close(). See OVERVIEW for more details. Fields of %opt become fields of created IO::Stream object. There only few fields required, but you can set any other fields too, and can also set your custom fields (with names starting from upper-case letter). Only required fields in %opt are {cb} and either {fh} or {host}+{port}. The {wait_for} field also highly recommended to set when creating object. If {out_buf} will be set, then new() will automatically call write() after creating object. IO::Stream->new({ fh => \*STDIN, cb => \&console, wait_for => IN, }); write $io->write(); $io->write($data); Method write() MUST be called after any modifications of {out_buf} field, to ensure data in {out_buf} will be written to {fh} as soon as it will be possible. If {fh} available for writing when calling write(), then it will write (may be partially) {out_buf} and may immediately call your callback function delivering OUT|SENT events there. So, if you call write() from that callback (as it usually happens), keep in mind it may be called again while executing write(), and object state may significantly change (it even may be close()'d) after it return from write() into your callback. The write($data) is just a shortcut for: $io->{out_buf} .= $data; $io->write(); close $io->close() Method close() will close {fh} and destroy IO::Stream object. See OVERVIEW for more details. PUBLIC FIELDS If field marked *RO* that mean field is read-only and shouldn't be changed. Some field have default values (shown after equal sign). Some field modified on events. cb method ='IO' User callback which will be called when some listed in {wait_for} events arise or error happens. Field {cb} should be either CODE ref or object or class name. In last two cases method named {method} will be called. Field {method} should be string. wait_for Bitmask of events interesting for user. Can be changed at any time. For example: $io->{wait_for} = RESOLVED|CONNECTED|IN|EOF|OUT|SENT; When some data will be read from {fh}, {wait_for} must contain IN and/or EOF, or error EREQINEOF will be generated. So, it's better to always have IN and/or EOF in {wait_for}. If {wait_for} contain EOF and doesn't contain IN then {in_buf_limit} must be defined or error EREQINBUFLIMIT will be generated. fh *RO* File handle for doing I/O. It's either provided by user to new(), or created by new() (when user provided {host}+{port} instead). host *RO* port *RO* If user doesn't provide {fh} to new(), he should provide {host} and {port} instead. This way new() will create new TCP socket in {fh} and resolve {host} and connect this {fh} to resolved {ip} and {port}. Both resolving and connecting happens in non-blocking way, and will result in delivering RESOLVED and CONNECTED events into user callback (if user {wait_for} these events). in_buf_limit =undef Used to avoid DoS attach when user doesn't handle IN events and want his callback called only on EOF event. Must be defined if user have EOF without IN in {wait_for}. Any value >0 will defined amount of bytes which can be read into {in_buf} before EOF happens. When size of {in_buf} become larger than {in_buf_limit}, error EINBUFLIMIT will be delivered to user callback. In this case user can either remove some data from {in_buf} to make it smaller than {in_buf_limit} or increase {in_buf_limit}, and continue reading data. NOT RECOMMENDED! Value 0 will switch off DoS protection, so there will be no limit on amount of data to read into {in_buf} until EOF happens. out_buf =q{} # modified on: OUT out_pos =undef # modified on: OUT Data from {out_buf} will be written to {fh}. If {out_pos} not defined, then data will be written from beginning of {out_buf}, and after successful write written bytes will be removed from beginning of {out_buf}. If {out_pos} defined, it should be >= 0. In this case data will be written from {out_pos} position in {out_buf}, and after successful write {out_pos} will be incremented by amount of bytes written. {out_buf} will not be changed! out_bytes =0 # modified on: OUT Each successful write will increment {out_bytes} by amount of written bytes. You can change {out_bytes} in any way, but it should always be a number. in_buf =q{} # modified on: IN Each successful read will concatenate read bytes to {in_buf}. You can change {in_buf} in any way, but it should always be a string. in_bytes =0 # modified on: IN Each successful read will increment {in_bytes} by amount of read bytes. You can change {in_bytes} in any way, but it should always be a number. ip *RO* =undef # modified on: RESOLVED When you call new() with {host}+{port} instead of {fh} then IP address resolved from {host} will be stored in {ip}, and event RESOLVED will be generated. is_eof *RO* =undef # modified on: EOF When EOF event happens {is_eof} will be set to true value. This allow you to detect is EOF already happens at any time, even if you doesn't have EOF in {wait_for}. plugin *RO* ={} Allow you to set list of plugins when creating object with new(), and later access these plugins. This field is somewhat special, because when you call new() you should set plugin to ARRAY ref, but in IO::Stream object {plugin} is HASH ref: my $io = IO::Stream->new({ host => 'www.google.com', port => 443, cb => \&google, wait_for => EOF, in_buf_limit=> 102400, out_buf => "GET / HTTP/1.0\nHost: www.google.com\n\n", plugin => [ # <------ it's ARRAY, but looks like HASH ssl => IO::Stream::MatrixSSL::Client->new(), proxy => IO::Stream::Proxy::HTTPS->new({ host => 'my.proxy.com', port => 3218, user => 'me', pass => 'my pass', }), ], MyField1 => 'my data1', MyField2 => \%mydata2, }); # access the "proxy" plugin: $io->{plugin}{proxy}; This is because when calling new() it's important to keep plugins in order, but later it's easier to access them using names. DIAGNOSTICS Exceptions may be thrown only in new(). All other errors will be delivered to user's callback in last parameter. usage: IO::Stream->new({ cb=>, wait_for=>, [fh=>, | host=>, port=>,] ... }) You called new() with wrong parameters. socket: %s fcntl: %s Error happens while creating new socket. Usually this happens because you run out of file descriptors. can't get file descriptor Failed to get fileno() for your fh. Either fh doesn't open, or this fh type is not supported (directory handle), or fh is not file handle at all. can't create second object for same fh You can't have more than one IO::Stream object for same fh. IO::Stream keep all objects created by new() until $io->close() will be called. Probably you've closed fh in some way without calling $io->close(), then new fh was created with same file descriptor number, and you've tried to create IO::Stream object using new fh. SEE ALSO AnyEvent::Handle SUPPORT Bugs / Feature Requests Please report any bugs or feature requests through the issue tracker at https://github.com/powerman/perl-IO-Stream/issues. You will be notified automatically of any progress on your issue. Source Code This is open source software. The code repository is available for public review and contribution under the terms of the license. Feel free to fork the repository and submit pull requests. https://github.com/powerman/perl-IO-Stream git clone https://github.com/powerman/perl-IO-Stream.git Resources * MetaCPAN Search https://metacpan.org/search?q=IO-Stream * CPAN Ratings http://cpanratings.perl.org/dist/IO-Stream * AnnoCPAN: Annotated CPAN documentation http://annocpan.org/dist/IO-Stream * CPAN Testers Matrix http://matrix.cpantesters.org/?dist=IO-Stream * CPANTS: A CPAN Testing Service (Kwalitee) http://cpants.cpanauthors.org/dist/IO-Stream AUTHOR Alex Efros COPYRIGHT AND LICENSE This software is Copyright (c) 2008- by Alex Efros . This is free software, licensed under: The MIT (X11) License IO-Stream-v2.0.3/cpanfile0000644000175000017500000000070713260723453015421 0ustar powermanpowermanrequires 'perl', '5.010001'; requires 'AnyEvent::DNS'; requires 'EV'; requires 'Scalar::Util'; requires 'Socket'; recommends 'Data::Alias', '0.08'; on configure => sub { requires 'Module::Build::Tiny', '0.034'; }; on test => sub { requires 'File::Temp'; requires 'Test::Differences'; requires 'Test::Exception'; requires 'Test::More'; }; on develop => sub { requires 'Test::Distribution'; requires 'Test::Perl::Critic'; }; IO-Stream-v2.0.3/LICENSE0000644000175000017500000000223213260723453014715 0ustar powermanpowermanThis software is Copyright (c) 2008- by Alex Efros . This is free software, licensed under: The MIT (X11) License The MIT License Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. IO-Stream-v2.0.3/dist.ini0000644000175000017500000000045513260723453015361 0ustar powermanpowerman[@Milla] [MetaProvides::Package] [Substitute] code = s/^(This document describes \S+ version |VERSION=['"])([^'"\r\n]*)/my($s,$v)=($1,$2);my%h=%Term::ReadLine::Gnu::Attribs;$s.($h{prompt}?($h{line_buffer}||$h{prompt}=~m{ \[(.*)\]})[0]:$v)/e [GitHubREADME::Badge] badges = travis badges = coveralls IO-Stream-v2.0.3/META.json0000644000175000017500000000467713260723453015350 0ustar powermanpowerman{ "abstract" : "ease non-blocking I/O streams based on EV", "author" : [ "Alex Efros " ], "dynamic_config" : 0, "generated_by" : "Dist::Milla version v1.0.18, Dist::Zilla version 6.011, CPAN::Meta::Converter version 2.150010", "license" : [ "mit" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "IO-Stream", "no_index" : { "directory" : [ "eg", "examples", "inc", "share", "t", "xt" ] }, "prereqs" : { "configure" : { "requires" : { "Module::Build::Tiny" : "0.034" } }, "develop" : { "requires" : { "Dist::Milla" : "v1.0.18", "Test::Distribution" : "0", "Test::Perl::Critic" : "0", "Test::Pod" : "1.41" } }, "runtime" : { "recommends" : { "Data::Alias" : "0.08" }, "requires" : { "AnyEvent::DNS" : "0", "EV" : "0", "Scalar::Util" : "0", "Socket" : "0", "perl" : "5.010001" } }, "test" : { "requires" : { "File::Temp" : "0", "Test::Differences" : "0", "Test::Exception" : "0", "Test::More" : "0" } } }, "provides" : { "IO::Stream" : { "file" : "lib/IO/Stream.pm", "version" : "v2.0.3" }, "IO::Stream::EV" : { "file" : "lib/IO/Stream/EV.pm", "version" : "v2.0.3" }, "IO::Stream::Noop" : { "file" : "lib/IO/Stream/Noop.pm", "version" : "v2.0.3" }, "IO::Stream::NoopAlias" : { "file" : "lib/IO/Stream/NoopAlias.pm", "version" : "v2.0.3" }, "IO::Stream::const" : { "file" : "lib/IO/Stream/const.pm", "version" : "v2.0.3" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/powerman/perl-IO-Stream/issues" }, "homepage" : "https://github.com/powerman/perl-IO-Stream", "repository" : { "type" : "git", "url" : "https://github.com/powerman/perl-IO-Stream.git", "web" : "https://github.com/powerman/perl-IO-Stream" } }, "version" : "v2.0.3", "x_serialization_backend" : "JSON::XS version 3.04" } IO-Stream-v2.0.3/MANIFEST0000644000175000017500000000150013260723453015036 0ustar powermanpowerman# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.011. Build.PL Changes LICENSE MANIFEST META.json META.yml README cpanfile dist.ini lib/IO/Stream.pm lib/IO/Stream/EV.pm lib/IO/Stream/Noop.pm lib/IO/Stream/NoopAlias.pm lib/IO/Stream/const.pm t/00.load.t t/01.export-all.t t/01.export-custom.t t/01.export-error.t t/01.export-event.t t/01.export-none.t t/01.export.t t/author-perlcritic.t t/author-pod-syntax.t t/bench/cs_echo t/bench/cs_longio t/bench/http t/diagnostics.t t/dns-error.t t/dns.t t/err-EAGAIN.t t/err-rw.t t/extra_fields.t t/fh-types-all.t t/fh-types-posix.t t/leak.t t/plugin-alias.t t/plugin.t t/release-distribution.t t/share.pm t/timeout-connect.t t/timeout-write-slowclient.t t/timeout-write.t t/uc-echo.t t/uc-google.t t/uc-proxy-big-alias.t t/uc-proxy-big.t t/uc-proxy.t t/wait_for.t IO-Stream-v2.0.3/META.yml0000644000175000017500000000247613260723453015173 0ustar powermanpowerman--- abstract: 'ease non-blocking I/O streams based on EV' author: - 'Alex Efros ' build_requires: File::Temp: '0' Test::Differences: '0' Test::Exception: '0' Test::More: '0' configure_requires: Module::Build::Tiny: '0.034' dynamic_config: 0 generated_by: 'Dist::Milla version v1.0.18, Dist::Zilla version 6.011, CPAN::Meta::Converter version 2.150010' license: mit meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: IO-Stream no_index: directory: - eg - examples - inc - share - t - xt provides: IO::Stream: file: lib/IO/Stream.pm version: v2.0.3 IO::Stream::EV: file: lib/IO/Stream/EV.pm version: v2.0.3 IO::Stream::Noop: file: lib/IO/Stream/Noop.pm version: v2.0.3 IO::Stream::NoopAlias: file: lib/IO/Stream/NoopAlias.pm version: v2.0.3 IO::Stream::const: file: lib/IO/Stream/const.pm version: v2.0.3 recommends: Data::Alias: '0.08' requires: AnyEvent::DNS: '0' EV: '0' Scalar::Util: '0' Socket: '0' perl: '5.010001' resources: bugtracker: https://github.com/powerman/perl-IO-Stream/issues homepage: https://github.com/powerman/perl-IO-Stream repository: https://github.com/powerman/perl-IO-Stream.git version: v2.0.3 x_serialization_backend: 'YAML::Tiny version 1.73'