more work on the figures

[ikiwiki_plugins.git] / sweavealike.pm

#!/usr/bin/perl
# Ikiwiki Sweave-alike plugin
# under the terms of the GPL version 2, or any later version at your
# option.
# Copyright 2012 by Don Armstrong <don@donarmstrong.com>.


package IkiWiki::Plugin::sweavealike;

=head1 NAME

sweavealike -- A Sweave-alike plugin which allows for embedding R code in IkiWiki

=head1 SYNOPSIS

sweavealike allows you to embed R code in IkiWiki.


[[!sweavealike code='''
a <- 1
a <- a*a+10
print(a)
''']]


=head1 DESCRIPTION

=head2 Available options

=over

=item code

R code to execute. Required to be present. [If you didn't want to
execute R code, why would you use this directive?]

=item echo

Echo the R code. [Basically, this escapes the code with >, and then
adds spaces so that the output is interpreted as a code fragment.]

=item nooutput

Suppress all non-figure output

=item results

Defaults to show the results (what R wrote to stdout) of a particular
piece of code

=item fig

If present, code is assumed to produce a figure which is automatically
included inline

=item width

Integer width of included figure; defaults to 400

=item height

Integer height of included figure; defaults to 400

=back


=head1 BUGS

R is a complete language, and no attempt is made to control what you
can do. Reading and writing arbitrary files, as well as exhausting
available memory and CPU are all trivially possible. Thus, you should
NEVER use this plugin on a publicly editable IkiWiki instance.

You should be able to refer to previously created figures without
rerunning the code.

=cut

use warnings;
use strict;

use Statistics::R;

use IkiWiki '3.00';

use Encode qw(decode);
use Digest::MD5 qw(md5_hex);

my $id = "sweavealike";
sub import {
    hook(type => "getsetup", id => $id, call => \&getsetup);
    hook(type => "preprocess", id => $id, call => \&preprocess);
    hook(type => "htmlize", id => $id, call => \&htmlize);
    hook(type => "savestate", id => $id, call => \&savestate);
}

sub getsetup {
    return(plugin => {safe => 0,
                      rebuild => 1,
                      section => "misc",
                      link => "http://git.donarmstrong.com/?p=ikiwiki_plugins.git;a=blob;f=sweavealike.pm;hb=HEAD",
                      description => "sweavealike plugin",
                     },
          );
}

sub code_md5 {
    return(md5_hex(map {decode('utf8',$_)} @_));
}

sub preprocess {
    my %param = @_;

    if (not defined $pagestate{$param{page}}{$id}{R}) {
        $pagestate{$param{page}}{$id}{R} = Statistics::R->new(shared => 1)
            or error("Unable to create an R process");
    }
    # we currently don't bother to support anything but outputing the
    # entire segment of code and its R output

    if (not exists $param{code}
        or not defined $param{code}
        or not length $param{code}) {
        error("There wasn't any R code supplied");
    }

    my $image_loc
    if (exists $param{fig}) {
        $pagestate{$param{page}}{$id}{fignum}++;
        $param{width} = '400' unless exists $param{width} and defined $param{width};
        $param{height} = '400' unless exists $param{height} and defined $param{height};
        for (qw(width height)) {
            if ($param{$_} !~ /^\d+$/) {
                error("invalid $_; must be an integer: $param{$_}");
            }
        }
        # because even if the code is duplicated, the figure could still be the same.
        my $md5 = code_md5($param{code},$param{width},$param{height},$pagestate{$param{page}}{$id}{fignum});
        $image_loc = "$param{page}/${md5}.png";
        my $image_loc_esc = $image_loc;
        $image_loc_esc =~ s/"/\\"/g;
        will_render($param{page},$image_loc);
        eval {
            $pagestate{$param{page}}{$id}{R}->run(qq{png(filename="$image_loc_esc",width=$param{width},height=$param{height});});
        };
        if ($@) {
            error("code 'png(filename="$image_loc_esc",width=$param{width},height=$param{height});' (from internal figure handling) produced error '$@'");
        }
    }
    my $code_result;
    eval {
        $code_result = $pagestate{$param{page}}{$id}{R}->run($param{code});
    };
    if ($@) {
        error("code '$param{code}' produced error '$@'");
    }
    my $output = '';
    my $fig_output = '';
    if (exists $param{fig}) {
        eval {
            $pagestate{$param{page}}{$id}{R}->run(qq{dev.off();});
        };
        if ($@) {
            error("code 'dev.off()' (from internal figure handling) produced error '$@'");
        }
        $fig_output = qq(\n<img class="sweavealike" src=").urlto($image_loc,$param{destpage}).qq(" />);
    }
    if (exists $param{nooutput}) {
        return($output.$fig_output);
    }
    if (exists $param{echo}) {
        $output .= $param{code};
        $output =~ s/^/> /mg;
        $output .= "\n";
    }
    if (not exists $param{results} or
        (defined $param{results} and
         $param{results} !~ /^(hide|false)$/i;)) {
        $output .= $code_result;
    }
    if (exists $param{echo} or
        exists $param{results}) {
        $output =~ s/^/    /mg;
    }
    return($output);
}

# stop any started R processes here
sub htmlize {
    my %param = @_;
    if (exists $pagestate{$param{page}} and
        exists $pagestate{$param{page}}{$id} and
        exists $pagestate{$param{page}}{$id}{R}) {
        if (defined $pagestate{$param{page}}{$id}{R}
            and $pagestate{$param{page}}{$id}{R}->is_started()) {
            $pagestate{$param{page}}{$id}{R}->stop();
        }
        delete $pagestate{$param{page}}{$id}{R};
    }
}

sub savestate {
    # make sure we never try to save an R process
    for my $page (keys %pagestate) {
        next unless exists $pagestate{$page}{$id};
        next unless exists $pagestate{$page}{$id}{R};
        if (defined $pagestate{$page}{$id}{R}
            and $pagestate{$page}{$id}{R}->is_started()) {
            $pagestate{$page}{$id}{R}->stop;
        }
        delete $pagestate{$page}{$id}{R};
    }
}





1;


__END__