=head1 SYNOPSIS
+sweavealike allows you to embed R code in IkiWiki.
+
+
+[[!sweavealike code='''
+a <- 1
+a <- a*a+10
+print(a)
+''']]
+
=head1 DESCRIPTION
+=head2 Available options
+
+=over
+
+=item code
+
+R code to execute. Required to be present. [If you didn't want to
+execute R code, why would you use this directive?]
+
+=item echo
+
+Echo the R code. [Basically, this escapes the code with >, and then
+adds spaces so that the output is interpreted as a code fragment.]
+
+=item nooutput
+
+Suppress all non-figure output
+
+=item results
+
+Defaults to show the results (what R wrote to stdout) of a particular
+piece of code
+
+=item fig
+
+If present, code is assumed to produce a figure which is automatically
+included inline
+
+=item width
+
+Integer width of included figure; defaults to 400
+
+=item height
+
+Integer height of included figure; defaults to 400
+
+=back
+
=head1 BUGS
-None known.
+R is a complete language, and no attempt is made to control what you
+can do. Reading and writing arbitrary files, as well as exhausting
+available memory and CPU are all trivially possible. Thus, you should
+NEVER use this plugin on a publicly editable IkiWiki instance.
+
+You should be able to refer to previously created figures without
+rerunning the code.
=cut
use IkiWiki '3.00';
+use Encode qw(decode);
+use Digest::MD5 qw(md5_hex);
+use Cwd;
+
my $id = "sweavealike";
sub import {
hook(type => "getsetup", id => $id, call => \&getsetup);
}
sub getsetup {
- return(plugin => {safe => 1,
+ return(plugin => {safe => 0,
rebuild => 1,
section => "misc",
link => "http://git.donarmstrong.com/?p=ikiwiki_plugins.git;a=blob;f=sweavealike.pm;hb=HEAD",
);
}
+sub code_md5 {
+ return(md5_hex(map {decode('utf8',$_)} @_));
+}
+
sub preprocess {
my %param = @_;
if (not defined $pagestate{$param{page}}{$id}{R}) {
+ # I've decided to put R into the src directory instead of the
+ # dest directory
+ my $cur_dir = getcwd;
+ chdir($config{srcdir});
$pagestate{$param{page}}{$id}{R} = Statistics::R->new(shared => 1)
or error("Unable to create an R process");
+ chdir($cur_dir);
}
# we currently don't bother to support anything but outputing the
# entire segment of code and its R output
or not length $param{code}) {
error("There wasn't any R code supplied");
}
+
+ my $image_loc = '';
+ if (exists $param{fig}) {
+ $param{width} = '400' unless exists $param{width} and defined $param{width};
+ $param{height} = '400' unless exists $param{height} and defined $param{height};
+ for (qw(width height)) {
+ if ($param{$_} !~ /^\d+$/) {
+ error("invalid $_; must be an integer: $param{$_}");
+ }
+ }
+ # because even if the code is duplicated, the figure could
+ # still be different, we track the number of figures
+ $pagestate{$param{page}}{$id}{fignum}++;
+ my $md5 = code_md5($param{code},$param{width},$param{height},$pagestate{$param{page}}{$id}{fignum});
+ $image_loc = "$param{page}/${md5}.png";
+ my $image_loc_esc = $image_loc;
+ $image_loc_esc =~ s/"/\\"/g;
+ will_render($param{page},$image_loc);
+ # this makes sure that we can write to the file result
+ writefile($image_loc, $config{destdir}, "");
+ eval {
+ $pagestate{$param{page}}{$id}{R}->run(qq|png(filename="$config{destdir}/$image_loc_esc",width=$param{width},height=$param{height});|);
+ };
+ if ($@) {
+ error(qq|code 'png(filename="$config{destdir}/$image_loc_esc",width=$param{width},height=$param{height});' (from internal figure handling) produced error '$@'|);
+ }
+ }
my $code_result;
eval {
$code_result = $pagestate{$param{page}}{$id}{R}->run($param{code});
if ($@) {
error("code '$param{code}' produced error '$@'");
}
- my $output;
- if (exists $param{verbatim}) {
- $output = $param{code};
+ my $output = '';
+ my $fig_output = '';
+ if (exists $param{fig}) {
+ eval {
+ $pagestate{$param{page}}{$id}{R}->run(qq{dev.off();});
+ };
+ if ($@) {
+ error("code 'dev.off()' (from internal figure handling) produced error '$@'");
+ }
+ $fig_output = qq(\n\n<img class="sweavealike" src=").urlto($image_loc,$param{destpage}).qq(" />\n);
+ }
+ if (exists $param{nooutput}) {
+ return($output.$fig_output);
+ }
+ if (exists $param{echo}) {
+ $output .= $param{code};
$output =~ s/^/> /mg;
+ $output .= "\n";
+ }
+ if (not exists $param{results} or
+ (defined $param{results} and
+ $param{results} !~ /^(hide|false)$/i)) {
+ $output .= $code_result;
}
- $output .= "\n".$code_result;
- $output =~ s/^/ /mg;
- return($output);
+ if (exists $param{echo} or
+ exists $param{results}) {
+ $output =~ s/^/ /mg;
+ }
+ return($output.$fig_output);
}
# stop any started R processes here
# make sure we never try to save an R process
for my $page (keys %pagestate) {
next unless exists $pagestate{$page}{$id};
- next unless exists $pagestate{$page}{$id}{R};
- if (defined $pagestate{$page}{$id}{R}
- and $pagestate{$page}{$id}{R}->is_started()) {
- $pagestate{$page}{$id}{R}->stop;
+ if (exists $pagestate{$page}{$id}{R}) {
+ if (defined $pagestate{$page}{$id}{R}
+ and $pagestate{$page}{$id}{R}->is_started()) {
+ $pagestate{$page}{$id}{R}->stop;
+ }
+ delete $pagestate{$page}{$id}{R};
+ }
+ if (exists $pagestate{$page}{$id}{fignum}) {
+ delete $pagestate{$page}{$id}{fignum}
}
- delete $pagestate{$page}{$id}{R};
}
}