pandoc/templates/fillTemplates.pl

#!/usr/bin/env perl
# Fills templates with haskell-escaped strings slurped from input files.
# Takes two arguments, the first specifying the pathname of the target
# relative to the root directory, the second specifying the root directory
# (defaulting to ..).  The template is assumed to have the same base name
# as the target and to reside in the templates subdirectory of the root
# directory.

use strict;
use warnings;

# Utility routines:

sub slurp {
    open FILE, $_[0] or die "couldn't open file '$_[0]': $!";
    my $contents = do { local $/; <FILE>;};
    close FILE;
    return $contents;
}

sub escape_for_haskell {
    my ($contents) = @_;

    $contents =~ s/\\/\\\\/g;
    $contents =~ s/\t/\\t/g;
    $contents =~ s/"/\\"/g;
    $contents =~ s/\n/\\n/g;
    return $contents;
}

# Template processors.

my %processor = (
    # --------------------------------------------------------------------------
    'Text/Pandoc/Writers/S5.hs' => {
    # --------------------------------------------------------------------------
	proc     => sub {
	    my ($template) = @_;

        my (@files) = qw(slides.js s5-core.css framing.css pretty.css 
                         opera.css outline.css print.css);

        foreach my $file (@files) {
	        my $replacement = escape_for_haskell(slurp "templates/ui/default/$file");
            my $escapedfile = $file;
            $escapedfile =~ s/\./\\./g;
            $template =~ s/\@$escapedfile\@/$replacement/;
        } 
	    return $template;
	},
    },
    # --------------------------------------------------------------------------
    'Text/Pandoc/ASCIIMathML.hs' => {
    # --------------------------------------------------------------------------
	proc     => sub {
	    my ($template) = @_;

	    my $script = escape_for_haskell(slurp "templates/ASCIIMathML.js"); 
	    my $acknowledgements =
		" ASCIIMathML.js - copyright Peter Jipsen,".
		" released under the GPL\\nSee ".
		"http://www1.chapman.edu/~jipsen/mathml/asciimath.html/ ";
	    $script =~ s/\/\*.*?\*\//\/\*$acknowledgements\*\//g; # strip comments
	    $template =~ s/\@ASCIIMathML\.js@/$script/;

	    return $template;
	},
    },
    # --------------------------------------------------------------------------
    'Text/Pandoc/Writers/DefaultHeaders.hs' => {
    # --------------------------------------------------------------------------
	proc     => sub {
	    my ($template) = @_;

        my (@headers) = split(/\s/,`ls templates/headers`);
        foreach my $header (@headers) {
           my ($replacement) = escape_for_haskell(slurp "templates/headers/$header");
           $template =~ s/\@$header\@/$replacement/;
        }
	    
	    return $template;
	},
    },
    # --------------------------------------------------------------------------
    # 'foo/bar/baz' => {
    # --------------------------------------------------------------------------
    #    template => 'optional-template-filename-defaults-to-baz'
    #    proc     => sub {
    # 	    my ($template) = @_;
    # 	    # Process.
    # 	    return $template;
    #    },
    #},
);

# Main.

my $target = shift @ARGV;
if (!defined $target || !length $target) {
	print STDERR "Available targets:\n\n" . join "\n", keys %processor;
	die "\n\nYou must supply a target!\n";
}

die "No processor exists for '$target'!\n" if ! exists $processor{$target};

my $rootdir = shift @ARGV || '..';
chdir $rootdir or die "Couldn't chdir to '$rootdir': $!";

my $template;
if (exists $processor{$target}->{template}) {
   $template = $processor{$target}->{template};
}
else {
    ($template = $target) =~ s!.*/+!!;
}
$template = "templates/$template";
die "No template exists for '$target'!\n" if ! -f "$template";

open OUTFILE, ">$target" or die "couldn't open file '$target': $!";
print OUTFILE <<END;
----------------------------------------------------
-- Do not edit this file by hand.  Edit 
-- '$template'
-- and run $0 $target
----------------------------------------------------

END

print OUTFILE $processor{$target}->{proc}->(slurp($template));
print OUTFILE "\n";
close OUTFILE;