summaryrefslogtreecommitdiff
path: root/examples
diff options
context:
space:
mode:
Diffstat (limited to 'examples')
-rw-r--r--examples/chat-server.pl71
-rw-r--r--examples/echo-server.pl69
-rw-r--r--examples/netcat-client.pl68
-rw-r--r--examples/readwrite-futures.pl17
-rw-r--r--examples/tail-logfile.pl32
-rw-r--r--examples/tcp-proxy.pl81
-rw-r--r--examples/whoami-server.pl58
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;
View Lorry Controller Status