#!/usr/bin/perl
#
# https://toroid.org/nice-photo-urls
# Copyright 2009 Abhijit Menon-Sen <ams@toroid.org>

use POSIX;

$base = "/ams/img";
$data = "/usr/local/web/toroid.org/ams/img";

my ( $album, $photo, $title, $heading, $text );

# We accept three forms of invocation:
#
# img.cgi                       displays a list of albums
# img.cgi/$album                displays a list of photos
# img.cgi/$album/$photo         displays a single photograph
#
# Anything else we can reject straightaway.

$_ = $ENV{PATH_INFO} || "";
unless ( $_ eq "" ||
         (($album) = m{^/([\w\d.-]+)$}) ||
         (($album,$photo) = m{^/([\w\d.-]+)/([\w\d.-]+)$}) )
{
NOTFOUND:
    print "Status: 404 File Not Found\r\n";
    print "Content-Type: text/plain\r\n\r\n";
    print "Not found.\r\n";
    exit;
}

# We can't proceed any further without parsing albums.txt. How much
# further we proceed depends on PATH_INFO. If it's empty, we just
# display a list of (links to) non-empty albums.

my @albums = get_albums();
my %albums = map { $_->{name} => $_ } @albums;

if ( not defined $album ) {
    $title = "Albums";
    $text = join(
        "\n",
        "<ul>",
        ( map { "<li><a href=\"$base/$_->{name}\">$_->{title}</a>" } @albums ),
        "</ul>"
    ) if @albums;
    $text ||= "No albums defined.";
}

# Otherwise we parse photographs.txt and display either the contents of
# an album or a single photograph with next/previous links.

else {
    goto NOTFOUND unless exists $albums{$album};

    my $a = $albums{$album};
    my @contents = @{ $a->{contents} };

    # The contents of an album are defined by I: lines in albums.txt.
    # A P: line for an album further prefixes a directory name to each
    # filename. Thus @contents = ("x/a.png", "x/b.png", "x/c.png", ...).
    #
    # The entry for a photograph in photographs.txt is identified by
    # whatever name (a.jpeg or x/a.jpeg) is given to it in the album.
    #
    # Now here's the tricky part. When we're generating links, we use a
    # short form, i.e. just "a" (which must be unique AT LEAST within an
    # album, i.e. you can't put foo/1.jpeg and bar/1.jpeg into the same
    # album), so we need to map unique filenames to unique-in-context
    # shorter names, and back.

    my ( %photos, %shortnames, %fullnames );

    %photos = get_photographs();

    foreach ( @contents ) {
        (my $short = $_) =~ s/^(?:.*\/)?(.*)(?:\.\w+)$/$1/;
        $shortnames{$_} = exists $fullnames{$short} ? $_ : $short;
        $fullnames{$shortnames{$_}} = $_;
    }

    sub photo_title {
        my ( $photo ) = @_;

        my $title;
        if ( exists $photos{$photo} ) {
            $title = $photos{$photo}->{title};
        }
        unless ( $title ) {
            $title = $shortnames{$photo};
            $title =~ y/-/ /;
            $title =~ s/\.[a-z]*$//;
            $title = ucfirst $title;
        }

        return $title;
    }

    # And now we assemble the display text.

    if ( not defined $photo ) {
        my @parts;

        if ( my $foreword = $a->{foreword} ) {
            push @parts, $foreword;
            push @parts, "<p>";
        }

        push @parts, "<ul>";
        foreach ( @contents ) {
            my $name = $shortnames{$_};
            my $title = photo_title( $_ );
            push @parts, "<li><a href=\"$base/$album/$name\">$title</a>";
        }
        push @parts, "</ul>";

        if ( my $afterword = $a->{afterword} ) {
            push @parts, "<p>";
            push @parts, $afterword;
        }

        push @parts, "<p>(<a href=\"$base\">Back to the list of albums</a>)";

        $title = $a->{title};
        $text = join( "\n", @parts );
    }
    else {
        my $i = 0;
        my %contents = map { $_ => $i++ } @contents;

        $photo = $fullnames{$photo};

        goto NOTFOUND unless
            exists $contents{$photo} &&
            ( exists $photos{$photo} || -f "$data/$photo" );

        my $imagetitle = photo_title( $photo );
        $title = "$a->{title}: $imagetitle";
        $heading = $imagetitle;

        my $idx = $contents{$photo};
        if ( $idx != 0 || $idx+1 != @contents ) {
            if ( $idx+1 != @contents ) {
                my $next = $shortnames{$contents[$idx+1]};
                $text .= "<a href=\"$base/$album/$next\">Next</a>,\n";
            }

            if ( $idx != 0 ) {
                my $prev = $shortnames{$contents[$idx-1]};
                $text .= "<a href=\"$base/$album/$prev\">Previous</a>,\n";
            }

            $text .= "<a href=\"$base/$album\">Index</a>\n";
            $text .= "<br>\n";
        }
        $text .= "<img src=\"$base/$photo\" alt=\"$imagetitle\">\n";

        if ( exists $photos{$photo} &&
             ( my $description = $photos{$photo}->{description} ) )
        {
            $text .= "\n<p>\n$description\n";
        }
    }
}

