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

umask 0022;

##################################################
# See 'perldoc caption_edit.cgi' for documentation
##################################################

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

## User home directory
## This is your $HOME shell variable, and this is needed to find
## the home album.conf if you so desire.
$ENV{HOME} = $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).
## You can specify as many paths as you want, separated by spaces.
## (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 /some_photos /dave/dave's_favorites);

## 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";

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

##################################################
# Changelog
##################################################
# Version 1.08, 2007/09/05
# ------------------------
# * Stupid choose_album bug wouldn't allow for one album
#
# Version 1.07, 2006/06/12
# ------------------------
# * Fixed some bugs
#
# Version 1.06, 2005/11/05
# ------------------------
# * Fixed albums with apostrophes bug (and cleaned up 'choose_album' code)
#
# Version 1.05, 2005/09/19
# ------------------------
# + Added POD docs (try 'perldoc caption_edit')
#
# Version 1.04, 2004/09/29
# ------------------------
# + Now has "choose a photo album" menu
# + Better handling of errors
# + Added "[link]" (needed by some themes)
#
# 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] =~ /^\Q$file\E\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 choose_album {
  my ($query, $err) = @_;

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

  # Return if we have an album
  if ($query->{album} && !$err) {
    return $query->{album};
  }

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

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

  $choose = "$err\n$choose" if $err;

  EXIT($choose);
}

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

  my $album = choose_album($query);

  # Clean up the album path.
  $album = clean_path($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");
  }

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

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

  if ($query->{edit_captions}) {

		# Get the current captions
    my (@captions, %curr_caps, $num_captions);
    if (open(CAP,"<$dir/captions.txt")) {
			while (<CAP>) {
      	push(@captions, $_);
				chomp;
				my ($file,$name,$cap) = split(/\t+/, $_, 3);
				$curr_caps{$file}{name} = $name if $file && $name;
				$curr_caps{$file}{cap} = $cap if $file && $cap;
			}
      close CAP;
    }
		$num_captions = $#captions;

    # Write out the captions file
    my (@unlink,$header,$footer);
    foreach my $key ( keys %$query ) {
      $header=$1 if $key =~ /^HEADER:(.+)/;
      $footer=$1 if $key =~ /^FOOTER:(.+)/;
			next unless $key =~ /^NAME(-?\d+)?:(.+)/;
			my ($num,$file) = ($1,$2);
      $num = find_num($file,@captions) unless defined $num;
			$num = $num_captions-$num if $num<0;	# For entries not in captions.txt
      my $name = $query->{$key} || " ";
      $name =~ s/\t/ /mg;
      # ctrl-M == \x0d
      $name =~ s/[\n\r\x0d]//mg;
      my $caption = $query->{"CAPTION:$file"};
			$caption = $curr_caps{$file}{cap} unless defined $caption;
      $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 -no_virgin_check -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";
    choose_album($query,"No index found: [$dir/$index].<p>\n")
      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%' bgcolor=red><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();

##################################################
# POD/man
##################################################

__END__

=pod
=head1 NAME

caption_edit.cgi - CGI script for created editable albums

=head1 SYNOPSIS

Visit URL of B<caption_edit.cgi> on web server

=head1 DESCRIPTION

caption_edit is a CGI support script for the album generator C<album>
found at:

<http://MarginalHacks.com/>

After it is installed, you can create an album with -caption_edit:

% album -caption_edit Photos/Spain

You can view this album directly through it's normal URL, or else
you can view it with the caption_edit CGI script, which will make
all the photo names and captions editable so you can change captions
and then regenerate the album.

=head1 INSTALLATION

Installation isn't particularly simple - you need to know how to
install a basic CGI script first.  In the general case you have to
put it in the CGI directory and make sure it is readable/executable
by your webserver.  If this doesn't work for you, then there are
resources on the web that can help you accomplish basic CGI installation,
please don't bother the author of C<album> for help on this issue.

You also have to change the basic settings at the top of the CGI
script.  Open the script with a text editor, and look through the
settings section.  Hopefully most of the settings you need to set
will be self explanatory.  Generally you only want to change things
that you find in between the "double quotes" or (parentheses).

One setting in particular is the list of albums that users are
allowed to edit, this is the @ALBUMS setting.  Generally you
can just add a list of space separated URLs for all of the URLs
that you want to edit.  Any path will automatically include
any sub-albums inside that path.  See the current setting as an example.

The exception to this is if your filesystem paths don't match your
URL paths - as an example:

=over 4

=item Your root URL filesystem path (the location where '/' files are,
and the setting for $ROOT) is at:

/var/www/html

=item The URL for your photos is:

http://some.com/Photos/Spain/

=item But for some reason, the filesystem path for those photos is actually at:

/var/www/html/B<image_storage>/Photos/Spain/

=item Then you'll have to use the actual path from root, in this case:

image_storage/Photos/Spain/

=back

Such is the occasional pain and suffering of the differences between
filesystem paths and URL paths.

=head1 SECURITY

caption_edit comes with B<no> security other than the fact that
people might not know where it is installed.  Anyone who has
access to the caption_edit URL and who can guess which albums
you might have available to edit can permanently edit your albums.

If you are installing this on a public webserver I recommend
using whatever security/login system your webserver supplies to
control access to caption_edit (such as C<.htaccess>).  Again,
please don't bother the author of C<album> with questions about
this, this is outside of his scope.

=head1 SEE ALSO

L<album(1)>

=head1 AUTHOR

David Ljung Madison <http://MarginalHacks.com/>

=cut