X-Git-Url: http://www.average.org/gitweb/?p=mkgallery.git;a=blobdiff_plain;f=mkgallery.pl;h=c7d3f46391a0e2a1b1e3271b90f5b208497a9726;hp=85c648ec5352cd24958f7b7dfe2de561a28e64b0;hb=938141692ce114b47e3268df7a2bb115e40e8e0d;hpb=5284b11e03a2cf04522adf94e187619620191a78 diff --git a/mkgallery.pl b/mkgallery.pl index 85c648e..c7d3f46 100755 --- a/mkgallery.pl +++ b/mkgallery.pl @@ -3,10 +3,10 @@ # $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-2008 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,702 @@ # 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 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 encoding 'utf-8'; +binmode(STDOUT, ":utf8"); + +my $haveimagick = eval { require Image::Magick; }; +{ package Image::Magick; } # to make perl compiler happy + +my $haverssxml = eval { require XML::RSS; }; +{ package XML::RSS; } # to make perl compiler happy -my $ask=1; -my $startdir=getcwd; +my @sizes = (160, 640, 1600); ###################################################################### -&processdir($startdir); +my $incpath; +my $rssobj; +my $debug = 0; +my $asktitle = 0; +my $noasktitle = 0; +my $rssfile = ""; + +charset("utf-8"); + +unless (GetOptions( + 'help'=>\&help, + 'incpath'=>\$incpath, + 'asktitle'=>\$asktitle, + 'noasktitle'=>\$noasktitle, + 'rssfile=s'=>\$rssfile, + 'debug'=>\$debug)) { + &help; +} -sub processdir { - my ($start,$dir)=@_; - my $dn=$start; - $dn .= "/".$dir if ($dir); - unless ( -d $dn ) { - warn "not a directory: $dn"; - return; +if ($rssfile && ! $haverssxml) { + print STDERR "You need to get XML::RSS from CPAN to use --rssfile\n"; + exit 1; +} + +my $term = new Term::ReadLine "Edit Title"; + +FsObj->new(getcwd)->iterate; + +if ($rssobj) { + my $itemstodel = @{$rssobj->{'rss'}->{'items'}} - 15; + while ($itemstodel-- > 0) { + pop(@{$rssobj->{'rss'}->{'items'}}) + } + $rssobj->{'rss'}->save($rssobj->{'file'}); +} + +sub help { + + print STDERR <<__END__; +usage: $0 [options] + --help: print help message and exit + --incpath: do not try to find .include diretory 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. + --rssfile=...: build RSS feed for newly added "albums", give name of rss file +__END__ + + exit 1; +} + +sub new { + my $this = shift; + my $class; + my $self; + if (ref($this)) { + $class = ref($this); + my $parent = $this; + my $name = shift; + my $fullpath = $parent->{-fullpath}.'/'.$name; + $self = { + -parent=>$parent, + -root=>$parent->{-root}, + -base=>$name, + -fullpath=>$fullpath, + -inc=>'../'.$parent->{-inc}, + -rss=>'../'.$parent->{-rss}, + }; + } else { + $class = $this; + my $root=shift; + $self = { + -root=>$root, + -fullpath=>$root, + -inc=>getinc($root), + -rss=>getrss($root), + }; + } + 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 getinc { + my $fullpath=shift; # this is not a method + my $depth=20; # arbitrary max depth + + if ($incpath) { + return $incpath."/.include"; + } + + my $inc=".include"; + while ( ! -d $fullpath."/".$inc ) { + $inc = "../".$inc; + last unless ($depth-- > 0); + } + if ($depth > 0) { + return $inc.'/'; # prefix with trailing slash + } else { + return 'NO-.INCLUDE-IN-PATH/'; # won't work anyway + } +} + +sub getrss { + my $fullpath=shift; # this is not a method + my $depth=20; # arbitrary max depth + + return "" unless $rssfile; + + my $rss=$rssfile; + while ( ! -f $fullpath."/".$rss ) { + $rss = "../".$rss; + last unless ($depth-- > 0); + } + if ($depth > 0) { + $rssobj->{'file'} = $rss; + $rssobj->{'rss'} = new XML::RSS (version=>2); + $rssobj->{'rss'}->parsefile($rss); + return $rss; + } else { + print STDERR "There is no $rssfile in this or parent ". + "directories, you must create one with mkgalrss.pl\n"; + exit 1; } +} + +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 ); + 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 ); } - foreach my $de(sort @list) { - &$prog($start,$dir,$de); + $self->edittitle; +} + +sub edittitle { + my $self = shift; + my $fullpath = $self->{-fullpath}; + my $title; + my $T; + if (open($T,'<'.$fullpath.'/.title')) { + $title = <$T>; + $title =~ s/[\r\n]*$//; + close($T); + } + if ($asktitle || (!$title && !$noasktitle)) { + my $prompt = $self->{-base}; + $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')) { + print $T $title,"\n"; + close($T); + } } - rewinddir($D); + unless ($title) { + $title=substr($fullpath,length($self->{-root})); + } + $self->{-title}=$title; + print "title in $fullpath is $title\n" if ($debug); } -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 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'} = [$w*$factor, $h*$factor]; + if (isnewer($fn,$nfn)) { + doscaling($fn,$nfn,$factor,$w,$h); + } + } } } -sub gettitle { - my ($dir,$dflt)=@_; +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 $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; +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); } - if (open($F,">".$dir."/.title")) { - print $F $str,"\n"; + undef $im; + } + if ($err) { # fallback to command-line tools + system("djpeg \"$src\" | pnmscale \"$factor\" | cjpeg >\"$dest\""); + } +} + +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}; + 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]}; + 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,'>'.$fn)) { + warn "cannot open \"$fn\": $!"; + next; + } + binmode($F, ":utf8"); + 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"; + + } else { + print $F start_html(-title=>$title, + -encoding=>"utf-8", + -bgcolor=>"#808080", + -style=>{-src=>$inc."gallery.css"}, + ),"\n"; + } + print $F start_center,"\n", + h1($title),"\n", + 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", + end_Tr, + end_table,"\n", + table({-class=>'picframe'}, + Tr(td(img({-src=>$imgsrc})))),"\n", + end_center,"\n", + end_html,"\n"; close($F); - } else { - print STDERR "cant open .title in $dir for writing: $!"; } } - return $str; + + # info html + my $fn = sprintf("%s/.html/%s-info.html",$dn,$name); + if (isnewer($self->{-fullpath},$fn)) { + my $F; + unless (open($F,'>'.$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"},),"\n", + start_center,"\n", + h1($title),"\n", + table({-class=>'ipage'}, + Tr(td(img({-src=>$imgsrc})), + td($self->infotable))), + a({-href=>'../index.html'},'Index'),"\n", + end_center,"\n", + end_html,"\n"; + close($F); + } } -sub subalbum { - my ($base,$title)=@_; +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)) { + warn "cannot open $fn: $!"; + return; + } + binmode($IND, ":utf8"); + $self->{-IND} = $IND; + + my $inc = $self->{-inc}; + my $title = $self->{-title}; + my $rsslink=""; + if ($self->{-rss}) { + $rsslink=Link({-rel=>'alternate', + -type=>'application/rss+xml', + -title=>'RSS', + -href=>$self->{-rss}}); + } + print $IND start_html(-title => $title, + -encoding=>"utf-8", + -head=>$rsslink, + -style=>{-src=>$inc."gallery.css"}, + -script=>[ + {-src=>$inc."mootools.js"}, + {-src=>$inc."overlay.js"}, + {-src=>$inc."urlparser.js"}, + {-src=>$inc."multibox.js"}, + {-src=>$inc."slideshow.js"}, + {-src=>$inc."gallery.js"}, + {-code=>"var incPrefix='$inc';"} + ]), + a({-href=>"../index.html"},"UP"),"\n", + start_center,"\n", + h1($title),"\n", + "\n"; +} - print Tr({-bgcolor=>"#c0c0c0"}, - td(a({-href=>$base."/"},$base)), - td(a({-href=>$base."/"},$title))),"\n"; +sub endindex { + my $self = shift; + my $IND = $self->{-IND}; + + print $IND end_center,end_html,"\n"; + + close($IND) if ($IND); + undef $self->{-IND}; + if ($rssobj) { + my $rsstitle=sprintf "%s [%d images, %d subalbums]", + $self->{-title}, + $self->{-numofimgs}, + $self->{-numofsubs}; + my $rsslink=$rssobj->{'rss'}->channel('link')."index.html"; + $rssobj->{'rss'}->add_item( + title => $self->{-title}, + link => $rsslink, + description => $rsstitle, + ); + } } -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 startsublist { + my $self = shift; + my $IND = $self->{-IND}; + + print $IND h2("Albums"),"\n",start_table,"\n"; +} + +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("Images"),"\n", + a({-href=>$slideref, + -onClick=>"return run_slideshow(-1);"}, + 'Slideshow'), + start_div({-id=>"slideshowWindow",-class=>"slideshowWindow"}), + div({-id=>"slideshowContainer", + -class=>"slideshowContainer"},""), + start_div({-id=>"slideshowControls", + -class=>"slideshowControls"}), + a({-href=>"#",-onClick=>"show.previous();return false;"}, + "Prev"), + a({-href=>"#",-onClick=>"show.play();return false;"}, + "Play"), + a({-href=>"#",-onClick=>"show.stop();return false;"}, + "Stop"), + a({-href=>"#",-onClick=>"show.next();return false;"}, + "Next"), + a({-href=>"#",-onClick=>"stop_slideshow();return false;"}, + "Exit"), + end_div, + end_div, + "\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 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 a({-name=>$i}),"\n", + start_table({-class=>'slide'}),start_Tr,start_td,"\n", + div({-class=>'slidetitle',-id=>$name}, + a({-href=>".html/$name-info.html", + -title=>'Image Info', + -class=>'infobox'}, + $title)),"\n", + div({-class=>'slideimage',-id=>$name}, + a({-href=>".html/$name-static.html",-title=>$title, + -id=>$name, + -OnClick=>"return run_slideshow(".$i.");"}, + img({-src=>$thumb}))),"\n", + start_div({-class=>'varimages',-id=>$i}); + 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,-style=>"display: none;", + -class=>($sz == 640)?"slideshowThumbnail":"", + -title=>"Reduced to ".$w."x".$h}, + $w."x".$h)," "; + } + print $IND a({-href=>$name, + -title=>'Original'},$w."x".$h), + end_div,"\n", + end_td,end_Tr,end_table,"\n"; +} + +sub endimglist { + my $self = shift; + my $IND = $self->{-IND}; + + print $IND br({-clear=>'all'}),hr,"\n\n"; } -sub infobox { - my ($info,$base,$fn)=@_; +sub infotable { + my $self = shift; + my $info = $self->{-info}; + my $msg=''; my @infokeys=( 'DateTime', @@ -265,93 +735,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; -}