2f6bc6e5ea0f95371fd5e6c3629a91f29b38069a
[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 use Getopt::Long;
36
37 use Image::Magick;
38
39 my @sizes = (160, 640);
40
41 ######################################################################
42
43 my $debug = 0;
44 my $asktitle = 0;
45 my $noasktitle = 0;
46
47 GetOptions('asktitle'=>\$asktitle,
48                 'noasktitle'=>\$noasktitle,
49                 'debug'=>\$debug);
50
51 my $term = new Term::ReadLine "Edit Title";
52
53 FsObj->new(getcwd)->iterate;
54
55 sub new {
56         my $this = shift;
57         my $class;
58         my $self;
59         if (ref($this)) {
60                 $class = ref($this);
61                 my $parent = $this;
62                 my $name = shift;
63                 my $fullpath = $parent->{-fullpath}.'/'.$name;
64                 $self = {
65                                 -parent=>$parent,
66                                 -root=>$parent->{-root},
67                                 -base=>$name,
68                                 -fullpath=>$fullpath,
69                                 -inc=>'../'.$parent->{-inc},
70                         };
71         } else {
72                 $class = $this;
73                 my $root=shift;
74                 $self = {
75                                 -root=>$root,
76                                 -fullpath=>$root,
77                                 -inc=>getinc($root),
78                         };
79         }
80         bless $self, $class;
81         if ($debug) {
82                 print "new $class:\n";
83                 foreach my $k(keys %$self) {
84                         print "\t$k\t=\t$self->{$k}\n";
85                 }
86         }
87         return $self;
88 }
89
90 sub getinc {
91         my $fullpath=shift;     # this is not a method
92         my $depth=20;           # arbitrary max depth
93
94         my $inc=".include";
95         while ( ! -d $fullpath."/".$inc ) {
96                 $inc = "../".$inc;
97                 last unless ($depth-- > 0);
98         }
99         if ($depth > 0) {
100                 return $inc.'/';                # prefix with trailing slash
101         } else {
102                 return 'NO-.INCLUDE-IN-PATH/';  # won't work anyway
103         }
104 }
105
106 sub iterate {
107         my $self = shift;
108         my $fullpath .= $self->{-fullpath};
109         print "iterate in dir $fullpath\n" if ($debug);
110
111         my @rdirlist;
112         my @rimglist;
113         my $D;
114         unless (opendir($D,$fullpath)) {
115                 warn "cannot opendir $fullpath: $!";
116                 return;
117         }
118         while (my $de = readdir($D)) {
119                 next if ($de =~ /^\./);
120                 my $child = $self->new($de);
121                 if ($child->isdir) {
122                         push(@rdirlist,$child);
123                 } elsif ($child->isimg) {
124                         push(@rimglist,$child);
125                 }
126         }
127         closedir($D);
128         my @dirlist = sort {$a->{-base} cmp $b->{-base}} @rdirlist;
129         undef @rdirlist; # inplace sorting would be handy here
130         my @imglist = sort {$a->{-base} cmp $b->{-base}} @rimglist;
131         undef @rimglist; # optimize away unsorted versions
132         $self->{-firstimg} = $imglist[0];
133
134         print "Dir: $self->{-fullpath}\n" if ($debug);
135
136 # 1. first of all, fill title for this directory and create hidden subdirs
137
138         $self->initdir;
139
140 # 2. recurse into subdirectories to get their titles filled
141 #    before we start writing out subalbum list
142
143         foreach my $dir(@dirlist) {
144                 $dir->iterate;
145         }
146
147 # 3. iterate through images to build cross-links,
148
149         my $previmg = undef;
150         foreach my $img(@imglist) {
151                 # list-linking must be done before generating
152                 # aux html because aux pages rely on prev/next refs
153                 if ($previmg) {
154                         $previmg->{-nextimg} = $img;
155                         $img->{-previmg} = $previmg;
156                 }
157                 $previmg=$img;
158         }
159
160 # 4. create scaled versions and aux html pages
161
162         foreach my $img(@imglist) {
163                 # scaled versions must be generated before aux html
164                 # and main image index because they both rely on
165                 # refs to scaled images and they may be just original
166                 # images, this is not known before we try scaling.
167                 $img->makescaled;
168                 # finally, make aux html pages
169                 $img->makeaux;
170         }
171
172 # 5. start building index.html for the directory
173
174         $self->startindex;
175
176 # 6. iterate through subdirectories to build subalbums list
177
178         if (@dirlist) {
179                 $self->startsublist;
180                 foreach my $dir(@dirlist) {
181                         $dir->sub_entry;
182                 }
183                 $self->endsublist;
184         }
185
186 # 7. iterate through images to build thumb list
187
188         if (@imglist) {
189                 $self->startimglist;
190                 foreach my $img(@imglist) {
191                         print "Img: $img->{-fullpath}\n" if ($debug);
192                         $img->img_entry;
193                 }
194                 $self->endimglist;
195         }
196
197 # 8. comlplete building index.html for the directory
198
199         $self->endindex;
200 }
201
202 sub isdir {
203         my $self = shift;
204         return ( -d $self->{-fullpath} );
205 }
206
207 sub isimg {
208         my $self = shift;
209         my $fullpath = $self->{-fullpath};
210         return 0 unless ( -f $fullpath );
211         my $info = image_info($fullpath);
212         if (my $error = $info->{error}) {
213                 if (($error !~ "Unrecognized file format") &&
214                     ($error !~ "Can't read head")) {
215                         warn "File \"$fullpath\": $error\n";
216                 }
217                 return 0;
218         }
219         $self->{-isimg} = 1;
220         $self->{-info} = $info;
221         return 1;
222 }
223
224 sub initdir {
225         my $self = shift;
226         my $fullpath = $self->{-fullpath};
227         for my $subdir(@sizes, 'html') {
228                 my $tdir=sprintf "%s/.%s",$self->{-fullpath},$subdir;
229                 mkdir($tdir,0755) unless ( -d $tdir );
230         }
231         $self->edittitle;
232 }
233
234 sub edittitle {
235         my $self = shift;
236         my $fullpath = $self->{-fullpath};
237         my $title;
238         my $T;
239         if (open($T,'<'.$fullpath.'/.title')) {
240                 $title = <$T>;
241                 $title =~ s/[\r\n]*$//;
242                 close($T);
243         }
244         if ($asktitle || (!$title && !$noasktitle)) {
245                 my $prompt = $self->{-base};
246                 $prompt = '/' unless ($prompt);
247                 my $OUT = $term->OUT || \*STDOUT;
248                 print $OUT "Enter title for $fullpath\n";
249                 $title = $term->readline($prompt.' >',$title);
250                 $term->addhistory($title) if ($title);
251                 if (open($T,'>'.$fullpath.'/.title')) {
252                         print $T $title,"\n";
253                         close($T);
254                 }
255         }
256         unless ($title) {
257                 $title=substr($fullpath,length($self->{-root}));
258         }
259         $self->{-title}=$title;
260         print "title in $fullpath is $title\n" if ($debug);
261 }
262
263 sub makescaled {
264         my $self = shift;
265         my $fn = $self->{-fullpath};
266         my $name = $self->{-base};
267         my $dn = $self->{-parent}->{-fullpath};
268         my ($w, $h) = dim($self->{-info});
269         my $max = ($w > $h)?$w:$h;
270
271         foreach my $size(@sizes) {
272                 my $nref = '.'.$size.'/'.$name;
273                 my $nfn = $dn.'/'.$nref;
274                 my $factor=$size/$max;
275                 if ($factor >= 1) {
276                         $self->{$size} = $name; # unscaled version will do
277                 } else {
278                         $self->{$size} = $nref;
279                         if (isnewer($fn,$nfn)) {
280                                 doscaling($fn,$nfn,$factor,$w,$h);
281                         }
282                 }
283         }
284 }
285
286 sub isnewer {
287         my ($fn1,$fn2) = @_;                    # this is not a method
288         my @stat1=stat($fn1);
289         my @stat2=stat($fn2);
290         return (!@stat2 || ($stat1[9] > $stat2[9]));
291         # true if $fn2 is absent or is older than $fn1
292 }
293
294 sub doscaling {
295         my ($src,$dest,$factor,$w,$h) = @_;     # this is not a method
296         my $im = new Image::Magick;
297         my $err;
298         print "doscaling $src -> $dest by $factor\n" if ($debug);
299         $err = $im->Read($src);
300         unless ($err) {
301                 $im->Scale(width=>$w*$factor,height=>$h*$factor);
302                 $err=$im->Write($dest);
303                 warn "ImageMagick: write \"$dest\": $err" if ($err);
304         } else {        # fallback to command-line tools
305                 warn "ImageMagick: read \"$src\": $err";
306                 system("djpeg \"$src\" | pnmscale \"$factor\" | cjpeg >\"$dest\"");
307         }
308         undef $im;
309 }
310
311 sub makeaux {
312         my $self = shift;
313         my $name = $self->{-base};
314         my $dn = $self->{-parent}->{-fullpath};
315         my $pref = $self->{-previmg}->{-base};
316         my $nref = $self->{-nextimg}->{-base};
317         my $inc = $self->{-inc};
318         my $title = $self->{-info}->{'Comment'};
319         $title = $name unless ($title);
320
321         print "slide: \"$pref\"->\"$name\"->\"$nref\"\n" if ($debug);
322
323         # slideshow
324         for my $refresh('static', 'slide') {
325                 my $fn = sprintf("%s/.html/%s-%s.html",$dn,$name,$refresh);
326                 my $imgsrc = sprintf("../.%s/%s",$sizes[1],$name);
327                 my $fwdref;
328                 my $bakref;
329                 if ($nref) {
330                         $fwdref = sprintf("%s-%s.html",$nref,$refresh);
331                 } else {
332                         $fwdref = '../index.html';
333                 }
334                 if ($pref) {
335                         $bakref = sprintf("%s-%s.html",$pref,$refresh);
336                 } else {
337                         $bakref = '../index.html';
338                 }
339                 my $toggleref;
340                 my $toggletext;
341                 if ($refresh eq 'slide') {
342                         $toggleref=sprintf("%s-static.html",$name);
343                         $toggletext = 'Stop!';
344                 } else {
345                         $toggleref=sprintf("%s-slide.html",$name);
346                         $toggletext = 'Play-&gt;';
347                 }
348                 my $F;
349                 unless (open($F,'>'.$fn)) {
350                         warn "cannot open \"$fn\": $!";
351                         next;
352                 }
353                 if ($refresh eq 'slide') {
354                         print $F start_html(-title=>$title,
355                                         -bgcolor=>"#808080",
356                                         -head=>meta({-http_equiv=>'Refresh',
357                                                 -content=>"3; url=$fwdref"}),
358                                         -style=>{-src=>$inc."gallery.css"},
359                                 ),"\n";
360                                         
361                 } else {
362                         print $F start_html(-title=>$title,
363                                         -bgcolor=>"#808080",
364                                         -style=>{-src=>$inc."gallery.css"},
365                                 ),"\n";
366                 }
367                 print $F start_center,"\n",
368                         h1($title),
369                         a({-href=>"../index.html"},"Index")," | ",
370                         a({-href=>$bakref},"&lt;&lt;Prev")," | ",
371                         a({-href=>$toggleref},$toggletext)," | ",
372                         a({-href=>$fwdref},"Next&gt;&gt;"),
373                         p,
374                         img({-src=>$imgsrc}),"\n",
375                         end_center,"\n",
376                         end_html,"\n";
377                 close($F);
378         }
379         my $fn = sprintf("%s/.html/%s-info.html",$dn,$name);
380         my $F;
381         unless (open($F,'>'.$fn)) {
382                 warn "cannot open \"$fn\": $!";
383                 return;
384         }
385
386         # info html
387         my $imgsrc = sprintf("../.%s/%s",$sizes[0],$name);
388         print $F start_html(-title=>$title,-bgcolor=>"#ffff80",
389                                 -style=>{-src=>$inc."gallery.css"},),"\n",
390                 start_center,"\n",
391                 h1($title),"\n",
392                 table(Tr(td(img({-src=>$imgsrc})),td($self->infotable))),
393                 end_table,
394                 end_center,"\n",
395                 end_html,"\n";
396         close($F);
397 }
398
399 sub startindex {
400         my $self = shift;
401         my $fn = $self->{-fullpath}.'/index.html';
402         my $IND;
403         unless (open($IND,'>'.$fn)) {
404                 warn "cannot open $fn: $!";
405                 return;
406         }
407         $self->{-IND} = $IND;
408
409         my $inc = $self->{-inc};
410         my $title = $self->{-title};
411         print $IND start_html(-title => $title,
412                         -style=>{-src=>[$inc."gallery.css",
413                                         $inc."lightbox.css"]},
414                         -script=>[{-code=>"var incPrefix='$inc';"},
415                                 {-src=>$inc."gallery.js"},
416                                 {-src=>$inc."lightbox.js"}]),
417                 a({-href=>"../index.html"},"UP"),"\n",
418                 start_center,"\n",
419                 h1($title),"\n",
420                 "\n";
421 }
422
423 sub endindex {
424         my $self = shift;
425         my $IND = $self->{-IND};
426
427         print $IND end_center,end_html,"\n";
428
429         close($IND) if ($IND);
430         undef $self->{-IND};
431 }
432
433 sub startsublist {
434         my $self = shift;
435         my $IND = $self->{-IND};
436
437         print $IND h2("Albums"),"\n",start_table,"\n";
438 }
439
440 sub sub_entry {
441         my $self = shift;
442         my $IND = $self->{-parent}->{-IND};
443         my $name = $self->{-base};
444         my $title = $self->{-title};
445
446         print $IND Tr(td(a({-href=>$name.'/index.html'},$name)),
447                         td(a({-href=>$name.'/index.html'},$title))),"\n";
448 }
449
450 sub endsublist {
451         my $self = shift;
452         my $IND = $self->{-IND};
453
454         print $IND end_table,"\n",br({-clear=>'all'}),hr,"\n\n";
455 }
456
457 sub startimglist {
458         my $self = shift;
459         my $IND = $self->{-IND};
460         my $first = $self->{-firstimg}->{-base};
461         my $slideref = sprintf(".html/%s-slide.html",$first);
462
463         print $IND h2("Images"),"\n",
464                 a({-href=>$slideref},'Slideshow'),
465                 "\n";
466 }
467
468 sub img_entry {
469         my $self = shift;
470         my $IND = $self->{-parent}->{-IND};
471         my $name = $self->{-base};
472         my $title = $self->{-info}->{'Comment'};
473         $title = $name unless ($title);
474         my $thumb = $self->{$sizes[0]};
475         my $medium = $self->{$sizes[1]};
476         my $info = $self->{-info};
477         my ($w, $h) = dim($info);
478
479         print $IND start_div({-class=>'ibox',-id=>$name,
480                                         -OnClick=>"HideIbox('$name');"}),
481                 span({-style=>'float: left;'},b("Info for $name")),
482                 span({-style=>'float: right;'},
483                         a({-href=>"#",-OnClick=>"HideIbox('$name');"},"Close")),
484                 br({-clear=>'all'}),
485                 $self->infotable,
486                 end_div,"\n";
487
488         print $IND table({-class=>'slide'},Tr(td(
489                 a({-href=>".html/$name-info.html",
490                         -onClick=>"return showIbox('$name');"},$title),
491                 br,
492                 a({-href=>$medium,-rel=>"lightbox",-title=>$title},
493                         img({-src=>$thumb})),
494                 br,
495                 a({-href=>$name},"($w x $h)"),
496                 br))),"\n";
497 }
498
499 sub endimglist {
500         my $self = shift;
501         my $IND = $self->{-IND};
502
503         print $IND br({-clear=>'all'}),hr,"\n\n";
504 }
505
506 sub infotable {
507         my $self = shift;
508         my $info = $self->{-info};
509         my $msg='';
510
511         my @infokeys=(
512                 'DateTime',
513                 'ExposureTime',
514                 'FNumber',
515                 'Flash',
516                 'ISOSpeedRatings',
517                 'MeteringMode',
518                 'ExposureProgram',
519                 'FocalLength',
520                 'FileSource',
521                 'Make',
522                 'Model',
523                 'Software',
524         );
525         $msg.=start_table."\n";
526         foreach my $k(@infokeys) {
527                 $msg.=Tr(td($k.":"),td($info->{$k}))."\n" if ($info->{$k});
528         }
529         $msg.=end_table."\n";
530 }
531