File Coverage

blib/lib/ExtUtils/ParseXS/CountLines.pm
Criterion Covered Total %
statement 26 27 96.3
branch 1 2 50.0
condition n/a
subroutine 8 8 100.0
pod 0 1 0.0
total 35 38 92.1


line stmt bran cond sub pod time code
1             package ExtUtils::ParseXS::CountLines;
2              
3             # Private helper module. It is used to tie a file handle, and
4             # whenever lines are written to it, lines which match the
5             #
6             # ExtUtils::ParseXS::CountLines->end_marker()
7             #
8             # token are replaced with:
9             #
10             # #line NNN file.c
11             #
12             # where NNN is the count of lines written so far.
13              
14 28     28   149 use strict;
  28         60  
  28         886  
15 28     28   112 use warnings;
  28         40  
  28         12158  
16              
17             our $VERSION = '3.63';
18              
19             our $SECTION_END_MARKER;
20              
21             sub TIEHANDLE {
22 431     431   3902 my ($class, $cfile, $fh) = @_;
23 431         3676 $cfile =~ s/\\/\\\\/g;
24 431         1404 $cfile =~ s/"/\\"/g;
25 431         1727 $SECTION_END_MARKER = qq{#line --- "$cfile"};
26              
27 431         15062 return bless {
28             buffer => '',
29             fh => $fh,
30             line_no => 1,
31             }, $class;
32             }
33              
34             sub PRINT {
35 10677     10677   15445 my $self = shift;
36 10677         15035 for (@_) {
37 13806         27743 $self->{buffer} .= $_;
38 13806         42793 while ($self->{buffer} =~ s/^([^\n]*\n)//) {
39 84929         381632 my $line = $1;
40 84929         97456 ++$self->{line_no};
41 84929         98560 $line =~ s|^\#line\s+---(?=\s)|#line $self->{line_no}|;
42 84929         84987 print {$self->{fh}} $line;
  84929         145012  
43             }
44             }
45             }
46              
47             sub PRINTF {
48 345     345   571 my $self = shift;
49 345         898 my $fmt = shift;
50 345         1574 $self->PRINT(sprintf($fmt, @_));
51             }
52              
53             sub DESTROY {
54             # Not necessary if we're careful to end with a "\n"
55 429     429   869 my $self = shift;
56 429 50       3424 print {$self->{fh}} $self->{buffer} if length $self->{buffer};
  0         0  
57             }
58              
59       369     sub UNTIE {
60             # This sub does nothing, but is necessary for references to be released.
61             }
62              
63             sub end_marker {
64 866     866 0 2248 return $SECTION_END_MARKER;
65             }
66              
67             1;