File Coverage

lib/Pod/PseudoPod/DOM/Role/LaTeX.pm
Criterion Covered Total %
statement 224 229 97.8
branch 43 56 76.7
condition 2 2 100.0
subroutine 54 56 96.4
pod 0 44 0.0
total 323 387 83.4


line stmt bran cond sub pod time code
1             package Pod::PseudoPod::DOM::Role::LaTeX;
2             # ABSTRACT: an LaTeX formatter role for PseudoPod DOM trees
3              
4 11     11   8587 use strict;
  11         29  
  11         343  
5 11     11   58 use warnings;
  11         22  
  11         273  
6              
7 11     11   55 use Moose::Role;
  11         25  
  11         107  
8 11     11   65587 use File::Basename;
  11         29  
  11         24559  
9              
10             requires 'type';
11             has 'tables', is => 'rw', default => sub { {} };
12             has 'filename', is => 'ro', default => '';
13             has 'emit_environments', is => 'ro', default => sub { {} };
14              
15 11     11 0 136 sub accept_targets { 'latex' }
16              
17             sub add_table
18             {
19 11     11 0 55 my ($self, $table) = @_;
20              
21             # TeX includes are RELATIVE
22 11         409 my $filename = basename($self->filename);
23 11         508 my $tables = $self->tables;
24 11         157 my $count = keys %$tables;
25 11         124 (my $id = $filename)
26 11         1338 =~ s/\.(\w+)$/'_table' . $count . '.tex'/e;
27              
28 11         58 $tables->{$id} = $table;
29 11         44 return $id;
30             }
31              
32             sub emit
33             {
34 3710     3710 0 5874 my $self = shift;
35 3710         108012 my $type = $self->type;
36 3710         7404 my $emit = 'emit_' . $type;
37              
38 3710         10443 $self->$emit( @_ );
39             }
40              
41             sub emit_document
42             {
43 11     11 0 33 my $self = shift;
44 11         58 return $self->emit_kids( document => $self );
45             }
46              
47             sub emit_kids
48             {
49 1300     1300 0 2158 my $self = shift;
50 1300         2042 join '', map { $_->emit( @_ ) } @{ $self->children }
  2962         8010  
  1300         39283  
51             }
52              
53             sub emit_header
54             {
55 88     88 0 169 my $self = shift;
56 88         2719 my $level = $self->level;
57 88         272 my $text = $self->emit_kids;
58 88 100       398 my $suppress = $text =~ s/^\*// ? '*' : '';
59 88 100       2916 my $anchor = $self->anchor ? $self->anchor->emit_anchor : '';
60              
61 88 100       350 return qq|\\chapter${suppress}{$text}\n\n$anchor| if $level == 0;
62              
63 66         240 my $subs = 'sub' x ($level - 1);
64              
65 66         315 return qq|\\${subs}section${suppress}{$text}\n\n$anchor|;
66             }
67              
68             sub emit_plaintext
69             {
70 2015     2015 0 4733 my ($self, %args) = @_;
71 2015 50       62363 my $content = defined $self->content ? $self->content : '';
72              
73 2015 100       4897 if (my $encode = $args{encode})
74             {
75 617         1151 my $method = 'encode_' . $encode;
76 617         2029 return $self->$method( $content, %args );
77             }
78              
79 1398         3851 return $self->encode_text( $content, %args );
80             }
81              
82 44     44 0 325 sub encode_none { return $_[1] }
83              
84             sub encode_split
85             {
86 33     33 0 135 my ($self, $content, %args) = @_;
87 33         65 my $target = $args{target};
88             return join $args{joiner},
89 33         367 map { $self->encode_text( $_ ) } split /\Q$target\E/, $content;
  66         155  
90             }
91              
92             sub encode_index_anchor
93             {
94 187     187 0 390 my ($self, $text) = @_;
95              
96 187         358 $text =~ s/"/""/g;
97 187         413 $text = $self->escape_characters( $text );
98 187         472 $text =~ s/([!|@])/"$1/g;
99              
100 187         690 return $text;
101             }
102              
103             sub encode_label_text
104             {
105 88     88 0 220 my ($self, $text) = @_;
106 88         303 $text =~ s/[^\w:]/-/g;
107              
108 88         646 return $text;
109             }
110              
111             sub encode_verbatim_text
112             {
113 187     187 0 406 my ($self, $text) = @_;
114              
115 187         405 $text = $self->escape_characters( $text );
116 187         427 $text =~ s/--/-\\mbox{}-/g;
117              
118 187         1041 return $text;
119             }
120              
121             sub encode_text
122             {
123 1553     1553 0 3065 my ($self, $text) = @_;
124              
125 1553         3204 $text = $self->escape_characters( $text );
126 1553         2941 $text =~ s/(\\textbackslash)/\$$1\$/g; # add unescaped dollars
127              
128             # use the right beginning quotes
129 1553         2605 $text =~ s/(^|\s)"/$1``/g;
130              
131             # and the right ending quotes
132 1553         2491 $text =~ s/"(\W|$)/''$1/g;
133              
134             # fix the ellipses
135 1553         2569 $text =~ s/\.{3}\s*/\\ldots /g;
136              
137             # fix the ligatures
138 1553 50       4090 $text =~ s/f([fil])/f\\mbox{}$1/g unless $self->{keep_ligatures};
139              
140             # fix emdashes
141 1553         2511 $text =~ s/\s--\s/---/g;
142              
143             # suggest hyphenation points for module names
144 1553         2320 $text =~ s/::/::\\-/g;
145              
146 1553         9206 return $text;
147             }
148              
149             sub escape_characters
150             {
151 1927     1927 0 3410 my ($self, $text) = @_;
152              
153             # Escape LaTeX-specific characters
154 1927         3969 $text =~ s/([{}])/\\$1/g;
155 1927         3403 $text =~ s/\\(?![{}])/\\textbackslash{}/g; # backslashes are special
156 1927         3802 $text =~ s/([#\$&%_])/\\$1/g;
157 1927         3047 $text =~ s/(\^)/\\char94{}/g; # carets are special
158 1927         2951 $text =~ s/</\\textless{}/g;
159 1927         3190 $text =~ s/>/\\textgreater{}/g;
160 1927         2994 $text =~ s/~/\\textasciitilde{}/g;
161 1927         2914 $text =~ s/'/\\textquotesingle{}/g;
162              
163 1927         3870 return $text;
164             }
165              
166             sub emit_literal
167             {
168 11     11 0 31 my $self = shift;
169              
170 11 50       340 if (my $title = $self->title)
171             {
172 11         45 my $target = $title->emit_kids( encode => 'none' );
173             return join "\n\n",
174             map
175             {
176 11         55 $_->emit_kids(
177             encode => 'split', target => $target, joiner => "\\\\\n"
178             )
179 11         37 } @{ $self->children };
  11         346  
180             }
181              
182             return qq||
183 0         0 . join( "\\\\\n", map { $_->emit_kids( @_ ) } @{ $self->children } )
  0         0  
  0         0  
184             . qq|\n|;
185             }
186              
187             sub emit_anchor
188             {
189 44     44 0 130 my $self = shift;
190 44         145 return '\\label{' . $self->emit_kids( encode => 'label_text' ) . qq|}\n\n|;
191             }
192              
193             sub emit_italics
194             {
195 110     110 0 199 my $self = shift;
196 110         292 return '\\emph{' . $self->emit_kids( @_ ) . '}';
197             }
198              
199             sub emit_number_item
200             {
201 33     33 0 68 my $self = shift;
202 33         1160 my $marker = $self->marker;
203 33 50       123 my $number = $marker ? qq| number="$marker"| : '';
204 33         108 return "\\item " . $self->emit_kids( @_ ) . "\n\n";
205             }
206              
207             sub emit_text_item
208             {
209 121     121 0 210 my $self = shift;
210 121         3652 my $kids = $self->children;
211 121 50       423 return qq|\\item[]\n| unless @$kids;
212              
213 121         341 my $first = (shift @$kids)->emit;
214 121 100       582 my $prelude = $first =~ /\D/
215             ? q|\\item[] | . $first
216             : qq|\\item[$first]|;
217              
218 121         13101 return $prelude . "\n\n" . join( '', map { $_->emit } @$kids );
  88         267  
219             }
220              
221             sub emit_bullet_item
222             {
223 99     99 0 175 my $self = shift;
224 99         2957 my $kids = $self->children;
225 99 50       259 return qq|\\item\n| unless @$kids;
226              
227 99         254 return q|\\item | . join( '', map { $_->emit } @$kids ) . qq|\n\n|;
  110         287  
228             }
229              
230             sub emit_code
231             {
232 121     121 0 323 my ($self, %args) = @_;
233 121         303 my $kids = $self->emit_kids( encode => 'verbatim_text' );
234 121         652 my $tag = '\\texttt{' . $kids . '}';
235              
236 121   100     554 $args{encode} ||= '';
237 121 100       422 return $tag unless $args{encode} =~ /^index_/;
238 55         222 return $kids . '@' . $tag;
239             }
240              
241             sub emit_footnote
242             {
243 11     11 0 29 my $self = shift;
244 11         60 return '\\footnote{' . $self->emit_kids( @_ ) . '}';
245             }
246              
247             sub emit_url
248             {
249 11     11 0 31 my $self = shift;
250 11         51 return q|\\url{| . $self->emit_kids( encode => 'verbatim_text' ) . '}';
251             }
252              
253             sub emit_link
254             {
255 44     44 0 94 my $self = shift;
256 44         137 return qq|\\ppodxref{| . $self->emit_kids( encode => 'label_text' ). q|}|;
257             }
258              
259             sub emit_superscript
260             {
261 11     11 0 36 my $self = shift;
262 11         57 return '$^{' . $self->emit_kids( @_ ) . '}$';
263             }
264              
265             sub emit_subscript
266             {
267 11     11 0 35 my $self = shift;
268 11         50 return '$_{' . $self->emit_kids( @_ ) . '}$';
269             }
270              
271             sub emit_bold
272             {
273 22     22 0 61 my $self = shift;
274 22         86 return '\\textbf{' . $self->emit_kids( @_ ) . '}';
275             }
276              
277             sub emit_file
278             {
279 22     22 0 48 my $self = shift;
280 22         87 return '\\emph{' . $self->emit_kids( @_ ) . '}';
281             }
282              
283             sub emit_paragraph
284             {
285 385     385 0 642 my $self = shift;
286 385         569 my $has_visible_text = grep { $_->type ne 'index' } @{ $self->children };
  1199         32663  
  385         11590  
287 385 50       1010 return $self->emit_kids( @_ ) . ( $has_visible_text ? "\n\n" : '' );
288             }
289              
290 11     11   107 use constant { BEFORE => 0, AFTER => 1 };
  11         36  
  11         3019  
291             my $escapes = "commandchars=\\\\\\{\\}";
292              
293             my %parent_items =
294             (
295             text_list => [ qq|\\begin{description}\n\n|,
296             qq|\\end{description}| ],
297             bullet_list => [ qq|\\begin{itemize}\n\n|,
298             qq|\\end{itemize}| ],
299             number_list => [ qq|\\begin{enumerate}\n\n|,
300             qq|\\end{enumerate}| ],
301             map { $_ => [ qq|\\begin{$_}\n|, qq|\\end{$_}\n\n| ] }
302             qw( epigraph blockquote )
303             );
304              
305             while (my ($tag, $values) = each %parent_items)
306             {
307             my $sub = sub
308             {
309 0     0   0 my $self = shift;
  99     99   190  
        99      
        99      
        99      
        99      
310 0         0 return $values->[BEFORE]
  99         296  
311             . $self->emit_kids( @_ )
312             . $values->[AFTER] . "\n\n";
313             };
314              
315 11     11   128 do { no strict 'refs'; *{ 'emit_' . $tag } = $sub };
  11         26  
  11         18540  
316             }
317              
318             sub emit_programlisting
319             {
320 11     11 0 31 my $self = shift;
321              
322             # should be only a single Verbatim; may need to fix with hoisting
323 11         416 my $kid = $self->children->[0];
324              
325 11         387 return qq|\\begin{CodeListing}\n|
326             . $kid->emit_kids( encode => 'verbatim_text' )
327             . qq|\n\\end{CodeListing}\n|;
328             }
329              
330             sub emit_verbatim
331             {
332 11     11 0 34 my $self = shift;
333 11         66 return qq|\\begin{Verbatim}[$escapes]\n|
334             . $self->emit_kids( encode => 'verbatim_text' )
335             . qq|\n\\end{Verbatim}\n|;
336             }
337              
338             sub emit_screen
339             {
340 11     11 0 32 my $self = shift;
341             # should be only a single Verbatim; may need to fix with hoisting
342 11         352 my $kid = $self->children->[0];
343              
344 11         58 return qq|\\begin{Screen}\n|
345             . $kid->emit_kids( encode => 'verbatim_text' )
346             . qq|\n\\end{Screen}\n|;
347             }
348              
349             my %characters = (
350             acute => sub { qq|\\'| . shift },
351             grave => sub { qq|\\`| . shift },
352             uml => sub { qq|\\"| . shift },
353             cedilla => sub { '\c{' . shift . '}' }, # cedilla
354             opy => sub { '\copyright' }, # copy
355             dash => sub { '---' }, # mdash
356             lusmn => sub { '\pm' }, # plusmn
357             mp => sub { '\&' }, # amp
358             rademark => sub { '\texttrademark' }
359             );
360              
361             sub emit_character
362             {
363 110     110 0 193 my $self = shift;
364              
365 110         198 my $content = eval { $self->emit_kids( @_ ) };
  110         306  
366 110 50       300 return unless defined $content;
367              
368 110 50       571 if (my ($char, $class) = $content =~ /(\w)(\w+)/)
369             {
370 110 100       481 return $characters{$class}->($char) if exists $characters{$class};
371             }
372              
373 33         161 return Pod::Escapes::e2char( $content );
374             }
375              
376             sub emit_index
377             {
378 154     154 0 266 my $self = shift;
379              
380 154         225 my $content;
381 154         256 for my $kid (@{ $self->children })
  154         4754  
382             {
383 242 100       7094 if ($kid->type eq 'plaintext')
384             {
385 165         411 my $kid_content = $kid->emit( encode => 'index_anchor' );
386 165         525 $kid_content =~ s/\s*;\s*/!/g;
387 165         419 $content .= $kid_content;
388             }
389             else
390             {
391 77         229 $content .= $kid->emit( encode => 'index_anchor' );
392             }
393             }
394              
395 154         918 $content =~ s/^\s+|\s+$//g;
396              
397 154         511 return '\\index{' . $content . '}';
398             }
399              
400             sub emit_latex
401             {
402 22     22 0 53 my $self = shift;
403 22         80 return $self->emit_kids( encode => 'none' ) . "\n";
404             }
405              
406             sub emit_block
407             {
408 78     78 0 150 my $self = shift;
409 78 100       2374 my $title = $self->title ? $self->title->emit_kids( encode => 'text' ) :'';
410 78         2550 my $target = $self->target;
411              
412 78 100       2561 if (my $environment = $self->emit_environments->{$target})
    100          
413             {
414 1         3 $target = $environment;
415             }
416             elsif (my $meth = $self->can( 'emit_' . $target))
417             {
418 66         256 return $self->$meth( @_ );
419             }
420              
421 12         385 return $self->make_basic_block( $self->target, $title, @_ );
422             }
423              
424             sub make_basic_block
425             {
426 14     14 0 63 my ($self, $target, $title, @rest) = @_;
427              
428 14 100       79 $title = defined $title ? qq|[$title]| : '';
429              
430 14         80 return qq|\\begin{$target}$title\{\n|
431             . $self->emit_kids( @rest )
432             . qq|}\\end{$target}\n|;
433             }
434              
435       0 0   sub encode_E_contents {}
436              
437             sub emit_sidebar
438             {
439 22     22 0 53 my $self = shift;
440 22         717 my $title = $self->title;
441 22         735 my $env = $self->emit_environments;
442              
443             return $self->make_basic_block( $env->{sidebar}, $title, @_ )
444 22 100       91 if exists $env->{sidebar};
445              
446 20 100       67 if ($title)
447             {
448 10         65 $title = <<END_TITLE;
449             \\begin{center}
450             \\large{\\bfseries{$title}}
451             \\end{center}
452             END_TITLE
453             }
454             else
455             {
456 10         28 $title = '';
457             }
458              
459 20         109 return <<END_HEADER . $self->emit_kids( @_ ) . <<END_FOOTER;
460             \\begin{figure}[H]
461             \\begin{center}
462             \\begin{Sbox}
463             \\begin{minipage}{\\linewidth}
464             $title
465             END_HEADER
466             \\end{minipage}
467             \\end{Sbox}
468             \\framebox{\\TheSbox}
469             \\end{center}
470             \\end{figure}
471             END_FOOTER
472              
473             }
474              
475             sub emit_table
476             {
477 11     11 0 46 my ($self, %args) = @_;
478 11 50       411 my $title = $self->title
479             ? $self->title->emit_kids( encode => 'text' )
480             : '';
481 11         131 my $num_cols = $self->num_cols;
482 11         68 my $width = 1.0 / $num_cols;
483 11         49 my $cols = join ' | ', map { 'X' } 1 .. $num_cols;
  22         78  
484              
485 11         45 my $document = $args{document};
486 11 50       66 my $caption = length $title
487             ? "\\caption{" . $title . "}\n"
488             : '';
489              
490 11         40 my $start = "\\begin{longtable}{| $cols |}\n";
491 11         36 my $end = "$caption\\end{longtable}\n";
492 11         55 my $id = $document->add_table( $start . $self->emit_kids( @_ ) . $end );
493              
494 11         79 return <<TABLE_REFERENCE;
495             \\begin{center}
496             \\LTXtable{\\linewidth}{$id}
497             \\end{center}
498             TABLE_REFERENCE
499             }
500              
501             sub emit_headrow
502             {
503 11     11 0 35 my $self = shift;
504 11         55 my $row = $self->emit_row;
505 11         95 $row =~ s{(\\hline\n)$}{\\endhead$1}s;
506 11         71 return "\\hline\n\\rowcolor[gray]{.9}\n$row";
507             }
508              
509             sub emit_row
510             {
511 33     33 0 64 my $self = shift;
512 33         61 my $contents = join ' & ', map { $_->emit } @{ $self->children };
  66         200  
  33         1040  
513 33         213 return $contents . "\\\\\\hline\n";
514             }
515              
516             sub emit_cell
517             {
518 66     66 0 123 my $self = shift;
519 66         111 my @contents;
520              
521 66         102 for my $child (@{ $self->children })
  66         1998  
522             {
523 99         293 my $contents = $child->emit( @_ );
524 99         243 $contents =~ s/\n+$//g;
525 99 100       354 next unless $contents =~ /\S/;
526 66         186 push @contents, $contents;
527             }
528              
529 66         286 return join '\\newline\\newline ', @contents;
530             }
531              
532             sub emit_figure
533             {
534 11     11 0 36 my $self = shift;
535 11         1248 my $caption = $self->caption;
536 11 50       76 $caption = defined $caption
537             ? '\\caption{' . $self->encode_text( $caption ) . "}\n"
538             : '';
539              
540 11         111 my $anchor = $self->anchor;
541 11 50       68 $anchor = defined $anchor ? $anchor->emit : '';
542              
543 11         100 my $file = $self->file->emit_kids( encode => 'none' );
544              
545 11         65 return <<END_FIGURE;
546             \\begin{figure}[H]
547             \\centering
548             \\includegraphics[width=\\linewidth]{$file}
549             $caption$anchor\\end{figure}
550             END_FIGURE
551             }
552              
553             1;
554              
555             __END__
556              
557             =pod
558              
559             =encoding UTF-8
560              
561             =head1 NAME
562              
563             Pod::PseudoPod::DOM::Role::LaTeX - an LaTeX formatter role for PseudoPod DOM trees
564              
565             =head1 VERSION
566              
567             version 1.20210620.2004
568              
569             =head1 AUTHOR
570              
571             chromatic <chromatic@wgz.org>
572              
573             =head1 COPYRIGHT AND LICENSE
574              
575             This software is copyright (c) 2021 by chromatic.
576              
577             This is free software; you can redistribute it and/or modify it under
578             the same terms as the Perl 5 programming language system itself.
579              
580             =cut