File Coverage

blib/lib/Text/Amuse/Output.pm
Criterion Covered Total %
statement 724 754 96.0
branch 340 398 85.4
condition 84 126 66.6
subroutine 82 84 97.6
pod 38 38 100.0
total 1268 1400 90.5


line stmt bran cond sub pod time code
1             package Text::Amuse::Output;
2 43     43   61446 use strict;
  43         85  
  43         2493  
3 43     43   213 use warnings;
  43         105  
  43         1074  
4 43     43   709 use utf8;
  43         83  
  43         1525  
5 43     43   17063 use Text::Amuse::Output::Image;
  43         106  
  43         1224  
6 43     43   16707 use Text::Amuse::InlineElement;
  43         101  
  43         1422  
7 43     43   300 use Text::Amuse::Utils;
  43         91  
  43         901  
8             # use Data::Dumper::Concise;
9 43     43   220 use constant DEBUG => 0;
  43         90  
  43         77968  
10              
11             =head1 NAME
12              
13             Text::Amuse::Output - Internal module for L output
14              
15             =head1 SYNOPSIS
16              
17             The module is used internally by L, so everything here is
18             pretty much internal only (and underdocumented).
19              
20             =head2 Basic LaTeX preamble
21              
22             \documentclass[DIV=9,fontsize=10pt,oneside,paper=a5]{scrbook}
23             \usepackage{graphicx}
24             \usepackage{alltt}
25             \usepackage{verbatim}
26             \usepackage[hyperfootnotes=false,hidelinks,breaklinks=true]{hyperref}
27             \usepackage{bookmark}
28             \usepackage[stable]{footmisc}
29             \usepackage{enumerate}
30             \usepackage{longtable}
31             \usepackage[normalem]{ulem}
32             \usepackage{wrapfig}
33              
34             % avoid breakage on multiple

