#!/usr/bin/perl
# Filename:	caption_edit.cgi
# Author:	David Ljung Madison <DaveSource.com>
# See License:	http://MarginalHacks.com/License
# Version:	1.04
# Description:	Shows an album page
# See Also:	http://MarginalHacks.com/License
use strict;

umask 0022;

##################################################
##################################################
#
# SETTINGS (you probably want to change these)
#
##################################################
##################################################

$ENV{HOME} = "/home/dave";

## Root directory of the / URL
## (the top level for your web docs)
## This is a filesystem path, not a URL path!
my $ROOT = "/data/proj/album";

## Directory for ~user expansion, in case we have http://some.com/~dave/photos/
##   %u is replaced with user
## So this is where we find the actual filesystem paths for those URLs:
## (Or empty if you don't use ~user expansion)
my $HOME_ROOT = "/home/%u/public_html";

## Allowed albums
## What is the path for albums that we can change?  (path from $ROOT)
## This is an array of paths (actually regexps, if you like)
## (The path of the URL needs to match the actual filesystem path
##  from $ROOT, otherwise you'll have problems.)
##
## The "http://domain/" part is optional
##
## These are examples - you'll want to change:
my @ALBUMS = qw(/test/ab /test/3);

## The name of your machine
## Change the default at the end:
my $HOST = $ENV{HTTP_HOST} || $ENV{SERVER_NAME} || "YOURDOMAINHERE.com";

