codeblock-diagrams.pl

#!/usr/bin/env perl
# Based on 'mddia', licensed under GPL by Jakob Voss
# Rewritten as a pandoc filter by Benct Philip Jonsson

use strict;
use warnings;
use Pod::Usage;
use File::Basename;
use Cwd 'abs_path';

use Pandoc::Elements 0.17;
use Pandoc::Walker qw[ transform ];
use File::Slurper 0.008  qw[ write_text ];

=head1 NAME

codeblock-diagrams - filter to process diagrams embedded in pandoc code blocks

=head1 SYNOPSIS

    pandoc -F codeblock-diagrams.pl [-M dia_format=pdf|png] [PANDOC-OPTIONS] [FILE-NAME ...]

=head1 EXAMPLES

    ~~~~ {.ditaa .no-separation scale=1.5 .fig_}
        
        +----------+      +--------+     +--------+  +-----+  +-----+  +-----+
        |          |      |        |     |        |  |     |  |     |  |     |
        | markdown |----->| pandoc |---->| output |  | img |  | img |  | img |
        | {d}      |      |        |     | {d}    |  | {d} |  | {d} |  | {d} |
        |          |      +--------+     |        |  |     |  |     |  |     |
        +----------+         |  ^        +--------+  +-----+  +-----+  +-----+
                             v  |                       ^        ^        ^ 
                          +--------+   +--------+       |        |        |     
                          |        |-->| ditaa  |-------+        |        |
                          | filter |   +--------+                |        |
                          |        |-->| dot    |----------------+        |
                          |        |   +--------+                         |
                          |        |-->| rdfdot |-------------------------+
                          +--------+   +--------+
    ~~~~

    ~~~~ {.dot Grankdir=LR}
    digraph {
    A -> B -> C;
    A -> C;
    }
    ~~~~

    ~~~~ {.rdfdot}
    @prefix foaf: <http://xmlns.com/foaf/0.1/> .
    @base <http://example.com/> .
    <alice> foaf:name "Alice" ;
            foaf:knows [ foaf:name "Bob" ] .
    ~~~~

=head1 ATTRIBUTES

The first class argument specifies the diagram type (C<.ditaa .dot .rdfdot>).

Class attributes (prefixed with a dot) are passed as options without arguments.

Name=value attributes are passed as options with arguments.

Classes ending in an underscore or name=value arguments where the
name ends in an underscore have the underscore removed and are
passed as attributes to the output Image element rather than as
options to the diagram processor.

=head2 Special attributes

=over

=item C<.fig_>

The image becomes a figure with caption.

=item C<< alt_=I<TEXT> >>

Specify the alt text/caption for the image/figure.
Currently you can I<not> use markup inside this text!

=item C<< title_=I<TEXT> >>

Set the title attribute of the image.

=back

=cut

# required jar files
my %ditaa;
{
    my $loc = dirname(abs_path($0));
    my $home = abs_path($ENV{HOME});
    my %jar = (png => "ditaa0_6b.jar", pdf => "DitaaEps.jar");
    JAR:
    while ( my($fmt, $name) = each %jar ) {
        PATH:
        foreach my $path ( "$loc/$name", "$home/$name" ) {
            -f $path || next PATH;
            $ditaa{$fmt} = $path;
        }
        $ditaa{$fmt} || pod2usage("missing $name");
    }
}

my ($format);

my $count = 0;       # image counter to get unique image file names

