File Coverage

blib/lib/Perl6/Pod/Writer.pm
Criterion Covered Total %
statement 9 52 17.3
branch 1 8 12.5
condition 1 7 14.2
subroutine 3 12 25.0
pod 0 8 0.0
total 14 87 16.0


line stmt bran cond sub pod time code
1             #===============================================================================
2             #
3             # DESCRIPTION: Abstract writer
4             #
5             # AUTHOR: Aliaksandr P. Zahatski,
6             #===============================================================================
7             package Perl6::Pod::Writer;
8             our $VERSION = '0.01';
9 3     3   17 use strict;
  3         6  
  3         82  
10 3     3   18 use warnings;
  3         7  
  3         1723  
11             sub new {
12 2     2 0 4 my $class = shift;
13 2 50 33     17 my $self = bless( ( $#_ == 0 ) ? shift : {@_}, ref($class) || $class );
14 2         8 $self;
15             }
16              
17             sub o {
18 0     0 0   return $_[0]->{out};
19             }
20              
21             sub raw {
22 0     0 0   my $self = shift;
23 0           my $fh = $self->o;
24 0           print $fh @_;
25 0           $self
26             }
27              
28             #http://stackoverflow.com/questions/1091945
29              
30             sub _xml_escape {
31 0     0     my ( $txt ) =@_;
32 0           $txt =~ s/&/&/g;
33 0           $txt =~ s/
34 0           $txt =~ s/>/>/g;
35 0           $txt =~ s/"/"/g;
36 0           $txt =~ s/'/'/g;
37 0           $txt
38             }
39              
40             sub _html_escape {
41 0     0     my ( $txt ) =@_;
42 0           $txt =~ s/&/&/g;
43 0           $txt =~ s/
44 0           $txt =~ s/>/>/g;
45 0           $txt =~ s/"/"/g;
46 0           $txt =~ s/'/'/g;
47 0           $txt
48             }
49              
50              
51             sub raw_print {
52 0     0 0   my $self = shift;
53 0           my $fh = $self->o;
54 0           print $fh @_;
55 0           $self
56             }
57              
58             sub print {
59 0     0 0   my $self = shift;
60 0           my $fh = $self->o;
61 0 0         if (my $type = $self->{escape}) {
62 0           my $str = join ""=>@_;
63 0 0         utf8::encode( $str) if utf8::is_utf8($str);
64 0 0         print $fh ($type eq 'xml') ? _xml_escape($str) : _html_escape($str);
65 0           return $self
66             }
67 0           print $fh @_;
68 0           $self
69             }
70              
71             sub say {
72 0     0 0   my $self = shift;
73 0           my $fh = $self->o;
74 0           print $fh @_;
75 0           print $fh "\n";
76 0           $self
77             }
78              
79             sub start_nesting {
80 0     0 0   my $self = shift;
81 0   0       my $level = shift || 1 ;
82 0           $self->raw('
') for (1..$level);
83             }
84             sub stop_nesting {
85 0     0 0   my $self = shift;
86 0   0       my $level = shift || 1 ;
87 0           $self->raw('') for (1..$level);
88             }
89              
90             1;
91              
92