File Coverage

blib/lib/Text/Amuse.pm
Criterion Covered Total %
statement 174 184 94.5
branch 62 68 91.1
condition 6 11 54.5
subroutine 38 42 90.4
pod 30 30 100.0
total 310 335 92.5


line stmt bran cond sub pod time code
1             package Text::Amuse;
2              
3 41     41   1097023 use strict;
  41         234  
  41         1050  
4 41     41   181 use warnings;
  41         61  
  41         964  
5             # use Data::Dumper;
6 41     41   17025 use Text::Amuse::Document;
  41         339  
  41         1306  
7 41     41   23657 use Text::Amuse::Output;
  41         117  
  41         1523  
8 41     41   15682 use Text::Amuse::Beamer;
  41         108  
  41         1081  
9 41     41   219 use Text::Amuse::Utils;
  41         79  
  41         81775  
10              
11             =head1 NAME
12              
13             Text::Amuse - Generate HTML and LaTeX documents from Emacs Muse markup.
14              
15             =head1 VERSION
16              
17             Version 1.82
18              
19             =cut
20              
21             our $VERSION = '1.82';
22              
23              
24             =head1 SYNOPSIS
25              
26             Typical usage which should illustrate all the public methods
27              
28             use Text::Amuse;
29             my $doc = Text::Amuse->new(file => "test.muse");
30              
31             # get the title, author, etc. as an hashref
32             my $html_directives = $doc->header_as_html;
33              
34             # get the table of contents
35             my $html_toc = $doc->toc_as_html;
36              
37             # get the body
38             my $html_body = $doc->as_html;
39              
40             # same for LaTeX
41             my $latex_directives = $doc->header_as_latex;
42             my $latex_body = $doc->as_latex;
43              
44             # do we need a \tableofcontents ?
45             my $wants_toc = $doc->wants_toc; # (boolean)
46              
47             # files attached
48             my @images = $doc->attachments;
49              
50             # at this point you can inject the values in a template, which is
51             # left to the user. If you want an executable, please install
52             # Text::Amuse::Compile.
53              
54             =head1 CONSTRUCTORS
55              
56             =over 4
57              
58             =item new (file => $file, partial => \@parts, include_paths => \@paths)
59              
60             Create a new Text::Amuse object. You should pass the named parameter
61             C, pointing to a muse file to process. Please note that you
62             can't pass a string. Build a wrapper going through a temporary file if
63             you need to pass strings.
64              
65             Optionally, accept a C option pointing to an arrayref of
66             integers, meaning that only those chunks will be needed.
67              
68             The beamer output doesn't take C in account.
69              
70             Optionally, accept a C argument, with an arrayref of
71             directories to search for included files.
72              
73             =cut
74              
75             sub new {
76 646     646 1 620303 my $class = shift;
77 646         2775 my %opts = @_;
78             my $self = {
79             file => $opts{file},
80             debug => $opts{debug},
81 646         3616 partials => undef,
82             };
83 646 100       2503 if (my $chunks = $opts{partial}) {
84 9 100       42 die "partial needs an arrayref" unless ref($chunks) eq 'ARRAY';
85 7         9 my %partials;
86 7         14 foreach my $chunk (@$chunks) {
87 17 50       25 if (defined $chunk) {
88 17 100       53 if ($chunk =~ m/\A
89             (pre | post | [0-9] | [1-9][0-9]+ )
90             \z/x) {
91 16         36 $partials{$1} = 1;
92             }
93             else {
94 1         8 die q{Partials should be integers or strings "pre", "post"};
95             }
96             }
97             }
98 6 100       12 if (%partials) {
99 5         11 $self->{partials} = \%partials;
100             }
101             }
102              
103             $self->{_document_obj} =
104             Text::Amuse::Document->new(file => $self->{file},
105             include_paths => $opts{include_paths},
106 643         6268 debug => $self->{debug});
107 643         6383 bless $self, $class;
108             }
109              
110             =back
111              
112             =head1 METHODS
113              
114             =over 4
115              
116             =item document
117              
118             Accessor to the L object. [Internal]
119              
120             =item file
121              
122             Accessor to the file passed in the constructor (read-only)
123              
124             =item partials
125              
126             Return an hashref where the keys are the chunk indexes and the values
127             are true, undef otherwise.
128              
129             =item include_paths
130              
131             Return a list of directory to look into for included files
132              
133             =item included_files
134              
135             Return the list of files included
136              
137             =cut
138              
139             sub document {
140 1118     1118 1 7469 return shift->{_document_obj};
141             }
142              
143             sub include_paths {
144 4     4 1 24 return shift->document->include_paths;
145             }
146              
147             sub included_files {
148 7     7 1 16 my $self = shift;
149 7         12 $self->document->raw_body; # call it to get it populated
150 7         13 return $self->document->included_files;
151             }
152              
153              
154             sub partials {
155 1006     1006 1 2101 my $self = shift;
156 1006 100       2454 if (my $partials = $self->{partials}) {
157 20         119 return { %$partials };
158             }
159             else {
160 986         2813 return undef;
161             }
162             }
163              
164             sub file {
165 2     2 1 9 return shift->{file};
166             }
167              
168             =back
169              
170             =head2 HTML output
171              
172             =over 4
173              
174             =item as_html
175              
176             Output the HTML document (and cache it in the object)
177              
178             =cut
179              
180             sub _html_obj {
181 709     709   1176 my $self = shift;
182 709 100       2117 unless (defined $self->{_html_doc}) {
183             $self->{_html_doc} =
184 510         1561 Text::Amuse::Output->new(
185             document => $self->document,
186             format => 'html',
187             );
188             }
189 709         2166 return $self->{_html_doc};
190             }
191              
192             sub _get_body {
193 868     868   2328 my ($self, $doc, $split) = @_;
194 868 100       2218 if (my $partials = $self->partials) {
195 4         5 my @chunks = @{ $doc->process(split => 1) };
  4         19  
196 4         10 my @out;
197 4         12 for (my $i = 0; $i < @chunks; $i++) {
198 44 100       119 push @out, $chunks[$i] if $partials->{$i};
199             }
200 4         39 return \@out;
201             }
202             else {
203 864         3379 return $doc->process(split => $split);
204             }
205             }
206              
207             sub _get_full_body {
208 671     671   1710 my ($self, $doc) = @_;
209 671         1835 return $self->_get_body($doc => 0);
210             }
211              
212             sub _get_splat_body {
213 197     197   417 my ($self, $doc) = @_;
214 197         491 return $self->_get_body($doc => 1);
215             }
216              
217              
218             sub as_html {
219 459     459 1 222095 my $self = shift;
220 459 100       1685 unless (defined $self->{_html_output_strings}) {
221 416         1432 $self->{_html_output_strings} = $self->_get_full_body($self->_html_obj);
222             }
223 459 100       1439 return unless defined wantarray;
224 390         719 return join("", @{ $self->{_html_output_strings} });
  390         5078  
225             }
226              
227             =item header_as_html
228              
229             The directives of the document in HTML (title, authors, etc.),
230             returned as an hashref.
231              
232             B.
233              
234             =cut
235              
236             sub header_as_html {
237 68     68 1 150 my $self = shift;
238 68         207 $self->as_html; # trigger the html generation. This operation is
239             # not expensive if we already call it, and won't
240             # be the next time.
241 68 100       151 unless (defined $self->{_cached_html_header}) {
242 66         151 $self->{_cached_html_header} = $self->_html_obj->header;
243             }
244 68         122 return { %{ $self->{_cached_html_header} } };
  68         732  
245             }
246              
247             =item toc_as_html
248              
249             Return the HTML formatted ToC, as a string.
250              
251             =cut
252              
253             sub toc_as_html {
254 18     18 1 3773 my $self = shift;
255 18         67 my @toc = $self->raw_html_toc;
256 18 50       45 return "" unless @toc;
257             # do the dirty job
258 18         26 my @out;
259 18         32 foreach my $item (@toc) {
260 75 100       145 next unless $item->{index}; # skip the 0 one, is dummy
261 70 100       112 next unless length $item->{string}; # skip empty one at output level
262 67 100       129 my $anchor = $item->{named} ? $item->{named} : 'toc' . $item->{index};
263             my $line = qq{

264

            $item->{level} . qq{">} .
265             '  ' x $item->{level} . "" .
266             qq{} .
267 67         265 $item->{string} . "

";
268 67         98 push @out, $line;
269             }
270 18 100       42 if (@out) {
271 16         252 return join ("\n", @out) . "\n";
272             }
273             else {
274 2         20 return '';
275             }
276             }
277              
278             =item as_splat_html
279              
280             Return a list of strings, each of them is a html page resulting from
281             the splitting of the as_html output. Linked footnotes as inserted at
282             the end of each page.
283              
284             =cut
285              
286             sub as_splat_html {
287 103     103 1 99906 my $self = shift;
288 103         144 return @{ $self->_get_splat_body($self->_html_obj) };
  103         321  
289             }
290              
291              
292             =item raw_html_toc
293              
294             Return an internal representation of the ToC
295              
296             =cut
297              
298             sub raw_html_toc {
299 124     124 1 2780 my $self = shift;
300 124         432 my $html = $self->_html_obj;
301 124         255 my @pieces = @{ $html->process(split => 1) };
  124         500  
302 124         461 my @toc = $html->table_of_contents;
303 124         301 my $missing = scalar(@pieces) - scalar(@toc);
304 124 100       345 if ($missing) {
305 81 50       189 if ($missing == 1) {
306             unshift @toc, {
307             index => 0,
308             level => 2,
309 81   50     330 string => $html->header->{title} || "start body",
310             };
311             }
312             else {
313 0         0 die "This shouldn't happen: missing pieces: $missing!";
314             }
315             }
316 124 100       497 if (my $partials = $self->partials) {
317 5         7 my @out;
318 5         16 for (my $i = 0; $i < @toc; $i++) {
319 55 100       116 push @out, $toc[$i] if $partials->{$i};
320             }
321 5         38 return @out;
322             }
323 119         672 return @toc;
324             }
325              
326             =back
327              
328             =head2 LaTeX output
329              
330             =over 4
331              
332             =item as_latex
333              
334             Output the (Xe)LaTeX document (and cache it in the object), as a
335             string.
336              
337             =cut
338              
339             sub _latex_obj {
340 448     448   736 my $self = shift;
341 448 100       1202 unless (defined $self->{_ltx_doc}) {
342             $self->{_ltx_doc} =
343 255         740 Text::Amuse::Output->new(
344             document => $self->document,
345             format => 'ltx',
346             );
347             }
348 448         1637 return $self->{_ltx_doc};
349             }
350              
351             =item as_splat_latex
352              
353             Return a list of strings, each of them is a LaTeX chunk resulting from
354             the splitting of the as_latex output.
355              
356             =cut
357              
358             sub as_latex {
359 496     496 1 3130 my $self = shift;
360 496 100       1609 unless (defined $self->{_latex_output_strings}) {
361 255         784 $self->{_latex_output_strings} = $self->_get_full_body($self->_latex_obj);
362             }
363 496 100       1326 return unless defined wantarray;
364 257         411 return join("", @{ $self->{_latex_output_strings} });
  257         4809  
365             }
366              
367             sub as_splat_latex {
368 94     94 1 56728 my $self = shift;
369 94         219 return @{ $self->_get_splat_body($self->_latex_obj) };
  94         311  
370             }
371              
372             =item as_beamer
373              
374             Output the document as LaTeX, but wrap each section which doesn't
375             contain a comment C<; noslide> inside a frame.
376              
377             =cut
378              
379             sub as_beamer {
380 1     1 1 770 my $self = shift;
381 1         5 my $latex = $self->_latex_obj->process;
382 1         10 return Text::Amuse::Beamer->new(latex => $latex)->process;
383             }
384              
385             =item wants_toc
386              
387             Return true if a ToC is needed because we found some headings inside.
388              
389             =item wants_preamble
390              
391             Normally returns true. If partial output, only if the C
 string was passed. 
392              
393             Preamble is the title page, or the title/author/date chunk.
394              
395             =item wants_postamble
396              
397             Normally returns true. If partial output, only if the C string was passed.
398              
399             Postamble is the metadata of the text.
400              
401             =cut
402              
403             sub wants_preamble {
404 6     6 1 22 my $self = shift;
405 6 100       12 if (my $partials = $self->partials) {
406 5 100       13 if ($partials->{pre}) {
407 2         10 return 1;
408             }
409             else {
410 3         15 return 0;
411             }
412             }
413 1         6 return 1;
414             }
415              
416             sub wants_postamble {
417 6     6 1 12 my $self = shift;
418 6 100       13 if (my $partials = $self->partials) {
419 5 100       10 if ($partials->{post}) {
420 2         7 return 1;
421             }
422             else {
423 3         16 return 0;
424             }
425             }
426 1         4 return 1;
427             }
428              
429              
430             sub wants_toc {
431 96     96 1 49108 my $self = shift;
432 96         386 $self->as_latex;
433 96         298 my @toc = $self->_latex_obj->table_of_contents;
434 96         317 return scalar(@toc);
435             }
436              
437              
438             =item header_as_latex
439              
440             The LaTeX formatted header, as an hashref. Keys are not interpolated
441             in any way.
442              
443             =cut
444              
445             sub header_as_latex {
446 4     4 1 8 my $self = shift;
447 4         11 $self->as_latex;
448 4 100       9 unless (defined $self->{_cached_latex_header}) {
449 2         6 $self->{_cached_latex_header} = $self->_latex_obj->header;
450             }
451 4         7 return { %{ $self->{_cached_latex_header} } };
  4         39  
452             }
453              
454             =back
455              
456             =head2 Helpers
457              
458             =over 4
459              
460             =item attachments
461              
462             Report the attachments (images) found, as a list.
463              
464             =cut
465              
466             sub attachments {
467 2     2 1 8 my $self = shift;
468 2         9 $self->as_latex;
469 2         9 return $self->document->attachments;
470             }
471              
472             =item language_code
473              
474             The language code of the document. This method will looks into the
475             header of the document, searching for the keys C or C,
476             defaulting to C.
477              
478             =item language
479              
480             Same as above, but returns the human readable version, notably used by
481             Babel, Polyglossia, etc.
482              
483             =cut
484              
485             sub _language_mapping {
486 0     0   0 return Text::Amuse::Utils::language_mapping();
487             }
488              
489             =item header_defined
490              
491             Return a convenience hashref with the header fields set to true when
492             they are defined in the document.
493              
494             This way, in the template you can write doc.header_defined.subtitle
495             without doing crazy things like C
496             which relies on virtual methods.
497              
498             =cut
499              
500             sub header_defined {
501 3     3 1 12 my $self = shift;
502 3 100       10 unless (defined $self->{_header_defined_hashref}) {
503 1         1 my %fields;
504 1         3 my %header = $self->document->raw_header;
505 1         3 foreach my $k (keys %header) {
506 2 50 33     11 if (defined($header{$k}) and length($header{$k})) {
507 2         4 $fields{$k} = 1;
508             }
509             }
510 1         4 $self->{_header_defined_hashref} = \%fields;
511             }
512 3         4 return { %{ $self->{_header_defined_hashref} } };
  3         21  
513             }
514              
515              
516             sub language_code {
517 101     101 1 437 shift->document->language_code;
518             }
519             sub language {
520 64     64 1 199 shift->document->language;
521             }
522              
523             =item other_language_codes
524              
525             It returns an arrayref or undef.
526              
527             =cut
528              
529             sub other_language_codes {
530 67     67 1 113 my $self = shift;
531             # ensure the body is parsed
532 67         141 $self->as_latex;
533 67         121 return $self->document->other_language_codes;
534             }
535              
536             =item other_languages
537              
538             It return an arrayref or undef.
539              
540             =cut
541              
542              
543             sub other_languages {
544 34     34 1 2070 my $self = shift;
545             # ensure the body is parsed
546 34         91 $self->as_latex;
547 34         84 return $self->document->other_languages;
548             }
549              
550             =item hyphenation
551              
552             Return a validated version of the C<#hyphenation> header, if present,
553             or the empty string.
554              
555             =cut
556              
557             sub hyphenation {
558 36     36 1 10905 my $self = shift;
559 36 100       84 unless (defined $self->{_doc_hyphenation}) {
560 18         32 my %header = $self->document->raw_header;
561 18   100     50 my $hyphenation = $header{hyphenation} || '';
562             my @validated = grep {
563 18         57 m/\A(
  20         113  
564             [[:alpha:]]+
565             (-[[:alpha:]]+)*
566             )\z/x
567             } split(/\s+/, $hyphenation);
568 18 100       64 $self->{_doc_hyphenation} = @validated ? join(' ', @validated) : '';
569             }
570 36         119 return $self->{_doc_hyphenation};
571             }
572              
573             =item is_rtl
574              
575             Return true if the language is RTL (ar, he, fa -- so far)
576              
577             =item is_bidi
578              
579             Return true if the document uses direction switches.
580              
581             =item has_ruby
582              
583             Return true if the document uses the ruby annotation.
584              
585             =item html_direction
586              
587             Return the direction (rtl or ltr) of the document, based on the
588             language
589              
590             =item font_script
591              
592             Return the script of the language.
593              
594             Implemented for Russian, Macedonian, Farsi, Arabic, Hebrew. Otherwise
595             return Latin.
596              
597             =cut
598              
599             sub is_rtl {
600 3     3 1 11 Text::Amuse::Utils::lang_code_is_rtl(shift->language_code);
601             }
602              
603             sub is_bidi {
604 36     36 1 85 my $self = shift;
605             # trigger the parsing
606 36         104 $self->as_latex;
607             return $self->document->bidi_document || scalar(grep { Text::Amuse::Utils::lang_code_is_rtl($_) }
608             ($self->language_code,
609 36   100     107 @{ $self->other_language_codes || [] }));
610             }
611              
612             sub has_ruby {
613 0     0 1   shift->document->has_ruby;
614             }
615              
616             sub html_direction {
617 0     0 1   my $self = shift;
618 0 0         if ($self->is_rtl) {
619 0           return 'rtl';
620             }
621             else {
622 0           return 'ltr';
623             }
624             }
625              
626             sub font_script {
627 0     0 1   my $self = shift;
628 0           my %scripts = (
629             mk => 'Cyrillic',
630             ru => 'Cyrillic',
631             fa => 'Arabic',
632             ar => 'Arabic',
633             he => 'Hebrew',
634             el => 'Greek',
635             );
636 0   0       return $scripts{$self->language_code} || 'Latin';
637             }
638              
639             =back
640              
641             =head1 DIFFERENCES WITH THE ORIGINAL EMACS MUSE MARKUP
642              
643             The updated manual can be found at
644             L or
645             L
646              
647             See the section "Differences between Text::Amuse and Emacs Muse".
648              
649              
650             =head3 Inline markup
651              
652             Underlining has been dropped.
653              
654             Emphasis and strong can also be written with tags, like emphasis,
655             strong and code.
656              
657             Added tag and for superscript and subscript.
658              
659             =head4 Inline logic
660              
661             Asterisk and equal symbols (*, **, *** =) are interpreted as markup
662             elements if they are paired (an opening one and a closing one).
663              
664             The opening one must be preceded by something which is not an
665             alphanumerical character (or at the beginning of the line) and
666             followed by something which is not a space.
667              
668             The closing one must be preceded by something which is not a space,
669             and followed by something which is not an alphanumerical character (or
670             at the end of the line).
671              
672             =head3 Block markup
673              
674             The only tables supported are the native one (with ||| as separator).
675              
676             Since version 0.60, the code blocks, beside the C tag, can
677             also be written as:
678              
679             {{{
680             if ($perl) {...}
681             }}}
682              
683             Borrowed from the Creole markup.
684              
685             =head3 Others
686              
687             Embedded lisp code and syntax highlight is not supported.
688              
689             Esoteric stuff like citing from other resources is not supported.
690              
691             The scope of this module is not to replicate all the features of the
692             original implementation, but to use the markup for a wiki (as opposed
693             as a personal and private wiki).
694              
695             =head1 AUTHOR
696              
697             Marco Pessotto, C<< >>
698              
699             =head1 BUGS
700              
701             Please report any bugs or feature requests to the author's email or
702             just use the CPAN's RT. If you find a bug, please provide a minimal
703             muse file which reproduces the problem (so I can add it to the test
704             suite).
705              
706             =head1 SUPPORT
707              
708             You can find documentation for this module with the perldoc command.
709              
710             perldoc Text::Amuse
711              
712             Repository available at GitHub: L
713              
714             =head1 SEE ALSO
715              
716             The original documentation for the Emacs Muse markup can be found at:
717             L
718              
719             L ships an executable to compile muse files.
720              
721             Amusewiki, L, a wiki/publishing engine which
722             uses this module under the hood (and for which this module was written
723             and is maintained).
724              
725             =head1 LICENSE
726              
727             This module is free software and is published under the same terms as
728             Perl itself.
729              
730             =cut
731              
732             1; # End of Text::Amuse