Some refactoring, improve CLI usage

[svg-meme] / meme.fcgi

#!/usr/bin/perl -w

use strict;

use CGI::Fast;

use HTML::Entities;

use File::Basename;

my %sizes; # meme base image sizes
my %acros; # meme base acronyms (BLB => bad-luck-brian.jpg)

# Are we running as CGI or from the command-line?
# TODO better detection
my $is_cgi = $ENV{'SCRIPT_FILENAME'};

my $script_path =  $is_cgi ? dirname($ENV{'SCRIPT_FILENAME'}) : dirname($0);

my $sz_fname = $script_path . '/meme-sizes.lst';

open FILE, $sz_fname or die $!;

while (my $line = <FILE>) {
        chomp($line);
        next unless $line;
        my ($width, $height, $fname) = split(/ /, $line, 3);
        $sizes{$fname} = [$width, $height];

        # Find a potential short form (acronym for multiword, no extension otherwise)
        my $acro = '';

        # remove article for the purpose of the shrotening; we don't care if it's
        # in the middle of a word because we only care about initials anyway
        # FIXME this actually fails in the case of XXXthe-XXX, let's care about that
        # when we actually come across it
        my $the = $fname;
        $the =~ s/the-//g;
        if ($the =~ /-/) {
                $acro = join('', map { uc(substr($_, 0, 1)) } split(/-/, $the ));
        } else {
                $acro = (split(/\./, $the))[0]
        }
        if (!defined $acros{$acro}) {
                $acros{$acro} = $fname;
        } else {
                print STDERR "Trying to redefined acronym $acro from $acros{$acro} to ${fname}\n";
        }
}

my %revacros = reverse %acros;

close FILE;


# params: img, width, height, text

my $svg_template=<<SVG;
<?xml version='1.0' encoding='UTF-8'?>
<svg
 xmlns='http://www.w3.org/2000/svg'
 xmlns:xlink='http://www.w3.org/1999/xlink' version='1.1'
 viewBox='0 0 %2\$d %3\$d'>
<style type="text/css">text{font-family:'Impact';fill:white;stroke:black;stroke-width:2px;text-anchor:middle}</style>
<image xlink:href='%1\$s' x='0' y='0'
width='%2\$d' height='%3\$d'/>
%4\$s</svg>
SVG

sub fill_svg($$$$) {
        return sprintf($svg_template, @_);
}

# params: y-pos, font-size, text

my $txt_template=<<TXT;
<text x='50%%' y='%1\$d%%' font-size='%2\$d'
>%3\$s</text>
TXT

sub fill_txt($$$) {
        return sprintf($txt_template, @_);
}

# routine to actually prepare the SVG.
# params: img, sep, text
sub make_svg($$@) {
        my $img = shift;
        my $sep = shift;
        my @t   = @_;

        unless (defined $img and defined $sizes{$img}) {
                return undef unless defined $img and defined $acros{$img};
                $img = $acros{$img};
        }

        my ($width, $height) = @{$sizes{$img}};

        my $divisions = 7;
        my @lines = ();
        foreach (@t) {
                foreach (split /\Q$sep\E/) {
                        push @lines, $_;
                }
        }

        $divisions = @lines if @lines > $divisions;

        my $fontsize = int($height/$divisions + 0.5);
        if ($fontsize > $width/10) {
                $fontsize = int($width/10 + 0.5) if $fontsize > $width/10;
                $divisions = int($height/$fontsize + 0.5);
        }

        my $offset = int(100/$divisions + 0.5);
        my $fillers = grep { $_ eq '' } @lines;
        my $real_lines = @lines - $fillers;
        my $filler_size = $fillers ? int((98 - $offset*$real_lines)/$fillers) : 0;

        my $dy = 0;
        my $txt = '';
        foreach (@lines) {
                if ($_ eq '') {
                        $dy += $filler_size;
                        next;
                }
                $dy += $offset;
                $txt .= fill_txt($dy, $fontsize, $_);
        }

        return fill_svg($img, $width, $height, $txt);
}

my ($img, $sep, @t); # image, line separator, text lines

while (my $q = new CGI::Fast) {

        if ($is_cgi) {
                $img = $q->param('m');
                $sep = $q->param('s');
                @t = $q->param('t');
        } else {
                ($img, $sep, @t) = @ARGV;
        }

        $img ||= (keys %sizes)[0];
        $sep ||= '/';
        @t = ('TOP TEST//BOTTOM TEST') unless @t;

        my $svg = make_svg($img, $sep, @t);

        if (defined $svg) {
                print $q->header(
                        -type => 'image/svg+xml',
                        -charset => 'UTF-8'
                ) if $is_cgi;

                print $svg;

                next if $is_cgi;
                exit 0;
        }

        # missing meme
        if ($is_cgi) {
                print $q->header(-status=>404),
                $q->start_html("Unknown meme base"),
                $q->h1("Unknown meme base!");
                print   "<p>Sorry, <tt>'" . encode_entities($img) . "'</tt> is not a known meme base. ".
                "You want one of the following instead:</p><ul>";
                my %revacros = reverse %acros;
                foreach (keys %sizes) {
                        print "<li><tt>" . encode_entities($_) . "</tt>";
                        print " (<tt>" . encode_entities($revacros{$_}) . "</tt>)" if defined $revacros{$_};
                        print "</tt></li>";
                }
                print "</ul>";
                # foreach (keys %ENV) {
                #       print "<p>$_=$ENV{$_}</p>"
                # }
                print $q->end_html();
                next;
        } else {
                foreach (keys %sizes) {
                        print STDERR "* $_";
                        print STDERR " ($revacros{$_})" if defined $revacros{$_};
                        print STDERR "\n";
                }
                exit -1;
        }
}