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 }