File Coverage

blib/lib/PerlIO/via/LineNumber.pm

Criterion	Covered	Total	%
statement	27	27	100.0
branch	9	10	90.0
condition			n/a
subroutine	9	9	100.0
pod	3	5	60.0
total	48	51	94.1

package PerlIO::via::LineNumber;

$VERSION= '0.04';

# be as strict as possible
use strict;
use warnings;

# defaults
my $line=      1;
my $format=    '%4d %s';
my $increment= 1;

# satisfy -require-
1;

#-------------------------------------------------------------------------------
#
# Class methods
#
#-------------------------------------------------------------------------------
#  IN: 1 class (ignored)
#      2 new value for default initial line number
# OUT: 1 current default initial line number

sub line {

    # set new default initial line number if one specified
    $line= $_[1] if @_ >1;

    return $line;
} #line

#-------------------------------------------------------------------------------
#  IN: 1 class (ignored)
#      2 new value for default format
# OUT: 1 current default format

sub format {

    # set new default format if one specified
    $format= $_[1] if @_ >1;

    return $format;
} #format

#-------------------------------------------------------------------------------
#  IN: 1 class (ignored)
#      2 new value for default increment and default line number
# OUT: 1 current default increment

sub increment {

    # set new default increment if one specified
    $line= $increment= $_[1] if @_ >1;

    return $increment;
} #increment

#-------------------------------------------------------------------------------
#
# Subroutines for standard Perl features
#
#-------------------------------------------------------------------------------
#  IN: 1 class to bless with
#      2 mode string (ignored)
#      3 file handle of PerlIO layer below (ignored)
# OUT: 1 blessed object

sub PUSHED {

    return bless {
      line      => $line,
      format    => $format,
      increment => $increment,
    }, $_[0];
} #PUSHED

#-------------------------------------------------------------------------------
#  IN: 1 instantiated object
#      2 handle to read from
# OUT: 1 processed string

sub FILL {

    # prefix line number
    if ( defined( my $line= readline( $_[1] ) ) ) {
        my $number= $_[0]->{line};
        $_[0]->{line} += $_[0]->{increment};
        return sprintf $_[0]->{format}, $number, $line;
    }

    # nothing to do
    return undef;
} #FILL

#-------------------------------------------------------------------------------
#  IN: 1 instantiated object
#      2 buffer to be written
#      3 handle to write to
# OUT: 1 number of bytes written

sub WRITE {

    # local copies of format and increment
    my ( $format, $increment )= @{ $_[0] }{ qw(format increment ) };

    # print all lines with line number, die if print fails
    foreach ( split m#(?<=$/)#, $_[1] ) {
        return -1
          if !print { $_[2] } sprintf( $format, $_[0]->{line}, $_ );
        $_[0]->{line} += $increment;
    }

    return length( $_[1] );
} #WRITE

#-------------------------------------------------------------------------------
#  IN: 1 class for which to import
#      2..N parameters passed with -use-

sub import {
    my ( $class, %param )= @_;

    # store parameters using mutators
    $class->$_( $param{$_} ) foreach keys %param;
} #import

#-------------------------------------------------------------------------------

__END__