and avoid the next [] to be eaten
35             \newcommand*{\forcelinebreak}{~\\\relax}
36             % this also works
37             % \newcommand*{\forcelinebreak}{\strut\\{}}
38              
39             \newcommand*{\hairline}{%
40             \bigskip%
41             \noindent \hrulefill%
42             \bigskip%
43             }
44              
45             % reverse indentation for biblio and play
46              
47             \newenvironment{amusebiblio}{
48             \leftskip=\parindent
49             \parindent=-\parindent
50             \bigskip
51             \indent
52             }{\bigskip}
53              
54             \newenvironment{amuseplay}{
55             \leftskip=\parindent
56             \parindent=-\parindent
57             \bigskip
58             \indent
59             }{\bigskip}
60              
61             \newcommand{\Slash}{\slash\hspace{0pt}}
62              
63             =head1 CONSTRUCTORS
64              
65             =over 4
66              
67             =item Text::Amuse::Output->new(document => $obj, format => "ltx")
68              
69             Constructor. Format can be C or C, while document must be a
70             L object.
71              
72             =cut
73              
74             sub new {
75 819     819 1 11846 my $class = shift;
76 819         2823 my %opts = @_;
77 819 50       2723 die "Missing document object!\n" unless $opts{document};
78             die "Missing or wrong format!\n" unless ($opts{format} and ($opts{format} eq 'ltx' or
79 819 50 66     5633 $opts{format} eq 'html'));
      66        
80             my $self = { document => $opts{document},
81 819         3148 fmt => $opts{format} };
82 819 100 66     6801 if (ref($self->{document}) and $self->{document}->can('language_code')) {
83 818         3185 $self->{_lang} = $self->{document}->language_code;
84             }
85 819         4268 bless $self, $class;
86             }
87              
88             =back
89              
90             =head1 METHODS
91              
92             =over 4
93              
94             =item _lang
95              
96             =cut
97              
98 34695     34695   108795 sub _lang { shift->{_lang} };
99              
100             =item document
101              
102             Accessor to the L object (read-only, but you
103             may call its method on that.
104              
105             =cut
106              
107             sub document {
108 3593     3593 1 10529 return shift->{document};
109             }
110              
111             =item fmt
112              
113             Accessor to the current format (read-only);
114              
115             =cut
116              
117             sub fmt {
118 107720     107720 1 215042 return shift->{fmt};
119             }
120              
121             =item is_html
122              
123             True if the format is html
124              
125             =item is_latex
126              
127             True if the format is latex
128              
129             =cut
130              
131             sub is_latex {
132 2391     2391 1 3728 return shift->fmt eq 'ltx';
133             }
134              
135             sub is_html {
136 8108     8108 1 13003 return shift->fmt eq 'html';
137             }
138              
139             =item process
140              
141             This method returns a array ref with the processed chunks. To get
142             a sensible output you will have to join the pieces yourself.
143              
144             We don't return a joined string to avoid copying large amounts of
145             data.
146              
147             my $splat_pages = $obj->process(split => 1);
148             foreach my $html (@$splat_pages) {
149             # ...templating here...
150             }
151              
152             If the format is C, the option C may be passed. Instead
153             of a arrayref of chunks, an arrayref with html pages will be
154             returned. Each page usually starts with an heading, and it's without
155             . Footnotes are flushed and inserted at the end of each
156             pages.
157              
158             E.g.
159              
160             print @{$obj->process};
161              
162             =cut
163              
164             sub process {
165 1023     1023 1 3099 my ($self, %opts) = @_;
166 1023         1873 my (@pieces, @splat);
167 1023         1927 my $split = $opts{split};
168 1023         3036 my $imagere = $self->image_re;
169 1023         4034 $self->reset_toc_stack;
170             # loop over the parsed elements
171 1023         2700 foreach my $el ($self->document->elements) {
172 34258 100       68376 if ($el->type eq 'null') {
173 12778 50       22435 push @pieces, $self->format_anchors($el) if $el->anchors;
174 12778         21714 next;
175             }
176 21480 100       38840 if ($el->type eq 'startblock') {
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    50          
177 4874 50       8931 die "startblock with string passed!: " . $el->string if $el->string;
178 4874         9593 push @pieces, $self->blkstring(start => $el->block,
179             start_list_index => $el->start_list_index,
180             language => $el->language,
181             ),
182             $self->format_anchors($el);
183             }
184             elsif ($el->type eq 'stopblock') {
185 4874 50       8556 die "stopblock with string passed!:" . $el->string if $el->string;
186 4874         8221 push @pieces, $self->format_anchors($el), $self->blkstring(stop => $el->block);
187             }
188             elsif ($el->type eq 'regular') {
189             # manage the special markup
190 8482 100 66     15746 if ($el->string =~ m/\A\s*-----*\s*\z/s) {
    100          
191 48         162 push @pieces, $self->manage_hr($el), $self->format_anchors($el);
192             }
193             # an image by itself, so avoid it wrapping with

,
194             # but only if just 1 is found. With multiple one, we get
195             # incorrect output anyway, so who cares?
196             elsif ($el->string =~ m/\A\s*\[\[\s*$imagere\s*\]
197             (\[[^\]\[]+?\])?\]\s*\z/sx and
198             $el->string !~ m/\[\[.*\[\[/s) {
199 380         905 push @pieces, $self->format_anchors($el), $self->manage_regular($el);
200             }
201             else {
202 8054         18405 push @pieces, $self->manage_paragraph($el);
203             }
204             }
205             elsif ($el->type eq 'standalone') {
206 29         56 push @pieces, $self->manage_regular($el);
207             }
208             elsif ($el->type eq 'dt') {
209 285         648 push @pieces, $self->manage_regular($el);
210             }
211             elsif ($el->is_header) {
212             # if we want a split html, we cut here and flush the footnotes
213 1691 100 100     3058 if ($el->type =~ m/h[1-4]/ and $split and @pieces) {
      100        
214            
215 755 100       1760 if ($self->is_html) {
216 547         1297 foreach my $fn ($self->flush_footnotes) {
217 176         396 push @pieces, $self->manage_html_footnote($fn);
218             }
219 547         1217 foreach my $nested ($self->flush_secondary_footnotes) {
220 66         173 push @pieces, $self->manage_html_footnote($nested);
221             }
222 547 50       952 die "Footnotes still in the stack!" if $self->flush_footnotes;
223 547 50       834 die "Secondary footnotes still in the stack!" if $self->flush_secondary_footnotes;
224             }
225 755         4713 push @splat, join("", @pieces);
226 755         1859 @pieces = ();
227             # all done
228             }
229              
230             # then continue as usual
231 1691         4489 push @pieces, $self->manage_header($el);
232             }
233             elsif ($el->type eq 'verse') {
234 296         687 push @pieces, $self->format_anchors($el), $self->manage_verse($el);
235             }
236             elsif ($el->type eq 'inlinecomment') {
237 138         378 push @pieces, $self->manage_inline_comment($el);
238             }
239             elsif ($el->type eq 'comment') {
240 70         207 push @pieces, $self->manage_comment($el);
241             }
242             elsif ($el->type eq 'table') {
243 220         579 push @pieces, $self->format_anchors($el), $self->manage_table($el);
244             }
245             elsif ($el->type eq 'example') {
246 450         1156 push @pieces, $self->format_anchors($el), $self->manage_example($el);
247             }
248             elsif ($el->type eq 'newpage') {
249 71         186 push @pieces, $self->manage_newpage($el), $self->format_anchors($el);
250             }
251             else {
252 0         0 die "Unrecognized element: " . $el->type;
253             }
254             }
255 1023 100       6538 if ($self->is_html) {
256 661         2347 foreach my $fn ($self->flush_footnotes) {
257 354         846 push @pieces, $self->manage_html_footnote($fn);
258             }
259 661         2233 foreach my $nested ($self->flush_secondary_footnotes) {
260 62         155 push @pieces, $self->manage_html_footnote($nested);
261             }
262 661 50       1339 die "Footnotes still in the stack!" if $self->flush_footnotes;
263 661 50       1372 die "Secondary footnotes still in the stack!" if $self->flush_secondary_footnotes;
264             }
265              
266 1023 100       2338 if ($split) {
267             # catch the last
268 324         3376 push @splat, join("", @pieces);
269             # and return
270 324         3322 return \@splat;
271             }
272 699         5982 return \@pieces;
273             }
274              
275             =item header
276              
277             Return the formatted header as an hashref with key/value
278             pairs.
279              
280             =cut
281              
282             sub header {
283 149     149 1 247 my $self = shift;
284 149         410 my %directives = $self->document->raw_header;
285 149         297 my %out;
286 149         590 while (my ($k, $v) = each %directives) {
287 280         577 $out{$k} = $self->manage_regular($v);
288             }
289 149         921 return \%out;
290             }
291              
292             =back
293              
294             =head2 Internal Methods
295              
296             =over 4
297              
298             =item add_footnote($element)
299              
300             Add the footnote to the internal list of found footnotes.
301              
302             =cut
303              
304             sub add_footnote {
305 658     658 1 975 my ($self, $fn) = @_;
306 658 50       1207 return unless defined($fn);
307 658 100       1450 if ($fn->type eq 'footnote') {
    50          
308 530         1092 $self->_add_primary_footnote($fn);
309             }
310             elsif ($fn->type eq 'secondary_footnote') {
311 128         286 $self->_add_secondary_footnote($fn);
312             }
313             else {
314 0         0 die "Wrong element type passed: " . $fn->type . " " . $fn->string;
315             }
316             }
317              
318             sub _add_primary_footnote {
319 530     530   809 my ($self, $fn) = @_;
320 530 100       1083 unless (defined $self->{_fn_list}) {
321 229         528 $self->{_fn_list} = [];
322             }
323 530         662 push @{$self->{_fn_list}}, $fn;
  530         1128  
324             }
325              
326             sub _add_secondary_footnote {
327 128     128   225 my ($self, $fn) = @_;
328 128 100       297 unless (defined $self->{_sec_fn_list}) {
329 57         134 $self->{_sec_fn_list} = [];
330             }
331 128         173 push @{$self->{_sec_fn_list}}, $fn;
  128         308  
332             }
333              
334             =item flush_footnotes
335              
336             Return the list of primary footnotes found as a list of elements.
337              
338             =item flush_secondary_footnotes
339              
340             Return the list of secondary footnotes found as a list of elements.
341              
342             =cut
343              
344             sub flush_footnotes {
345 2416     2416 1 3131 my $self = shift;
346 2416 100       6674 return unless (defined $self->{_fn_list});
347             # if we flush, we flush and forget, so we don't collect them again
348             # on the next call
349 229         354 return sort { $a->footnote_number <=> $b->footnote_number } @{delete $self->{_fn_list}};
  507         1024  
  229         1112  
350             }
351              
352             sub flush_secondary_footnotes {
353 2416     2416 1 3171 my $self = shift;
354             # as above
355 2416 100       6387 return unless (defined $self->{_sec_fn_list});
356 57         95 return sort { $a->footnote_number <=> $b->footnote_number } @{delete $self->{_sec_fn_list}};
  126         263  
  57         286  
357             }
358              
359             =item manage_html_footnote
360              
361             =cut
362              
363             sub manage_html_footnote {
364 658     658 1 1102 my ($self, $element) = @_;
365 658 50       1332 return unless $element;
366 658         1355 my $anchors = $self->format_anchors($element);
367 658         1745 my $fn_num = $element->footnote_index;
368 658         1288 my $fn_symbol = $element->footnote_symbol;
369 658         842 my $class;
370 658 100       1579 if ($element->type eq 'footnote') {
    50          
371 530         833 $class = 'fnline';
372             }
373             elsif ($element->type eq 'secondary_footnote') {
374 128         207 $class = 'secondary-fnline';
375             }
376             else {
377 0         0 die "wrong type " . $element->type . ' ' . $element->string;
378             }
379 658         3207 my $chunk = qq{\n

380             . qq{href="#fn_back${fn_num}" id="fn${fn_num}">$fn_symbol$anchors }
381             . $self->manage_regular($element) .
382             qq{

\n};
383             }
384              
385             =item blkstring
386              
387             =cut
388              
389             sub blkstring {
390 31026     31026 1 54068 my ($self, $start_stop, $block, %attributes) = @_;
391 31026 50 33     79058 die "Wrong usage! Missing params $start_stop, $block"
392             unless ($start_stop && $block);
393 31026 50 66     64285 die "Wrong usage!\n" unless ($start_stop eq 'stop' or
394             $start_stop eq 'start');
395 31026         45218 my $table = $self->blk_table;
396             die "Table is missing an element $start_stop $block "
397 31026 50       63225 unless exists $table->{$block}->{$start_stop}->{$self->fmt};
398 31026         48711 my $string = $table->{$block}->{$start_stop}->{$self->fmt};
399 31026 100       45951 if (ref($string)) {
400 1535         4574 return $string->(%attributes);
401             }
402             else {
403 29491         89916 return $string;
404             }
405             }
406              
407             =item manage_regular($element_or_string, %options)
408              
409             Main routine to transform a string to the given format
410              
411             Options:
412              
413             =over 4
414              
415             =item nolinks
416              
417             If set to true, do not parse the links and consider them plain strings
418              
419             =item anchors
420              
421             If set to true, parse the anchors and return two elements, the first
422             is the processed string, the second is the processed anchors string.
423              
424             =back
425              
426             =item inline_elements($string)
427              
428             Parse the provided string into a list of L
429             objects.
430              
431             =cut
432              
433             sub inline_elements {
434 18214     18214 1 26957 my ($self, $string) = @_;
435 18214 100       43110 return unless length($string);
436 18201         20904 my @list;
437 18201 100       39384 if ($string =~ m{\A\s*\
\s*\z}) {
438 90         262 return Text::Amuse::InlineElement->new(string => $string,
439             type => 'bigskip',
440             last_position => length($string),
441             fmt => $self->fmt,
442             lang => $self->_lang,
443             );
444             }
445 18111         39024 pos($string) = 0;
446 18111         547926 while ($string =~ m{\G # last match
447             (?.*?) # something not greedy, even nothing
448             (?
449             # these are OR, so order matters.
450             # link is the most greedy, as it could have inline markup in the second argument.
451             (? \[\[[^\[].*?\]\]) |
452              
453             # please note: verbatim, code, = =, are
454             # greedy, the first will slurp up to the
455             # next matching. one
456              
457             (? \ .*? \<\/verbatim\> ) |
458             (? \ .*? \<\/code\> ) |
459             (? (?
460             (? \ .+?\|.+? \<\/ruby\>) |
461             (? (?:\<\<\<|\>\>\>) ) |
462             (? \s*\[[1-9][0-9]*\]) |
463             (? \s*\{[1-9][0-9]*\}) |
464             (? \<
465             (?\/?)
466             (? strong | em | strike | del | sup | sub | sf | sc |
467             \[(?[a-z-]+)\]
468             )
469             \>
470             ) |
471             (? \~\~ ) |
472             (?(?:\*\*\*|\*\*|\*) ) |
473             (?
\x{20}*\< br \x{20}* \/?\>)
474             )}gcxms) {
475             # this is a mammuth, but hey
476 43     43   17985 my %captures = %+;
  43         14742  
  43         339715  
  8422         101451  
477 8422         24459 my $text = delete $captures{text};
478 8422         12405 my $raw = delete $captures{raw};
479 8422         14298 my $position = pos($string);
480 8422 100       17834 if (length($text)) {
481 5563         14604 push @list, Text::Amuse::InlineElement->new(string => $text,
482             type => 'text',
483             last_position => $position - length($raw),
484             fmt => $self->fmt,
485             lang => $self->_lang,
486             );
487             }
488 8422         12854 my $inlined_lang = delete $captures{lang};
489 8422 100       14218 if ($inlined_lang) {
490 44         97 $self->document->_add_to_other_language_codes($inlined_lang);
491             }
492 8422   66     15037 my %args = (
493             string => $raw,
494             last_position => $position,
495             fmt => $self->fmt,
496             lang => $inlined_lang || $self->_lang,
497             );
498              
499 8422 100       22727 if (delete $captures{tag}) {
    100          
    50          
500 841         1310 my $close = delete $captures{close};
501 841 100       1858 $args{type} = $close ? 'close' : 'open';
502 841 50       1931 $args{tag} = delete $captures{tag_name} or die "Missing tag_name, this is a bug: <$string>";
503             }
504             elsif (my $tag = delete $captures{inline}) {
505 2085         3342 $args{type} = 'inline';
506 2085         3704 $args{tag} = $tag;
507             }
508             elsif (delete $captures{close_inline}) {
509 0         0 $args{type} = 'close_inline';
510 0 0       0 $args{tag} = delete $captures{close_inline_name} or die "Missing close_inline_name in <$string>";
511             }
512             else {
513 5496         10783 my ($type, @rest) = keys %captures;
514 5496 50       10732 die "Too many keys in <$string> the capture hash: @rest" if @rest;
515 5496         8321 delete $captures{$type};
516 5496         8198 $args{type} = $type;
517 5496 100       11081 if ($type eq 'ruby') {
518 18         32 $self->document->set_has_ruby;
519             }
520             }
521 8422 50       13604 die "Unprocessed captures %captures in <$string>" if %captures;
522 8422         24039 push @list, Text::Amuse::InlineElement->new(%args);
523             }
524 18111 100       41907 my $offset = (@list ? $list[-1]->last_position : 0);
525 18111         37148 my $last_chunk = substr $string, $offset;
526 18111         34661 push @list, Text::Amuse::InlineElement->new(string => $last_chunk,
527             type => 'text',
528             fmt => $self->fmt,
529             lang => $self->_lang,
530             last_position => $offset + length($last_chunk),
531             );
532 18111 50       35697 die "Chunks lost during processing <$string>" unless $string eq join('', map { $_->string } @list);
  32096         54173  
533 18111 100 33     73066 if (@list and $list[0] and $list[0]->type eq 'br') {
      66        
534 32         74 $list[0]->type('noindent');
535             }
536 18111         43396 return @list;
537             }
538              
539             sub manage_regular {
540 18192     18192 1 41788 my ($self, $el, %opts) = @_;
541 18192         20733 my $string;
542 18192         20813 my $insert_primary_footnote = 1;
543 18192         19455 my $insert_secondary_footnote = 1;
544 18192         19632 my $el_object;
545             # we can accept even plain string;
546 18192 100       32020 if (ref($el) eq "") {
547 8256         10340 $string = $el;
548             } else {
549 9936         12520 $el_object = $el;
550 9936         17035 $string = $el->string;
551 9936 100       17555 if ($el->type eq 'footnote') {
    100          
552 919         1312 $insert_primary_footnote = 0;
553             }
554             elsif ($el->type eq 'secondary_footnote') {
555 230         318 $insert_primary_footnote = 0;
556 230         298 $insert_secondary_footnote = 0;
557             }
558             }
559 18192 50       31102 unless (defined $string) {
560 0         0 $string = '';
561             }
562              
563             # we do the processing in more steps. It may be more expensive,
564             # but at least the code should be clearer.
565              
566 18192         32359 my @pieces = $self->inline_elements($string);
567 18192         21922 my @processed;
568 18192         22627 my $current_direction = '';
569             BIDIPROC:
570 18192         30572 while (@pieces) {
571 32058         39407 my $piece = shift @pieces;
572 32058         60199 my %dirs = (
573             '<<<' => 'rtl',
574             '>>>' => 'ltr',
575             );
576 32058 100       53895 if ($piece->type eq 'bidimarker') {
577 90         178 $self->document->set_bidi_document;
578 90 50       169 my $dir = $dirs{$piece->string} or die "Invalid bidimarker " . $piece->string;
579             # we need to close
580 90 100       180 if ($current_direction) {
581 38 50       74 if ($dir ne $current_direction) {
582 38         94 push @processed, Text::Amuse::InlineElement->new(string => '',
583             fmt => $self->fmt,
584             lang => $self->_lang,
585             tag => $current_direction,
586             type => 'close');
587 38         120 $current_direction = '';
588             }
589             else {
590 0         0 warn "$string is trying to set direction to $dir twice!, ignoring\n";
591             }
592             }
593             # we need to open
594             else {
595 52         87 $current_direction = $dir;
596 52         113 push @processed, Text::Amuse::InlineElement->new(string => '',
597             fmt => $self->fmt,
598             lang => $self->_lang,
599             tag => $current_direction,
600             type => 'open');
601             }
602             }
603             else {
604 31968         72064 push @processed, $piece;
605             }
606             }
607 18192 100       30065 if ($current_direction) {
608 14         31 push @processed, Text::Amuse::InlineElement->new(string => '',
609             fmt => $self->fmt,
610             lang => $self->_lang,
611             tag => $current_direction,
612             type => 'close');
613 14         24 $current_direction = '';
614             }
615              
616             # now we decide what to do with the inline elements: either turn
617             # them into open/close tag via unroll, or turn them into regular
618             # text
619              
620             # given the way we parsed the string, we have to do another round
621             # to check if the open/close are legit. This would have been
622             # probably done better with regexp, but we're down this road now
623             # and no turning back.
624              
625             CHECK_LEGIT:
626             {
627 18192         19651 for (my $i = 0; $i <= $#processed; $i++) {
  18192         35034  
628              
629 32072         42422 my $el = $processed[$i];
630 32072 100       49702 if ($el->type eq 'inline') {
631 2077 100 66     6148 if ($i > 0 and $i < $#processed) {
632 1829 100 100     3681 if ($processed[$i - 1]->string =~ m/[[:alnum:]]\z/ and
633             $processed[$i + 1]->string =~ m/\A[[:alnum:]]/) {
634 64         198 $el->type('text');
635 64         214 $el->tag('');
636             }
637             }
638             }
639             }
640             }
641              
642              
643             # print Dumper(\@processed);
644 18192         22628 my @tracking;
645             MARKUP:
646 18192         30202 while (@processed) {
647 32072         37820 my $piece = shift @processed;
648 32072 100       50646 if ($piece->type eq 'inline') {
649 2013 100       3594 my $previous = @pieces ? $pieces[-1] : undef;
650 2013 50       3136 my $next = @processed ? $processed[0] : undef;
651              
652             # first element can only open if there is a next one.
653 2013 100       5603 if (!$previous) {
    50          
654 248 100 50     687 if ($next and
      100        
655 1920         3113 scalar(grep { $_->tag eq $piece->tag } @processed) and
656             $next->string =~ m/\A\S/) {
657 167         260 print "Opening initial " . $piece->string . "\n" if DEBUG;
658 167         485 $piece->type('open_inline');
659 167         310 push @pieces, $piece;
660 167         413 push @tracking, $piece->tag;
661 167         540 next MARKUP;
662             }
663             }
664             elsif (!$next) {
665             # last element, can only close
666 0 0 0     0 if (@tracking and
      0        
667             $piece->tag eq $tracking[-1] and
668             $previous->string =~ m/\S\z/) {
669 0         0 print "Closing final " . $piece->string . "\n" if DEBUG;
670 0         0 $piece->type('close_inline');
671 0         0 push @pieces, $piece;
672 0         0 pop @tracking;
673 0         0 next MARKUP;
674              
675             }
676             }
677             # in the middle.
678             else {
679 1765         1894 print $piece->string . " is in the middle\n" if DEBUG;
680             # print Dumper([ \@processed, \@pieces, \@tracking, $next, $previous ]);
681 1765 100 100     5941 if (@tracking and
    100 100        
      100        
      100        
682             $piece->tag eq $tracking[-1] and
683             $previous->string =~ m/\S\z/) {
684 736 50       1698 if ($previous->type ne 'open_inline') {
685 736         1876 $piece->type('close_inline');
686 736         909 print "Closing " . $piece->string . "\n" if DEBUG;
687 736         1349 push @pieces, $piece;
688 736         1016 pop @tracking;
689 736         2250 next MARKUP;
690             }
691             }
692             elsif ($next->string =~ m/\A\S/ and
693             $previous->string =~ m/[[:^alnum:]]\z/ and
694 4911         8199 scalar(grep { $_->tag eq $piece->tag } @processed)) {
695 596         899 print "Opening " . $piece->string . "\n" if DEBUG;
696 596         1500 $piece->type('open_inline');
697 596         944 push @pieces, $piece;
698 596         1329 push @tracking, $piece->tag;
699 596         1814 next MARKUP;
700             }
701             }
702 514         728 print "Nothing to do for " . $piece->string . "\n" if DEBUG;
703             # default to text
704 514         892 $piece->type('text');
705             }
706 30573         51699 push @pieces, $piece;
707             }
708              
709             # we need to do another pass to assert there is a match. Sometime
710             # I regret to solve everything with s/.+/.../ but
711             # that has other problems.
712              
713 18192         23302 @tracking = ();
714             # print Dumper(\@pieces);
715              
716 18192         23105 my $chomped_string = $string;
717 18192         27462 chomp($chomped_string);
718              
719             my $format_warning = sub {
720 62     62   122 my ($type, $tag) = @_;
721 62         98 my $matching = 'closing';
722 62 100 66     222 if ($type eq 'close' or $type eq 'close_inline') {
723 36         55 $matching = 'opening';
724             }
725 62         5686 return "Found $type tag $tag"
726             . " in <$chomped_string> without a matching $matching tag. "
727             . "Leaving it as-is, but it's unlikely you want this. "
728             . "To suppress this warning, wrap it in \n";
729 18192         76407 };
730              
731             UNROLL:
732 18192         35082 while (@pieces) {
733 32072         38590 my $piece = shift @pieces;
734 32072 100       55433 if ($piece->type eq 'open_inline') {
    100          
735             # check if we have a matching close in the rest of the string
736 763 100       1389 if (grep { $_->type eq 'close_inline' and $_->tag eq $piece->tag } @pieces) {
  6090 100       9661  
737 750         1811 push @tracking, $piece->tag;
738 750         2058 push @processed, $piece->unroll;
739 750         2963 next UNROLL;
740             }
741             else {
742 13         36 warn $format_warning->($piece->type, $piece->tag);
743 13         100 $piece->type('text');
744             }
745             }
746             elsif ($piece->type eq 'close_inline') {
747 736 50 33     2443 if (@tracking and $tracking[-1] eq $piece->tag) {
748 736         1571 push @processed, $piece->unroll;
749 736         1267 pop @tracking;
750 736         2610 next UNROLL;
751             }
752             else {
753 0         0 warn $format_warning->($piece->type, $piece->tag);
754 0         0 $piece->type('text');
755             }
756             }
757 30586         56063 push @processed, $piece;
758             }
759              
760             # print Dumper(\@processed);
761              
762             # now validate the tags: open and close
763 18192         22072 my @tagpile;
764             INLINETAG:
765 18192         29879 while (@processed) {
766 32276         37853 my $piece = shift @processed;
767 32276 100       51458 if ($piece->type eq 'open') {
    100          
768             # look forward for a matching tag
769 1310 100       2319 if (grep { $_->type eq 'close' and $_->tag eq $piece->tag } @processed) {
  12765 100       18979  
770 1297         2842 push @tagpile, $piece->tag;
771             }
772             else {
773 13         33 warn $format_warning->($piece->type, $piece->tag);
774 13         87 $piece->type('text');
775             }
776             }
777             elsif ($piece->type eq 'close') {
778             # check if there is a matching opening
779 1313 100 66     4101 if (@tagpile and $tagpile[-1] eq $piece->tag) {
780             # all match, can go
781             # and remove from the pile
782 1277         1990 pop @tagpile;
783 1277 100 66     2569 if ($pieces[-1]->type eq 'open' and
784             $pieces[-1]->tag eq $piece->tag) {
785 36         46 pop @pieces;
786 36         136 next INLINETAG;
787             }
788             }
789             else {
790 36         80 warn $format_warning->($piece->type, $piece->tag);
791 36         353 $piece->type('text');
792             }
793             }
794 32240         56239 push @pieces, $piece;
795             }
796              
797             # print Dumper(\@pieces);
798              
799 18192         31522 while (@tagpile) {
800 20         41 my $unclosed = pop @tagpile;
801 20         2370 warn "Found unclosed tag $unclosed in string <$string>, closing it\n";
802 20         169 push @pieces, Text::Amuse::InlineElement->new(string => '',
803             fmt => $self->fmt,
804             lang => $self->_lang,
805             tag => $unclosed,
806             type => 'close');
807             }
808              
809             # now we're hopefully set.
810 18192         20918 my @out;
811             CHUNK:
812 18192         29671 while (@pieces) {
813 32224         41401 my $piece = shift @pieces;
814 32224 100       52840 if ($piece->type eq 'link') {
    100          
    100          
815 1774 100       3360 if ($opts{nolinks}) {
816 120         224 $piece->type('text');
817             }
818             else {
819 1654         3493 push @out, $self->linkify($piece->string);
820 1654         6380 next CHUNK;
821             }
822             }
823             elsif ($piece->type eq 'pri_footnote') {
824 1264 100 100     3746 if ($insert_primary_footnote and
825             my $pri_fn = $self->document->get_footnote($piece->string)) {
826 919 100 100     2018 if ($self->is_html and $piece->string =~ m/\A(\s+)/) {
827 511         1055 push @out, $1;
828             }
829 919         2455 push @out, $self->_format_footnote($pri_fn);
830 919         3800 next CHUNK;
831             }
832             else {
833 345         728 $piece->type('text');
834             }
835             }
836             elsif ($piece->type eq 'sec_footnote') {
837 312 100 100     926 if ($insert_secondary_footnote and
838             my $sec_fn = $self->document->get_footnote($piece->string)) {
839 230 100 100     543 if ($self->is_html and $piece->string =~ m/\A(\s+)/) {
840 125         288 push @out, $1;
841             }
842 230         708 push @out, $self->_format_footnote($sec_fn);
843 230         1099 next CHUNK;
844             }
845             else {
846 82         158 $piece->type('text');
847             }
848             }
849 29421         57337 push @out, $piece->stringify;
850             }
851 18192         114192 return join('', @out);
852             }
853              
854             sub _format_footnote {
855 1149     1149   2230 my ($self, $element) = @_;
856 1149 100       2019 if ($self->is_latex) {
    50          
857             # print "Calling manage_regular from format_footnote " . Dumper($element);
858 491         1297 my $footnote = $self->manage_regular($element);
859 491         1382 my $anchors = $self->format_anchors($element);
860 491         5377 $footnote =~ s/\s+/ /gs;
861 491         2800 $footnote =~ s/ +$//s;
862             # covert
to \par in latex. those \\ in the footnotes are
863             # pretty much ugly. Also the syntax doesn't permit to have
864             # multiple paragraphs separated by a blank line in a footnote.
865             # However, this is going to fail with footnotes in the
866             # headings, so we have to call \endgraf instead
867             # https://tex.stackexchange.com/questions/248620/footnote-of-several-paragraphs-length-to-section-title
868 491         1507 $footnote =~ s/\\forcelinebreak /\\protect\\endgraf /g;
869 491 100       1107 if ($element->type eq 'secondary_footnote') {
870 102         411 return '\footnoteB{' . $anchors . $footnote . '}';
871             }
872             else {
873 389         1395 return '\footnote{' . $anchors . $footnote . '}';
874             }
875             } elsif ($self->is_html) {
876             # in html, just remember the number
877 658         1518 $self->add_footnote($element);
878 658         1510 my $fn_num = $element->footnote_index;
879 658         1429 my $fn_symbol = $element->footnote_symbol;
880             return
881 658         3119 qq(
882             qq(id="fn_back${fn_num}">$fn_symbol);
883             }
884             else {
885 0         0 die "Not reached"
886             }
887             }
888              
889             =item safe($string)
890              
891             Be sure that the strings passed are properly escaped for the current
892             format, to avoid command injection.
893              
894             =cut
895              
896             sub safe {
897 1617     1617 1 2753 my ($self, $string) = @_;
898 1617         3063 return Text::Amuse::InlineElement->new(fmt => $self->fmt,
899             lang => $self->_lang,
900             string => $string,
901             type => 'safe')->stringify;
902             }
903              
904              
905             =item manage_paragraph
906              
907             =cut
908              
909              
910             sub manage_paragraph {
911 8093     8093 1 12768 my ($self, $el) = @_;
912 8093         16324 my $body = $self->manage_regular($el);
913 8093         15118 chomp $body;
914 8093         17005 return $self->blkstring(start => "p") . $self->format_anchors($el) . $body . $self->blkstring(stop => "p");
915             }
916              
917             =item manage_header
918              
919             =cut
920              
921             sub manage_header {
922 1691     1691 1 3375 my ($self, $el) = @_;
923             # print Dumper([$el->anchors]);
924              
925 1691         3638 my ($short, $long) = split(/\s+\|\s+/, $el->string, 2);
926 1691 100 66     4543 unless (defined($long) and length($long)) {
927 1653         2439 $long = $short;
928             }
929 1691         2278 my $body_with_no_footnotes = $short;
930             my $catch_fn = sub {
931 433     433   863 my $fn = $_[0];
932             # replace only real footnotes
933 433 100       791 if ($self->document->get_footnote($fn)) {
934 417         1391 return ''
935             } else {
936 16         52 return $fn;
937             }
938 1691         5902 };
939 1691         7099 $body_with_no_footnotes =~ s/(
940             \{ [1-9][0-9]* \}
941             |
942             \[ [1-9][0-9]* \]
943             )
944 433         894 /$catch_fn->($1)/gxe;
945 1691         5432 undef $catch_fn;
946 1691         3783 my ($first_anchor) = $el->anchors;
947             # just in case, should be already vadidated
948 1691 100 66     4084 if ($first_anchor and $first_anchor =~ m/[A-Za-z0-9]/) {
949 149         277 $first_anchor =~ s/[^A-Za-z0-9-]//g;
950 149         342 $first_anchor = 'text-amuse-label-' . $first_anchor;
951             }
952 1691         3614 my $anchors = $self->format_anchors($el);
953 1691         3946 my ($body_for_toc) = $self->manage_regular($body_with_no_footnotes, nolinks => 1);
954 1691         3949 my ($body) = $self->manage_regular($long, nolinks => 1);
955 1691         8605 $body_for_toc =~ s/\s+\z//;
956 1691         6357 $body =~ s/\s+\z//;
957              
958 1691 100       4763 my $leading = $self->blkstring(start => $el->type,
959             toc_entry => ($body ne $body_for_toc ? $body_for_toc : undef));
960 1691         4289 my $trailing = $self->blkstring(stop => $el->type);
961 1691 100       3562 if ($anchors) {
962 149 100       273 if ($self->is_html) {
    50          
963             #insert the before the text
964 88         201 $leading .= $anchors;
965             }
966             elsif ($self->is_latex) {
967             # latex doesn't like it inside \chapter{}
968 61         123 $trailing .= $anchors;
969             }
970 0         0 else { die "Not reached" }
971             }
972             # add them to the ToC for html output;
973 1691 100       3656 if ($el->type =~ m/h([1-4])/) {
974 1542         3860 my $level = $1;
975 1542         2056 my $tocline = $body;
976 1542 50       4044 my $index = $self->add_to_table_of_contents($level => (defined($body_for_toc) ? $body_for_toc : $body),
977             $first_anchor,
978             );
979 1542         2480 $level++; # increment by one
980 1542 50       2725 die "wtf, no index for toc?" unless $index;
981              
982             # inject the id into the html ToC (and the anchor)
983 1542 100       3041 if ($self->is_html) {
984 869         2547 $leading = "
985             qq{ id="toc$index">} . $anchors;
986             }
987             }
988 1691         7887 return $leading . $body . $trailing . "\n";
989             }
990              
991             =item add_to_table_of_contents
992              
993             When we catch an header, we save it in the Output object, so we can
994             emit the ToC. Level 5 is excluded as per doc.
995              
996             It returns the numerical index (so you can inject the id).
997              
998             =cut
999              
1000             sub add_to_table_of_contents {
1001 1542     1542 1 3187 my ($self, $level, $string, $named) = @_;
1002 1542 50 33     4922 return unless ($level and defined($string));
1003 1542 100       3258 unless (defined $self->{_toc_entries}) {
1004 311         762 $self->{_toc_entries} = [];
1005             }
1006 1542         1920 my $index = scalar(@{$self->{_toc_entries}});
  1542         2542  
1007 1542 100       2439 push @{$self->{_toc_entries}}, { level => $level,
  1542         6719  
1008             string => $string,
1009             index => ++$index,
1010             ($named ? (named => $named) : ())
1011             };
1012 1542         3063 return $index;
1013             }
1014              
1015             =item reset_toc_stack
1016              
1017             Clear out the list. This is called at the beginning of the main loop,
1018             so we don't collect duplicates over multiple runs.
1019              
1020             =cut
1021              
1022             sub reset_toc_stack {
1023 1023     1023 1 1533 my $self = shift;
1024 1023 100       4272 delete $self->{_toc_entries} if defined $self->{_toc_entries};
1025             }
1026              
1027             =item table_of_contents
1028              
1029             Emit the formatted ToC (if any). Please note that this method works
1030             even for the LaTeX format, even if does not produce usable output.
1031              
1032             This because we can test if we need to emit a table of contents
1033             looking at this without searching the whole output.
1034              
1035             The output is a list of hashref, where each hashref has the following keys:
1036              
1037             =over 4
1038              
1039             =item level
1040              
1041             The level of the header. Currently we store only levels 1-4, defining
1042             part(1), chapter(2), section(3) and subsection(4). Any other value
1043             means something is off (a.k.a., you found a bug).
1044              
1045             =item index
1046              
1047             The index of the entry, starting from 1.
1048              
1049             =item string
1050              
1051             The output.
1052              
1053             =back
1054              
1055             The hashrefs are returned as copies, so they are safe to
1056             manipulate.
1057              
1058             =cut
1059              
1060             sub table_of_contents {
1061 221     221 1 1152 my $self = shift;
1062 221         357 my $internal_toc = $self->{_toc_entries};
1063 221         323 my @toc;
1064 221 100       588 return @toc unless $internal_toc; # no ToC gets undef
1065             # do a deep copy and return;
1066 117         290 foreach my $entry (@$internal_toc) {
1067 584         2236 push @toc, { %$entry };
1068             }
1069 117         419 return @toc;
1070             }
1071              
1072             =item manage_verse
1073              
1074             =cut
1075              
1076             sub manage_verse {
1077 296     296 1 543 my ($self, $el) = @_;
1078 296         445 my ($lead, $stanzasep);
1079 296 100       591 if ($self->is_html) {
    50          
1080 152         267 $lead = ' ';
1081 152         232 $stanzasep = "\n

\n";
1082             }
1083             elsif ($self->is_latex) {
1084 144         211 $lead = "~";
1085 144         214 $stanzasep = "\n\n";
1086             }
1087 0         0 else { die "Not reached" }
1088              
1089 296         719 my (@chunks) = split(/\n/, $el->string);
1090              
1091             # remove useless
triggering LaTeX errors
1092 296         1179 s/
\s*\z// for @chunks;
1093              
1094 296         496 my (@out, @stanza);
1095 296         516 foreach my $l (@chunks) {
1096 778 100       3851 if ($l =~ m/\A( *)(.+?)\z/s) {
    50          
1097 648         1882 my $leading = $lead x length($1);
1098 648         1299 my $text = $self->manage_regular($2);
1099 648 50       1620 if (length($text)) {
1100 648         1701 push @stanza, $leading . $text;
1101             }
1102             }
1103             elsif ($l =~ m/\A\s*\z/s) {
1104 130         337 push @out, $self->_format_stanza(\@stanza);
1105 130 50       400 die "wtf" if @stanza;
1106             }
1107             else {
1108 0         0 die "wtf?";
1109             }
1110             }
1111             # flush the stanzas
1112 296 100       994 push @out, $self->_format_stanza(\@stanza) if @stanza;
1113 296 50       666 die "wtf" if @stanza;
1114              
1115             # process
1116 296         810 return $self->blkstring(start => $el->type) .
1117             join($stanzasep, @out) . $self->blkstring(stop => $el->type);
1118             }
1119              
1120             sub _format_stanza {
1121 408     408   730 my ($self, $stanza) = @_;
1122              
1123 408         534 my $eol;
1124 408 100       731 if ($self->is_html) {
    50          
1125 209         322 $eol = "
\n";
1126             }
1127             elsif ($self->is_latex) {
1128 199         314 $eol = " \\\\{}\n";
1129             }
1130 0         0 else { die "Not reached" };
1131              
1132 408         604 my $stanza_string = '';
1133 408 100       862 if (@$stanza) {
1134 396         860 $stanza_string = join($eol, @$stanza);
1135 396         677 @$stanza = ();
1136             }
1137 408         789 return $stanza_string;
1138             }
1139              
1140              
1141             =item manage_comment
1142              
1143             =item manage_inline_comment
1144              
1145             =cut
1146              
1147             sub manage_inline_comment {
1148 138     138 1 266 my ($self, $el) = @_;
1149 138         362 my $body = $self->safe($el->string);
1150 138         825 $body =~ s/\n\z//;
1151 138         528 $body =~ s/\s/ /g; # remove eventual newlines, even we don't expect any
1152              
1153 138 100       391 if ($self->is_html) {
    50          
1154 69         316 return q{\n};
1155             }
1156             elsif ($self->is_latex) {
1157 69         326 return q{% } . $body . "\n";
1158             }
1159             else {
1160 0         0 die "Not reached";
1161             }
1162             }
1163              
1164             sub manage_comment {
1165 70     70 1 140 my ($self, $el) = @_;
1166 70         175 my $body = $self->safe($el->string);
1167 70         218 chomp $body;
1168 70         209 return $self->blkstring(start => $el->type) .
1169             $body . $self->blkstring(stop => $el->type);
1170             }
1171              
1172             =item manage_table
1173              
1174             =cut
1175              
1176             sub manage_table {
1177 220     220 1 444 my ($self, $el) = @_;
1178 220         653 my $thash = $self->_split_table_in_hash($el->string);
1179 220 100       606 if ($self->is_html) {
    50          
1180 114         327 return $self->manage_table_html($thash);
1181             }
1182             elsif ($self->is_latex) {
1183 106         286 return $self->manage_table_ltx($thash);
1184             }
1185 0         0 else { die "Not reached" }
1186             }
1187              
1188             =item manage_table_html
1189              
1190             =cut
1191              
1192             sub manage_table_html {
1193 114     114 1 274 my ($self, $table) = @_;
1194 114         155 my @out;
1195 114         333 my $map = $self->html_table_mapping;
1196             # here it's full of hardcoded things, but it can't be done differently
1197 114         203 my $attrs = '';
1198 114 100       275 if ($table->{specification}) {
1199 33         50 $attrs =q{ class="markdown-style-table" style="width:100%"}
1200             }
1201 114         359 push @out, "\n";
1202              
1203             # the hash is always defined
1204 114 100       306 if ($table->{caption} ne "") {
1205             push @out, "
"
1206             . $self->manage_regular($table->{caption})
1207 41         139 . "";
1208             }
1209              
1210 114         255 foreach my $tablepart (qw/head foot body/) {
1211 342 100       731 next unless @{$table->{$tablepart}};
  342         762  
1212 208         391 push @out, $map->{$tablepart}->{b};
1213 208         287 while (@{$table->{$tablepart}}) {
  693         1453  
1214 485         685 my $cells = shift @{$table->{$tablepart}};
  485         887  
1215              
1216 485         749 push @out, $map->{btr};
1217 485         1072 my @cells = @$cells;
1218 485         616 my $i = 0;
1219 485         977 for (my $i = 0; $i < @cells; $i++) {
1220 1382         2074 my $cell = $cells[$i];
1221 1382         1682 my $spec;
1222 1382 100       2395 if ($table->{specification}) {
1223 237         349 $spec = $table->{specification}->[$i];
1224             }
1225             push @out, $map->{$tablepart}->{bcell}->($spec),
1226             $self->manage_regular($cell),
1227             $map->{$tablepart}->{ecell},
1228 1382         2485 }
1229 485         919 push @out, $map->{etr};
1230 485         1106 $i++;
1231             }
1232 208         471 push @out, $map->{$tablepart}->{e};
1233             }
1234 114         235 push @out, "
\n"; 1235 114         2885 return join("\n", @out); 1236             } 1237               1238             =item manage_table_ltx 1239               1240             =cut 1241               1242             sub manage_table_ltx { 1243 106     106 1 247 my ($self, $table) = @_; 1244               1245 106         348 my $out = { 1246             body => [], 1247             head => [], 1248             foot => [], 1249             }; 1250 106         238 foreach my $t (qw/body head foot/) { 1251 318         479 foreach my $rt (@{$table->{$t}}) {   318         644   1252 447         558 my @row; 1253 447         746 foreach my $cell (@$rt) { 1254             # escape all! 1255 1291         2529 push @row, $self->manage_regular($cell); 1256             } 1257 447         1068 my $texrow = join(q{ & }, @row); 1258 447         580 push @{$out->{$t}}, "\\relax " . $texrow . " \\\\\n"   447         1780   1259             } 1260             } 1261             # then we loop over what we have. First head, then body, and 1262             # finally foot 1263 106         163 my $has_caption; 1264 106 100 66     579 if (defined $table->{caption} and $table->{caption} ne '') { 1265 35         81 $has_caption = 1; 1266             } 1267 106         212 my $textable = ''; 1268 106 100       235 if ($has_caption) { 1269 35         79 $textable .= "\\begin{table}[htbp!]\n"; 1270             } 1271             else { 1272 71         120 $textable .= "\\bigskip\n\\noindent\n"; 1273             } 1274 106         213 $textable .= " \\begin{minipage}[t]{\\textwidth}\n"; 1275 106         174 $textable .= "\\begin{tabularx}{\\textwidth}{" ; 1276               1277 106 100       238 if ($table->{specification}) { 1278 33         54 $textable .= join('', @{$table->{specification}});   33         78   1279             } 1280             else { 1281             # back compat 1282 73         207 $textable .= "|X" x $table->{counter}; 1283 73         109 $textable .= "|"; 1284             } 1285 106         189 $textable .= "}\n"; 1286 106 100       261 if (!$table->{specification}) { 1287 73         171 $textable .= "\\hline\n"; 1288             } 1289 106 100       174 if (my @head = @{$out->{head}}) {   106         346   1290 53         141 $textable .= join("", @head) . "\\hline\n"; 1291             } 1292 106 50       163 if (my @body = @{$out->{body}}) {   106         394   1293 106         263 $textable .= join("", @body); 1294             } 1295 106 100       171 if (my @foot = @{$out->{foot}}) {   106         317   1296 29         88 $textable .= "\\hline\n" . join("", @foot); 1297             } 1298 106 100       261 if (!$table->{specification}) { 1299 73         141 $textable .= "\\hline\n"; 1300             } 1301 106         180 $textable .= "\\end{tabularx}\n"; 1302 106 100       234 if ($has_caption) { 1303             $textable .= "\n\\caption[]{" . 1304             $self->manage_regular($table->{caption}) 1305 35         105 . "}\n"; 1306             } 1307 106         204 $textable .= "\\end{minipage}\n"; 1308 106 100       233 if ($has_caption) { 1309 35         66 $textable .= "\\end{table}\n"; 1310             } 1311             else { 1312 71         107 $textable .= "\\bigskip\n"; 1313             } 1314 106         161 $textable .= "\n"; 1315             # print $textable; 1316 106         1259 return $textable; 1317             } 1318               1319             =item _split_table_in_hash 1320               1321             =cut 1322               1323             sub _table_row_specification { 1324 878     878   1288 my ($self, $cells) = @_; 1325 878         962 my @spec; 1326 878         1239 foreach my $c (@$cells) { 1327             # print "Examining $c\n"; 1328 1022 100       2608 if ($c =~ m/\A\s*\:?---+\:?\s*\z/) {     100           1329 174 100       593 if ($c =~ m/\:-+\:/) {     100               100           1330 54         98 push @spec, 'c'; 1331             } 1332             elsif ($c =~ m/\:-/) { 1333 18         38 push @spec, 'l'; 1334             } 1335             elsif ($c =~ m/-\:/) { 1336 18         38 push @spec, 'r'; 1337             } 1338             else { 1339 84         150 push @spec, 'X'; 1340             } 1341             } 1342             elsif ($c =~ m/\A\s*---+\s*([0-9]+)\s*---+\s*\z/) { 1343 36         85 my $percentage = $1; 1344 36 100 66     148 if ($percentage > 0 and $percentage < 100) { 1345 30         264 push @spec, 'p{' . sprintf('%.2f', $percentage / 100) . "\\textwidth}"; 1346             } 1347             else { 1348 6         804 warn "Table width should be a percentage between 1 and 99, you provided $percentage\n"; 1349 6         39 push @spec, 'X'; 1350             } 1351             } 1352             else { 1353             # discard all and give up 1354 812         934 @spec = (); 1355 812         997 last; 1356             } 1357             } 1358 878 100 66     1789 if (@spec and @spec == @$cells) { 1359 66         262 return @spec; 1360             } 1361             else { 1362 812         1624 return; 1363             } 1364             } 1365               1366             sub _split_table_in_hash { 1367 220     220   472 my ($self, $table) = @_; 1368 220 50       570 return {} unless $table; 1369 220         1238 my $output = { 1370             caption => "", 1371             body => [], 1372             head => [], 1373             foot => [], 1374             counter => 0, 1375             specification => undef, 1376             }; 1377               1378             # remove the caption 1379 220         353 my @rows; 1380 220         360 my $caption_done = 0; 1381 220         1464 foreach my $r (split(/\n/, $table)) { 1382 1074 100       2336 if ($r =~ m/\A\s*\|\+\s*(.+?)\s*\+\|\s*\z/) { 1383 76         365 $output->{caption} = $1; 1384 76         535 $caption_done++; 1385             } 1386             else { 1387 998         1473 push @rows, $r; 1388             } 1389             } 1390               1391 220         364 my $empty_first_cell = 0; 1392 220         345 my @row_cells; 1393 220         426 foreach my $r (@rows) { 1394 998         3643 my @cells = split /\|+/, $r; 1395 998         1381 my $type = 'body'; 1396 998 100       2535 if ($r =~ m/\|\|\|/) {     100           1397 70         126 $type = 'foot'; 1398             } 1399             elsif ($r =~ m/\|\|/) { 1400 88         145 $type = 'head'; 1401             } 1402 998 100       2218 if ($cells[0] =~ /\A\s*\z/) { 1403 227         304 $empty_first_cell++; 1404             } 1405 998         2961 push @row_cells, { 1406             cells => \@cells, 1407             type => $type, 1408             }; 1409             } 1410               1411             # consistently empty first cell: nuke 1412 220 100       674 if ($empty_first_cell == @row_cells) { 1413 69         137 foreach my $r (@row_cells) { 1414 191         209 shift @{$r->{cells}};   191         365   1415             } 1416             } 1417               1418             ROW: 1419 220         701 for (my $i = 0; $i < @row_cells; $i++) { 1420               1421 998         1116 my @cells = @{$row_cells[$i]{cells}};   998         2230   1422 998         1377 my $type = $row_cells[$i]{type}; 1423               1424 998 100       1716 if ($output->{counter} < scalar(@cells)) { 1425 220         425 $output->{counter} = scalar(@cells); 1426             } 1427 998 100       1578 if (!$output->{specification}) { 1428             # print Dumper(\@cells); 1429 878 100       1553 if (my @spec = $self->_table_row_specification(\@cells)) { 1430 66         133 $output->{specification} = \@spec; 1431             # print Dumper(\@cells); 1432             # now, if we're on the second, the previous row was 1433             # the header, so move it. 1434 66 100       145 if ($i == 1) { 1435             # print Dumper($output); 1436 36 100 66     53 if (@{$output->{body}} == 1 and @{$output->{head}} == 0) {   36         108     30         88   1437 30         41 push @{$output->{head}}, shift @{$output->{body}};   30         52     30         50   1438             } 1439             } 1440 66         226 next ROW; 1441             } 1442             } 1443 932         1097 push @{$output->{$type}}, \@cells;   932         2458   1444             } 1445               1446             # pad the cells with " " if their number doesn't match 1447 220         486 foreach my $part (qw/body head foot/) { 1448 660         782 foreach my $row (@{$output->{$part}}) {   660         1120   1449 932         1682 while (@$row < $output->{counter}) { 1450             # warn "Found uneven table: " . join (":", @$row), "\n"; 1451 96         195 push @$row, " "; 1452             } 1453             } 1454             } 1455               1456             # pad the specification with X if short. 1457 220 100       612 if (my $spec = $output->{specification}) { 1458 66         226 while (@$spec < $output->{counter}) { 1459 0         0 push @$spec, 'X'; 1460             } 1461             } 1462 220         1102 return $output; 1463             } 1464               1465             =item manage_example 1466               1467             =cut 1468               1469             sub manage_example { 1470 450     450 1 847 my ($self, $el) = @_; 1471 450         1069 my $body = $self->safe($el->string); 1472 450         1841 return $self->blkstring(start => $el->type) . 1473             $body . $self->blkstring(stop => $el->type); 1474             } 1475               1476             =item manage_hr 1477               1478             Put an horizontal rule 1479               1480             =cut 1481               1482             sub manage_hr { 1483 48     48 1 164 my ($self, $el) = @_; 1484 48 50       118 die "Wtf?" if $el->string =~ m/\w/s; # don't eat chars by mistake 1485 48 100       149 if ($self->is_html) {     50           1486 24         72 return "\n
\n"; 1487             } 1488             elsif ($self->is_latex) { 1489 24         71 return "\n\\hairline\n\n"; 1490             } 1491 0         0 else { die "Not reached" } 1492             } 1493               1494             =item manage_newpage 1495               1496             If it's LaTeX, insert a newpage 1497               1498             =cut 1499               1500             sub manage_newpage { 1501 71     71 1 150 my ($self, $el) = @_; 1502 71 50       156 die "Wtf? " . $el->string if $el->string =~ m/\w/s; # don't eat chars by mistake 1503 71 100       155 if ($self->is_html) {     50           1504 39         83 my $out = $self->blkstring(start => 'center') . 1505             $self->manage_paragraph($el) . 1506             $self->blkstring(stop => 'center'); 1507 39         135 return $out; 1508             } 1509             elsif ($self->is_latex) { 1510 32         89 return "\n\\clearpage\n\n"; 1511             } 1512 0         0 else { die "Not reached" } 1513             } 1514               1515             =back 1516               1517             =head2 Links management 1518               1519             =over 4 1520               1521             =item linkify($link) 1522               1523             Here we see if it's a single one or a link/desc pair. Then dispatch 1524               1525             =cut 1526               1527             sub linkify { 1528 1654     1654 1 2703 my ($self, $link) = @_; 1529 1654 50       3322 die "no link passed" unless defined $link; 1530             # warn "Linkifying $link"; 1531 1654 100       13311 if ($link =~ m/\A\[\[     50           1532             \s* 1533             (.+?) # link 1534             \s* 1535             \]\[ 1536             \s* 1537             (.+?) # desc 1538             \s* 1539             \]\]\z 1540             /sx) { 1541 1168         2677 return $self->format_links($1, $2); 1542             } 1543               1544             elsif ($link =~ m/\[\[ 1545             \s* 1546             (.+?) # link 1547             \s* 1548             \]\]/sx) { 1549 486         1212 return $self->format_single_link($1); 1550             } 1551               1552             else { 1553 0         0 die "Wtf??? $link" 1554             } 1555             } 1556               1557             =item format_links 1558               1559             =cut 1560               1561             sub format_links { 1562 1168     1168 1 4084 my ($self, $link, $desc) = @_; 1563 1168         2722 $desc = $self->manage_regular($desc); 1564             # first the images 1565 1168 100       3037 if (my $image = $self->find_image($link)) { 1566 100         337 my $src = $image->filename; 1567 100         232 $self->document->attachments($src); 1568 100         328 $image->desc($desc); 1569 100         307 return $image->output; 1570             } 1571             # links 1572 1068 100       4064 if ($link =~ m/\A\#([A-Za-z][A-Za-z0-9-]*)\z/) { 1573 826         1800 my $linkname = $1; 1574 826 100       1587 if ($self->is_html) {     50           1575 417         997 $link = "#text-amuse-label-$linkname"; 1576             } 1577             elsif ($self->is_latex) { 1578             # turn ?? placeholder in the page name; the starred 1579             # version is without hyperlink, because we're already 1580             # inside one. 1581 409         712 $desc =~ s/\?\?/\\pageref*{textamuse:$linkname}/g; 1582 409         1674 return "\\hyperref{}{amuse}{$linkname}{$desc}"; 1583             } 1584             } 1585               1586 659 100       1327 if ($self->is_html) {     50           1587 539         1094 $link = $self->_url_safe_escape($link); 1588 539         1806 return qq{$desc}; 1589             } 1590             elsif ($self->is_latex) { 1591 120         301 return qq/\\href{/ . 1592             $self->_url_safe_escape($link) . 1593             qq/}{$desc}/; 1594             } 1595 0         0 else { die "Not reached" } 1596             } 1597               1598             =item format_single_link 1599               1600             =cut 1601               1602             sub format_single_link { 1603 486     486 1 1486 my ($self, $link) = @_; 1604             # the re matches only clean names, no need to escape anything 1605 486 100       1104 if (my $image = $self->find_image($link)) { 1606 320         643 $self->document->attachments($image->filename); 1607 320         743 return $image->output; 1608             } 1609 166 100       475 if ($link =~ m/\A\#([A-Za-z][A-Za-z0-9]+)\z/) { 1610 16         33 my $linkname = $1; 1611             # link is sane and safe 1612 16 100       39 if ($self->is_html) {     50           1613 10         25 $link = "#text-amuse-label-$linkname"; 1614 10         38 return qq{$linkname}; 1615             } 1616             elsif ($self->is_latex) { 1617 6         27 return "\\hyperref{}{amuse}{$linkname}{$linkname}"; 1618             } 1619             } 1620               1621 150         368 my $url = $self->_url_safe_escape($link); 1622 150         319 my $desc = $self->safe($link); 1623 150 100       455 if ($self->is_html) {     50           1624 78         344 return qq{$desc}; 1625             } 1626             elsif ($self->is_latex) { 1627 72         325 return "\\href{$url}{\\texttt{$desc}}"; 1628             } 1629 0         0 else { die "Not reached" } 1630             } 1631               1632             =item _url_safe_escape 1633               1634             =cut 1635               1636             sub _url_safe_escape { 1637 809     809   1319 my ($self, $string) = @_; 1638 809         1886 utf8::encode($string); 1639 809         1828 $string =~ s/([^0-9a-zA-Z\.\/\:\;_\%\&\#\?\=\@\-]) 1640 638         1754 /sprintf("%%%02X", ord ($1))/gesx; 1641 809         1769 my $escaped = $self->safe($string); 1642 809         2702 return $escaped; 1643             } 1644               1645             =back 1646               1647             =head1 HELPERS 1648               1649             Methods providing some fixed values 1650               1651             =over 4 1652               1653             =item blk_table 1654               1655             =cut 1656               1657             sub blk_table { 1658 31026     31026 1 37045 my $self = shift; 1659 31026 100       52774 unless ($self->{_block_table_map}) { 1660 742         1994 $self->{_block_table_map} = $self->_build_blk_table; 1661             } 1662 31026         40675 return $self->{_block_table_map}; 1663             } 1664               1665             sub _build_blk_table { 1666             my $table = { 1667             languageswitch => { 1668             start => { 1669             html => sub { 1670 8     8   29 my %attrs = @_; 1671 8   50     32 my $lang = $attrs{language} || "en"; 1672 8         49 return qq{
\n}; 1673             }, 1674             ltx => sub { 1675 8     8   26 my %attrs = @_; 1676 8   50     34 my $iso = $attrs{language} || "en"; 1677 8         28 my $lang = Text::Amuse::Utils::language_mapping()->{$iso}; 1678 8   50     309 return sprintf("\\begin{otherlanguage}{%s}\n", 1679             $lang || "english"); 1680             } 1681             }, 1682             stop => { 1683 8     8   35 html => sub { return qq{
\n} }, 1684             ltx => "\\end{otherlanguage}\n", 1685             }, 1686             }, 1687             'rtl' => { 1688             start => { 1689             html => '
', 1690             # ltx => "\n\\setRTL\%", 1691             ltx => "\n\\begin{RTL}\n", 1692             }, 1693             stop => { 1694             html => "
\n", 1695             ltx => "\n\\end{RTL}\n", 1696             # ltx => "\n\\setLTR\%", 1697             }, 1698             }, 1699             'ltr' => { 1700             start => { 1701             html => '
', 1702             ltx => "\n\\begin{LTR}\n", 1703             # ltx => "\n\\setLTR\%", 1704             }, 1705             stop => { 1706             html => "
\n", # RLM (U+200F RIGHT-TO-LEFT MARK) 1707             ltx => "\n\\end{LTR}\n", 1708             # ltx => "\n\\setRTL\%", 1709             }, 1710             }, 1711             p => { start => { 1712             ltx => "\n", 1713             html => "\n

\n", 1714             }, 1715             stop => { 1716             ltx => "\n\n", 1717             html => "\n

\n", 1718             }, 1719             }, 1720             h1 => { 1721             start => { 1722             ltx => sub { 1723 79     79   249 _latex_header(part => @_); 1724             }, 1725             html => "

", 1726             }, 1727             stop => { 1728             ltx => "}\n", 1729             html => "

\n" 1730             } 1731             }, 1732             h2 => { 1733             start => { 1734             ltx => sub { 1735 281     281   872 _latex_header(chapter => @_); 1736             }, 1737             html => "

", 1738             }, 1739             stop => { 1740             ltx => "}\n", 1741             html => "

\n" 1742             } 1743             }, 1744             h3 => { 1745             start => { 1746             ltx => sub { 1747 234     234   668 _latex_header(section => @_); 1748             }, 1749             html => "

", 1750             }, 1751             stop => { 1752             ltx => "}\n", 1753             html => "

\n" 1754             } 1755             }, 1756             h4 => { 1757             start => { 1758             ltx => sub { 1759 79     79   266 _latex_header(subsection => @_); 1760             }, 1761             html => "
", 1762             }, 1763             stop => { 1764             ltx => "}\n", 1765             html => "
\n" 1766             } 1767             }, 1768             h5 => { 1769             start => { 1770             ltx => sub { 1771 61     61   212 _latex_header(subsubsection => @_); 1772             }, 1773             html => "
", 1774             }, 1775             stop => { 1776             ltx => "}\n", 1777             html => "
\n" 1778             } 1779             }, 1780             example => { 1781             start => { 1782             html => "\n
\n", 




1783




 





 





 





 





 





 



                                                         ltx => "\n\\begin{alltt}\n", 




1784




 





 





 





 





 





 



                                                        }, 




1785




 





 





 





 





 





 



                                               stop => { 




1786




 





 





 





 





 





 



                                                        html => "
\n", 1787             ltx => "\\end{alltt}\n\n", 1788             }, 1789             }, 1790             1791             comment => { 1792             start => { # we could also use a more 1793             # stable startstop hiding 1794             html => qq{\n\n\n\n", 1799             ltx => "\n\\end{comment}\n\n", 1800             }, 1801             }, 1802             verse => { 1803             start => { 1804             html => "
\n", 1805             ltx => "\n\n\\begin{verse}\n", 1806             }, 1807             stop => { 1808             html => "\n
\n", 1809             ltx => "\n\\end{verse}\n\n", 1810             }, 1811             }, 1812             quote => { 1813             start => { 1814             html => "\n
\n", 1815             ltx => "\n\n\\begin{quote}\n\n", 1816             }, 1817             stop => { 1818             html => "\n
\n", 1819             ltx => "\n\n\\end{quote}\n\n", 1820             }, 1821             }, 1822             1823             biblio => { 1824             start => { 1825             html => "\n
\n", 1826             ltx => "\n\n\\begin{amusebiblio}\n\n", 1827             }, 1828             stop => { 1829             html => "\n
\n", 1830             ltx => "\n\n\\end{amusebiblio}\n\n", 1831             }, 1832             }, 1833             play => { 1834             start => { 1835             html => "\n
\n", 1836             ltx => "\n\n\\begin{amuseplay}\n\n", 1837             }, 1838             stop => { 1839             html => "\n
\n", 1840             ltx => "\n\n\\end{amuseplay}\n\n", 1841             }, 1842             }, 1843               1844             center => { 1845             start => { 1846             html => "\n
\n", 1847             ltx => "\n\n\\begin{center}\n", 1848             }, 1849             stop => { 1850             html => "\n
\n", 1851             ltx => "\n\\end{center}\n\n", 1852             }, 1853             }, 1854             right => { 1855             start => { 1856             html => "\n
\n", 1857             ltx => "\n\n\\begin{flushright}\n", 1858             }, 1859             stop => { 1860             html => "\n
\n", 1861             ltx => "\n\\end{flushright}\n\n", 1862             }, 1863             }, 1864               1865             ul => { 1866             start => { 1867             html => "\n\n", 1872             ltx => "\n\\end{itemize}\n", 1873             }, 1874             }, 1875               1876             ol => { 1877             start => { 1878             html => sub { 1879 0     0   0 _html_ol_element(n => @_); 1880             }, 1881             ltx => sub { 1882 0     0   0 _ltx_enum_element(1 => @_); 1883             }, 1884             }, 1885             stop => { 1886             html => "\n\n", 1887             ltx => "\n\\end{enumerate}\n", 1888             }, 1889             }, 1890               1891             oln => { 1892             start => { 1893             html => sub { 1894 148     148   457 _html_ol_element(n => @_); 1895             }, 1896             ltx => sub { 1897 142     142   522 _ltx_enum_element(1 => @_); 1898             }, 1899             }, 1900             stop => { 1901             html => "\n\n", 1902             ltx => "\n\\end{enumerate}\n", 1903             }, 1904             }, 1905               1906             oli => { 1907             start => { 1908             html => sub { 1909 65     65   196 _html_ol_element(i => @_); 1910             }, 1911             ltx => sub { 1912 63     63   237 _ltx_enum_element(i => @_); 1913             }, 1914             }, 1915             stop => { 1916             html => "\n\n", 1917             ltx => "\n\\end{enumerate}\n", 1918             }, 1919             }, 1920               1921             olI => { 1922             start => { 1923             html => sub { 1924 42     42   126 _html_ol_element(I => @_); 1925             }, 1926             ltx => sub { 1927 42     42   154 _ltx_enum_element(I => @_); 1928             }, 1929             }, 1930             stop => { 1931             html => "\n\n", 1932             ltx => "\n\\end{enumerate}\n", 1933             }, 1934             }, 1935               1936             olA => { 1937             start => { 1938             html => sub { 1939 52     52   185 _html_ol_element(A => @_); 1940             }, 1941             ltx => sub { 1942 39     39   114 _ltx_enum_element(A => @_); 1943             }, 1944             }, 1945             stop => { 1946             html => "\n\n", 1947             ltx => "\n\\end{enumerate}\n", 1948             }, 1949             }, 1950               1951             ola => { 1952             start => { 1953             html => sub { 1954 92     92   282 _html_ol_element(a => @_); 1955             }, 1956             ltx => sub { 1957 92     92   297 _ltx_enum_element(a => @_); 1958             }, 1959             }, 1960 742     742   85688 stop => { 1961             html => "\n\n", 1962             ltx => "\n\\end{enumerate}\n", 1963             }, 1964             }, 1965               1966             li => { 1967             start => { 1968             html => "
  • ", 1969             ltx => "\\item\\relax ", 1970             }, 1971             stop => { 1972             html => "\n
  • \n", 1973             ltx => "\n\n", 1974             }, 1975             }, 1976             dl => { 1977             start => { 1978             ltx => "\n\\begin{description}\n", 1979             html => "\n
    \n", 1980             }, 1981             stop => { 1982             ltx => "\n\\end{description}\n", 1983             html => "\n
    \n", 1984             }, 1985             }, 1986             dt => { 1987             start => { 1988             ltx => "\n\\item[{", 1989             html => "
    ", 1990             }, 1991             stop => { 1992             ltx => "}] ", 1993             html => "
    ", 1994             }, 1995             }, 1996             dd => { 1997             start => { 1998             ltx => "", 1999             html => "\n
    ", 2000             }, 2001             stop => { 2002             ltx => "", 2003             html => "
    \n", 2004             }, 2005             }, 2006             }; 2007 742         4456 return $table; 2008             } 2009               2010               2011             =item image_re 2012               2013             Regular expression to match image links. 2014               2015             =cut 2016               2017             sub image_re { 2018 2689     2689 1 10695 return qr{([0-9A-Za-z][0-9A-Za-z/-]+ # basename 2019             \. # dot 2020             (png|jpe?g)) # extension $2 2021             ([ ]+ 2022             ([0-9]+)? # width in percent 2023             ([ ]*([rlf]))? 2024             ([ ]*(a(90|180|270)))? 2025             )?}x; 2026             } 2027               2028               2029             =item find_image($link) 2030               2031             Given the input string $link, return undef if it's not an image. If it 2032             is, return a Text::Amuse::Output::Image object. 2033               2034             =cut 2035               2036             sub find_image { 2037 1666     1666 1 5687 my ($self, $link) = @_; 2038 1666         3127 my $imagere = $self->image_re; 2039 1666 100       10073 if ($link =~ m/\A$imagere\z/s) { 2040 430         956 my $filename = $1; 2041 430         716 my $width = $4; 2042 430         686 my $float = $6; 2043 430         585 my $rotate = $9; 2044 430         914 return Text::Amuse::Output::Image->new(filename => $filename, 2045             width => $width, 2046             wrap => $float, 2047             rotate => $rotate, 2048             fmt => $self->fmt); 2049             } 2050             else { 2051             # warn "Not recognized\n"; 2052 1236         4307 return; 2053             } 2054             } 2055               2056               2057             =item url_re 2058               2059             =cut 2060               2061             sub url_re { 2062 56     56 1 21288 return qr!((www\.|https?:\/\/) 2063             \w[\w\-\.]+\.\w+ # domain 2064             (:\d+)? # the port 2065             # everything else, but start with a 2066             # slash and end with a a \w, and don't 2067             # tolerate spaces 2068             (/(\S*\w)?)?) 2069             !x; 2070             } 2071               2072               2073             =item html_table_mapping 2074               2075             =cut 2076               2077             sub _format_table_tag { 2078 1382     1382   2191 my ($tag, $spec) = @_; 2079 1382         1872 my $attrs = ''; 2080 1382 100       2133 if ($spec) { 2081 237         531 my %specs = ( 2082             c => 'center', 2083             l => 'left', 2084             r => 'right', 2085             ); 2086 237 100       639 if (my $align = $specs{$spec}) {     100           2087 117         269 $attrs = qq{ style="text-align:$align"}; 2088             } 2089             elsif ($spec =~ m/p\{0\.([0-9][0-9])\\textwidth/) { 2090 15         53 $attrs = qq{ style="width:$1%" }; 2091             } 2092             } 2093 1382         4233 return '<' . $tag . $attrs . '>'; 2094             } 2095               2096             sub html_table_mapping { 2097             return { 2098             head => { 2099             b => " ", 2100             e => " ", 2101             bcell => sub { 2102 152     152   310 return " " . _format_table_tag(th => @_); 2103             }, 2104             ecell => " ", 2105             }, 2106             foot => { 2107             b => " ", 2108             e => " ", 2109             bcell => sub { 2110 107     107   238 return " " . _format_table_tag(td => @_); 2111             }, 2112             ecell => " ", 2113             }, 2114             body => { 2115             b => " ", 2116             e => " ", 2117             bcell => sub { 2118 1123     1123   2047 return " " . _format_table_tag(td => @_); 2119             }, 2120 114     114 1 1673 ecell => " ", 2121             }, 2122             btr => " ", 2123             etr => " ", 2124             }; 2125             } 2126               2127             sub _html_ol_element { 2128 399     399   1140 my ($type, %attributes) = @_; 2129 399         1606 my %map = ( 2130             ol => '', 2131             n => '', 2132             i => 'lower-roman', 2133             I => 'upper-roman', 2134             A => 'upper-alpha', 2135             a => 'lower-alpha', 2136             ); 2137 399         586 my $ol_type = ''; 2138 399 100       867 if ($map{$type}) { 2139 251         557 $ol_type = qq{ style="list-style-type:$map{$type}"}; 2140             } 2141 399         628 my $start = $attributes{start_list_index}; 2142 399         636 my $start_string = ''; 2143 399 100 33     3195 if ($start and $start =~ m/\A[0-9]+\z/ and $start > 1) {       66         2144 99         219 $start_string = qq{ start="$start"}; 2145             } 2146 399         2185 return "\n\n"; 2147             } 2148               2149             sub _ltx_enum_element { 2150 378     378   1114 my ($type, %attributes) = @_; 2151 378         1626 my %map = ( 2152             1 => '1', 2153             i => 'i', 2154             I => 'I', 2155             A => 'A', 2156             a => 'a', 2157             ); 2158 378         568 my $string = "\n\\begin{enumerate}["; 2159 378   50     951 my $type_string = $map{$type} || '1'; 2160               2161 378         552 my $start = $attributes{start_list_index}; 2162 378         551 my $start_string = ''; 2163 378 100 33     2943 if ($start and $start =~ m/\A[0-9]+\z/ and $start > 1) {       66         2164 96         205 $start_string = qq{, start=$start}; 2165             } 2166 378         2090 return $string . $type_string . '.' . $start_string . "]\n"; 2167             } 2168               2169             sub _latex_header { 2170             # All sectioning commands take the same general form, e.g., 2171             # \chapter[TOCTITLE]{TITLE} 2172 734     734   1619 my ($name, %attributes) = @_; 2173 734 100       1873 if (defined $attributes{toc_entry}) { 2174 120         443 $attributes{toc_entry} =~ s/\s+/ /g; 2175             # we use the grouping here, to avoid chocking on [ ] 2176 120         549 return "\\" . $name . '[{' . $attributes{toc_entry} . '}]{' 2177             } 2178             else { 2179 614         2428 return "\\" . $name . '{'; 2180             } 2181             } 2182               2183             =item format_anchors($element) 2184               2185             Return a formatted string with the anchors found in the element. 2186               2187             =cut 2188               2189             sub format_anchors { 2190 22146     22146 1 31658 my ($self, $el) = @_; 2191 22146         26030 my $out = ''; 2192 22146 100       42767 if (my @anchors = map { Text::Amuse::InlineElement->new(string => $_,   812         1799   2193             type => 'anchor', 2194             lang => $self->_lang, 2195             fmt => $self->fmt)->stringify } $el->anchors) { 2196 609         2561 return join('', @anchors); 2197             } 2198 21537         52251 return $out; 2199             } 2200               2201             =back 2202               2203             =cut 2204               2205             1;