2 # Ikiwiki Sweave-alike plugin
3 # under the terms of the GPL version 2, or any later version at your
5 # Copyright 2012 by Don Armstrong <don@donarmstrong.com>.
8 package IkiWiki::Plugin::sweavealike;
12 sweavealike -- A Sweave-alike plugin which allows for embedding R code in IkiWiki
16 sweavealike allows you to embed R code in IkiWiki.
19 [[!sweavealike code='''
28 =head2 Available options
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?]
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.]
44 Suppress all non-figure output
48 Defaults to show the results (what R wrote to stdout) of a particular
53 If present, code is assumed to produce a figure which is automatically
58 Integer width of included figure; defaults to 400
62 Integer height of included figure; defaults to 400
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.
74 You should be able to refer to previously created figures without
86 use Encode qw(decode);
87 use Digest::MD5 qw(md5_hex);
89 my $id = "sweavealike";
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);
98 return(plugin => {safe => 0,
101 link => "http://git.donarmstrong.com/?p=ikiwiki_plugins.git;a=blob;f=sweavealike.pm;hb=HEAD",
102 description => "sweavealike plugin",
108 return(md5_hex(map {decode('utf8',$_)} @_));
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");
118 # we currently don't bother to support anything but outputing the
119 # entire segment of code and its R output
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");
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{$_}");
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);
145 $pagestate{$param{page}}{$id}{R}->run(qq|png(filename="$image_loc_esc",width=$param{width},height=$param{height});|);
148 error(qq|code 'png(filename="$image_loc_esc",width=$param{width},height=$param{height});' (from internal figure handling) produced error '$@'|);
153 $code_result = $pagestate{$param{page}}{$id}{R}->run($param{code});
156 error("code '$param{code}' produced error '$@'");
160 if (exists $param{fig}) {
162 $pagestate{$param{page}}{$id}{R}->run(qq{dev.off();});
165 error("code 'dev.off()' (from internal figure handling) produced error '$@'");
167 $fig_output = qq(\n<img class="sweavealike" src=").urlto($image_loc,$param{destpage}).qq(" />);
169 if (exists $param{nooutput}) {
170 return($output.$fig_output);
172 if (exists $param{echo}) {
173 $output .= $param{code};
174 $output =~ s/^/> /mg;
177 if (not exists $param{results} or
178 (defined $param{results} and
179 $param{results} !~ /^(hide|false)$/i)) {
180 $output .= $code_result;
182 if (exists $param{echo} or
183 exists $param{results}) {
189 # stop any started R processes here
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();
199 delete $pagestate{$param{page}}{$id}{R};
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;
212 delete $pagestate{$page}{$id}{R};
214 if (exists $pagestate{$page}{$id}{fignum}) {
215 delete $pagestate{$page}{$id}{fignum}