pandoc-small-caps.pl

#!/usr/bin/env perl

#----------------------------------------------------------------------
# pandoc-small-caps.pl
#
# Pandoc filter to convert spans with class 'small-caps' 
# (and optionally ~~Strikeout~~) to SmallCaps.
#
#	pandoc -F pandoc-small-caps.pl [-M strikeout2smallcaps] ARGUMENTS...
#
# Copyright 2014- Benct Philip Jonsson.
# 
# This script is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#----------------------------------------------------------------------
#
# You can set the following options in the document metadata:
# 
# ---
# strikeout2smallcaps: 1    # Boolean -- convert ~~Strikeout~~ to SmallCaps.
# ...
#
# or on the commandline:
#
# -M strikeout2smallcaps=1
#

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

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

use autodie 2.12;

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

use JSON qw[ decode_json encode_json ];
use Data::Rmap qw[ rmap_hash cut ]; # Data structure traversal support.
# use List::MoreUtils qw[any];
use List::Util qw[any];

sub get_meta_option_strings {
    my($doc, $keys, $prefix) = @_;
    $keys = [$keys] unless 'ARRAY' eq ref $keys;
    my $meta = $doc->[0]{unMeta};
    my %option;
    OPTION:
    for my $key ( @$keys ) {
        next OPTION unless exists $meta->{$prefix.$key};
        my($value) = rmap_hash {
            if ( $_->{t} =~ /\A(?:MetaString|Str)\z/ ) {
                cut $_->{c};
            }
            elsif ( $_->{t} =~ /\ACode(?:Block)?\z/ ) {
                cut $_->{c}[-1];
            }
        } $meta->{$prefix.$key};
        $option{$key} = $value;
    }
    return \%option;
}

my $to_format = shift @ARGV;

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

my $strike2sc 
    = get_meta_option_strings( $doc, 'strikeout2smallcaps' )->{strikeout2smallcaps};


# Change elements in-place
rmap_hash {
    if ( 'Span' eq $_->{t} ) {
        my $classes = $_->{c}[-2][1];
        return unless any { /\Asmall-caps\z/ } @$classes;
        $_->{c} = $_->{c}[-1];
        $_->{t} = 'SmallCaps';
    }
    elsif ( $strike2sc ) {
        return unless 'Strikeout' eq $_->{t};
        $_->{t} = 'SmallCaps';
    }
    return; # Nothing!
} $doc;

print {*STDOUT} encode_json $doc;

__END__