File Coverage

blib/lib/PerlIO/via/EscStatus/ShowNone.pm
Criterion Covered Total %
statement 25 25 100.0
branch 1 2 50.0
condition n/a
subroutine 8 8 100.0
pod 0 1 0.0
total 34 36 94.4


line stmt bran cond sub pod time code
1             # Copyright 2008, 2009, 2010, 2011, 2012 Kevin Ryde
2              
3             # This file is part of PerlIO-via-EscStatus.
4             #
5             # PerlIO-via-EscStatus is free software; you can redistribute it and/or
6             # modify it under the terms of the GNU General Public License as published
7             # by the Free Software Foundation; either version 3, or (at your option) any
8             # later version.
9             #
10             # PerlIO-via-EscStatus is distributed in the hope that it will be useful,
11             # but WITHOUT ANY WARRANTY; without even the implied warranty of
12             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
13             # Public License for more details.
14             #
15             # You should have received a copy of the GNU General Public License along
16             # with PerlIO-via-EscStatus. If not, see .
17              
18             package PerlIO::via::EscStatus::ShowNone;
19 1     1   52525 use 5.008;
  1         4  
  1         38  
20 1     1   6 use strict;
  1         2  
  1         37  
21 1     1   5 use warnings;
  1         2  
  1         38  
22 1     1   770 use PerlIO::via::EscStatus;
  1         4  
  1         76  
23 1     1   8 use PerlIO::via::EscStatus::Parser;
  1         3  
  1         40  
24              
25             our $VERSION = 11;
26              
27 1     1   5 use constant DEBUG => 0;
  1         2  
  1         244  
28              
29             sub PUSHED {
30 2     2 0 22548 my ($class, $mode, $fh) = @_;
31 2         5 if (DEBUG) {
32             require Data::Dumper;
33             print STDERR "pushed ", Data::Dumper::Dumper ([$class,$mode,$fh]);
34             }
35 2         18 return bless { parser => PerlIO::via::EscStatus::Parser->new
36             }, $class;
37             }
38              
39             *UTF8 = \&PerlIO::via::EscStatus::UTF8;
40             *FLUSH = \&PerlIO::via::EscStatus::FLUSH;
41              
42             sub WRITE {
43 6     6   30 my ($self, $buf, $fh) = @_;
44 6         23 my ($status, $output) = $self->{'parser'}->parse($buf);
45 6 50       35 print $fh $output or return -1;
46 6         24 return length($buf);
47             }
48              
49             1;
50             __END__