IkiWiki/Plugin/sparkline.pm

   1 #!/usr/bin/perl
   2 package IkiWiki::Plugin::sparkline;
   3
   4 use warnings;
   5 use strict;
   6 use IkiWiki 3.00;
   7 use IPC::Open2;
   8
   9 my $match_num=qr/[-+]?[0-9]+(?:\.[0-9]+)?/;
  10 my %locmap=(
  11         top => 'TEXT_TOP',
  12         right => 'TEXT_RIGHT',
  13         bottom => 'TEXT_BOTTOM',
  14         left => 'TEXT_LEFT',
  15 );
  16
  17 sub import {
  18         hook(type => "getsetup", id => "sparkline", call => \&getsetup);
  19         hook(type => "preprocess", id => "sparkline", call => \&preprocess);
  20 }
  21
  22 sub getsetup () {
  23         return
  24                 plugin => {
  25                         safe => 1,
  26                         rebuild => undef,
  27                 },
  28 }
  29
  30 sub preprocess (@) {
  31         my %params=@_;
  32
  33         my $php;
  34
  35         my $style=(exists $params{style} && $params{style} eq "bar") ? "Bar" : "Line";
  36         $php=qq{<?php
  37                 require_once('sparkline/Sparkline_$style.php');
  38                 \$sparkline = new Sparkline_$style();
  39                 \$sparkline->SetDebugLevel(DEBUG_NONE);
  40         };
  41
  42         foreach my $param (qw{BarWidth BarSpacing YMin YMaz}) {
  43                 if (exists $params{lc($param)}) {
  44                         $php.=qq{\$sparkline->Set$param(}.int($params{lc($param)}).qq{);\n};
  45                 }
  46         }
  47
  48         my $c=0;
  49         while (@_) {
  50                 my $key=shift;
  51                 my $value=shift;
  52
  53                 if ($key=~/^($match_num)(?:,($match_num))?(?:\(([a-z]+)\))?$/) {
  54                         $c++;
  55                         my ($x, $y);
  56                         if (defined $2) {
  57                                 $x=$1;
  58                                 $y=$2;
  59                         }
  60                         else {
  61                                 $x=$c;
  62                                 $y=$1;
  63                         }
  64                         if ($style eq "Bar" && defined $3) {
  65                                 $php.=qq{\$sparkline->SetData($x, $y, '$3');\n};
  66                         }
  67                         else {
  68                                 $php.=qq{\$sparkline->SetData($x, $y);\n};
  69                         }
  70                 }
  71                 elsif (! length $value) {
  72                         error gettext("parse error")." \"$key\"";
  73                 }
  74                 elsif ($key eq 'featurepoint') {
  75                         my ($x, $y, $color, $diameter, $text, $location)=
  76                                 split(/\s*,\s*/, $value);
  77                         if (! defined $diameter || $diameter < 0) {
  78                                 error gettext("bad featurepoint diameter");
  79                         }
  80                         $x=int($x);
  81                         $y=int($y);
  82                         $color=~s/[^a-z]+//g;
  83                         $diameter=int($diameter);
  84                         $text=~s/[^-a-zA-Z0-9]+//g if defined $text;
  85                         if (defined $location) {
  86                                 $location=$locmap{$location};
  87                                 if (! defined $location) {
  88                                         error gettext("bad featurepoint location");
  89                                 }
  90                         }
  91                         $php.=qq{\$sparkline->SetFeaturePoint($x, $y, '$color', $diameter};
  92                         $php.=qq{, '$text'} if defined $text;
  93                         $php.=qq{, $location} if defined $location;
  94                         $php.=qq{);\n};
  95                 }
  96         }
  97
  98         if ($c eq 0) {
  99                 error gettext("missing values");
 100         }
 101
 102         my $height=int($params{height} || 20);
 103         if ($height < 2 || $height > 100) {
 104                 error gettext("bad height value");
 105         }
 106         if ($style eq "Bar") {
 107                 $php.=qq{\$sparkline->Render($height);\n};
 108         }
 109         else {
 110                 if (! exists $params{width}) {
 111                         error gettext("missing width parameter");
 112                 }
 113                 my $width=int($params{width});
 114                 if ($width < 2 || $width > 1024) {
 115                         error gettext("bad width value");
 116                 }
 117                 $php.=qq{\$sparkline->RenderResampled($width, $height);\n};
 118         }
 119
 120         $php.=qq{\$sparkline->Output();\n?>\n};
 121
 122         # Use the sha1 of the php code that generates the sparkline as
 123         # the base for its filename.
 124         eval q{use Digest::SHA1};
 125         error($@) if $@;
 126         my $fn=$params{page}."/sparkline-".
 127                 IkiWiki::possibly_foolish_untaint(Digest::SHA1::sha1_hex($php)).
 128                 ".png";
 129         will_render($params{page}, $fn);
 130
 131         if (! -e "$config{destdir}/$fn") {
 132                 my $pid;
 133                 my $sigpipe=0;;
 134                 $SIG{PIPE}=sub { $sigpipe=1 };
 135                 $pid=open2(*IN, *OUT, "php");
 136
 137                 # open2 doesn't respect "use open ':utf8'"
 138                 binmode (OUT, ':utf8');
 139
 140                 print OUT $php;
 141                 close OUT;
 142
 143                 my $png;
 144                 {
 145                         local $/=undef;
 146                         $png=<IN>;
 147                 }
 148                 close IN;
 149
 150                 waitpid $pid, 0;
 151                 $SIG{PIPE}="DEFAULT";
 152                 if ($sigpipe) {
 153                         error gettext("failed to run php");
 154                 }
 155
 156                 if (! $params{preview}) {
 157                         writefile($fn, $config{destdir}, $png, 1);
 158                 }
 159                 else {
 160                         # can't write the file, so embed it in a data uri
 161                         eval q{use MIME::Base64};
 162                         error($@) if $@;
 163                         return "<img src=\"data:image/png;base64,".
 164                                 encode_base64($png)."\" />";
 165                 }
 166         }
 167
 168         return '<img src="'.urlto($fn, $params{destpage}).'" alt="graph" />';
 169 }
 170
 171 1