XHTML results from the CPAN

Image-Shoehorn-Gallery

				                ],
                                   scale_if    => { x => 400 , y => 300 },
                                   iptc        => ["headline","caption/abstract"],
                                   set_lang    => "en-ca",
                                   set_styles  => {
                                                  image => [
                                                            {title=>"my css",href=>"/styles.css"},
                                                           ],
                                                 },
                                   set_index_images => { default => 1 },
    		                  });

=head1 DESCRIPTION

Image::Shoehorn::Gallery generates HTML slideshows from a directory of image files. But wait, there's more!

Image::Shoehorn uses I<XML::Filter::XML_Directory_2XHTML>, I<XML::SAX::Machines> and a small army of I<Image::*> packages allowing you to :

=over 4

=item *

Create one, or more, scaled versions of an image, and their associate HTML pages. Scaled version may also be defined but left to be created at a later date by I<Apache::Image::Shoehorn>.

Associate HTML are always "baked", rather than "fried" (see also : http://www.aaronsw.com/weblog/000404 )

=item *

Read a user-defined list of IPTC and EXIF metadata fields from each image and include the data in the HTML pages.

=item *

Generate named indices and next/previous links by reading IPTC "headline" data.

=item *

Define one, or more, SAX filters to be applied to "index" and individual "image" documents before they are passed the final I<XML::SAX::Writer> filter for output.

The default look and feel of the gallery pages is pretty plain, but you could easily define a "foofy design" XSL stylesheet to be applied with the I<XML::Filter::XSLT> SAX filter:

 <xsl:stylesheet xmlns:xsl="http://www.w3.org/1999/XSL/Transform"
                 version = "1.0" >

  <xsl:template match = "/">
  <html>
   <xsl:copy-of select = "html/head" />
   <body>

    <!-- lots of foofy design stuff -->
    <xsl:copy-of select = "/html/body/*" />
    <!-- lots of foofy design stuff -->

   </body>
  </html>
  </xsl:template>

 </xsl:stylesheet>

=item *

Generates valid XHTML (strict) and CSS!

=back

=cut

use strict;
package Image::Shoehorn::Gallery;

$Image::Shoehorn::Gallery::VERSION = '0.22';

use Carp;
use Carp::Heavy;
use Digest::MD5 qw (md5_hex);

use DirHandle;

use File::Basename;
use File::Copy;
use File::Path;

use Image::Shoehorn;
use Image::Size qw (imgsize);

use IO::File;
use XML::SAX::Writer;
use XML::Filter::XML_Directory_2XHTML;
use XML::Directory::SAX;

use XML::SAX::Machines qw (Pipeline);
$XML::SAX::ParserPackage = "XML::SAX::Expat";

#

my $directory = undef;
my $source    = undef;
my $dest      = undef;

my $url       = undef;

my $static    = undef;
my $scales    = {};
my $scaleif   = {};

my $views     = [];
my $iptc      = [];
my $exif      = [];

my $maxdepth  = undef;
my $encoding  = undef;
my $lang      = undef;

my $styles    = {};
my $filters   = {};
my $images    = {};

my $verbose   = 0;
my $force     = 0;

my $conf      = undef;

lib/Image/Shoehorn/Gallery.pm view on Meta::CPAN

    }
  }

  $visit --;
}

