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


line stmt bran cond sub pod time code
1             package PerlIO::via::LineNumber;
2              
3             $VERSION= '0.05';
4              
5             # be as strict as possible
6 1     1   63313 use strict;
  1         2  
  1         23  
7 1     1   5 use warnings;
  1         2  
  1         364  
8              
9             # defaults
10             my $line= 1;
11             my $format= '%4d %s';
12             my $increment= 1;
13              
14             # satisfy -require-
15             1;
16              
17             #-------------------------------------------------------------------------------
18             #
19             # Class methods
20             #
21             #-------------------------------------------------------------------------------
22             # IN: 1 class (ignored)
23             # 2 new value for default initial line number
24             # OUT: 1 current default initial line number
25              
26             sub line {
27              
28             # set new default initial line number if one specified
29 4 100   4 1 1048 $line= $_[1] if @_ >1;
30              
31 4         16 return $line;
32             } #line
33              
34             #-------------------------------------------------------------------------------
35             # IN: 1 class (ignored)
36             # 2 new value for default format
37             # OUT: 1 current default format
38              
39             sub format {
40              
41             # set new default format if one specified
42 6 100   6 1 20 $format= $_[1] if @_ >1;
43              
44 6         15 return $format;
45             } #format
46              
47             #-------------------------------------------------------------------------------
48             # IN: 1 class (ignored)
49             # 2 new value for default increment and default line number
50             # OUT: 1 current default increment
51              
52             sub increment {
53              
54             # set new default increment if one specified
55 4 100   4 1 14 $line= $increment= $_[1] if @_ >1;
56              
57 4         19 return $increment;
58             } #increment
59              
60             #-------------------------------------------------------------------------------
61             #
62             # Subroutines for standard Perl features
63             #
64             #-------------------------------------------------------------------------------
65             # IN: 1 class to bless with
66             # 2 mode string (ignored)
67             # 3 file handle of PerlIO layer below (ignored)
68             # OUT: 1 blessed object
69              
70             sub PUSHED {
71              
72 3     3 0 789 return bless {
73             line => $line,
74             format => $format,
75             increment => $increment,
76             }, $_[0];
77             } #PUSHED
78              
79             #-------------------------------------------------------------------------------
80             # IN: 1 instantiated object
81             # 2 handle to read from
82             # OUT: 1 processed string
83              
84             sub FILL {
85              
86             # prefix line number
87 12 100   12 0 75 if ( defined( my $line= readline( $_[1] ) ) ) {
88 10         28 my $number= $_[0]->{line};
89 10         13 $_[0]->{line} += $_[0]->{increment};
90 10         47 return sprintf $_[0]->{format}, $number, $line;
91             }
92              
93             # nothing to do
94 2         21 return undef;
95             } #FILL
96              
97             #-------------------------------------------------------------------------------
98             # IN: 1 instantiated object
99             # 2 buffer to be written
100             # 3 handle to write to
101             # OUT: 1 number of bytes written
102              
103             sub WRITE {
104              
105             # local copies of format and increment
106 1     1   3 my ( $format, $increment )= @{ $_[0] }{ qw(format increment ) };
  1         7  
107              
108             # print all lines with line number, die if print fails
109 1         20 foreach ( split m#(?<=$/)#, $_[1] ) {
110             return -1
111 5 50       7 if !print { $_[2] } sprintf( $format, $_[0]->{line}, $_ );
  5         18  
112 5         8 $_[0]->{line} += $increment;
113             }
114              
115 1         7 return length( $_[1] );
116             } #WRITE
117              
118             #-------------------------------------------------------------------------------
119             # IN: 1 class for which to import
120             # 2..N parameters passed with -use-
121              
122             sub import {
123 2     2   196 my ( $class, %param )= @_;
124              
125             # store parameters using mutators
126 2         15 $class->$_( $param{$_} ) foreach keys %param;
127             } #import
128              
129             #-------------------------------------------------------------------------------
130              
131             __END__