X-Git-Url: http://www.average.org/gitweb/?p=mkgallery.git;a=blobdiff_plain;f=mkgallery.pl;h=8bed35cb1d594efd3fdb17cb7703751757ddb198;hp=85c648ec5352cd24958f7b7dfe2de561a28e64b0;hb=HEAD;hpb=5284b11e03a2cf04522adf94e187619620191a78;ds=sidebyside diff --git a/mkgallery.pl b/mkgallery.pl index 85c648e..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 @@ -24,232 +24,738 @@ # misrepresented as being the original software. # 3. This notice may not be removed or altered from any source distribution. +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 Image::Magick; +use Term::ReadLine; +use Getopt::Long; +use Encode; +use UUID; +use utf8; +binmode(STDOUT, ":utf8"); + +my $haveimagick = eval { require Image::Magick; }; +{ package Image::Magick; } # to make perl compiler happy + +my $havegeoloc = eval { require Image::ExifTool::Location; }; +{ package Image::ExifTool::Location; } # to make perl compiler happy -my $ask=1; -my $startdir=getcwd; +my @sizes = (160, 640, 1600); +my $incdir = ".gallery2"; ###################################################################### -&processdir($startdir); +my $incpath; +my $debug = 0; +my $asktitle = 0; +my $noasktitle = 0; -sub processdir { - my ($start,$dir)=@_; - my $dn=$start; - $dn .= "/".$dir if ($dir); - unless ( -d $dn ) { - warn "not a directory: $dn"; - return; +charset("utf-8"); + +unless (GetOptions( + 'help'=>\&help, + 'incpath'=>\$incpath, + 'asktitle'=>\$asktitle, + 'noasktitle'=>\$noasktitle, + '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; + my $self; + if (ref($this)) { + $class = ref($this); + my $parent = $this; + my $name = shift; + $self = { + -parent=>$parent, + -root=>$parent->{-root}, + -toppath=>$parent->{-toppath}, + -depth=>$parent->{-depth}+1, + -base=>$name, + -fullpath=>$parent->{-fullpath}.'/'.$name, + -relpath=>$parent->{-relpath}.$name.'/', + -inc=>'../'.$parent->{-inc}, + }; + } else { + $class = $this; + my $root=shift; + $self = { + -root=>$root, + -fullpath=>$root, + }; + # fill in -inc, -relpath + initpaths($self); # we are not blessed yet, so cheat. + } + bless $self, $class; + if ($debug) { + print "new $class:\n"; + foreach my $k(keys %$self) { + print "\t$k\t=\t$self->{$k}\n"; + } + } + return $self; +} + +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; + + if ($incpath) { + $inc = $incpath; + $inc .= '/' unless ($inc =~ m%/$%); + } else { + $inc=""; + while ( ! -d $fullpath."/".$inc."/".$incdir ) { + $inc = "../".$inc; + last unless ($depth-- > 0); + } } + if ($depth > 0) { + $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 { + $self->{-inc} = 'NO-.INCLUDE-IN-PATH/'; # won't work anyway + $self->{-relpath} = ''; + $self->{-depth} = 0; + } +} + +sub iterate { + my $self = shift; + my $fullpath .= $self->{-fullpath}; + print "iterate in dir $fullpath\n" if ($debug); + + my $youngest=0; + my @rdirlist; + my @rimglist; my $D; - unless (opendir($D,$dn)) { - warn "cannot opendir $dn: $!"; + unless (opendir($D,$fullpath)) { + warn "cannot opendir $fullpath: $!"; return; } + 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) { + push(@rimglist,$child); + } + } + closedir($D); + my @dirlist = sort {$a->{-base} cmp $b->{-base}} @rdirlist; + 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]; -# recurse into subdirectories BEFORE opening index file + print "Dir: $self->{-fullpath}\n" if ($debug); - &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); - }); +# 1. first of all, fill title for this directory and create hidden subdirs -# fill in title + $self->initdir; - my $title=&gettitle($dn,$dir); +# 2. recurse into subdirectories to get their titles filled +# before we start writing out subalbum list -# get include prefix + foreach my $dir(@dirlist) { + $dir->iterate; + } - my $inc=&getinclude($dn); +# 3. iterate through images to build cross-links, -# generate directory index unless suppressed + 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; + } - if ( -e $dn."/.noindex" ) { - open(STDOUT,">/dev/null"); - } else { - open(STDOUT,">".$dn."/index.html"); +# 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; } -# write HTML header +# no need to go beyond this point if the directory timestamp did not +# change since we built index.html file last time. - print start_html(-title => $title, - -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=>"../"},"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; + my @istat = stat($self->{-fullpath}.'/index.html'); + return unless ($youngest > $istat[9]); + +# 5. start building index.html for the directory + + $self->startindex; + +# 6. iterate through subdirectories to build subalbums list + + if (@dirlist) { + $self->startsublist; + foreach my $dir(@dirlist) { + $dir->sub_entry; } - if (&processfile($start,$dir,$base,$en,$info)) { - $haspics=1; - push(@piclist,$base); - push(@infolist,$info); + $self->endsublist; + } + +# 7. iterate through images to build thumb list + + if (@imglist) { + $self->startimglist; + foreach my $img(@imglist) { + print "Img: $img->{-fullpath}\n" if ($debug); + $img->img_entry; } - }); + $self->endimglist; + } -# write HTML footer +# 8. comlplete building index.html for the directory - print br({-clear=>"all"}),"\n"; - print hr,"\n" if ($haspics); - print end_center,"\n"; - print end_html,"\n"; + $self->endindex; +} - close(STDOUT); - closedir($D); +sub isdir { + my $self = shift; + return ( -d $self->{-fullpath} ); +} -# 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]); +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") && + ($error !~ "Can't read head")) { + warn "File \"$fullpath\": $error\n"; + } + return 0; + } + + tryapp12($info) unless ($info->{'ExifVersion'}); + + $self->{-isimg} = 1; + $self->{-info} = $info; + return 1; } -############################################################# -# helper functions -############################################################# +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 iteratedir { - my ($D,$start,$dir,$prog)=@_; - my @list=(); - while (my $de=readdir($D)) { - next if ($de =~ /^\./); - push(@list,$de); +sub initdir { + my $self = shift; + my $fullpath = $self->{-fullpath}; + for my $subdir(@sizes, 'html') { + my $tdir=sprintf "%s/.%s",$self->{-fullpath},$subdir; + mkdir($tdir,0755) unless ( -d $tdir ); + } + $self->edittitle; +} + +sub edittitle { + my $self = shift; + my $fullpath = $self->{-fullpath}; + my $title; + my $titleimage; + my $T; + my $TI; + if (open($T,'<:encoding(utf8)', $fullpath.'/.title')) { + $title = <$T>; + $title =~ s/[\r\n]*$//; + close($T); + } + if ($asktitle || (!$title && !$noasktitle)) { + 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,'>:encoding(utf8)', $fullpath.'/.title')) { + print $T $title,"\n"; + close($T); + } + } + unless ($title) { + $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; } - foreach my $de(sort @list) { - &$prog($start,$dir,$de); + print "title in $fullpath is $title\n" if ($debug); +} + +sub makescaled { + my $self = shift; + my $fn = $self->{-fullpath}; + my $name = $self->{-base}; + my $dn = $self->{-parent}->{-fullpath}; + my ($w, $h) = dim($self->{-info}); + my $max = ($w > $h)?$w:$h; + + foreach my $size(@sizes) { + 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); + } + } } - rewinddir($D); } -sub getinclude { - my ($dn)=@_; +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 +} - 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--); +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; } - #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 + if ($err) { # fallback to command-line tools + system("djpeg \"$src\" | pnmscale \"$factor\" | cjpeg >\"$dest\""); } } -sub gettitle { - my ($dir,$dflt)=@_; +sub makeaux { + my $self = shift; + 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); + } + } - my $F; - my $str; - if (open($F,"<".$dir."/.title")) { - $str=<$F>; - chop $str; + # 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,'>:encoding(utf8)', $fn)) { + warn "cannot open $fn: $!"; + return; + } + $self->{-IND} = $IND; + + my $inc = $self->{-inc}.$incdir.'/'; + my $title = $self->{-title}; + my $titleimage = $self->{-titleimage}; + print $IND start_html(-title => $title, + -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"}, + ]),"\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 "enter title for $dir\n"; - $str=<>; - if ($str =~ /^\s*$/) { - $str=$dflt; + 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"; } - if (open($F,">".$dir."/.title")) { - print $F $str,"\n"; - close($F); - } else { - print STDERR "cant open .title in $dir for writing: $!"; + print $IND h1({-class=>'title'},$title), + br({-clear=>'all'}),"\n"; + } +} + +sub endindex { + my $self = shift; + my $IND = $self->{-IND}; + + 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"; } - return $str; + print $IND end_html,"\n"; + + close($IND) if ($IND); + undef $self->{-IND}; } -sub subalbum { - my ($base,$title)=@_; +sub startsublist { + my $self = shift; + my $IND = $self->{-IND}; - print Tr({-bgcolor=>"#c0c0c0"}, - td(a({-href=>$base."/"},$base)), - td(a({-href=>$base."/"},$title))),"\n"; + print $IND h2({-class=>"atitle"},"Albums"),"\n",start_table,"\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 sub_entry { + my $self = shift; + my $IND = $self->{-parent}->{-IND}; + 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"; +} + +sub endsublist { + my $self = shift; + my $IND = $self->{-IND}; + + print $IND end_table,"\n",br({-clear=>'all'}),hr,"\n\n"; +} + +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({-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}; + 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 infobox { - my ($info,$base,$fn)=@_; +sub endimglist { + my $self = shift; + my $IND = $self->{-IND}; + + print $IND br({-clear=>'all'}),hr,"\n\n"; +} + +sub infotable { + my $self = shift; + my $info = $self->{-info}; + my $msg=''; my @infokeys=( 'DateTime', @@ -265,93 +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="../"; - } - if ($nbase) { - $nref=sprintf("%s-%s.html",$nbase,$refresh); - } else { - $nref="../"; - } - - 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, - -head=>meta({-http_equiv=>'Refresh', - -content=>"3; url=$nref"})),"\n"; - } else { - print start_html(-title=>$title),"\n"; - } - print img({-src=>"../.640/".$base}); - 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; -}