#!/usr/bin/perl
# Filename:	caption_edit.cgi
# Author:	David Ljung Madison <DaveSource.com>
# See License:	http://MarginalHacks.com/License
# Version:	1.10
# 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";
#$ROOT = `pwd`;
chomp($ROOT);

## 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);
##
## Or leave this empty "()", and it will show *all* the albums
## (including subdirectories, though for safety it will not follow links)
my @ALBUMS = ();

## 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.10, 2015/05/04
# ------------------------
# + Can automatically list all albums in a subdirectory
# + Improved form/UI, can change albums from inside albums
# + Can hide images (though no interface to unhide them currently)
#
# 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;

sub add_dir_to_albums {
	my ($dir) = @_;
	opendir(DIR,"$ROOT/$dir") || return FATAL("Can't read directory $dir [ROOT: $ROOT]");
	my @dir = readdir(DIR);
	closedir(DIR);
	foreach my $p ( @dir ) {
		next if $p eq '.' || $p eq '..';
		next if $p eq 'tn';	# Hack, shoud use album.conf values
		next if $p eq 'Themes';	# Hack to avoid themes directory
		my $path = $dir ? "$dir/$p" : $p;
		next unless -f "$ROOT/$path/index.html"; # Hack again, should use album.conf for 'index.html'
		next unless -d "$ROOT/$path";
		next if -l "$ROOT/$path";
		push(@ALBUMS,"/$path");
		add_dir_to_albums("$path");
	}
}

add_dir_to_albums() unless @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 @ALBUMS form $ROOT")
		unless $alb =~ m|^/|;
}

sub choose_album_form {
	my ($query,$str,$name) = @_;

	my $choose = "<form action='$URL' method='GET' name='".($name||'choose_album')."'>\n";
	$choose .= "$str\n";
	$choose .= "  <select name='album' onChange='this.form.submit();'>\n";
	foreach my $alb ( sort @ALBUMS ) {
		my $qalb = $alb;
		$qalb =~ s/'/%27/g;
		my $sel = $alb eq $query->{album} ? " selected" : "";
		$choose .= "    <option value='$qalb'$sel>$alb\n";
	}
	$choose .= "  </select>\n";
	$choose .= "  <input type=submit value=Edit>\n" unless $name;
	$choose .= "</form>\n";
	$choose;
}

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
	return $query->{album} if $query->{album} && !$err;

	my $choose = choose_album_form($query,"Please choose a photo album:");

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

	EXIT($choose);
}

sub image_input {
	my ($nameimg) = @_;
	# Need to construct the hide checkbox
	return "<input $nameimg>" unless $nameimg =~ /name="NAME([^"]+)"/;
	return "(hide: <input type=checkbox name='HIDE$1'>) <input $nameimg>";
}

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);
			my $hide = $query->{"HIDE${num}:$file"} ? "#" : "";
			$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]+$//g;
			$caption =~ s/[
\n]+/<br \\>/mg;
			$captions[$num] = "$hide$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 $choose = choose_album_form($query,"Switch album (no save):",'change_album');
		my $original = "<b>Goto original <a href='$original_url'>Album</a></b>";
		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 $chooseOriginal = <<CHOOSEORIGINAL;
<div style='width: 100%-10; background-color: red; padding: 5px;'>
	<div style='float: left; width: 50%; text-align: left;'>$choose</div>
	<div style='float: right; width: 50%; text-align: right;'>$original</div>
<div style='clear: both;'> </div>
</div>
CHOOSEORIGINAL
		my $formSubmit = <<FORMSUBMIT;
$form
<div style='width: 100%-30; background-color: red; text-align: center; padding: 15px;'>
	$submit
</div>
FORMSUBMIT
		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:
			## (But this screws up things like relative .css paths - maybe just html links?)
			## This version probably works - but what if the subalbum isn't on the edit list?
			## And with the new dropdown menu, we probably don't need it...
			#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>$chooseOriginal$formSubmit#g;
			s#</body([^>]*)>#$noheader$nofooter$formSubmit</form></body$1>#g;
			s#<!--(HEADER|FOOTER) (.*)-->\n?#<textarea cols='60' rows='6' $2>#g;
			s#<!--(IMAGE_CAPTION) (.*)-->\n?#<textarea cols='30' rows='3' $2>#g;
			s#<!--END_(HEADER|FOOTER|IMAGE_CAPTION)-->#</textarea>#g;
			s#<!--IMAGE_NAME (.*)-->.*<!--END_IMAGE_NAME-->#'[link]</a>'.image_input($1)#eg;
			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