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 }
 380
 381 sub startindex {
 382         my $self = shift;
 383         my $fn = $self->{-fullpath}.'/index.html';
 384         my $IND;
 385         unless (open($IND,'>'.$fn)) {
 386                 warn "cannot open $fn: $!";
 387                 return;
 388         }
 389         $self->{-IND} = $IND;
 390
 391         my $inc = $self->{-inc};
 392         my $title = $self->{-title};
 393         print $IND start_html(-title => $title,
 394                         -style=>{-src=>[$inc."gallery.css",
 395                                         $inc."lightbox.css"]},
 396                         -script=>[{-code=>"var incPrefix='$inc';"},
 397                                 {-src=>$inc."gallery.js"},
 398                                 {-src=>$inc."lightbox.js"}]),
 399                 a({-href=>"../index.html"},"UP"),"\n",
 400                 start_center,"\n",
 401                 h1($title),"\n",
 402                 "\n";
 403 }
 404
 405 sub endindex {
 406         my $self = shift;
 407         my $IND = $self->{-IND};
 408
 409         print $IND end_center,end_html,"\n";
 410
 411         close($IND) if ($IND);
 412         undef $self->{-IND};
 413 }
 414
 415 sub startsublist {
 416         my $self = shift;
 417         my $IND = $self->{-IND};
 418
 419         print $IND h2("Albums"),"\n",start_table,"\n";
 420 }
 421
 422 sub sub_entry {
 423         my $self = shift;
 424         my $IND = $self->{-parent}->{-IND};
 425         my $name = $self->{-base};
 426         my $title = $self->{-title};
 427
 428         print $IND Tr(td(a({-href=>$name.'/index.html'},$name)),
 429                         td(a({-href=>$name.'/index.html'},$title))),"\n";
 430 }
 431
 432 sub endsublist {
 433         my $self = shift;
 434         my $IND = $self->{-IND};
 435
 436         print $IND end_table,"\n",br({-clear=>'all'}),hr,"\n\n";
 437 }
 438
 439 sub startimglist {
 440         my $self = shift;
 441         my $IND = $self->{-IND};
 442         my $first = $self->{-firstimg}->{-base};
 443         my $slideref = sprintf(".html/%s-slide.html",$first);
 444
 445         print $IND h2("Images"),
 446                 a({-href=>$slideref},'Slideshow');
 447                 "\n";
 448 }
 449
 450 sub img_entry {
 451         my $self = shift;
 452         my $IND = $self->{-parent}->{-IND};
 453         my $name = $self->{-base};
 454         my $title = $self->{-info}->{'Comment'};
 455         $title = $name unless ($title);
 456         my $thumb = $self->{$sizes[0]};
 457         my $medium = $self->{$sizes[1]};
 458         my $info = $self->{-info};
 459         my ($w, $h) = dim($info);
 460
 461         #print &infobox($info,$base,$fn),"\n";
 462         print $IND table({-class=>'slide'},Tr(td(
 463                 a({-href=>".html/$name-info.html",
 464                         -onClick=>"return showIbox('$name');"},$title),
 465                 br,
 466                 a({-href=>$medium,-rel=>"lightbox",-title=>$title},
 467                         img({-src=>$thumb})),
 468                 br,
 469                 a({-href=>$name},"($w x $h)"),
 470                 br))),"\n";
 471 }
 472
 473 sub endimglist {
 474         my $self = shift;
 475         my $IND = $self->{-IND};
 476
 477         print $IND br({-clear=>'all'}),hr,"\n\n";
 478 }
 479
 480 ######################################################################
 481 =cut
 482 ######################################################################
 483
 484 &processdir(getcwd);
 485
 486 sub processdir {
 487         my ($start,$dir)=@_;
 488         my $dn=$start;
 489         $dn .= "/".$dir if ($dir);
 490         unless ( -d $dn ) {
 491                 warn "not a directory: $dn";
 492                 return;
 493         }
 494         my $D;
 495         unless (opendir($D,$dn)) {
 496                 warn "cannot opendir $dn: $!";
 497                 return;
 498         }
 499
 500 # recurse into subdirectories BEFORE opening index file
 501
 502         &iteratedir($D,$start,$dir,sub {
 503                 my ($start,$dir,$base)=@_;
 504                 my $ndir = $dir;
 505                 $ndir .= "/" if ($ndir);
 506                 $ndir .= $base;
 507                 return unless ( -d $start."/".$ndir );
 508                 &processdir($start,$ndir);
 509         });
 510
 511 # fill in title
 512
 513         my $title=&gettitle($dn,$dir);
 514
 515 # get include prefix
 516
 517         my $inc=&getinclude($dn);
 518
 519 # generate directory index unless suppressed
 520
 521         if ( -e $dn."/.noindex" ) {
 522                 open(STDOUT,">/dev/null");
 523         } else {
 524                 open(STDOUT,">".$dn."/index.html");
 525         }
 526
 527 # write HTML header
 528
 529                         -style=>{-src=>[$inc."gallery.css",
 530                                         $inc."lightbox.css"]},
 531                         -script=>[{-code=>"var incPrefix='$inc';"},
 532                                 {-src=>$inc."gallery.js"},
 533                                 {-src=>$inc."lightbox.js"}]),"\n";
 534         print a({-href=>"../index.html"},"UP");
 535         print start_center,"\n";
 536         print h1($title),"\n";
 537
 538 # create list of sub-albums
 539
 540         my $hassubdirs=0;
 541         &iteratedir($D,$start,$dir,sub {
 542                 my ($start,$dir,$base)=@_;
 543                 my $en=sprintf("%s/%s/%s",$start,$dir,$base);
 544                 return unless ( -d $en );
 545                 unless ($hassubdirs) {
 546                         print hr,h2("Albums"),start_table,"\n";
 547                         $hassubdirs=1;
 548                 }
 549                 &subalbum($base,&gettitle($en,$dir."/".$base));
 550         });
 551         print end_table,hr,"\n" if ($hassubdirs);
 552
 553 # create picture gallery
 554
 555         my @piclist=();
 556         my @infolist=();
 557
 558         my $haspics=0;
 559         &iteratedir($D,$start,$dir,sub {
 560                 my ($start,$dir,$base)=@_;
 561                 my $en=sprintf("%s/%s/%s",$start,$dir,$base);
 562                 return unless ( -f $en );
 563                 my $info = image_info($en);
 564                 if (my $error = $info->{error}) {
 565                         if (($error !~ "Unrecognized file format") &&
 566                             ($error !~ "Can't read head")) {
 567                                 print STDERR "File \"$en\": $error\n";
 568                         }
 569                         return;
 570                 }
 571                 if (&processfile($start,$dir,$base,$en,$info)) {
 572                         $haspics=1;
 573                         push(@piclist,$base);
 574                         push(@infolist,$info);
 575                 }
 576         });
 577
 578 # write HTML footer
 579
 580         print br({-clear=>"all"}),"\n";
 581         print a({-href=>".html/".$piclist[0]."-slide.html"},"Slideshow");
 582         print hr,"\n" if ($haspics);
 583         print end_center,"\n";
 584         print end_html,"\n";
 585
 586         close(STDOUT);
 587         closedir($D);
 588
 589 # generate html files for slideshow from @piclist
 590
 591         for (my $i=0;$i<=$#piclist;$i++) {
 592                 my $base=$piclist[$i];
 593                 my $pbase;
 594                 my $nbase;
 595                 $pbase=$piclist[$i-1] if ($i>0);
 596                 $nbase=$piclist[$i+1] if ($i<$#piclist);
 597                 for my $refresh('static','slide') {
 598                         &mkauxfile($start,$dir,$pbase,$base,$nbase,
 599                                         $refresh,$infolist[$i]);
 600                 }
 601         }
 602
 603 }
 604
 605 #############################################################
 606 # helper functions
 607 #############################################################
 608
 609 sub iteratedir {
 610         my ($D,$start,$dir,$prog)=@_;
 611         my @list=();
 612         while (my $de=readdir($D)) {
 613                 next if ($de =~ /^\./);
 614                 push(@list,$de);
 615         }
 616         foreach my $de(sort @list) {
 617                 &$prog($start,$dir,$de);
 618         }
 619         rewinddir($D);
 620 }
 621
 622 sub getinclude {
 623         my ($dn)=@_;
 624
 625         my $depth=20;
 626         my $str="";
 627         #print STDERR "start include ",$dn."/".$str.".include","\n";
 628         while ( ! -d $dn."/".$str.".include" ) {
 629                 #print STDERR "not include ",$dn."/".$str.".include","\n";
 630                 $str.="../";
 631                 last unless ($depth--);
 632         }
 633         #print STDERR "end include ",$dn."/".$str.".include","\n";
 634         if ( -d $dn."/".$str.".include" ) {
 635                 #print STDERR "return include ".$str.".include/".$fn,"\n";
 636                 return $str.".include/";
 637         } else {
 638                 return ""; # won't work anyway but return something
 639         }
 640 }
 641
 642 sub gettitle {
 643         my ($dir,$dflt)=@_;
 644
 645         my $F;
 646         my $str;
 647         if (open($F,"<".$dir."/.title")) {
 648                 $str=<$F>;
 649                 chop $str;
 650                 close($F);
 651         } else {
 652                 print STDERR "enter title for $dir\n";
 653                 $str=<>;
 654                 if ($str =~ /^\s*$/) {
 655                         $str=$dflt;
 656                 }
 657                 if (open($F,">".$dir."/.title")) {
 658                         print $F $str,"\n";
 659                         close($F);
 660                 } else {
 661                         print STDERR "cant open .title in $dir for writing: $!";
 662                 }
 663         }
 664         return $str;
 665 }
 666
 667 sub subalbum {
 668         my ($base,$title)=@_;
 669
 670         print Tr({-bgcolor=>"#c0c0c0"},
 671                 td(a({-href=>$base."/index.html"},$base)),
 672                 td(a({-href=>$base."/index.html"},$title))),"\n";
 673 }
 674
 675 sub processfile {
 676         my ($start,$dir,$base,$fn,$info)=@_;
 677
 678         my ($w,$h) = dim($info);
 679         my $title=$info->{'Comment'};
 680         $title=$base unless ($title);
 681         my $thumb=&scale($start,$dir,$base,$fn,160,$info);
 682         my $medium=&scale($start,$dir,$base,$fn,640,$info);
 683         print &infobox($info,$base,$fn),"\n";
 684         print table({-class=>'slide'},Tr(td(
 685                 a({-href=>".html/$base-info.html",
 686                         -onClick=>"return showIbox('$base');"},$title),
 687                 br,
 688                 a({-href=>$medium,-rel=>"lightbox",-title=>$title},
 689                         img({-src=>$thumb})),
 690                 br,
 691                 a({-href=>$base},"($w x $h)"),
 692                 br))),"\n";
 693         return 1;
 694 }
 695
 696 sub infobox {
 697         my ($info,$base,$fn)=@_;
 698
 699         my @infokeys=(
 700                 'DateTime',
 701                 'ExposureTime',
 702                 'FNumber',
 703                 'Flash',
 704                 'ISOSpeedRatings',
 705                 'MeteringMode',
 706                 'ExposureProgram',
 707                 'FocalLength',
 708                 'FileSource',
 709                 'Make',
 710                 'Model',
 711                 'Software',
 712         );
 713
 714         my $msg=start_div({-class=>'ibox',-id=>$base,-OnClick=>"HideIbox('$base');"});
 715         $msg.=span({-style=>'float: left;'},"Info for $base").
 716                 span({-style=>'float: right;'},
 717                         a({-href=>"#",-OnClick=>"HideIbox('$base');"},"Close"));
 718         $msg.=br({-clear=>'all'});
 719         $msg.=start_table;
 720         foreach my $k(@infokeys) {
 721                 $msg.=Tr(td($k.":"),td($info->{$k}));
 722         }
 723         $msg.=end_table;
 724         $msg.=end_div;
 725         return $msg;
 726 }
 727
 728 sub mkauxfile {
 729         my ($start,$dir,$pbase,$base,$nbase,$refresh,$info) =@_;
 730         my $en=sprintf("%s/%s/.html/%s-%s.html",$start,$dir,$base,$refresh);
 731         my $pref;
 732         my $nref;
 733         if ($pbase) {
 734                 $pref=sprintf("%s-%s.html",$pbase,$refresh);
 735         } else {
 736                 $pref="../index.html";
 737         }
 738         if ($nbase) {
 739                 $nref=sprintf("%s-%s.html",$nbase,$refresh);
 740         } else {
 741                 $nref="../index.html";
 742         }
 743         my $toggle;
 744         my $toggleref;
 745         if ($refresh eq 'slide') {
 746                 $toggle='Stop!';
 747                 $toggleref=sprintf("%s-static.html",$base);
 748         } else {
 749                 $toggle='Play-&gt;';
 750                 $toggleref=sprintf("%s-slide.html",$base);
 751         }
 752
 753         my $tdir=sprintf "%s/%s/.html",$start,$dir;
 754         mkdir($tdir,0755) unless ( -d $tdir );
 755
 756         unless (open(STDOUT,">".$en)) {
 757                 warn "cannot open $en: $!";
 758                 return;
 759         }
 760         my $title=$info->{'Comment'};
 761         $title=$base unless ($title);
 762         if ($refresh eq 'slide') {
 763                 print start_html(-title=>$title,
 764                                 -bgcolor=>"#808080",
 765                         -head=>meta({-http_equiv=>'Refresh',
 766                                 -content=>"3; url=$nref"})),"\n";
 767         } else {
 768                 print start_html(-title=>$title,
 769                                 -bgcolor=>"#808080"),"\n";
 770         }
 771         print start_center,"\n";
 772         print h1($title);
 773         print a({-href=>"../index.html"},"Index")," | ";
 774         print a({-href=>$pref},"&lt;&lt;Prev")," | ";
 775         print a({-href=>$toggleref},$toggle)," | ";
 776         print a({-href=>$nref},"Next&gt;&gt;");
 777         print p;
 778         print img({-src=>"../.640/".$base}),"\n";
 779         print end_center,"\n";
 780         print end_html,"\n";
 781         close(STDOUT);
 782 }
 783
 784 sub scale {
 785         my ($start,$dir,$base,$fn,$tsize,$info)=@_;
 786         my ($w,$h) = dim($info);
 787         my $max=($w>$h)?$w:$h;
 788         my $factor=$tsize/$max;
 789
 790         return $base if ($factor >= 1);
 791
 792         my $tdir=sprintf "%s/%s/.%s",$start,$dir,$tsize;
 793         mkdir($tdir,0755) unless ( -d $tdir );
 794         my $tbase=sprintf ".%s/%s",$tsize,$base;
 795         my $tfn=sprintf "%s/%s",$tdir,$base;
 796         my @sstat=stat($fn);
 797         my @tstat=stat($tfn);
 798         return $tbase if (@tstat && ($sstat[9] < $tstat[9])); # [9] -> mtime
 799
 800         print STDERR "scale by $factor from $fn to $tfn\n";
 801         &doscaling($fn,$tfn,$factor,$w,$h);
 802         return $tbase;
 803 }
 804
 805 sub doscaling {
 806         my ($src,$dest,$factor,$w,$h)=@_;
 807
 808         my $im=new Image::Magick;
 809         my $err;
 810         #print STDERR "doscale $src -> $dest by $factor\n";
 811         $err=$im->Read($src);
 812         unless ($err) {
 813                 $im->Scale(width=>$w*$factor,height=>$h*$factor);
 814                 $err=$im->Write($dest);
 815                 warn "ImageMagic: write \"$dest\": $err" if ($err);
 816         } else {
 817                 warn "ImageMagic: read \"$src\": $err";
 818                 system("djpeg \"$src\" | pnmscale \"$factor\" | cjpeg >\"$dest\"");
 819         }
 820         undef $im;
 821 }