File Coverage

blib/lib/Pod/Simple/Role/XHTML/WithPostProcess.pm
Criterion Covered Total %
statement 13 13 100.0
branch n/a
condition n/a
subroutine 5 5 100.0
pod 2 2 100.0
total 20 20 100.0


line stmt bran cond sub pod time code
1             package Pod::Simple::Role::XHTML::WithPostProcess;
2 1     1   389 use Moo::Role;
  1         2  
  1         4  
3              
4             our $VERSION = '0.003002';
5             $VERSION =~ tr/_//d;
6              
7 1     1   298 use namespace::clean;
  1         2  
  1         5  
8              
9             around new => sub {
10             my $orig = shift;
11             my $class = shift;
12             my $self = $class->$orig(@_);
13 1     1   6 open my $fh, '>', \($self->{__buffer} = '') or die;
  1         1  
  1         7  
14             $self->{__real_output_fh} = $self->{output_fh};
15             $self->{output_fh} = $fh;
16             return $self;
17             };
18              
19             around output_fh => sub {
20             my $orig = shift;
21             my $self = shift;
22             if (@_) {
23             $self->{__real_output_fh} = $_[0];
24             }
25             else {
26             return $self->{__real_output_fh};
27             }
28             };
29              
30             around output_string => sub {
31             my $orig = shift;
32             my $self = shift;
33             return $self->$orig(@_)
34             if !@_;
35              
36             local $self->{output_fh} = $self->{__real_output_fh};
37             my $output = $self->$orig(@_);
38             $self->{__real_output_fh} = $self->{output_fh};
39             return $output;
40             };
41              
42             sub pre_process {
43 26     26 1 165 my ($self, $content) = @_;
44 26         365 return $content;
45             }
46              
47             sub post_process {
48 2     2 1 4 my ($self, $output) = @_;
49 2         5 return $output;
50             }
51              
52             after end_Document => sub {
53             my ($self) = @_;
54             my $full_content = $self->{__buffer};
55             $self->{__buffer} = '';
56             print { $self->{__real_output_fh} } $self->post_process($full_content);
57             };
58              
59             before emit => sub {
60             my $self = shift;
61             $self->{scratch} = $self->pre_process($self->{scratch});
62             };
63              
64             after reinit => sub {
65             my $self = shift;
66             $self->{__buffer} = '';
67             };
68              
69             1;
70             __END__