File Coverage

blib/lib/Tie/Handle/Filter/Output/Timestamp/EveryLine.pm

Criterion	Covered	Total	%
statement	30	30	100.0
branch	1	2	50.0
condition	2	5	40.0
subroutine	9	9	100.0
pod			n/a
total	42	46	91.3

package Tie::Handle::Filter::Output::Timestamp::EveryLine;

# ABSTRACT: prepend every line of filehandle output with a timestamp

use 5.008;
use strict;
use warnings;
use base 'Tie::Handle::Filter';
use English '-no_match_vars';
use POSIX 'strftime';
our $VERSION = '0.009';    # TRIAL

#pod =head1 SYNOPSIS
#pod
#pod     use Tie::Handle::Filter::Output::Timestamp::EveryLine;
#pod     tie *STDOUT, 'Tie::Handle::Filter::Output::Timestamp::EveryLine', *STDOUT;
#pod
#pod     print "Everything I print will be prepended with a timestamp.\n";
#pod     print <<'END_OUTPUT';
#pod     Even multi-line output will have every line prepended.
#pod     Including this one.
#pod     END_OUTPUT
#pod
#pod =cut

#pod =head1 DESCRIPTION
#pod
#pod This class may be used with Perl's L function to
#pod prepend all output with a timestamp, optionally formatted according to
#pod the L|POSIX/strftime> function. Unlike
#pod L|Tie::Handle::Filter::Output::Timestamp>,
#pod I line gets a timestamp, rather than just the beginning of
#pod strings given to L|perlfunc/print>,
#pod L|perlfunc/printf>, L|perlfunc/syswrite>, and
#pod L|perlfunc/say> (in Perl > v5.10).
#pod
#pod =head1 BUGS AND LIMITATIONS
#pod
#pod Because the date and time format is specified using
#pod L|POSIX/strftime>, portable code should restrict itself to
#pod formats using ANSI C89 specifiers.
#pod
#pod =cut

my $NEWLINE = $PERL_VERSION < v5.10    ## no critic (ProhibitMagicNumbers)
    ? '(?>\x0D\x0A|\n)'    ## no critic (RequireInterpolationOfMetachars)
    : '\R';

#pod =method TIEHANDLE
#pod
#pod Invoked by the command
#pod C.
#pod You may also specify a L|POSIX/strftime> string as an
#pod additional parameter to format the timestamp; by default the format is
#pod C<%x %X >, which is the local representation of the date and time
#pod followed by a space.
#pod
#pod =cut

sub TIEHANDLE {
    my ( $class, $handle_glob, $format ) = @_;
    return $class->SUPER::TIEHANDLE( $handle_glob,
        _filter_closure( $format || '%x %X ' ) );
}

sub _filter_closure {
    my $format           = shift;
    my $string_beginning = 1;
    return sub {
        my $string = join q() => @_;
        $string
            =~ s/ ($NEWLINE) (?=.) / $1 . strftime($format, localtime) /egmsx;
        if ($string_beginning) {
            $string =~ s/ \A / strftime($format, localtime) /emsx;
        }
        $string_beginning = $string =~ / $NEWLINE \z/msx
            || $OUTPUT_RECORD_SEPARATOR eq "\n";
        return $string;
    };
}

1;

__END__