pandoc-wrap-raw.pl

#!/usr/bin/env perl

=encoding UTF-8

 This is a Pandoc <http://pandoc.org> filter to turn
 code blocks and code spans which have certain specified
 classes into RawBlock or RawInline elements in specified
 output formats, wrapping them in specified markup as needed.

 It can be used e.g. to output LaTeX math in both LaTeX and HTML,
 in the latter wrapped in appropraite markup for MathJax.


 You can set the following options in the document metadata:

 (The shown values are set by default.)
 
 ````yaml
 ---
 wrap_raw:
   math:
     html:
       block: 
         before: '`<p><span class="math">\[`'
         after:  '`\]</span></p>`'
       inline:  
         before : '`<span class="math">\(`'
         after:   '`\)</span>`'
     latex: 
       block: 
         before: '`\[`'
         after:  '`\]`'
       inline:  
         before: '`\(`'
         after:  '`\)`'
 ...
 ````

 Now you can put things like this in your Markdown:

 ````````markdown_pandoc
 This is some math.
 
 ````{.math}
 \begin{align}
 x&=1\label{eq:1}\\
 y&=2
 \end{align}
 ````
 
 End of math. `\eqref{eq:1}`{.math}
 ````````

 Run pandoc with the filter:

     $ pandoc -F pandoc-wrap-raw.pl input.md
 
 And get output like this in HTML:
     
 ````html
 <p>This is some math.</p>
 <p><span class="math">
 \begin{align}
 x&=1\label{eq:1}\\
 y&=2
 \end{align}
 </span></p>
 <p>End of math. <span class="math">\eqref{eq:1}</span></p>
 ````

 and like this in LaTeX:
 
 ````latex
 This is some math.
 
 \begin{align}
 x&=1\label{eq:1}\\
 y&=2
 \end{align}
 
 End of math. \eqref{eq:1}
 ````

 You will need these CPAN modules and their dependencies:

 *  JSON::MaybeXS
    
    Any of

    *   Cpanel::JSON::XS
    *   JSON::XS
    *   JSON::PP

 *  Data::Rmap
 *  List::AllUtils

 If you have *cpanm* installed you can do this:

    $ perl pandoc-wrap-raw.pl --prereqs | cpanm

 and they will be installed for you!

 If you are on Windows and don't have perl installed, see

 <http://strawberryperl.com/>
 <http://www.cpan.org/modules/INSTALL.html>

=cut

# use 5.014;
use strict;
use warnings FATAL => 'all';
no warnings qw[ uninitialized numeric ];

use utf8;  # No UTF-8 I/O with JSON!

# use autodie 2.12;

# no indirect;
# no autovivification; # Don't pullute the AST!

# use Getopt::Long qw[ GetOptionsFromArray :config no_ignore_case ];

use Pod::Usage;
use JSON::MaybeXS qw[ decode_json encode_json ];
use Data::Rmap qw[ rmap_hash rmap_array cut ]; # Data structure traversal support.
use List::AllUtils qw[ firstval ];

my $prereqs = <<'PREREQS';
JSON::MaybeXS
JSON::PP
Data::Rmap
List::AllUtils
PREREQS

unless ( @ARGV ) {
    pod2usage(-exitval => 1, -verbose => 2, -noperldoc => 1);
}

my $to_format = shift @ARGV;

if ( $to_format =~ /^-/ ) {
    if ( '--prereqs' eq $to_format ) {
        print $prereqs;
        exit 0;
    }
    elsif ( $to_format =~ /^(?:--help|-h)$/ ) {
        pod2usage(-exitval => 0, -verbose => 2, -noperldoc => 1);
    }
    else {
        pod2usage(-exitval => 1, -verbose => 2, -noperldoc => 1);
    }
}

my $doc = decode_json do { local $/; <>; };

# Gather options from the document metadata:    # {{{1}}}