OUT:

$heading ||= $title;

print "Content-Type: text/html; charset=utf-8\r\n";
print "\r\n";

print <<"HTML";
<!doctype html>

<title>ams/img: $title</title>
<link rel=stylesheet type="text/css" href="/toroid.css">
<style>
h1 { font-size: 1.5em; }
</style>

<h1>$heading</h1>

<div class=byline>
By <a href="http://toroid.org">Abhijit Menon-Sen</a> &lt;ams\@toroid.org&gt;
</div>

<p>
$text
HTML

sub get_albums {
    my @a;

    local *ALBUMS;
    open( ALBUMS, "$data/albums.txt" ) || die;
    while ( <ALBUMS> ) {
        chomp;
        next if /^#/ || /^\s*$/;
        if ( /^N: ([\w\d.-]+)$/ ) {
            (my $title = ucfirst $1) =~ y/-/ /;
            push @a,
                { name => $1, title => $title,
                  foreword => "", afterword => "",
                  prefix => "", contents => [] };
        }
        elsif ( @a && /^T: (.*)$/ ) {
            $a[-1]->{title} = $1;
        }
        elsif ( @a && /^F: (.*)$/ ) {
            $a[-1]->{foreword} .= "$1\n";
        }
        elsif ( @a && /^A: (.*)$/ ) {
            $a[-1]->{afterword} .= "$1\n";
        }
        elsif ( @a && /^P: (.*)$/ ) {
            $a[-1]->{prefix} = $1;
        }
        elsif ( @a && /^I: (.*)$/ ) {
            push @{ $a[-1]->{contents} }, split /\s*,\s*/, $1;
        }
    }

    my @albums;
    foreach ( @a ) {
        my $prefix = $_->{prefix};
        my @contents = @{$_->{contents}};

        if ( $prefix ) {
            unless ( @contents ) {
                # We could opendir $prefix and read in the filenames,
                # but is it really a good idea to do that to display
                # every photograph? It doesn't seem worth it.
            }

            @contents = @{$_->{contents}} =
                map { $_ =~ m#/# ? $_ : "$prefix/$_" } @contents;
        }

        # Exclude any album without any defined contents. What could we
        # do with such a thing anyway?

        push( @albums, $_ ) if @contents;
    }

    return @albums;
}

sub get_photographs {
    my @photos;

    local *PHOTOS;
    open( PHOTOS, "$data/photographs.txt" ) || die;
    while ( <PHOTOS> ) {
        chomp;
        next if /^#/ || /^\s*$/;
        if ( /^N: ([\w\d.\/-]+)$/ ) {
            push @photos,
                { name => $1, title => "", description => "" };
        }
        elsif ( @photos && /^T: (.*)$/ ) {
            $photos[-1]->{title} = $1;
        }
        elsif ( @photos && /^D: (.*)$/ ) {
            $photos[-1]->{description} .= "$1\n";
        }
    }

    return map { $_->{name} => $_ } @photos;
}