use v5.8.0;
use strict;
use warnings;

package PerlIO::via::TimeStamp;

sub PUSHED {
   my ($class, $mode, $fh) = @_;

   # We can't be the bottom layer.
   if (@_ < 3) {
      # XXX Set "$!"?
      return -1;
   }

   # We only support writting.
   if ($mode ne 'w' && $mode ne 'a') {
      # XXX Set "$!"?
      return -1;
   }

   return bless({ nl => 1 }, $class);
}

sub WRITE {
   my  $self              =  $_[0];
   our $ibuf; local *ibuf = \$_[1];
   my  $fh                =  $_[2];

   return 0 if not length $ibuf;

   local ($,, $\);

   our $nl; local *nl = \($self->{nl});
   my $lt;

   my $qsep = quotemeta($/);
   while ($_[1] =~ /((?:(?!$qsep).)*(?:($qsep)|(?!$qsep).))/gs) {
      my $obuf = '';

      if ($nl) {
         $lt ||= "[" . localtime() . "] ";
         $obuf .= $lt;
      }

      $obuf .= $1;
      print $fh $obuf
         or return 0;

      $nl = !!$2;
   }
  
   return length($ibuf);
}

1;
[download]

binmode(STDOUT, '>:via(TimeStamp)');
print("test\n");
[download]

Untested.

=head1 NAME

FileHandle::Sub - an output filehandle that sends each line of output 
+to a user-specified CODE block

=head1 SYNOPSIS

    use FileHandle::Sub;

    # grep
    my $fh = FileHandle::Sub::open { /token/ and print };

    # prefix
    my $fh = FileHandle::Sub::open { s/^/scalar localtime/e; print };

=head1 DESCRIPTION

Each line of output sent to this file handle will be passed to the COD
+E block supplied to C<open>.

=cut

package FileHandle::Sub;
{
    require 5.8.0;

    use strict;
    use warnings;

    sub open (&)
    {
        local *FH;
        tie *FH, __PACKAGE__, @_ or return;
        return *FH;
    }

    sub TIEHANDLE
    {
        my($class, $code) = @_;
        bless [$code, ""], $class;
    }

    sub _emit
    {
        my ($self, $txt) = @_;

        my ($code, $prev) = @$self;

        if ($txt =~ /\n$/)
        {
            local $_ = $prev . $txt;
            $code->($_);
            $prev = "";
        }
        else
        {
            $prev .= $txt;
        }

        $self->[1] = $prev;
    }

    sub PRINT
    {
        my ($self, @txt) = @_;
        local $_;
        for my $txt (@txt)
        {
            _emit($self, $_) for $txt =~ /[^\n]*\n?/g;
        }
    }

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

    sub CLOSE
    {
        my ($self) = @_;
        local $_ = $self->[1];
        if (length)
        {
            $self->[0]->($_);
        }
        $self->[1] = "";
    }

    sub DESTROY { &CLOSE }
}

1;
[download]

Good idea. My code was just an example. There are problems with the implementation, though.

• For starters, you cannot easily replace an existing file handle, so you failed to address the original question.

• No support for $,.

• No support for $\.

• No error code is returned. People won't be able to use this module when error checking is being done.

• No support for write, binmode, etc. People won't be able to use this module when these are called with the filehandle.

• Only your open function requires 5.8.0, and it could easily be rewritten to avoid that requirement.

• Using $/ as the line terminator would be better than \n because it would give more flexibility to the caller at no cost.

• _emit for //g would be more efficient as _emit while //g.

Obviously I agree that the implementation is incomplete; and yes, it is orthogonal to the OP's question. A user of a module like this would be responsible for managing their own filehandles -- as earlier answers said: store a dup of STDOUT.

Support for all the special variables needs a little thought, because they are dynamically scoped. I'd probably want to capture their values in the "open" function and store those values in the object. But, OTOH, maybe someone changing the values dynamically knows what they're doing.

I'm not sure that binmode is required for this filehandle. All it does is call a user-defined perl function for each line (implicitly text). If that code prints to a "real" filehandle, then it is that filehandle that needs to support binmode.

I'd be interested to know how to rewrite the "open" function to avoid needing 5.8.x -- the requirement exists because of bugs in 5.6.x, so the simplest (and safest) thing it to require a version of perl that works reliably with tied filehandles.

The conclusion I'd draw from this is that filehandles aren't as simple as we'd like -- because there's more underlying complexity than initially apparent.

--Dave
Opinions my own; statements of fact may be in error.