#!/usr/bin/perl # gex.pl - Gallery EXport tool package GEX; use strict; use warnings; $|++; my $VERSION = '1.0.0'; # 2004-07-28 17:50 - Morten Wulff use Data::Dumper; $Data::Dumper::Indent = 1; use File::Copy; use File::Path; use Getopt::Std; use PHP::Serialization qw(unserialize); use Text::Template; use Tree::Simple; =head1 NAME gex.pl - generate static HTML version of a gallery album =head1 SYNOPSIS You want to export the gallery "holiday". Your albums directory is C and you want the output written to C: gex.pl -b /home/joe/albums -o /home/joe/export holiday Same as above, but display the name of each album as it is being processed: gex.pl -v -b /home/joe/albums -o /home/joe/export holiday Same as above, but don't include full-sized images: gex.pl -m -v -b /home/joe/albums -o /home/joe/export holiday Display short help message and exit: gex.pl -h Displau full help: perldoc gex.pl =head1 DESCRIPTION =cut use vars qw($opt_b $opt_c $opt_d $opt_h $opt_m $opt_o $opt_t $opt_v); # config ----------------------------------------------------------------------- my $Albums_Root = 'selfinjury'; my $Albums_Dir = 'd:/wwwroot/gallery/albums'; my $Output_Dir = 'd:/projekter/Psyke.org/temp/gex'; my $Template = 'd:/projekter/Psyke.org/bin/gex/gex.tmpl'; # init ------------------------------------------------------------------------- unless ( getopts('b:cd:hmo:t:v') ) { die usage(); } if ($opt_h) { die help(); } $ARGV[0] && do { $Albums_Root = $ARGV[0] }; $opt_b && do { $Albums_Dir = $opt_b }; $opt_o && do { $Output_Dir = $opt_o }; $opt_t && do { $Template = $opt_t }; my @Path = (); # stores the current path my $Tree = Tree::Simple->new({}, Tree::Simple->ROOT); my $Time = 0; # template utility function { no warnings; *GEX::Template::album_highlight = sub { my $album = shift; my $photo; foreach my $item ( @{$album->{'_photos'}} ) { if ($item->{_highlight}) { $photo = $item; last; } } my $img = join '.', $photo->{'highlightImage'}->{'name'}, $photo->{'highlightImage'}->{'type'}; my $img_src = join '/', $album->{'name'}, $img; my $ah = { name => $album->{'name'}, title => $album->{'title'}, count => $album->{'cached_photo_count'}, img => $img_src, width => $photo->{'highlightImage'}->{'width'}, height => $photo->{'highlightImage'}->{'height'} }; # $ah->{debug} = '
' . Dumper($photo) . "########\n" . Dumper($album->{'_photos'}) . '
'; return $ah; }; } # main ------------------------------------------------------------------------- print "Gallery EXport v$VERSION\n" if ($opt_c || $opt_v); if ($opt_c) { print " Album : $Albums_Root\n"; print " Albums dir: $Albums_Dir\n"; print " Output dir: $Output_Dir\n"; exit(0); } # flush target directory if (-d $Output_Dir) { rmtree($Output_Dir) or die "Can't remove directory '$Output_Dir': $!"; } mkpath($Output_Dir, 0, 0755) or die "Can't create directory '$Output_Dir}': $!"; print "Populating album tree...\n" if $opt_v; $Time = -time; populate($Tree, $Albums_Root); $Time += time; print "...completed in $Time second(s)\n" if $opt_v; print "Traversing album tree...\n" if $opt_v; $Time = -time; $Tree->traverse(\&traverse); create_root($Tree); $Time += time; print "...completed in $Time second(s)\n" if $opt_v; # subs ------------------------------------------------------------------------- sub populate { my $tree = shift; my $album_name = shift; push @Path, $album_name; foreach my $item (@{get_photos($album_name)}) { if ($item->{'isAlbumName'}) { my $album = get_album($item->{'isAlbumName'}); next if (defined($opt_d) and $opt_d <= $tree->getDepth and $album->{'fields'}->{'description'} eq ''); $tree->addChild(Tree::Simple->new(cook_album($item))); print " $item->{'isAlbumName'}\n" if $opt_v; } else { push @{$tree->getNodeValue->{'_photos'}}, cook_photo($item); } } foreach my $child ($tree->getAllChildren) { populate($child, $child->getNodeValue->{'_isAlbumName'}); } pop @Path; } sub traverse { my $tree = shift; return if (defined($opt_d) and $tree->getDepth <= $opt_d and $tree->getChildCount == 0); my $nv = $tree->getNodeValue; print " $nv->{'_isAlbumName'}\n" if $opt_v; # add current album to path my @path = @{$nv->{'_path'}}; push @path, $nv->{'_isAlbumName'}; # create output directory my $dir = join '/', $Output_Dir, @path; unless (-d $dir) { mkpath($dir, 0, 0755) or die "Can't create directory '$dir': $!"; } # clean up album description $nv->{'description'} =~ s/\r//g; $GEX::Template::title = $nv->{'title'}; $GEX::Template::name = $nv->{'name'}; $GEX::Template::description = $nv->{'description'}; $GEX::Template::minimal = $opt_m; @GEX::Template::path = @path; @GEX::Template::photos = $nv->{'_photos'} ? @{$nv->{'_photos'}} : (); @GEX::Template::albums = map {$_->getNodeValue} $tree->getAllChildren; my $output_file = join '/', $dir, 'index.html'; templify($Template, $output_file); copy_photos($nv->{'_isAlbumName'}, $nv->{'_photos'}, \@path); } sub create_root { my $tree = shift; my $nv = $tree->getNodeValue; print " ROOT\n" if $opt_v; my @path = ($Albums_Root); my $dir = join '/', $Output_Dir, @path; $GEX::Template::title = 'Pictures'; $GEX::Template::name = 'pictures'; $GEX::Template::description = 'ROOT'; $GEX::Template::minimal = $opt_m; @GEX::Template::path = @path; @GEX::Template::photos = $nv->{'_photos'} ? @{$nv->{'_photos'}} : (); @GEX::Template::albums = $tree->getAllChildren; if (defined($opt_d)) { @GEX::Template::albums = grep {$_->getChildCount > 0} @GEX::Template::albums; } @GEX::Template::albums = map {$_->getNodeValue} @GEX::Template::albums; %GEX::Template::highligts = (); foreach my $album (@GEX::Template::albums) { foreach my $item (@{get_photos($album->{name})}) { push @{$GEX::Template::highligts{$album->{name}}}, cook_photo($item); } } # print Dumper(\%GEX::Template::highligts); my $output_file = join '/', $dir, 'index.html'; templify($Template, $output_file); copy_photos($Albums_Root, $nv->{'_photos'}, \@path); copy_highlights($Albums_Root, \%GEX::Template::highligts, \@path); } # clean up data from album.dat sub cook_album { my $item = shift; my $album = get_album($item->{'isAlbumName'}); return { _path => [@Path], _isAlbumName => $item->{'isAlbumName'}, _highlight => $item->{'highlight'}, _highlightImage => $item->{'highlightImage'}, name => $album->{'fields'}->{'name'}, title => $album->{'fields'}->{'title'}, description => $album->{'fields'}->{'description'}, cached_photo_count => $album->{'fields'}->{'cached_photo_count'} }; } # clean up data from photos.dat sub cook_photo { my $item = shift; return { _highlight => $item->{'highlight'}, thumbnail => { name => $item->{'thumbnail'}->{'name'}, type => $item->{'thumbnail'}->{'type'}, width => $item->{'thumbnail'}->{'width'}, height => $item->{'thumbnail'}->{'height'} }, image => { name => $item->{'image'}->{'name'}, resizedName => $item->{'image'}->{'resizedName'}, type => $item->{'image'}->{'type'}, width => $item->{'image'}->{'width'}, height => $item->{'image'}->{'height'}, raw_width => $item->{'image'}->{'raw_width'}, raw_height => $item->{'image'}->{'raw_height'} }, highlightImage => $item->{'highlightImage'} ? { name => $item->{'highlightImage'}->{'name'}, type => $item->{'highlightImage'}->{'type'}, width => $item->{'highlightImage'}->{'width'}, height => $item->{'highlightImage'}->{'height'} } : undef }; } sub copy_photo { my $photo_name = shift; my $album_name = shift; my $path = shift; my $source = join '/', $Albums_Dir, $album_name, $photo_name; my $target = join '/', $Output_Dir, @$path, $photo_name; copy($source, $target) or die "Can't copy '$source' to '$target': $!"; } # Copy photos from album directory to target directory. $photos must be a # reference to an array of photo objects and $path must be a reference to the # array containing the current path. sub copy_photos { my $album_name = shift; my $photos = shift; my $path = shift; foreach my $photo (@$photos) { # copy thumbnail copy_photo( join('.', $photo->{'thumbnail'}->{'name'}, $photo->{'thumbnail'}->{'type'}), $album_name, $path ); # copy full sized image if no resized image exists if (!$photo->{'image'}->{'resizedName'}) { copy_photo( join('.', $photo->{'image'}->{'name'}, $photo->{'image'}->{'type'}), $album_name, $path ); } else { copy_photo( join('.', $photo->{'image'}->{'resizedName'}, $photo->{'image'}->{'type'}), $album_name, $path ); unless ($opt_m) { copy_photo( join('.', $photo->{'image'}->{'name'}, $photo->{'image'}->{'type'}), $album_name, $path ); } } # copy highlight image if ($photo->{'highlightImage'}) { copy_photo( join('.', $photo->{'highlightImage'}->{'name'}, $photo->{'highlightImage'}->{'type'}), $album_name, $path ); } } } sub copy_highlights { my $album_name = shift; my $highlights = shift; my $path = shift; my $highlight = 'NONE'; foreach my $key (keys %$highlights) { foreach my $item ( @{$GEX::Template::highligts{$key}} ) { if (defined($item->{_highlight}) and $item->{_highlight} == 1) { print "\t" . $item->{highlightImage}->{name} . "\n"; $highlight = $item; last; } } my $image = join '.', $highlight->{highlightImage}->{name}, $highlight->{highlightImage}->{type}; my $source = join '/', $Albums_Dir, $key, $image; my $target = join '/', $Output_Dir, 'selfinjury', $key, $image; copy($source, $target) or warn "Can't copy '$source' to '$target': $!"; } } # Returns data from C. { my %cache; sub get_album { my $album = shift; my $file = join '/', $Albums_Dir, $album, 'album.dat'; return $cache{$file} if $cache{$file}; die "Can't read data for '$album' (album.dat): No such album\n" unless -e $file; $cache{$file} = unserialize_file($file); return $cache{$file}; } } # Returns data from C. { my %cache; sub get_photos { my $album = shift; my $file = join '/', $Albums_Dir, $album, 'photos.dat'; return $cache{$file} if $cache{$file}; die "Can't read data for '$album' (photos.dat): No such album\n" unless -e $file; $cache{$file} = unserialize_file($file); return $cache{$file}; } } # Returns unserialized data from $file. sub unserialize_file { my $file = shift; local $/; open(IN, $file) or die "Can't open file '$file': $!"; binmode IN; my $data = unserialize(); #FIXME: error handling if file doesn't contain serialized data close(IN); return $data; } # Creates a new template object from $template_file, fills it in with the # variables from C and writes the result to $output_file. sub templify { my $source = shift; my $output = shift; # create new template object my $template = Text::Template->new( TYPE => 'FILE', SOURCE => $source ) or die "$Text::Template::ERROR"; # fill in template and write result to target file open(OUT, ">$output") or die "Can't open '$output': $!"; $template->fill_in( PACKAGE => 'GEX::Template', OUTPUT => \*OUT ) or die "$Text::Template::ERROR"; close(OUT); } sub usage { return < C C =head1 AUTHOR Morten Wulff, =head1 COPYRIGHT Copyright 2004, Morten Wulff This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. =cut