IO-Async-0.67HEADIO-Async-0.67master

7 files changed, 396 insertions, 0 deletions

diff --git a/examples/chat-server.pl b/examples/chat-server.pl
new file mode 100644
index 0000000..00522e1
--- /dev/null
+++ b/examples/chat-server.pl
@@ -0,0 +1,71 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use IO::Async::Loop;
+use IO::Async::Stream;
+
+my $PORT = 12345;
+
+my $loop = IO::Async::Loop->new;
+
+my $listener = ChatListener->new;
+
+$loop->add( $listener );
+
+$listener->listen(
+   service  => $PORT,
+   socktype => 'stream',
+)->on_done( sub {
+   my ( $listener ) = @_;
+   my $socket = $listener->read_handle;
+
+   printf STDERR "Listening on %s:%d\n", $socket->sockhost, $socket->sockport;
+})->get;
+
+$loop->run;
+
+package ChatListener;
+use base qw( IO::Async::Listener );
+
+my @clients;
+
+sub on_stream
+{
+   my $self = shift;
+   my ( $stream ) = @_;
+
+   # $socket is just an IO::Socket reference
+   my $socket = $stream->read_handle;
+   my $peeraddr = $socket->peerhost . ":" . $socket->peerport;
+
+   # Inform the others
+   $_->write( "$peeraddr joins\n" ) for @clients;
+
+   $stream->configure(
+      on_read => sub {
+         my ( $self, $buffref, $eof ) = @_;
+
+         while( $$buffref =~ s/^(.*\n)// ) {
+            # eat a line from the stream input
+
+            # Reflect it to all but the stream who wrote it
+            $_ == $self or $_->write( "$peeraddr: $1" ) for @clients;
+         }
+
+         return 0;
+      },
+
+      on_closed => sub {
+         my ( $self ) = @_;
+         @clients = grep { $_ != $self } @clients;
+
+         # Inform the others
+         $_->write( "$peeraddr leaves\n" ) for @clients;
+      },
+   );
+
+   $loop->add( $stream );
+   push @clients, $stream;
+}
diff --git a/examples/echo-server.pl b/examples/echo-server.pl
new file mode 100644
index 0000000..a63f516
--- /dev/null
+++ b/examples/echo-server.pl
@@ -0,0 +1,69 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Getopt::Long;
+
+use IO::Async::Loop;
+use IO::Async::Listener;
+
+my $PORT = 12345;
+my $FAMILY;
+my $V6ONLY;
+
+GetOptions(
+   'port|p=i' => \$PORT,
+   '4'        => sub { $FAMILY = "inet" },
+   '6'        => sub { $FAMILY = "inet6" },
+   'v6only=i' => \$V6ONLY,
+) or exit 1;
+
+my $loop = IO::Async::Loop->new;
+
+my $listener = IO::Async::Listener->new(
+   on_stream => sub {
+      my $self = shift;
+      my ( $stream ) = @_;
+
+      my $socket = $stream->read_handle;
+      my $peeraddr = $socket->peerhost . ":" . $socket->peerport;
+
+      print STDERR "Accepted new connection from $peeraddr\n";
+
+      $stream->configure(
+         on_read => sub {
+            my ( $self, $buffref, $eof ) = @_;
+
+            while( $$buffref =~ s/^(.*\n)// ) {
+               # eat a line from the stream input
+               $self->write( $1 );
+            }
+
+            return 0;
+         },
+
+         on_closed => sub {
+            print STDERR "Connection from $peeraddr closed\n";
+         },
+      );
+
+      $loop->add( $stream );
+   },
+);
+
+$loop->add( $listener );
+
+$listener->listen(
+   service  => $PORT,
+   socktype => 'stream',
+   family   => $FAMILY,
+   v6only   => $V6ONLY,
+)->on_done( sub {
+   my ( $listener ) = @_;
+   my $socket = $listener->read_handle;
+
+   printf STDERR "Listening on %s:%d\n", $socket->sockhost, $socket->sockport;
+})->get;
+
+$loop->run;
diff --git a/examples/netcat-client.pl b/examples/netcat-client.pl
new file mode 100644
index 0000000..8926131
--- /dev/null
+++ b/examples/netcat-client.pl
@@ -0,0 +1,68 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use IO::Async::Loop;
+use IO::Async::Stream;
+
+my $CRLF = "\x0d\x0a"; # because \r\n is not portable
+
+my $HOST = shift @ARGV or die "Need HOST";
+my $PORT = shift @ARGV or die "Need PORT";
+
+my $loop = IO::Async::Loop->new;
+
+my $socket = $loop->connect(
+   host     => $HOST,
+   service  => $PORT,
+   socktype => 'stream',
+)->get;
+
+# $socket is just an IO::Socket reference
+my $peeraddr = $socket->peerhost . ":" . $socket->peerport;
+
+print STDERR "Connected to $peeraddr\n";
+
+# We need to create a cross-connected pair of Streams. Can't do that
+# easily without a temporary variable
+my ( $socketstream, $stdiostream );
+
+$socketstream = IO::Async::Stream->new(
+   handle => $socket,
+
+   on_read => sub {
+      my ( undef, $buffref, $eof ) = @_;
+
+      while( $$buffref =~ s/^(.*)$CRLF// ) {
+         $stdiostream->write( $1 . "\n" );
+      }
+
+      return 0;
+   },
+
+   on_closed => sub {
+      print STDERR "Closed connection to $peeraddr\n";
+      $stdiostream->close_when_empty;
+   },
+);
+$loop->add( $socketstream );
+
+$stdiostream = IO::Async::Stream->new_for_stdio(
+   on_read => sub {
+      my ( undef, $buffref, $eof ) = @_;
+
+      while( $$buffref =~ s/^(.*)\n// ) {
+         $socketstream->write( $1 . $CRLF );
+      }
+
+      return 0;
+   },
+
+   on_closed => sub {
+      $socketstream->close_when_empty;
+   },
+);
+$loop->add( $stdiostream );
+
+$loop->await_all( $socketstream->new_close_future, $stdiostream->new_close_future );
diff --git a/examples/readwrite-futures.pl b/examples/readwrite-futures.pl
new file mode 100644
index 0000000..9ab73b2
--- /dev/null
+++ b/examples/readwrite-futures.pl
@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use IO::Async::Loop;
+use IO::Async::Stream;
+
+my $loop = IO::Async::Loop->new;
+
+$loop->add( my $stdin  = IO::Async::Stream->new_for_stdin( on_read => sub { 0 } ) );
+$loop->add( my $stdout = IO::Async::Stream->new_for_stdout );
+
+$stdout->write( sub {
+   return undef if $stdin->is_read_eof;
+   return $stdin->read_atmost( 64 * 1024 );
+})->get;
diff --git a/examples/tail-logfile.pl b/examples/tail-logfile.pl
new file mode 100644
index 0000000..1f7d6eb
--- /dev/null
+++ b/examples/tail-logfile.pl
@@ -0,0 +1,32 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use IO::Async::Loop;
+use IO::Async::FileStream;
+
+my $FILE = shift @ARGV or die "Need FILE";
+
+my $loop = IO::Async::Loop->new;
+
+open my $fh, "<", $FILE or die "Cannot open $FILE for reading - $!";
+my $filestream = IO::Async::FileStream->new(
+   read_handle => $fh,
+   on_initial => sub {
+      my ( $self ) = @_;
+      $self->seek_to_last( "\n" );
+   },
+   on_read => sub {
+      my ( undef, $buffref ) = @_;
+
+      while( $$buffref =~ s/^(.*)\n// ) {
+         print "$FILE: $1\n";
+      }
+
+      return 0;
+   },
+);
+$loop->add( $filestream );
+
+$loop->run;
diff --git a/examples/tcp-proxy.pl b/examples/tcp-proxy.pl
new file mode 100644
index 0000000..51bd44a
--- /dev/null
+++ b/examples/tcp-proxy.pl
@@ -0,0 +1,81 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use IO::Async::Loop;
+use IO::Async::Stream;
+use IO::Async::Listener;
+
+my $LISTEN_PORT = 12345;
+my $CONNECT_HOST = "localhost";
+my $CONNECT_PORT = 80;
+
+my $loop = IO::Async::Loop->new;
+
+my $listener = ProxyListener->new;
+
+$loop->add( $listener );
+
+$listener->listen(
+   service  => $LISTEN_PORT,
+   socktype => 'stream',
+)->get;
+
+$loop->run;
+
+package ProxyListener;
+use base qw( IO::Async::Listener );
+
+sub on_stream
+{
+   my $self = shift;
+   my ( $stream1 ) = @_;
+
+   # $socket is just an IO::Socket reference
+   my $socket1 = $stream1->read_handle;
+   my $peeraddr = $socket1->peerhost . ":" . $socket1->peerport;
+
+   print STDERR "Accepted new connection from $peeraddr\n";
+
+   $loop->connect(
+      host    => $CONNECT_HOST,
+      service => $CONNECT_PORT,
+
+      on_stream => sub {
+         my ( $stream2 ) = @_;
+
+         $stream1->configure(
+            on_read => sub {
+               my ( $self, $buffref, $eof ) = @_;
+               # Just copy all the data
+               $stream2->write( $$buffref ); $$buffref = "";
+               return 0;
+            },
+            on_closed => sub {
+               $stream2->close_when_empty;
+               print STDERR "Connection from $peeraddr closed\n";
+            },
+         );
+
+         $stream2->configure(
+            on_read => sub {
+               my ( $self, $buffref, $eof ) = @_;
+               # Just copy all the data
+               $stream1->write( $$buffref ); $$buffref = "";
+               return 0;
+            },
+            on_closed => sub {
+               $stream1->close_when_empty;
+               print STDERR "Connection to $CONNECT_HOST:$CONNECT_PORT closed\n";
+            },
+         );
+
+         $loop->add( $stream1 );
+         $loop->add( $stream2 );
+      },
+
+      on_resolve_error => sub { print STDERR "Cannot resolve - $_[0]\n"; },
+      on_connect_error => sub { print STDERR "Cannot connect\n"; },
+   );
+}
diff --git a/examples/whoami-server.pl b/examples/whoami-server.pl
new file mode 100644
index 0000000..f11f8ea
--- /dev/null
+++ b/examples/whoami-server.pl
@@ -0,0 +1,58 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use IO::Async::Loop;
+use IO::Async::Stream;
+use IO::Async::Listener;
+
+my $PORT = 12345;
+
+my $loop = IO::Async::Loop->new;
+
+my $listener = IO::Async::Listener->new(
+   on_accept => sub {
+      my $self = shift;
+      my ( $socket ) = @_;
+
+      # $socket is just an IO::Socket reference
+      my $peeraddr = $socket->peerhost . ":" . $socket->peerport;
+
+      my $clientstream = IO::Async::Stream->new(
+         write_handle => $socket,
+      );
+
+      $loop->add( $clientstream );
+
+      $clientstream->write( "Your address is " . $peeraddr . "\n" );
+
+      $loop->resolver->getnameinfo(
+         addr => $socket->peername,
+
+         on_resolved => sub {
+            my ( $host, $service ) = @_;
+            $clientstream->write( "You are $host:$service\n" );
+            $clientstream->close_when_empty;
+         },
+         on_error => sub {
+            $clientstream->write( "Cannot resolve your address - $_[-1]\n" );
+            $clientstream->close_when_empty;
+         },
+      );
+   },
+);
+
+$loop->add( $listener );
+
+$listener->listen(
+   service  => $PORT,
+   socktype => 'stream',
+)->on_done( sub {
+   my ( $listener ) = @_;
+   my $socket = $listener->read_handle;
+
+   printf STDERR "Listening on %s:%d\n", $socket->sockhost, $socket->sockport;
+})->get;
+
+$loop->run;