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