#!/usr/bin/perl -w use strict; use IO::Async::Test; use Test::More tests => 15; use Test::Refcount; use IO::Async::Loop; use IO::Async::OS; use IO::Async::Protocol::LineStream; my $loop = IO::Async::Loop->new; testing_loop( $loop ); my ( $S1, $S2 ) = IO::Async::OS->socketpair or die "Cannot create socket pair - $!"; # Need sockets in nonblocking mode $S1->blocking( 0 ); $S2->blocking( 0 ); my @lines; my $linestreamproto = IO::Async::Protocol::LineStream->new( handle => $S1, on_read_line => sub { my $self = shift; push @lines, $_[0]; }, ); ok( defined $linestreamproto, '$linestreamproto defined' ); isa_ok( $linestreamproto, "IO::Async::Protocol::LineStream", '$linestreamproto isa IO::Async::Protocol::LineStream' ); is_oneref( $linestreamproto, '$linestreamproto has refcount 1 initially' ); $loop->add( $linestreamproto ); is_refcount( $linestreamproto, 2, '$linestreamproto has refcount 2 after adding to Loop' ); $S2->syswrite( "message\r\n" ); is_deeply( \@lines, [], '@lines before wait' ); wait_for { scalar @lines }; is_deeply( \@lines, [ "message" ], '@lines after wait' ); undef @lines; my @new_lines; $linestreamproto->configure( on_read_line => sub { my $self = shift; push @new_lines, $_[0]; }, ); $S2->syswrite( "new\r\nlines\r\n" ); wait_for { scalar @new_lines }; is( scalar @lines, 0, '@lines still empty after on_read replace' ); is_deeply( \@new_lines, [ "new", "lines" ], '@new_lines after on_read replace' ); $linestreamproto->write_line( "response" ); my $response = ""; wait_for_stream { $response =~ m/\r\n/ } $S2 => $response; is( $response, "response\r\n", 'response written by protocol' ); my @sub_lines; $linestreamproto = TestProtocol::Stream->new( handle => $S1, ); ok( defined $linestreamproto, 'subclass $linestreamproto defined' ); isa_ok( $linestreamproto, "IO::Async::Protocol::LineStream", '$linestreamproto isa IO::Async::Protocol::LineStream' ); is_oneref( $linestreamproto, 'subclass $linestreamproto has refcount 1 initially' ); $loop->add( $linestreamproto ); is_refcount( $linestreamproto, 2, 'subclass $linestreamproto has refcount 2 after adding to Loop' ); $S2->syswrite( "message\r\n" ); is_deeply( \@sub_lines, [], '@sub_lines before wait' ); wait_for { scalar @sub_lines }; is_deeply( \@sub_lines, [ "message" ], '@sub_lines after wait' ); undef @lines; $loop->remove( $linestreamproto ); undef $linestreamproto; package TestProtocol::Stream; use base qw( IO::Async::Protocol::LineStream ); sub on_read_line { my $self = shift; push @sub_lines, $_[0]; }