File Coverage

blib/lib/Text/MultiMarkdown.pm
Criterion Covered Total %
statement 506 534 94.7
branch 150 180 83.3
condition 46 74 62.1
subroutine 55 55 100.0
pod 4 4 100.0
total 761 847 89.8


line stmt bran cond sub pod time code
1             require 5.008_000;
2 26     26   9078824 use utf8;
  26         7776  
  26         177  
3              
4             package Text::MultiMarkdown;
5 26     26   1364 use strict;
  26         57  
  26         648  
6 26     26   187 use warnings;
  26         88  
  26         1516  
7 26     26   159 use re 'eval';
  26         64  
  26         1605  
8              
9 26     26   175 use Digest::MD5 qw(md5_hex);
  26         49  
  26         2069  
10 26     26   162 use Encode qw();
  26         78  
  26         726  
11 26     26   164 use Carp qw(carp croak);
  26         60  
  26         1811  
12 26     26   169 use base qw(Text::Markdown);
  26         84  
  26         18184  
13 26     26   677345 use HTML::Entities qw(encode_entities);
  26         171972  
  26         2991  
14 26     26   253 use Scalar::Util qw(blessed);
  26         50  
  26         1889  
15 26     26   14978 use Unicode::Normalize ();
  26         79714  
  26         4385  
