385342ca0bcfa9b10dc13577fe7e186a0601c57d
[mkgallery.git] / mkgallery.pl
1 #!/usr/bin/perl
2
3 # $Id$
4
5 # Recursively create image gallery index and slideshow wrappings.
6 # Makes use of (slightly modified) "lightbox" Javascript/CSS as published
7 # at http://www.huddletogether.com/projects/lightbox/
8
9 # Copyright (c) 2006 Eugene G. Crosser
10
11 #  This software is provided 'as-is', without any express or implied
12 #  warranty.  In no event will the authors be held liable for any damages
13 #  arising from the use of this software.
14 #
15 #  Permission is granted to anyone to use this software for any purpose,
16 #  including commercial applications, and to alter it and redistribute it
17 #  freely, subject to the following restrictions:
18 #
19 #  1. The origin of this software must not be misrepresented; you must not
20 #     claim that you wrote the original software. If you use this software
21 #     in a product, an acknowledgment in the product documentation would be
22 #     appreciated but is not required.
23 #  2. Altered source versions must be plainly marked as such, and must not be
24 #     misrepresented as being the original software.
25 #  3. This notice may not be removed or altered from any source distribution.
26
27 package FsObj;
28
29 use strict;
30 use Carp;
31 use POSIX qw/getcwd/;
32 use CGI qw/:html *table *center *div/;
33 use Image::Info qw/image_info dim/;
34 use Term::ReadLine;
35 use Getopt::Long;
36
37 use Image::Magick;
38
39 my @sizes = (160, 640);
40
41 ######################################################################
42
43 my $debug = 0;
44 my $asktitle = 0;
45 my $noasktitle = 0;
46
47 GetOptions('asktitle'=>\$asktitle,
48                 'noasktitle'=>\$noasktitle,
49                 'debug'=>\$debug);
50
51 my $term = new Term::ReadLine "Edit Title";
52
53 FsObj->new(getcwd)->iterate;
54
55 sub new {
56         my $this = shift;
57         my $class;
58         my $self;
59         if (ref($this)) {
60                 $class = ref($this);
61                 my $parent = $this;
62                 my $name = shift;
63                 my $fullpath = $parent->{-fullpath}.'/'.$name;
64                 $self = {
65                                 -parent=>$parent,
66                                 -root=>$parent->{-root},
67                                 -base=>$name,
68                                 -fullpath=>$fullpath,
69                                 -inc=>'../'.$parent->{-inc},
70                         };
71         } else {
72                 $class = $this;
73                 my $root=shift;
74                 $self = {
75                                 -root=>$root,
76                                 -fullpath=>$root,
77                                 -inc=>getinc($root),
78                         };
79         }
80         bless $self, $class;
81         if ($debug) {
82                 print "new $class:\n";
83                 foreach my $k(keys %$self) {
84                         print "\t$k\t=\t$self->{$k}\n";
85                 }
86         }
87         return $self;
88 }
89
90 sub getinc {
91         my $fullpath=shift;     # this is not a method
92         my $depth=20;           # arbitrary max depth
93
94         my $inc=".include";
95         while ( ! -d $fullpath."/".$inc ) {
96                 $inc = "../".$inc;
97                 last unless ($depth-- > 0);
98         }
99         if ($depth > 0) {
100                 return $inc.'/';                # prefix with trailing slash
101         } else {
102                 return 'NO-.INCLUDE-IN-PATH/';  # won't work anyway
103         }
104 }
105
106 sub iterate {
107         my $self = shift;
108         my $fullpath .= $self->{-fullpath};
109         print "iterate in dir $fullpath\n" if ($debug);
110
111         my @rdirlist;
112         my @rimglist;
113         my $D;
114         unless (opendir($D,$fullpath)) {
115                 warn "cannot opendir $fullpath: $!";
116                 return;
117         }
118         while (my $de = readdir($D)) {
119                 next if ($de =~ /^\./);
120                 my $child = $self->new($de);
121                 if ($child->isdir) {
122                         push(@rdirlist,$child);
123                 } elsif ($child->isimg) {
124                         push(@rimglist,$child);
125                 }
126         }
127         closedir($D);
128         my @dirlist = sort {$a->{-base} cmp $b->{-base}} @rdirlist;
129         undef @rdirlist; # inplace sorting would be handy here
130         my @imglist = sort {$a->{-base} cmp $b->{-base}} @rimglist;
131         undef @rimglist; # optimize away unsorted versions
132
133         print "Dir: $self->{-fullpath}\n" if ($debug);
134
135 # 1. first of all, fill title for this directory and create hidden subdirs
136
137         $self->initdir;
138
139 # 2. recurse into subdirectories to get their titles filled
140 #    before we start writing out subalbum list
141
142         foreach my $dir(@dirlist) {
143                 $dir->iterate;
144         }
145
146 # 3. iterate through images to build cross-links,
147
148         my $previmg = undef;
149         foreach my $img(@imglist) {
150                 # list-linking must be done before generating
151                 # aux html because aux pages rely on prev/next refs
152                 if ($previmg) {
153                         $previmg->{-nextimg} = $img;
154                         $img->{-previmg} = $previmg;
155                 }
156                 $previmg=$img;
157         }
158
159 # 4. create scaled versions and aux html pages
160
161         foreach my $img(@imglist) {
162                 # scaled versions must be generated before aux html
163                 # and main image index because they both rely on
164                 # refs to scaled images and they may be just original
165                 # images, this is not known before we try scaling.
166                 $img->makescaled;
167                 # finally, make aux html pages
168                 $img->makeaux;
169         }
170
171 # 5. start building index.html for the directory
172
173         $self->startindex;
174
175 # 6. iterate through subdirectories to build subalbums list
176
177         if (@dirlist) {
178                 $self->startsublist;
179                 foreach my $dir(@dirlist) {
180                         $dir->sub_entry;
181                 }
182                 $self->endsublist;
183         }
184
185 # 7. iterate through images to build thumb list
186
187         if (@imglist) {
188                 $self->startimglist;
189                 foreach my $img(@imglist) {
190                         print "Img: $img->{-fullpath}\n" if ($debug);
191                         $img->img_entry;
192                 }
193                 $self->endimglist;
194         }
195
196 # 8. comlplete building index.html for the directory
197
198         $self->endindex;
199 }
200
201 sub isdir {
202         my $self = shift;
203         return ( -d $self->{-fullpath} );
204 }
205
206 sub isimg {
207         my $self = shift;
208         my $fullpath = $self->{-fullpath};
209         return 0 unless ( -f $fullpath );
210         my $info = image_info($fullpath);
211         if (my $error = $info->{error}) {
212                 if (($error !~ "Unrecognized file format") &&
213                     ($error !~ "Can't read head")) {
214                         warn "File \"$fullpath\": $error\n";
215                 }
216                 return 0;
217         }
218         $self->{-isimg} = 1;
219         $self->{-info} = $info;
220         return 1;
221 }
222
223 sub initdir {
224         my $self = shift;
225         my $fullpath = $self->{-fullpath};
226         for my $subdir(@sizes, 'html') {
227                 my $tdir=sprintf "%s/.%s",$self->{-fullpath},$subdir;
228                 mkdir($tdir,0755) unless ( -d $tdir );
229         }
230         $self->edittitle;
231 }
232
233 sub edittitle {
234         my $self = shift;
235         my $fullpath = $self->{-fullpath};
236         my $title;
237         my $T;
238         if (open($T,'<'.$fullpath.'/.title')) {
239                 $title = <$T>;
240                 $title =~ s/[\r\n]*$//;
241                 close($T);
242         }
243         if ($asktitle || (!$title && !$noasktitle)) {
244                 my $prompt = $self->{-base};
245                 $prompt = '/' unless ($prompt);
246                 my $OUT = $term->OUT || \*STDOUT;
247                 print $OUT "Enter title for $fullpath\n";
248                 $title = $term->readline($prompt.' >',$title);
249                 $term->addhistory($title) if ($title);
250                 if (open($T,'>'.$fullpath.'/.title')) {
251                         print $T $title,"\n";
252                         close($T);
253                 }
254         }
255         unless ($title) {
256                 $title=substr($fullpath,length($self->{-root}));
257         }
258         $self->{-title}=$title;
259         print "title in $fullpath is $title\n" if ($debug);
260 }
261
262 sub makescaled {
263         my $self = shift;
264         my $fn = $self->{-fullpath};
265         my $name = $self->{-base};
266         my $dn = $self->{-parent}->{-fullpath};
267         my ($w, $h) = dim($self->{-info});
268         my $max = ($w > $h)?$w:$h;
269
270         foreach my $size(@sizes) {
271                 my $nref = '.'.$size.'/'.$name;
272                 my $nfn = $dn.'/'.$nref;
273                 my $factor=$size/$max;
274                 if ($factor >= 1) {
275                         $self->{$size} = $name; # unscaled version will do
276                 } else {
277                         $self->{$size} = $nref;
278                         if (isnewer($fn,$nfn)) {
279                                 doscaling($fn,$nfn,$factor,$w,$h);
280                         }
281                 }
282         }
283 }
284
285 sub isnewer {
286         my ($fn1,$fn2) = @_;                    # this is not a method
287         my @stat1=stat($fn1);
288         my @stat2=stat($fn2);
289         return (!@stat2 || ($stat1[9] > $stat2[9]));
290         # true if $fn2 is absent or is older than $fn1
291 }
292
293 sub doscaling {
294         my ($src,$dest,$factor,$w,$h) = @_;     # this is not a method
295         my $im = new Image::Magick;
296         my $err;
297         print "doscaling $src -> $dest by $factor\n" if ($debug);
298         $err = $im->Read($src);
299         unless ($err) {
300                 $im->Scale(width=>$w*$factor,height=>$h*$factor);
301                 $err=$im->Write($dest);
302                 warn "ImageMagick: write \"$dest\": $err" if ($err);
303         } else {        # fallback to command-line tools
304                 warn "ImageMagick: read \"$src\": $err";
305                 system("djpeg \"$src\" | pnmscale \"$factor\" | cjpeg >\"$dest\"");
306         }
307         undef $im;
308 }
309
310 sub makeaux {
311         my $self = shift;
312         my $name = $self->{-base};
313         my $dn = $self->{-parent}->{-fullpath};
314         my $pref = $self->{-previmg}->{-base};
315         my $nref = $self->{-nextimg}->{-base};
316         my $inc = $self->{-inc};
317         my $title = $self->{-info}->{'Comment'};
318         $title = $name unless ($title);
319
320         print "slide: \"$pref\"->\"$name\"->\"$nref\"\n" if ($debug);
321
322         # slideshow
323         for my $refresh('static', 'slide') {
324                 my $fn = sprintf("%s/.html/%s-%s.html",$dn,$name,$refresh);
325                 my $bakref = sprintf("%s-%s.html",$pref,$refresh);
326                 my $fwdref = sprintf("%s-%s.html",$nref,$refresh);
327                 my $imgsrc = sprintf("../.%s/%s",$sizes[1],$name);
328                 my $toggleref;
329                 my $toggletext;
330                 if ($refresh eq 'slide') {
331                         $toggleref=sprintf("%s-static.html",$name);
332                         $toggletext = 'Stop!';
333                 } else {
334                         $toggleref=sprintf("%s-slide.html",$name);
335                         $toggletext = 'Play-&gt;';
336                 }
337                 my $F;
338                 unless (open($F,'>'.$fn)) {
339                         warn "cannot open \"$fn\": $!";
340                         next;
341                 }
342                 if ($refresh eq 'slide') {
343                         print $F start_html(-title=>$title,
344                                         -bgcolor=>"#808080",
345                                         -head=>meta({-http_equiv=>'Refresh',
346                                                 -content=>"3; url=$fwdref"}),
347                                         -style=>{-src=>$inc."gallery.css"},
348                                 ),"\n";
349                                         
350                 } else {
351                         print $F start_html(-title=>$title,
352                                         -bgcolor=>"#808080",
353                                         -style=>{-src=>$inc."gallery.css"},
354                                 ),"\n";
355                 }
356                 print $F start_center,"\n",
357                         h1($title),
358                         a({-href=>"../index.html"},"Index")," | ",
359                         a({-href=>$bakref},"&lt;&lt;Prev")," | ",
360                         a({-href=>$toggleref},$toggletext)," | ",
361                         a({-href=>$fwdref},"Next&gt;&gt;"),
362                         p,
363                         img({-src=>$imgsrc}),"\n",
364                         end_center,"\n",
365                         end_html,"\n";
366                 close($F);
367         }
368 }
369
370 sub startindex {
371         my $self = shift;
372         my $fn = $self->{-fullpath}.'/index.html';
373         my $IND;
374         unless (open($IND,'>'.$fn)) {
375                 warn "cannot open $fn: $!";
376                 return;
377         }
378         $self->{-IND} = $IND;
379
380         my $inc = $self->{-inc};
381         my $title = $self->{-title};
382         print $IND start_html(-title => $title,
383                         -style=>{-src=>[$inc."gallery.css",
384                                         $inc."lightbox.css"]},
385                         -script=>[{-code=>"var incPrefix='$inc';"},
386                                 {-src=>$inc."gallery.js"},
387                                 {-src=>$inc."lightbox.js"}]),
388                 a({-href=>"../index.html"},"UP"),"\n",
389                 start_center,"\n",
390                 h1($title),"\n",
391                 "\n";
392 }
393
394 sub endindex {
395         my $self = shift;
396         my $IND = $self->{-IND};
397
398         print $IND end_center,end_html,"\n";
399
400         close($IND) if ($IND);
401         undef $self->{-IND};
402 }
403
404 sub startsublist {
405         my $self = shift;
406         my $IND = $self->{-IND};
407
408         print $IND h2("Albums"),"\n",start_table,"\n";
409 }
410
411 sub sub_entry {
412         my $self = shift;
413         my $IND = $self->{-parent}->{-IND};
414         my $name = $self->{-base};
415         my $title = $self->{-title};
416
417         print $IND Tr(td(a({-href=>$name.'/index.html'},$name)),
418                         td(a({-href=>$name.'/index.html'},$title))),"\n";
419 }
420
421 sub endsublist {
422         my $self = shift;
423         my $IND = $self->{-IND};
424
425         print $IND end_table,"\n",br({-clear=>'all'}),hr,"\n\n";
426 }
427
428 sub startimglist {
429         my $self = shift;
430         my $IND = $self->{-IND};
431
432         print $IND h2("Images"),"\n";
433 }
434
435 sub img_entry {
436         my $self = shift;
437         my $IND = $self->{-parent}->{-IND};
438         my $name = $self->{-base};
439
440         print $IND a({-href=>$name},$name),"\n";
441 }
442
443 sub endimglist {
444         my $self = shift;
445         my $IND = $self->{-IND};
446
447         print $IND br({-clear=>'all'}),hr,"\n\n";
448 }
449
450 ######################################################################
451 =cut
452 ######################################################################
453
454 &processdir(getcwd);
455
456 sub processdir {
457         my ($start,$dir)=@_;
458         my $dn=$start;
459         $dn .= "/".$dir if ($dir);
460         unless ( -d $dn ) {
461                 warn "not a directory: $dn";
462                 return;
463         }
464         my $D;
465         unless (opendir($D,$dn)) {
466                 warn "cannot opendir $dn: $!";
467                 return;
468         }
469
470 # recurse into subdirectories BEFORE opening index file
471
472         &iteratedir($D,$start,$dir,sub {
473                 my ($start,$dir,$base)=@_;
474                 my $ndir = $dir;
475                 $ndir .= "/" if ($ndir);
476                 $ndir .= $base;
477                 return unless ( -d $start."/".$ndir );
478                 &processdir($start,$ndir);
479         });
480
481 # fill in title
482
483         my $title=&gettitle($dn,$dir);
484
485 # get include prefix
486
487         my $inc=&getinclude($dn);
488
489 # generate directory index unless suppressed
490
491         if ( -e $dn."/.noindex" ) {
492                 open(STDOUT,">/dev/null");
493         } else {
494                 open(STDOUT,">".$dn."/index.html");
495         }
496
497 # write HTML header
498
499                         -style=>{-src=>[$inc."gallery.css",
500                                         $inc."lightbox.css"]},
501                         -script=>[{-code=>"var incPrefix='$inc';"},
502                                 {-src=>$inc."gallery.js"},
503                                 {-src=>$inc."lightbox.js"}]),"\n";
504         print a({-href=>"../index.html"},"UP");
505         print start_center,"\n";
506         print h1($title),"\n";
507
508 # create list of sub-albums
509
510         my $hassubdirs=0;
511         &iteratedir($D,$start,$dir,sub {
512                 my ($start,$dir,$base)=@_;
513                 my $en=sprintf("%s/%s/%s",$start,$dir,$base);
514                 return unless ( -d $en );
515                 unless ($hassubdirs) {
516                         print hr,h2("Albums"),start_table,"\n";
517                         $hassubdirs=1;
518                 }
519                 &subalbum($base,&gettitle($en,$dir."/".$base));
520         });
521         print end_table,hr,"\n" if ($hassubdirs);
522
523 # create picture gallery
524
525         my @piclist=();
526         my @infolist=();
527
528         my $haspics=0;
529         &iteratedir($D,$start,$dir,sub {
530                 my ($start,$dir,$base)=@_;
531                 my $en=sprintf("%s/%s/%s",$start,$dir,$base);
532                 return unless ( -f $en );
533                 my $info = image_info($en);
534                 if (my $error = $info->{error}) {
535                         if (($error !~ "Unrecognized file format") &&
536                             ($error !~ "Can't read head")) {
537                                 print STDERR "File \"$en\": $error\n";
538                         }
539                         return;
540                 }
541                 if (&processfile($start,$dir,$base,$en,$info)) {
542                         $haspics=1;
543                         push(@piclist,$base);
544                         push(@infolist,$info);
545                 }
546         });
547
548 # write HTML footer
549
550         print br({-clear=>"all"}),"\n";
551         print a({-href=>".html/".$piclist[0]."-slide.html"},"Slideshow");
552         print hr,"\n" if ($haspics);
553         print end_center,"\n";
554         print end_html,"\n";
555
556         close(STDOUT);
557         closedir($D);
558
559 # generate html files for slideshow from @piclist
560
561         for (my $i=0;$i<=$#piclist;$i++) {
562                 my $base=$piclist[$i];
563                 my $pbase;
564                 my $nbase;
565                 $pbase=$piclist[$i-1] if ($i>0);
566                 $nbase=$piclist[$i+1] if ($i<$#piclist);
567                 for my $refresh('static','slide') {
568                         &mkauxfile($start,$dir,$pbase,$base,$nbase,
569                                         $refresh,$infolist[$i]);
570                 }
571         }
572
573 }
574
575 #############################################################
576 # helper functions
577 #############################################################
578
579 sub iteratedir {
580         my ($D,$start,$dir,$prog)=@_;
581         my @list=();
582         while (my $de=readdir($D)) {
583                 next if ($de =~ /^\./);
584                 push(@list,$de);
585         }
586         foreach my $de(sort @list) {
587                 &$prog($start,$dir,$de);
588         }
589         rewinddir($D);
590 }
591
592 sub getinclude {
593         my ($dn)=@_;
594
595         my $depth=20;
596         my $str="";
597         #print STDERR "start include ",$dn."/".$str.".include","\n";
598         while ( ! -d $dn."/".$str.".include" ) {
599                 #print STDERR "not include ",$dn."/".$str.".include","\n";
600                 $str.="../";
601                 last unless ($depth--);
602         }
603         #print STDERR "end include ",$dn."/".$str.".include","\n";
604         if ( -d $dn."/".$str.".include" ) {
605                 #print STDERR "return include ".$str.".include/".$fn,"\n";
606                 return $str.".include/";
607         } else {
608                 return ""; # won't work anyway but return something
609         }
610 }
611
612 sub gettitle {
613         my ($dir,$dflt)=@_;
614
615         my $F;
616         my $str;
617         if (open($F,"<".$dir."/.title")) {
618                 $str=<$F>;
619                 chop $str;
620                 close($F);
621         } else {
622                 print STDERR "enter title for $dir\n";
623                 $str=<>;
624                 if ($str =~ /^\s*$/) {
625                         $str=$dflt;
626                 }
627                 if (open($F,">".$dir."/.title")) {
628                         print $F $str,"\n";
629                         close($F);
630                 } else {
631                         print STDERR "cant open .title in $dir for writing: $!";
632                 }
633         }
634         return $str;
635 }
636
637 sub subalbum {
638         my ($base,$title)=@_;
639
640         print Tr({-bgcolor=>"#c0c0c0"},
641                 td(a({-href=>$base."/index.html"},$base)),
642                 td(a({-href=>$base."/index.html"},$title))),"\n";
643 }
644
645 sub processfile {
646         my ($start,$dir,$base,$fn,$info)=@_;
647
648         my ($w,$h) = dim($info);
649         my $title=$info->{'Comment'};
650         $title=$base unless ($title);
651         my $thumb=&scale($start,$dir,$base,$fn,160,$info);
652         my $medium=&scale($start,$dir,$base,$fn,640,$info);
653         print &infobox($info,$base,$fn),"\n";
654         print table({-class=>'slide'},Tr(td(
655                 a({-href=>".html/$base-info.html",
656                         -onClick=>"return showIbox('$base');"},$title),
657                 br,
658                 a({-href=>$medium,-rel=>"lightbox",-title=>$title},
659                         img({-src=>$thumb})),
660                 br,
661                 a({-href=>$base},"($w x $h)"),
662                 br))),"\n";
663         return 1;
664 }
665
666 sub infobox {
667         my ($info,$base,$fn)=@_;
668
669         my @infokeys=(
670                 'DateTime',
671                 'ExposureTime',
672                 'FNumber',
673                 'Flash',
674                 'ISOSpeedRatings',
675                 'MeteringMode',
676                 'ExposureProgram',
677                 'FocalLength',
678                 'FileSource',
679                 'Make',
680                 'Model',
681                 'Software',
682         );
683
684         my $msg=start_div({-class=>'ibox',-id=>$base,-OnClick=>"HideIbox('$base');"});
685         $msg.=span({-style=>'float: left;'},"Info for $base").
686                 span({-style=>'float: right;'},
687                         a({-href=>"#",-OnClick=>"HideIbox('$base');"},"Close"));
688         $msg.=br({-clear=>'all'});
689         $msg.=start_table;
690         foreach my $k(@infokeys) {
691                 $msg.=Tr(td($k.":"),td($info->{$k}));
692         }
693         $msg.=end_table;
694         $msg.=end_div;
695         return $msg;
696 }
697
698 sub mkauxfile {
699         my ($start,$dir,$pbase,$base,$nbase,$refresh,$info) =@_;
700         my $en=sprintf("%s/%s/.html/%s-%s.html",$start,$dir,$base,$refresh);
701         my $pref;
702         my $nref;
703         if ($pbase) {
704                 $pref=sprintf("%s-%s.html",$pbase,$refresh);
705         } else {
706                 $pref="../index.html";
707         }
708         if ($nbase) {
709                 $nref=sprintf("%s-%s.html",$nbase,$refresh);
710         } else {
711                 $nref="../index.html";
712         }
713         my $toggle;
714         my $toggleref;
715         if ($refresh eq 'slide') {
716                 $toggle='Stop!';
717                 $toggleref=sprintf("%s-static.html",$base);
718         } else {
719                 $toggle='Play-&gt;';
720                 $toggleref=sprintf("%s-slide.html",$base);
721         }
722
723         my $tdir=sprintf "%s/%s/.html",$start,$dir;
724         mkdir($tdir,0755) unless ( -d $tdir );
725
726         unless (open(STDOUT,">".$en)) {
727                 warn "cannot open $en: $!";
728                 return;
729         }
730         my $title=$info->{'Comment'};
731         $title=$base unless ($title);
732         if ($refresh eq 'slide') {
733                 print start_html(-title=>$title,
734                                 -bgcolor=>"#808080",
735                         -head=>meta({-http_equiv=>'Refresh',
736                                 -content=>"3; url=$nref"})),"\n";
737         } else {
738                 print start_html(-title=>$title,
739                                 -bgcolor=>"#808080"),"\n";
740         }
741         print start_center,"\n";
742         print h1($title);
743         print a({-href=>"../index.html"},"Index")," | ";
744         print a({-href=>$pref},"&lt;&lt;Prev")," | ";
745         print a({-href=>$toggleref},$toggle)," | ";
746         print a({-href=>$nref},"Next&gt;&gt;");
747         print p;
748         print img({-src=>"../.640/".$base}),"\n";
749         print end_center,"\n";
750         print end_html,"\n";
751         close(STDOUT);
752 }
753
754 sub scale {
755         my ($start,$dir,$base,$fn,$tsize,$info)=@_;
756         my ($w,$h) = dim($info);
757         my $max=($w>$h)?$w:$h;
758         my $factor=$tsize/$max;
759
760         return $base if ($factor >= 1);
761
762         my $tdir=sprintf "%s/%s/.%s",$start,$dir,$tsize;
763         mkdir($tdir,0755) unless ( -d $tdir );
764         my $tbase=sprintf ".%s/%s",$tsize,$base;
765         my $tfn=sprintf "%s/%s",$tdir,$base;
766         my @sstat=stat($fn);
767         my @tstat=stat($tfn);
768         return $tbase if (@tstat && ($sstat[9] < $tstat[9])); # [9] -> mtime
769
770         print STDERR "scale by $factor from $fn to $tfn\n";
771         &doscaling($fn,$tfn,$factor,$w,$h);
772         return $tbase;
773 }
774
775 sub doscaling {
776         my ($src,$dest,$factor,$w,$h)=@_;
777
778         my $im=new Image::Magick;
779         my $err;
780         #print STDERR "doscale $src -> $dest by $factor\n";
781         $err=$im->Read($src);
782         unless ($err) {
783                 $im->Scale(width=>$w*$factor,height=>$h*$factor);
784                 $err=$im->Write($dest);
785                 warn "ImageMagic: write \"$dest\": $err" if ($err);
786         } else {
787                 warn "ImageMagic: read \"$src\": $err";
788                 system("djpeg \"$src\" | pnmscale \"$factor\" | cjpeg >\"$dest\"");
789         }
790         undef $im;
791 }