my $option = get_meta_opts(
    +{  doc     => $doc,
        opts    => [qw[ wrap_raw ]],
        default => +{
            wrap_raw => {
                math => {
                    html => {
                        block => {
                            after  => "\\]</span></p>",
                            before => "<p><span class=\"math\">\\[",
                        },
                        inline => {
                            after  => "\\)</span>",
                            before => "<span class=\"math\">\\("
                        },
                    },
                    latex => {
                        block  => { after => "\\]", before => "\\[" },
                        inline => { after => "\\)", before => "\\(" },
                    },
                },
            },
        },
        prefix => q{},
    }
);

my $wrap_raw = $option->{wrap_raw};
my %wrap_block = ( before => "%s\n", after => "\n%s", );

# Traverse document:                            # {{{1}}}

# Change elements in-place:                     # {{{2}}}

rmap_hash {
    my $elem  = $_;
    return unless $elem->{t} =~ /Code/;
    my $wrap_class = firstval { $wrap_raw->{$_} } @{ $elem->{c}[-2][1] }; # Classes
    return unless $wrap_class and my $wrap = $wrap_raw->{$wrap_class}{$to_format};
    my($type) = $elem->{t} =~ /(Block)/;
    $type ||= 'Inline';
    my $text = $elem->{c}[-1];
    if ( ref $wrap ) {
        if( my $around = $wrap->{lc $type} ) {
            my %around;
            AROUND:
            for my $end ( qw[ before after ] ) {
                next AROUND unless $around->{$end};
                $around{$end} = $around->{$end};
                $around{$end} = sprintf $wrap_block{$end}, $around{$end} if 'Block' eq $type;
            }
            $text = $around{before} . $text . $around{after};
        }
    }
    $_ = _mk_elem( "Raw\u\L$type" => [ $to_format => $text ] );
    return;
} $doc;


print {*STDOUT} encode_json $doc;

# HELPER FUNCTIONS                              # {{{1}}}
sub _mk_elem {	# {{{2}}}
    my($type => $contents) = @_;
    return +{ t => $type, c => $contents };
}

# Getting options:                              # {{{2}}}

sub get_meta_opts {                             # {{{3}}}
	my $p = shift;
	my $doc = $p->{doc};
	my $meta = $doc->[0]{unMeta};
	my %opt = %{ $p->{default} || +{} };
	my @opts = @{ $p->{opts} || [] };
	my $pfx = $p->{prefix} || q{};
	@opts = keys %opt unless @opts;
	OPT:
	for my $opt ( @opts ) {
		my $key = $pfx . $opt;
		next unless exists $meta->{$key};
		$opt{$opt} = _get_opt_val( $meta->{$key} );
	}
	return \%opt;
}

# Turn one pandoc metadata value into an option value # {{{3}}}
sub _get_opt_val {
	my($data) = @_;
	if ( 'MetaMap' eq $data->{t} ) {
		return _get_opt_map( $data->{c} );
	}
	elsif ( 'MetaList' eq $data->{t} ) {
		return _get_opt_list( $data->{c} );
	}
	else {
        # Should we return a concatenation instead of 
        # just the first string-ish contents value?
		my($opt) = rmap_hash {
			if ( $_->{t} =~ /\A(?:Str|Meta(?:String|Bool))\z/ ) {
				cut $_->{c};
			}
			elsif ( $_->{t} =~ /\ACode(?:Block)?\z/ ) {
				cut $_->{c}[-1];
			}
			return;
		} $data;
		return $opt;
	}
	return;
}

# Turn a pandoc metadata map into a plain hashref # {{{3}}}
sub _get_opt_map {
	my($href) = @_;
	my %ret;
	while ( my( $k, $v ) = each %$href ) {
		$ret{$k} = _get_opt_val($v);
	}
	return \%ret;
}

# Turn a pandoc metadata list into a plain arrayref # {{{3}}}
sub _get_opt_list {
	my( $aref ) = @_;
	my @ret = map { _get_opt_val($_) } @$aref;
	return \@ret;
}

__END__