## Port (from ENV or from HOST or 80)
my $PORT = $ENV{SERVER_PORT} || $ENV{HTTP_PORT};
   $PORT = (($HOST =~ s/:(\d+)$//) ? $1 : 80) unless (defined $PORT);

## For the URL
my $DOMAIN = $PORT==80 ? $HOST : "$HOST:$PORT";

## If you're using SSL, here's where you choose "https:"
my $HTTP = "http";
#my $HTTP = "https";

## The location of the cgi script
my $CGI = $ENV{REQUEST_URI};
   $CGI =~ s/[\&\?].+$//;

## Where is the album script?  (or just "album" if it's in the path)
## Add any options you need here (such as -medium)
my $ALBUM = "album-3.05b";


## Header and Footer files (defaults as in album)
my $HEADER = "header.txt";
my $FOOTER = "footer.txt";

##################################################
# Changelog
##################################################
# Version 1.04, 2004/09/29
# ------------------------
# + Better handling of "no album specified"
# + ??
#
# Version 1.03, 2003/11/22
# ------------------------
# + Always shows header and footer boxes
#
# Version 1.02, 2003/06/19
# ------------------------
# + Now can edit image pages!
# + Now links keep you in the caption editor
# * Doesn't complain about missing caption info on non-image pages
#
# Version 1.01, 2003/05/19
# ------------------------
# * Handles optional port
# * Fixes missing background problem
# + Now can take URL to specify album to edit
#
# Version 1.00, ????/??/??
# ------------------------
# + Released

##################################################
##################################################
#
# Code
#
##################################################
##################################################
# These you probably shouldn't change
##################################################
my $URL = "${HTTP}://$DOMAIN$CGI";

##################################################
# Query
##################################################
sub from_url {
  my ($str) = @_;
  $str =~ s/\+/ /g;
  $str =~ s/%([0-9a-f]{2})/chr(hex($1))/eig;
  $str;
}

sub to_url {
  my ($str) = @_;
  $str =~ s/([^a-zA-Z0-9\._\/-])/"%".sprintf("%0.2x",ord($1))/eg;
  #$str =~ s/ /+/g;
  $str;
}

sub unhtml {
  my ($str) = @_;
  $str = from_url($str);
  $str =~ s/</\&lt;/g;
  $str =~ s/>/\&gt;/g;
  $str =~ s/[\r\n]/ /g;
  $str;
}

sub html {
  my (@str) = @_;
  my $str = join("<br>\n",split("\n",join("",@str)));
  $str;
}

sub parse_query {
  # Get query
  my $query_string;
  if ($ENV{REQUEST_METHOD} eq "POST") {
    read(STDIN,$query_string,$ENV{CONTENT_LENGTH});
  } elsif ($ENV{QUERY_STRING}) {
    $query_string = $ENV{QUERY_STRING};
  } elsif (@ARGV) {
    $query_string = join("&",@ARGV);
  }
  chomp($query_string);

  # Split query
  # $query_string is of the form:  "variable=value&var2=val2&.."
  my @querys=split(/[\&\?]/,$query_string);
  my (%query,$var,$val);
  foreach my $str (@querys) {
    $var = $str if (!(($var,$val) = ($str =~ /([^=]*)=(.*)/)));
    $val = defined $val ? from_url($val) : 1;
    $var = from_url($var);
    $query{$var} = from_url($val);
  }

#header(1); show_values(\%query);
  \%query;
}

sub show_values {
  my ($query) = @_;
  print "<p><hr><p>\n\n";
  foreach my $q ( keys %$query ) {
    print "yo $q -> $query->{$q}<br>\n";
  }
}

##################################################
# HTML
##################################################
my $DID_HEADER;
sub header {
  print "Content-type: text/html\n\n" unless $DID_HEADER++;
}

sub ERROR { header(); print "<h2>ERROR: @_</h2>\n"; undef; }
sub FATAL { ERROR(@_); exit; }
sub EXIT { header(); print "<h2>@_</h2>\n"; exit; }

sub write_file {
  my ($file,@content) = @_;
  return unlink $file unless grep(/\S/, @content);
  open(FILE,">$file") ||
    FATAL("Couldn't write [$file] (perhaps web user doesn't have permission?)");
  print FILE @content;
  close FILE;
}

##################################################
# Do it
##################################################
sub clean_path {
  my ($path) = @_;

  # Whitespace
  $path =~ s/^\s*//;
  $path =~ s/\s*$//;

  # Remove trailing "/"
  $path =~ s|/+$||;

  # Remove optional domain:port of URL
  $path =~ s{^(ftp|https?)://[^/]+}{};

  # Remove all // and /./
  #$path="/$path";       # Temporarily make matches easier
  while ($path =~ s|/\.?/|/|) {}
  $path =~ s|/\.$||;

  # Remove all */dir/../*
  while ($path =~ s|/[^/]+/\.\./|/|) {}
  # SECURITY:  Make sure we didn't have too many /../
  # Example:   /bob/../../../../../../etc/passwd
  $path =~ s|^/\.\./|/|;    # /../blah  -> /blah
  $path = "/" if $path eq "/..";  # /..       -> /
  $path =~ s|[^/]+/\.\.$||;   # */some/.. -> *

  # Remove trailing "/"
  $path =~ s|/+$||;

  $path = $path || ".";

  $path;
}

# What number caption is this?
sub find_num {
  my ($file,@captions) = @_;

  # Is the file in the caption array?
  for (my $i=0; $i<=$#captions; $i++) {
    return $i if $captions[$i] =~ /^$file\t/;
  }
  # Otherwise it goes on the end
  return $#captions+1;
}

# Update relative links with a base
sub update_relative {
  my ($base,$link) = @_;
  return "$link" if $link =~ m|^/|;
  return "$link" if $link =~ /^(ftp|https?):/;
  return "$base/$link";
}

# Take "http://domain:port/" out of $ALBUMS
@ALBUMS = map { s{^(ftp|https?)://[^/]+}{}; $_; } @ALBUMS;

foreach my $alb ( @ALBUMS ) {
  # Make sure ALBUMS is absolute
  FATAL("\@ALBUMS setting in CGI needs to have absolute paths<br>".
        "(bad path: $alb - probably should be /$alb?)\n")
    unless $alb =~ m|^/|;
}

sub main {
  $ROOT =~ s|/+$||;
  $HOME_ROOT =~ s|/+$||;
  my $query = parse_query();

  # If no album specified and only one allowed, use that.
  $query->{album} = $ALBUMS[0] unless $query->{album} || $#ALBUMS;

  # Make sure album path is okay
  my $album = clean_path($query->{album});
  $album = "/$album" unless $album =~ m|^/|;	# Absolute paths!
  my $album_url = to_url($album);
  my $original_url = $album_url;

  my $image;
  if ($album =~ s|(/tn/[^/]+\.html?)$||) {
    $image = $1;
    $album_url = to_url("$album/tn");
  }

#  my $choose_album = 
#    "<form action='$URL' method='GET' name='choose_album'>\n".
#    "Album URL: <input type='text' name='album'></form>";

  my $choose_album = "<form action='$URL' method='GET' name='choose_album'>\n";
  $choose_album .= "Please choose a photo album:\n";
  $choose_album .= "  <select name='album'>\n";
  foreach my $alb ( @ALBUMS ) {
    $choose_album .= "    <option value='$alb'>$alb\n";
  }
  $choose_album .= "  </select>\n";
  $choose_album .= "  <input type=submit value=Edit>\n";
  $choose_album .= "</form>\n";

  EXIT("$choose_album")
    unless $query->{album};
  FATAL("Album [$album] not allowed.<p>\n$choose_album")
    unless grep($album =~ /^$_/, @ALBUMS);
  FATAL("Can't have '..' in album path.<p>\n$choose_album")
    if $album =~ m|/\.\./|;
  FATAL("Can't have '|' in album path.<p>\n$choose_album")
    if $album =~ /\|/;

  # ~user or just plain path?
  my $dir;
  if ($album =~ m|^/?~([^/]+)(/.*)|) {
    my ($user,$piece) = ($1,$2);
    $dir = "$HOME_ROOT/$piece";
    $dir =~ s/%u/$user/g;
  } else {
    $dir = "$ROOT/$album";
  }

  FATAL("Can't read album: [$dir].<p>\n$choose_album") unless -d $dir;

  if ($query->{edit_captions}) {
    my @captions;
    if ($image && open(CAP,"<$dir/captions.txt")) {
      # Image Page: We only have caption info for this page.
      # Read the current captions in and edit the new captions in place.
      @captions = <CAP>;
      close CAP;
    }
    # Write out the captions file
    my (@unlink,$header,$footer);
    foreach my $file ( keys %$query ) {
      $header=$1 if $file =~ /^HEADER:(.+)/;
      $footer=$1 if $file =~ /^FOOTER:(.+)/;
      next unless $file =~ s/^NAME(\d+)://g;
      my $num = $image ? find_num($file,@captions) : $1;
      my $name = $query->{"NAME$num:$file"} || " ";
      $name =~ s/\t/ /mg;
      # ctrl-M == \x0d
      $name =~ s/[\n\r\x0d]//mg;
      my $caption = $query->{"CAPTION:$file"} || " ";
      $caption =~ s/\t/ /mg;
      $caption =~ s/[
\n]//mg;
      $captions[$num] = "$file\t$name\t$caption\n";
      my $capfile = $file;
      $capfile =~ s/\.[^\.]+$//;
      $capfile .= ".txt";
      push(@unlink,"$dir/$capfile");
    }

    write_file("$dir/captions.txt",@captions);

    unlink(@unlink);

    # Header/footer
    write_file("$dir/$header",$query->{"HEADER:$header"}) if $header;
    write_file("$dir/$footer",$query->{"FOOTER:$footer"}) if $footer;

    # Now run album on the directory
    open(ALBUM,"$ALBUM -q -caption_edit -depth 1 \Q$dir\E 2>&1 |")
      || FATAL("Can't run album [$ALBUM]");
    my @out = <ALBUM>;
    close ALBUM;
    FATAL("Album error:<p></h2><pre>@out</pre>") if @out;

    # And relocate them to the new page
    #print "Location: ${HTTP}://$DOMAIN$album/\n\n";
    # Nope - relocate back to the CGI
    print "Location: $URL?album=$album\n\n";
    exit;
  } else {
    header();

    # Pipe through the index
    my $index = $image || "index.html";
    FATAL("No index found: [$dir/$index].<p>\n$choose_album")
      unless open(IND,"<$dir/$index");
    my @ind = <IND>;
    close IND;

# TODO: Should we just rerun album now?
    ERROR("Missing caption_edit comment tags<p>Run album (version >=2.47) with -caption_edit option (and a theme)<p><hr><p>")
      unless (grep(/<meta name='caption_edit'/, @ind));

    my $form = "<form action='$URL' method='POST' name='caption_edit'>\n".
               "<input type='hidden' name='album' value='$original_url'>";
    my $submit = "<input type='submit' name='edit_captions' value='Save Changes (may take a while)'>";
    my $original = "<b>Goto original <a href='$original_url'>Album</a></b>";
    $submit = "<table width='100%'><tr><td align=left>$submit</td><td align=right>$original</td></tr></table>\n";
    my $noheader = "<p>No header found.  You can add a $HEADER file here:<br><textarea cols='60' rows='6' name='HEADER:$HEADER'></textarea><p>";
    my $nofooter = "<p>No footer found.  You can add a $FOOTER file here:<br><textarea cols='60' rows='6' name='FOOTER:$FOOTER'></textarea><p>";

    while ($_ = shift @ind) {
      # If we want subalbums/image pages to also go to the CGI:
      s#href=(['"])(.)#($2 eq "/") ? "href=$1$2" : "href=$1$URL?album=$album_url/$2"#eg;

      # Update relative links with correct URL (based off $album)
      s#(src|background|href)=(["'])([^"']+)#"$1=$2".update_relative($album_url,$3)#eg;

      $noheader="" if /<!--HEADER /;
      $nofooter="" if /<!--FOOTER /;
      s#<body([^>]*)>#<body$1>$form$submit#g;
      s#</body([^>]*)>#$noheader$nofooter$submit</form></body$1>#g;
      s#<!--(HEADER|FOOTER) (.*)-->\n?#<textarea cols='60' rows='6' $2>#g;
      s#<!--(IMAGE_CAPTION) (.*)-->\n?#<textarea $2>#g;
      s#<!--END_(HEADER|FOOTER|IMAGE_CAPTION)-->#</textarea>#g;
      s#<!--IMAGE_NAME (.*)-->.*<!--END_IMAGE_NAME-->#[link]</a><input $1>#g;
      print;
    }
  }

} main();