53b9c9ad809ae91fb57afe18164b2403b4b39668
[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
133         print "Dir: $self->{-fullpath}\n" if ($debug);
134
135 # 1. first of all, fill title for this directory and create hidden subdirs
136
137         $self->initdir;
138
139 # 2. recurse into subdirectories to get their titles filled
140 #    before we start writing out subalbum list
141
142         foreach my $dir(@dirlist) {
143                 $dir->iterate;
144         }
145
146 # 3. iterate through images to build cross-links,
147 #    create scaled versions and aux htmls
148
149         my $previmg = undef;
150         foreach my $img(@imglist) {
151                 if ($previmg) {
152                         $previmg->{-nextimg} = $img;
153                         $img->{-previmg} = $previmg;
154                 }
155                 $previmg=$img;
156
157                 $img->makescaled;
158                 $img->makeaux;
159         }
160
161 # 4. start building index.html for the directory
162
163         $self->startindex;
164
165 # 5. iterate through subdirectories to build subalbums list
166
167         if (@dirlist) {
168                 $self->startsublist;
169                 foreach my $dir(@dirlist) {
170                         $dir->sub_entry;
171                 }
172                 $self->endsublist;
173         }
174
175 # 6. iterate through images to build thumb list
176
177         if (@imglist) {
178                 $self->startimglist;
179                 foreach my $img(@imglist) {
180                         print "Img: $img->{-fullpath}\n" if ($debug);
181                         $img->img_entry;
182                 }
183                 $self->endimglist;
184         }
185
186 # 7. comlplete building index.html for the directory
187
188         $self->endindex;
189 }
190
191 sub isdir {
192         my $self = shift;
193         return ( -d $self->{-fullpath} );
194 }
195
196 sub isimg {
197         my $self = shift;
198         my $fullpath = $self->{-fullpath};
199         return 0 unless ( -f $fullpath );
200         my $info = image_info($fullpath);
201         if (my $error = $info->{error}) {
202                 if (($error !~ "Unrecognized file format") &&
203                     ($error !~ "Can't read head")) {
204                         warn "File \"$fullpath\": $error\n";
205                 }
206                 return 0;
207         }
208         $self->{-isimg} = 1;
209         $self->{-info} = $info;
210         return 1;
211 }
212
213 sub initdir {
214         my $self = shift;
215         my $fullpath = $self->{-fullpath};
216         for my $subdir(@sizes, 'html') {
217                 my $tdir=sprintf "%s/.%s",$self->{-fullpath},$subdir;
218                 mkdir($tdir,0755) unless ( -d $tdir );
219         }
220         $self->edittitle;
221 }
222
223 sub edittitle {
224         my $self = shift;
225         my $fullpath = $self->{-fullpath};
226         my $title;
227         my $T;
228         if (open($T,'<'.$fullpath.'/.title')) {
229                 $title = <$T>;
230                 $title =~ s/[\r\n]*$//;
231                 close($T);
232         }
233         if ($asktitle || (!$title && !$noasktitle)) {
234                 my $prompt = $self->{-base};
235                 $prompt = '/' unless ($prompt);
236                 my $OUT = $term->OUT || \*STDOUT;
237                 print $OUT "Enter title for $fullpath\n";
238                 $title = $term->readline($prompt.' >',$title);
239                 $term->addhistory($title) if ($title);
240                 if (open($T,'>'.$fullpath.'/.title')) {
241                         print $T $title,"\n";
242                         close($T);
243                 }
244         }
245         unless ($title) {
246                 $title=substr($fullpath,length($self->{-root}));
247         }
248         $self->{-title}=$title;
249         print "title in $fullpath is $title\n" if ($debug);
250 }
251
252 sub makescaled {
253         my $self = shift;
254         my $fn = $self->{-fullpath};
255         my $name = $self->{-base};
256         my $dn = $self->{-parent}->{-fullpath};
257         my ($w, $h) = dim($self->{-info});
258         my $max = ($w > $h)?$w:$h;
259
260         foreach my $size(@sizes) {
261                 my $nfn = $dn.'/.'.$size.'/'.$name;
262                 my $factor=$size/$max;
263         }
264 }
265
266 sub makeaux {
267         my $self = shift;
268         my $fn = $self->{-fullpath};
269         my $name = $self->{-base};
270         my $dn = $self->{-parent}->{-fullpath};
271 }
272
273 sub startindex {
274         my $self = shift;
275         my $fn = $self->{-fullpath}.'/index.html';
276         my $IND;
277         unless (open($IND,'>'.$fn)) {
278                 warn "cannot open $fn: $!";
279                 return;
280         }
281         $self->{-IND} = $IND;
282
283         my $inc = $self->{-inc};
284         my $title = $self->{-title};
285         print $IND start_html(-title => $title,
286                         -style=>{-src=>[$inc."gallery.css",
287                                         $inc."lightbox.css"]},
288                         -script=>[{-code=>"var incPrefix='$inc';"},
289                                 {-src=>$inc."gallery.js"},
290                                 {-src=>$inc."lightbox.js"}]),
291                 a({-href=>"../index.html"},"UP"),"\n",
292                 start_center,"\n",
293                 h1($title),"\n",
294                 "\n";
295 }
296
297 sub endindex {
298         my $self = shift;
299         my $IND = $self->{-IND};
300
301         print $IND end_center,end_html,"\n";
302
303         close($IND) if ($IND);
304         undef $self->{-IND};
305 }
306
307 sub startsublist {
308         my $self = shift;
309         my $IND = $self->{-IND};
310
311         print $IND h2("Albums"),"\n",start_table,"\n";
312 }
313
314 sub sub_entry {
315         my $self = shift;
316         my $IND = $self->{-parent}->{-IND};
317         my $name = $self->{-base};
318         my $title = $self->{-title};
319
320         print $IND Tr(td(a({-href=>$name.'/index.html'},$name)),
321                         td(a({-href=>$name.'/index.html'},$title))),"\n";
322 }
323
324 sub endsublist {
325         my $self = shift;
326         my $IND = $self->{-IND};
327
328         print $IND end_table,"\n",br({-clear=>'all'}),hr,"\n\n";
329 }
330
331 sub startimglist {
332         my $self = shift;
333         my $IND = $self->{-IND};
334
335         print $IND h2("Images"),"\n";
336 }
337
338 sub img_entry {
339         my $self = shift;
340         my $IND = $self->{-parent}->{-IND};
341         my $name = $self->{-base};
342
343         print $IND a({-href=>$name},$name),"\n";
344 }
345
346 sub endimglist {
347         my $self = shift;
348         my $IND = $self->{-IND};
349
350         print $IND br({-clear=>'all'}),hr,"\n\n";
351 }
352
353 ######################################################################
354 =cut
355 ######################################################################
356
357 &processdir(getcwd);
358
359 sub processdir {
360         my ($start,$dir)=@_;
361         my $dn=$start;
362         $dn .= "/".$dir if ($dir);
363         unless ( -d $dn ) {
364                 warn "not a directory: $dn";
365                 return;
366         }
367         my $D;
368         unless (opendir($D,$dn)) {
369                 warn "cannot opendir $dn: $!";
370                 return;
371         }
372
373 # recurse into subdirectories BEFORE opening index file
374
375         &iteratedir($D,$start,$dir,sub {
376                 my ($start,$dir,$base)=@_;
377                 my $ndir = $dir;
378                 $ndir .= "/" if ($ndir);
379                 $ndir .= $base;
380                 return unless ( -d $start."/".$ndir );
381                 &processdir($start,$ndir);
382         });
383
384 # fill in title
385
386         my $title=&gettitle($dn,$dir);
387
388 # get include prefix
389
390         my $inc=&getinclude($dn);
391
392 # generate directory index unless suppressed
393
394         if ( -e $dn."/.noindex" ) {
395                 open(STDOUT,">/dev/null");
396         } else {
397                 open(STDOUT,">".$dn."/index.html");
398         }
399
400 # write HTML header
401
402                         -style=>{-src=>[$inc."gallery.css",
403                                         $inc."lightbox.css"]},
404                         -script=>[{-code=>"var incPrefix='$inc';"},
405                                 {-src=>$inc."gallery.js"},
406                                 {-src=>$inc."lightbox.js"}]),"\n";
407         print a({-href=>"../index.html"},"UP");
408         print start_center,"\n";
409         print h1($title),"\n";
410
411 # create list of sub-albums
412
413         my $hassubdirs=0;
414         &iteratedir($D,$start,$dir,sub {
415                 my ($start,$dir,$base)=@_;
416                 my $en=sprintf("%s/%s/%s",$start,$dir,$base);
417                 return unless ( -d $en );
418                 unless ($hassubdirs) {
419                         print hr,h2("Albums"),start_table,"\n";
420                         $hassubdirs=1;
421                 }
422                 &subalbum($base,&gettitle($en,$dir."/".$base));
423         });
424         print end_table,hr,"\n" if ($hassubdirs);
425
426 # create picture gallery
427
428         my @piclist=();
429         my @infolist=();
430
431         my $haspics=0;
432         &iteratedir($D,$start,$dir,sub {
433                 my ($start,$dir,$base)=@_;
434                 my $en=sprintf("%s/%s/%s",$start,$dir,$base);
435                 return unless ( -f $en );
436                 my $info = image_info($en);
437                 if (my $error = $info->{error}) {
438                         if (($error !~ "Unrecognized file format") &&
439                             ($error !~ "Can't read head")) {
440                                 print STDERR "File \"$en\": $error\n";
441                         }
442                         return;
443                 }
444                 if (&processfile($start,$dir,$base,$en,$info)) {
445                         $haspics=1;
446                         push(@piclist,$base);
447                         push(@infolist,$info);
448                 }
449         });
450
451 # write HTML footer
452
453         print br({-clear=>"all"}),"\n";
454         print a({-href=>".html/".$piclist[0]."-slide.html"},"Slideshow");
455         print hr,"\n" if ($haspics);
456         print end_center,"\n";
457         print end_html,"\n";
458
459         close(STDOUT);
460         closedir($D);
461
462 # generate html files for slideshow from @piclist
463
464         for (my $i=0;$i<=$#piclist;$i++) {
465                 my $base=$piclist[$i];
466                 my $pbase;
467                 my $nbase;
468                 $pbase=$piclist[$i-1] if ($i>0);
469                 $nbase=$piclist[$i+1] if ($i<$#piclist);
470                 for my $refresh('static','slide') {
471                         &mkauxfile($start,$dir,$pbase,$base,$nbase,
472                                         $refresh,$infolist[$i]);
473                 }
474         }
475
476 }
477
478 #############################################################
479 # helper functions
480 #############################################################
481
482 sub iteratedir {
483         my ($D,$start,$dir,$prog)=@_;
484         my @list=();
485         while (my $de=readdir($D)) {
486                 next if ($de =~ /^\./);
487                 push(@list,$de);
488         }
489         foreach my $de(sort @list) {
490                 &$prog($start,$dir,$de);
491         }
492         rewinddir($D);
493 }
494
495 sub getinclude {
496         my ($dn)=@_;
497
498         my $depth=20;
499         my $str="";
500         #print STDERR "start include ",$dn."/".$str.".include","\n";
501         while ( ! -d $dn."/".$str.".include" ) {
502                 #print STDERR "not include ",$dn."/".$str.".include","\n";
503                 $str.="../";
504                 last unless ($depth--);
505         }
506         #print STDERR "end include ",$dn."/".$str.".include","\n";
507         if ( -d $dn."/".$str.".include" ) {
508                 #print STDERR "return include ".$str.".include/".$fn,"\n";
509                 return $str.".include/";
510         } else {
511                 return ""; # won't work anyway but return something
512         }
513 }
514
515 sub gettitle {
516         my ($dir,$dflt)=@_;
517
518         my $F;
519         my $str;
520         if (open($F,"<".$dir."/.title")) {
521                 $str=<$F>;
522                 chop $str;
523                 close($F);
524         } else {
525                 print STDERR "enter title for $dir\n";
526                 $str=<>;
527                 if ($str =~ /^\s*$/) {
528                         $str=$dflt;
529                 }
530                 if (open($F,">".$dir."/.title")) {
531                         print $F $str,"\n";
532                         close($F);
533                 } else {
534                         print STDERR "cant open .title in $dir for writing: $!";
535                 }
536         }
537         return $str;
538 }
539
540 sub subalbum {
541         my ($base,$title)=@_;
542
543         print Tr({-bgcolor=>"#c0c0c0"},
544                 td(a({-href=>$base."/index.html"},$base)),
545                 td(a({-href=>$base."/index.html"},$title))),"\n";
546 }
547
548 sub processfile {
549         my ($start,$dir,$base,$fn,$info)=@_;
550
551         my ($w,$h) = dim($info);
552         my $title=$info->{'Comment'};
553         $title=$base unless ($title);
554         my $thumb=&scale($start,$dir,$base,$fn,160,$info);
555         my $medium=&scale($start,$dir,$base,$fn,640,$info);
556         print &infobox($info,$base,$fn),"\n";
557         print table({-class=>'slide'},Tr(td(
558                 a({-href=>".html/$base-info.html",
559                         -onClick=>"return showIbox('$base');"},$title),
560                 br,
561                 a({-href=>$medium,-rel=>"lightbox",-title=>$title},
562                         img({-src=>$thumb})),
563                 br,
564                 a({-href=>$base},"($w x $h)"),
565                 br))),"\n";
566         return 1;
567 }
568
569 sub infobox {
570         my ($info,$base,$fn)=@_;
571
572         my @infokeys=(
573                 'DateTime',
574                 'ExposureTime',
575                 'FNumber',
576                 'Flash',
577                 'ISOSpeedRatings',
578                 'MeteringMode',
579                 'ExposureProgram',
580                 'FocalLength',
581                 'FileSource',
582                 'Make',
583                 'Model',
584                 'Software',
585         );
586
587         my $msg=start_div({-class=>'ibox',-id=>$base,-OnClick=>"HideIbox('$base');"});
588         $msg.=span({-style=>'float: left;'},"Info for $base").
589                 span({-style=>'float: right;'},
590                         a({-href=>"#",-OnClick=>"HideIbox('$base');"},"Close"));
591         $msg.=br({-clear=>'all'});
592         $msg.=start_table;
593         foreach my $k(@infokeys) {
594                 $msg.=Tr(td($k.":"),td($info->{$k}));
595         }
596         $msg.=end_table;
597         $msg.=end_div;
598         return $msg;
599 }
600
601 sub mkauxfile {
602         my ($start,$dir,$pbase,$base,$nbase,$refresh,$info) =@_;
603         my $en=sprintf("%s/%s/.html/%s-%s.html",$start,$dir,$base,$refresh);
604         my $pref;
605         my $nref;
606         if ($pbase) {
607                 $pref=sprintf("%s-%s.html",$pbase,$refresh);
608         } else {
609                 $pref="../index.html";
610         }
611         if ($nbase) {
612                 $nref=sprintf("%s-%s.html",$nbase,$refresh);
613         } else {
614                 $nref="../index.html";
615         }
616         my $toggle;
617         my $toggleref;
618         if ($refresh eq 'slide') {
619                 $toggle='Stop!';
620                 $toggleref=sprintf("%s-static.html",$base);
621         } else {
622                 $toggle='Play-&gt;';
623                 $toggleref=sprintf("%s-slide.html",$base);
624         }
625
626         my $tdir=sprintf "%s/%s/.html",$start,$dir;
627         mkdir($tdir,0755) unless ( -d $tdir );
628
629         unless (open(STDOUT,">".$en)) {
630                 warn "cannot open $en: $!";
631                 return;
632         }
633         my $title=$info->{'Comment'};
634         $title=$base unless ($title);
635         if ($refresh eq 'slide') {
636                 print start_html(-title=>$title,
637                                 -bgcolor=>"#808080",
638                         -head=>meta({-http_equiv=>'Refresh',
639                                 -content=>"3; url=$nref"})),"\n";
640         } else {
641                 print start_html(-title=>$title,
642                                 -bgcolor=>"#808080"),"\n";
643         }
644         print start_center,"\n";
645         print h1($title);
646         print a({-href=>"../index.html"},"Index")," | ";
647         print a({-href=>$pref},"&lt;&lt;Prev")," | ";
648         print a({-href=>$toggleref},$toggle)," | ";
649         print a({-href=>$nref},"Next&gt;&gt;");
650         print p;
651         print img({-src=>"../.640/".$base}),"\n";
652         print end_center,"\n";
653         print end_html,"\n";
654         close(STDOUT);
655 }
656
657 sub scale {
658         my ($start,$dir,$base,$fn,$tsize,$info)=@_;
659         my ($w,$h) = dim($info);
660         my $max=($w>$h)?$w:$h;
661         my $factor=$tsize/$max;
662
663         return $base if ($factor >= 1);
664
665         my $tdir=sprintf "%s/%s/.%s",$start,$dir,$tsize;
666         mkdir($tdir,0755) unless ( -d $tdir );
667         my $tbase=sprintf ".%s/%s",$tsize,$base;
668         my $tfn=sprintf "%s/%s",$tdir,$base;
669         my @sstat=stat($fn);
670         my @tstat=stat($tfn);
671         return $tbase if (@tstat && ($sstat[9] < $tstat[9])); # [9] -> mtime
672
673         print STDERR "scale by $factor from $fn to $tfn\n";
674         &doscaling($fn,$tfn,$factor,$w,$h);
675         return $tbase;
676 }
677
678 sub doscaling {
679         my ($src,$dest,$factor,$w,$h)=@_;
680
681         my $im=new Image::Magick;
682         my $err;
683         #print STDERR "doscale $src -> $dest by $factor\n";
684         $err=$im->Read($src);
685         unless ($err) {
686                 $im->Scale(width=>$w*$factor,height=>$h*$factor);
687                 $err=$im->Write($dest);
688                 warn "ImageMagic: write \"$dest\": $err" if ($err);
689         } else {
690                 warn "ImageMagic: read \"$src\": $err";
691                 system("djpeg \"$src\" | pnmscale \"$factor\" | cjpeg >\"$dest\"");
692         }
693         undef $im;
694 }