File Coverage

blib/lib/HTML/FormatMarkdown.pm
Criterion Covered Total %
statement 137 147 93.2
branch 31 52 59.6
condition 1 2 50.0
subroutine 30 30 100.0
pod 0 26 0.0
total 199 257 77.4


line stmt bran cond sub pod time code
1             package HTML::FormatMarkdown;
2              
3             # ABSTRACT: Format HTML as Markdown
4              
5              
6 2     2   1616 use 5.006_001;
  2         36  
7 2     2   9 use strict;
  2         2  
  2         70  
8 2     2   9 use warnings;
  2         4  
  2         102  
9              
10 2     2   429 use parent 'HTML::Formatter';
  2         269  
  2         16  
11              
12             our $VERSION = '2.15'; # TRIAL VERSION
13             our $AUTHORITY = 'cpan:NIGELM'; # AUTHORITY
14              
15             sub default_values {
16 6     6 0 28 ( shift->SUPER::default_values(),
17             lm => 0,
18             rm => 70,
19             );
20             }
21              
22             sub configure {
23 2     2 0 4 my ( $self, $hash ) = @_;
24              
25 2         9 my $lm = $self->{lm};
26 2         3 my $rm = $self->{rm};
27              
28 2 50       8 $lm = delete $hash->{lm} if exists $hash->{lm};
29 2 50       8 $lm = delete $hash->{leftmargin} if exists $hash->{leftmargin};
30 2 50       7 $rm = delete $hash->{rm} if exists $hash->{rm};
31 2 50       5 $rm = delete $hash->{rightmargin} if exists $hash->{rightmargin};
32              
33 2         4 my $width = $rm - $lm;
34 2 50       5 if ( $width < 1 ) {
35 0 0       0 warn "Bad margins, ignored" if $^W;
36 0         0 return;
37             }
38 2 50       4 if ( $width < 20 ) {
39 0 0       0 warn "Page probably too narrow" if $^W;
40             }
41              
42 2         7 for ( keys %$hash ) {
43 0 0       0 warn "Unknown configure option '$_'" if $^W;
44             }
45              
46 2         2 $self->{lm} = $lm;
47 2         2 $self->{rm} = $rm;
48 2         4 $self;
49             }
50              
51             sub begin {
52 4     4 0 9 my $self = shift;
53              
54 4         33 $self->SUPER::begin();
55 4         8 $self->{maxpos} = 0;
56 4         28 $self->{curpos} = 0; # current output position.
57             }
58              
59             sub end {
60 4     4 0 15 shift->collect("\n");
61             }
62              
63             sub header_start {
64 2     2 0 3 my ( $self, $level ) = @_;
65              
66 2         10 $self->vspace(1);
67 2         10 $self->out( '#' x $level . ' ' );
68 2         6 1;
69             }
70              
71             sub header_end {
72 2     2 0 3 my ( $self, $level ) = @_;
73              
74 2         8 $self->out( ' ' . '#' x $level );
75 2         6 $self->vspace(1);
76             }
77              
78             sub bullet {
79 4     4 0 47 my $self = shift;
80              
81 4         13 $self->SUPER::bullet( $_[0] . ' ' );
82              
83             }
84              
85             sub hr_start {
86 1     1 0 2 my $self = shift;
87              
88 1         3 $self->vspace(1);
89 1         3 $self->out('- - -');
90 1         3 $self->vspace(1);
91             }
92              
93             sub img_start {
94 1     1 0 4 my ( $self, $node ) = @_;
95              
96 1   50     6 my $alt = $node->attr('alt') || '';
97 1         30 my $src = $node->attr('src');
98              
99 1         20 $self->out("![$alt]($src)");
100             }
101              
102             sub a_start {
103 2     2 0 5 my ( $self, $node ) = @_;
104              
105             # ignore named anchors
106 2 50       11 if ( $node->attr('name') ) {
    50          
107 0         0 1;
108             }
109             elsif ( $node->attr('href') =~ /^#/ ) {
110 0         0 1;
111             }
112             else {
113 2         60 $self->out("[");
114 2         8 1;
115             }
116             }
117              
118             sub a_end {
119 2     2 0 6 my ( $self, $node ) = @_;
120              
121 2 50       10 if ( $node->attr('name') ) {
    50          
122 0         0 return;
123             }
124             elsif ( my $href = $node->attr('href') ) {
125 2 50       68 if ( $href =~ /^#/ ) {
126 0         0 return;
127             }
128 2         11 $self->out("]($href)");
129             }
130             }
131              
132 1     1 0 3 sub b_start { shift->out("**") }
133 1     1 0 6 sub b_end { shift->out("**") }
134 1     1 0 2 sub i_start { shift->out("*") }
135 1     1 0 3 sub i_end { shift->out("*") }
136              
137             sub tt_start {
138 1     1 0 2 my $self = shift;
139              
140 1 50       4 if ( $self->{pre} ) {
141 0         0 return 1;
142             }
143             else {
144 1         3 $self->out("`");
145             }
146             }
147              
148             sub tt_end {
149 1     1 0 28 my $self = shift;
150              
151 1 50       4 if ( $self->{pre} ) {
152 0         0 return;
153             }
154             else {
155 1         3 $self->out("`");
156             }
157             }
158              
159             sub blockquote_start {
160 1     1 0 2 my $self = shift;
161              
162 1         2 $self->{blockquote}++;
163 1         4 $self->vspace(1);
164 1         4 $self->adjust_rm(-4);
165              
166 1         2 1;
167             }
168              
169             sub blockquote_end {
170 1     1 0 2 my $self = shift;
171              
172 1         2 $self->{blockquote}--;
173 1         3 $self->vspace(1);
174 1         2 $self->adjust_rm(+4);
175              
176             }
177              
178             sub blockquote_out {
179 1     1 0 2 my ( $self, $text ) = @_;
180              
181 1         2 $self->nl;
182 1         3 $self->goto_lm;
183              
184 1         1 my $line = "> ";
185 1         2 $self->{curpos} += 2;
186              
187 1         14 foreach my $word ( split /\s/, $text ) {
188 30         29 $line .= "$word ";
189 30 100       47 if ( ( $self->{curpos} + length($line) ) > $self->{rm} ) {
190 4         6 $self->collect($line);
191 4         5 $self->nl;
192 4         6 $self->goto_lm;
193 4         4 $line = "> ";
194 4         6 $self->{curpos} += 2;
195             }
196             }
197              
198 1         5 $self->collect($line);
199 1         8 $self->nl;
200              
201             }
202              
203             # Quoted from HTML::FormatText
204             sub pre_out {
205 1     1 0 2 my $self = shift;
206              
207 1 50       4 if ( defined $self->{vspace} ) {
208 1 50       3 if ( $self->{out} ) {
209 1         5 $self->nl() while $self->{vspace}-- >= 0;
210 1         2 $self->{vspace} = undef;
211             }
212             }
213              
214 1         3 my $indent = ' ' x $self->{lm};
215 1         2 $indent .= ' ' x 4;
216 1         2 my $pre = shift;
217 1         8 $pre =~ s/^/$indent/mg;
218 1         3 $self->collect($pre);
219 1         2 $self->{out}++;
220             }
221              
222             sub out {
223 862     862 0 690 my $self = shift;
224 862         679 my $text = shift;
225              
226 862 100       1922 if ( $text =~ /^\s*$/ ) {
227 423         362 $self->{hspace} = 1;
228 423         660 return;
229             }
230              
231 439 100       638 if ( defined $self->{vspace} ) {
232 27 100       50 if ( $self->{out} ) {
233 25         66 $self->nl while $self->{vspace}-- >= 0;
234             }
235 27         36 $self->goto_lm;
236 27         41 $self->{vspace} = undef;
237 27         29 $self->{hspace} = 0;
238             }
239              
240 439 100       616 if ( $self->{hspace} ) {
241 393 100       511 if ( $self->{curpos} + length($text) > $self->{rm} ) {
242              
243             # word will not fit on line; do a line break
244 46         60 $self->nl;
245 46         61 $self->goto_lm;
246             }
247             else {
248              
249             # word fits on line; use a space
250 347         546 $self->collect(' ');
251 347         318 ++$self->{curpos};
252             }
253 393         316 $self->{hspace} = 0;
254             }
255              
256 439         660 $self->collect($text);
257 439         425 my $pos = $self->{curpos} += length $text;
258 439 100       647 $self->{maxpos} = $pos if $self->{maxpos} < $pos;
259 439         786 $self->{'out'}++;
260             }
261              
262             sub goto_lm {
263 90     90 0 73 my $self = shift;
264              
265 90         85 my $pos = $self->{curpos};
266 90         73 my $lm = $self->{lm};
267 90 100       176 if ( $pos < $lm ) {
268 78         63 $self->{curpos} = $lm;
269 78         191 $self->collect( " " x ( $lm - $pos ) );
270             }
271             }
272              
273             sub nl {
274 102     102 0 86 my $self = shift;
275              
276 102         74 $self->{'out'}++;
277 102         100 $self->{curpos} = 0;
278 102         175 $self->collect("\n");
279             }
280              
281             sub adjust_lm {
282 12     12 0 13 my $self = shift;
283              
284 12         13 $self->{lm} += $_[0];
285 12         15 $self->goto_lm;
286             }
287              
288             sub adjust_rm {
289 2     2 0 5 shift->{rm} += $_[0];
290             }
291              
292             1;
293              
294             __END__