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; # meme base image sizes
  12 my %acros; # meme base acronyms (BLB => bad-luck-brian.jpg)
  13
  14 my $script_path = $ENV{'SCRIPT_FILENAME'} ? dirname($ENV{'SCRIPT_FILENAME'}) : dirname($0);
  15
  16 my $sz_fname = $script_path . '/meme-sizes.lst';
  17
  18 open FILE, $sz_fname or die $!;
  19
  20 while (my $line = <FILE>) {
  21         chomp($line);
  22         next unless $line;
  23         my ($width, $height, $fname) = split(/ /, $line, 3);
  24         $sizes{$fname} = [$width, $height];
  25
  26         # Find a potential short form (acronym for multiword, no extension otherwise)
  27         my $acro = '';
  28
  29         # remove article for the purpose of the shrotening; we don't care if it's
  30         # in the middle of a word because we only care about initials anyway
  31         # FIXME this actually fails in the case of XXXthe-XXX, let's care about that
  32         # when we actually come across it
  33         my $the = $fname;
  34         $the =~ s/the-//g;
  35         if ($the =~ /-/) {
  36                 $acro = join('', map { uc(substr($_, 0, 1)) } split(/-/, $the ));
  37         } else {
  38                 $acro = (split(/\./, $the))[0]
  39         }
  40         if (!defined $acros{$acro}) {
  41                 $acros{$acro} = $fname;
  42         } else {
  43                 print STDERR "Trying to redefined acronym $acro from $acros{$acro} to ${fname}\n";
  44         }
  45 }
  46
  47 close FILE;
  48
  49
  50 # params: img, width, height, text
  51
  52 my $svg_template=<<SVG;
  53 <?xml version='1.0' encoding='UTF-8'?>
  54 <svg
  55  xmlns='http://www.w3.org/2000/svg'
  56  xmlns:xlink='http://www.w3.org/1999/xlink' version='1.1'
  57  viewBox='0 0 %2\$d %3\$d'>
  58 <style type="text/css">text{font-family:'Impact';fill:white;stroke:black;stroke-width:2px;text-anchor:middle}</style>
  59 <image xlink:href='%1\$s' x='0' y='0'
  60 width='%2\$d' height='%3\$d'/>
  61 %4\$s</svg>
  62 SVG
  63
  64 # template: y-pos, font-size, text
  65 my $txt_template=<<TXT;
  66 <text x='50%%' y='%1\$d%%' font-size='%2\$d'
  67 >%3\$s</text>
  68 TXT
  69
  70 while (my $q = new CGI::Fast) {
  71         my $img = $q->param('m') || (keys %sizes)[0];
  72         if (!defined $sizes{$img}) {
  73                 if (!defined $acros{$img}) {
  74                         print $q->header(-status=>404),
  75                         $q->start_html("Unknown meme base"),
  76                         $q->h1("Unknown meme base!");
  77                         print   "<p>Sorry, <tt>'" . encode_entities($img) . "'</tt> is not a known meme base. ".
  78                         "You want one of the following instead:</p><ul>";
  79                         my %revacros = reverse %acros;
  80                         foreach (keys %sizes) {
  81                                 print "<li><tt>" . encode_entities($_) . "</tt>";
  82                                 print " (<tt>" . encode_entities($revacros{$_}) . "</tt>)" if defined $revacros{$_};
  83                                 print "</tt></li>";
  84                         }
  85                         print "</ul>";
  86                         # foreach (keys %ENV) {
  87                         #       print "<p>$_=$ENV{$_}</p>"
  88                         # }
  89                         print $q->end_html();
  90                         next;
  91                 } else {
  92                         $img = $acros{$img};
  93                 }
  94         }
  95
  96         print $q->header(
  97                 -type => 'image/svg+xml',
  98                 -charset => 'UTF-8'
  99         );
 100
 101         my ($width, $height) = @{$sizes{$img}};
 102
 103         my $sep = $q->param('s') || '/'; # line separator
 104
 105         my @t = $q->param('t') || ('TEST TOP//TEST BOTTOM');
 106
 107         my $divisions = 7;
 108         my @lines = ();
 109         foreach (@t) {
 110                 foreach (split /\Q$sep\E/) {
 111                         push @lines, $_;
 112                 }
 113         }
 114
 115         $divisions = @lines if @lines > $divisions;
 116
 117         my $fontsize = int($height/$divisions + 0.5);
 118         my $offset = int(100/$divisions + 0.5);
 119         my $fillers = grep { $_ eq '' } @lines;
 120         my $real_lines = @lines - $fillers;
 121         my $filler_size = $fillers ? int((98 - $offset*$real_lines)/$fillers) : 0;
 122
 123         my $dy = 0;
 124         my $txt = '';
 125         foreach (@lines) {
 126                 if ($_ eq '') {
 127                         $dy += $filler_size;
 128                         next;
 129                 }
 130                 $dy += $offset;
 131                 $txt .= sprintf($txt_template, $dy, $fontsize, $_);
 132         }
 133
 134         printf($svg_template, $img, $width, $height, $txt);
 135 }