From d285e7854dfc62c213bec4c101eaf080fa81ac46 Mon Sep 17 00:00:00 2001
From: Tom Feist <shabble@metavore.org>
Date: Wed, 12 Jan 2011 00:10:16 +0000
Subject: pipes: added an example feature test on how to use pipes for
 non-blocking IO. Hope to expand it to include network IO at some point.

---
 feature-tests/pipes.pl | 87 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 87 insertions(+)
 create mode 100644 feature-tests/pipes.pl

(limited to 'feature-tests/pipes.pl')

diff --git a/feature-tests/pipes.pl b/feature-tests/pipes.pl
new file mode 100644
index 0000000..50bff53
--- /dev/null
+++ b/feature-tests/pipes.pl
@@ -0,0 +1,87 @@
+use strict;
+use warnings;
+
+use Irssi;
+use POSIX;
+use Time::HiRes qw/sleep/;
+
+my $forked = 0;
+
+sub pipe_and_fork {
+    my ($read_handle, $write_handle);
+
+    pipe($read_handle, $write_handle);
+
+    my $oldfh = select($write_handle);
+    $| = 1;
+    select $oldfh;
+
+    return if $forked;
+
+    my $pid = fork();
+
+    if (not defined $pid) {
+        _error("Can't fork: Aborting");
+        close($read_handle);
+        close($write_handle);
+        return;
+    }
+
+    $forked = 1;
+
+    if ($pid > 0) { # this is the parent (Irssi)
+        close ($write_handle);
+        Irssi::pidwait_add($pid);
+        my $job = $pid;
+        my $tag;
+        my @args = ($read_handle, \$tag, $job);
+        $tag = Irssi::input_add(fileno($read_handle),
+                                      Irssi::INPUT_READ,
+                                      \&child_input,
+                                      \@args);
+
+    } else { # child
+        # make up some data - block if we like.
+        for (1..10) {
+            sleep rand 1;
+            print $write_handle "Some data: $_\n";
+        }
+        print $write_handle "__DONE__\n";
+        close $write_handle;
+
+        POSIX::_exit(1);
+    }
+}
+
+sub child_input {
+    my $args = shift;
+    my ($read_handle, $input_tag_ref, $job) = @$args;
+
+    my $data = <$read_handle>;
+
+    if ($data =~ m/__DONE__/) {
+        close($read_handle);
+        Irssi::input_remove($$input_tag_ref);
+        _msg("child finished");
+
+        $forked = 0;
+
+    } else {
+        _msg("Received from child: $data");
+    }
+
+}
+
+sub _error {
+    my ($msg) = @_;
+    my $win = Irssi::active_win();
+    $win->print($msg, Irssi::MSGLEVEL_CLIENTERROR);
+}
+
+sub _msg {
+    my ($msg) = @_;
+    my $win = Irssi::active_win();
+    $win->print($msg, Irssi::MSGLEVEL_CLIENTCRAP);
+}
+
+Irssi::command_bind("start_pipes", \&pipe_and_fork);
-- 
cgit v1.2.3