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 strftime/;
  32 use CGI qw/:html *table *Tr *center *div *Link/;
  33 use Image::Info qw/image_info dim/;
  34 use Term::ReadLine;
  35 use Getopt::Long;
  36 use Encode;
  37 use encoding 'utf-8';
  38 binmode(STDOUT, ":utf8");
  39
  40 my $haveimagick = eval { require Image::Magick; };
  41 { package Image::Magick; }      # to make perl compiler happy
  42
  43 my $haverssxml = eval { require XML::RSS; };
  44 { package XML::RSS; }           # to make perl compiler happy
  45
  46 my @sizes = (160, 640);
  47
  48 ######################################################################
  49
  50 my $incpath;
  51 my $rssobj;
  52 my $debug = 0;
  53 my $asktitle = 0;
  54 my $noasktitle = 0;
  55 my $rssfile = "";
  56
  57 charset("utf-8");
  58
  59 unless (GetOptions(
  60                 'help'=>\&help,
  61                 'incpath'=>\$incpath,
  62                 'asktitle'=>\$asktitle,
  63                 'noasktitle'=>\$noasktitle,
  64                 'rssfile=s'=>\$rssfile,
  65                 'debug'=>\$debug)) {
  66         &help;
  67 }
  68
  69 if ($rssfile && ! $haverssxml) {
  70         print STDERR "You need to get XML::RSS from CPAN to use --rssfile\n";
  71         exit 1;
  72 }
  73
  74 my $term = new Term::ReadLine "Edit Title";
  75
  76 FsObj->new(getcwd)->iterate;
  77
  78 if ($rssobj) {
  79         $rssobj->save($rssfile);
  80 }
  81
  82 sub help {
  83
  84         print STDERR <<__END__;
  85 usage: $0 [options]
  86  --help:        print help message and exit
  87  --incpath:     do not try to find .include diretory upstream, use
  88                 specified path (absolute or relavive).  Use with causion.
  89  --debug:       print a lot of debugging info to stdout as you run
  90  --asktitle:    ask to edit album titles even if there are ".title" files
  91  --noasktitle:  don't ask to enter album titles even where ".title"
  92                 files are absent.  Use partial directory names as titles.
  93  --rssfile=...: build RSS feed for newly added "albums", give name of rss file
  94 __END__
  95
  96         exit 1;
  97 }
  98
  99 sub new {
 100         my $this = shift;
 101         my $class;
 102         my $self;
 103         if (ref($this)) {
 104                 $class = ref($this);
 105                 my $parent = $this;
 106                 my $name = shift;
 107                 my $fullpath = $parent->{-fullpath}.'/'.$name;
 108                 $self = {
 109                                 -parent=>$parent,
 110                                 -root=>$parent->{-root},
 111                                 -base=>$name,
 112                                 -fullpath=>$fullpath,
 113                                 -inc=>'../'.$parent->{-inc},
 114                                 -rss=>'../'.$parent->{-rss},
 115                         };
 116         } else {
 117                 $class = $this;
 118                 my $root=shift;
 119                 $self = {
 120                                 -root=>$root,
 121                                 -fullpath=>$root,
 122                                 -inc=>getinc($root),
 123                                 -rss=>getrss($root),
 124                         };
 125         }
 126         bless $self, $class;
 127         if ($debug) {
 128                 print "new $class:\n";
 129                 foreach my $k(keys %$self) {
 130                         print "\t$k\t=\t$self->{$k}\n";
 131                 }
 132         }
 133         return $self;
 134 }
 135
 136 sub getinc {
 137         my $fullpath=shift;     # this is not a method
 138         my $depth=20;           # arbitrary max depth
 139
 140         if ($incpath) {
 141                 return $incpath."/.include";
 142         }
 143
 144         my $inc=".include";
 145         while ( ! -d $fullpath."/".$inc ) {
 146                 $inc = "../".$inc;
 147                 last unless ($depth-- > 0);
 148         }
 149         if ($depth > 0) {
 150                 return $inc.'/';                # prefix with trailing slash
 151         } else {
 152                 return 'NO-.INCLUDE-IN-PATH/';  # won't work anyway
 153         }
 154 }
 155
 156 sub getrss {
 157         my $fullpath=shift;     # this is not a method
 158         my $depth=20;           # arbitrary max depth
 159
 160         return "" unless $rssfile;
 161
 162         my $rss=$rssfile;
 163         while ( ! -f $fullpath."/".$rss ) {
 164                 $rss = "../".$rss;
 165                 last unless ($depth-- > 0);
 166         }
 167         if ($depth > 0) {
 168                 $rssobj = new XML::RSS (version=>2);
 169                 $rssobj->parsefile($rss);
 170                 return $rss;
 171         } else {
 172                 print STDERR "There is no $rssfile in this or parent ".
 173                         "directories, you must create one with mkgalrss.pl\n";
 174                 exit 1;
 175         }
 176 }
 177
 178 sub iterate {
 179         my $self = shift;
 180         my $fullpath .= $self->{-fullpath};
 181         print "iterate in dir $fullpath\n" if ($debug);
 182
 183         my $youngest=0;
 184         my @rdirlist;
 185         my @rimglist;
 186         my $D;
 187         unless (opendir($D,$fullpath)) {
 188                 warn "cannot opendir $fullpath: $!";
 189                 return;
 190         }
 191         while (my $de = readdir($D)) {
 192                 next if ($de =~ /^\./);
 193                 my $child = $self->new($de);
 194                 my @stat = stat($child->{-fullpath});
 195                 $youngest = $stat[9] if ($youngest < $stat[9]);
 196                 if ($child->isdir) {
 197                         push(@rdirlist,$child);
 198                 } elsif ($child->isimg) {
 199                         push(@rimglist,$child);
 200                 }
 201         }
 202         closedir($D);
 203         my @dirlist = sort {$a->{-base} cmp $b->{-base}} @rdirlist;
 204         undef @rdirlist; # inplace sorting would be handy here
 205         my @imglist = sort {$a->{-base} cmp $b->{-base}} @rimglist;
 206         undef @rimglist; # optimize away unsorted versions
 207         $self->{-firstimg} = $imglist[0];
 208
 209         print "Dir: $self->{-fullpath}\n" if ($debug);
 210
 211 # 1. first of all, fill title for this directory and create hidden subdirs
 212
 213         $self->initdir;
 214
 215 # 2. recurse into subdirectories to get their titles filled
 216 #    before we start writing out subalbum list
 217
 218         foreach my $dir(@dirlist) {
 219                 $dir->iterate;
 220         }
 221
 222 # 3. iterate through images to build cross-links,
 223
 224         my $previmg = undef;
 225         foreach my $img(@imglist) {
 226                 # list-linking must be done before generating
 227                 # aux html because aux pages rely on prev/next refs
 228                 if ($previmg) {
 229                         $previmg->{-nextimg} = $img;
 230                         $img->{-previmg} = $previmg;
 231                 }
 232                 $previmg=$img;
 233         }
 234
 235 # 4. create scaled versions and aux html pages
 236
 237         foreach my $img(@imglist) {
 238                 # scaled versions must be generated before aux html
 239                 # and main image index because they both rely on
 240                 # refs to scaled images and they may be just original
 241                 # images, this is not known before we try scaling.
 242                 $img->makescaled;
 243                 # finally, make aux html pages
 244                 $img->makeaux;
 245         }
 246
 247 # no need to go beyond this point if the directory timestamp did not
 248 # change since we built index.html file last time.
 249
 250         my @istat = stat($self->{-fullpath}.'/index.html');
 251         return unless ($youngest > $istat[9]);
 252
 253 # 5. start building index.html for the directory
 254
 255         $self->startindex;
 256
 257 # 6. iterate through subdirectories to build subalbums list
 258
 259         if (@dirlist) {
 260                 $self->startsublist;
 261                 foreach my $dir(@dirlist) {
 262                         $dir->sub_entry;
 263                 }
 264                 $self->endsublist;
 265         }
 266
 267 # 7. iterate through images to build thumb list
 268
 269         if (@imglist) {
 270                 $self->startimglist;
 271                 foreach my $img(@imglist) {
 272                         print "Img: $img->{-fullpath}\n" if ($debug);
 273                         $img->img_entry;
 274                 }
 275                 $self->endimglist;
 276         }
 277
 278 # 8. comlplete building index.html for the directory
 279
 280         $self->endindex;
 281 }
 282
 283 sub isdir {
 284         my $self = shift;
 285         return ( -d $self->{-fullpath} );
 286 }
 287
 288 sub isimg {
 289         my $self = shift;
 290         my $fullpath = $self->{-fullpath};
 291         return 0 unless ( -f $fullpath );
 292         my $info = image_info($fullpath);
 293         if (my $error = $info->{error}) {
 294                 if (($error !~ "Unrecognized file format") &&
 295                     ($error !~ "Can't read head")) {
 296                         warn "File \"$fullpath\": $error\n";
 297                 }
 298                 return 0;
 299         }
 300
 301         tryapp12($info) unless ($info->{'ExifVersion'});
 302
 303         $self->{-isimg} = 1;
 304         $self->{-info} = $info;
 305         return 1;
 306 }
 307
 308 sub tryapp12 {
 309         my $info = shift;       # this is not a method
 310         my $app12;
 311         # dirty hack to take care of Image::Info parser strangeness
 312         foreach my $k(keys %$info) {
 313                 $app12=substr($k,6).$info->{$k} if ($k =~ /^App12-/);
 314         }
 315         return unless ($app12); # bad luck
 316         my $seenfirstline=0;
 317         foreach my $ln(split /[\r\n]+/,$app12) {
 318                 $ln =~ s/[[:^print:]\000]/ /g;
 319                 unless ($seenfirstline) {
 320                         $seenfirstline=1;
 321                         $info->{'Make'}=$ln;
 322                         next;
 323                 }
 324                 my ($k,$v)=split /=/,$ln,2;
 325                 if ($k eq 'TimeDate') {
 326                         $info->{'DateTime'} =
 327                                 strftime("%Y:%m:%d %H:%M:%S", localtime($v))
 328                                                         unless ($v < 0);
 329                 } elsif ($k eq 'Shutter') {
 330                         $info->{'ExposureTime'} = '1/'.int(1000000/$v+.5);
 331                 } elsif ($k eq 'Flash') {
 332                         $info->{'Flash'} = $v?'Flash fired':'Flash did not fire';
 333                 } elsif ($k eq 'Type') {
 334                         $info->{'Model'} = $v;
 335                 } elsif ($k eq 'Version') {
 336                         $info->{'Software'} = $v;
 337                 } elsif ($k eq 'Fnumber') {
 338                         $info->{'FNumber'} = $v;
 339                 }
 340         }
 341 }
 342
 343 sub initdir {
 344         my $self = shift;
 345         my $fullpath = $self->{-fullpath};
 346         for my $subdir(@sizes, 'html') {
 347                 my $tdir=sprintf "%s/.%s",$self->{-fullpath},$subdir;
 348                 mkdir($tdir,0755) unless ( -d $tdir );
 349         }
 350         $self->edittitle;
 351 }
 352
 353 sub edittitle {
 354         my $self = shift;
 355         my $fullpath = $self->{-fullpath};
 356         my $title;
 357         my $T;
 358         if (open($T,'<'.$fullpath.'/.title')) {
 359                 $title = <$T>;
 360                 $title =~ s/[\r\n]*$//;
 361                 close($T);
 362         }
 363         if ($asktitle || (!$title && !$noasktitle)) {
 364                 my $prompt = $self->{-base};
 365                 $prompt = '/' unless ($prompt);
 366                 my $OUT = $term->OUT || \*STDOUT;
 367                 print $OUT "Enter title for $fullpath\n";
 368                 $title = $term->readline($prompt.' >',$title);
 369                 $term->addhistory($title) if ($title);
 370                 if (open($T,'>'.$fullpath.'/.title')) {
 371                         print $T $title,"\n";
 372                         close($T);
 373                 }
 374         }
 375         unless ($title) {
 376                 $title=substr($fullpath,length($self->{-root}));
 377         }
 378         $self->{-title}=$title;
 379         print "title in $fullpath is $title\n" if ($debug);
 380 }
 381
 382 sub makescaled {
 383         my $self = shift;
 384         my $fn = $self->{-fullpath};
 385         my $name = $self->{-base};
 386         my $dn = $self->{-parent}->{-fullpath};
 387         my ($w, $h) = dim($self->{-info});
 388         my $max = ($w > $h)?$w:$h;
 389
 390         foreach my $size(@sizes) {
 391                 my $nref = '.'.$size.'/'.$name;
 392                 my $nfn = $dn.'/'.$nref;
 393                 my $factor=$size/$max;
 394                 if ($factor >= 1) {
 395                         $self->{$size} = $name; # unscaled version will do
 396                 } else {
 397                         $self->{$size} = $nref;
 398                         if (isnewer($fn,$nfn)) {
 399                                 doscaling($fn,$nfn,$factor,$w,$h);
 400                         }
 401                 }
 402         }
 403 }
 404
 405 sub isnewer {
 406         my ($fn1,$fn2) = @_;                    # this is not a method
 407         my @stat1=stat($fn1);
 408         my @stat2=stat($fn2);
 409         return (!@stat2 || ($stat1[9] > $stat2[9]));
 410         # true if $fn2 is absent or is older than $fn1
 411 }
 412
 413 sub doscaling {
 414         my ($src,$dest,$factor,$w,$h) = @_;     # this is not a method
 415
 416         my $err=1;
 417         if ($haveimagick) {
 418                 my $im = new Image::Magick;
 419                 print "doscaling $src -> $dest by $factor\n" if ($debug);
 420                 if ($err = $im->Read($src)) {
 421                         warn "ImageMagick: read \"$src\": $err";
 422                 } else {
 423                         $im->Scale(width=>$w*$factor,height=>$h*$factor);
 424                         $err=$im->Write($dest);
 425                         warn "ImageMagick: write \"$dest\": $err" if ($err);
 426                 }
 427                 undef $im;
 428         }
 429         if ($err) {     # fallback to command-line tools
 430                 system("djpeg \"$src\" | pnmscale \"$factor\" | cjpeg >\"$dest\"");
 431         }
 432 }
 433
 434 sub makeaux {
 435         my $self = shift;
 436         my $name = $self->{-base};
 437         my $dn = $self->{-parent}->{-fullpath};
 438         my $pref = $self->{-previmg}->{-base};
 439         my $nref = $self->{-nextimg}->{-base};
 440         my $inc = $self->{-inc};
 441         my $title = $self->{-info}->{'Comment'};
 442         $title = $name unless ($title);
 443
 444         print "slide: \"$title\": \"$pref\"->\"$name\"->\"$nref\"\n" if ($debug);
 445
 446         # slideshow
 447         for my $refresh('static', 'slide') {
 448                 my $fn = sprintf("%s/.html/%s-%s.html",$dn,$name,$refresh);
 449                 if (isnewer($self->{-fullpath},$fn)) {
 450                         my $imgsrc = '../'.$self->{$sizes[1]};
 451                         my $fwdref;
 452                         my $bakref;
 453                         if ($nref) {
 454                                 $fwdref = sprintf("%s-%s.html",$nref,$refresh);
 455                         } else {
 456                                 $fwdref = '../index.html';
 457                         }
 458                         if ($pref) {
 459                                 $bakref = sprintf("%s-%s.html",$pref,$refresh);
 460                         } else {
 461                                 $bakref = '../index.html';
 462                         }
 463                         my $toggleref;
 464                         my $toggletext;
 465                         if ($refresh eq 'slide') {
 466                                 $toggleref=sprintf("%s-static.html",$name);
 467                                 $toggletext = 'Stop!';
 468                         } else {
 469                                 $toggleref=sprintf("%s-slide.html",$name);
 470                                 $toggletext = 'Play-&gt;';
 471                         }
 472                         my $F;
 473                         unless (open($F,'>'.$fn)) {
 474                                 warn "cannot open \"$fn\": $!";
 475                                 next;
 476                         }
 477                         binmode($F, ":utf8");
 478                         if ($refresh eq 'slide') {
 479                                 print $F start_html(
 480                                         -encoding=>"utf-8",
 481                                         -title=>$title,
 482                                         -bgcolor=>"#808080",
 483                                         -head=>meta({-http_equiv=>'Refresh',
 484                                                 -content=>"3; url=$fwdref"}),
 485                                         -style=>{-src=>$inc."gallery.css"},
 486                                         ),"\n";
 487
 488                         } else {
 489                                 print $F start_html(-title=>$title,
 490                                         -encoding=>"utf-8",
 491                                         -bgcolor=>"#808080",
 492                                         -style=>{-src=>$inc."gallery.css"},
 493                                         ),"\n";
 494                         }
 495                         print $F start_center,"\n",
 496                                 h1($title),"\n",
 497                                 start_table({-class=>'navi'}),start_Tr,"\n",
 498                                 td(a({-href=>"../index.html"},"Index")),"\n",
 499                                 td(a({-href=>$bakref},"&lt;&lt;Prev")),"\n",
 500                                 td(a({-href=>$toggleref},$toggletext)),"\n",
 501                                 td(a({-href=>$fwdref},"Next&gt;&gt;")),"\n",
 502                                 end_Tr,
 503                                 end_table,"\n",
 504                                 table({-class=>'picframe'},
 505                                         Tr(td(img({-src=>$imgsrc})))),"\n",
 506                                 end_center,"\n",
 507                                 end_html,"\n";
 508                         close($F);
 509                 }
 510         }
 511
 512         # info html
 513         my $fn = sprintf("%s/.html/%s-info.html",$dn,$name);
 514         if (isnewer($self->{-fullpath},$fn)) {
 515                 my $F;
 516                 unless (open($F,'>'.$fn)) {
 517                         warn "cannot open \"$fn\": $!";
 518                         return;
 519                 }
 520                 my $imgsrc = sprintf("../.%s/%s",$sizes[0],$name);
 521                 print $F start_html(-title=>$title,
 522                                 -encoding=>"utf-8",
 523                                 -style=>{-src=>$inc."gallery.css"},),"\n",
 524                         start_center,"\n",
 525                         h1($title),"\n",
 526                         table({-class=>'ipage'},
 527                                 Tr(td(img({-src=>$imgsrc})),
 528                                         td($self->infotable))),
 529                         a({-href=>'../index.html'},'Index'),"\n",
 530                         end_center,"\n",
 531                         end_html,"\n";
 532                 close($F);
 533         }
 534 }
 535
 536 sub startindex {
 537         my $self = shift;
 538         my $fn = $self->{-fullpath}.'/index.html';
 539         my $block = $self->{-fullpath}.'/.noindex';
 540         $fn = '/dev/null' if ( -f $block );
 541         my $IND;
 542         unless (open($IND,'>'.$fn)) {
 543                 warn "cannot open $fn: $!";
 544                 return;
 545         }
 546         binmode($IND, ":utf8");
 547         $self->{-IND} = $IND;
 548
 549         my $inc = $self->{-inc};
 550         my $title = $self->{-title};
 551         my $rsslink="";
 552         if ($self->{-rss}) {
 553                 $rsslink=Link({-rel=>'alternate',
 554                                 -type=>'application/rss+xml',
 555                                 -title=>'RSS',
 556                                 -href=>$self->{-rss}});
 557         }
 558         print $IND start_html(-title => $title,
 559                         -encoding=>"utf-8",
 560                         -head=>$rsslink,
 561                         -style=>{-src=>[$inc."gallery.css",
 562                                         $inc."lightbox.css"]},
 563                         -script=>[{-code=>"var incPrefix='$inc';"},
 564                                 {-src=>$inc."gallery.js"},
 565                                 {-src=>$inc."lightbox.js"}]),
 566                 a({-href=>"../index.html"},"UP"),"\n",
 567                 start_center,"\n",
 568                 h1($title),"\n",
 569                 "\n";
 570 }
 571
 572 sub endindex {
 573         my $self = shift;
 574         my $IND = $self->{-IND};
 575
 576         print $IND end_center,end_html,"\n";
 577
 578         close($IND) if ($IND);
 579         undef $self->{-IND};
 580         print STDERR "title=",$self->{-title},
 581                 ", numofsubs=",$self->{-numofsubs},
 582                 ", numofimgs=",$self->{-numofimgs},"\n";
 583         if ($rssobj) {
 584                 my $rsstitle=sprintf "%s [%d images, %d subalbums]",
 585                                 $self->{-title},
 586                                 $self->{-numofimgs},
 587                                 $self->{-numofsubs};
 588                 my $rsslink=$rssobj->channel('link')."index.html";
 589                 $rssobj->add_item(
 590                         title           => $self->{-title},
 591                         link            => $rsslink,
 592                         description     => $rsstitle,
 593                 );
 594         }
 595 }
 596
 597 sub startsublist {
 598         my $self = shift;
 599         my $IND = $self->{-IND};
 600
 601         print $IND h2("Albums"),"\n",start_table,"\n";
 602 }
 603
 604 sub sub_entry {
 605         my $self = shift;
 606         my $IND = $self->{-parent}->{-IND};
 607         my $name = $self->{-base};
 608         my $title = $self->{-title};
 609
 610         $self->{-parent}->{-numofsubs}++;
 611         print $IND Tr(td(a({-href=>$name.'/index.html'},$name)),
 612                         td(a({-href=>$name.'/index.html'},$title))),"\n";
 613 }
 614
 615 sub endsublist {
 616         my $self = shift;
 617         my $IND = $self->{-IND};
 618
 619         print $IND end_table,"\n",br({-clear=>'all'}),hr,"\n\n";
 620 }
 621
 622 sub startimglist {
 623         my $self = shift;
 624         my $IND = $self->{-IND};
 625         my $first = $self->{-firstimg}->{-base};
 626         my $slideref = sprintf(".html/%s-slide.html",$first);
 627
 628         print $IND h2("Images"),"\n",
 629                 a({-href=>$slideref},'Slideshow'),
 630                 "\n";
 631 }
 632
 633 sub img_entry {
 634         my $self = shift;
 635         my $IND = $self->{-parent}->{-IND};
 636         my $name = $self->{-base};
 637         my $title = $self->{-info}->{'Comment'};
 638         $title = $name unless ($title);
 639         my $thumb = $self->{$sizes[0]};
 640         my $medium = $self->{$sizes[1]};
 641         my $info = $self->{-info};
 642         my ($w, $h) = dim($info);
 643
 644         $self->{-parent}->{-numofimgs}++;
 645         print $IND start_div({-class=>'ibox',-id=>$name,
 646                                 -OnClick=>"HideIbox('$name');"}),"\n",
 647                 start_div({-class=>'iboxtitle'}),
 648                 span({-style=>'float: left;'},b("Info for $name")),
 649                 span({-style=>'float: right;'},
 650                         a({-href=>"#",-OnClick=>"HideIbox('$name');"},"Close")),
 651                 br({-clear=>'all'}),"\n",
 652                 end_div,"\n",
 653                 $self->infotable,
 654                 end_div,"\n";
 655
 656         print $IND table({-class=>'slide'},Tr(td(
 657                 a({-href=>".html/$name-info.html",-title=>'Image Info',
 658                         -onClick=>"return showIbox('$name');"},$title),
 659                 br,
 660                 a({-href=>$medium,-rel=>"lightbox",-title=>$title},
 661                         img({-src=>$thumb})),
 662                 br,
 663                 a({-href=>$name,-title=>'Original Image'},"($w x $h)"),
 664                 br))),"\n";
 665 }
 666
 667 sub endimglist {
 668         my $self = shift;
 669         my $IND = $self->{-IND};
 670
 671         print $IND br({-clear=>'all'}),hr,"\n\n";
 672 }
 673
 674 sub infotable {
 675         my $self = shift;
 676         my $info = $self->{-info};
 677         my $msg='';
 678
 679         my @infokeys=(
 680                 'DateTime',
 681                 'ExposureTime',
 682                 'FNumber',
 683                 'Flash',
 684                 'ISOSpeedRatings',
 685                 'MeteringMode',
 686                 'ExposureProgram',
 687                 'FocalLength',
 688                 'FileSource',
 689                 'Make',
 690                 'Model',
 691                 'Software',
 692         );
 693         $msg.=start_table({-class=>'infotable'})."\n";
 694         foreach my $k(@infokeys) {
 695                 $msg.=Tr(td($k.":"),td($info->{$k}))."\n" if ($info->{$k});
 696         }
 697         $msg.=end_table."\n";
 698 }
 699