X-Git-Url: http://www.average.org/gitweb/?p=mkgallery.git;a=blobdiff_plain;f=mkgallery.pl;h=385342ca0bcfa9b10dc13577fe7e186a0601c57d;hp=85c648ec5352cd24958f7b7dfe2de561a28e64b0;hb=8d5a6921d193300a214cdc2c455f25363f960725;hpb=5284b11e03a2cf04522adf94e187619620191a78 diff --git a/mkgallery.pl b/mkgallery.pl index 85c648e..385342c 100755 --- a/mkgallery.pl +++ b/mkgallery.pl @@ -24,19 +24,434 @@ # 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 Image::Info qw/image_info dim/; +use Term::ReadLine; +use Getopt::Long; + use Image::Magick; -my $ask=1; -my $startdir=getcwd; +my @sizes = (160, 640); + +###################################################################### + +my $debug = 0; +my $asktitle = 0; +my $noasktitle = 0; + +GetOptions('asktitle'=>\$asktitle, + 'noasktitle'=>\$noasktitle, + 'debug'=>\$debug); + +my $term = new Term::ReadLine "Edit Title"; + +FsObj->new(getcwd)->iterate; + +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}, + }; + } else { + $class = $this; + my $root=shift; + $self = { + -root=>$root, + -fullpath=>$root, + -inc=>getinc($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 + + 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 iterate { + my $self = shift; + my $fullpath .= $self->{-fullpath}; + print "iterate in dir $fullpath\n" if ($debug); + + my @rdirlist; + my @rimglist; + my $D; + unless (opendir($D,$fullpath)) { + warn "cannot opendir $fullpath: $!"; + return; + } + while (my $de = readdir($D)) { + next if ($de =~ /^\./); + my $child = $self->new($de); + 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 + + print "Dir: $self->{-fullpath}\n" if ($debug); + +# 1. first of all, fill title for this directory and create hidden subdirs + + $self->initdir; + +# 2. recurse into subdirectories to get their titles filled +# before we start writing out subalbum list + + foreach my $dir(@dirlist) { + $dir->iterate; + } + +# 3. iterate through images to build cross-links, + + 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; + } + +# 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; + } + $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; + } + +# 8. comlplete building index.html for the directory + + $self->endindex; +} + +sub isdir { + my $self = shift; + return ( -d $self->{-fullpath} ); +} + +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; + } + $self->{-isimg} = 1; + $self->{-info} = $info; + return 1; +} + +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 $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); + } + } + unless ($title) { + $title=substr($fullpath,length($self->{-root})); + } + $self->{-title}=$title; + 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} = $name; # unscaled version will do + } else { + $self->{$size} = $nref; + 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 $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"; + system("djpeg \"$src\" | pnmscale \"$factor\" | cjpeg >\"$dest\""); + } + undef $im; +} + +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: \"$pref\"->\"$name\"->\"$nref\"\n" if ($debug); + + # slideshow + for my $refresh('static', 'slide') { + my $fn = sprintf("%s/.html/%s-%s.html",$dn,$name,$refresh); + my $bakref = sprintf("%s-%s.html",$pref,$refresh); + my $fwdref = sprintf("%s-%s.html",$nref,$refresh); + my $imgsrc = sprintf("../.%s/%s",$sizes[1],$name); + 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; + } + if ($refresh eq 'slide') { + print $F start_html(-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, + -bgcolor=>"#808080", + -style=>{-src=>$inc."gallery.css"}, + ),"\n"; + } + print $F start_center,"\n", + h1($title), + a({-href=>"../index.html"},"Index")," | ", + a({-href=>$bakref},"<<Prev")," | ", + a({-href=>$toggleref},$toggletext)," | ", + a({-href=>$fwdref},"Next>>"), + p, + img({-src=>$imgsrc}),"\n", + end_center,"\n", + end_html,"\n"; + close($F); + } +} + +sub startindex { + my $self = shift; + my $fn = $self->{-fullpath}.'/index.html'; + my $IND; + unless (open($IND,'>'.$fn)) { + warn "cannot open $fn: $!"; + return; + } + $self->{-IND} = $IND; + + my $inc = $self->{-inc}; + my $title = $self->{-title}; + print $IND 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"}]), + a({-href=>"../index.html"},"UP"),"\n", + start_center,"\n", + h1($title),"\n", + "\n"; +} + +sub endindex { + my $self = shift; + my $IND = $self->{-IND}; + + print $IND end_center,end_html,"\n"; + + close($IND) if ($IND); + undef $self->{-IND}; +} + +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}; + + 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}; + + print $IND h2("Images"),"\n"; +} + +sub img_entry { + my $self = shift; + my $IND = $self->{-parent}->{-IND}; + my $name = $self->{-base}; + + print $IND a({-href=>$name},$name),"\n"; +} + +sub endimglist { + my $self = shift; + my $IND = $self->{-IND}; + + print $IND br({-clear=>'all'}),hr,"\n\n"; +} + +###################################################################### +=cut ###################################################################### -&processdir($startdir); +&processdir(getcwd); sub processdir { my ($start,$dir)=@_; @@ -81,13 +496,12 @@ sub processdir { # write HTML header - 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 a({-href=>"../index.html"},"UP"); print start_center,"\n"; print h1($title),"\n"; @@ -134,6 +548,7 @@ sub processdir { # 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"; @@ -223,8 +638,8 @@ sub subalbum { my ($base,$title)=@_; print Tr({-bgcolor=>"#c0c0c0"}, - td(a({-href=>$base."/"},$base)), - td(a({-href=>$base."/"},$title))),"\n"; + td(a({-href=>$base."/index.html"},$base)), + td(a({-href=>$base."/index.html"},$title))),"\n"; } sub processfile { @@ -288,12 +703,21 @@ sub mkauxfile { if ($pbase) { $pref=sprintf("%s-%s.html",$pbase,$refresh); } else { - $pref="../"; + $pref="../index.html"; } if ($nbase) { $nref=sprintf("%s-%s.html",$nbase,$refresh); } else { - $nref="../"; + $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; @@ -307,12 +731,22 @@ sub mkauxfile { $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),"\n"; + print start_html(-title=>$title, + -bgcolor=>"#808080"),"\n"; } - print img({-src=>"../.640/".$base}); + 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); }