X-Git-Url: http://www.average.org/gitweb/?p=mkgallery.git;a=blobdiff_plain;f=mkgallery.pl;h=8bed35cb1d594efd3fdb17cb7703751757ddb198;hp=a0cb8eebef6089317ae33056ddfef89ca91737e7;hb=HEAD;hpb=c1251ffd78703170ddd2fd6e2d14959f64679da0;ds=sidebyside diff --git a/mkgallery.pl b/mkgallery.pl index a0cb8ee..8bed35c 100755 --- a/mkgallery.pl +++ b/mkgallery.pl @@ -1,12 +1,12 @@ #!/usr/bin/perl -# $Id$ +my $version='$Id$'; # Recursively create image gallery index and slideshow wrappings. -# Makes use of (slightly modified) "lightbox" Javascript/CSS as published -# at http://www.huddletogether.com/projects/lightbox/ +# Makes use of modified "slideshow" javascript by Samuel Birch +# http://www.phatfusion.net/slideshow/ -# Copyright (c) 2006 Eugene G. Crosser +# Copyright (c) 2006-2013 Eugene G. Crosser # This software is provided 'as-is', without any express or implied # warranty. In no event will the authors be held liable for any damages @@ -29,29 +29,64 @@ package FsObj; use strict; use Carp; use POSIX qw/getcwd strftime/; -use CGI qw/:html *table *Tr *center *div/; +use HTTP::Date; +use CGI qw/:html *table *Tr *td *center *div *Link/; use Image::Info qw/image_info dim/; use Term::ReadLine; use Getopt::Long; +use Encode; +use UUID; +use utf8; +binmode(STDOUT, ":utf8"); -use Image::Magick; +my $haveimagick = eval { require Image::Magick; }; +{ package Image::Magick; } # to make perl compiler happy -my @sizes = (160, 640); +my $havegeoloc = eval { require Image::ExifTool::Location; }; +{ package Image::ExifTool::Location; } # to make perl compiler happy + +my @sizes = (160, 640, 1600); +my $incdir = ".gallery2"; ###################################################################### +my $incpath; my $debug = 0; my $asktitle = 0; my $noasktitle = 0; -GetOptions('asktitle'=>\$asktitle, +charset("utf-8"); + +unless (GetOptions( + 'help'=>\&help, + 'incpath'=>\$incpath, + 'asktitle'=>\$asktitle, 'noasktitle'=>\$noasktitle, - 'debug'=>\$debug); + 'debug'=>\$debug)) { + &help; +} my $term = new Term::ReadLine "Edit Title"; +binmode($term->IN, ':utf8'); FsObj->new(getcwd)->iterate; +sub help { + + print STDERR <<__END__; +usage: $0 [options] + --help: print help message and exit + --incpath: do not try to find .gallery2 directory upstream, use + specified path (absolute or relavive). Use with causion. + --debug: print a lot of debugging info to stdout as you run + --asktitle: ask to edit album titles even if there are ".title" files + --noasktitle: don't ask to enter album titles even where ".title" + files are absent. Use partial directory names as titles. +__END__ + + exit 1; +} + sub new { my $this = shift; my $class; @@ -60,12 +95,14 @@ sub new { $class = ref($this); my $parent = $this; my $name = shift; - my $fullpath = $parent->{-fullpath}.'/'.$name; $self = { -parent=>$parent, -root=>$parent->{-root}, + -toppath=>$parent->{-toppath}, + -depth=>$parent->{-depth}+1, -base=>$name, - -fullpath=>$fullpath, + -fullpath=>$parent->{-fullpath}.'/'.$name, + -relpath=>$parent->{-relpath}.$name.'/', -inc=>'../'.$parent->{-inc}, }; } else { @@ -74,8 +111,9 @@ sub new { $self = { -root=>$root, -fullpath=>$root, - -inc=>getinc($root), }; + # fill in -inc, -relpath + initpaths($self); # we are not blessed yet, so cheat. } bless $self, $class; if ($debug) { @@ -87,19 +125,46 @@ sub new { return $self; } -sub getinc { - my $fullpath=shift; # this is not a method +sub initpaths { + my $self=shift; # this is not a method but we cheat my $depth=20; # arbitrary max depth + my $fullpath=$self->{-fullpath}; + my $inc; + my $relpath; - my $inc=".include"; - while ( ! -d $fullpath."/".$inc ) { - $inc = "../".$inc; - last unless ($depth-- > 0); + if ($incpath) { + $inc = $incpath; + $inc .= '/' unless ($inc =~ m%/$%); + } else { + $inc=""; + while ( ! -d $fullpath."/".$inc."/".$incdir ) { + $inc = "../".$inc; + last unless ($depth-- > 0); + } } if ($depth > 0) { - return $inc.'/'; # prefix with trailing slash + $self->{-inc} = $inc; + my $dp=0; + my $pos; + for ($pos=index($inc,'/');$pos>=0; + $pos=index($inc,'/',$pos+1)) { + $dp++; + } + $self->{-depth} = $dp; + for ($pos=length($fullpath);$dp>0 && $pos>0; + $pos=rindex($fullpath,'/',$pos-1)) { + $dp--; + } + my $relpath = substr($fullpath,$pos); + $relpath =~ s%^/%%; + $relpath .= '/' if ($relpath); + $self->{-relpath} = $relpath; + $self->{-toppath} = substr($fullpath,0,$pos); + #print "rel=$relpath, top=$self->{-toppath}, inc=$inc\n"; } else { - return 'NO-.INCLUDE-IN-PATH/'; # won't work anyway + $self->{-inc} = 'NO-.INCLUDE-IN-PATH/'; # won't work anyway + $self->{-relpath} = ''; + $self->{-depth} = 0; } } @@ -119,11 +184,11 @@ sub iterate { while (my $de = readdir($D)) { next if ($de =~ /^\./); my $child = $self->new($de); + my @stat = stat($child->{-fullpath}); + $youngest = $stat[9] if ($youngest < $stat[9]); if ($child->isdir) { push(@rdirlist,$child); } elsif ($child->isimg) { - my @stat = stat($child->{-fullpath}); - $youngest = $stat[9] if ($youngest < $stat[9]); push(@rimglist,$child); } } @@ -147,12 +212,6 @@ sub iterate { $dir->iterate; } -# no need to go beyond this point if the directory timestamp did not -# change since we built index.html file last time. - - my @istat = stat($self->{-fullpath}.'/index.html'); - return unless ($youngest > $istat[9]); - # 3. iterate through images to build cross-links, my $previmg = undef; @@ -178,6 +237,12 @@ sub iterate { $img->makeaux; } +# no need to go beyond this point if the directory timestamp did not +# change since we built index.html file last time. + + my @istat = stat($self->{-fullpath}.'/index.html'); + return unless ($youngest > $istat[9]); + # 5. start building index.html for the directory $self->startindex; @@ -217,6 +282,16 @@ sub isimg { my $self = shift; my $fullpath = $self->{-fullpath}; return 0 unless ( -f $fullpath ); + + if ($havegeoloc) { + my $exif = new Image::ExifTool; + $exif->ExtractInfo($fullpath); + my ($la,$lo) = $exif->GetLocation(); + if ($la && $lo) { + $self->{-geoloc} = [$la,$lo]; + } + } + my $info = image_info($fullpath); if (my $error = $info->{error}) { if (($error !~ "Unrecognized file format") && @@ -282,28 +357,37 @@ sub edittitle { my $self = shift; my $fullpath = $self->{-fullpath}; my $title; + my $titleimage; my $T; - if (open($T,'<'.$fullpath.'/.title')) { + my $TI; + if (open($T,'<:encoding(utf8)', $fullpath.'/.title')) { $title = <$T>; $title =~ s/[\r\n]*$//; close($T); } if ($asktitle || (!$title && !$noasktitle)) { - my $prompt = $self->{-base}; + my $prompt = $self->{-relpath}; $prompt = '/' unless ($prompt); my $OUT = $term->OUT || \*STDOUT; print $OUT "Enter title for $fullpath\n"; $title = $term->readline($prompt.' >',$title); $term->addhistory($title) if ($title); - if (open($T,'>'.$fullpath.'/.title')) { + if (open($T,'>:encoding(utf8)', $fullpath.'/.title')) { print $T $title,"\n"; close($T); } } unless ($title) { - $title=substr($fullpath,length($self->{-root})); + $title=$self->{-relpath}; } $self->{-title}=$title; + if (open($TI,'<:encoding(utf8)', $fullpath.'/.titleimage')) { + $titleimage = <$TI>; + $titleimage =~ s/[\r\n]*$//; + close($TI); + #print STDERR "found title image \"",$titleimage,"\"\n"; + $self->{-titleimage}=$titleimage; + } print "title in $fullpath is $title\n" if ($debug); } @@ -320,9 +404,12 @@ sub makescaled { my $nfn = $dn.'/'.$nref; my $factor=$size/$max; if ($factor >= 1) { - $self->{$size} = $name; # unscaled version will do + $self->{$size}->{'url'} = $name; # unscaled version + $self->{$size}->{'dim'} = [$w, $h]; } else { - $self->{$size} = $nref; + $self->{$size}->{'url'} = $nref; + $self->{$size}->{'dim'} = [int($w*$factor+.5), + int($h*$factor+.5)]; if (isnewer($fn,$nfn)) { doscaling($fn,$nfn,$factor,$w,$h); } @@ -340,19 +427,23 @@ sub isnewer { sub doscaling { my ($src,$dest,$factor,$w,$h) = @_; # this is not a method - my $im = new Image::Magick; - my $err; - print "doscaling $src -> $dest by $factor\n" if ($debug); - $err = $im->Read($src); - unless ($err) { - $im->Scale(width=>$w*$factor,height=>$h*$factor); - $err=$im->Write($dest); - warn "ImageMagick: write \"$dest\": $err" if ($err); - } else { # fallback to command-line tools - warn "ImageMagick: read \"$src\": $err"; + + my $err=1; + if ($haveimagick) { + my $im = new Image::Magick; + print "doscaling $src -> $dest by $factor\n" if ($debug); + if ($err = $im->Read($src)) { + warn "ImageMagick: read \"$src\": $err"; + } else { + $im->Scale(width=>$w*$factor,height=>$h*$factor); + $err=$im->Write($dest); + warn "ImageMagick: write \"$dest\": $err" if ($err); + } + undef $im; + } + if ($err) { # fallback to command-line tools system("djpeg \"$src\" | pnmscale \"$factor\" | cjpeg >\"$dest\""); } - undef $im; } sub makeaux { @@ -361,17 +452,17 @@ sub makeaux { my $dn = $self->{-parent}->{-fullpath}; my $pref = $self->{-previmg}->{-base}; my $nref = $self->{-nextimg}->{-base}; - my $inc = $self->{-inc}; + my $inc = $self->{-inc}.$incdir.'/'; my $title = $self->{-info}->{'Comment'}; $title = $name unless ($title); - print "slide: \"$pref\"->\"$name\"->\"$nref\"\n" if ($debug); + print "slide: \"$title\": \"$pref\"->\"$name\"->\"$nref\"\n" if ($debug); # slideshow for my $refresh('static', 'slide') { my $fn = sprintf("%s/.html/%s-%s.html",$dn,$name,$refresh); if (isnewer($self->{-fullpath},$fn)) { - my $imgsrc = '../'.$self->{$sizes[1]}; + my $imgsrc = '../'.$self->{$sizes[1]}->{'url'}; my $fwdref; my $bakref; if ($nref) { @@ -394,37 +485,41 @@ sub makeaux { $toggletext = 'Play->'; } my $F; - unless (open($F,'>'.$fn)) { + unless (open($F,'>:encoding(utf8)', $fn)) { warn "cannot open \"$fn\": $!"; next; } if ($refresh eq 'slide') { print $F start_html( + -encoding=>"utf-8", -title=>$title, -bgcolor=>"#808080", -head=>meta({-http_equiv=>'Refresh', -content=>"3; url=$fwdref"}), -style=>{-src=>$inc."gallery.css"}, - ),"\n"; + ),"\n", + comment("Created by ".$version),"\n"; } else { print $F start_html(-title=>$title, + -encoding=>"utf-8", -bgcolor=>"#808080", -style=>{-src=>$inc."gallery.css"}, - ),"\n"; + ),"\n", + comment("Created by ".$version),"\n"; } - print $F start_center,"\n", - h1($title),"\n", - start_table({-class=>'navi'}),start_Tr,"\n", + print $F start_table({-class=>'navi'}),start_Tr,"\n", td(a({-href=>"../index.html"},"Index")),"\n", td(a({-href=>$bakref},"<<Prev")),"\n", td(a({-href=>$toggleref},$toggletext)),"\n", td(a({-href=>$fwdref},"Next>>")),"\n", + td({-class=>'title'},$title),"\n", end_Tr, end_table,"\n", - table({-class=>'picframe'}, - Tr(td(img({-src=>$imgsrc})))),"\n", - end_center,"\n", + center(table({-class=>'picframe'}, + Tr(td(img({-src=>$imgsrc, + -class=>'standalone', + -alt=>$title}))))),"\n", end_html,"\n"; close($F); } @@ -434,19 +529,29 @@ sub makeaux { my $fn = sprintf("%s/.html/%s-info.html",$dn,$name); if (isnewer($self->{-fullpath},$fn)) { my $F; - unless (open($F,'>'.$fn)) { + unless (open($F,'>:encoding(utf8)', $fn)) { warn "cannot open \"$fn\": $!"; return; } my $imgsrc = sprintf("../.%s/%s",$sizes[0],$name); print $F start_html(-title=>$title, - -style=>{-src=>$inc."gallery.css"},),"\n", + -encoding=>"utf-8", + -style=>{-src=>$inc."gallery.css"}, + -script=>[ + {-src=>$inc."mootools.js"}, + {-src=>$inc."urlparser.js"}, + {-src=>$inc."infopage.js"}, + ]),"\n", + comment("Created by ".$version),"\n", start_center,"\n", h1($title),"\n", table({-class=>'ipage'}, - Tr(td(img({-src=>$imgsrc})), + Tr(td(img({-src=>$imgsrc, + -class=>'thumbnail', + -alt=>$title})), td($self->infotable))), - a({-href=>'../index.html'},'Index'),"\n", + a({-href=>'../index.html',-class=>'conceal'}, + 'Index'),"\n", end_center,"\n", end_html,"\n"; close($F); @@ -459,31 +564,92 @@ sub startindex { my $block = $self->{-fullpath}.'/.noindex'; $fn = '/dev/null' if ( -f $block ); my $IND; - unless (open($IND,'>'.$fn)) { + unless (open($IND,'>:encoding(utf8)', $fn)) { warn "cannot open $fn: $!"; return; } $self->{-IND} = $IND; - my $inc = $self->{-inc}; + my $inc = $self->{-inc}.$incdir.'/'; my $title = $self->{-title}; + my $titleimage = $self->{-titleimage}; print $IND start_html(-title => $title, - -style=>{-src=>[$inc."gallery.css", - $inc."lightbox.css"]}, - -script=>[{-code=>"var incPrefix='$inc';"}, + -encoding=>"utf-8", + -style=>[ + {-src=>$inc."gallery.css"}, + {-src=>$inc."custom.css"}, + ], + -script=>[ + {-src=>$inc."mootools.js"}, + {-src=>$inc."overlay.js"}, + {-src=>$inc."urlparser.js"}, + {-src=>$inc."multibox.js"}, + {-src=>$inc."showwin.js"}, + {-src=>$inc."controls.js"}, + {-src=>$inc."show.js"}, {-src=>$inc."gallery.js"}, - {-src=>$inc."lightbox.js"}]), - a({-href=>"../index.html"},"UP"),"\n", - start_center,"\n", - h1($title),"\n", + ]),"\n", + comment("Created by ".$version),"\n", + start_div({-class => 'indexContainer', + -id => 'indexContainer'}), "\n"; + my $EVL; + if (open($EVL, '<:encoding(utf8)', $self->{-toppath}.'/'.$incdir.'/header.pl')) { + my $prm; + while (<$EVL>) { + $prm .= $_; + } + close($EVL); + %_ = ( + -version => $version, + -depth => $self->{-depth}, + -title => $title, + -titleimage => $titleimage, + -path => $self->{-fullpath}, + -breadcrumbs => "breadcrumbs unimplemented", + ); + print $IND eval $prm,"\n"; + } else { + print STDERR "could not open ", + $self->{-toppath}.'/'.$incdir.'/header.pl', + " ($!), reverting to default header"; + print $IND a({-href=>"../index.html"},"UP"),"\n"; + if ($titleimage) { + print $IND img({-src=>$titleimage, + -class=>'titleimage', + -alt=>'Title Image'}),"\n"; + } + print $IND h1({-class=>'title'},$title), + br({-clear=>'all'}),"\n"; + } } sub endindex { my $self = shift; my $IND = $self->{-IND}; - print $IND end_center,end_html,"\n"; + print $IND end_div; + my $EVL; + if (open($EVL, '<:encoding(utf8)', $self->{-toppath}.'/'.$incdir.'/footer.pl')) { + my $prm; + while (<$EVL>) { + $prm .= $_; + } + close($EVL); + %_ = ( + -version => $version, + -depth => $self->{-depth}, + -title => $self->{-title}, + -titleimage => $self->{-titleimage}, + -breadcrumbs => "breadcrumbs unimplemented", + ); + print $IND eval $prm,"\n"; + } else { + print STDERR "could not open ", + $self->{-toppath}.'/'.$incdir.'/footer.pl', + " ($!), reverting to default empty footer"; + } + print $IND end_html,"\n"; close($IND) if ($IND); undef $self->{-IND}; @@ -493,7 +659,7 @@ sub startsublist { my $self = shift; my $IND = $self->{-IND}; - print $IND h2("Albums"),"\n",start_table,"\n"; + print $IND h2({-class=>"atitle"},"Albums"),"\n",start_table,"\n"; } sub sub_entry { @@ -502,6 +668,7 @@ sub sub_entry { my $name = $self->{-base}; my $title = $self->{-title}; + $self->{-parent}->{-numofsubs}++; print $IND Tr(td(a({-href=>$name.'/index.html'},$name)), td(a({-href=>$name.'/index.html'},$title))),"\n"; } @@ -519,9 +686,9 @@ sub startimglist { my $first = $self->{-firstimg}->{-base}; my $slideref = sprintf(".html/%s-slide.html",$first); - print $IND h2("Images"),"\n", - a({-href=>$slideref},'Slideshow'), - "\n"; + print $IND h2({-class=>"ititle"},"Images ", + a({-href=>$slideref,-class=>'showStart',-rel=>'i'.$first}, + '> slideshow')),"\n"; } sub img_entry { @@ -530,31 +697,52 @@ sub img_entry { my $name = $self->{-base}; my $title = $self->{-info}->{'Comment'}; $title = $name unless ($title); - my $thumb = $self->{$sizes[0]}; - my $medium = $self->{$sizes[1]}; + my $thumb = $self->{$sizes[0]}->{'url'}; my $info = $self->{-info}; my ($w, $h) = dim($info); - print $IND start_div({-class=>'ibox',-id=>$name, - -OnClick=>"HideIbox('$name');"}),"\n", - start_div({-class=>'iboxtitle'}), - span({-style=>'float: left;'},b("Info for $name")), - span({-style=>'float: right;'}, - a({-href=>"#",-OnClick=>"HideIbox('$name');"},"Close")), - br({-clear=>'all'}),"\n", - end_div,"\n", - $self->infotable, - end_div,"\n"; - - print $IND table({-class=>'slide'},Tr(td( - a({-href=>".html/$name-info.html",-title=>'Image Info', - -onClick=>"return showIbox('$name');"},$title), - br, - a({-href=>$medium,-rel=>"lightbox",-title=>$title}, - img({-src=>$thumb})), - br, - a({-href=>$name,-title=>'Original Image'},"($w x $h)"), - br))),"\n"; + my $i=0+$self->{-parent}->{-numofimgs}; + $self->{-parent}->{-numofimgs}++; + + print $IND a({-name=>$name}),"\n", + start_table({-class=>'slide'}),start_Tr,start_td,"\n"; + print $IND div({-class=>'slidetitle'}, + "\n ",a({-href=>".html/$name-info.html", + -title=>'Image Info: '.$name, + -class=>'infoBox'}, + $title),"\n"),"\n", + start_div({-class=>'slideimage'}); + if ($self->{-geoloc}) { + my ($la,$lo) = @{$self->{-geoloc}}; + print $IND a({-href=>"http://maps.google.com/". + "?q=$la,$lo&ll=$la,$lo", + -title=>"$la,$lo", + -class=>'geoloc'}, + div({-class=>'geoloc'},"")),"\n"; + } + print $IND a({-href=>".html/$name-static.html", + -title=>$title, + -class=>'showImage', + -rel=>'i'.$name}, + img({-src=>$thumb, + -class=>'thumbnail', + -alt=>$title})),"\n",end_div, + start_div({-class=>'varimages',-id=>'i'.$name,-title=>$title}),"\n"; + foreach my $sz(@sizes) { + my $src=$self->{$sz}->{'url'}; + my $w=$self->{$sz}->{'dim'}->[0]; + my $h=$self->{$sz}->{'dim'}->[1]; + print $IND " ",a({-href=>$src, + -class=>"conceal", + -rel=>$w."x".$h, + -title=>"Reduced to ".$w."x".$h}, + $w."x".$h)," \n"; + } + print $IND " ",a({-href=>$name, + -rel=>$w."x".$h, + -title=>'Original'},$w."x".$h), + "\n",end_div,"\n", + end_td,end_Tr,end_table,"\n"; } sub endimglist {