sub make_index {
  my $path = shift;

  print STDERR "[make-index] Making $path\n"
    if ($verbose);

  $cur_source = $path;
  $cur_dest   = __PACKAGE__->source_to_dest($path);

  #

  my $src = __PACKAGE__->source_to_dest($path);

  print STDERR "Making '$cur_dest'..."
    if ($verbose);

  if ((! -d $cur_dest) && (! mkpath($cur_dest,0,0755))) {
    print STDERR "Failed to make '$cur_dest', $!\n";
    return 0;
  }

  print STDERR "ok\n"
    if ($verbose);

  #

  my $html = $cur_dest."/index.html";
  my $tmp  = $html.".tmp";

  #

  my $output  = IO::File->new(">$tmp");

  if (! $output) {
    carp "Failed to open '$tmp' for writing, $!\n";
    return 0;
  }

  #

  my $writer  = XML::SAX::Writer->new(Output=>$output);

  my $filters = __PACKAGE__->filters("index");

  my $machine = Pipeline(
			 "LocalSAX_FloatingThumbs",
			 "LocalSAX_Breadcrumbs",
			 ((scalar(@{$filters})) ? @{$filters} : ()),
			 $writer);

  #

  # This is broken, I know.
  # There appears to be some degree of funkiness going
  # on with the inheritance chain for 2XHTML that is 
  # preventing the SAX::Machine from getting the output
  # of 2XHTML and passing it on to $writer. I think, anyway.

  my $xhtml = XML::Filter::XML_Directory_2XHTML->new(Handler=>$machine);

  $xhtml->debug(0);

  if ($encoding) {
    $xhtml->set_encoding($encoding);
  }

  if ($lang) {
    $xhtml->set_lang($lang);
  }

  $xhtml->exclude_root(1);
  $xhtml->exclude(
		  starting => ["\\."],
		  ending   => ["html","tmp","~"],
		  matching => ["^(.*)-(".join("|","thumb",@{$views}).")\.([^\.]+)\$"],
		 );

  #

  my $css = __PACKAGE__->styles("index");

  if (scalar(@$css)) {
    $xhtml->set_styles($css);
  }

  else {
    $xhtml->set_style(\qq(
body {
  background-color: #ffffff;
  margin:0;
}

.breadcrumbs {
 display:block;
  background-color: #f5f5dc;
  padding:5px;
  margin-bottom:5px;
  border-bottom: solid thin;
}

.breadcrumbs-spacer {

}

.directory { margin:10px;float:left; padding: 5px;}

.file      { margin:10px;float:left;padding: 5px;}

.spacer { clear:both; }

.thumbnail { display:block;width:100px;float:left;}

.file ul   { float:left;}

));
  }

lib/Image/Shoehorn/Gallery.pm view on Meta::CPAN

This is free software, you may use it and distribute it under the same terms as Perl itself.

=cut

package MyXSLT;
use base qw (XML::Filter::XSLT::LibXSLT);

sub set_stylesheet_parameters {
    my $self   = shift;
    my %params = @_;

    if (keys %params) {
	map { push @{$self->{'__params'}},&XML::LibXSLT::xpath_to_string($_=>$params{$_}) } keys %params;
    }
}

sub set_stylesheet_string {
  my $self = shift;
  $self->{Source}{String} = $_[0];
}

# No point until I figure out how
# to pass the filehandles :-(

#sub set_stylesheet_fh {
#  my $self = shift;
#  $self->{Source}{ByteStream} = $_[0];
#}

sub end_document {
    my $self = shift;

    my $dom = $self->XML::LibXML::SAX::Builder::end_document(@_);

    # This is so fucking stupid, but there are bugs
    # somewhere in all the magic that handles XHTML
    # and XSLT so...

    my $parser = XML::LibXML->new;
    $dom = $parser->parse_html_string($dom->toString());

    my $xslt       = XML::LibXSLT->new;
    my $stylesheet = $xslt->parse_stylesheet($self->{StylesheetDOM});

    my $results = $stylesheet->transform($dom,((ref($self->{'__params'}) eq "ARRAY") ? @{$self->{'__params'}} : ()));

    my $parser = XML::LibXML::SAX::Parser->new(%$self);
    $parser->generate($results);
}

package LocalSAX_Image;
use base qw (XML::SAX::Base);

use File::Basename;
use Image::Size qw (imgsize);
use Image::Info;

my $possible_views;

use constant DTD_HTML_ROOT     => "html";
use constant DTD_HTML_PUBLICID => "-//W3C//DTD XHTML 1.0 Strict//EN";
use constant DTD_HTML_SYSTEMID => "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd";

sub xml_decl {
  my $self = shift;
  $self->SUPER::xml_decl({
			  Version  => "1.0",
			  Encoding => (Image::Shoehorn::Gallery->encoding() || "UTF-8")
			 });

  # If you're wondering what is going on here,
  # see the note in the STYLESHEET package.

  $self->SUPER::start_dtd({Name=>DTD_HTML_ROOT,
			   PublicId=>DTD_HTML_PUBLICID,
			   SystemId=>DTD_HTML_SYSTEMID});
  $self->SUPER::end_dtd();
}

sub start_document {
  my $self = shift;

  $self->{'__styles'} = scalar(@{Image::Shoehorn::Gallery->styles("image")});
  $possible_views = join("|",@{Image::Shoehorn::Gallery->views()});

  $self->SUPER::start_document(@_);
}

sub start_element {
    my $self = shift;
    my $data = shift;

    $self->{'__last'} = $data->{Name};

    #

    if (($data->{Name} eq "html") && (Image::Shoehorn::Gallery->lang())) {

      $self->SUPER::start_prefix_mapping({Prefix=>"",NamespaceURI=>"http://www.w3.org/1999/xhtml"});

      $self->SUPER::start_element({Name=>"html",Attributes=>{
							     "{}lang" => {Name         => "lang",
									  Value        => Image::Shoehorn::Gallery->lang(),
									  Prefix       => "",
									  LocalName    => "lang",
									  NamespaceURI => "",
									 },
							     "{}xml:lang" => {
									      Name => "xml:lang",
									      Value => Image::Shoehorn::Gallery->lang(),
									      Prefix       => "xml",
									      LocalName    => "xml:lang",
									      NamespaceURI => "http://www.w3.org/1999/xhtml",
									    },
							    }});
      return 1;
    }

    if (($data->{Name} eq "style") && ($self->{'__styles'})){

      foreach my $style (@{Image::Shoehorn::Gallery->styles("image")}) {

lib/Image/Shoehorn/Gallery.pm view on Meta::CPAN

    $exif{$path} = undef;
  }

  return $exif{$path};
}

sub test {
  my $pkg  = shift;
  my $path = shift;

  if (exists($views{$path})) {
    return $views{$path};
  }

  foreach my $view (@{Image::Shoehorn::Gallery->exif()}) {
    if ($exif{$path}->{$view}) {
      $views{$path} = 1;
      return 1;
    }
  }

  $views{$path} = 0;
  return 0;
}

package Breadcrumbs;

my %crumbs = ();
my %count  = ();

sub get {
  my $pkg = shift;

  if (! $_[0]) {
    return ([],1);
  }

  if (exists $crumbs{$_[0]}) {
    return ($crumbs{$_[0]},$count{$_[0]});
  }

  @{$crumbs{$_[0]}} = split("/",$_[0]);
  $count{$_[0]}     = scalar(@{$crumbs{$_[0]}});

  return ($crumbs{$_[0]},$count{$_[0]});
}

package STYLESHEET;
my $data = undef;

sub data {
  if ($data) { return $data; }
  while (<DATA>) { $data .= $_;  }
  return $data;
}

return 1;

# NOTE : we are not setting the public and system doctypes here
# because they cause even more weirdness with XML::LibXML and it's
# seeming inability to deal with XHTML files. I really don't get
# what's going on so we play a little game and set them event the 
# xml_decl event in the LocalSAX_Image filter is called next. Gah!

# NOTE ALSO : that this is also where we happen to set the encoding

__DATA__
<?xml version="1.0" encoding='iso-8859-1'?>

<xsl:stylesheet xmlns:xsl="http://www.w3.org/1999/XSL/Transform"
                version = "1.0" >

<xsl:output method = "xml" 
            indent = "yes" />

<xsl:param name = "id" />
<xsl:param name = "scales" />
<xsl:param name = "scale" />
<xsl:param name = "doscale" />
<xsl:param name = "static" />

<!-- ======================================================================
     ====================================================================== -->

 <xsl:variable name = "has_id">
  <xsl:choose>
   <xsl:when test = "/html/body/div[@id=$id]">1</xsl:when>
   <xsl:otherwise>0</xsl:otherwise>
  </xsl:choose>
 </xsl:variable>

   <xsl:variable name = "image">
    <xsl:value-of select = "/html/body/div[@id=$id]/div[@class='thumbnail']/img/@src" />
   </xsl:variable>

    <xsl:variable name  = "prev">
     <xsl:value-of select = "/html/body/div[@id=$id]/preceding-sibling::*[1][name()='div']/a/@href" />
    </xsl:variable>

    <xsl:variable name  = "next">
     <xsl:value-of select = "/html/body/div[@id=$id]/following-sibling::*[1][name()='div']/a/@href" />
    </xsl:variable>

    <xsl:variable name = "last" select = "count(/html/body/div[@class='file' or @class = 'directory'])" />

    <xsl:variable name = "prev_title">
     <xsl:choose>
      <xsl:when test = "$prev != ''">
       <xsl:value-of select = "/html/body/div[@id=$id]/preceding-sibling::*[1][@class='file' or @class = 'directory']/a" />
      </xsl:when>
      <xsl:otherwise>
       <xsl:value-of select = "/html/body/div[@class='file' or @class = 'directory'][$last]/a" />
      </xsl:otherwise>
     </xsl:choose>
    </xsl:variable>

      <xsl:variable name = "prev_href">
       <xsl:choose>
        <xsl:when test = "$prev != ''">
         <xsl:value-of select = "$prev" />
        </xsl:when>

( run in 0.968 second using v1.01-cache-2.11-cpan-39bf76dae61 )