aboutsummaryrefslogtreecommitdiffstats
path: root/feature-tests/pipes.pl
blob: 50bff534bb8ad34f7315ac30e7bb1149db946730 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
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);