sweavealike.pm

   1 #!/usr/bin/perl
   2 # Ikiwiki Sweave-alike plugin
   3 # under the terms of the GPL version 2, or any later version at your
   4 # option.
   5 # Copyright 2012 by Don Armstrong <don@donarmstrong.com>.
   6
   7
   8 package IkiWiki::Plugin::sweavealike;
   9
  10 =head1 NAME
  11
  12 sweavealike -- A Sweave-alike plugin which allows for embedding R code in IkiWiki
  13
  14 =head1 SYNOPSIS
  15
  16 sweavealike allows you to embed R code in IkiWiki.
  17
  18
  19 [[!sweavealike code='''
  20 a <- 1
  21 a <- a*a+10
  22 print(a)
  23 ''']]
  24
  25
  26 =head1 DESCRIPTION
  27
  28 =head2 Available options
  29
  30 =over
  31
  32 =item code
  33
  34 R code to execute. Required to be present. [If you didn't want to
  35 execute R code, why would you use this directive?]
  36
  37 =item echo
  38
  39 Echo the R code. [Basically, this escapes the code with >, and then
  40 adds spaces so that the output is interpreted as a code fragment.]
  41
  42 =item nooutput
  43
  44 Suppress all non-figure output
  45
  46 =item results
  47
  48 Defaults to show the results (what R wrote to stdout) of a particular
  49 piece of code
  50
  51 =item fig
  52
  53 If present, code is assumed to produce a figure which is automatically
  54 included inline
  55
  56 =item width
  57
  58 Integer width of included figure; defaults to 400
  59
  60 =item height
  61
  62 Integer height of included figure; defaults to 400
  63
  64 =back
  65
  66
  67 =head1 BUGS
  68
  69 R is a complete language, and no attempt is made to control what you
  70 can do. Reading and writing arbitrary files, as well as exhausting
  71 available memory and CPU are all trivially possible. Thus, you should
  72 NEVER use this plugin on a publicly editable IkiWiki instance.
  73
  74 You should be able to refer to previously created figures without
  75 rerunning the code.
  76
  77 =cut
  78
  79 use warnings;
  80 use strict;
  81
  82 use Statistics::R;
  83
  84 use IkiWiki '3.00';
  85
  86 use Encode qw(decode);
  87 use Digest::MD5 qw(md5_hex);
  88 use Cwd;
  89
  90 my $id = "sweavealike";
  91 sub import {
  92     hook(type => "getsetup", id => $id, call => \&getsetup);
  93     hook(type => "preprocess", id => $id, call => \&preprocess);
  94     hook(type => "htmlize", id => $id, call => \&htmlize);
  95     hook(type => "savestate", id => $id, call => \&savestate);
  96 }
  97
  98 sub getsetup {
  99     return(plugin => {safe => 0,
 100                       rebuild => 1,
 101                       section => "misc",
 102                       link => "http://git.donarmstrong.com/?p=ikiwiki_plugins.git;a=blob;f=sweavealike.pm;hb=HEAD",
 103                       description => "sweavealike plugin",
 104                      },
 105           );
 106 }
 107
 108 sub code_md5 {
 109     return(md5_hex(map {decode('utf8',$_)} @_));
 110 }
 111
 112 sub preprocess {
 113     my %param = @_;
 114
 115     if (not defined $pagestate{$param{page}}{$id}{R}) {
 116         # I've decided to put R into the src directory instead of the
 117         # dest directory
 118         my $cur_dir = getcwd;
 119         chdir($config{srcdir});
 120         $pagestate{$param{page}}{$id}{R} = Statistics::R->new(shared => 1)
 121             or error("Unable to create an R process");
 122         chdir($cur_dir);
 123     }
 124     # we currently don't bother to support anything but outputing the
 125     # entire segment of code and its R output
 126
 127     if (not exists $param{code}
 128         or not defined $param{code}
 129         or not length $param{code}) {
 130         error("There wasn't any R code supplied");
 131     }
 132
 133     my $image_loc = '';
 134     if (exists $param{fig}) {
 135         $param{width} = '400' unless exists $param{width} and defined $param{width};
 136         $param{height} = '400' unless exists $param{height} and defined $param{height};
 137         for (qw(width height)) {
 138             if ($param{$_} !~ /^\d+$/) {
 139                 error("invalid $_; must be an integer: $param{$_}");
 140             }
 141         }
 142         # because even if the code is duplicated, the figure could
 143         # still be different, we track the number of figures
 144         $pagestate{$param{page}}{$id}{fignum}++;
 145         my $md5 = code_md5($param{code},$param{width},$param{height},$pagestate{$param{page}}{$id}{fignum});
 146         $image_loc = "$param{page}/${md5}.png";
 147         my $image_loc_esc = $image_loc;
 148         $image_loc_esc =~ s/"/\\"/g;
 149         will_render($param{page},$image_loc);
 150         # this makes sure that we can write to the file result
 151         writefile($image_loc, $config{destdir}, "");
 152         eval {
 153             $pagestate{$param{page}}{$id}{R}->run(qq|png(filename="$config{destdir}/$image_loc_esc",width=$param{width},height=$param{height});|);
 154         };
 155         if ($@) {
 156             error(qq|code 'png(filename="$config{destdir}/$image_loc_esc",width=$param{width},height=$param{height});' (from internal figure handling) produced error '$@'|);
 157         }
 158     }
 159     my $code_result;
 160     eval {
 161         $code_result = $pagestate{$param{page}}{$id}{R}->run($param{code});
 162     };
 163     if ($@) {
 164         error("code '$param{code}' produced error '$@'");
 165     }
 166     my $output = '';
 167     my $fig_output = '';
 168     if (exists $param{fig}) {
 169         eval {
 170             $pagestate{$param{page}}{$id}{R}->run(qq{dev.off();});
 171         };
 172         if ($@) {
 173             error("code 'dev.off()' (from internal figure handling) produced error '$@'");
 174         }
 175         $fig_output = qq(\n<img class="sweavealike" src=").urlto($image_loc,$param{destpage}).qq(" />);
 176     }
 177     if (exists $param{nooutput}) {
 178         return($output.$fig_output);
 179     }
 180     if (exists $param{echo}) {
 181         $output .= $param{code};
 182         $output =~ s/^/> /mg;
 183         $output .= "\n";
 184     }
 185     if (not exists $param{results} or
 186         (defined $param{results} and
 187          $param{results} !~ /^(hide|false)$/i)) {
 188         $output .= $code_result;
 189     }
 190     if (exists $param{echo} or
 191         exists $param{results}) {
 192         $output =~ s/^/    /mg;
 193     }
 194     return($output);
 195 }
 196
 197 # stop any started R processes here
 198 sub htmlize {
 199     my %param = @_;
 200     if (exists $pagestate{$param{page}} and
 201         exists $pagestate{$param{page}}{$id} and
 202         exists $pagestate{$param{page}}{$id}{R}) {
 203         if (defined $pagestate{$param{page}}{$id}{R}
 204             and $pagestate{$param{page}}{$id}{R}->is_started()) {
 205             $pagestate{$param{page}}{$id}{R}->stop();
 206         }
 207         delete $pagestate{$param{page}}{$id}{R};
 208     }
 209 }
 210
 211 sub savestate {
 212     # make sure we never try to save an R process
 213     for my $page (keys %pagestate) {
 214         next unless exists $pagestate{$page}{$id};
 215         if (exists $pagestate{$page}{$id}{R}) {
 216             if (defined $pagestate{$page}{$id}{R}
 217                 and $pagestate{$page}{$id}{R}->is_started()) {
 218                 $pagestate{$page}{$id}{R}->stop;
 219             }
 220             delete $pagestate{$page}{$id}{R};
 221         }
 222         if (exists $pagestate{$page}{$id}{fignum}) {
 223             delete $pagestate{$page}{$id}{fignum}
 224         }
 225     }
 226 }
 227
 228
 229
 230
 231
 232 1;
 233
 234
 235 __END__
 236
 237
 238
 239
 240
 241
 242
 243