sweavealike.pm

   1 #!/usr/bin/perl
   2 # Ikiwiki Sweave-alike plugin
   3 # under the terms of the GPL version 2, or any later version at your
   4 # option.
   5 # Copyright 2012 by Don Armstrong <don@donarmstrong.com>.
   6
   7
   8 package IkiWiki::Plugin::sweavealike;
   9
  10 =head1 NAME
  11
  12 sweavealike -- A Sweave-alike plugin which allows for embedding R code in IkiWiki
  13
  14 =head1 SYNOPSIS
  15
  16
  17 =head1 DESCRIPTION
  18
  19
  20 =head1 BUGS
  21
  22 None known.
  23
  24 =cut
  25
  26 use warnings;
  27 use strict;
  28
  29 use Statistics::R;
  30
  31 use IkiWiki '3.00';
  32
  33 my $id = "sweavealike";
  34 sub import {
  35     hook(type => "getsetup", id => $id, call => \&getsetup);
  36     hook(type => "preprocess", id => $id, call => \&preprocess);
  37     hook(type => "htmlize", id => $id, call => \&htmlize);
  38     hook(type => "savestate", id => $id, call => \&savestate);
  39 }
  40
  41 sub getsetup {
  42     return(plugin => {safe => 1,
  43                       rebuild => 1,
  44                       section => "misc",
  45                       link => "http://git.donarmstrong.com/?p=ikiwiki_plugins.git;a=blob;f=sweavealike.pm;hb=HEAD",
  46                       description => "sweavealike plugin",
  47                      },
  48           );
  49 }
  50
  51 sub preprocess {
  52     my %param = @_;
  53
  54     if (not defined $pagestate{$param{page}}{$id}{R}) {
  55         $pagestate{$param{page}}{$id}{R} = Statistics::R->new(shared => 1)
  56             or error("Unable to create an R process");
  57     }
  58     # we currently don't bother to support anything but outputing the
  59     # entire segment of code and its R output
  60
  61     if (not exists $param{code}
  62         or not defined $param{code}
  63         or not length $param{code}) {
  64         error("There wasn't any R code supplied");
  65     }
  66     my $code_result;
  67     eval {
  68         $code_result = $pagestate{$param{page}}{$id}{R}->run($param{code});
  69     };
  70     if ($@) {
  71         error("code '$param{code}' produced error '$@'");
  72     }
  73     my $output = "sweave output\n\n";
  74     if (exists $param{verbatim}) {
  75         $output = $param{code};
  76         $output =~ s/^/> /mg;
  77     }
  78     $output .= $code_result;
  79     $output =~ s/^/    /mg;
  80     return($output);
  81 }
  82
  83 # stop any started R processes here
  84 sub htmlize {
  85     my %param = @_;
  86     if (exists $pagestate{$param{page}} and
  87         exists $pagestate{$param{page}}{$id} and
  88         exists $pagestate{$param{page}}{$id}{R}) {
  89         if (defined $pagestate{$param{page}}{$id}{R}
  90             and $pagestate{$param{page}}{$id}{R}->is_started()) {
  91             $pagestate{$param{page}}{$id}{R}->stop();
  92         }
  93         delete $pagestate{$param{page}}{$id}{R};
  94     }
  95 }
  96
  97 sub savestate {
  98     # make sure we never try to save an R process
  99     for my $page (keys %pagestate) {
 100         next unless exists $pagestate{$page}{$id};
 101         next unless exists $pagestate{$page}{$id}{R};
 102         if (defined $pagestate{$page}{$id}{R}
 103             and $pagestate{$page}{$id}{R}->is_started()) {
 104             $pagestate{$page}{$id}{R}->stop;
 105         }
 106         delete $pagestate{$page}{$id}{R};
 107     }
 108 }
 109
 110
 111
 112
 113
 114 1;
 115
 116
 117 __END__
 118
 119
 120
 121
 122
 123
 124
 125