alarm

use Socket;

eval {
        local $SIG{ALRM} = sub { die "time is out" };
        alarm 3;
        socket SOCK, PF_INET, SOCK_STREAM, getprotobyname('tcp');
        connect SOCK, sockaddr_in(81, inet_aton("microsoft.com"))
                                         or die "connect failed";
        alarm 0;
        send SOCK, "GET / HTTP/1.0\n\n", 0;
        print while <SOCK>;
        shutdown SOCK, 2;
};
print "$@\n" if $@;

die

$warnings = 0;

$SIG{__WARN__} = sub { print @_ if $warnings };
$SIG{__DIE__} = sub { print "Goodbye, my darling!\n" };

warn "i'm only warning...";
die "i'm dying...";

open

{
    open MORE, "| less" or die "cannot fork";
    local $SIG{PIPE} = sub { die "broken pipe" };
    print MORE "hello\nworld\n" or die "cannot write";
    close MORE or die "cannot close";
}

open DIR, "dir |" or die "cannot fork";
print while <DIR>;
close DIR or die "cannot close";

$pid = open(KID_TO_WRITE, "|-");
die "cannot fork" if (!defined $pid);
if ($pid) {
    print KID_TO_WRITE "hi there";
    close KID_TO_WRITE or warn "kid exited $?";
} else {
    ($EUID, $EGID) = ($UID, $GID);
    open FILE, ">safe";
    while (<STDIN>) {
        print FILE;
    }
    close FILE;
    exit;
}

bug

#!/usr/bin/perl -p

open2

use IPC::Open2;

$pid = open2(*READER, *WRITER, "grep ERROR");
print WRITER <<EOT
1 asdf
2 qwer
3 ERROR
4 zzzz
5 ERROR
EOT
;
close WRITER;
print while <READER>;
close READER;

pipe

pipe (PAR_R, CHLD_W);
pipe (CHLD_R, PAR_W);
select((select(CHLD_W),$|=1)[0]);
select((select(PAR_W),$|=1)[0]);

if ($pid = fork()) {
    close PAR_R; close PAR_W;
    print CHLD_W "how are you there?\n";
    print "<< $_" while <CHLD_R>;
    close CHLD_W; close CHLD_R;
    waitpid($pid, 0);
} else {
    die "cannot fork: $!" unless defined $pid;
    close CHLD_R; close CHLD_W;
    while (<PAR_R>) {
        print ">> $_";
        print PAR_W "ok\n";
    }
    close PAR_W; close PAR_R;
}

daemonize

use POSIX 'setsid';

sub daemonize {
    chdir '/' or die "Can't chdir to /: $!";
    open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
    open STDOUT, '>/dev/null' or die "Can't write to /dev/null: $!";
    defined(my $pid = fork) or die "Can't fork: $!";
    exit if $pid;
    setsid or die "Can't start a new session: $!";
    open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
}

daemonize();
1 while 1;

threads

use threads;
use threads::shared;

my $sh :shared;
$sh = 0;

sub thread_start {
    local $SIG{'KILL'} = sub { threads->exit(); };
    {
        lock($sh);
        print threads->tid(), " increasing $sh...\n";
        $sh++;
        sleep 1;
    }
    sleep 10;
    return 1;
}

my $th = threads->create(\&thread_start, "lalala");
my $th2 = threads->create(\&thread_start);

my $counter = 0;
while ($th->is_running() && !$th->is_detached()) {
    print "...still running...\n";
    $counter++;
    sleep 1;
    $th->kill('KILL')->detach() if $counter > 5;
}

print "result is: ".$th->join();

print "sh: $sh\n";