git.oblomov.eu Git - svg-meme/blob - meme.fcgi

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4
   5 use CGI::Fast;
   6
   7 use HTML::Entities;
   8
   9 use File::Basename;
  10
  11 my %sizes;
  12
  13 my $script_path = $ENV{'SCRIPT_FILENAME'} ? dirname($ENV{'SCRIPT_FILENAME'}) : dirname($0);
  14
  15 my $sz_fname = $script_path . '/meme-sizes.lst';
  16
  17 open FILE, $sz_fname or die $!;
  18
  19 while (my $line = <FILE>) {
  20         chomp($line);
  21         next unless $line;
  22         my ($width, $height, $fname) = split(/ /, $line, 3);
  23         $sizes{$fname} = [$width, $height];
  24 }
  25
  26 close FILE;
  27
  28
  29 # params: img, width, height, text
  30
  31 my $svg_template=<<SVG;
  32 <?xml version='1.0' encoding='UTF-8'?>
  33 <svg
  34  xmlns='http://www.w3.org/2000/svg'
  35  xmlns:xlink='http://www.w3.org/1999/xlink' version='1.1'
  36  viewBox='0 0 %2\$d %3\$d'>
  37 <style type="text/css">text{font-family:'Impact';fill:white;stroke:black;stroke-width:2px;text-anchor:middle}</style>
  38 <image xlink:href='%1\$s' x='0' y='0'
  39 width='%2\$d' height='%3\$d'/>
  40 %4\$s</svg>
  41 SVG
  42
  43 # template: y-pos, font-size, text
  44 my $txt_template=<<TXT;
  45 <text x='50%%' y='%1\$d%%' font-size='%2\$d'
  46 >%3\$s</text>
  47 TXT
  48
  49 while (my $q = new CGI::Fast) {
  50         my $img = $q->param('m') || (keys %sizes)[0];
  51         if (!defined $sizes{$img}) {
  52                 print $q->header(-status=>404),
  53                 $q->start_html("Unknown meme base"),
  54                 $q->h1("Unknown meme base!");
  55                 print   "<p>Sorry, <tt>'" . encode_entities($img) . "'</tt> is not a known meme base. ".
  56                         "You want one of the following instead:</p><ul>";
  57                 foreach (keys %sizes) {
  58                         print "<li><tt>" . encode_entities($_) . "</tt></li>";
  59                 }
  60                 print "</ul>";
  61                 # foreach (keys %ENV) {
  62                 #       print "<p>$_=$ENV{$_}</p>"
  63                 # }
  64                 print $q->end_html();
  65                 next;
  66         }
  67
  68         print $q->header(
  69                 -type => 'image/svg+xml',
  70                 -charset => 'UTF-8'
  71         );
  72
  73         my ($width, $height) = @{$sizes{$img}};
  74
  75         my $sep = $q->param('s') || '/'; # line separator
  76
  77         my @t = $q->param('t') || ('TEST TOP//TEST BOTTOM');
  78
  79         my $divisions = 7;
  80         my @lines = ();
  81         foreach (@t) {
  82                 foreach (split /\Q$sep\E/) {
  83                         push @lines, $_;
  84                 }
  85         }
  86
  87         $divisions = @lines if @lines > $divisions;
  88
  89         my $fontsize = int($height/$divisions + 0.5);
  90         my $offset = int(100/$divisions + 0.5);
  91         my $fillers = grep { $_ eq '' } @lines;
  92         my $real_lines = @lines - $fillers;
  93         my $filler_size = $fillers ? int((98 - $offset*$real_lines)/$fillers) : 0;
  94
  95         my $dy = 0;
  96         my $txt = '';
  97         foreach (@lines) {
  98                 if ($_ eq '') {
  99                         $dy += $filler_size;
 100                         next;
 101                 }
 102                 $dy += $offset;
 103                 $txt .= sprintf($txt_template, $dy, $fontsize, $_);
 104         }
 105
 106         printf($svg_template, $img, $width, $height, $txt);
 107 }