my %diagramtypes = (
    ditaa  => sub {
        my( $file, $classes, $attrs ) = @_;
        my $img = $format eq 'png' ? "$file.png" : "$file.eps";
        my @args = map {; "--$_" } @$classes;
        push @args, map {; ( "--$_->[0]", $_->[1] ) } @$attrs; 
        system join ' ', 'java', '-jar', $ditaa{$format}, @args, "$file.ditaa", $img, ">/dev/null";
        system "epstopdf", "-o", "$file.$format", $img if $format eq 'pdf';
    },
    dot    => sub {
        my( $file, $classes, $attrs ) = @_;
        my $img = $format eq 'png' ? "$file.png" : "$file.eps";
        my @args = map {"-$_" } @$classes;
        push @args, map { "-$_->[0]=$_->[1]" } @$attrs; 
        system join ' ', 'dot', ($format eq 'png' ? '-Tpng' : '-Teps'), @args, "-o$img", "$file.dot", ">/dev/null";
        system "epstopdf", "-o", "$file.$format", $img if $format eq 'pdf';
    },
    rdfdot => sub { 
        my( $file, $classes, $attrs ) = @_;
        my @args = map {; "-$_" } @$classes;
        push @args, map {; ( "-$_->[0]", $_->[1] ) } @$attrs; 
        if ($format eq 'png') {
            system 'rdfdot', @args, '-ttl', "$file.rdfdot", "$file.png";
        } else {
            system 'rdfdot', @args, '-ttl', "$file.rdfdot", "$file.dot";
            system 'dot', '-Teps', "-o$file.eps", "$file.dot", ">/dev/null";
            system 'epstopdf', "-o=$file.pdf", "$file.eps";
        }
    },
);

pod2usage(1) if grep /^-(-?help|h)$/, @ARGV;


my $markup_format = shift;
my $document = pandoc_json( <> );

my $meta = $document->meta;
$format
  = exists $meta->{dia_format}                     ? $meta->{dia_format}->string
  : $markup_format =~ /^(?:latex|beamer|context)$/ ? 'pdf'
  :                                                  'png';
$format =~ s/^\s+|\s+$//g;
$format ||= 'png';
$format =~ /^(?:pdf|png)$/ or pod2usage( "-M dia_format must be 'pdf' or 'png'" );

$document->transform( CodeBlock =>\&codeblock_dia );

print $document->to_json;

sub codeblock_dia {
    my($code_block) = @_;
    # 'CodeBlock' eq $code_block->name or return;
    my($type, @classes) = @{ $code_block->classes };
    return unless $type;
    return unless $diagramtypes{$type};
    my $kvs = $code_block->attr->[2];
    my %params = map {; $_ => [[],[]] } qw[ attr args ];
    for my $class ( grep {defined} @classes ) {
        my $key = $class =~ s/_$// ? 'attr' : 'args';
        push @{ $params{$key}[0] }, $class;
    }
    for my $kv ( @$kvs ) {
        my $key = $kv->[0] =~ s/_$//  ? 'attr' : 'args';
        push @{ $params{$key}[1] }, $kv;
    }
    $count++;
    my $file = "image-$count";
    {
        open my $fh, '>:encoding(UTF-8)', "$file.$type"
            or die "couldn't open file $file.$type: $!\n";
        print {$fh} $code_block->content;
        close $fh or die "couldn't close file $file.$type: $!\n";
    }
    $diagramtypes{$type}->($file, @{ $params{args} });
    my %attr = map {; @$_ } @{ $params{attr}[1] };
    $attr{classes} = $params{attr}[0] // [];
    $attr{id} = $code_block->id;
    my( $alt, $title ) = map {; delete($attr{$_}) // "" } qw[ alt title ];
    my $fig = grep { /^fig$/ } @{ $attr{classes} };
    return Para [
        Image attributes \%attr,
        [ Str $alt ],
        [ "$file.$format", $fig ? "fig:$title" : $title ]
    ];
}

__END__

image-1.png

@nichtich wrote:

dia_format can be set automatically from markup_format: beamer, latex, pdf requires PDF images, otherwise use PNG.

Yes I thought of that, but I think the option to choose explicitly should be there too, at least so that things don't break totally if another format is added. BTW markup_format will never be pdf. If you say -o foo.pdf it will be latex. I suppose context will want PDF too, right?

File::Slurper::write_text is useful but I'd replace it with 3 lines of own code to not add another dependency to Pandoc::Elements

Sure. On second thought this filter is pretty *nix only anyway.

A better name to be included in examples directory of Pandoc::Elements, e.g. codeblock-images.pl, codeimages.pl, code2image.pl...

codeblock-diagrams.pl would probably be smore descriptive. Naming modules is really hard! FWIW I make a point of naming my pandoc filters with the prefix 'pandoc-'.

I will do this tomorrow if I get some time.