File Coverage

blib/lib/PerlIO/via/UnComment.pm
Criterion Covered Total %
statement 12 12 100.0
branch 3 4 75.0
condition 2 2 100.0
subroutine 4 4 100.0
pod 0 2 0.0
total 21 24 87.5


line stmt bran cond sub pod time code
1             package PerlIO::via::UnComment;
2              
3             $VERSION= '0.05';
4              
5             # be as strict as possible
6 1     1   56620 use strict;
  1         2  
  1         194  
7              
8             # satisfy -require-
9             1;
10              
11             #-----------------------------------------------------------------------
12             #
13             # Standard Perl features
14             #
15             #-----------------------------------------------------------------------
16             # IN: 1 class to bless with
17             # 2 mode string (ignored)
18             # 3 file handle of PerlIO layer below (ignored)
19             # OUT: 1 blessed object
20              
21             sub PUSHED {
22              
23             # return an object
24 2     2 0 1377 return bless \*PUSHED, $_[0];
25             } #PUSHED
26              
27             #-----------------------------------------------------------------------
28             # IN: 1 instantiated object
29             # 2 handle to read from
30             # OUT: 1 processed string (if any)
31              
32             sub FILL {
33              
34             # return first line that isn't a comment
35 6     6 0 13 local( $_ );
36 6   100     132 m/^#/ or return $_ while defined( $_= readline( $_[1] ) );
37              
38 1         19 return undef;
39             } #FILL
40              
41             #-----------------------------------------------------------------------
42             # IN: 1 instantiated object
43             # 2 buffer to be written
44             # 3 handle to write to
45             # OUT: 1 number of bytes written or -1 if failure
46              
47             sub WRITE {
48              
49             # print all lines that don't start with #
50             LINE:
51 1     1   51 foreach ( split( m#(?<=$/)#, $_[1] ) ) {
52 7 100       18 next LINE if m/^#/;
53              
54 5 50       6 return -1 if !print {$_[2]} $_;
  5         13  
55             }
56              
57 1         10 return length( $_[1] );
58             } #WRITE
59              
60             #-----------------------------------------------------------------------
61              
62             __END__