view release on metacpan or  search on metacpan

bin/ppp  view on Meta::CPAN

#!/usr/bin/env perl

package main;
$main::VERSION = 'v0.9.10';
#  PODNAME: ppp
# ABSTRACT: Preprocess Pandoc before Processing Pandoc

use v5.14;
use strict;
use warnings;
use File::Spec;
use File::Temp 'tempdir';
use File::Path 'make_path';

# configuration set as --key value at command line or as key=value from file
our %config;
our ($img, $log);

# load configuration from file in current directory if given
{
    if (local @ARGV = grep { -e $_ } qw(.ppprc ppp.conf)) {
        while (<>) { # parse simple "key = value" pairs
            $config{$1} = $2 if /^\s*(\w+)\s*=\s*(.*?)\s*$/;
        }
    }
}

# parse command line options
while (@ARGV) {
    last unless $ARGV[0] =~ /^--(\w*)$/; # --key
    last unless length($1);              # "--" stops option parsing
    shift @ARGV;
    $config{$1} = (@ARGV && $ARGV[0] !~ /^--(\w*)$/)
                ? shift @ARGV : 1;       # --key  or --key value
}

# register known options as global variables
{
    no strict 'refs';
    for my $name (qw(img log)) {
        $$name = $config{$name} if defined $config{$name};
    }
}

create_directories($img, $log);

state $fileno = 0;
state $outfile;
state $format;
state @children;
state %attributes;
state $imgdir = defined $img ? $img : tempdir('ppp-render-XXXXX', CLEANUP => 0, TMPDIR => 1);
state $logdir = defined $log ? $log : tempdir('ppp-log-XXXXX'   , CLEANUP => 0, TMPDIR => 1);

MAIN: {
  while(<>) {
    if ( (my $start = /^~{3,}\s*\{.*?(?<format>rdfdot|ditaa|dot|neato|yuml|plantuml)(?<attributes>.*)\}.*/) ... (my $end = /^~{3,}\s*$/) ) {
        $start ? begin_ppp() : $end ? end_ppp() : print {$outfile} $_
    } else {
      print
    }
  }
}

SUBS: {
  sub begin_ppp {
    $fileno++;
    $format = $+{format};
    $attributes{$fileno.$format} = $+{attributes};
    open $outfile, '>', "$imgdir/image-$fileno.$format"
  }

  sub render {
    my ($format, $fileno, %attrs) = @_;
    my $cmd = '';

    $format =~ /^ditaa$/ and
      $cmd = "ditaa"
           . " @{[exists $attrs{'rounded-corners'} ? '--round-corners ' : ' ']}"
           . " @{[exists $attrs{'no-shadows'}      ? '--no-shadows '    : ' ']}"
           . " @{[exists $attrs{'no-separation'}   ? '--no-separation ' : ' ']}"