Annotation of scaleomat/scaleomat.pl, revision 1.7
1.1 casties 1: #!/usr/bin/perl
2:
1.3 casties 3: # Copyright (C) 2003,2004 Robert Casties, IT-Group MPIWG
4: #
5: # This program is free software; you can redistribute it and/or modify it
6: # under the terms of the GNU General Public License as published by the Free
7: # Software Foundation; either version 2 of the License, or (at your option)
8: # any later version.
9: #
10: # Please read license.txt for the full details. A copy of the GPL may be found
11: # at http://www.gnu.org/copyleft/lgpl.html
12: #
13: # You should have received a copy of the GNU General Public License along with
14: # this program; if not, write to the Free Software Foundation, Inc., 59 Temple
15: # Place, Suite 330, Boston, MA 02111-1307 USA
16:
1.2 casties 17: use strict;
1.4 casties 18: use sigtrap qw(die normal-signals);
1.2 casties 19:
20: # MPIWG libraries
21: use lib '/usr/local/mpiwg/scripts';
22: use MPIWGlib;
23:
24:
1.1 casties 25: $| = 1; # unblock IO
26:
1.7 ! casties 27: my $version = "V0.9.5 (ROC 5.1.2005)";
1.1 casties 28:
29: $debug = 0;
30:
1.2 casties 31: my $simulate = 0;
32:
33: my $do_descend = 1;
1.1 casties 34:
1.2 casties 35: my $dir_perm = 0775;
36: my $file_perm = 0664;
1.1 casties 37:
38: umask 000; # to make shure we can actually use these perms
39:
1.2 casties 40: my $overwrite = 0; # overwrite already converted files
1.1 casties 41:
1.2 casties 42: # image file extensions and formats
43: my %img_type_ext = ("tif" => "TIFF", "tiff" => "TIFF", "gif" => "GIF",
1.6 casties 44: "jpg" => "JPEG", "png" => "PNG", "dcr" => "RAW");
1.2 casties 45: # destination image file extensions
46: my %target_ext_type = ("TIFF" => "jpg", "JPEG" => "jpg");
47:
48: # default scale settings
1.7 ! casties 49: my $scale_w = 2048; # width in pixel
! 50: my $scale_h = 2048; # height in pixel
1.2 casties 51: my $scale_relative = 0; # scale by relative factor instead of destination size
52: my $jpeg_quality = 75; # default JPEG compression quality
53: my $use_encoder = 0; # autodetect encoder
54:
55: # programs to use
56: my $identifier;
57: my $tiffinfo;
58: my $jpegloader;
59: my $tiffloader;
60: my $quantizer;
61: my $scaler;
62: my $jpegwriter;
63: my $pngwriter;
64: my $converter;
1.1 casties 65:
66: ##########################################################################
67: # subroutines
68: #
69:
70: #
71: # checksoft()
72: #
73: # returns if all necessary external programs are installed
74: #
75: sub checksoft {
76:
77: my @softdirs = ("/usr/X11R6/bin", "/usr/bin", "/usr/local/bin");
78:
79: $identifier = findfile(\@softdirs, "identify")
80: or die("ABORT: neccessary external program not found: identify");
1.2 casties 81: $tiffinfo = findfile(\@softdirs, "tiffinfo")
82: or die("ABORT: neccessary external program not found: tiffinfo");
1.1 casties 83: $jpegloader = findfile(\@softdirs, "jpegtopnm")
84: or die("ABORT: neccessary external program not found: jpegtopnm");
85: $tiffloader = findfile(\@softdirs, "tifftopnm")
86: or die("ABORT: neccessary external program not found: tifftopnm");
87: $quantizer = findfile(\@softdirs, "pbmtopgm")
88: or die("ABORT: neccessary external program not found: pbmtopgm");
89: $scaler = findfile(\@softdirs, "pnmscale")
90: or die("ABORT: neccessary external program not found: pnmscale");
91: $jpegwriter = findfile(\@softdirs, "ppmtojpeg")
92: or die("ABORT: neccessary external program not found: ppmtojpeg");
93: $pngwriter = findfile(\@softdirs, "pnmtopng")
94: or die("ABORT: neccessary external program not found: pnmtopng");
95: $converter = findfile(\@softdirs, "convert")
96: or die("ABORT: neccessary external program not found: convert");
97:
98: }
99:
100:
101:
102: #
103: # findir(\@basedirs, $subdir)
104: #
105: # check directories in @basedirs+$subdir and return the first existing basedir
106: #
107: sub findir {
108: my($dirlist, $subdir) = @_;
109:
110: foreach my $dir (@$dirlist) {
111: if (-d "$dir/$subdir") {
112: return "$dir";
113: }
114: }
115: return;
116: }
117:
118: #
119: # findfile(\@basedirs, $filename)
120: #
121: # check @basedirs+$filename and return the first existing file
122: #
123: sub findfile {
124: my($dirlist, $fn) = @_;
125:
126: foreach my $dir (@$dirlist) {
127: if (-f "$dir/$fn") {
128: return "$dir/$fn";
129: }
130: }
131: return;
132: }
133:
1.5 casties 134: #
135: # $p = cleanpath($path, $startslash).
136: #
137: # returns a pathname with trailing and starting slash removed (if
138: # $startslash is true the starting slash is not removed)
139: #
1.4 casties 140: sub cleanpath {
141: my ($path, $startslash) = @_;
142:
143: if ($path =~ /^(\/)*(.*?)\/*$/) {
144: if ($startslash) {
145: return $1 . $2;
146: } else {
147: return $2;
148: }
149: }
150: return $path;
151: }
152:
1.1 casties 153: #
1.2 casties 154: # ($basename, $extension) = splitfn($filename)
155: #
156: # split filename into base and (lowercase) extension
157: #
158: sub splitfn {
159: my ($filepath) = @_;
160: if ($filepath =~ /^(.*)\.(\w+)$/) {
161: return ($1, lc($2));
162: }
163: return;
164: }
165:
166:
167: #
1.1 casties 168: # mmkdir($dirname)
169: #
170: # create directory recursively and check permissions
171: #
172: sub mmkdir {
173: my($dirname) = @_;
174: my $newdir;
175:
176: # does the directory already exist?
1.2 casties 177: if (-d $dirname) {
178: chmod $dir_perm, $dirname or do {
1.4 casties 179: logger('WARNING', "unable to change permission on $dirname!");
1.1 casties 180: };
181: return 1;
182: }
183: # split directory name by levels
184: my @dirlist = split /\//, $dirname;
185: my @newlist = ();
186: my $dir = join("/", @dirlist);
187: # test backwards which directories exist
188: while (not -d $dir) {
1.2 casties 189: last unless ($dir);
1.1 casties 190: # move missing elements from the end of @dirlist to @newlist
191: unshift @newlist, pop @dirlist;
192: $dir = join("/", @dirlist);
193: }
194: # create missing directories level by level
195: foreach $newdir (@newlist) {
196: push @dirlist, $newdir;
197: $dir = join("/", @dirlist);
198: mkdir "$dir", $dir_perm or do {
1.2 casties 199: logger('ERROR', "unable to create $dir!");
1.1 casties 200: return 0;
201: }
202: }
203: return 1;
204: }
205:
206: #
1.2 casties 207: # ($type, $width, $height) = identify($filepath)
208: #
209: sub identify {
210: my ($filepath) = @_;
1.4 casties 211: my $pictype = "";
212: my $picwidth = 0;
213: my $picheight = 0;
1.2 casties 214: my $bitdepth = 0;
215: # use quickident first
216: $pictype = quickident($filepath);
1.7 ! casties 217: # optimized tiff identification
1.2 casties 218: if (($pictype)&&($pictype eq 'TIFF')) {
219: logger('DEBUG', "running tiffinfo $tiffinfo");
220: if (open(IDENT, "nice -10 $tiffinfo '$filepath' 2>/dev/null |")) {
221: while (<IDENT>) {
222: chomp;
1.7 ! casties 223: # we take the biggest values, because embedded thumbnails
! 224: # may also show up
1.2 casties 225: if (/Image Width:\s*(\d+)\s*Image Length:\s*(\d+)/) {
1.4 casties 226: $picwidth = $1 if ($1 > $picwidth);
227: $picheight = $2 if ($2 > $picheight);
1.2 casties 228: next;
229: }
230: if (/Bits\/Sample:\s*(\d+)/) {
1.4 casties 231: $bitdepth = $1 if ($1 > $bitdepth);
1.2 casties 232: next;
233: }
234: }
235: if ($picwidth) {
1.4 casties 236: logger('DEBUG', "TIFF $picwidth x $picheight");
1.2 casties 237: return ($pictype, $picwidth, $picheight, $bitdepth);
238: }
239: }
240: }
241: # run ident to get image type and dimensions
242: logger('DEBUG', "running identifier $identifier");
243: if (open(IDENT, "nice -10 $identifier -ping -format '%w %h %m\n' '$filepath' 2>/dev/null |")) {
244: my @id = <IDENT>;
245: my $picinfo = $id[0];
246: close IDENT;
247: chomp $picinfo;
248: logger('DEBUG', "PIC is '$picinfo'");
249: if ($picinfo =~ /^(\d+) (\d+) (\w+)$/) {
250: $picwidth = $1;
251: $picheight = $2;
252: $pictype = $3;
253: }
254: } else {
255: logger('DEBUG', "unable to identify $filepath!");
256: }
257: return ($pictype, $picwidth, $picheight, $bitdepth);
258: }
259:
260: #
261: # $type = quickident($filepath);
262: #
263: sub quickident {
264: my ($filepath) = @_;
265: logger('DEBUG', "running quickident");
266: # look at file extension
267: my ($filebase, $fileext) = splitfn($filepath);
268: if ($fileext) {
269: return $img_type_ext{$fileext};
270: }
271: return;
272: }
273:
274:
275: #
1.7 ! casties 276: # $fact = scalefactor(\$args)
1.1 casties 277: #
1.7 ! casties 278: sub scalefactor {
1.2 casties 279: my ($args) = @_;
280:
281: my $srcdir = $$args{'srcdir'};
282: my $filename = $$args{'filename'};
1.7 ! casties 283: my $scale_w = $$args{'scale_w'};
! 284: my $scale_h = $$args{'scale_h'};
1.2 casties 285: my $scale_rel = $$args{'scale_rel'};
1.7 ! casties 286: my $scale = 0;
1.2 casties 287:
288: if ($scale_rel) {
289: # scale relative -- no size needed, only scaling factor
1.7 ! casties 290: $scale = $scale_w;
1.2 casties 291: } else {
292: # scale to size -- size needed
293: my $pictype = $$args{'pictype'};
294: my $picwidth = $$args{'picwidth'};
295: my $picheight = $$args{'picheight'};
296: if (! $picwidth) {
1.7 ! casties 297: # no size yet - identify
1.2 casties 298: ($pictype, $picwidth, $picheight) = identify("$srcdir/$filename");
299: if ((! $pictype)||($picwidth == 0)||($picheight == 0)) {
300: logger('ERROR', "unable to identify $srcdir/$filename!");
1.7 ! casties 301: return 0;
1.2 casties 302: }
1.7 ! casties 303: # save values
! 304: $$args{'pictype'} = $pictype;
! 305: $$args{'picwidth'} = $picwidth;
! 306: $$args{'picheight'} = $picheight;
! 307: }
! 308: # calculate x and y scaling factors
! 309: my $scale_x = $scale_w / $picwidth;
! 310: my $scale_y = $scale_h / $picheight;
! 311: # take the smallest
! 312: if ($scale_x < $scale_y) {
! 313: $scale = $scale_x;
! 314: logger('DEBUG', "PIC scale to width");
1.2 casties 315: } else {
1.7 ! casties 316: $scale = $scale_y;
! 317: logger('DEBUG', "PIC scale to height");
1.2 casties 318: }
1.7 ! casties 319: if ($scale >= 1) {
! 320: $scale = 1;
1.2 casties 321: logger('DEBUG', "PIC is already smaller");
1.7 ! casties 322: # continue since we may have to convert
1.2 casties 323: }
324: }
1.7 ! casties 325: return $scale;
! 326: }
! 327:
! 328:
! 329: #
! 330: # $error = scale_jpeg(\$args);
! 331: #
! 332: # scale JPEG images to JPEG using netpbm tools
! 333: #
! 334: # args needed: $srcdir, $filename, $destdir,
! 335: # $scale_w, $scale_h, $scale_rel, $picwidth, $picheight
! 336: #
! 337: sub scale_jpeg {
! 338: my ($args) = @_;
! 339:
! 340: my $srcdir = $$args{'srcdir'};
! 341: my $filename = $$args{'filename'};
! 342: my $destdir = $$args{'destdir'};
! 343: my $scale_w = $$args{'scale_w'};
! 344: my $scale_h = $$args{'scale_h'};
! 345: my $scale_rel = $$args{'scale_rel'};
! 346: my $scaleopt;
! 347:
! 348: # convert jpg -> jpg
! 349: my ($basename, $fileext) = splitfn($filename);
! 350: my $newfn = $basename . ".jpg";
! 351: logger('INFO', "Convert(jpg): $filename -> $newfn");
! 352: return 1 if ($simulate);
! 353:
! 354: $scaleopt = scalefactor($args);
1.1 casties 355:
1.2 casties 356: if (!$scaleopt) {
357: logger('ERROR', "unable to calculate scaling options!");
358: return 1;
1.1 casties 359: }
1.2 casties 360:
1.7 ! casties 361: if ($scaleopt = 1) {
! 362: # is already smaller
! 363: return 0;
! 364: }
! 365:
1.2 casties 366: # convert
367: logger('DEBUG', "nice -10 $jpegloader '$srcdir/$filename' 2>/dev/null | nice -10 $scaler $scaleopt 2>/dev/null | nice -10 $jpegwriter > '$destdir/$newfn' 2>/dev/null");
368: return 0 if ($simulate);
369: if (system("nice -10 $jpegloader '$srcdir/$filename' 2>/dev/null | nice -10 $scaler $scaleopt 2>/dev/null | nice -10 $jpegwriter > '$destdir/$newfn' 2>/dev/null") != 0) {
370: logger('ERROR', "error converting '$srcdir/$filename'!");
1.7 ! casties 371: if (! -s "$destdir/$newfn") {
! 372: # file broken (size 0)
! 373: logger('ERROR', "created file '$destdir/$newfn' broken -- will be removed!");
! 374: unlink "$destdir/$newfn";
! 375: }
1.2 casties 376: return 1;
1.1 casties 377: }
1.2 casties 378:
379: # change permissions
380: chmod $file_perm, "$destdir/$newfn" or
381: logger('WARNING', "unable to set permission on '$destdir/$newfn'");
382:
383: if (! -s "$destdir/$newfn") {
384: # file broken (size 0)
385: logger('ERROR', "created file '$destdir/$newfn' broken -- will be removed!");
386: unlink "$destdir/$newfn";
387: return 1;
1.1 casties 388: }
1.2 casties 389: return 0;
1.1 casties 390: }
391:
392:
393: #
1.2 casties 394: # $error = scale_tiff_jpeg2(\$args);
395: #
396: # scale TIFF images to JPEG using ImageMagick convert
1.1 casties 397: #
1.2 casties 398: # args needed: $srcdir, $filename, $destdir,
1.7 ! casties 399: # $scale_w, $scale_h, $scale_rel, $picwidth, $picheight
1.1 casties 400: #
1.2 casties 401: sub scale_tiff_jpeg2 {
402: my ($args) = @_;
403:
404: my $srcdir = $$args{'srcdir'};
405: my $filename = $$args{'filename'};
406: my $destdir = $$args{'destdir'};
1.7 ! casties 407: my $scale_w = $$args{'scale_w'};
! 408: my $scale_h = $$args{'scale_h'};
1.2 casties 409: my $scale_rel = $$args{'scale_rel'};
410: my $scaleopt;
411:
412: my ($basename, $fileext) = splitfn($filename);
413: my $newfn = $basename . ".jpg";
414: logger('INFO', "Convert(tiff2): $filename -> $newfn");
415:
416: if ($scale_rel) {
1.7 ! casties 417: my $per_scale = 100 * $scale_w;
1.2 casties 418: logger('DEBUG', "nice -10 $converter -quality $jpeg_quality -scale $per_scale\% '$srcdir/$filename' '$destdir/$newfn' 2>/dev/null");
419: return 0 if ($simulate);
420: if (system("nice -10 $converter -quality $jpeg_quality -scale $per_scale\% '$srcdir/$filename' '$destdir/$newfn' 2>/dev/null\n") != 0) {
421: logger('ERROR', "error converting '$srcdir/$filename'!");
422: return 1;
423: }
424: } else {
1.7 ! casties 425: logger('DEBUG', "nice -10 $converter -quality $jpeg_quality -scale ${scale_w}x${scale_h} '$srcdir/$filename' '$destdir/$newfn' 2>/dev/null");
1.2 casties 426: return 0 if ($simulate);
1.7 ! casties 427: if (system("nice -10 $converter -quality $jpeg_quality -scale ${scale_w}x${scale_h} '$srcdir/$filename' '$destdir/$newfn' 2>/dev/null\n") != 0) {
1.2 casties 428: logger('ERROR', "error converting '$srcdir/$filename'!");
1.7 ! casties 429: if (! -s "$destdir/$newfn") {
! 430: # file broken (size 0)
! 431: logger('ERROR', "created file '$destdir/$newfn' broken -- will be removed!");
! 432: unlink "$destdir/$newfn";
! 433: }
1.2 casties 434: return 1;
1.1 casties 435: }
436: }
1.2 casties 437:
438: # change permissions
439: chmod $file_perm, "$destdir/$newfn" or
440: logger('WARNING', "unable to set permission on '$destdir/$newfn'");
441:
442: return 0;
443: }
444:
445:
446: #
447: # $error = scale_tiff_jpeg(\$args);
448: #
449: # scale TIFF images to JPEG using netpbm tools
450: #
451: # args needed: $srcdir, $filename, $destdir,
1.7 ! casties 452: # $scale_w, $scale_h, $scale_rel, $picwidth, $picheight
1.2 casties 453: #
454: sub scale_tiff_jpeg {
455: my ($args) = @_;
456:
457: my $srcdir = $$args{'srcdir'};
458: my $filename = $$args{'filename'};
459: my $destdir = $$args{'destdir'};
1.7 ! casties 460: my $bitdepth = $$args{'bitdepth'};
! 461: my $scale_w = $$args{'scale_w'};
! 462: my $scale_h = $$args{'scale_h'};
1.2 casties 463: my $scale_rel = $$args{'scale_rel'};
464: my $scaleopt;
465:
466: # convert jpg -> jpg
467: my ($basename, $fileext) = splitfn($filename);
468: my $newfn = $basename . ".jpg";
469: logger('INFO', "Convert(tiff1): $filename -> $newfn");
470: return 1 if ($simulate);
471:
1.7 ! casties 472: $scaleopt = scalefactor($args);
1.2 casties 473:
474: if (!$scaleopt) {
475: logger('ERROR', "unable to calculate scaling options!");
1.1 casties 476: return 1;
477: }
478:
1.2 casties 479: # convert
1.7 ! casties 480: my $cmd = "nice -10 $tiffloader \'$srcdir/$filename\' 2>/dev/null ";
! 481: if ($bitdepth == 1) {
! 482: # antialiasing bilevel images
! 483: $cmd .= "| nice -10 $quantizer 2 2 2>/dev/null ";
! 484: }
! 485: $cmd .= "| nice -10 $scaler $scaleopt 2>/dev/null | nice -10 $jpegwriter --quality $jpeg_quality > '$destdir/$newfn' 2>/dev/null";
! 486: logger('DEBUG', "$cmd");
1.2 casties 487: return 0 if ($simulate);
1.7 ! casties 488: if (system($cmd) != 0) {
1.2 casties 489: logger('ERROR', "error converting '$srcdir/$filename'!");
1.7 ! casties 490: if (! -s "$destdir/$newfn") {
! 491: # file broken (size 0)
! 492: logger('ERROR', "created file '$destdir/$newfn' broken -- will be removed!");
! 493: unlink "$destdir/$newfn";
! 494: }
1.2 casties 495: return 1;
496: }
497:
498: # change permissions
499: chmod $file_perm, "$destdir/$newfn" or
500: logger('WARNING', "unable to set permission on '$destdir/$newfn'");
501:
502: return 0;
503: }
504:
505:
506:
507: #
508: # $error = scale_tiff_png(\$args);
509: #
510: # scale TIFF images to PNG using netpbm tools
511: #
512: # args needed: $srcdir, $filename, $destdir,
1.7 ! casties 513: # $scale_w, $scale_h, $scale_rel, $picwidth, $picheight
1.2 casties 514: #
515: sub scale_tiff_png {
516: my ($args) = @_;
517:
518: my $srcdir = $$args{'srcdir'};
519: my $filename = $$args{'filename'};
520: my $destdir = $$args{'destdir'};
521: my $bitdepth = $$args{'bitdepth'};
1.7 ! casties 522: my $scale_w = $$args{'scale_w'};
! 523: my $scale_h = $$args{'scale_h'};
1.2 casties 524: my $scale_rel = $$args{'scale_rel'};
525: my $scaleopt;
526:
1.7 ! casties 527: # convert tif -> png
1.2 casties 528: my ($basename, $fileext) = splitfn($filename);
529: my $newfn = $basename . ".png";
530: logger('INFO', "Convert(tiff3): $filename -> $newfn");
531:
1.7 ! casties 532: $scaleopt = scalefactor($args);
1.2 casties 533:
534: if (!$scaleopt) {
535: logger('ERROR', "unable to calculate scaling options!");
1.1 casties 536: return 1;
537: }
538:
1.2 casties 539: # convert
540: my $cmd = "nice -10 $tiffloader \'$srcdir/$filename\' 2>/dev/null ";
541: if ($bitdepth == 1) {
542: # antialiasing bilevel images
543: $cmd .= "| nice -10 $quantizer 2 2 2>/dev/null ";
544: }
545: $cmd .= "| nice -10 $scaler $scaleopt 2>/dev/null | nice -10 $pngwriter > '$destdir/$newfn' 2>/dev/null";
546: logger('DEBUG', "$cmd");
547: return 0 if ($simulate);
548: if (system($cmd) != 0) {
549: logger('ERROR', "error converting '$srcdir/$filename'!");
1.7 ! casties 550: if (! -s "$destdir/$newfn") {
! 551: # file broken (size 0)
! 552: logger('ERROR', "created file '$destdir/$newfn' broken -- will be removed!");
! 553: unlink "$destdir/$newfn";
! 554: }
1.2 casties 555: return 1;
556: }
557:
558: # change permissions
559: chmod $file_perm, "$destdir/$newfn" or
560: logger('WARNING', "unable to set permission on '$destdir/$newfn'");
561:
562: return 0;
563: }
564:
565:
566: #
567: # $error = convert_file($srcdir, $filename, $destdir);
568: #
569: # convert file
570: #
571: sub convert_file {
572: my($srcdir, $filename, $destdir) = @_;
573: my $filebase;
574: my $fileext;
575: my $newfn;
576: my $pictype;
577: my $picwidth;
578: my $picheight;
579: my $bitdepth;
580: my $error = 0;
581:
582: logger('DEBUG', "convert_file ($srcdir, $filename, $destdir)");
583:
584: if (not (( -f "$srcdir/$filename") && (-r _))) {
585: logger('ERROR', "unable to read file '$srcdir/$filename'");
586: return 1;
587: }
588:
589: # get base name and extension
590: if ($filename =~ /^(.*)\.(\w+)$/) {
591: $filebase = $1;
592: $fileext = $2;
593: }
594:
1.1 casties 595: #
1.2 casties 596: # quick check if target image exists
1.1 casties 597: #
1.2 casties 598: $pictype = quickident("$srcdir/$filename");
599: if ($pictype) {
1.6 casties 600: if ($pictype eq "RAW") {
601: logger('DEBUG', "skipping raw file '$srcdir/$filename'");
602: return 0;
603: }
1.2 casties 604: my $newext = $target_ext_type{$pictype};
605: if ($newext) {
606: $newfn = $filebase . ".$newext";
607: # check if file exists
608: if (-f "$destdir/$newfn") {
609: logger('DEBUG', "CONV file exists: $newfn");
610: if (! $overwrite) {
1.7 ! casties 611: # compare age with source file
! 612: if (-M "$destdir/$newfn" > -M "$srcdir/$filename") {
! 613: logger('DEBUG', "CONV file is older: $newfn");
! 614: } else {
! 615: logger('INFO', "File already converted: $newfn");
! 616: return 0;
! 617: }
1.2 casties 618: }
1.1 casties 619: }
1.2 casties 620: } else {
621: logger('DEBUG', "target extension for $pictype unknown!");
1.1 casties 622: }
1.2 casties 623: } else {
624: # quick ident failed -- do it slowly
625: ($pictype, $picwidth, $picheight, $bitdepth) = identify("$srcdir/$filename");
626: if ((! $pictype)||($picwidth == 0)||($picheight == 0)) {
627: logger('WARNING', "unknown file type '$srcdir/$filename'");
1.1 casties 628: return 0;
629: }
630: }
631:
1.2 casties 632: # collect arguments for the conversion
633: my %args;
634: $args{'srcdir'} = $srcdir;
635: $args{'destdir'} = $destdir;
636: $args{'filename'} = $filename;
637: $args{'pictype'} = $pictype;
638: $args{'picwidth'} = $picwidth;
639: $args{'picheight'} = $picheight;
640: $args{'bitdepth'} = $bitdepth;
641: $args{'srcdir'} = $srcdir;
1.7 ! casties 642: $args{'scale_w'} = $scale_w;
! 643: $args{'scale_h'} = $scale_h;
1.2 casties 644: $args{'scale_rel'} = $scale_relative;
645:
646: # decide conversion based on image type and encoding preferences
647: if ($pictype eq 'JPEG') {
648: $args{'jpeg_qual'} = $jpeg_quality;
649: #default encoder
650: $error = scale_jpeg(\%args);
651: } elsif ($pictype eq 'TIFF') {
652: if ($use_encoder) {
653: # use specific encoder
654: if ($use_encoder eq 'tiff_jpeg') {
655: $error = scale_tiff_jpeg(\%args);
656: } elsif ($use_encoder eq 'tiff_jpeg2') {
657: $error = scale_tiff_jpeg2(\%args);
658: } elsif ($use_encoder eq 'tiff_png') {
659: $error = scale_tiff_png(\%args);
660: }
661: } else {
662: # default
663: $error = scale_tiff_jpeg(\%args);
664: }
665: } else {
666: logger('WARNING', "unknown file type: $pictype ($srcdir/$filename)");
667: }
668: return $error;
669: }
1.1 casties 670:
671:
672: #
673: # walk_convert_dir($dirname)
674: #
675: # Descend recursively through $dirname and work on all files
676: #
677: sub walk_convert_dir {
1.2 casties 678: my($srcdir, $workdir, $destdir) = @_;
1.1 casties 679: my $errcnt = 0;
680: my $newfn;
681:
1.2 casties 682: opendir WORKDIR, "$srcdir/$workdir" or do {
683: logger('ERROR', "Unable to open directory $srcdir/$workdir!");
1.1 casties 684: return 0;
685: };
686:
687: my @dirlist = readdir(WORKDIR);
688:
689: closedir WORKDIR;
690:
691: if ($do_descend) {
692: foreach (sort @dirlist) {
1.2 casties 693: next if (/^[.]+$/);
694: next if ($junk_files{$_});
695: if (-d "$srcdir/$workdir/$_") {
696: walk_convert_dir($srcdir, "$workdir/$_", $destdir);
1.1 casties 697: }
698: }
699: }
700:
1.2 casties 701: logger('INFO', "Working on $workdir");
702: logger('INFO', "Reading from $srcdir/$workdir.");
703: logger('INFO', "Writing to $destdir/$workdir");
1.1 casties 704:
1.2 casties 705: # create destination directory
1.1 casties 706: if (not ($simulate)) {
1.2 casties 707: mmkdir("$destdir/$workdir") or do {
708: logger("ERROR", "unable to create directory '$destdir/$workdir'");
1.1 casties 709: $errcnt++;
710: return 0;
711: };
712: }
1.2 casties 713:
1.1 casties 714: foreach (sort @dirlist) {
1.2 casties 715: # skip dot-directories
1.1 casties 716: if (/^[.]+.*$/) {
717: next;
718: }
1.2 casties 719: if (-f "$srcdir/$workdir/$_") {
720: $errcnt += convert_file("$srcdir/$workdir", "$_", "$destdir/$workdir");
1.1 casties 721: }
722: }
723:
724: if ($errcnt) {
1.2 casties 725: logger('INFO', "There were $errcnt errors converting '$workdir'!");
1.1 casties 726: } else {
1.2 casties 727: logger('INFO', "Finished converting $workdir!");
1.1 casties 728: }
729:
730: return 1;
731: }
732:
733:
734: #
735: # convert_dir($from_dir)
736: #
737: # Convert directory "from_dir" and its subdirectories
738: #
739: sub convert_dir {
1.2 casties 740: my ($srcdir, $workdir, $destdir) = @_;
1.1 casties 741:
1.2 casties 742: logger('INFO', "** Converting Scans **");
1.7 ! casties 743:
! 744: if (-d "$srcdir/$workdir") {
! 745: # it's a dirrectory
! 746: logger('INFO', "Starting in directory '$srcdir/$workdir'");
! 747: walk_convert_dir($srcdir, $workdir, $destdir);
! 748: # touch source directory so digilib rescans the thumbnails
! 749: #logger('DEBUG', "/usr/bin/touch $source_base_dirs[0]/$workdir");
! 750: system("/usr/bin/touch '$srcdir/$workdir'");
! 751: } elsif (-f _) {
! 752: # it's a file
! 753: logger('INFO', "Converting file '$srcdir/$workdir'");
! 754: convert_file($srcdir, $workdir, $destdir);
! 755: # touch source parent directory so digilib rescans the thumbnails
! 756: my $pdir = "$srcdir/$workdir";
! 757: # chop off after the last slash
! 758: $pdir =~ s/\/[^\/]+$/\//;
! 759: system("/usr/bin/touch '$pdir'");
! 760: }
1.1 casties 761:
1.2 casties 762: logger('DONE', "** Finished converting scans **");
1.1 casties 763: return 1;
764: }
765:
766:
767:
768:
769:
770:
771: ###############################################################
772: ## Main
773:
1.2 casties 774: if ($#ARGV < 3) {
1.1 casties 775: print "Scale-O-Mat $version\n";
1.2 casties 776: print " use: scaleomat.pl -src=src-base -dest=dest-base -dir=workdir [...]\n";
777: print " reads from scr-base/workdir and writes to dest-base/workdir\n";
1.7 ! casties 778: print " -scaleto=destination size (S or WxH)\n";
1.2 casties 779: print " -scaleby=magnification factor.\n";
780: print " -jpegqual=JPEG quality (0-100)\n";
781: print " -replace=yes replaces existing files (default=skip).\n";
782: print " -encoder=tiff_png|tiff_jpeg|tiff_jpeg2\n";
1.1 casties 783: exit 1;
784: }
785:
786: # test software installation
1.2 casties 787: checksoft();
788:
789: # read command line parameters
790: my $args = parseargs();
791:
792: # source dir
1.4 casties 793: my $srcdir = cleanpath($$args{'src'}, 1);
1.1 casties 794:
1.2 casties 795: # destination dir
1.4 casties 796: my $destdir = cleanpath($$args{'dest'}, 1);
1.2 casties 797:
798: # working dir
1.4 casties 799: my $workdir = cleanpath($$args{'dir'});
1.2 casties 800:
801: # destination size
802: if ($$args{'scaleby'}) {
803: $scale_relative = 1;
1.7 ! casties 804: $scale_w = $$args{'scaleby'};
! 805: logger('INFO', "Scaling relative by factor $scale_w");
1.2 casties 806: }
807: if ($$args{'scaleto'}) {
808: $scale_relative = 0;
1.7 ! casties 809: if ($$args{'scaleto'} =~ /(\d+)x(\d+)/) {
! 810: $scale_w = $1;
! 811: $scale_h = $2;
! 812: } else {
! 813: $scale_w = $$args{'scaleto'};
! 814: $scale_h = $$args{'scaleto'};
! 815: }
! 816: logger('INFO', "Scaling absolute to size $scale_w x $scale_h");
1.2 casties 817: }
818:
819: # JPEG quality
820: if ($$args{'jpegqual'}) {
821: logger('INFO', "JPEG quality set to '$$args{'jpegqual'}'!");
822: $jpeg_quality = $$args{'jpegqual'};
823: }
824:
825: # force encoder
826: if ($$args{'encoder'}) {
827: logger('INFO', "Using encoder '$$args{'encoder'}'!");
828: $use_encoder = $$args{'encoder'};
1.1 casties 829: }
830:
1.2 casties 831: # Overwrite
832: if ($$args{'replace'}) {
833: logger('INFO', "Set to overwrite existing files!");
834: $overwrite = 1;
1.1 casties 835: }
836:
1.2 casties 837: # debug
838: if ($$args{'debug'}) {
839: logger('INFO', "Set debug level to $$args{'debug'}!");
840: $debug = $$args{'debug'};
1.1 casties 841: }
842:
1.2 casties 843: # simulate
844: if ($$args{'simulate'}) {
845: logger('INFO', "Set to simulate operation only ($$args{'simulate'})!");
846: $simulate = $$args{'simulate'};
1.1 casties 847: }
1.2 casties 848:
849: convert_dir($srcdir, $workdir, $destdir);
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvs/cvsweb/icons/back.gif){kind=icon}
Return to scaleomat.pl CVS log ![[TXT]](/cvs/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvs/cvsweb/icons/dir.gif){kind=icon}
Up to [Repository] / scaleomat