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/format-test.pl         | 13 ++++--
 feature-tests/local_input_capture.pl | 50 +++++++++++++++++++++
 feature-tests/pipes.pl               | 87 ++++++++++++++++++++++++++++++++++++
 3 files changed, 146 insertions(+), 4 deletions(-)
 create mode 100644 feature-tests/local_input_capture.pl
 create mode 100644 feature-tests/pipes.pl

(limited to 'feature-tests')

diff --git a/feature-tests/format-test.pl b/feature-tests/format-test.pl
index 2c99d50..7a38d9f 100644
--- a/feature-tests/format-test.pl
+++ b/feature-tests/format-test.pl
@@ -3,7 +3,7 @@ use warnings;
 
 
 use Irssi;
-
+use Data::Dumper;
 
 our $VERSION = '0.1';
 our %IRSSI = (
@@ -16,19 +16,24 @@ our %IRSSI = (
 
 sub actually_printformat {
     my ($win, $level, $module, $format, @args) = @_;
+    my $ret = '';
     {
         # deeeeeeep black magic.
         local *CORE::GLOBAL::caller = sub { $module };
         $win->printformat($level, $format, @args);
-    }
 
+        $ret = Irssi::current_theme()->get_format($module, $format);
+    }
+    return $ret;
 }
 
 init();
 
 sub init {
     my $win = Irssi::active_win();
-    actually_printformat($win, Irssi::MSGLEVEL_CLIENTCRAP, 'fe-common/irc',
-                               "kill_server", "foo", "bar", "horse", "cake");
+    my $moo = actually_printformat($win, Irssi::MSGLEVEL_CLIENTCRAP, 'fe-common/irc',
+                                   "kill_server", "foo", "bar", "horse", "cake");
+
+    print Dumper($moo);
 
 }
diff --git a/feature-tests/local_input_capture.pl b/feature-tests/local_input_capture.pl
new file mode 100644
index 0000000..847ff07
--- /dev/null
+++ b/feature-tests/local_input_capture.pl
@@ -0,0 +1,50 @@
+use strict;
+use warnings;
+
+
+use Irssi;
+use Irssi::Irc;
+use Irssi::TextUI;
+
+use Data::Dumper;
+
+
+our $VERSION = '0.1';
+our %IRSSI = (
+              authors     => 'shabble',
+              contact     => 'shabble+irssi@metavore.org',
+              name        => '',
+              description => '',
+              license     => 'Public Domain',
+             );
+
+my $buffer = '';
+init();
+
+sub init {
+
+    Irssi::signal_add_first 'print text', 'sig_print_text';
+    Irssi::command 'echo Hello there';
+    Irssi::signal_remove 'print text', 'sig_print_text';
+    Irssi::command_bind 'showbuf', 'cmd_showbuf';
+}
+
+sub cmd_showbuf {
+    my ($args, $server, $win_item) = @_;
+    my $win;
+    if (defined $win_item) {
+        $win = $win_item->window();
+    } else {
+        $win = Irssi::active_win();
+    }
+
+    $win->print("buffer is: $buffer");
+    $buffer = '';
+}
+
+sub sig_print_text {
+    my ($text_dest, $str, $stripped_str) = @_;
+
+    $buffer .= $stripped_str;
+    Irssi::signal_stop;
+}
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