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
  89 my $id = "sweavealike";
  90 sub import {
  91     hook(type => "getsetup", id => $id, call => \&getsetup);
  92     hook(type => "preprocess", id => $id, call => \&preprocess);
  93     hook(type => "htmlize", id => $id, call => \&htmlize);
  94     hook(type => "savestate", id => $id, call => \&savestate);
  95 }
  96
  97 sub getsetup {
  98     return(plugin => {safe => 0,
  99                       rebuild => 1,
 100                       section => "misc",
 101                       link => "http://git.donarmstrong.com/?p=ikiwiki_plugins.git;a=blob;f=sweavealike.pm;hb=HEAD",
 102                       description => "sweavealike plugin",
 103                      },
 104           );
 105 }
 106
 107 sub code_md5 {
 108     return(md5_hex(map {decode('utf8',$_)} @_));
 109 }
 110
 111 sub preprocess {
 112     my %param = @_;
 113
 114     if (not defined $pagestate{$param{page}}{$id}{R}) {
 115         $pagestate{$param{page}}{$id}{R} = Statistics::R->new(shared => 1)
 116             or error("Unable to create an R process");
 117     }
 118     # we currently don't bother to support anything but outputing the
 119     # entire segment of code and its R output
 120
 121     if (not exists $param{code}
 122         or not defined $param{code}
 123         or not length $param{code}) {
 124         error("There wasn't any R code supplied");
 125     }
 126
 127     my $image_loc = '';
 128     if (exists $param{fig}) {
 129         $param{width} = '400' unless exists $param{width} and defined $param{width};
 130         $param{height} = '400' unless exists $param{height} and defined $param{height};
 131         for (qw(width height)) {
 132             if ($param{$_} !~ /^\d+$/) {
 133                 error("invalid $_; must be an integer: $param{$_}");
 134             }
 135         }
 136         # because even if the code is duplicated, the figure could
 137         # still be different, we track the number of figures
 138         $pagestate{$param{page}}{$id}{fignum}++;
 139         my $md5 = code_md5($param{code},$param{width},$param{height},$pagestate{$param{page}}{$id}{fignum});
 140         $image_loc = "$param{page}/${md5}.png";
 141         my $image_loc_esc = $image_loc;
 142         $image_loc_esc =~ s/"/\\"/g;
 143         will_render($param{page},$image_loc);
 144         eval {
 145             $pagestate{$param{page}}{$id}{R}->run(qq|png(filename="$image_loc_esc",width=$param{width},height=$param{height});|);
 146         };
 147         if ($@) {
 148             error(qq|code 'png(filename="$image_loc_esc",width=$param{width},height=$param{height});' (from internal figure handling) produced error '$@'|);
 149         }
 150     }
 151     my $code_result;
 152     eval {
 153         $code_result = $pagestate{$param{page}}{$id}{R}->run($param{code});
 154     };
 155     if ($@) {
 156         error("code '$param{code}' produced error '$@'");
 157     }
 158     my $output = '';
 159     my $fig_output = '';
 160     if (exists $param{fig}) {
 161         eval {
 162             $pagestate{$param{page}}{$id}{R}->run(qq{dev.off();});
 163         };
 164         if ($@) {
 165             error("code 'dev.off()' (from internal figure handling) produced error '$@'");
 166         }
 167         $fig_output = qq(\n<img class="sweavealike" src=").urlto($image_loc,$param{destpage}).qq(" />);
 168     }
 169     if (exists $param{nooutput}) {
 170         return($output.$fig_output);
 171     }
 172     if (exists $param{echo}) {
 173         $output .= $param{code};
 174         $output =~ s/^/> /mg;
 175         $output .= "\n";
 176     }
 177     if (not exists $param{results} or
 178         (defined $param{results} and
 179          $param{results} !~ /^(hide|false)$/i)) {
 180         $output .= $code_result;
 181     }
 182     if (exists $param{echo} or
 183         exists $param{results}) {
 184         $output =~ s/^/    /mg;
 185     }
 186     return($output);
 187 }
 188
 189 # stop any started R processes here
 190 sub htmlize {
 191     my %param = @_;
 192     if (exists $pagestate{$param{page}} and
 193         exists $pagestate{$param{page}}{$id} and
 194         exists $pagestate{$param{page}}{$id}{R}) {
 195         if (defined $pagestate{$param{page}}{$id}{R}
 196             and $pagestate{$param{page}}{$id}{R}->is_started()) {
 197             $pagestate{$param{page}}{$id}{R}->stop();
 198         }
 199         delete $pagestate{$param{page}}{$id}{R};
 200     }
 201 }
 202
 203 sub savestate {
 204     # make sure we never try to save an R process
 205     for my $page (keys %pagestate) {
 206         next unless exists $pagestate{$page}{$id};
 207         if (exists $pagestate{$page}{$id}{R}) {
 208             if (defined $pagestate{$page}{$id}{R}
 209                 and $pagestate{$page}{$id}{R}->is_started()) {
 210                 $pagestate{$page}{$id}{R}->stop;
 211             }
 212             delete $pagestate{$page}{$id}{R};
 213         }
 214         if (exists $pagestate{$page}{$id}{fignum}) {
 215             delete $pagestate{$page}{$id}{fignum}
 216         }
 217     }
 218 }
 219
 220
 221
 222
 223
 224 1;
 225
 226
 227 __END__
 228
 229
 230
 231
 232
 233
 234
 235