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