File Coverage

blib/lib/Swim.pm
Criterion Covered Total %
statement 21 72 29.1
branch 1 24 4.1
condition n/a
subroutine 7 15 46.6
pod 0 10 0.0
total 29 121 23.9


line stmt bran cond sub pod time code
1 2     2   56685 use strict; use warnings;
  2     2   10  
  2         45  
  2         7  
  2         3  
  2         60  
2             package Swim;
3 2     2   722 use Pegex::Base;
  2         2984  
  2         5  
4              
5             our $VERSION = '0.1.48';
6              
7             has text => ();
8             has meta => {};
9             has option => {};
10             has debug => 0;
11              
12 2     2   3099 use Pegex::Parser;
  2         16972  
  2         47  
13 2     2   740 use Swim::Grammar;
  2         4  
  2         15  
14              
15             sub convert {
16 1     1 0 3 my ($self, $receiver_class) = @_;
17 1 50       41 eval "require $receiver_class; 1"
18             or die "$@";
19              
20 1         9 my $parser = Pegex::Parser->new(
21             grammar => 'Swim::Grammar'->new,
22             receiver => $receiver_class->new(
23             meta => $self->meta,
24             option => $self->option,
25             ),
26             debug => $self->debug,
27             );
28 1         95 $parser->parse($self->text);
29             }
30              
31             sub to_pod {
32 0     0 0 0 my ($self) = @_;
33 0         0 $self->convert('Swim::Pod');
34             }
35              
36             sub to_md {
37 0     0 0 0 my ($self) = @_;
38 0         0 $self->convert('Swim::Markdown');
39             }
40              
41             sub to_html {
42 1     1 0 132 my ($self) = @_;
43 1         4 $self->convert('Swim::HTML');
44             }
45              
46             sub to_txt {
47 0     0 0   require IPC::Run;
48 0           my ($self) = @_;
49 0           my $in = $self->convert('Swim::Pod');
50 0           my ($out, $err);
51 0           my @cmd = ('pod2text');
52              
53 0 0         IPC::Run::run(\@cmd, \$in, \$out, \$err, IPC::Run::timeout(10))
54             or die "$cmd[0]: $? - $err";
55 0 0         die "$err" if $err;
56              
57 0           $out;
58             }
59              
60             my @months = qw(
61             January February March April May June July
62             August September October November December
63             );
64             sub to_man {
65 0     0 0   my ($self) = @_;
66 0           my $man = $self->get_man;
67 0 0         if ($man =~ /\n\.IX Header "Name"\n(.*) \\- (.*)/) {
68 0           my ($name, $title) = ($1, $2);
69 0           $man =~ s/IO::FILE=IO\(0X\S+\)/$name/g;
70 0           $man =~ s/"User Contributed Perl Documentation"/"$title"/;
71 0           $man =~ s/"perl v5\.\d+\.\d+"/"Generated by Swim v$VERSION"/;
72 0           $man =~ s/"(\d{4})-(\d{2})-\d{2}"/"$months[$2 - 1] $1"/;
73             }
74 0           return $man;
75             }
76              
77             sub to_pdf {
78 0     0 0   require IPC::Run;
79 0           my ($self) = @_;
80 0           my ($in, $out, $err) = $self->get_man;
81 0           my @cmd = ('groffer', '--pdf', '--to-stdout');
82 0 0         IPC::Run::run(\@cmd, \$in, \$out, \$err, IPC::Run::timeout(10))
83             or die "$cmd[0]: $? - $err";
84 0 0         die "$err" if $err;
85 0           $out;
86             }
87              
88             sub to_dvi {
89 0     0 0   require IPC::Run;
90 0           my ($self) = @_;
91 0           my ($in, $out, $err) = $self->get_man;
92 0           my @cmd = ('groffer', '--dvi', '--to-stdout');
93 0 0         IPC::Run::run(\@cmd, \$in, \$out, \$err, IPC::Run::timeout(10))
94             or die "$cmd[0]: $? - $err";
95 0 0         die "$err" if $err;
96 0           $out;
97             }
98              
99             sub to_ps {
100 0     0 0   require IPC::Run;
101 0           my ($self) = @_;
102 0           my ($in, $out, $err) = $self->get_man;
103 0           my @cmd = ('groffer', '--ps', '--to-stdout');
104 0 0         IPC::Run::run(\@cmd, \$in, \$out, \$err, IPC::Run::timeout(10))
105             or die "$cmd[0]: $? - $err";
106 0 0         die "$err" if $err;
107 0           $out;
108             }
109              
110             sub get_man {
111 0     0 0   require IPC::Run;
112 0           my ($self) = @_;
113 0           $self->option->{complete} = 1;
114 0           my $in = $self->convert('Swim::Pod');
115 0           my ($out, $err);
116              
117 0           my @cmd = ('pod2man', '--utf8');
118 0 0         IPC::Run::run(\@cmd, \$in, \$out, \$err, IPC::Run::timeout(10))
119             or die "$0: $? - $err";
120 0 0         die "$err" if $err;
121              
122 0           $out;
123             }
124              
125             1;