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);
90 my $id = "sweavealike";
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);
99 return(plugin => {safe => 0,
102 link => "http://git.donarmstrong.com/?p=ikiwiki_plugins.git;a=blob;f=sweavealike.pm;hb=HEAD",
103 description => "sweavealike plugin",
109 return(md5_hex(map {decode('utf8',$_)} @_));
115 if (not defined $pagestate{$param{page}}{$id}{R}) {
116 # I've decided to put R into the src directory instead of the
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");
126 # we currently don't bother to support anything but outputing the
127 # entire segment of code and its R output
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");
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{$_}");
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}, "");
155 $pagestate{$param{page}}{$id}{R}->run(qq|png(filename="$config{destdir}/$image_loc_esc",width=$param{width},height=$param{height});|);
158 error(qq|code 'png(filename="$config{destdir}/$image_loc_esc",width=$param{width},height=$param{height});' (from internal figure handling) produced error '$@'|);
163 $code_result = $pagestate{$param{page}}{$id}{R}->run($param{code});
166 error("code '$param{code}' produced error '$@'");
170 if (exists $param{fig}) {
172 $pagestate{$param{page}}{$id}{R}->run(qq{dev.off();});
175 error("code 'dev.off()' (from internal figure handling) produced error '$@'");
177 $fig_output = qq(\n\n<img class="sweavealike" src=").urlto($image_loc,$param{destpage}).qq(" />\n);
179 if (exists $param{nooutput}) {
180 return($output.$fig_output);
182 if (exists $param{echo}) {
183 $output .= $param{code};
184 $output =~ s/^/> /mg;
187 if (not exists $param{results} or
188 (defined $param{results} and
189 $param{results} !~ /^(hide|false)$/i)) {
190 $output .= $code_result;
192 if (exists $param{echo} or
193 exists $param{results}) {
196 return($output.$fig_output);
199 # stop any started R processes here
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();
209 delete $pagestate{$param{page}}{$id}{R};
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;
222 delete $pagestate{$page}{$id}{R};
224 if (exists $pagestate{$page}{$id}{fignum}) {
225 delete $pagestate{$page}{$id}{fignum}