The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#!/usr/bin/perl -w
# $Id: bench-pipe-server.pl 35 2005-06-06 04:48:39Z asari $

use strict;
use blib;
use File::Basename;
use Fcntl;

$SIG{INT}  = \&term;
$SIG{TERM} = \&term;

my ( $base, $path, $suffix ) = fileparse( $0, qr(\.[t|pl]) );

my $read_pipe  = $path . 'SERVER_PIPE';
my $write_pipe = $path . 'CLIENT_PIPE';

unless ( -p $write_pipe ) {
    if ( -e _ ) {
        die "$0: Won't overwrite $write_pipe\n";
    }
    else {
        require POSIX;
        POSIX::mkfifo( $write_pipe, 0666 )
          or die "Can't create $write_pipe: $!\n";
    }
}

unless ( -p $read_pipe ) {
    if ( -e _ ) {
        die "$0: Won't overwrite $read_pipe\n";
    }
    else {
        require POSIX;
        POSIX::mkfifo( $read_pipe, 0666 )
          or die "Can't create $read_pipe: $!\n";
    }
}

while (1) {
    die "Pipe $read_pipe disappeared\n" unless -p $read_pipe;

    sysopen( SERVER_PIPE, $read_pipe, O_RDONLY )
      or die "Can't write to $read_pipe: $!";
    sysopen( CLIENT_PIPE, $write_pipe, O_WRONLY )
      or die "Can't read to $write_pipe: $!";

    my $arg = <SERVER_PIPE>;
    print CLIENT_PIPE $arg**2;

    close SERVER_PIPE;
    close CLIENT_PIPE;

    select undef, undef, undef, 0.2;
}

sub term {
    my $sig = shift;
    die "$0: Caught signal $sig.\n";
}