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         $pagestate{$param{page}}{$id}{R}->start() or
 123             error("Unable to start the R process");
 124         chdir($cur_dir);
 125     }
 126     # we currently don't bother to support anything but outputing the
 127     # entire segment of code and its R output
 128
 129     if (not exists $param{code}
 130         or not defined $param{code}
 131         or not length $param{code}) {
 132         error("There wasn't any R code supplied");
 133     }
 134
 135     my $image_loc = '';
 136     if (exists $param{fig}) {
 137         $param{width} = '400' unless exists $param{width} and defined $param{width};
 138         $param{height} = '400' unless exists $param{height} and defined $param{height};
 139         for (qw(width height)) {
 140             if ($param{$_} !~ /^\d+$/) {
 141                 error("invalid $_; must be an integer: $param{$_}");
 142             }
 143         }
 144         # because even if the code is duplicated, the figure could
 145         # still be different, we track the number of figures
 146         $pagestate{$param{page}}{$id}{fignum}++;
 147         my $md5 = code_md5($param{code},$param{width},$param{height},$pagestate{$param{page}}{$id}{fignum});
 148         $image_loc = "$param{page}/${md5}.png";
 149         my $image_loc_esc = $image_loc;
 150         $image_loc_esc =~ s/"/\\"/g;
 151         will_render($param{page},$image_loc);
 152         # this makes sure that we can write to the file result
 153         writefile($image_loc, $config{destdir}, "");
 154         eval {
 155             $pagestate{$param{page}}{$id}{R}->run(qq|png(filename="$config{destdir}/$image_loc_esc",width=$param{width},height=$param{height});|);
 156         };
 157         if ($@) {
 158             error(qq|code 'png(filename="$config{destdir}/$image_loc_esc",width=$param{width},height=$param{height});' (from internal figure handling) produced error '$@'|);
 159         }
 160     }
 161     my $code_result;
 162     eval {
 163         $code_result = $pagestate{$param{page}}{$id}{R}->run($param{code});
 164     };
 165     if ($@) {
 166         error("code '$param{code}' produced error '$@'");
 167     }
 168     my $output = '';
 169     my $fig_output = '';
 170     if (exists $param{fig}) {
 171         eval {
 172             $pagestate{$param{page}}{$id}{R}->run(qq{dev.off();});
 173         };
 174         if ($@) {
 175             error("code 'dev.off()' (from internal figure handling) produced error '$@'");
 176         }
 177         $fig_output = qq(\n\n<img class="sweavealike" src=").urlto($image_loc,$param{destpage}).qq(" />\n);
 178     }
 179     if (exists $param{nooutput}) {
 180         return($output.$fig_output);
 181     }
 182     if (exists $param{echo}) {
 183         $output .= $param{code};
 184         $output =~ s/^/> /mg;
 185         $output .= "\n";
 186     }
 187     if (not exists $param{results} or
 188         (defined $param{results} and
 189          $param{results} !~ /^(hide|false)$/i)) {
 190         $output .= $code_result;
 191     }
 192     if (exists $param{echo} or
 193         exists $param{results}) {
 194         $output =~ s/^/    /mg;
 195     }
 196     return($output.$fig_output);
 197 }
 198
 199 # stop any started R processes here
 200 sub htmlize {
 201     my %param = @_;
 202     if (exists $pagestate{$param{page}} and
 203         exists $pagestate{$param{page}}{$id} and
 204         exists $pagestate{$param{page}}{$id}{R}) {
 205         if (defined $pagestate{$param{page}}{$id}{R}
 206             and $pagestate{$param{page}}{$id}{R}->is_started()) {
 207             $pagestate{$param{page}}{$id}{R}->stop();
 208         }
 209         delete $pagestate{$param{page}}{$id}{R};
 210     }
 211 }
 212
 213 sub savestate {
 214     # make sure we never try to save an R process
 215     for my $page (keys %pagestate) {
 216         next unless exists $pagestate{$page}{$id};
 217         if (exists $pagestate{$page}{$id}{R}) {
 218             if (defined $pagestate{$page}{$id}{R}
 219                 and $pagestate{$page}{$id}{R}->is_started()) {
 220                 $pagestate{$page}{$id}{R}->stop;
 221             }
 222             delete $pagestate{$page}{$id}{R};
 223         }
 224         if (exists $pagestate{$page}{$id}{fignum}) {
 225             delete $pagestate{$page}{$id}{fignum}
 226         }
 227     }
 228 }
 229
 230
 231
 232
 233
 234 1;
 235
 236
 237 __END__
 238
 239
 240
 241
 242
 243
 244
 245