File Coverage

blib/lib/PerlIO/via/EscStatus/ShowAll.pm
Criterion Covered Total %
statement 31 31 100.0
branch 2 4 50.0
condition n/a
subroutine 8 8 100.0
pod 0 1 0.0
total 41 44 93.1


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::ShowAll;
19 1     1   30165 use 5.008;
  1         4  
  1         39  
20 1     1   6 use strict;
  1         2  
  1         35  
21 1     1   5 use warnings;
  1         2  
  1         33  
22 1     1   648 use PerlIO::via::EscStatus;
  1         3  
  1         56  
23 1     1   8 use PerlIO::via::EscStatus::Parser;
  1         3  
  1         40  
24              
25             our $VERSION = 11;
26              
27 1     1   6 use constant DEBUG => 0;
  1         2  
  1         353  
28              
29             sub PUSHED {
30 2     2 0 79506 my ($class, $mode, $fh) = @_;
31 2         82 if (DEBUG) {
32             require Data::Dumper;
33             print STDERR "ShowAll pushed ", Data::Dumper::Dumper ([$class,$mode,$fh]);
34             }
35 2         24 return bless { partial => '' }, $class;
36             }
37              
38             *UTF8 = \&PerlIO::via::EscStatus::UTF8;
39             *FLUSH = \&PerlIO::via::EscStatus::FLUSH;
40              
41             sub WRITE {
42 6     6   42 my ($self, $buf, $fh) = @_;
43 6         231 my $ret_ok = length ($buf);
44 6         8 if (DEBUG) { print STDERR "ShowAll write $ret_ok\n"; }
45              
46 6         18 $buf = $self->{'partial'} . $buf;
47              
48             # complete sequences
49 6         15 $buf =~ s/\e_EscStatus\e\\//g;
50              
51 6 50       22 my $pos
52             = ($buf =~ PerlIO::via::EscStatus::Parser::ESCSTATUS_STR_PARTIAL_REGEXP()
53             ? $-[0] # start of match
54             : length ($buf));
55 6         95 $self->{'partial'} = substr ($buf, $pos); # match onwards
56 6         87 $buf = substr ($buf, 0, $pos); # prematch
57              
58 6 50       35 print $fh $buf or return -1;
59 6         31 return $ret_ok;
60             }
61              
62             1;
63             __END__