16              
17             our $VERSION = '1.005';
18             our @EXPORT_OK = qw(markdown multimarkdown_to_html);
19              
20             =encoding utf8
21              
22             =head1 NAME
23              
24             Text::MultiMarkdown - Convert MultiMarkdown syntax to (X)HTML
25              
26             =head1 SYNOPSIS
27              
28             Use it as a function, with or without optional arguments:
29              
30             use Text::MultiMarkdown 'markdown';
31              
32             my $html = markdown($text);
33              
34             my $html = markdown( $text, {
35             empty_element_suffix => '>',
36             tab_width => 2,
37             use_wikilinks => 1,
38             } );
39              
40             Or in the object-oriented interface:
41              
42             use Text::MultiMarkdown;
43              
44             my $m = Text::MultiMarkdown->new;
45             my $html = $m->markdown($text);
46              
47             my $m = Text::MultiMarkdown->new(
48             empty_element_suffix => '>',
49             tab_width => 2,
50             use_wikilinks => 1,
51             );
52             my $html = $m->markdown( $text );
53              
54             =head1 DESCRIPTION
55              
56             Markdown is a text-to-HTML filter; it translates an easy-to-read /
57             easy-to-write structured text format into HTML. Markdown's text format
58             is most similar to that of plain text email, and supports features such
59             as headers, *emphasis*, code blocks, blockquotes, and links.
60              
61             Markdown's syntax is designed not as a generic markup language, but
62             specifically to serve as a front-end to (X)HTML. You can use span-level
63             HTML tags anywhere in a Markdown document, and you can use block level
64             HTML tags (C<<
>>, C<< >> etc.). Note that by default
65             Markdown isn't interpreted in HTML block-level elements, unless you add
66             a C attribute to the element. See L for
67             details.
68              
69             This module implements the MultiMarkdown markdown syntax extensions from:
70              
71             http://fletcherpenney.net/multimarkdown/
72              
73             =head1 SYNTAX
74              
75             For more information about (original) Markdown's syntax, see:
76              
77             http://daringfireball.net/projects/markdown/
78              
79             This module implements MultiMarkdown, which is an extension to Markdown..
80              
81             The extension is documented at:
82              
83             http://fletcherpenney.net/multimarkdown/
84              
85             and borrows from php-markdown, which lives at:
86              
87             http://michelf.com/projects/php-markdown/extra/
88              
89             This documentation is going to be moved/copied into this module for
90             clearer reading in a future release..
91              
92             =head2 Options
93              
94             MultiMarkdown supports a number of options to its processor which
95             control the behaviour of the output document.
96              
97             These options can be supplied to the constructor, on in a hash with
98             the individual calls to the markdown method. See the synopsis for
99             examples of both of the above styles.
100              
101             The options for the processor are:
102              
103             =over 4
104              
105             =item bibliography_title
106              
107             The title of the generated bibliography, defaults to 'Bibliography'.
108              
109             =item disable_bibliography
110              
111             If true, this disables the MultiMarkdown bibliography/citation handling.
112              
113             =item disable_definition_lists
114              
115             If true, this disables the MultiMarkdown definition list handling.
116              
117             =item disable_footnotes
118              
119             If true, this disables the MultiMarkdown footnotes handling.
120              
121             =item disable_tables
122              
123             If true, this disables the MultiMarkdown table handling.
124              
125             =item empty_element_suffix
126              
127             This option can be used to generate normal HTML output. By default, it
128             is C<< /> >>, which is xHTML, change to C<< > >> for normal HTML.
129              
130             =item heading_ids
131              
132             Controls if C tags generated have an id attribute. Defaults to true.
133             Turn off for compatibility with the original markdown.
134              
135             =item heading_ids_spaces_to_dash
136              
137             Controls whether spaces in headings should be rendered as "-" characters
138             in the heading ids (for compatibility with GitHub markdown, and others)
139              
140             =item img_ids
141              
142             Controls if C tags generated have an id attribute. Defaults to true.
143             Turn off for compatibility with the original markdown.
144              
145             =item strip_metadata
146              
147             If true, any metadata in the input document is removed from the output
148             document (note - does not take effect in complete document format).
149              
150             =item tab_width
151              
152             Controls indent width in the generated markup, defaults to 4
153              
154             =item transliterated_ids
155              
156             In markdown label values, change accented and other non-ASCII letter
157             characters with L. If that module is not available,
158             this issues a warning and does nothing. When C is true,
159             this is ignored. The default is false.
160              
161             =item unicode_ids
162              
163             In markdown label values, allow any Unicode letter character along
164             with the allowed ASCII symbol characters. This overrules
165             C when true. The default is false.
166              
167             =item use_metadata
168              
169             Controls the metadata options below.
170              
171             =back
172              
173             =head2 Metadata
174              
175             MultiMarkdown supports the concept of 'metadata', which allows you to
176             specify a number of formatting options within the document itself.
177             Metadata should be placed in the top few lines of a file, on value per
178             line as colon separated key/value pairs. The metadata should be
179             separated from the document with a blank line.
180              
181             Most metadata keys are also supported as options to the constructor,
182             or options to the markdown method itself. (Note, as metadata, keys
183             contain space, whereas options the keys are underscore separated.)
184              
185             You can attach arbitrary metadata to a document, which is output in
186             HTML C<< >> tags if unknown, see F for
187             an example.
188              
189             These are the known metadata keys:
190              
191             =over 4
192              
193             =item document_format
194              
195             If set to 'complete', MultiMarkdown will render an entire xHTML page,
196             otherwise it will render a document fragment
197              
198             =over 4
199              
200             =item base url
201              
202             This is the base URL for referencing wiki pages. In this is not
203             supplied, all wiki links are relative.
204              
205             =item css
206              
207             Sets a CSS file for the file, if in 'complete' document format.
208              
209             =item title
210              
211             Sets the page title, if in 'complete' document format.
212              
213             =back
214              
215             =item use wikilinks
216              
217             If set to '1' or 'on', causes links that are WikiWords to
218             automatically be processed into links.
219              
220             =back
221              
222             =head2 Class methods
223              
224             =over 4
225              
226             =item new
227              
228             A simple constructor, see the SYNTAX and OPTIONS sections for more information.
229              
230             =cut
231              
232             my %defaults;
233             BEGIN {
234 26     26   18475 %defaults = (
235             use_metadata => 1,
236             base_url => '',
237             tab_width => 4,
238             document_format => '',
239             empty_element_suffix => ' />',
240             use_wikilinks => 0,
241             heading_ids => 1,
242             img_ids => 1,
243             bibliography_title => 'Bibliography',
244             self_url => '',
245             heading_ids_spaces_to_dash => '',
246             );
247              
248             }
249              
250             sub new {
251 120     120 1 291590 my ($class, %args) = @_;
252              
253 120         1470 my %p = ( %defaults, %args );
254              
255 120         474 my @binary = qw(use_metadata use_wikilinks);
256 120 100       757 $p{$_} = $p{$_} ? 1 : 0 for @binary;
257              
258 120 50       950 unless( $p{tab_width} =~ m/^[0-9]+$/ ) {
259 0         0 carp "tab_width did not look like a decimal number, so using the default 4";
260 0         0 $p{tab_width} = 4;
261             }
262              
263 120         510 _process_id_handler( \%args, \%p );
264              
265 120         374 my $self = { params => \%p };
266 120   66     574 bless $self, ref($class) || $class;
267 120         612 return $self;
268             }
269              
270             sub _id_handler {
271 237 50   237   935 defined $_[0]->{id_handler} ? $_[0]->{id_handler} : \&_default_id_handler
272             }
273              
274             sub _default_id_handler {
275 227     227   107553 my ($label) = @_;
276              
277 227         1099 $label =~ s/[^A-Za-z0-9:_.-]//g;
278 227         636 $label =~ s/\A[^A-Za-z]+//g;
279 227         541 $label =~ s/-+/-/g;
280 227         431 $label =~ s/-+\z//g;
281              
282 227         673 return $label;
283             }
284              
285 0         0 BEGIN {
286 26     26   108 my $has_unidecode = eval { require Text::Unidecode };
  26         14623  
287              
288             sub _transliteration_id_handler {
289 22     22   58 my ($label) = @_;
290              
291 22 50       61 unless ($has_unidecode ) {
292 0         0 carp "Need Text::Unidecode to for transliterated_ids, but could not load it. Falling back to default id handler";
293 0         0 return _default_id_handler($label);
294             }
295              
296 22         109 $label = Text::Unidecode::unidecode($label);
297              
298 22         5296 $label =~ s/\s+//g;
299 22         115 $label =~ s/\A[^A-Za-z]+//g;
300 22         126 $label =~ s/-+/-/g;
301 22         72 $label =~ s/-+\z//g;
302              
303 22         86 return $label;
304             }
305              
306             {
307 26     26   232 no warnings qw(redefine);
  26         148  
  26         15714  
  26         51331  
308 26 50       200153 *_transliteration_id_handler = \&_default_id_handler unless $has_unidecode;
309             }
310              
311             sub _unicode_id_handler {
312 30     30   82 my ($label) = @_;
313              
314 30         140 $label =~ s/\s+//g;
315 30         220 $label =~ s/\W+/-/g;
316 30         101 $label =~ s/\A\P{Letter}+//g;
317 30         171 $label =~ s/-+/-/g;
318 30         118 $label =~ s/-+\z//g;
319 30         115 return $label;
320             }
321              
322             sub _process_id_handler {
323 120     120   272 my( $args, $p ) = @_;
324              
325 120         439 $p->{id_handler} = \&_default_id_handler;
326              
327 120 100 66     470 if ( exists $args->{unicode_ids} and $args->{unicode_ids} and exists $args->{transliterated_ids} ) {
      66        
328 3         26 warn "ignoring transliterated_ids because unicode_ids is true\n";
329 3         27 delete $args->{transliterated_ids};
330             }
331              
332 120 100       528 if ( $args->{unicode_ids} ) {
    100          
333 6         21 $p->{id_handler} = \&_unicode_id_handler
334             }
335             elsif ( $args->{transliterated_ids} ) {
336 3 50       13 warn "Need Text::Unidecode to transliterate labels, but could not load it\n"
337             unless $has_unidecode;
338 3         12 $p->{id_handler} = \&_transliteration_id_handler;
339             }
340             }
341             }
342              
343             =back
344              
345             =head2 Instance methods
346              
347             =over 4
348              
349             =item markdown( MARKDOWN_TEXT [, HASHREF] )
350              
351             This is the legacy interface to this module, but it does too much and
352             is a poor name. For the function form, use C
353             instead. At the moment that's just a wrapper for C in the
354             functional form. For the object-oriented forms, use C instead.
355             That's also just a wrapper for this, but will later change to enforce
356             object-orientedness (i.e. exclude the functional form).
357              
358             And now the legacy stuff.
359              
360             This works as either a class method, instance method, or exportable
361             function:
362              
363             my $html = Text::MultiMarkdown->markdown( $text );
364              
365             my $mm = Text::MultiMarkdown->new;
366             my $html = $mm->markdown($text);
367              
368             use Text::MultiMarkdown qw(markdown);
369             my $html = markdown( $text );
370              
371             Any of these forms take an optional HASH_REF argument for options. These
372             are the options for this module or the parent class L:
373              
374             my $html = Text::MultiMarkdown->markdown( $text, { ... } );
375              
376             my $mm = Text::MultiMarkdown->new;
377             my $html = $mm->markdown($text, { ... });
378              
379             use Text::MultiMarkdown qw(markdown);
380             my $html = markdown( $text, { ... } );
381              
382             To make this work in all these cases, since this was the legacy design,
383             various unsavory things have to happen.
384              
385             When called as a class method, a new object is constructed. We guess
386             that it's a class method by looking at the first argument and seeing
387             that it looks like a Perl package name. In prior versions this was
388             documented to not work, but there was also a TODO test for it to work.
389             So, now it works. This might fail if the entire markdown text is exactly
390             a valid Perl package name.
391              
392             If the first argument is a blessed reference, we guess that this is
393             an instance method. With the optional HASH_REF argument this constructs
394             a new argument with all of the settings of the original object and the
395             stuff in HASH_REF. This might fail if you have some weird case where
396             you call this as a function but pass as the TEXT argument an object that
397             has overloaded stringification .
398              
399             =cut
400              
401             =begin comment
402              
403             =end comment
404              
405             There are these situations:
406              
407             CLASS->markdown( TEXT );
408             CLASS->markdown( TEXT, HASHREF );
409              
410             OBJ->markdown( TEXT );
411             OBJ->markdown( TEXT, HASHREF );
412              
413             markdown( TEXT );
414             markdown( TEXT, HASHREF );
415              
416             These are really:
417              
418             markdown( CLASS, TEXT )
419             markdown( CLASS, TEXT, HASHREF )
420              
421             markdown( OBJ, TEXT )
422             markdown( OBJ, TEXT, HASHREF )
423              
424             markdown( TEXT );
425             markdown( TEXT, HASHREF );
426              
427             Which breaks down to these groups:
428              
429             1) markdown( TEXT );
430              
431             2.1) markdown( TEXT, HASHREF );
432             2.2) markdown( CLASS, TEXT )
433             2.3) markdown( OBJ, TEXT )
434              
435             3.1) markdown( CLASS, TEXT, HASHREF )
436             3.2) markdown( OBJ, TEXT, HASHREF )
437              
438             In 1), 2.2), and 3.1), we should make a new object and then do our
439             thing.
440              
441             In 3.1), the previous version specifically said that we can't call
442             this as a class method.
443              
444             In 3.2), we need to merge the options in the existing object with
445             the new options. This was never a documented feature though.
446              
447             Part of the tickyness is that interface for Text::Markdown. We need
448             to pass the HASHREF to _CleanUpRunData in the SUPER class
449              
450             =cut
451              
452             sub _looks_like_class {
453 282     282   614 local $_ = $_[0];
454 282         5134 m/\A\w+(?:::\w+)+\z/;
455             }
456              
457             sub markdown {
458 181     181 1 530885 my( $self, $text, $options ) = do {
459 181 100 66     2126 if ( @_ == 1 and ! ref $_[0] ) { # Case 1
    100 100        
    100 100        
    100 100        
    100 66        
    50 66        
      66        
      66        
      66        
      66        
      33        
      33        
      33        
460 8         40 ( __PACKAGE__->new, $_[0], {} );
461             } elsif ( @_ == 2 and ! _looks_like_class($_[0]) and ref $_[1] eq ref {} ) { # Case 2.1
462 28         66 ( __PACKAGE__->new( %{ $_[1] } ), $_[0], $_[1] );
  28         193  
463             } elsif ( @_ == 2 and _looks_like_class($_[0]) and ! ref $_[1] ) { # Case 2.2
464 7         27 ( $_[0]->new, $_[1] );
465             } elsif ( @_ == 2 and blessed($_[0]) and ! ref $_[1] ) { # Case 2.3
466 102         519 ( $_[0], $_[1], {} );
467             } elsif ( @_ == 3 and _looks_like_class($_[0]) and ! ref $_[1] and ref $_[2] eq ref {} ) { # Case 3.1
468 14         31 ( $_[0]->new( %{ $_[2]} ), $_[1], $_[2] );
  14         86  
469             } elsif ( @_ == 3 and blessed($_[0]) and ! ref $_[1] and ref $_[2] eq ref {} ) { # Case 3.2
470 22         70 my %merged = ( %{ $_[0]->{params} }, %{ $_[2] } );
  22         117  
  22         157  
471 22         121 my $new = $_[0]->new( %merged );
472 22         139 ( $new, $_[1], $_[2] );
473             } else {
474 0         0 carp "Unrecognized arguments for markdown()";
475 0         0 return;
476             }
477             };
478              
479 181 100       570 $options = {} unless defined $options;
480              
481 181         348 %$self = (%{ $self->{params} }, %$options, params => $self->{params});
  181         2875  
482 181         931 $self->_CleanUpRunData($options);
483              
484 181         2617 return $self->_Markdown($text);
485             }
486              
487             =item multimarkdown_to_html
488              
489             For the functional interface, you should use this instead of C
490             because it's a better name. At the moment it's the same as calling
491             C, but eventually this will diverge from the object-oriented
492             form C, which is also a better name.
493              
494             =cut
495              
496             sub multimarkdown_to_html {
497 18     18 1 99829 markdown(@_);
498             }
499              
500             =item to_html
501              
502             As a class or instance method, you should use this instead of C
503             because it's a better name. At the moment it's the same as calling
504             C, but eventually this will diverge from the functional
505             form C, which is also a better name.
506              
507             =cut
508              
509             sub to_html {
510 31     31 1 88451 markdown(@_);
511             }
512              
513             sub _CleanUpRunData {
514 181     181   482 my ($self, $options) = @_;
515             # Clear the global hashes. If we don't clear these, you get conflicts
516             # from other articles when generating a page which contains more than
517             # one article (e.g. an index page that shows the N most recent
518             # articles):
519 181         487 $self->{_crossrefs} = {};
520 181         512 $self->{_footnotes} = {};
521 181         379 $self->{_references} = {};
522 181         407 $self->{_used_footnotes} = []; # Why do we need 2 data structures for footnotes? FIXME
523 181         364 $self->{_used_references} = []; # Ditto for references
524 181         370 $self->{_citation_counter} = 0;
525 181         386 $self->{_metadata} = {};
526 181         348 $self->{_attributes} = {}; # Used for extra attributes on links / images.
527              
528 181         962 $self->SUPER::_CleanUpRunData($options);
529             }
530              
531             sub _Markdown {
532             #
533             # Main function. The order in which other subs are called here is
534             # essential. Link and image substitutions need to happen before
535             # _EscapeSpecialChars(), so that any *'s or _'s in the
536             # and tags get encoded.
537             #
538             # Can't think of any good way to make this inherit from the Markdown version as ordering is so important, so I've left it.
539 181     181   459 my ($self, $text) = @_;
540              
541 181         796 $text = $self->_CleanUpDoc($text);
542              
543             # MMD only. Strip out MetaData
544 181 100 100     16731 $text = $self->_ParseMetaData($text) if ($self->{use_metadata} || $self->{strip_metadata});
545              
546             # Turn block-level HTML blocks into hash entries
547 181         1102 $text = $self->_HashHTMLBlocks($text, {interpret_markdown_on_attribute => 1});
548              
549 181         141406 $text = $self->_StripLinkDefinitions($text);
550              
551             # MMD only
552 181         684 $text = $self->_StripMarkdownReferences($text);
553              
554 181         1249 $text = $self->_RunBlockGamut($text, {wrap_in_p_tags => 1});
555              
556             # MMD Only
557 181 100       25205 $text = $self->_DoMarkdownCitations($text) unless $self->{disable_bibliography};
558 181 100       854 $text = $self->_DoFootnotes($text) unless $self->{disable_footnotes};
559              
560 181         828 $text = $self->_UnescapeSpecialChars($text);
561              
562             # MMD Only
563             # This must follow _UnescapeSpecialChars
564 181         30861 $text = $self->_UnescapeWikiWords($text);
565 181 100       956 $text = $self->_FixFootnoteParagraphs($text) unless $self->{disable_footnotes}; # TODO: remove. Doesn't make any difference to test suite pass/failure
566 181 100       918 $text .= $self->_PrintFootnotes() unless $self->{disable_footnotes};
567 181 100       929 $text .= $self->_PrintMarkdownBibliography() unless $self->{disable_bibliography};
568              
569 181         809 $text = $self->_ConvertCopyright($text);
570              
571             # MMD Only
572 181 100       1921 if (lc($self->{document_format}) =~ /^complete\s*$/) {
573 4         24 return $self->_xhtmlMetaData() . "\n" . $text . "\n\n";
574             }
575             else {
576 177         617 return $self->_textMetaData() . $text . "\n";
577             }
578              
579             }
580              
581             #
582             # Routines which are overridden for slightly different behaviour in MultiMarkdown
583             #
584              
585             # Delegate to super class, then do wiki links
586             sub _RunSpanGamut {
587 946     946   655264 my ($self, $text) = @_;
588              
589 946         3026 $text = $self->SUPER::_RunSpanGamut($text);
590              
591             # Process WikiWords
592 946 100       422140 if ($self->_UseWikiLinks()) {
593 34         109 $text = $self->_DoWikiLinks($text);
594              
595             # And then reprocess anchors and images
596             # FIXME - This is needed exactly why?
597 34         108 $text = $self->_DoImages($text);
598 34         2821 $text = $self->_DoAnchors($text);
599             }
600              
601 946         4066 return $text;
602             }
603              
604             # Don't do Wiki Links in Headers, otherwise delegate to super class
605             # Do tables stright after headers
606             sub _DoHeaders {
607 240     240   8304 my ($self, $text) = @_;
608              
609 240         724 local $self->{use_wikilinks} = 0;
610              
611 240         1013 $text = $self->SUPER::_DoHeaders($text);
612              
613             # Do tables to populate the table id's for cross-refs
614             # (but after headers as the tables can contain cross-refs to other things, so we want the header cross-refs)
615 240         6501 $text = $self->_DoTables($text);
616             }
617              
618             sub _DoLists {
619 343     343   25234 my ($self, $text) = @_;
620             $text = $self->_DoDefinitionLists($text)
621 343 50       1476 unless $self->{disable_definition_lists};
622 343         1527 $self->SUPER::_DoLists($text);
623             }
624              
625             sub _DoDefinitionLists {
626 343     343   760 my ($self, $text) = @_;
627             # Uses the syntax proposed by Michel Fortin in PHP Markdown Extra
628              
629 343         733 my $less_than_tab = $self->{tab_width} -1;
630              
631 343         1849 my $line_start = qr{
632             [ ]{0,$less_than_tab}
633             }mx;
634              
635 343         2425 my $term = qr{
636             $line_start
637             [^:\s][^\n]*\n
638             }sx;
639              
640 343         2098 my $definition = qr{
641             \n?[ ]{0,$less_than_tab}
642             \:[ \t]+(.*?)\n
643             ((?=\n?\:)|\n|\Z) # Lookahead for next definition, two returns,
644             # or the end of the document
645             }sx;
646              
647 343         3674 my $definition_block = qr{
648             ((?:$term)+) # $1 = one or more terms
649             ((?:$definition)+) # $2 = by one or more definitions
650             }sx;
651              
652 343         3674 my $definition_list = qr{
653             (?:$definition_block\n*)+ # One ore more definition blocks
654             }sx;
655              
656 343         211599 $text =~ s{
657             ($definition_list) # $1 = the whole list
658             }{
659 1         4 my $list = $1;
660 1         2 my $result = $1;
661              
662 1         56 $list =~ s{
663             (?:$definition_block)\n*
664             }{
665 2         5 my $terms = $1;
666 2         4 my $defs = $2;
667              
668 2         26 $terms =~ s{
669             [ ]{0,$less_than_tab}
670             (.*)
671             \s*
672             }{
673 4         8 my $term = $1;
674 4         4 my $result = "";
675 4         16 $term =~ s/^\s*(.*?)\s*$/$1/;
676 4 100       12 if ($term !~ /^\s*$/){
677 2         5 $result = "
" . $self->_RunSpanGamut($1) . "
\n";
678             }
679 4         14 $result;
680             }xmge;
681              
682 2         59 $defs =~ s{
683             $definition
684             }{
685 3         26 my $def = $1 . "\n";
686 3         26 $def =~ s/^[ ]{0,$self->{tab_width}}//gm;
687 3         9 "
\n" . $self->_RunBlockGamut($def) . "\n
\n";
688             }xsge;
689              
690 2         35 $terms . $defs . "\n";
691             }xsge;
692              
693 1         4 "
\n" . $list . "
\n\n";
694             }xsge;
695              
696 343         1673 return $text
697             }
698              
699             # Generating headers automatically generates X-refs in MultiMarkdown (always)
700             # Also, by default, you get id attributes added to your headers, you can turn this
701             # part of the MultiMarkdown behaviour off with the heading_ids flag.
702             sub _GenerateHeader {
703 91     91   2016 my ($self, $level, $id) = @_;
704              
705 91 100       439 my $label = $self->{heading_ids} ? $self->_Header2Label($id) : '';
706 91         298 my $header = $self->_RunSpanGamut($id);
707              
708 91 100       308 if ($label ne '') {
709 89         425 $self->{_crossrefs}{$label} = "#$label";
710 89         291 $self->{_titles}{$label} = $header;
711 89         208 $label = qq{ id="$label"};
712             }
713              
714 91         1573 return "$header\n\n";
715             }
716              
717             # Protect Wiki Links in Code Blocks (if wiki links are turned on), then delegate to super class.
718             sub _EncodeCode {
719 368     368   29833 my ($self, $text) = @_;
720              
721 368 100       751 if ($self->_UseWikiLinks()) {
722 3         22 $text =~ s/([A-Z]+[a-z\x80-\xff]+[A-Z][A-Za-z\x80-\xff]*)/\\$1/gx;
723             }
724              
725 368         838 return $self->SUPER::_EncodeCode($text);
726             }
727              
728             # Full function pulled out of Text::Markdown as MultiMarkdown supports supplying extra 'attributes' with links and
729             # images which are then pushed back into the generated HTML, and this needs a different regex. It should be possible
730             # to extract the just the regex from Text::Markdown, and use that here, but I haven't done so yet.
731             # Strip footnote definitions at the same time as stripping link definitions.
732             # Also extract images and then replace them straight back in (code smell!) to be able to cross reference images
733             sub _StripLinkDefinitions {
734             #
735             # Strips link definitions from text, stores the URLs and titles in
736             # hash references.
737             #
738 181     181   592 my ($self, $text) = @_;
739              
740 181 100       1123 $text = $self->_StripFootnoteDefinitions($text) unless $self->{disable_footnotes};
741              
742 181         462 my $less_than_tab = $self->{tab_width} - 1;
743              
744             # Link defs are in the form: ^[id]: url "optional title"
745             # FIXME - document attributes here.
746 181         7234 while ($text =~ s{
747             # Pattern altered for MultiMarkdown
748             # in order to not match citations or footnotes
749             ^[ ]{0,$less_than_tab}\[([^#^].*)\]: # id = $1
750             [ \t]*
751             \n? # maybe *one* newline
752             [ \t]*
753             ? # url = $2
754             [ \t]*
755             \n? # maybe one newline
756             [ \t]*
757             (?:
758             (?<=\s) # lookbehind for whitespace
759             ["(]
760             (.+?) # title = $3
761             [")]
762             [ \t]*
763             )? # title is optional
764              
765             # MultiMarkdown addition for attribute support
766             \n?
767             ( # Attributes = $4
768             (?<=\s) # lookbehind for whitespace
769             (([ \t]*\n)?[ \t]*((\S+=\S+)|(\S+=".*?")))*
770             )?
771             [ \t]*
772             # /addition
773             (?:\n+|\Z)
774             }
775             {}mx) {
776 45         213 $self->{_urls}{lc $1} = $self->_EncodeAmpsAndAngles( $2 ); # Link IDs are case-insensitive
777 45 100       1071 if ($3) {
778 12         41 $self->{_titles}{lc $1} = $3;
779 12         44 $self->{_titles}{lc $1} =~ s/"/"/g;
780             }
781              
782             # MultiMarkdown addition "
783 45 100       3115 if ($4) {
784 4         166 $self->{_attributes}{lc $1} = $4;
785             }
786             # /addition
787             }
788              
789 181         707 $text = $self->_GenerateImageCrossRefs($text);
790              
791 181         505 return $text;
792             }
793              
794             # Add the extra cross-references to headers that MultiMarkdown supports, and also
795             # the additional link attributes.
796             sub _GenerateAnchor {
797             # FIXME - Fugly, change to named params?
798 208     208   57885 my ($self, $whole_match, $link_text, $link_id, $url, $title, $attributes) = @_;
799              
800             # Allow automatic cross-references to headers
801 208 100       688 if (defined $link_id) {
802 123         349 my $label = $self->_Header2Label($link_id);
803 123 100       379 if (defined $self->{_crossrefs}{$label}) {
804 8   33     43 $url ||= $self->{_crossrefs}{$label};
805             }
806 123 100       291 if ( defined $self->{_titles}{$label} ) {
807 11   33     52 $title ||= $self->{_titles}{$label};
808             }
809 123   66     451 $attributes ||= $self->_DoAttributes($label);
810             }
811 208         781 return $self->SUPER::_GenerateAnchor($whole_match, $link_text, $link_id, $url, $title, $attributes);
812             }
813              
814             # Add the extra cross-references to images that MultiMarkdown supports, and also
815             # the additional attributes.
816             sub _GenerateImage {
817             # FIXME - Fugly, change to named params?
818 6     6   1488 my ($self, $whole_match, $alt_text, $link_id, $url, $title, $attributes) = @_;
819              
820 6 50 33     48 if (defined $alt_text && length $alt_text) {
821 6         24 my $label = $self->_Header2Label($alt_text);
822 6         24 $self->{_crossrefs}{$label} = "#$label";
823 6 50       33 $attributes .= $self->{img_ids} ? qq{ id="$label"} : '';
824             }
825              
826 6 100       25 $attributes .= $self->_DoAttributes($link_id) if defined $link_id;
827              
828 6         38 $self->SUPER::_GenerateImage($whole_match, $alt_text, $link_id, $url, $title, $attributes);
829             }
830              
831              
832             #
833             # MultiMarkdown specific routines
834             #
835              
836             # FIXME - This is really really ugly!
837             sub _ParseMetaData {
838 176     176   604 my ($self, $text) = @_;
839 176         3277 my $clean_text = "";
840              
841 176         538 my ($inMetaData, $currentKey) = (1, '');
842              
843 176         2062 foreach my $line ( split /\n/, $text ) {
844 3359 50 100     11826 $line =~ /^\s*$/ and $inMetaData = 0 and $clean_text .= $line and next;
      33        
845 3359 100       5260 if ($inMetaData) {
846 193 100       597 next unless $self->{use_metadata}; # We can come in here as use_metadata => 0, strip_metadata => 1
847 191 100       741 if ($line =~ /^([a-zA-Z0-9][0-9a-zA-Z _-]+?):\s*(.*)$/ ) {
848 40         111 $currentKey = $1;
849 40         80 $currentKey =~ s/ / /g;
850 40 50       165 $self->{_metadata}{$currentKey} = defined $2 ? $2 : '';
851 40 100       121 if (lc($currentKey) eq "format") {
852 2         6 $self->{document_format} = $self->{_metadata}{$currentKey};
853             }
854 40 100       102 if (lc($currentKey) eq "base url") {
855 12         28 $self->{base_url} = $self->{_metadata}{$currentKey};
856             }
857 40 50       115 if (lc($currentKey) eq "bibliography title") {
858 0         0 $self->{bibliography_title} = $self->{_metadata}{$currentKey};
859 0         0 $self->{bibliography_title} =~ s/\s*$//;
860             }
861             }
862             else {
863 151 100       468 if ($currentKey eq "") {
864             # No metadata present
865 150         497 $clean_text .= "$line\n";
866 150         297 $inMetaData = 0;
867 150         379 next;
868             }
869 1 50       8 if ($line =~ /^\s*(.+)$/ ) {
870 1         7 $self->{_metadata}{$currentKey} .= "\n$1";
871             }
872             }
873             }
874             else {
875 3166         5034 $clean_text .= "$line\n";
876             }
877             }
878              
879             # Recheck for leading blank lines
880 176         864 $clean_text =~ s/^\n+//s;
881              
882 176         683 return $clean_text;
883             }
884              
885             # FIXME - This is really ugly, why do we match stuff and substitute it with the thing we just matched?
886             sub _GenerateImageCrossRefs {
887 181     181   443 my ($self, $text) = @_;
888              
889             #
890             # First, handle reference-style labeled images: ![alt text][id]
891             #
892 181         628 $text =~ s{
893             ( # wrap whole match in $1
894             !\[
895             (.*?) # alt text = $2
896             \]
897              
898             [ ]? # one optional space
899             (?:\n[ ]*)? # one optional newline followed by spaces
900              
901             \[
902             (.*?) # id = $3
903             \]
904              
905             )
906             }{
907 7         24 my $whole_match = $1;
908 7         19 my $alt_text = $2;
909 7         20 my $link_id = lc $3;
910              
911 7 100       27 if ($link_id eq "") {
912 2         6 $link_id = lc $alt_text; # for shortcut links like ![this][].
913             }
914              
915 7         32 $alt_text =~ s/"/"/g;
916              
917 7 100       32 if (defined $self->{_urls}{$link_id}) {
918 4         36 my $label = $self->_Header2Label($alt_text);
919 4         21 $self->{_crossrefs}{$label} = "#$label";
920             }
921              
922 7         64 $whole_match;
923             }xsge;
924              
925             #
926             # Next, handle inline images: ![alt text](url "optional title")
927             # Don't forget: encode * and _
928              
929 181         551 $text =~ s{
930             ( # wrap whole match in $1
931             !\[
932             (.*?) # alt text = $2
933             \]
934             \( # literal paren
935             [ \t]*
936             ? # src url = $3
937             [ \t]*
938             ( # $4
939             (['"]) # quote char = $5
940             (.*?) # title = $6
941             \5 # matching quote
942             [ \t]*
943             )? # title is optional
944             \)
945             )
946             }{
947 7         16 my $result;
948 7         19 my $whole_match = $1;
949 7         18 my $alt_text = $2;
950              
951 7         16 $alt_text =~ s/"/"/g;
952 7         49 my $label = $self->_Header2Label($alt_text);
953 7         27 $self->{_crossrefs}{$label} = "#$label";
954 7         96 $whole_match;
955             }xsge;
956              
957 181         505 return $text;
958             }
959              
960             sub _StripFootnoteDefinitions {
961 178     178   393 my ($self, $text) = @_;
962 178         565 my $less_than_tab = $self->{tab_width} - 1;
963              
964 178         2559 while ($text =~ s{
965             \n\[\^([^\n]+?)\]\:[ \t]*# id = $1
966             \n?
967             (.*?)\n{1,2} # end at new paragraph
968             ((?=\n[ ]{0,$less_than_tab}\S)|\Z) # Lookahead for non-space at line-start, or end of doc
969             }
970             {\n}sx)
971             {
972 7         21 my $id = $1;
973 7         20 my $footnote = "$2\n";
974 7         56 $footnote =~ s/^[ ]{0,$self->{tab_width}}//gm;
975              
976 7         21 $self->{_footnotes}{$self->_Id2Footnote($id)} = $footnote;
977             }
978              
979 178         564 return $text;
980             }
981              
982             sub _DoFootnotes {
983 178     178   440 my ($self, $text) = @_;
984              
985 178 50       554 return '' unless length $text;
986              
987             # First, run routines that get skipped in footnotes
988 178         344 foreach my $label (sort keys %{ $self->{_footnotes} }) {
  178         808  
989 7         51 my $footnote = $self->_RunBlockGamut($self->{_footnotes}{$label}, {wrap_in_p_tags => 1});
990 7         192 $footnote = $self->_UnescapeSpecialChars($footnote);
991 7         1135 $footnote = $self->_DoMarkdownCitations($footnote);
992 7         31 $self->{_footnotes}{$label} = $footnote;
993             }
994              
995 178         449 my $footnote_counter = 0;
996              
997 178         447 $text =~ s{
998             \[\^(.*?)\] # id = $1
999             }{
1000 7         16 my $result = '';
1001 7         19 my $id = $self->_Id2Footnote($1);
1002              
1003 7 50       26 if (defined $self->{_footnotes}{$id} ) {
1004 7         14 $footnote_counter++;
1005 7 50       27 if ($self->{_footnotes}{$id} =~ /^glossary:/i) {
1006 0         0 $result = qq{$footnote_counter};
1007             }
1008             else {
1009 7         23 $result = qq{$footnote_counter};
1010             }
1011 7         11 push (@{ $self->{_used_footnotes} }, $id);
  7         19  
1012             }
1013 7         32 $result;
1014             }xsge;
1015              
1016 178         550 return $text;
1017             }
1018              
1019             # TODO: remove. Doesn't make any difference to test suite pass/failure
1020             sub _FixFootnoteParagraphs {
1021 178     178   426 my ($self, $text) = @_;
1022              
1023 178         577 $text =~ s(^

)()gm;

1024              
1025 178         400 return $text;
1026             }
1027              
1028             sub _PrintFootnotes {
1029 178     178   1093 my ($self) = @_;
1030 178         372 my $footnote_counter = 0;
1031 178         306 my $result;
1032              
1033 178         333 foreach my $id (@{ $self->{_used_footnotes} }) {
  178         664  
1034 7         11 $footnote_counter++;
1035 7         17 my $footnote = $self->{_footnotes}{$id};
1036              
1037 7         55 $footnote =~ s/(<\/(p(re)?|ol|ul)>)$//;
1038 7         17 my $footnote_closing_tag = $1;
1039 7 50       21 $footnote_closing_tag = '' if !defined $footnote_closing_tag;
1040              
1041 7 50       29 if ($footnote =~ s/^glossary:\s*//i) {
1042             # Add some formatting for glossary entries
1043              
1044 0         0 $footnote =~ s{
1045             ^(.*?) # $1 = term
1046             \s*
1047             (?:\(([^\(\)]*)\)[^\n]*)? # $2 = optional sort key
1048             \n
1049             }{
1050 0         0 my $glossary = qq{$1};
1051              
1052 0 0       0 if ($2) {
1053 0         0 $glossary.= qq{};
1054             };
1055              
1056 0         0 $glossary . q{:

};

1057             }egsx;
1058              
1059 0         0 $result .= qq{
  • $footnote ↩$footnote_closing_tag
    • \n\n};
    1060             }
    1061             else {
    1062 7         43 $result .= qq{
  • $footnote ↩$footnote_closing_tag
    • \n\n};
    1063             }
    1064             }
    1065              
    1066 178 100       533 if ($footnote_counter > 0) {
    1067 4         19 $result = qq[\n\n
    \n{empty_element_suffix}\n
      \n\n] . $result . "
    \n
    ";
    1068             }
    1069             else {
    1070 174         360 $result = "";
    1071             }
    1072              
    1073 178         603 return $result;
    1074             }
    1075              
    1076             sub _Header2Label {
    1077 237     237   599 my ($self, $header) = @_;
    1078 237         649 my $label = lc $header;
    1079 237 100       992 $label =~ s/ +/-/g if $self->{heading_ids_spaces_to_dash};
    1080              
    1081 237         764 return $self->_id_handler->($label);
    1082             }
    1083              
    1084             sub _Id2Footnote {
    1085             # Since we prepend "fn:", we can allow leading digits in footnotes
    1086 14     14   35 my ($self, $id) = @_;
    1087 14         32 my $footnote = lc $id;
    1088 14         28 $footnote =~ s/[^A-Za-z0-9:_.-]//g; # Strip illegal characters
    1089 14         66 return $footnote;
    1090             }
    1091              
    1092             sub _xhtmlMetaData {
    1093 4     4   11 my ($self) = @_;
    1094             # FIXME: Should not assume encoding
    1095 4         9 my $result; # FIXME: This breaks some things in IE 6- = qq{\n};
    1096              
    1097             # This screws up xsltproc - make sure to use `-nonet -novalid` if you
    1098             # have difficulty
    1099 4         12 $result .= qq{\n};
    1100              
    1101 4         13 $result.= "\n\t\n";
    1102              
    1103 4         8 foreach my $key (sort keys %{$self->{_metadata}} ) {
      4         27  
    1104 15 100       457 if (lc($key) eq "title") {
        100          
        100          
    1105 3         12 $result.= "\t\t" . encode_entities($self->{_metadata}{$key}) . "\n";
    1106             }
    1107             elsif (lc($key) eq "css") {
    1108 3         14 $result.= qq[\t\t{empty_element_suffix}\n];
    1109             }
    1110             elsif( lc($key) eq "xhtml header") {
    1111 1         5 $result .= qq[\t\t$self->{_metadata}{$key}\n]
    1112             }
    1113             else {
    1114             $result.= qq[\t\t
    1115 8         41 . qq[content="] . encode_entities($self->{_metadata}{$key}) . qq["$self->{empty_element_suffix}\n];
    1116             }
    1117             }
    1118 4         39 $result.= "\t\n";
    1119              
    1120 4         86 return $result;
    1121             }
    1122              
    1123             sub _textMetaData {
    1124 177     177   393 my ($self) = @_;
    1125 177         332 my $result = "";
    1126              
    1127 177 100       557 return $result if $self->{strip_metadata};
    1128              
    1129 175         299 foreach my $key (sort keys %{$self->{_metadata}} ) {
      175         582  
    1130 23         79 $result .= "$key: $self->{_metadata}{$key}\n";
    1131             }
    1132 175         539 $result =~ s/\s*\n/{empty_element_suffix}\n/g;
    1133              
    1134 175 100       543 if ($result ne "") {
    1135 16         33 $result.= "\n";
    1136             }
    1137              
    1138 175         2136 return $result;
    1139             }
    1140              
    1141             sub _UseWikiLinks {
    1142 1348     1348   2915 my ($self) = @_;
    1143 1348 100       3924 return 1 if $self->{use_wikilinks};
    1144 1294         2060 my ($k) = grep { /use wikilinks/i } keys %{$self->{_metadata}};
      55         170  
      1294         3614  
    1145 1294 100       8562 return unless $k;
    1146 17 50       62 return 1 if $self->{_metadata}{$k};
    1147 0         0 return;
    1148             }
    1149              
    1150             sub _CreateWikiLink {
    1151 33     33   166 my ($self, $title) = @_;
    1152              
    1153 33         81 my $id = $title;
    1154 33         71 $id =~ s/ /_/g;
    1155 33         58 $id =~ s/__+/_/g;
    1156 33         63 $id =~ s/^_//g;
    1157 33         54 $id =~ s/_$//;
    1158              
    1159 33         60 $title =~ s/_/ /g;
    1160              
    1161 33         280 return "[$title](" . $self->{base_url} . "$id)";
    1162             }
    1163              
    1164             sub _DoWikiLinks {
    1165              
    1166 34     34   80 my ($self, $text) = @_;
    1167 34         65 my $WikiWord = '[A-Z]+[a-z\x80-\xff]+[A-Z][A-Za-z\x80-\xff]*';
    1168 34         61 my $FreeLinkPattern = "([-,.()' _0-9A-Za-z\x80-\xff]+)";
    1169              
    1170 34 50       74 if ($self->_UseWikiLinks()) {
    1171             # FreeLinks
    1172 34         350 $text =~ s{
    1173             \[\[($FreeLinkPattern)\]\]
    1174             }{
    1175 1         4 my $label = $1;
    1176 1         40 $label =~ s{
    1177             ([\s\>])($WikiWord)
    1178             }{
    1179 0         0 $1 ."\\" . $2
    1180             }xsge;
    1181              
    1182 1         6 $self->_CreateWikiLink($label)
    1183             }xsge;
    1184              
    1185             # WikiWords
    1186 34         487 $text =~ s{
    1187             ([\s])($WikiWord)
    1188             }{
    1189 29         96 $1 . $self->_CreateWikiLink($2)
    1190             }xsge;
    1191              
    1192             # Catch WikiWords at beginning of text
    1193 34         350 $text =~ s{^($WikiWord)
    1194             }{
    1195 3         21 $self->_CreateWikiLink($1)
    1196             }xse;
    1197             }
    1198              
    1199              
    1200 34         103 return $text;
    1201             }
    1202              
    1203             sub _UnescapeWikiWords {
    1204 181     181   460 my ($self, $text) = @_;
    1205 181         1175 my $WikiWord = '[A-Z]+[a-z\x80-\xff]+[A-Z][A-Za-z\x80-\xff]*';
    1206              
    1207             # Unescape escaped WikiWords
    1208 181         2000 $text =~ s/(?<=\B)\\($WikiWord)/$1/g;
    1209              
    1210 181         451 return $text;
    1211             }
    1212              
    1213             sub _DoTables {
    1214 240     240   508 my ($self, $text) = @_;
    1215              
    1216 240 100       791 return $text if $self->{disable_tables};
    1217              
    1218 236         536 my $less_than_tab = $self->{tab_width} - 1;
    1219              
    1220             # Algorithm inspired by PHP Markdown Extra's
    1221             #
    1222              
    1223             # Reusable regexp's to match table
    1224              
    1225 236         1710 my $line_start = qr{
    1226             [ ]{0,$less_than_tab}
    1227             }mx;
    1228              
    1229 236         698 my $table_row = qr{
    1230             [^\n]*?\|[^\n]*?\n
    1231             }mx;
    1232              
    1233 236         1816 my $first_row = qr{
    1234             $line_start
    1235             \S+.*?\|.*?\n
    1236             }mx;
    1237              
    1238 236         1494 my $table_rows = qr{
    1239             (\n?$table_row)
    1240             }mx;
    1241              
    1242 236         1423 my $table_caption = qr{
    1243             $line_start
    1244             \[.*?\][ \t]*\n
    1245             }mx;
    1246              
    1247 236         2230 my $table_divider = qr{
    1248             $line_start
    1249             [\|\-\:\.][ \-\|\:\.]* \| [ \-\|\:\.]*
    1250             }mx;
    1251              
    1252 236         4783 my $whole_table = qr{
    1253             ($table_caption)? # Optional caption
    1254             ($first_row # First line must start at beginning
    1255             ($table_row)*?)? # Header Rows
    1256             $table_divider # Divider/Alignment definitions
    1257             $table_rows+ # Body Rows
    1258             ($table_caption)? # Optional caption
    1259             }mx;
    1260              
    1261              
    1262             # Find whole tables, then break them up and process them
    1263              
    1264 236         6987 $text =~ s{
    1265             ^($whole_table) # Whole table in $1
    1266             (\n|\Z) # End of file or 2 blank lines
    1267             }{
    1268 3         17 my $table = $1;
    1269 3         7 my $result = "\n"; \n"; \n"; {empty_element_suffix}\n]; {empty_element_suffix}\n]; {empty_element_suffix}\n]; {empty_element_suffix}\n]; \n"; \n"; \n"; \n\n"; \n\n\n"; \n"; \n"; \n
    1270 3         6 my @alignments;
    1271 3         5 my $use_row_header = 0;
    1272              
    1273             # Add Caption, if present
    1274              
    1275 3 100       84 if ($table =~ s/^$line_start\[\s*(.*?)\s*\](\[\s*(.*?)\s*\])?[ \t]*$//m) {
    1276 2 50       7 if (defined $3) {
    1277             # add caption id to cross-ref list
    1278 2         4 my $table_id = $self->_Header2Label($3);
    1279 2         6 $result .= qq{
    } . $self->_RunSpanGamut($1). "
    1280              
    1281 2         8 $self->{_crossrefs}{$table_id} = "#$table_id";
    1282 2         7 $self->{_titles}{$table_id} = "$1";
    1283             }
    1284             else {
    1285 0         0 $result .= "
    " . $self->_RunSpanGamut($1). "
    1286             }
    1287             }
    1288              
    1289             # If a second "caption" is present, treat it as a summary
    1290             # However, this is not valid in XHTML 1.0 Strict
    1291             # But maybe in future
    1292              
    1293             # A summary might be longer than one line
    1294 3 50       49 if ($table =~ s/\n$line_start\[\s*(.*?)\s*\][ \t]*\n/\n/s) {
    1295             # $result .= "" . $self->_RunSpanGamut($1) . "\n";
    1296             }
    1297              
    1298             # Now, divide table into header, alignment, and body
    1299              
    1300             # First, add leading \n in case there is no header
    1301              
    1302 3         9 $table = "\n" . $table;
    1303              
    1304             # Need to be greedy
    1305              
    1306 3         141 $table =~ s/\n($table_divider)\n(($table_rows)+)//s;
    1307              
    1308 3         14 my $alignment_string = $1;
    1309 3         7 my $body = $2;
    1310              
    1311             # Process column alignment
    1312 3         25 while ($alignment_string =~ /\|?\s*(.+?)\s*(\||\Z)/gs) {
    1313 8         20 my $cell = $self->_RunSpanGamut($1);
    1314 8 100       28 if ($cell =~ /\:$/) {
    1315 4 100       34 if ($cell =~ /^\:/) {
    1316 2         5 $result .= qq[
    1317 2         15 push(@alignments,"center");
    1318             }
    1319             else {
    1320 2         5 $result .= qq[
    1321 2         6 push(@alignments,"right");
    1322             }
    1323             }
    1324             else {
    1325 4 50       11 if ($cell =~ /^\:/) {
    1326 0         0 $result .= qq[
    1327 0         0 push(@alignments,"left");
    1328             }
    1329             else {
    1330 4 50 33     19 if (($cell =~ /^\./) || ($cell =~ /\.$/)) {
    1331 0         0 $result .= qq[
    1332 0         0 push(@alignments,"char");
    1333             }
    1334             else {
    1335 4         9 $result .= "{empty_element_suffix}\n";
    1336 4         27 push(@alignments,"");
    1337             }
    1338             }
    1339             }
    1340             }
    1341              
    1342             # Process headers
    1343 3         16 $table =~ s/^\n+//s;
    1344              
    1345 3         6 $result .= "
    1346              
    1347             # Strip blank lines
    1348 3         8 $table =~ s/\n[ \t]*\n/\n/g;
    1349              
    1350 3         13 foreach my $line (split(/\n/, $table)) {
    1351             # process each line (row) in table
    1352 3         6 $result .= "
    1353 3         4 my $count=0;
    1354 3         18 while ($line =~ /\|?\s*([^\|]+?)\s*(\|+|\Z)/gs) {
    1355             # process contents of each cell
    1356 8         14 my $cell = $self->_RunSpanGamut($1);
    1357 8         19 my $ending = $2;
    1358 8         10 my $colspan = "";
    1359 8 100       21 if ($ending =~ s/^\s*(\|{2,})\s*$/$1/) {
    1360 1         3 $colspan = " colspan=\"" . length($ending) . "\"";
    1361             }
    1362 8         19 $result .= "\t$cell\n";
    1363 8 100       14 if ( $count == 0) {
    1364 3 100       14 if ($cell =~ /^\s*$/) {
    1365 1         1 $use_row_header = 1;
    1366             }
    1367             else {
    1368 2         6 $use_row_header = 0;
    1369             }
    1370             }
    1371 8         45 $count++;
    1372             }
    1373 3         7 $result .= "
    1374             }
    1375              
    1376             # Process body
    1377              
    1378 3         5 $result .= "
    1379              
    1380 3         14 foreach my $line (split(/\n/, $body)) {
    1381             # process each line (row) in table
    1382 13 100       40 if ($line =~ /^\s*$/) {
    1383 2         2 $result .= "
    1384 2         5 next;
    1385             }
    1386 11         15 $result .= "
    1387 11         14 my $count=0;
    1388 11         69 while ($line =~ /\|?\s*([^\|]+?)\s*(\|+|\Z)/gs) {
    1389             # process contents of each cell
    1390 26     26   256 no warnings 'uninitialized';
      26         124  
      26         39766  
    1391 27         52 my $cell = $self->_RunSpanGamut($1);
    1392 27         61 my $ending = $2;
    1393 27         38 my $colspan = "";
    1394 27         30 my $cell_type = "td";
    1395 27 50 66     87 if ($count == 0 && $use_row_header == 1) {
    1396 0         0 $cell_type = "th";
    1397             }
    1398 27 100       111 if ($ending =~ s/^\s*(\|{2,})\s*$/$1/) {
    1399 6         18 $colspan = " colspan=\"" . length($ending) . "\"";
    1400             }
    1401 27 100       114 if ($alignments[$count] !~ /^\s*$/) {
    1402 14         58 $result .= "\t<$cell_type$colspan align=\"$alignments[$count]\">$cell\n";
    1403             }
    1404             else {
    1405 13         37 $result .= "\t<$cell_type$colspan>$cell\n";
    1406             }
    1407 27         124 $count++;
    1408             }
    1409 11         25 $result .= "
    1410             }
    1411              
    1412 3         10 $result .= "
    \n";
    1413 3         453 $result
    1414             }egmx;
    1415              
    1416 236         3071 my $table_body = qr{
    1417             ( # wrap whole match in $2
    1418              
    1419             (.*?\|.*?)\n # wrap headers in $3
    1420              
    1421             [ ]{0,$less_than_tab}
    1422             ($table_divider) # alignment in $4
    1423              
    1424             ( # wrap cells in $5
    1425             $table_rows
    1426             )
    1427             )
    1428             }mx;
    1429              
    1430 236         1844 return $text;
    1431             }
    1432              
    1433             sub _DoAttributes {
    1434 127     127   253 my ($self, $id) = @_;
    1435 127         213 my $result = "";
    1436              
    1437 127 100       315 if (defined $self->{_attributes}{$id}) {
    1438 6         43 while ($self->{_attributes}{$id} =~ s/(\S+)="(.*?)"//) {
    1439 3         24 $result .= qq{ $1="$2"};
    1440             }
    1441 6         75 while ($self->{_attributes}{$id} =~ /(\S+)=(\S+)/g) {
    1442 9         67 $result .= qq{ $1="$2"};
    1443             }
    1444             }
    1445              
    1446 127         467 return $result;
    1447             }
    1448              
    1449             sub _StripMarkdownReferences {
    1450 181     181   430 my ($self, $text) = @_;
    1451 181         432 my $less_than_tab = $self->{tab_width} - 1;
    1452              
    1453 181         2087 while ($text =~ s{
    1454             \n\[\#(.+?)\]:[ \t]* # id = $1
    1455             \n?
    1456             (.*?)\n{1,2} # end at new paragraph
    1457             ((?=\n[ ]{0,$less_than_tab}\S)|\Z) # Lookahead for non-space at line-start, or end of doc
    1458             }
    1459             {\n}sx)
    1460             {
    1461 5         12 my $id = $1;
    1462 5         13 my $reference = "$2\n";
    1463              
    1464 5         41 $reference =~ s/^[ ]{0,$self->{tab_width}}//gm;
    1465              
    1466 5         21 $reference = $self->_RunBlockGamut($reference, {wrap_in_p_tags => 0});
    1467              
    1468 5         108 $self->{_references}{$id} = $reference;
    1469             }
    1470              
    1471 181         495 return $text;
    1472             }
    1473              
    1474             sub _DoMarkdownCitations {
    1475 185     185   476 my ($self, $text) = @_;
    1476              
    1477 185         533 $text =~ s{
    1478             \[([^\[]*?)\] # citation text = $1
    1479             [ ]? # one optional space
    1480             (?:\n[ ]*)? # one optional newline followed by spaces
    1481             \[\#(.*?)\] # id = $2
    1482             }{
    1483 6         9 my $result;
    1484 6         13 my $anchor_text = $1;
    1485 6         10 my $id = $2;
    1486 6         9 my $count;
    1487              
    1488 6 50       14 if (defined $self->{_references}{$id} ) {
    1489 6         10 my $citation_counter=0;
    1490              
    1491             # See if citation has been used before
    1492 6         6 foreach my $old_id (@{ $self->{_used_references} }) {
      6         12  
    1493 12         18 $citation_counter++;
    1494 12 100       21 $count = $citation_counter if ($old_id eq $id);
    1495             }
    1496              
    1497 6 100       11 if (! defined $count) {
    1498 3         4 $count = ++$self->{_citation_counter};
    1499 3         3 push (@{ $self->{_used_references} }, $id);
      3         5  
    1500             }
    1501              
    1502 6         10 $result = qq[ ($count];
    1503              
    1504 6 100       11 if ($anchor_text ne "") {
    1505 5         9 $result .= qq[, $anchor_text];
    1506             }
    1507              
    1508 6         24 $result .= ")";
    1509             }
    1510             else {
    1511             # No reference exists
    1512 0         0 $result = qq[ ($id];
    1513              
    1514 0 0       0 if ($anchor_text ne "") {
    1515 0         0 $result .= qq[, $anchor_text];
    1516             }
    1517              
    1518 0         0 $result .= ")";
    1519             }
    1520              
    1521 6 100       11 if ($self->_Header2Label($anchor_text) eq "notcited"){
    1522 1         2 $result = qq[];
    1523             }
    1524 6         30 $result;
    1525             }xsge;
    1526              
    1527 185         439 return $text;
    1528             }
    1529              
    1530             sub _PrintMarkdownBibliography {
    1531 178     178   399 my ($self) = @_;
    1532 178         333 my $citation_counter = 0;
    1533 178         305 my $result;
    1534              
    1535 178         328 foreach my $id (@{ $self->{_used_references} }) {
      178         521  
    1536 3         4 $citation_counter++;
    1537 3         8 $result .= qq|

    [$citation_counter] $self->{_references}{$id}

    \n\n|;
    1538             }
    1539 178         528 $result .= "";
    1540              
    1541 178 100       456 if ($citation_counter > 0) {
    1542 1         4 $result = qq[\n\n
    \n{empty_element_suffix}\n

    $self->{bibliography_title}

    \n\n] . $result;
    1543             }
    1544             else {
    1545 177         338 $result = "";
    1546             }
    1547              
    1548 178         404 return $result;
    1549             }
    1550              
    1551             1;
    1552              
    1553             =back
    1554              
    1555             =head1 BUGS
    1556              
    1557             Open an issue in the GitHub repo:
    1558              
    1559             https://github.com/briandfoy/text-multimarkdown/issues
    1560              
    1561             Please include with your report: (1) the example input; (2) the output
    1562             you expected; (3) the output Markdown actually produced.
    1563              
    1564             =head1 VERSION HISTORY
    1565              
    1566             See the Changes file for detailed release notes for this version.
    1567              
    1568             =head1 AUTHOR
    1569              
    1570             =over 4
    1571              
    1572             =item * John Gruber http://daringfireball.net/
    1573              
    1574             =item * PHP port and other contributions by Michel Fortin http://michelf.com/
    1575              
    1576             =item * MultiMarkdown changes by Fletcher Penney http://fletcher.freeshell.org/
    1577              
    1578             =item * CPAN Module Text::MultiMarkdown (based on Text::Markdown by Sebastian Riedel) originally by Darren Kulp (http://kulp.ch/)
    1579              
    1580             =item * This module was maintained by: Tomas Doran http://www.bobtfish.net/
    1581              
    1582             =item * This module is currently maintained by brian d foy
    1583              
    1584             =back
    1585              
    1586             =head1 THIS DISTRIBUTION
    1587              
    1588             Please note that this distribution is a fork of Fletcher Penny's MultiMarkdown project,
    1589             and it I in any way blessed by him.
    1590              
    1591             Whilst this code aims to be compatible with the original MultiMarkdown (and incorporates
    1592             and passes the MultiMarkdown test suite) whilst fixing a number of bugs in the original -
    1593             there may be differences between the behaviour of this module and MultiMarkdown. If you find
    1594             any differences where you believe Text::MultiMarkdown behaves contrary to the MultiMarkdown spec,
    1595             please report them as bugs.
    1596              
    1597             =head1 SOURCE CODE
    1598              
    1599             You can find the source code repository for L and L
    1600             on GitHub at .
    1601              
    1602             =head1 COPYRIGHT AND LICENSE
    1603              
    1604             Original Code Copyright (c) 2003-2004 John Gruber
    1605            
    1606             All rights reserved.
    1607              
    1608             MultiMarkdown changes Copyright (c) 2005-2006 Fletcher T. Penney
    1609            
    1610             All rights reserved.
    1611              
    1612             Text::MultiMarkdown changes Copyright (c) 2006-2009 Darren Kulp
    1613             and Tomas Doran
    1614              
    1615             Redistribution and use in source and binary forms, with or without
    1616             modification, are permitted provided that the following conditions are
    1617             met:
    1618              
    1619             * Redistributions of source code must retain the above copyright notice,
    1620             this list of conditions and the following disclaimer.
    1621              
    1622             * Redistributions in binary form must reproduce the above copyright
    1623             notice, this list of conditions and the following disclaimer in the
    1624             documentation and/or other materials provided with the distribution.
    1625              
    1626             * Neither the name "Markdown" nor the names of its contributors may
    1627             be used to endorse or promote products derived from this software
    1628             without specific prior written permission.
    1629              
    1630             This software is provided by the copyright holders and contributors "as
    1631             is" and any express or implied warranties, including, but not limited
    1632             to, the implied warranties of merchantability and fitness for a
    1633             particular purpose are disclaimed. In no event shall the copyright owner
    1634             or contributors be liable for any direct, indirect, incidental, special,
    1635             exemplary, or consequential damages (including, but not limited to,
    1636             procurement of substitute goods or services; loss of use, data, or
    1637             profits; or business interruption) however caused and on any theory of
    1638             liability, whether in contract, strict liability, or tort (including
    1639             negligence or otherwise) arising in any way out of the use of this
    1640             software, even if advised of the possibility of such damage.
    1641              
    1642             =cut