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
33 use Encode qw(decode);
34 use Digest::MD5 qw(md5_hex);
36 my $id = "sweavealike";
38 hook(type => "getsetup", id => $id, call => \&getsetup);
39 hook(type => "preprocess", id => $id, call => \&preprocess);
40 hook(type => "htmlize", id => $id, call => \&htmlize);
41 hook(type => "savestate", id => $id, call => \&savestate);
45 return(plugin => {safe => 1,
48 link => "http://git.donarmstrong.com/?p=ikiwiki_plugins.git;a=blob;f=sweavealike.pm;hb=HEAD",
49 description => "sweavealike plugin",
56 return(md5_hex(decode('utf8',$code)));
62 if (not defined $pagestate{$param{page}}{$id}{R}) {
63 $pagestate{$param{page}}{$id}{R} = Statistics::R->new(shared => 1)
64 or error("Unable to create an R process");
66 # we currently don't bother to support anything but outputing the
67 # entire segment of code and its R output
69 if (not exists $param{code}
70 or not defined $param{code}
71 or not length $param{code}) {
72 error("There wasn't any R code supplied");
75 $param{width} = '400' unless exists $param{width} and defined $param{width};
76 $param{height} = '400' unless exists $param{height} and defined $param{height};
77 for (qw(width height)) {
78 if ($param{$_} !~ /^\d+$/) {
79 error("invalid $_; must be an integer: $param{$_}");
82 if (exists $param{picture}) {
83 my $md5 = code_md5($param{code}."width=$param{width}height=$param{height}");
84 my $page_esc = $params->{page};
85 $page_esc =~ s/"/\\"/g;
86 $pagestate{$param{page}}{$id}{R}->run(qq{png(filename="$page_esc",width=$param{width},height=$param{height});});
90 $code_result = $pagestate{$param{page}}{$id}{R}->run($param{code});
93 error("code '$param{code}' produced error '$@'");
95 if (exists $param{picture}) {
96 $pagestate{$param{page}}{$id}{R}->run(qq{dev.off();});
98 if (exists $param{nooutput}) {
102 if (exists $param{echo}) {
103 $output .= $param{code};
104 $output =~ s/^/> /mg;
107 if (exists $param{results}) {
108 $output .= $code_result;
110 if (exists $param{echo} or
111 exists $param{results}) {
117 # stop any started R processes here
120 if (exists $pagestate{$param{page}} and
121 exists $pagestate{$param{page}}{$id} and
122 exists $pagestate{$param{page}}{$id}{R}) {
123 if (defined $pagestate{$param{page}}{$id}{R}
124 and $pagestate{$param{page}}{$id}{R}->is_started()) {
125 $pagestate{$param{page}}{$id}{R}->stop();
127 delete $pagestate{$param{page}}{$id}{R};
132 # make sure we never try to save an R process
133 for my $page (keys %pagestate) {
134 next unless exists $pagestate{$page}{$id};
135 next unless exists $pagestate{$page}{$id}{R};
136 if (defined $pagestate{$page}{$id}{R}
137 and $pagestate{$page}{$id}{R}->is_started()) {
138 $pagestate{$page}{$id}{R}->stop;
140 delete $pagestate{$page}{$id}{R};