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