fifo.pm
-------
package fifo;

# note: this was just a work in progress, now abandoned
# and never to be finished, so it's still somewhat crude.

use base 'Tie::Handle';
use Symbol ();

sub new {
        my $class = shift;
        my $self = bless Symbol::gensym(), ref($class) || $class;
        tie *$self, $self;
        $self->open(@_);
        $self;
}

sub open {
        my $self = shift;
        return $self->new(@_) unless ref($self);
        *$self->{contents} = [];
        return $self;
}

sub TIEHANDLE {
        return $_[0] if ref($_[0]);
        my $self = bless Symbol::gensym(), $_[0];
        $self->open(@_);
        return $self;
}

sub PRINT {
        my $self = shift;
        push(
                @{*$self->{contents}},
                split(
                        /^/om,
                        join(
                                '',
                                (pop @{*$self->{contents}} || '', @_)
                        )
                )
        );
}

sub PRINTF {
        my $self = shift;
        my $fmt = shift;
        $self->PRINT(sprintf($fmt, @_));
}

sub READLINE {
        return $_[0]->readlines() if wantarray;
        return shift(@{*{$_[0]}->{contents}});
}
sub readlines {
        my $contents = *{$_[0]}->{contents};
        *{$_[0]}->{contents} = [];
        return @$contents;
}

sub EOF {
        return not (scalar @{*{$_[0]}->{contents}});
}
                         
1;


benchmark.pl
------------
#!/usr/bin/perl
use fifo;
use IO::String;


my $fh1 = fifo->new();
my $fh2 = IO::String->new();
my $fh3;
my $buf = '';
open($fh3, "+<", \$buf);

sub foo {
        for (1..10) {
                print $fh1 "xxxx\n";
        }
        while (<$fh1>) {
                # print;
        }
}

sub bar {
        for (1..10) {
                print $fh2 "xxxx\n";
        }
        $fh2->pos(0);
        while (<$fh2>) {
                # print;
        }
        $fh2->pos(0);
}

sub baz {
        for (1..10) {
                print $fh3 "xxxx\n";
        }
        seek($fh3, 0, 0);
        while (<$fh3>) {
                # print;
        }
        seek($fh3, 0, 0);
}

use Benchmark qw(cmpthese);

cmpthese (
        10000,
        {
                fifo => \&foo,
                string => \&bar,
                perlio => \&baz,
        }
);