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 44     44   70225 use strict;
  44         1724  
  44         1374  
3 44     44   268 use warnings;
  44         117  
  44         1224  
4 44     44   854 use utf8;
  44         132  
  44         254  
5 44     44   23327 use Text::Amuse::Output::Image;
  44         124  
  44         1419  
6 44     44   20558 use Text::Amuse::InlineElement;
  44         151  
  44         1578  
7 44     44   331 use Text::Amuse::Utils;
  44         124  
  44         1064  
8             # use Data::Dumper::Concise;
9 44     44   267 use constant DEBUG => 0;
  44         93  
  44         96912  
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 820     820 1 10404 my $class = shift;
76 820         2929 my %opts = @_;
77 820 50       2661 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 820 50 66     5769 $opts{format} eq 'html'));
      66        
80             my $self = { document => $opts{document},
81 820         3092 fmt => $opts{format} };
82 820 100 66     6422 if (ref($self->{document}) and $self->{document}->can('language_code')) {
83 819         3268 $self->{_lang} = $self->{document}->language_code;
84             }
85 820         4968 bless $self, $class;
86             }
87              
88             =back
89              
90             =head1 METHODS
91              
92             =over 4
93              
94             =item _lang
95              
96             =cut
97              
98 34697     34697   125952 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 3595     3595 1 10988 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 107723     107723 1 255392 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 4476 return shift->fmt eq 'ltx';
133             }
134              
135             sub is_html {
136 8109     8109 1 16342 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 1024     1024 1 2943 my ($self, %opts) = @_;
166 1024         2019 my (@pieces, @splat);
167 1024         2194 my $split = $opts{split};
168 1024         2669 my $imagere = $self->image_re;
169 1024         3332 $self->reset_toc_stack;
170             # loop over the parsed elements
171 1024         2748 foreach my $el ($self->document->elements) {
172 34259 100       80279 if ($el->type eq 'null') {
173 12778 50       27360 push @pieces, $self->format_anchors($el) if $el->anchors;
174 12778         24922 next;
175             }
176 21481 100       44930 if ($el->type eq 'startblock') {
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    50          
177 4874 50       10322 die "startblock with string passed!: " . $el->string if $el->string;
178 4874         11611 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       10705 die "stopblock with string passed!:" . $el->string if $el->string;
186 4874         9898 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     16869 if ($el->string =~ m/\A\s*-----*\s*\z/s) {
    100          
191 48         177 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         1028 push @pieces, $self->format_anchors($el), $self->manage_regular($el);
200             }
201             else {
202 8054         19616 push @pieces, $self->manage_paragraph($el);
203             }
204             }
205             elsif ($el->type eq 'standalone') {
206 30         110 push @pieces, $self->manage_regular($el);
207             }
208             elsif ($el->type eq 'dt') {
209 285         780 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     3583 if ($el->type =~ m/h[1-4]/ and $split and @pieces) {
      100        
214            
215 755 100       1846 if ($self->is_html) {
216 547         1359 foreach my $fn ($self->flush_footnotes) {
217 176         480 push @pieces, $self->manage_html_footnote($fn);
218             }
219 547         1511 foreach my $nested ($self->flush_secondary_footnotes) {
220 66         174 push @pieces, $self->manage_html_footnote($nested);
221             }
222 547 50       1079 die "Footnotes still in the stack!" if $self->flush_footnotes;
223 547 50       1001 die "Secondary footnotes still in the stack!" if $self->flush_secondary_footnotes;
224             }
225 755         5050 push @splat, join("", @pieces);
226 755         2009 @pieces = ();
227             # all done
228             }
229              
230             # then continue as usual
231 1691         4799 push @pieces, $self->manage_header($el);
232             }
233             elsif ($el->type eq 'verse') {
234 296         800 push @pieces, $self->format_anchors($el), $self->manage_verse($el);
235             }
236             elsif ($el->type eq 'inlinecomment') {
237 138         466 push @pieces, $self->manage_inline_comment($el);
238             }
239             elsif ($el->type eq 'comment') {
240 70         254 push @pieces, $self->manage_comment($el);
241             }
242             elsif ($el->type eq 'table') {
243 220         630 push @pieces, $self->format_anchors($el), $self->manage_table($el);
244             }
245             elsif ($el->type eq 'example') {
246 450         1203 push @pieces, $self->format_anchors($el), $self->manage_example($el);
247             }
248             elsif ($el->type eq 'newpage') {
249 71         195 push @pieces, $self->manage_newpage($el), $self->format_anchors($el);
250             }
251             else {
252 0         0 die "Unrecognized element: " . $el->type;
253             }
254             }
255 1024 100       6201 if ($self->is_html) {
256 662         2073 foreach my $fn ($self->flush_footnotes) {
257 354         1018 push @pieces, $self->manage_html_footnote($fn);
258             }
259 662         2030 foreach my $nested ($self->flush_secondary_footnotes) {
260 62         174 push @pieces, $self->manage_html_footnote($nested);
261             }
262 662 50       1532 die "Footnotes still in the stack!" if $self->flush_footnotes;
263 662 50       1396 die "Secondary footnotes still in the stack!" if $self->flush_secondary_footnotes;
264             }
265              
266 1024 100       2862 if ($split) {
267             # catch the last
268 324         2993 push @splat, join("", @pieces);
269             # and return
270 324         3697 return \@splat;
271             }
272 700         5473 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 289 my $self = shift;
284 149         392 my %directives = $self->document->raw_header;
285 149         353 my %out;
286 149         736 while (my ($k, $v) = each %directives) {
287 280         664 $out{$k} = $self->manage_regular($v);
288             }
289 149         1053 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 1090 my ($self, $fn) = @_;
306 658 50       1455 return unless defined($fn);
307 658 100       1783 if ($fn->type eq 'footnote') {
    50          
308 530         1365 $self->_add_primary_footnote($fn);
309             }
310             elsif ($fn->type eq 'secondary_footnote') {
311 128         322 $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   984 my ($self, $fn) = @_;
320 530 100       1325 unless (defined $self->{_fn_list}) {
321 229         659 $self->{_fn_list} = [];
322             }
323 530         812 push @{$self->{_fn_list}}, $fn;
  530         1352  
324             }
325              
326             sub _add_secondary_footnote {
327 128     128   235 my ($self, $fn) = @_;
328 128 100       349 unless (defined $self->{_sec_fn_list}) {
329 57         162 $self->{_sec_fn_list} = [];
330             }
331 128         202 push @{$self->{_sec_fn_list}}, $fn;
  128         362  
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 2418     2418 1 3616 my $self = shift;
346 2418 100       7230 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         423 return sort { $a->footnote_number <=> $b->footnote_number } @{delete $self->{_fn_list}};
  507         1203  
  229         1253  
350             }
351              
352             sub flush_secondary_footnotes {
353 2418     2418 1 3569 my $self = shift;
354             # as above
355 2418 100       6765 return unless (defined $self->{_sec_fn_list});
356 57         115 return sort { $a->footnote_number <=> $b->footnote_number } @{delete $self->{_sec_fn_list}};
  126         334  
  57         264  
357             }
358              
359             =item manage_html_footnote
360              
361             =cut
362              
363             sub manage_html_footnote {
364 658     658 1 1329 my ($self, $element) = @_;
365 658 50       1575 return unless $element;
366 658         1578 my $anchors = $self->format_anchors($element);
367 658         1705 my $fn_num = $element->footnote_index;
368 658         1489 my $fn_symbol = $element->footnote_symbol;
369 658         1068 my $class;
370 658 100       1484 if ($element->type eq 'footnote') {
    50          
371 530         972 $class = 'fnline';
372             }
373             elsif ($element->type eq 'secondary_footnote') {
374 128         237 $class = 'secondary-fnline';
375             }
376             else {
377 0         0 die "wrong type " . $element->type . ' ' . $element->string;
378             }
379 658         3807 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 66991 my ($self, $start_stop, $block, %attributes) = @_;
391 31026 50 33     97043 die "Wrong usage! Missing params $start_stop, $block"
392             unless ($start_stop && $block);
393 31026 50 66     76875 die "Wrong usage!\n" unless ($start_stop eq 'stop' or
394             $start_stop eq 'start');
395 31026         52000 my $table = $self->blk_table;
396             die "Table is missing an element $start_stop $block "
397 31026 50       74710 unless exists $table->{$block}->{$start_stop}->{$self->fmt};
398 31026         58247 my $string = $table->{$block}->{$start_stop}->{$self->fmt};
399 31026 100       57972 if (ref($string)) {
400 1535         5170 return $string->(%attributes);
401             }
402             else {
403 29491         107988 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 18215     18215 1 33713 my ($self, $string) = @_;
435 18215 100       49536 return unless length($string);
436 18202         24833 my @list;
437 18202 100       47220 if ($string =~ m{\A\s*\
\s*\z}) {
438 90         325 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 18112         47284 pos($string) = 0;
446 18112         644552 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 44     44   21133 my %captures = %+;
  44         18174  
  44         419933  
  8423         113996  
477 8423         29931 my $text = delete $captures{text};
478 8423         13996 my $raw = delete $captures{raw};
479 8423         16416 my $position = pos($string);
480 8423 100       20346 if (length($text)) {
481 5563         15831 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 8423         15306 my $inlined_lang = delete $captures{lang};
489 8423 100       15996 if ($inlined_lang) {
490 44         107 $self->document->_add_to_other_language_codes($inlined_lang);
491             }
492 8423   66     18067 my %args = (
493             string => $raw,
494             last_position => $position,
495             fmt => $self->fmt,
496             lang => $inlined_lang || $self->_lang,
497             );
498              
499 8423 100       26070 if (delete $captures{tag}) {
    100          
    50          
500 841         1567 my $close = delete $captures{close};
501 841 100       2078 $args{type} = $close ? 'close' : 'open';
502 841 50       2219 $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         3847 $args{type} = 'inline';
506 2085         3710 $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 5497         12832 my ($type, @rest) = keys %captures;
514 5497 50       13028 die "Too many keys in <$string> the capture hash: @rest" if @rest;
515 5497         9955 delete $captures{$type};
516 5497         9919 $args{type} = $type;
517 5497 100       13077 if ($type eq 'ruby') {
518 19         49 $self->document->set_has_ruby;
519             }
520             }
521 8423 50       16896 die "Unprocessed captures %captures in <$string>" if %captures;
522 8423         28536 push @list, Text::Amuse::InlineElement->new(%args);
523             }
524 18112 100       48561 my $offset = (@list ? $list[-1]->last_position : 0);
525 18112         44037 my $last_chunk = substr $string, $offset;
526 18112         39384 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 18112 50       44333 die "Chunks lost during processing <$string>" unless $string eq join('', map { $_->string } @list);
  32098         63339  
533 18112 100 33     91211 if (@list and $list[0] and $list[0]->type eq 'br') {
      66        
534 32         100 $list[0]->type('noindent');
535             }
536 18112         51881 return @list;
537             }
538              
539             sub manage_regular {
540 18193     18193 1 46798 my ($self, $el, %opts) = @_;
541 18193         25515 my $string;
542 18193         25492 my $insert_primary_footnote = 1;
543 18193         24816 my $insert_secondary_footnote = 1;
544 18193         24825 my $el_object;
545             # we can accept even plain string;
546 18193 100       39238 if (ref($el) eq "") {
547 8256         12562 $string = $el;
548             } else {
549 9937         14224 $el_object = $el;
550 9937         20912 $string = $el->string;
551 9937 100       21573 if ($el->type eq 'footnote') {
    100          
552 919         1624 $insert_primary_footnote = 0;
553             }
554             elsif ($el->type eq 'secondary_footnote') {
555 230         374 $insert_primary_footnote = 0;
556 230         361 $insert_secondary_footnote = 0;
557             }
558             }
559 18193 50       39367 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 18193         35556 my @pieces = $self->inline_elements($string);
567 18193         26463 my @processed;
568 18193         29040 my $current_direction = '';
569             BIDIPROC:
570 18193         36588 while (@pieces) {
571 32060         47480 my $piece = shift @pieces;
572 32060         72938 my %dirs = (
573             '<<<' => 'rtl',
574             '>>>' => 'ltr',
575             );
576 32060 100       63155 if ($piece->type eq 'bidimarker') {
577 90         211 $self->document->set_bidi_document;
578 90 50       211 my $dir = $dirs{$piece->string} or die "Invalid bidimarker " . $piece->string;
579             # we need to close
580 90 100       239 if ($current_direction) {
581 38 50       104 if ($dir ne $current_direction) {
582 38         104 push @processed, Text::Amuse::InlineElement->new(string => '',
583             fmt => $self->fmt,
584             lang => $self->_lang,
585             tag => $current_direction,
586             type => 'close');
587 38         165 $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         106 $current_direction = $dir;
596 52         153 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 31970         86174 push @processed, $piece;
605             }
606             }
607 18193 100       38782 if ($current_direction) {
608 14         51 push @processed, Text::Amuse::InlineElement->new(string => '',
609             fmt => $self->fmt,
610             lang => $self->_lang,
611             tag => $current_direction,
612             type => 'close');
613 14         29 $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 18193         25551 for (my $i = 0; $i <= $#processed; $i++) {
  18193         41916  
628              
629 32074         48269 my $el = $processed[$i];
630 32074 100       62728 if ($el->type eq 'inline') {
631 2077 100 66     7014 if ($i > 0 and $i < $#processed) {
632 1829 100 100     4105 if ($processed[$i - 1]->string =~ m/[[:alnum:]]\z/ and
633             $processed[$i + 1]->string =~ m/\A[[:alnum:]]/) {
634 64         181 $el->type('text');
635 64         136 $el->tag('');
636             }
637             }
638             }
639             }
640             }
641              
642              
643             # print Dumper(\@processed);
644 18193         27095 my @tracking;
645             MARKUP:
646 18193         35602 while (@processed) {
647 32074         45976 my $piece = shift @processed;
648 32074 100       61477 if ($piece->type eq 'inline') {
649 2013 100       4087 my $previous = @pieces ? $pieces[-1] : undef;
650 2013 50       4167 my $next = @processed ? $processed[0] : undef;
651              
652             # first element can only open if there is a next one.
653 2013 100       4807 if (!$previous) {
    50          
654 248 100 50     768 if ($next and
      100        
655 1920         3488 scalar(grep { $_->tag eq $piece->tag } @processed) and
656             $next->string =~ m/\A\S/) {
657 167         296 print "Opening initial " . $piece->string . "\n" if DEBUG;
658 167         553 $piece->type('open_inline');
659 167         308 push @pieces, $piece;
660 167         434 push @tracking, $piece->tag;
661 167         560 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         2168 print $piece->string . " is in the middle\n" if DEBUG;
680             # print Dumper([ \@processed, \@pieces, \@tracking, $next, $previous ]);
681 1765 100 100     5602 if (@tracking and
    100 100        
      100        
      100        
682             $piece->tag eq $tracking[-1] and
683             $previous->string =~ m/\S\z/) {
684 736 50       1765 if ($previous->type ne 'open_inline') {
685 736         1981 $piece->type('close_inline');
686 736         997 print "Closing " . $piece->string . "\n" if DEBUG;
687 736         1229 push @pieces, $piece;
688 736         1050 pop @tracking;
689 736         2189 next MARKUP;
690             }
691             }
692             elsif ($next->string =~ m/\A\S/ and
693             $previous->string =~ m/[[:^alnum:]]\z/ and
694 4911         9248 scalar(grep { $_->tag eq $piece->tag } @processed)) {
695 596         994 print "Opening " . $piece->string . "\n" if DEBUG;
696 596         1654 $piece->type('open_inline');
697 596         958 push @pieces, $piece;
698 596         1359 push @tracking, $piece->tag;
699 596         1918 next MARKUP;
700             }
701             }
702 514         991 print "Nothing to do for " . $piece->string . "\n" if DEBUG;
703             # default to text
704 514         989 $piece->type('text');
705             }
706 30575         64543 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 18193         28996 @tracking = ();
714             # print Dumper(\@pieces);
715              
716 18193         27358 my $chomped_string = $string;
717 18193         34768 chomp($chomped_string);
718              
719             my $format_warning = sub {
720 62     62   132 my ($type, $tag) = @_;
721 62         110 my $matching = 'closing';
722 62 100 66     258 if ($type eq 'close' or $type eq 'close_inline') {
723 36         56 $matching = 'opening';
724             }
725 62         5335 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 18193         89759 };
730              
731             UNROLL:
732 18193         41603 while (@pieces) {
733 32074         45172 my $piece = shift @pieces;
734 32074 100       68296 if ($piece->type eq 'open_inline') {
    100          
735             # check if we have a matching close in the rest of the string
736 763 100       1442 if (grep { $_->type eq 'close_inline' and $_->tag eq $piece->tag } @pieces) {
  6090 100       11393  
737 750         1756 push @tracking, $piece->tag;
738 750         2050 push @processed, $piece->unroll;
739 750         3218 next UNROLL;
740             }
741             else {
742 13         47 warn $format_warning->($piece->type, $piece->tag);
743 13         104 $piece->type('text');
744             }
745             }
746             elsif ($piece->type eq 'close_inline') {
747 736 50 33     2634 if (@tracking and $tracking[-1] eq $piece->tag) {
748 736         1803 push @processed, $piece->unroll;
749 736         1462 pop @tracking;
750 736         2829 next UNROLL;
751             }
752             else {
753 0         0 warn $format_warning->($piece->type, $piece->tag);
754 0         0 $piece->type('text');
755             }
756             }
757 30588         65986 push @processed, $piece;
758             }
759              
760             # print Dumper(\@processed);
761              
762             # now validate the tags: open and close
763 18193         25739 my @tagpile;
764             INLINETAG:
765 18193         36630 while (@processed) {
766 32278         44752 my $piece = shift @processed;
767 32278 100       64243 if ($piece->type eq 'open') {
    100          
768             # look forward for a matching tag
769 1310 100       2645 if (grep { $_->type eq 'close' and $_->tag eq $piece->tag } @processed) {
  12765 100       23277  
770 1297         3203 push @tagpile, $piece->tag;
771             }
772             else {
773 13         44 warn $format_warning->($piece->type, $piece->tag);
774 13         156 $piece->type('text');
775             }
776             }
777             elsif ($piece->type eq 'close') {
778             # check if there is a matching opening
779 1313 100 66     4258 if (@tagpile and $tagpile[-1] eq $piece->tag) {
780             # all match, can go
781             # and remove from the pile
782 1277         1885 pop @tagpile;
783 1277 100 66     2915 if ($pieces[-1]->type eq 'open' and
784             $pieces[-1]->tag eq $piece->tag) {
785 36         49 pop @pieces;
786 36         166 next INLINETAG;
787             }
788             }
789             else {
790 36         90 warn $format_warning->($piece->type, $piece->tag);
791 36         275 $piece->type('text');
792             }
793             }
794 32242         68752 push @pieces, $piece;
795             }
796              
797             # print Dumper(\@pieces);
798              
799 18193         35930 while (@tagpile) {
800 20         43 my $unclosed = pop @tagpile;
801 20         964 warn "Found unclosed tag $unclosed in string <$string>, closing it\n";
802 20         134 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 18193         25268 my @out;
811             CHUNK:
812 18193         33375 while (@pieces) {
813 32226         48540 my $piece = shift @pieces;
814 32226 100       66163 if ($piece->type eq 'link') {
    100          
    100          
815 1774 100       4269 if ($opts{nolinks}) {
816 120         269 $piece->type('text');
817             }
818             else {
819 1654         3797 push @out, $self->linkify($piece->string);
820 1654         7978 next CHUNK;
821             }
822             }
823             elsif ($piece->type eq 'pri_footnote') {
824 1264 100 100     4426 if ($insert_primary_footnote and
825             my $pri_fn = $self->document->get_footnote($piece->string)) {
826 919 100 100     2167 if ($self->is_html and $piece->string =~ m/\A(\s+)/) {
827 511         1299 push @out, $1;
828             }
829 919         2612 push @out, $self->_format_footnote($pri_fn);
830 919         4522 next CHUNK;
831             }
832             else {
833 345         864 $piece->type('text');
834             }
835             }
836             elsif ($piece->type eq 'sec_footnote') {
837 312 100 100     1147 if ($insert_secondary_footnote and
838             my $sec_fn = $self->document->get_footnote($piece->string)) {
839 230 100 100     565 if ($self->is_html and $piece->string =~ m/\A(\s+)/) {
840 125         328 push @out, $1;
841             }
842 230         739 push @out, $self->_format_footnote($sec_fn);
843 230         1166 next CHUNK;
844             }
845             else {
846 82         215 $piece->type('text');
847             }
848             }
849 29423         65900 push @out, $piece->stringify;
850             }
851 18193         130166 return join('', @out);
852             }
853              
854             sub _format_footnote {
855 1149     1149   2230 my ($self, $element) = @_;
856 1149 100       2236 if ($self->is_latex) {
    50          
857             # print "Calling manage_regular from format_footnote " . Dumper($element);
858 491         1445 my $footnote = $self->manage_regular($element);
859 491         1442 my $anchors = $self->format_anchors($element);
860 491         6167 $footnote =~ s/\s+/ /gs;
861 491         3426 $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         1654 $footnote =~ s/\\forcelinebreak /\\protect\\endgraf /g;
869 491 100       1367 if ($element->type eq 'secondary_footnote') {
870 102         470 return '\footnoteB{' . $anchors . $footnote . '}';
871             }
872             else {
873 389         1736 return '\footnote{' . $anchors . $footnote . '}';
874             }
875             } elsif ($self->is_html) {
876             # in html, just remember the number
877 658         1905 $self->add_footnote($element);
878 658         1686 my $fn_num = $element->footnote_index;
879 658         1450 my $fn_symbol = $element->footnote_symbol;
880             return
881 658         3770 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 3028 my ($self, $string) = @_;
898 1617         3292 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 14744 my ($self, $el) = @_;
912 8093         17747 my $body = $self->manage_regular($el);
913 8093         17760 chomp $body;
914 8093         18587 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 3373 my ($self, $el) = @_;
923             # print Dumper([$el->anchors]);
924              
925 1691         3815 my ($short, $long) = split(/\s+\|\s+/, $el->string, 2);
926 1691 100 66     5140 unless (defined($long) and length($long)) {
927 1653         2908 $long = $short;
928             }
929 1691         2579 my $body_with_no_footnotes = $short;
930             my $catch_fn = sub {
931 433     433   1013 my $fn = $_[0];
932             # replace only real footnotes
933 433 100       1020 if ($self->document->get_footnote($fn)) {
934 417         1770 return ''
935             } else {
936 16         71 return $fn;
937             }
938 1691         6617 };
939 1691         7982 $body_with_no_footnotes =~ s/(
940             \{ [1-9][0-9]* \}
941             |
942             \[ [1-9][0-9]* \]
943             )
944 433         1134 /$catch_fn->($1)/gxe;
945 1691         6578 undef $catch_fn;
946 1691         4229 my ($first_anchor) = $el->anchors;
947             # just in case, should be already vadidated
948 1691 100 66     4958 if ($first_anchor and $first_anchor =~ m/[A-Za-z0-9]/) {
949 149         350 $first_anchor =~ s/[^A-Za-z0-9-]//g;
950 149         426 $first_anchor = 'text-amuse-label-' . $first_anchor;
951             }
952 1691         4011 my $anchors = $self->format_anchors($el);
953 1691         4443 my ($body_for_toc) = $self->manage_regular($body_with_no_footnotes, nolinks => 1);
954 1691         4276 my ($body) = $self->manage_regular($long, nolinks => 1);
955 1691         9964 $body_for_toc =~ s/\s+\z//;
956 1691         7437 $body =~ s/\s+\z//;
957              
958 1691 100       5845 my $leading = $self->blkstring(start => $el->type,
959             toc_entry => ($body ne $body_for_toc ? $body_for_toc : undef));
960 1691         4778 my $trailing = $self->blkstring(stop => $el->type);
961 1691 100       3979 if ($anchors) {
962 149 100       348 if ($self->is_html) {
    50          
963             #insert the before the text
964 88         294 $leading .= $anchors;
965             }
966             elsif ($self->is_latex) {
967             # latex doesn't like it inside \chapter{}
968 61         152 $trailing .= $anchors;
969             }
970 0         0 else { die "Not reached" }
971             }
972             # add them to the ToC for html output;
973 1691 100       3861 if ($el->type =~ m/h([1-4])/) {
974 1542         4249 my $level = $1;
975 1542         2327 my $tocline = $body;
976 1542 50       4552 my $index = $self->add_to_table_of_contents($level => (defined($body_for_toc) ? $body_for_toc : $body),
977             $first_anchor,
978             );
979 1542         3445 $level++; # increment by one
980 1542 50       3045 die "wtf, no index for toc?" unless $index;
981              
982             # inject the id into the html ToC (and the anchor)
983 1542 100       3431 if ($self->is_html) {
984 869         2751 $leading = "
985             qq{ id="toc$index">} . $anchors;
986             }
987             }
988 1691         9086 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 3762 my ($self, $level, $string, $named) = @_;
1002 1542 50 33     5572 return unless ($level and defined($string));
1003 1542 100       3718 unless (defined $self->{_toc_entries}) {
1004 311         927 $self->{_toc_entries} = [];
1005             }
1006 1542         2249 my $index = scalar(@{$self->{_toc_entries}});
  1542         2730  
1007 1542 100       2302 push @{$self->{_toc_entries}}, { level => $level,
  1542         7658  
1008             string => $string,
1009             index => ++$index,
1010             ($named ? (named => $named) : ())
1011             };
1012 1542         3413 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 1024     1024 1 1907 my $self = shift;
1024 1024 100       4102 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 1427 my $self = shift;
1062 221         513 my $internal_toc = $self->{_toc_entries};
1063 221         353 my @toc;
1064 221 100       875 return @toc unless $internal_toc; # no ToC gets undef
1065             # do a deep copy and return;
1066 117         381 foreach my $entry (@$internal_toc) {
1067 584         2533 push @toc, { %$entry };
1068             }
1069 117         493 return @toc;
1070             }
1071              
1072             =item manage_verse
1073              
1074             =cut
1075              
1076             sub manage_verse {
1077 296     296 1 685 my ($self, $el) = @_;
1078 296         523 my ($lead, $stanzasep);
1079 296 100       661 if ($self->is_html) {
    50          
1080 152         379 $lead = ' ';
1081 152         293 $stanzasep = "\n

\n";
1082             }
1083             elsif ($self->is_latex) {
1084 144         283 $lead = "~";
1085 144         267 $stanzasep = "\n\n";
1086             }
1087 0         0 else { die "Not reached" }
1088              
1089 296         789 my (@chunks) = split(/\n/, $el->string);
1090              
1091             # remove useless
triggering LaTeX errors
1092 296         1494 s/
\s*\z// for @chunks;
1093              
1094 296         581 my (@out, @stanza);
1095 296         631 foreach my $l (@chunks) {
1096 778 100       4706 if ($l =~ m/\A( *)(.+?)\z/s) {
    50          
1097 648         2214 my $leading = $lead x length($1);
1098 648         1639 my $text = $self->manage_regular($2);
1099 648 50       2094 if (length($text)) {
1100 648         2047 push @stanza, $leading . $text;
1101             }
1102             }
1103             elsif ($l =~ m/\A\s*\z/s) {
1104 130         417 push @out, $self->_format_stanza(\@stanza);
1105 130 50       452 die "wtf" if @stanza;
1106             }
1107             else {
1108 0         0 die "wtf?";
1109             }
1110             }
1111             # flush the stanzas
1112 296 100       1213 push @out, $self->_format_stanza(\@stanza) if @stanza;
1113 296 50       807 die "wtf" if @stanza;
1114              
1115             # process
1116 296         982 return $self->blkstring(start => $el->type) .
1117             join($stanzasep, @out) . $self->blkstring(stop => $el->type);
1118             }
1119              
1120             sub _format_stanza {
1121 408     408   888 my ($self, $stanza) = @_;
1122              
1123 408         604 my $eol;
1124 408 100       935 if ($self->is_html) {
    50          
1125 209         409 $eol = "
\n";
1126             }
1127             elsif ($self->is_latex) {
1128 199         378 $eol = " \\\\{}\n";
1129             }
1130 0         0 else { die "Not reached" };
1131              
1132 408         796 my $stanza_string = '';
1133 408 100       1178 if (@$stanza) {
1134 396         1026 $stanza_string = join($eol, @$stanza);
1135 396         811 @$stanza = ();
1136             }
1137 408         965 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 337 my ($self, $el) = @_;
1149 138         395 my $body = $self->safe($el->string);
1150 138         997 $body =~ s/\n\z//;
1151 138         675 $body =~ s/\s/ /g; # remove eventual newlines, even we don't expect any
1152              
1153 138 100       444 if ($self->is_html) {
    50          
1154 69         404 return q{\n};
1155             }
1156             elsif ($self->is_latex) {
1157 69         373 return q{% } . $body . "\n";
1158             }
1159             else {
1160 0         0 die "Not reached";
1161             }
1162             }
1163              
1164             sub manage_comment {
1165 70     70 1 190 my ($self, $el) = @_;
1166 70         188 my $body = $self->safe($el->string);
1167 70         293 chomp $body;
1168 70         254 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 577 my ($self, $el) = @_;
1178 220         637 my $thash = $self->_split_table_in_hash($el->string);
1179 220 100       696 if ($self->is_html) {
    50          
1180 114         382 return $self->manage_table_html($thash);
1181             }
1182             elsif ($self->is_latex) {
1183 106         346 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 307 my ($self, $table) = @_;
1194 114         206 my @out;
1195 114         355 my $map = $self->html_table_mapping;
1196             # here it's full of hardcoded things, but it can't be done differently
1197 114         235 my $attrs = '';
1198 114 100       349 if ($table->{specification}) {
1199 33         58 $attrs =q{ class="markdown-style-table" style="width:100%"}
1200             }
1201 114         356 push @out, "\n";
1202              
1203             # the hash is always defined
1204 114 100       321 if ($table->{caption} ne "") {
1205             push @out, "
"
1206             . $self->manage_regular($table->{caption})
1207 41         139 . "";
1208             }
1209              
1210 114         317 foreach my $tablepart (qw/head foot body/) {
1211 342 100       485 next unless @{$table->{$tablepart}};
  342         954  
1212 208         503 push @out, $map->{$tablepart}->{b};
1213 208         308 while (@{$table->{$tablepart}}) {
  693         1769  
1214 485         701 my $cells = shift @{$table->{$tablepart}};
  485         953  
1215              
1216 485         853 push @out, $map->{btr};
1217 485         1132 my @cells = @$cells;
1218 485         755 my $i = 0;
1219 485         1086 for (my $i = 0; $i < @cells; $i++) {
1220 1382         2538 my $cell = $cells[$i];
1221 1382         1905 my $spec;
1222 1382 100       2919 if ($table->{specification}) {
1223 237         400 $spec = $table->{specification}->[$i];
1224             }
1225             push @out, $map->{$tablepart}->{bcell}->($spec),
1226             $self->manage_regular($cell),
1227             $map->{$tablepart}->{ecell},
1228 1382         3036 }
1229 485         1063 push @out, $map->{etr};
1230 485         1320 $i++;
1231             }
1232 208         570 push @out, $map->{$tablepart}->{e};
1233             }
1234 114         268 push @out, "
\n"; 1235 114         2670 return join("\n", @out); 1236             } 1237               1238             =item manage_table_ltx 1239               1240             =cut 1241               1242             sub manage_table_ltx { 1243 106     106 1 255 my ($self, $table) = @_; 1244               1245 106         432 my $out = { 1246             body => [], 1247             head => [], 1248             foot => [], 1249             }; 1250 106         271 foreach my $t (qw/body head foot/) { 1251 318         492 foreach my $rt (@{$table->{$t}}) {   318         718   1252 447         714 my @row; 1253 447         772 foreach my $cell (@$rt) { 1254             # escape all! 1255 1291         2801 push @row, $self->manage_regular($cell); 1256             } 1257 447         1246 my $texrow = join(q{ & }, @row); 1258 447         696 push @{$out->{$t}}, "\\relax " . $texrow . " \\\\\n"   447         2047   1259             } 1260             } 1261             # then we loop over what we have. First head, then body, and 1262             # finally foot 1263 106         280 my $has_caption; 1264 106 100 66     762 if (defined $table->{caption} and $table->{caption} ne '') { 1265 35         94 $has_caption = 1; 1266             } 1267 106         208 my $textable = ''; 1268 106 100       390 if ($has_caption) { 1269 35         89 $textable .= "\\begin{table}[htbp!]\n"; 1270             } 1271             else { 1272 71         155 $textable .= "\\bigskip\n\\noindent\n"; 1273             } 1274 106         200 $textable .= " \\begin{minipage}[t]{\\textwidth}\n"; 1275 106         200 $textable .= "\\begin{tabularx}{\\textwidth}{" ; 1276               1277 106 100       270 if ($table->{specification}) { 1278 33         53 $textable .= join('', @{$table->{specification}});   33         83   1279             } 1280             else { 1281             # back compat 1282 73         240 $textable .= "|X" x $table->{counter}; 1283 73         140 $textable .= "|"; 1284             } 1285 106         222 $textable .= "}\n"; 1286 106 100       300 if (!$table->{specification}) { 1287 73         151 $textable .= "\\hline\n"; 1288             } 1289 106 100       176 if (my @head = @{$out->{head}}) {   106         386   1290 53         155 $textable .= join("", @head) . "\\hline\n"; 1291             } 1292 106 50       190 if (my @body = @{$out->{body}}) {   106         487   1293 106         338 $textable .= join("", @body); 1294             } 1295 106 100       194 if (my @foot = @{$out->{foot}}) {   106         347   1296 29         103 $textable .= "\\hline\n" . join("", @foot); 1297             } 1298 106 100       288 if (!$table->{specification}) { 1299 73         219 $textable .= "\\hline\n"; 1300             } 1301 106         205 $textable .= "\\end{tabularx}\n"; 1302 106 100       288 if ($has_caption) { 1303             $textable .= "\n\\caption[]{" . 1304             $self->manage_regular($table->{caption}) 1305 35         108 . "}\n"; 1306             } 1307 106         228 $textable .= "\\end{minipage}\n"; 1308 106 100       253 if ($has_caption) { 1309 35         74 $textable .= "\\end{table}\n"; 1310             } 1311             else { 1312 71         184 $textable .= "\\bigskip\n"; 1313             } 1314 106         191 $textable .= "\n"; 1315             # print $textable; 1316 106         1251 return $textable; 1317             } 1318               1319             =item _split_table_in_hash 1320               1321             =cut 1322               1323             sub _table_row_specification { 1324 878     878   1492 my ($self, $cells) = @_; 1325 878         1162 my @spec; 1326 878         1408 foreach my $c (@$cells) { 1327             # print "Examining $c\n"; 1328 1022 100       3033 if ($c =~ m/\A\s*\:?---+\:?\s*\z/) {     100           1329 174 100       598 if ($c =~ m/\:-+\:/) {     100               100           1330 54         104 push @spec, 'c'; 1331             } 1332             elsif ($c =~ m/\:-/) { 1333 18         39 push @spec, 'l'; 1334             } 1335             elsif ($c =~ m/-\:/) { 1336 18         40 push @spec, 'r'; 1337             } 1338             else { 1339 84         180 push @spec, 'X'; 1340             } 1341             } 1342             elsif ($c =~ m/\A\s*---+\s*([0-9]+)\s*---+\s*\z/) { 1343 36         104 my $percentage = $1; 1344 36 100 66     164 if ($percentage > 0 and $percentage < 100) { 1345 30         259 push @spec, 'p{' . sprintf('%.2f', $percentage / 100) . "\\textwidth}"; 1346             } 1347             else { 1348 6         626 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         1097 @spec = (); 1355 812         1207 last; 1356             } 1357             } 1358 878 100 66     2175 if (@spec and @spec == @$cells) { 1359 66         292 return @spec; 1360             } 1361             else { 1362 812         2057 return; 1363             } 1364             } 1365               1366             sub _split_table_in_hash { 1367 220     220   526 my ($self, $table) = @_; 1368 220 50       607 return {} unless $table; 1369 220         1254 my $output = { 1370             caption => "", 1371             body => [], 1372             head => [], 1373             foot => [], 1374             counter => 0, 1375             specification => undef, 1376             }; 1377               1378             # remove the caption 1379 220         401 my @rows; 1380 220         377 my $caption_done = 0; 1381 220         1609 foreach my $r (split(/\n/, $table)) { 1382 1074 100       2547 if ($r =~ m/\A\s*\|\+\s*(.+?)\s*\+\|\s*\z/) { 1383 76         299 $output->{caption} = $1; 1384 76         179 $caption_done++; 1385             } 1386             else { 1387 998         1700 push @rows, $r; 1388             } 1389             } 1390               1391 220         420 my $empty_first_cell = 0; 1392 220         388 my @row_cells; 1393 220         467 foreach my $r (@rows) { 1394 998         4196 my @cells = split /\|+/, $r; 1395 998         1643 my $type = 'body'; 1396 998 100       2900 if ($r =~ m/\|\|\|/) {     100           1397 70         139 $type = 'foot'; 1398             } 1399             elsif ($r =~ m/\|\|/) { 1400 88         187 $type = 'head'; 1401             } 1402 998 100       3097 if ($cells[0] =~ /\A\s*\z/) { 1403 227         364 $empty_first_cell++; 1404             } 1405 998         3081 push @row_cells, { 1406             cells => \@cells, 1407             type => $type, 1408             }; 1409             } 1410               1411             # consistently empty first cell: nuke 1412 220 100       712 if ($empty_first_cell == @row_cells) { 1413 69         144 foreach my $r (@row_cells) { 1414 191         251 shift @{$r->{cells}};   191         377   1415             } 1416             } 1417               1418             ROW: 1419 220         759 for (my $i = 0; $i < @row_cells; $i++) { 1420               1421 998         1449 my @cells = @{$row_cells[$i]{cells}};   998         2556   1422 998         1738 my $type = $row_cells[$i]{type}; 1423               1424 998 100       2110 if ($output->{counter} < scalar(@cells)) { 1425 220         497 $output->{counter} = scalar(@cells); 1426             } 1427 998 100       1948 if (!$output->{specification}) { 1428             # print Dumper(\@cells); 1429 878 100       1807 if (my @spec = $self->_table_row_specification(\@cells)) { 1430 66         130 $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     57 if (@{$output->{body}} == 1 and @{$output->{head}} == 0) {   36         102     30         90   1437 30         44 push @{$output->{head}}, shift @{$output->{body}};   30         53     30         66   1438             } 1439             } 1440 66         266 next ROW; 1441             } 1442             } 1443 932         1340 push @{$output->{$type}}, \@cells;   932         2979   1444             } 1445               1446             # pad the cells with " " if their number doesn't match 1447 220         551 foreach my $part (qw/body head foot/) { 1448 660         928 foreach my $row (@{$output->{$part}}) {   660         1279   1449 932         2058 while (@$row < $output->{counter}) { 1450             # warn "Found uneven table: " . join (":", @$row), "\n"; 1451 96         225 push @$row, " "; 1452             } 1453             } 1454             } 1455               1456             # pad the specification with X if short. 1457 220 100       665 if (my $spec = $output->{specification}) { 1458 66         155 while (@$spec < $output->{counter}) { 1459 0         0 push @$spec, 'X'; 1460             } 1461             } 1462 220         1293 return $output; 1463             } 1464               1465             =item manage_example 1466               1467             =cut 1468               1469             sub manage_example { 1470 450     450 1 1022 my ($self, $el) = @_; 1471 450         1241 my $body = $self->safe($el->string); 1472 450         2121 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 118 my ($self, $el) = @_; 1484 48 50       147 die "Wtf?" if $el->string =~ m/\w/s; # don't eat chars by mistake 1485 48 100       142 if ($self->is_html) {     50           1486 24         84 return "\n
\n"; 1487             } 1488             elsif ($self->is_latex) { 1489 24         87 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 159 my ($self, $el) = @_; 1502 71 50       196 die "Wtf? " . $el->string if $el->string =~ m/\w/s; # don't eat chars by mistake 1503 71 100       189 if ($self->is_html) {     50           1504 39         120 my $out = $self->blkstring(start => 'center') . 1505             $self->manage_paragraph($el) . 1506             $self->blkstring(stop => 'center'); 1507 39         155 return $out; 1508             } 1509             elsif ($self->is_latex) { 1510 32         152 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 3204 my ($self, $link) = @_; 1529 1654 50       4007 die "no link passed" unless defined $link; 1530             # warn "Linkifying $link"; 1531 1654 100       16209 if ($link =~ m/\A\[\[     50           1532             \s* 1533             (.+?) # link 1534             \s* 1535             \]\[ 1536             \s* 1537             (.+?) # desc 1538             \s* 1539             \]\]\z 1540             /sx) { 1541 1168         3367 return $self->format_links($1, $2); 1542             } 1543               1544             elsif ($link =~ m/\[\[ 1545             \s* 1546             (.+?) # link 1547             \s* 1548             \]\]/sx) { 1549 486         1501 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 4721 my ($self, $link, $desc) = @_; 1563 1168         3357 $desc = $self->manage_regular($desc); 1564             # first the images 1565 1168 100       3651 if (my $image = $self->find_image($link)) { 1566 100         341 my $src = $image->filename; 1567 100         293 $self->document->attachments($src); 1568 100         354 $image->desc($desc); 1569 100         311 return $image->output; 1570             } 1571             # links 1572 1068 100       4738 if ($link =~ m/\A\#([A-Za-z][A-Za-z0-9-]*)\z/) { 1573 826         2224 my $linkname = $1; 1574 826 100       1891 if ($self->is_html) {     50           1575 417         1219 $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         832 $desc =~ s/\?\?/\\pageref*{textamuse:$linkname}/g; 1582 409         1968 return "\\hyperref{}{amuse}{$linkname}{$desc}"; 1583             } 1584             } 1585               1586 659 100       1516 if ($self->is_html) {     50           1587 539         1432 $link = $self->_url_safe_escape($link); 1588 539         2668 return qq{$desc}; 1589             } 1590             elsif ($self->is_latex) { 1591 120         363 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 1655 my ($self, $link) = @_; 1604             # the re matches only clean names, no need to escape anything 1605 486 100       1309 if (my $image = $self->find_image($link)) { 1606 320         914 $self->document->attachments($image->filename); 1607 320         947 return $image->output; 1608             } 1609 166 100       574 if ($link =~ m/\A\#([A-Za-z][A-Za-z0-9]+)\z/) { 1610 16         48 my $linkname = $1; 1611             # link is sane and safe 1612 16 100       45 if ($self->is_html) {     50           1613 10         38 $link = "#text-amuse-label-$linkname"; 1614 10         73 return qq{$linkname}; 1615             } 1616             elsif ($self->is_latex) { 1617 6         33 return "\\hyperref{}{amuse}{$linkname}{$linkname}"; 1618             } 1619             } 1620               1621 150         413 my $url = $self->_url_safe_escape($link); 1622 150         403 my $desc = $self->safe($link); 1623 150 100       599 if ($self->is_html) {     50           1624 78         420 return qq{$desc}; 1625             } 1626             elsif ($self->is_latex) { 1627 72         403 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   1595 my ($self, $string) = @_; 1638 809         2282 utf8::encode($string); 1639 809         2214 $string =~ s/([^0-9a-zA-Z\.\/\:\;_\%\&\#\?\=\@\-]) 1640 638         2167 /sprintf("%%%02X", ord ($1))/gesx; 1641 809         1973 my $escaped = $self->safe($string); 1642 809         3256 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 44627 my $self = shift; 1659 31026 100       62012 unless ($self->{_block_table_map}) { 1660 742         2167 $self->{_block_table_map} = $self->_build_blk_table; 1661             } 1662 31026         52497 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   25 my %attrs = @_; 1671 8   50     30 my $lang = $attrs{language} || "en"; 1672 8         48 return qq{
\n}; 1673             }, 1674             ltx => sub { 1675 8     8   27 my %attrs = @_; 1676 8   50     28 my $iso = $attrs{language} || "en"; 1677 8         29 my $lang = Text::Amuse::Utils::language_mapping()->{$iso}; 1678 8   50     303 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   312 _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   973 _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   738 _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   274 _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   229 _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   553 _html_ol_element(n => @_); 1895             }, 1896             ltx => sub { 1897 142     142   516 _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   208 _html_ol_element(i => @_); 1910             }, 1911             ltx => sub { 1912 63     63   208 _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   172 _html_ol_element(I => @_); 1925             }, 1926             ltx => sub { 1927 42     42   164 _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   187 _html_ol_element(A => @_); 1940             }, 1941             ltx => sub { 1942 39     39   128 _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   319 _html_ol_element(a => @_); 1955             }, 1956             ltx => sub { 1957 92     92   291 _ltx_enum_element(a => @_); 1958             }, 1959             }, 1960 742     742   76955 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         5058 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 2690     2690 1 11190 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 7101 my ($self, $link) = @_; 2038 1666         3532 my $imagere = $self->image_re; 2039 1666 100       12087 if ($link =~ m/\A$imagere\z/s) { 2040 430         1184 my $filename = $1; 2041 430         835 my $width = $4; 2042 430         787 my $float = $6; 2043 430         711 my $rotate = $9; 2044 430         1138 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         5043 return; 2053             } 2054             } 2055               2056               2057             =item url_re 2058               2059             =cut 2060               2061             sub url_re { 2062 56     56 1 25733 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   2590 my ($tag, $spec) = @_; 2079 1382         2047 my $attrs = ''; 2080 1382 100       2543 if ($spec) { 2081 237         672 my %specs = ( 2082             c => 'center', 2083             l => 'left', 2084             r => 'right', 2085             ); 2086 237 100       739 if (my $align = $specs{$spec}) {     100           2087 117         322 $attrs = qq{ style="text-align:$align"}; 2088             } 2089             elsif ($spec =~ m/p\{0\.([0-9][0-9])\\textwidth/) { 2090 15         65 $attrs = qq{ style="width:$1%" }; 2091             } 2092             } 2093 1382         5051 return '<' . $tag . $attrs . '>'; 2094             } 2095               2096             sub html_table_mapping { 2097             return { 2098             head => { 2099             b => " ", 2100             e => " ", 2101             bcell => sub { 2102 152     152   375 return " " . _format_table_tag(th => @_); 2103             }, 2104             ecell => " ", 2105             }, 2106             foot => { 2107             b => " ", 2108             e => " ", 2109             bcell => sub { 2110 107     107   310 return " " . _format_table_tag(td => @_); 2111             }, 2112             ecell => " ", 2113             }, 2114             body => { 2115             b => " ", 2116             e => " ", 2117             bcell => sub { 2118 1123     1123   2502 return " " . _format_table_tag(td => @_); 2119             }, 2120 114     114 1 1745 ecell => " ", 2121             }, 2122             btr => " ", 2123             etr => " ", 2124             }; 2125             } 2126               2127             sub _html_ol_element { 2128 399     399   1222 my ($type, %attributes) = @_; 2129 399         1671 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         715 my $ol_type = ''; 2138 399 100       944 if ($map{$type}) { 2139 251         609 $ol_type = qq{ style="list-style-type:$map{$type}"}; 2140             } 2141 399         716 my $start = $attributes{start_list_index}; 2142 399         645 my $start_string = ''; 2143 399 100 33     3519 if ($start and $start =~ m/\A[0-9]+\z/ and $start > 1) {       66         2144 99         283 $start_string = qq{ start="$start"}; 2145             } 2146 399         2685 return "\n\n"; 2147             } 2148               2149             sub _ltx_enum_element { 2150 378     378   1149 my ($type, %attributes) = @_; 2151 378         1566 my %map = ( 2152             1 => '1', 2153             i => 'i', 2154             I => 'I', 2155             A => 'A', 2156             a => 'a', 2157             ); 2158 378         604 my $string = "\n\\begin{enumerate}["; 2159 378   50     985 my $type_string = $map{$type} || '1'; 2160               2161 378         624 my $start = $attributes{start_list_index}; 2162 378         625 my $start_string = ''; 2163 378 100 33     3324 if ($start and $start =~ m/\A[0-9]+\z/ and $start > 1) {       66         2164 96         231 $start_string = qq{, start=$start}; 2165             } 2166 378         2427 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   1927 my ($name, %attributes) = @_; 2173 734 100       1756 if (defined $attributes{toc_entry}) { 2174 120         530 $attributes{toc_entry} =~ s/\s+/ /g; 2175             # we use the grouping here, to avoid chocking on [ ] 2176 120         613 return "\\" . $name . '[{' . $attributes{toc_entry} . '}]{' 2177             } 2178             else { 2179 614         2635 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 39448 my ($self, $el) = @_; 2191 22146         31810 my $out = ''; 2192 22146 100       53580 if (my @anchors = map { Text::Amuse::InlineElement->new(string => $_,   812         2070   2193             type => 'anchor', 2194             lang => $self->_lang, 2195             fmt => $self->fmt)->stringify } $el->anchors) { 2196 609         2963 return join('', @anchors); 2197             } 2198 21537         63515 return $out; 2199             } 2200               2201             =back 2202               2203             =cut 2204               2205             1;