#!/usr/bin/perl -w
# Copyright (C) 2000 Steve Haslam
# This is free software, distributable under the same terms as Perl
# itself - see the Perl source distribution for details.
# Generate HTML pages and fingernails of photos from an XML file:
# e.g.: ./make_photos (uses photolist.xml, flibble.jpg, flibblebed.jp
+g, flibble-and-mewler.jpg)
# --> index.html, cats.html, flibble-s.jpg, flibblebed-s.jpg, flibbl
+e-and-mewler-s.jpg
require 5;
use strict;
use XML::Parser;
use XML::DOM;
use IO::File;
use POSIX qw(strftime);
use Sys::Hostname;
use Image::Size;
use Image::Magick;
use Getopt::Std;
use vars qw($listdoc %index $photo_dir $html_dir $opt_f $opt_d $opt_h)
+;
sub read_photolist {
my $filename = shift;
my $parser = XML::DOM::Parser->new;
$parser->parsefile($filename);
}
sub read_description {
my $photo_node = shift; # XML::DOM::Element (photo)
my $path = shift;
my $indexp = shift;
my $description = '';
my $plaindescription = '';
my @indexrefs;
foreach my $descnode ($photo_node->getChildNodes) {
if ($descnode->getNodeType == TEXT_NODE) {
# Add some more text
$description .= $descnode->getData;
$plaindescription .= $descnode->getData;
}
elsif ($descnode->getNodeType == ELEMENT_NODE) {
if ($descnode->getTagName eq 'index') {
# Index reference
# Get the text content
my $indexcontent = '';
foreach my $idxnode ($descnode->getChildNodes) {
next unless ($idxnode->getNodeType == TEXT_NODE);
$indexcontent .= $idxnode->getData;
}
my $indexid = $descnode->getAttribute("id") || $indexcontent;
push(@indexrefs, $indexid); # Can't push to $indexp until we have
+the entire description
# Add the index link to the description
$description .= "<a href=\"__xref.html#$indexid\">$indexcontent</a
+>";
$plaindescription .= $indexcontent;
}
else {
die "Unknown element <".$descnode->getTagName."> in <photo>\n";
}
}
}
foreach (@indexrefs) {
push(@{$indexp->{$_}}, { href => page_filename(@$path) . '#' . $ph
+oto_node->getAttribute('name'), description => $plaindescription });
}
return $description;
}
sub page_filename {
@_ ? join("-", map { lc($_) } @_).".html" : "index.html";
}
sub get_photo_fingernail {
my $photo_filename = shift;
my $obj = {};
my $fnfile;
if (! -f "$photo_dir/$photo_filename") {
print "*** Photo \"$photo_filename\" does not exist\n";
return { src => '', width => 0, height => 0 };
}
print "Finding fingernail for \"$photo_filename\"...";
if ($photo_filename =~ /(.*)\.([^.]+)/) {
my($stem, $ext) = ($1, $2);
foreach ("${stem}-s.$ext", "${stem}-s.png") {
if (-f "$photo_dir/$_") {
$fnfile = $_;
last;
}
}
}
if ($fnfile) {
print "$fnfile\n";
my($width, $height) = imgsize("$photo_dir/$fnfile");
{ src => $fnfile, width => $width, height => $height };
}
else {
print "(not found)\n";
$fnfile = $photo_filename;
$fnfile =~ s|\.([^.+]+)$|-s.png| or die "Don't know how to make fi
+ngernail file name for $photo_filename\n";
my $image = Image::Magick->new;
$image->Read("$photo_dir/$photo_filename");
my($origwidth, $origheight) = $image->Get('width', 'height');
print "Original size: $origwidth x $origheight\n";
my($fwidth, $fheight);
if ($origwidth > $origheight) {
$fwidth = int(64 * $origwidth / $origheight);
$fheight = 64;
}
else {
$fwidth = 64;
$fheight = int(64 * $origheight / $origwidth);
}
print "Fingernail size: $fwidth x $fheight\n";
$image->Scale(geom => "${fwidth}x${fheight}");
$image->Write("$photo_dir/$fnfile");
{ src => $fnfile, width => $fwidth, height => $fheight };
}
}
sub process_photolist {
my $photolist = shift; # XML::DOM::Element (section or photolist)
my $path = shift;
my $indexp = shift;
my $title = $photolist->getAttribute("title");
my $outfile = "$html_dir/".page_filename(@$path);
my $outstream = IO::File->new(">$outfile") or die "Unable to write t
+o $outfile: $!\n";
$outstream->print(<<EOF);
<html lang="en-gb">
<head>
<title> Photos: $title </title>
</head>
<body>
<h1> $title </h1>
EOF
foreach my $node ($photolist->getChildNodes) {
next unless ($node->getNodeType == ELEMENT_NODE);
if ($node->getTagName eq 'section') {
my $section_id = $node->getAttribute("name") or die "No \"name\"
+ attribute on <section>\n";
my $section_title = $node->getAttribute("title") or die "No \"ti
+tle\" attribute on <section name=\"$section_id\">\n";
my @newpath = (@$path, $section_id);
my $section_page = page_filename(@newpath);
$outstream->print(<<EOF);
<h2> $section_title </h2>
<a href="$section_page">More photos...</a>
EOF
process_photolist($node, \@newpath, $indexp);
}
elsif ($node->getTagName eq 'photo') {
my $photo_name = $node->getAttribute("name");
my $photo_filename = $node->getAttribute("filename");
my $description = read_description($node, $path, $indexp);
my $photo_fingernail = get_photo_fingernail($photo_filename);
$outstream->print(<<EOF);
<a name="$photo_name">
<table>
<tr> <td> <a href="$photo_filename"><img src="$photo_fingernail->{src
+}" width="$photo_fingernail->{width}" height="$photo_fingernail->{hei
+ght}"></a> </td>
<td> $description </td> </table>
EOF
}
else {
die "Unknown element <".$node->getTagName."> in <".$photolist->g
+etTagName.">\n";
}
}
if (@$path) {
# upwards navigation
$outstream->print(<<EOF);
<hr> <menu>
EOF
for (my $i=$#$path-1; $i>=0; $i--) {
my @subpath = @$path[0..$i];
my $page = page_filename(@subpath);
my $path = $subpath[$#subpath];
$outstream->print(<<EOF);
<li> <a href="$page">$path</a> </li>
EOF
}
$outstream->print(<<EOF);
<li> <a href="./">Top photo page</a> </li>
</menu>
EOF
}
else {
# link to cross-references
if (%$indexp) {
$outstream->print(<<EOF);
<hr> <p> Handy page of <a href="__xref.html"> cross-references </a>
EOF
}
}
my $date = strftime("%d %b %Y, %H:%M:%S %Z", localtime(time));
my $hostname = hostname;
my $user = getlogin || (getpwnam($<))[0];
$outstream->print(<<EOF);
<hr> <p> Generated $date on $hostname by $user
</body>
</html>
EOF
$outstream->close;
}
sub writexrefs {
my $indexp = shift;
my $outfile = "$html_dir/__xref.html";
my $outstream = IO::File->new(">$outfile") or die "Unable to write t
+o $outfile: $!\n";
$outstream->print(<<EOF);
<html lang="en-gb">
<head>
<title> Photos: Index </title>
</head>
<body>
<h1> Index </h1>
<table>
EOF
foreach my $who (sort keys %$indexp) {
my $photos = $indexp->{$who};
$outstream->print(<<EOF);
<tr> <td> $who <td>
EOF
foreach my $photo (@$photos) {
$outstream->print("<a href=\"$photo->{href}\">$photo->{descripti
+on}</a> <br>");
}
}
$outstream->print(<<EOF);
</table>
<hr>
<menu>
<li> <a href="./">Top photo page</a> </li>
</menu>
</body>
</html>
EOF
$outstream->close;
}
getopts('d:f:h:') && @ARGV == 0 or die <<EOF;
Syntax: $0 [-f photolist.xml] [-d photo_dir] [-h html_dir]
See the POD documentation for more information
EOF
$photo_dir = $opt_d || ".";
$html_dir = $opt_h || $photo_dir;
$listdoc = read_photolist($opt_f || "photolist.xml");
process_photolist($listdoc->getDocumentElement, [], \%index);
writexrefs(\%index);
=head1 NAME
make_photos - Generate HTML and fingernails for putting photos on the
+web
=head1 SYNOPSIS
make_photos [-d B<photos_dir> [-h B<html_dir>]] [-f B<photolist>]
=head1 DESCRIPTION
Reads an XML file (B<photolist>, or C<photolist.xml> by default) and
uses it to build HTML pages for navigating through a tree of
photographs.
As well as generating HTML, it will also automagically generate
scaled-down PNGs to use as fingernails. It can also produce a secondar
+y
index- e.g. for people who appear in various places in the tree.
The XML used looks like this:
<photolist title="My Photos">
<section name="Cats" title="Photos of cats">
<photo name="Photo1" filename="flibble.jpg">
This is the first photo, a picture of my cat <index>Flibble<inde
+x>
</photo>
<photo name="Photo2" filename="flibblebed.jpg">
This is a photo of <index id="Flibble">Flibble's</index> bed
</photo>
<photo name="Photo3" filename="flibble-and-mewler.jpg">
This is <index>Flibble</index> and our neighbour's cat <index>Me
+wler</index>
</photo>
</section>
</photolist>
Sections may be nested. The "name" elements are used to build the HTML
filenames and anchors.
The B<index> tag may or may not take an B<id> attribute- if none is
specified, then the text content is used for indexing. (I suspect this
is evil, but...)
The photos referenced in the XML file are expected to be found in
B<photos_dir> (defaults to the current working directory). The
fingernail file is expected to have the same name but with "-s"
interposed between the basename and the extension, viz.:
Photo file Fingernail file
flibble.jpg flibble-s.jpg
flibblebed.jpg flibblebed-s.jpg
The HTML is written on to B<html_dir>, which defaults to the same
directory as where the photos are found...
=head1 BUGS
There is no way to customise the HTML output without modifying the
script, and the HTML currently generated is unpleasant.
There is no way to customise the scaling decision used for the
fingernail file (scales smallest dimension to 64 pixels).
HTML escaping is not performed.
I don't really have a cat called Flibble. Honest.
=head1 AUTHOR
Steve Haslam <araqnid@debian.org>
=cut
|