bef05ccb7cc6397cfd019822abdf86528b91811f
[mkgallery.git] / mkgallery.pl
1 #!/usr/bin/perl
2
3 # $Id$
4
5 # Recursively create image gallery index and slideshow wrappings.
6 # Makes use of (slightly modified) "lightbox" Javascript/CSS as published
7 # at http://www.huddletogether.com/projects/lightbox/
8
9 # Copyright (c) 2006 Eugene G. Crosser
10
11 #  This software is provided 'as-is', without any express or implied
12 #  warranty.  In no event will the authors be held liable for any damages
13 #  arising from the use of this software.
14 #
15 #  Permission is granted to anyone to use this software for any purpose,
16 #  including commercial applications, and to alter it and redistribute it
17 #  freely, subject to the following restrictions:
18 #
19 #  1. The origin of this software must not be misrepresented; you must not
20 #     claim that you wrote the original software. If you use this software
21 #     in a product, an acknowledgment in the product documentation would be
22 #     appreciated but is not required.
23 #  2. Altered source versions must be plainly marked as such, and must not be
24 #     misrepresented as being the original software.
25 #  3. This notice may not be removed or altered from any source distribution.
26
27 package FsObj;
28
29 use strict;
30 use Carp;
31 use POSIX qw/getcwd/;
32 use CGI qw/:html *table *center *div/;
33 use Image::Info qw/image_info dim/;
34 use Term::ReadLine;
35
36 use Image::Magick;
37
38 my $debug=0;
39
40 ######################################################################
41
42 FsObj->new(getcwd)->iterate;
43
44 sub new {
45         my $this = shift;
46         my $class;
47         my $self;
48         if (ref($this)) {
49                 $class = ref($this);
50                 my $parent = $this;
51                 my $path = $parent->{-path};
52                 my $name = shift;
53                 $path .= '/' if ($path);
54                 $path .= $name;
55                 my $fullpath = $parent->{-fullpath}.'/'.$name;
56                 $self = {
57                                 -parent=>$parent,
58                                 -root=>$parent->{-root},
59                                 -path=>$path,
60                                 -base=>$name,
61                                 -fullpath=>$fullpath,
62                                 -inc=>'../'.$parent->{-inc},
63                         };
64         } else {
65                 $class = $this;
66                 my $root=shift;
67                 $self = {
68                                 -root=>$root,
69                                 -fullpath=>$root,
70                                 -inc=>getinc($root),
71                         };
72         }
73         bless $self, $class;
74         if ($debug) {
75                 print "new $class:\n";
76                 foreach my $k(keys %$self) {
77                         print "\t$k\t=\t$self->{$k}\n";
78                 }
79         }
80         return $self;
81 }
82
83 sub getinc {
84         my $fullpath=shift;     # this is not a method
85         my $depth=20;           # arbitrary max depth
86
87         my $inc=".include";
88         while ( ! -d $fullpath."/".$inc ) {
89                 $inc = "../".$inc;
90                 last unless ($depth-- > 0);
91         }
92         if ($depth > 0) {
93                 return $inc.'/';        # prefix with trailing slash
94         } else {
95                 return 'NO-.INCLUDE-IN-PATH/'; # won't work anyway
96         }
97 }
98
99 sub iterate {
100         my $self = shift;
101         my $fullpath .= $self->{-fullpath};
102         print "iterate in dir $fullpath\n" if ($debug);
103
104         my @rdirlist;
105         my @rimglist;
106         my $D;
107         unless (opendir($D,$fullpath)) {
108                 warn "cannot opendir $fullpath: $!";
109                 return;
110         }
111         while (my $de = readdir($D)) {
112                 next if ($de =~ /^\./);
113                 my $child = $self->new($de);
114                 if ($child->isdir) {
115                         push(@rdirlist,$child);
116                 } elsif ($child->isimg) {
117                         push(@rimglist,$child);
118                 }
119         }
120         closedir($D);
121         my @sdirlist = sort {$a->{-base} cmp $b->{-base}} @rdirlist;
122         undef @rdirlist; # inplace sorting would be handy here
123         my @simglist = sort {$a->{-base} cmp $b->{-base}} @rimglist;
124         undef @rimglist; # optimize away unsorted versions
125
126 # 1. first of all, fill title for this directory and create hidden subdirs
127
128         $self->initdir;
129
130 # 2. iterate through subdirectories to get their titles filled
131
132         foreach my $dir(@sdirlist) {
133                 print "Dir: $dir->{-fullpath}\n" if ($debug);
134                 $dir->iterate;
135         }
136
137 # 3. start building directory index.html
138 # 4. iterate through subdirectories to build subalbums list
139 # 5. iterate through images to build cross-links
140
141         foreach my $img(@simglist) {
142                 print "Img: $img->{-fullpath}\n" if ($debug);
143         }
144
145 # 6. iterate through images to build thumb list and aux html files
146
147 }
148
149 sub isdir {
150         my $self = shift;
151         return ( -d $self->{-fullpath} );
152 }
153
154 sub isimg {
155         my $self = shift;
156         my $fullpath = $self->{-fullpath};
157         return 0 unless ( -f $fullpath );
158         my $info = image_info($fullpath);
159         if (my $error = $info->{error}) {
160                 if (($error !~ "Unrecognized file format") &&
161                     ($error !~ "Can't read head")) {
162                         warn "File \"$fullpath\": $error\n";
163                 }
164                 return 0;
165         }
166         $self->{-isimg} = 1;
167         $self->{-info} = $info;
168         return 1;
169 }
170
171 sub initdir {
172         my $self = shift;
173         my $fullpath = $self->{-fullpath};
174         # do stuff
175 }
176
177 ######################################################################
178 =cut
179 ######################################################################
180
181 &processdir(getcwd);
182
183 sub processdir {
184         my ($start,$dir)=@_;
185         my $dn=$start;
186         $dn .= "/".$dir if ($dir);
187         unless ( -d $dn ) {
188                 warn "not a directory: $dn";
189                 return;
190         }
191         my $D;
192         unless (opendir($D,$dn)) {
193                 warn "cannot opendir $dn: $!";
194                 return;
195         }
196
197 # recurse into subdirectories BEFORE opening index file
198
199         &iteratedir($D,$start,$dir,sub {
200                 my ($start,$dir,$base)=@_;
201                 my $ndir = $dir;
202                 $ndir .= "/" if ($ndir);
203                 $ndir .= $base;
204                 return unless ( -d $start."/".$ndir );
205                 &processdir($start,$ndir);
206         });
207
208 # fill in title
209
210         my $title=&gettitle($dn,$dir);
211
212 # get include prefix
213
214         my $inc=&getinclude($dn);
215
216 # generate directory index unless suppressed
217
218         if ( -e $dn."/.noindex" ) {
219                 open(STDOUT,">/dev/null");
220         } else {
221                 open(STDOUT,">".$dn."/index.html");
222         }
223
224 # write HTML header
225
226         print start_html(-title => $title,
227                         -style=>{-src=>[$inc."gallery.css",
228                                         $inc."lightbox.css"]},
229                         -script=>[{-code=>"var incPrefix='$inc';"},
230                                 {-src=>$inc."gallery.js"},
231                                 {-src=>$inc."lightbox.js"}]),"\n";
232         print a({-href=>"../index.html"},"UP");
233         print start_center,"\n";
234         print h1($title),"\n";
235
236 # create list of sub-albums
237
238         my $hassubdirs=0;
239         &iteratedir($D,$start,$dir,sub {
240                 my ($start,$dir,$base)=@_;
241                 my $en=sprintf("%s/%s/%s",$start,$dir,$base);
242                 return unless ( -d $en );
243                 unless ($hassubdirs) {
244                         print hr,h2("Albums"),start_table,"\n";
245                         $hassubdirs=1;
246                 }
247                 &subalbum($base,&gettitle($en,$dir."/".$base));
248         });
249         print end_table,hr,"\n" if ($hassubdirs);
250
251 # create picture gallery
252
253         my @piclist=();
254         my @infolist=();
255
256         my $haspics=0;
257         &iteratedir($D,$start,$dir,sub {
258                 my ($start,$dir,$base)=@_;
259                 my $en=sprintf("%s/%s/%s",$start,$dir,$base);
260                 return unless ( -f $en );
261                 my $info = image_info($en);
262                 if (my $error = $info->{error}) {
263                         if (($error !~ "Unrecognized file format") &&
264                             ($error !~ "Can't read head")) {
265                                 print STDERR "File \"$en\": $error\n";
266                         }
267                         return;
268                 }
269                 if (&processfile($start,$dir,$base,$en,$info)) {
270                         $haspics=1;
271                         push(@piclist,$base);
272                         push(@infolist,$info);
273                 }
274         });
275
276 # write HTML footer
277
278         print br({-clear=>"all"}),"\n";
279         print a({-href=>".html/".$piclist[0]."-slide.html"},"Slideshow");
280         print hr,"\n" if ($haspics);
281         print end_center,"\n";
282         print end_html,"\n";
283
284         close(STDOUT);
285         closedir($D);
286
287 # generate html files for slideshow from @piclist
288
289         for (my $i=0;$i<=$#piclist;$i++) {
290                 my $base=$piclist[$i];
291                 my $pbase;
292                 my $nbase;
293                 $pbase=$piclist[$i-1] if ($i>0);
294                 $nbase=$piclist[$i+1] if ($i<$#piclist);
295                 for my $refresh('static','slide') {
296                         &mkauxfile($start,$dir,$pbase,$base,$nbase,
297                                         $refresh,$infolist[$i]);
298                 }
299         }
300
301 }
302
303 #############################################################
304 # helper functions
305 #############################################################
306
307 sub iteratedir {
308         my ($D,$start,$dir,$prog)=@_;
309         my @list=();
310         while (my $de=readdir($D)) {
311                 next if ($de =~ /^\./);
312                 push(@list,$de);
313         }
314         foreach my $de(sort @list) {
315                 &$prog($start,$dir,$de);
316         }
317         rewinddir($D);
318 }
319
320 sub getinclude {
321         my ($dn)=@_;
322
323         my $depth=20;
324         my $str="";
325         #print STDERR "start include ",$dn."/".$str.".include","\n";
326         while ( ! -d $dn."/".$str.".include" ) {
327                 #print STDERR "not include ",$dn."/".$str.".include","\n";
328                 $str.="../";
329                 last unless ($depth--);
330         }
331         #print STDERR "end include ",$dn."/".$str.".include","\n";
332         if ( -d $dn."/".$str.".include" ) {
333                 #print STDERR "return include ".$str.".include/".$fn,"\n";
334                 return $str.".include/";
335         } else {
336                 return ""; # won't work anyway but return something
337         }
338 }
339
340 sub gettitle {
341         my ($dir,$dflt)=@_;
342
343         my $F;
344         my $str;
345         if (open($F,"<".$dir."/.title")) {
346                 $str=<$F>;
347                 chop $str;
348                 close($F);
349         } else {
350                 print STDERR "enter title for $dir\n";
351                 $str=<>;
352                 if ($str =~ /^\s*$/) {
353                         $str=$dflt;
354                 }
355                 if (open($F,">".$dir."/.title")) {
356                         print $F $str,"\n";
357                         close($F);
358                 } else {
359                         print STDERR "cant open .title in $dir for writing: $!";
360                 }
361         }
362         return $str;
363 }
364
365 sub subalbum {
366         my ($base,$title)=@_;
367
368         print Tr({-bgcolor=>"#c0c0c0"},
369                 td(a({-href=>$base."/index.html"},$base)),
370                 td(a({-href=>$base."/index.html"},$title))),"\n";
371 }
372
373 sub processfile {
374         my ($start,$dir,$base,$fn,$info)=@_;
375
376         my ($w,$h) = dim($info);
377         my $title=$info->{'Comment'};
378         $title=$base unless ($title);
379         my $thumb=&scale($start,$dir,$base,$fn,160,$info);
380         my $medium=&scale($start,$dir,$base,$fn,640,$info);
381         print &infobox($info,$base,$fn),"\n";
382         print table({-class=>'slide'},Tr(td(
383                 a({-href=>".html/$base-info.html",
384                         -onClick=>"return showIbox('$base');"},$title),
385                 br,
386                 a({-href=>$medium,-rel=>"lightbox",-title=>$title},
387                         img({-src=>$thumb})),
388                 br,
389                 a({-href=>$base},"($w x $h)"),
390                 br))),"\n";
391         return 1;
392 }
393
394 sub infobox {
395         my ($info,$base,$fn)=@_;
396
397         my @infokeys=(
398                 'DateTime',
399                 'ExposureTime',
400                 'FNumber',
401                 'Flash',
402                 'ISOSpeedRatings',
403                 'MeteringMode',
404                 'ExposureProgram',
405                 'FocalLength',
406                 'FileSource',
407                 'Make',
408                 'Model',
409                 'Software',
410         );
411
412         my $msg=start_div({-class=>'ibox',-id=>$base,-OnClick=>"HideIbox('$base');"});
413         $msg.=span({-style=>'float: left;'},"Info for $base").
414                 span({-style=>'float: right;'},
415                         a({-href=>"#",-OnClick=>"HideIbox('$base');"},"Close"));
416         $msg.=br({-clear=>'all'});
417         $msg.=start_table;
418         foreach my $k(@infokeys) {
419                 $msg.=Tr(td($k.":"),td($info->{$k}));
420         }
421         $msg.=end_table;
422         $msg.=end_div;
423         return $msg;
424 }
425
426 sub mkauxfile {
427         my ($start,$dir,$pbase,$base,$nbase,$refresh,$info) =@_;
428         my $en=sprintf("%s/%s/.html/%s-%s.html",$start,$dir,$base,$refresh);
429         my $pref;
430         my $nref;
431         if ($pbase) {
432                 $pref=sprintf("%s-%s.html",$pbase,$refresh);
433         } else {
434                 $pref="../index.html";
435         }
436         if ($nbase) {
437                 $nref=sprintf("%s-%s.html",$nbase,$refresh);
438         } else {
439                 $nref="../index.html";
440         }
441         my $toggle;
442         my $toggleref;
443         if ($refresh eq 'slide') {
444                 $toggle='Stop!';
445                 $toggleref=sprintf("%s-static.html",$base);
446         } else {
447                 $toggle='Play-&gt;';
448                 $toggleref=sprintf("%s-slide.html",$base);
449         }
450
451         my $tdir=sprintf "%s/%s/.html",$start,$dir;
452         mkdir($tdir,0755) unless ( -d $tdir );
453
454         unless (open(STDOUT,">".$en)) {
455                 warn "cannot open $en: $!";
456                 return;
457         }
458         my $title=$info->{'Comment'};
459         $title=$base unless ($title);
460         if ($refresh eq 'slide') {
461                 print start_html(-title=>$title,
462                                 -bgcolor=>"#808080",
463                         -head=>meta({-http_equiv=>'Refresh',
464                                 -content=>"3; url=$nref"})),"\n";
465         } else {
466                 print start_html(-title=>$title,
467                                 -bgcolor=>"#808080"),"\n";
468         }
469         print start_center,"\n";
470         print h1($title);
471         print a({-href=>"../index.html"},"Index")," | ";
472         print a({-href=>$pref},"&lt;&lt;Prev")," | ";
473         print a({-href=>$toggleref},$toggle)," | ";
474         print a({-href=>$nref},"Next&gt;&gt;");
475         print p;
476         print img({-src=>"../.640/".$base}),"\n";
477         print end_center,"\n";
478         print end_html,"\n";
479         close(STDOUT);
480 }
481
482 sub scale {
483         my ($start,$dir,$base,$fn,$tsize,$info)=@_;
484         my ($w,$h) = dim($info);
485         my $max=($w>$h)?$w:$h;
486         my $factor=$tsize/$max;
487
488         return $base if ($factor >= 1);
489
490         my $tdir=sprintf "%s/%s/.%s",$start,$dir,$tsize;
491         mkdir($tdir,0755) unless ( -d $tdir );
492         my $tbase=sprintf ".%s/%s",$tsize,$base;
493         my $tfn=sprintf "%s/%s",$tdir,$base;
494         my @sstat=stat($fn);
495         my @tstat=stat($tfn);
496         return $tbase if (@tstat && ($sstat[9] < $tstat[9])); # [9] -> mtime
497
498         print STDERR "scale by $factor from $fn to $tfn\n";
499         &doscaling($fn,$tfn,$factor,$w,$h);
500         return $tbase;
501 }
502
503 sub doscaling {
504         my ($src,$dest,$factor,$w,$h)=@_;
505
506         my $im=new Image::Magick;
507         my $err;
508         #print STDERR "doscale $src -> $dest by $factor\n";
509         $err=$im->Read($src);
510         unless ($err) {
511                 $im->Scale(width=>$w*$factor,height=>$h*$factor);
512                 $err=$im->Write($dest);
513                 warn "ImageMagic: write \"$dest\": $err" if ($err);
514         } else {
515                 warn "ImageMagic: read \"$src\": $err";
516                 system("djpeg \"$src\" | pnmscale \"$factor\" | cjpeg >\"$dest\"");
517         }
518         undef $im;
519 }