X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=sweavealike.pm;h=0dd0e1b5ed8260650c629908cf66b7c983f61a89;hb=HEAD;hp=939f803dce772ea2ad7165eef871cf064e14e60e;hpb=feb8f93843c202cc6e8109b95418f46ec44e9496;p=ikiwiki_plugins.git

diff --git a/sweavealike.pm b/sweavealike.pm
index 939f803..0dd0e1b 100644
--- a/sweavealike.pm
+++ b/sweavealike.pm
@@ -13,13 +13,66 @@ sweavealike -- A Sweave-alike plugin which allows for embedding R code in IkiWik
 
 =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
 
@@ -30,46 +83,117 @@ use Statistics::R;
 
 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);
     hook(type => "preprocess", id => $id, call => \&preprocess);
-    hook(type => "preprocess", id => $id, call => \&preprocess_scan, scan => 1);
     hook(type => "htmlize", id => $id, call => \&htmlize);
     hook(type => "savestate", id => $id, call => \&savestate);
 }
 
-sub preprocess_scan {
-    my %param = @_;
-    # start the R process here for this page
-    if (not defined $pagestate{$param{page}}{$id}{R}) {
-	$pagestate{$param{page}}{$id}{R} = Statistics::R->new(shared => 1) or error("Unable to create an R process");
-    }
+sub getsetup {
+    return(plugin => {safe => 0,
+		      rebuild => 1,
+		      section => "misc",
+		      link => "http://git.donarmstrong.com/?p=ikiwiki_plugins.git;a=blob;f=sweavealike.pm;hb=HEAD",
+		      description => "sweavealike plugin",
+		     },
+	  );
+}
+
+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");
+	$pagestate{$param{page}}{$id}{R}->start() or
+	    error("Unable to start the R process");
+	chdir($cur_dir);
+    }
     # we currently don't bother to support anything but outputing the
     # entire segment of code and its R output
 
-    if (not exists $param{code} or not defined $param{code}) {
+    if (not exists $param{code}
+	or not defined $param{code}
+	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($@);
+	error("code '$param{code}' produced error '$@'");
+    }
+    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);
     }
-    my $output;
-    if ($param{verbatim}) {
-	$output = $param{code};
+    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 .= $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
@@ -90,12 +214,16 @@ sub savestate {
     # 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};
     }
 }