File Coverage

lib/Loctools/Markdown/Builder/MD.pm
Criterion Covered Total %
statement 71 75 94.6
branch 27 34 79.4
condition 7 9 77.7
subroutine 4 4 100.0
pod 0 3 0.0
total 109 125 87.2


line stmt bran cond sub pod time code
1             package Loctools::Markdown::Builder::MD;
2              
3 1     1   43971 use strict;
  1         3  
  1         875  
4              
5             sub new {
6 76     76 0 14420 my ($class) = @_;
7              
8 76         143 my $self = {};
9 76         144 bless($self, $class);
10              
11 76         172 return $self;
12             }
13              
14             sub build {
15 76     76 0 211 my ($self, $ast) = @_;
16              
17 76         150 my @out;
18              
19 76         148 foreach my $node (@$ast) {
20 201 100       437 if ($node->{kind} eq 'whitespace') {
21 45         97 push @out, $node->{text};
22 45         83 next;
23             }
24              
25 156 100       305 if ($node->{kind} eq 'hr') {
26 7         17 push @out, $node->{text};
27 7         13 next;
28             }
29              
30 149 100       324 if ($node->{kind} eq 'p') {
31 76         172 push @out, wrap($node->{text}, 80);
32 76         152 next;
33             }
34              
35 73 100       162 if ($node->{kind} eq 'html') {
36 11         22 push @out, $node->{text};
37 11         19 next;
38             }
39              
40 62 100       187 if ($node->{kind} =~ m/^h(\d+)$/) {
41 14 100 66     48 if ($node->{context} && $node->{context}->{setext} ne '') {
42 2         6 push @out, $node->{text}, $node->{context}->{setext};
43             } else {
44 12         52 my $prefix = ('#' x $1) . ' ';
45 12         37 push @out, $prefix.$node->{text};
46             }
47 14         29 next;
48             }
49              
50 48 100       103 if ($node->{kind} eq 'pre') {
51 7 100 66     33 if ($node->{context} && $node->{context}->{text} ne '') {
52 4         9 my $fence = $node->{context}->{text};
53 4         30 push @out, $fence.$node->{context}->{info}."\n".$node->{text}."\n".$fence;
54             } else {
55 3         21 my $text = $node->{text};
56 3         17 $text =~ s/\n/\n /sg;
57 3         12 push @out, ' '.$text;
58             }
59 7         16 next;
60             }
61              
62 41 100       102 if ($node->{kind} eq 'li') {
63 32         65 my $builder = Loctools::Markdown::Builder::MD->new;
64 32         70 my $text = $builder->build($node->{children});
65 32         104 my $prefix = $node->{context}->{prefix};
66 32         72 my $padding = ' ' x (length($prefix));
67 32         95 $text =~ s/\n/\n$padding/sg;
68 32         71 push @out, $prefix.$text;
69 32         81 next;
70             }
71              
72 9 50       39 if ($node->{kind} eq 'blockquote') {
73 9         21 my $builder = Loctools::Markdown::Builder::MD->new;
74 9         42 my $text = $builder->build($node->{children});
75 9         27 my $prefix = '> ';
76 9         15 my $padding = '> ';
77 9         50 $text =~ s/\n/\n$padding/sg;
78 9         28 push @out, $prefix.$text;
79 9         28 next;
80             }
81             }
82              
83 76         298 return join("\n", @out);
84             }
85              
86             # Implementation for this function was taken from Serge::Util.
87             sub wrap {
88 116     116 0 232 my ($s, $length) = @_;
89 116 50       233 die "length should be a positive integer" unless $length > 0;
90              
91 116 50       236 return ('') if $s eq '';
92              
93             # Wrap by '\n' explicitly
94 116 100       322 if ($s =~ m{^(.*?)\n(.+)$}s) {
95 20         50 my $a = $1; # if $1 and $2 are used directly, this won't work
96 20         41 my $b = $2;
97 20         55 return wrap($a, $length), wrap($b, $length);
98             }
99              
100             # The following regexp was taken from the Translate Toolkit, file textwrap.py
101 96         1225 my @a = split(/(\s+|[^\s\w]*\w+[a-zA-Z]-(?=\w+[a-zA-Z])|(?<=[\w\!\"\'\&\.\,\?])-{2,}(?=\w))/, $s);
102              
103 96         170 my @lines;
104 96         147 my $accum = '';
105 96         221 while (scalar(@a) > 0) {
106              
107             # Take the next chunk and append the
108             # following whitespace chunk to it, if any
109 249         417 my $chunk = shift @a;
110 249 100 100     861 if (@a > 0 && $a[0] =~ m/^\s*$/) {
111 151         310 $chunk .= shift @a;
112             }
113              
114 249 50       575 if (length($accum) + length($chunk) > $length) {
115 0 0       0 push @lines, $accum if $accum ne '';
116              
117 0         0 while (length($chunk) >= $length) {
118 0         0 push @lines, substr($chunk, 0, $length, '');
119             }
120              
121 0         0 $accum = $chunk;
122             } else {
123 249         631 $accum .= $chunk;
124             }
125             }
126 96 50       271 push @lines, $accum if $accum ne '';
127              
128 96         248 return @lines;
129             }
130              
131              
132             1;