1: #!/usr/bin/perl
2:
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:
17: use strict;
18: use sigtrap qw(die normal-signals);
19:
20: # MPIWG libraries
21: use lib '/usr/local/mpiwg/scripts';
22: use MPIWGlib;
23:
24:
25: $| = 1; # unblock IO
26:
27: my $version = "V0.9.5 (ROC 5.1.2005)";
28:
29: $debug = 0;
30:
31: my $simulate = 0;
32:
33: my $do_descend = 1;
34:
35: my $dir_perm = 0775;
36: my $file_perm = 0664;
37:
38: umask 000; # to make shure we can actually use these perms
39:
40: my $overwrite = 0; # overwrite already converted files
41:
42: # image file extensions and formats
43: my %img_type_ext = ("tif" => "TIFF", "tiff" => "TIFF", "gif" => "GIF",
44: "jpg" => "JPEG", "png" => "PNG", "dcr" => "RAW");
45: # destination image file extensions
46: my %target_ext_type = ("TIFF" => "jpg", "JPEG" => "jpg");
47:
48: # default scale settings
49: my $scale_w = 2048; # width in pixel
50: my $scale_h = 2048; # height in pixel
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;
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");
81: $tiffinfo = findfile(\@softdirs, "tiffinfo")
82: or die("ABORT: neccessary external program not found: tiffinfo");
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:
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: #
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:
153: #
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: #
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?
177: if (-d $dirname) {
178: chmod $dir_perm, $dirname or do {
179: logger('WARNING', "unable to change permission on $dirname!");
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) {
189: last unless ($dir);
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 {
199: logger('ERROR', "unable to create $dir!");
200: return 0;
201: }
202: }
203: return 1;
204: }
205:
206: #
207: # ($type, $width, $height) = identify($filepath)
208: #
209: sub identify {
210: my ($filepath) = @_;
211: my $pictype = "";
212: my $picwidth = 0;
213: my $picheight = 0;
214: my $bitdepth = 0;
215: # use quickident first
216: $pictype = quickident($filepath);
217: # optimized tiff identification
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;
223: # we take the biggest values, because embedded thumbnails
224: # may also show up
225: if (/Image Width:\s*(\d+)\s*Image Length:\s*(\d+)/) {
226: $picwidth = $1 if ($1 > $picwidth);
227: $picheight = $2 if ($2 > $picheight);
228: next;
229: }
230: if (/Bits\/Sample:\s*(\d+)/) {
231: $bitdepth = $1 if ($1 > $bitdepth);
232: next;
233: }
234: }
235: if ($picwidth) {
236: logger('DEBUG', "TIFF $picwidth x $picheight");
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: #
276: # $fact = scalefactor(\$args)
277: #
278: sub scalefactor {
279: my ($args) = @_;
280:
281: my $srcdir = $$args{'srcdir'};
282: my $filename = $$args{'filename'};
283: my $scale_w = $$args{'scale_w'};
284: my $scale_h = $$args{'scale_h'};
285: my $scale_rel = $$args{'scale_rel'};
286: my $scale = 0;
287:
288: if ($scale_rel) {
289: # scale relative -- no size needed, only scaling factor
290: $scale = $scale_w;
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) {
297: # no size yet - identify
298: ($pictype, $picwidth, $picheight) = identify("$srcdir/$filename");
299: if ((! $pictype)||($picwidth == 0)||($picheight == 0)) {
300: logger('ERROR', "unable to identify $srcdir/$filename!");
301: return 0;
302: }
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");
315: } else {
316: $scale = $scale_y;
317: logger('DEBUG', "PIC scale to height");
318: }
319: if ($scale >= 1) {
320: $scale = 1;
321: logger('DEBUG', "PIC is already smaller");
322: # continue since we may have to convert
323: }
324: }
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);
355:
356: if (!$scaleopt) {
357: logger('ERROR', "unable to calculate scaling options!");
358: return 1;
359: }
360:
361: if ($scaleopt = 1) {
362: # is already smaller
363: return 0;
364: }
365:
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'!");
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: }
376: return 1;
377: }
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;
388: }
389: return 0;
390: }
391:
392:
393: #
394: # $error = scale_tiff_jpeg2(\$args);
395: #
396: # scale TIFF images to JPEG using ImageMagick convert
397: #
398: # args needed: $srcdir, $filename, $destdir,
399: # $scale_w, $scale_h, $scale_rel, $picwidth, $picheight
400: #
401: sub scale_tiff_jpeg2 {
402: my ($args) = @_;
403:
404: my $srcdir = $$args{'srcdir'};
405: my $filename = $$args{'filename'};
406: my $destdir = $$args{'destdir'};
407: my $scale_w = $$args{'scale_w'};
408: my $scale_h = $$args{'scale_h'};
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) {
417: my $per_scale = 100 * $scale_w;
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 {
425: logger('DEBUG', "nice -10 $converter -quality $jpeg_quality -scale ${scale_w}x${scale_h} '$srcdir/$filename' '$destdir/$newfn' 2>/dev/null");
426: return 0 if ($simulate);
427: if (system("nice -10 $converter -quality $jpeg_quality -scale ${scale_w}x${scale_h} '$srcdir/$filename' '$destdir/$newfn' 2>/dev/null\n") != 0) {
428: logger('ERROR', "error converting '$srcdir/$filename'!");
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: }
434: return 1;
435: }
436: }
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,
452: # $scale_w, $scale_h, $scale_rel, $picwidth, $picheight
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'};
460: my $bitdepth = $$args{'bitdepth'};
461: my $scale_w = $$args{'scale_w'};
462: my $scale_h = $$args{'scale_h'};
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:
472: $scaleopt = scalefactor($args);
473:
474: if (!$scaleopt) {
475: logger('ERROR', "unable to calculate scaling options!");
476: return 1;
477: }
478:
479: # convert
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");
487: return 0 if ($simulate);
488: if (system($cmd) != 0) {
489: logger('ERROR', "error converting '$srcdir/$filename'!");
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: }
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,
513: # $scale_w, $scale_h, $scale_rel, $picwidth, $picheight
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'};
522: my $scale_w = $$args{'scale_w'};
523: my $scale_h = $$args{'scale_h'};
524: my $scale_rel = $$args{'scale_rel'};
525: my $scaleopt;
526:
527: # convert tif -> png
528: my ($basename, $fileext) = splitfn($filename);
529: my $newfn = $basename . ".png";
530: logger('INFO', "Convert(tiff3): $filename -> $newfn");
531:
532: $scaleopt = scalefactor($args);
533:
534: if (!$scaleopt) {
535: logger('ERROR', "unable to calculate scaling options!");
536: return 1;
537: }
538:
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'!");
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: }
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:
595: #
596: # quick check if target image exists
597: #
598: $pictype = quickident("$srcdir/$filename");
599: if ($pictype) {
600: if ($pictype eq "RAW") {
601: logger('DEBUG', "skipping raw file '$srcdir/$filename'");
602: return 0;
603: }
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) {
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: }
618: }
619: }
620: } else {
621: logger('DEBUG', "target extension for $pictype unknown!");
622: }
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'");
628: return 0;
629: }
630: }
631:
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{'scale_w'} = $scale_w;
643: $args{'scale_h'} = $scale_h;
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: }
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 {
678: my($srcdir, $workdir, $destdir) = @_;
679: my $errcnt = 0;
680: my $newfn;
681:
682: opendir WORKDIR, "$srcdir/$workdir" or do {
683: logger('ERROR', "Unable to open directory $srcdir/$workdir!");
684: return 0;
685: };
686:
687: my @dirlist = readdir(WORKDIR);
688:
689: closedir WORKDIR;
690:
691: if ($do_descend) {
692: foreach (sort @dirlist) {
693: next if (/^[.]+$/);
694: next if ($junk_files{$_});
695: if (-d "$srcdir/$workdir/$_") {
696: walk_convert_dir($srcdir, "$workdir/$_", $destdir);
697: }
698: }
699: }
700:
701: logger('INFO', "Working on $workdir");
702: logger('INFO', "Reading from $srcdir/$workdir.");
703: logger('INFO', "Writing to $destdir/$workdir");
704:
705: # create destination directory
706: if (not ($simulate)) {
707: mmkdir("$destdir/$workdir") or do {
708: logger("ERROR", "unable to create directory '$destdir/$workdir'");
709: $errcnt++;
710: return 0;
711: };
712: }
713:
714: foreach (sort @dirlist) {
715: # skip dot-directories
716: if (/^[.]+.*$/) {
717: next;
718: }
719: if (-f "$srcdir/$workdir/$_") {
720: $errcnt += convert_file("$srcdir/$workdir", "$_", "$destdir/$workdir");
721: }
722: }
723:
724: if ($errcnt) {
725: logger('INFO', "There were $errcnt errors converting '$workdir'!");
726: } else {
727: logger('INFO', "Finished converting $workdir!");
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 {
740: my ($srcdir, $workdir, $destdir) = @_;
741:
742: logger('INFO', "** Converting Scans **");
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: }
761:
762: logger('DONE', "** Finished converting scans **");
763: return 1;
764: }
765:
766:
767:
768:
769:
770:
771: ###############################################################
772: ## Main
773:
774: if ($#ARGV < 3) {
775: print "Scale-O-Mat $version\n";
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";
778: print " -scaleto=destination size (S or WxH)\n";
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";
783: exit 1;
784: }
785:
786: # test software installation
787: checksoft();
788:
789: # read command line parameters
790: my $args = parseargs();
791:
792: # source dir
793: my $srcdir = cleanpath($$args{'src'}, 1);
794:
795: # destination dir
796: my $destdir = cleanpath($$args{'dest'}, 1);
797:
798: # working dir
799: my $workdir = cleanpath($$args{'dir'});
800:
801: # destination size
802: if ($$args{'scaleby'}) {
803: $scale_relative = 1;
804: $scale_w = $$args{'scaleby'};
805: logger('INFO', "Scaling relative by factor $scale_w");
806: }
807: if ($$args{'scaleto'}) {
808: $scale_relative = 0;
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");
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'};
829: }
830:
831: # Overwrite
832: if ($$args{'replace'}) {
833: logger('INFO', "Set to overwrite existing files!");
834: $overwrite = 1;
835: }
836:
837: # debug
838: if ($$args{'debug'}) {
839: logger('INFO', "Set debug level to $$args{'debug'}!");
840: $debug = $$args{'debug'};
841: }
842:
843: # simulate
844: if ($$args{'simulate'}) {
845: logger('INFO', "Set to simulate operation only ($$args{'simulate'})!");
846: $simulate = $$args{'simulate'};
847: }
848:
849: convert_dir($srcdir, $workdir, $destdir);
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>