Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?

Comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
#!/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, +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 <> =cut

In reply to make_photos by araqnid

Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?

    What's my password?
    Create A New User
    and all is quiet...

    How do I use this? | Other CB clients
    Other Users?
    Others browsing the Monastery: (8)
    As of 2018-04-24 09:36 GMT
    Find Nodes?
      Voting Booth?