X-Git-Url: http://www.average.org/gitweb/?p=mkgallery.git;a=blobdiff_plain;f=mkgallery.pl;h=8bed35cb1d594efd3fdb17cb7703751757ddb198;hp=53b9c9ad809ae91fb57afe18164b2403b4b39668;hb=HEAD;hpb=95901ea203be37209c5ac2cadc685826a109026d;ds=sidebyside diff --git a/mkgallery.pl b/mkgallery.pl index 53b9c9a..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 @@ -28,30 +28,65 @@ package FsObj; use strict; use Carp; -use POSIX qw/getcwd/; -use CGI qw/:html *table *center *div/; +use POSIX qw/getcwd strftime/; +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; } } @@ -108,6 +173,7 @@ sub iterate { my $fullpath .= $self->{-fullpath}; print "iterate in dir $fullpath\n" if ($debug); + my $youngest=0; my @rdirlist; my @rimglist; my $D; @@ -118,6 +184,8 @@ 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) { @@ -129,6 +197,7 @@ sub iterate { undef @rdirlist; # inplace sorting would be handy here my @imglist = sort {$a->{-base} cmp $b->{-base}} @rimglist; undef @rimglist; # optimize away unsorted versions + $self->{-firstimg} = $imglist[0]; print "Dir: $self->{-fullpath}\n" if ($debug); @@ -144,25 +213,41 @@ sub iterate { } # 3. iterate through images to build cross-links, -# create scaled versions and aux htmls my $previmg = undef; foreach my $img(@imglist) { + # list-linking must be done before generating + # aux html because aux pages rely on prev/next refs if ($previmg) { $previmg->{-nextimg} = $img; $img->{-previmg} = $previmg; } $previmg=$img; + } + +# 4. create scaled versions and aux html pages + foreach my $img(@imglist) { + # scaled versions must be generated before aux html + # and main image index because they both rely on + # refs to scaled images and they may be just original + # images, this is not known before we try scaling. $img->makescaled; + # finally, make aux html pages $img->makeaux; } -# 4. start building index.html for the directory +# 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; -# 5. iterate through subdirectories to build subalbums list +# 6. iterate through subdirectories to build subalbums list if (@dirlist) { $self->startsublist; @@ -172,7 +257,7 @@ sub iterate { $self->endsublist; } -# 6. iterate through images to build thumb list +# 7. iterate through images to build thumb list if (@imglist) { $self->startimglist; @@ -183,7 +268,7 @@ sub iterate { $self->endimglist; } -# 7. comlplete building index.html for the directory +# 8. comlplete building index.html for the directory $self->endindex; } @@ -197,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") && @@ -205,11 +300,49 @@ sub isimg { } return 0; } + + tryapp12($info) unless ($info->{'ExifVersion'}); + $self->{-isimg} = 1; $self->{-info} = $info; return 1; } +sub tryapp12 { + my $info = shift; # this is not a method + my $app12; + # dirty hack to take care of Image::Info parser strangeness + foreach my $k(keys %$info) { + $app12=substr($k,6).$info->{$k} if ($k =~ /^App12-/); + } + return unless ($app12); # bad luck + my $seenfirstline=0; + foreach my $ln(split /[\r\n]+/,$app12) { + $ln =~ s/[[:^print:]\000]/ /g; + unless ($seenfirstline) { + $seenfirstline=1; + $info->{'Make'}=$ln; + next; + } + my ($k,$v)=split /=/,$ln,2; + if ($k eq 'TimeDate') { + $info->{'DateTime'} = + strftime("%Y:%m:%d %H:%M:%S", localtime($v)) + unless ($v < 0); + } elsif ($k eq 'Shutter') { + $info->{'ExposureTime'} = '1/'.int(1000000/$v+.5); + } elsif ($k eq 'Flash') { + $info->{'Flash'} = $v?'Flash fired':'Flash did not fire'; + } elsif ($k eq 'Type') { + $info->{'Model'} = $v; + } elsif ($k eq 'Version') { + $info->{'Software'} = $v; + } elsif ($k eq 'Fnumber') { + $info->{'FNumber'} = $v; + } + } +} + sub initdir { my $self = shift; my $fullpath = $self->{-fullpath}; @@ -224,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); } @@ -258,47 +400,256 @@ sub makescaled { my $max = ($w > $h)?$w:$h; foreach my $size(@sizes) { - my $nfn = $dn.'/.'.$size.'/'.$name; + my $nref = '.'.$size.'/'.$name; + my $nfn = $dn.'/'.$nref; my $factor=$size/$max; + if ($factor >= 1) { + $self->{$size}->{'url'} = $name; # unscaled version + $self->{$size}->{'dim'} = [$w, $h]; + } else { + $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); + } + } + } +} + +sub isnewer { + my ($fn1,$fn2) = @_; # this is not a method + my @stat1=stat($fn1); + my @stat2=stat($fn2); + return (!@stat2 || ($stat1[9] > $stat2[9])); + # true if $fn2 is absent or is older than $fn1 +} + +sub doscaling { + my ($src,$dest,$factor,$w,$h) = @_; # this is not a method + + 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\""); } } sub makeaux { my $self = shift; - my $fn = $self->{-fullpath}; my $name = $self->{-base}; my $dn = $self->{-parent}->{-fullpath}; + my $pref = $self->{-previmg}->{-base}; + my $nref = $self->{-nextimg}->{-base}; + my $inc = $self->{-inc}.$incdir.'/'; + my $title = $self->{-info}->{'Comment'}; + $title = $name unless ($title); + + 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]}->{'url'}; + my $fwdref; + my $bakref; + if ($nref) { + $fwdref = sprintf("%s-%s.html",$nref,$refresh); + } else { + $fwdref = '../index.html'; + } + if ($pref) { + $bakref = sprintf("%s-%s.html",$pref,$refresh); + } else { + $bakref = '../index.html'; + } + my $toggleref; + my $toggletext; + if ($refresh eq 'slide') { + $toggleref=sprintf("%s-static.html",$name); + $toggletext = 'Stop!'; + } else { + $toggleref=sprintf("%s-slide.html",$name); + $toggletext = 'Play->'; + } + my $F; + 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", + comment("Created by ".$version),"\n"; + + } else { + print $F start_html(-title=>$title, + -encoding=>"utf-8", + -bgcolor=>"#808080", + -style=>{-src=>$inc."gallery.css"}, + ),"\n", + comment("Created by ".$version),"\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", + center(table({-class=>'picframe'}, + Tr(td(img({-src=>$imgsrc, + -class=>'standalone', + -alt=>$title}))))),"\n", + end_html,"\n"; + close($F); + } + } + + # info html + my $fn = sprintf("%s/.html/%s-info.html",$dn,$name); + if (isnewer($self->{-fullpath},$fn)) { + my $F; + 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, + -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, + -class=>'thumbnail', + -alt=>$title})), + td($self->infotable))), + a({-href=>'../index.html',-class=>'conceal'}, + 'Index'),"\n", + end_center,"\n", + end_html,"\n"; + close($F); + } } sub startindex { my $self = shift; my $fn = $self->{-fullpath}.'/index.html'; + 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}; @@ -308,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 { @@ -317,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"; } @@ -331,16 +683,66 @@ sub endsublist { sub startimglist { my $self = shift; my $IND = $self->{-IND}; + my $first = $self->{-firstimg}->{-base}; + my $slideref = sprintf(".html/%s-slide.html",$first); - print $IND h2("Images"),"\n"; + print $IND h2({-class=>"ititle"},"Images ", + a({-href=>$slideref,-class=>'showStart',-rel=>'i'.$first}, + '> slideshow')),"\n"; } sub img_entry { my $self = shift; my $IND = $self->{-parent}->{-IND}; my $name = $self->{-base}; - - print $IND a({-href=>$name},$name),"\n"; + my $title = $self->{-info}->{'Comment'}; + $title = $name unless ($title); + my $thumb = $self->{$sizes[0]}->{'url'}; + my $info = $self->{-info}; + my ($w, $h) = dim($info); + + 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 { @@ -350,224 +752,10 @@ sub endimglist { print $IND br({-clear=>'all'}),hr,"\n\n"; } -###################################################################### -=cut -###################################################################### - -&processdir(getcwd); - -sub processdir { - my ($start,$dir)=@_; - my $dn=$start; - $dn .= "/".$dir if ($dir); - unless ( -d $dn ) { - warn "not a directory: $dn"; - return; - } - my $D; - unless (opendir($D,$dn)) { - warn "cannot opendir $dn: $!"; - return; - } - -# recurse into subdirectories BEFORE opening index file - - &iteratedir($D,$start,$dir,sub { - my ($start,$dir,$base)=@_; - my $ndir = $dir; - $ndir .= "/" if ($ndir); - $ndir .= $base; - return unless ( -d $start."/".$ndir ); - &processdir($start,$ndir); - }); - -# fill in title - - my $title=&gettitle($dn,$dir); - -# get include prefix - - my $inc=&getinclude($dn); - -# generate directory index unless suppressed - - if ( -e $dn."/.noindex" ) { - open(STDOUT,">/dev/null"); - } else { - open(STDOUT,">".$dn."/index.html"); - } - -# write HTML header - - -style=>{-src=>[$inc."gallery.css", - $inc."lightbox.css"]}, - -script=>[{-code=>"var incPrefix='$inc';"}, - {-src=>$inc."gallery.js"}, - {-src=>$inc."lightbox.js"}]),"\n"; - print a({-href=>"../index.html"},"UP"); - print start_center,"\n"; - print h1($title),"\n"; - -# create list of sub-albums - - my $hassubdirs=0; - &iteratedir($D,$start,$dir,sub { - my ($start,$dir,$base)=@_; - my $en=sprintf("%s/%s/%s",$start,$dir,$base); - return unless ( -d $en ); - unless ($hassubdirs) { - print hr,h2("Albums"),start_table,"\n"; - $hassubdirs=1; - } - &subalbum($base,&gettitle($en,$dir."/".$base)); - }); - print end_table,hr,"\n" if ($hassubdirs); - -# create picture gallery - - my @piclist=(); - my @infolist=(); - - my $haspics=0; - &iteratedir($D,$start,$dir,sub { - my ($start,$dir,$base)=@_; - my $en=sprintf("%s/%s/%s",$start,$dir,$base); - return unless ( -f $en ); - my $info = image_info($en); - if (my $error = $info->{error}) { - if (($error !~ "Unrecognized file format") && - ($error !~ "Can't read head")) { - print STDERR "File \"$en\": $error\n"; - } - return; - } - if (&processfile($start,$dir,$base,$en,$info)) { - $haspics=1; - push(@piclist,$base); - push(@infolist,$info); - } - }); - -# write HTML footer - - print br({-clear=>"all"}),"\n"; - print a({-href=>".html/".$piclist[0]."-slide.html"},"Slideshow"); - print hr,"\n" if ($haspics); - print end_center,"\n"; - print end_html,"\n"; - - close(STDOUT); - closedir($D); - -# generate html files for slideshow from @piclist - - for (my $i=0;$i<=$#piclist;$i++) { - my $base=$piclist[$i]; - my $pbase; - my $nbase; - $pbase=$piclist[$i-1] if ($i>0); - $nbase=$piclist[$i+1] if ($i<$#piclist); - for my $refresh('static','slide') { - &mkauxfile($start,$dir,$pbase,$base,$nbase, - $refresh,$infolist[$i]); - } - } - -} - -############################################################# -# helper functions -############################################################# - -sub iteratedir { - my ($D,$start,$dir,$prog)=@_; - my @list=(); - while (my $de=readdir($D)) { - next if ($de =~ /^\./); - push(@list,$de); - } - foreach my $de(sort @list) { - &$prog($start,$dir,$de); - } - rewinddir($D); -} - -sub getinclude { - my ($dn)=@_; - - my $depth=20; - my $str=""; - #print STDERR "start include ",$dn."/".$str.".include","\n"; - while ( ! -d $dn."/".$str.".include" ) { - #print STDERR "not include ",$dn."/".$str.".include","\n"; - $str.="../"; - last unless ($depth--); - } - #print STDERR "end include ",$dn."/".$str.".include","\n"; - if ( -d $dn."/".$str.".include" ) { - #print STDERR "return include ".$str.".include/".$fn,"\n"; - return $str.".include/"; - } else { - return ""; # won't work anyway but return something - } -} - -sub gettitle { - my ($dir,$dflt)=@_; - - my $F; - my $str; - if (open($F,"<".$dir."/.title")) { - $str=<$F>; - chop $str; - close($F); - } else { - print STDERR "enter title for $dir\n"; - $str=<>; - if ($str =~ /^\s*$/) { - $str=$dflt; - } - if (open($F,">".$dir."/.title")) { - print $F $str,"\n"; - close($F); - } else { - print STDERR "cant open .title in $dir for writing: $!"; - } - } - return $str; -} - -sub subalbum { - my ($base,$title)=@_; - - print Tr({-bgcolor=>"#c0c0c0"}, - td(a({-href=>$base."/index.html"},$base)), - td(a({-href=>$base."/index.html"},$title))),"\n"; -} - -sub processfile { - my ($start,$dir,$base,$fn,$info)=@_; - - my ($w,$h) = dim($info); - my $title=$info->{'Comment'}; - $title=$base unless ($title); - my $thumb=&scale($start,$dir,$base,$fn,160,$info); - my $medium=&scale($start,$dir,$base,$fn,640,$info); - print &infobox($info,$base,$fn),"\n"; - print table({-class=>'slide'},Tr(td( - a({-href=>".html/$base-info.html", - -onClick=>"return showIbox('$base');"},$title), - br, - a({-href=>$medium,-rel=>"lightbox",-title=>$title}, - img({-src=>$thumb})), - br, - a({-href=>$base},"($w x $h)"), - br))),"\n"; - return 1; -} - -sub infobox { - my ($info,$base,$fn)=@_; +sub infotable { + my $self = shift; + my $info = $self->{-info}; + my $msg=''; my @infokeys=( 'DateTime', @@ -583,112 +771,10 @@ sub infobox { 'Model', 'Software', ); - - my $msg=start_div({-class=>'ibox',-id=>$base,-OnClick=>"HideIbox('$base');"}); - $msg.=span({-style=>'float: left;'},"Info for $base"). - span({-style=>'float: right;'}, - a({-href=>"#",-OnClick=>"HideIbox('$base');"},"Close")); - $msg.=br({-clear=>'all'}); - $msg.=start_table; + $msg.=start_table({-class=>'infotable'})."\n"; foreach my $k(@infokeys) { - $msg.=Tr(td($k.":"),td($info->{$k})); + $msg.=Tr(td($k.":"),td($info->{$k}))."\n" if ($info->{$k}); } - $msg.=end_table; - $msg.=end_div; - return $msg; + $msg.=end_table."\n"; } -sub mkauxfile { - my ($start,$dir,$pbase,$base,$nbase,$refresh,$info) =@_; - my $en=sprintf("%s/%s/.html/%s-%s.html",$start,$dir,$base,$refresh); - my $pref; - my $nref; - if ($pbase) { - $pref=sprintf("%s-%s.html",$pbase,$refresh); - } else { - $pref="../index.html"; - } - if ($nbase) { - $nref=sprintf("%s-%s.html",$nbase,$refresh); - } else { - $nref="../index.html"; - } - my $toggle; - my $toggleref; - if ($refresh eq 'slide') { - $toggle='Stop!'; - $toggleref=sprintf("%s-static.html",$base); - } else { - $toggle='Play->'; - $toggleref=sprintf("%s-slide.html",$base); - } - - my $tdir=sprintf "%s/%s/.html",$start,$dir; - mkdir($tdir,0755) unless ( -d $tdir ); - - unless (open(STDOUT,">".$en)) { - warn "cannot open $en: $!"; - return; - } - my $title=$info->{'Comment'}; - $title=$base unless ($title); - if ($refresh eq 'slide') { - print start_html(-title=>$title, - -bgcolor=>"#808080", - -head=>meta({-http_equiv=>'Refresh', - -content=>"3; url=$nref"})),"\n"; - } else { - print start_html(-title=>$title, - -bgcolor=>"#808080"),"\n"; - } - print start_center,"\n"; - print h1($title); - print a({-href=>"../index.html"},"Index")," | "; - print a({-href=>$pref},"<<Prev")," | "; - print a({-href=>$toggleref},$toggle)," | "; - print a({-href=>$nref},"Next>>"); - print p; - print img({-src=>"../.640/".$base}),"\n"; - print end_center,"\n"; - print end_html,"\n"; - close(STDOUT); -} - -sub scale { - my ($start,$dir,$base,$fn,$tsize,$info)=@_; - my ($w,$h) = dim($info); - my $max=($w>$h)?$w:$h; - my $factor=$tsize/$max; - - return $base if ($factor >= 1); - - my $tdir=sprintf "%s/%s/.%s",$start,$dir,$tsize; - mkdir($tdir,0755) unless ( -d $tdir ); - my $tbase=sprintf ".%s/%s",$tsize,$base; - my $tfn=sprintf "%s/%s",$tdir,$base; - my @sstat=stat($fn); - my @tstat=stat($tfn); - return $tbase if (@tstat && ($sstat[9] < $tstat[9])); # [9] -> mtime - - print STDERR "scale by $factor from $fn to $tfn\n"; - &doscaling($fn,$tfn,$factor,$w,$h); - return $tbase; -} - -sub doscaling { - my ($src,$dest,$factor,$w,$h)=@_; - - my $im=new Image::Magick; - my $err; - #print STDERR "doscale $src -> $dest by $factor\n"; - $err=$im->Read($src); - unless ($err) { - $im->Scale(width=>$w*$factor,height=>$h*$factor); - $err=$im->Write($dest); - warn "ImageMagic: write \"$dest\": $err" if ($err); - } else { - warn "ImageMagic: read \"$src\": $err"; - system("djpeg \"$src\" | pnmscale \"$factor\" | cjpeg >\"$dest\""); - } - undef $im; -}