1: #!/usr/bin/perl
2:
3: use strict;
4:
5: # MPIWG libraries
6: use lib '/usr/local/mpiwg/scripts';
7: use MPIWGlib;
8:
9:
10: $| = 1; # unblock IO
11:
12: my $version = "V0.9.2 (ROC 22.4.2004)";
13:
14: $debug = 0;
15:
16: my $simulate = 0;
17:
18: my $do_descend = 1;
19:
20: my $dir_perm = 0775;
21: my $file_perm = 0664;
22:
23: umask 000; # to make shure we can actually use these perms
24:
25: my $overwrite = 0; # overwrite already converted files
26:
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;
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");
65: $tiffinfo = findfile(\@softdirs, "tiffinfo")
66: or die("ABORT: neccessary external program not found: tiffinfo");
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: #
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: #
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?
143: if (-d $dirname) {
144: chmod $dir_perm, $dirname or do {
145: logger('ERROR', "unable to change permission on $dirname!");
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) {
156: last unless ($dir);
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 {
166: logger('ERROR', "unable to create $dir!");
167: return 0;
168: }
169: }
170: return 1;
171: }
172:
173: #
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
244: #
245: # args needed: $srcdir, $filename, $destdir,
246: # $scalesize, $scale_rel, $picwidth, $picheight
247: #
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: }
291:
292: if (!$scaleopt) {
293: logger('ERROR', "unable to calculate scaling options!");
294: return 1;
295: }
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;
304: }
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;
315: }
316: return 0;
317: }
318:
319:
320: #
321: # $error = scale_tiff_jpeg2(\$args);
322: #
323: # scale TIFF images to JPEG using ImageMagick convert
324: #
325: # args needed: $srcdir, $filename, $destdir,
326: # $scalesize, $scale_rel, $picwidth, $picheight
327: #
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: }
370:
371: if (!$scaleopt) {
372: logger('ERROR', "unable to calculate scaling options!");
373: return 1;
374: }
375:
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;
390: }
391: }
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!");
443: return 1;
444: }
445: }
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");
456: }
457: }
458:
459: if (!$scaleopt) {
460: logger('ERROR', "unable to calculate scaling options!");
461: return 1;
462: }
463:
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!");
524: return 1;
525: }
526: }
527: if ($picheight > $picwidth) {
528: $scaleopt = $scalesize / $picheight;
529: logger('DEBUG', "PIC is portrait");
530: } else {
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");
537: }
538: }
539:
540: if (!$scaleopt) {
541: logger('ERROR', "unable to calculate scaling options!");
542: return 1;
543: }
544:
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:
603: #
604: # quick check if target image exists
605: #
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: }
618: }
619: } else {
620: logger('DEBUG', "target extension for $pictype unknown!");
621: }
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'");
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{'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: }
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 {
677: my($srcdir, $workdir, $destdir) = @_;
678: my $errcnt = 0;
679: my $newfn;
680:
681: opendir WORKDIR, "$srcdir/$workdir" or do {
682: logger('ERROR', "Unable to open directory $srcdir/$workdir!");
683: return 0;
684: };
685:
686: my @dirlist = readdir(WORKDIR);
687:
688: closedir WORKDIR;
689:
690: if ($do_descend) {
691: foreach (sort @dirlist) {
692: next if (/^[.]+$/);
693: next if ($junk_files{$_});
694: if (-d "$srcdir/$workdir/$_") {
695: walk_convert_dir($srcdir, "$workdir/$_", $destdir);
696: }
697: }
698: }
699:
700: logger('INFO', "Working on $workdir");
701: logger('INFO', "Reading from $srcdir/$workdir.");
702: logger('INFO', "Writing to $destdir/$workdir");
703:
704: # create destination directory
705: if (not ($simulate)) {
706: mmkdir("$destdir/$workdir") or do {
707: logger("ERROR", "unable to create directory '$destdir/$workdir'");
708: $errcnt++;
709: return 0;
710: };
711: }
712:
713: foreach (sort @dirlist) {
714: # skip dot-directories
715: if (/^[.]+.*$/) {
716: next;
717: }
718: if (-f "$srcdir/$workdir/$_") {
719: $errcnt += convert_file("$srcdir/$workdir", "$_", "$destdir/$workdir");
720: }
721: }
722:
723: if ($errcnt) {
724: logger('INFO', "There were $errcnt errors converting '$workdir'!");
725: } else {
726: logger('INFO', "Finished converting $workdir!");
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 {
739: my ($srcdir, $workdir, $destdir) = @_;
740:
741: logger('INFO', "** Converting Scans **");
742: logger('INFO', "Starting in directory '$srcdir/$workdir'");
743:
744: walk_convert_dir($srcdir, $workdir, $destdir);
745:
746: # touch source directory so digilib rescans the thumbnails
747: #logger('DEBUG', "/usr/bin/touch $source_base_dirs[0]/$workdir");
748: system("/usr/bin/touch '$srcdir/$workdir'");
749:
750: logger('DONE', "** Finished converting scans **");
751: return 1;
752: }
753:
754:
755:
756:
757:
758:
759: ###############################################################
760: ## Main
761:
762: if ($#ARGV < 3) {
763: print "Scale-O-Mat $version\n";
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";
771: exit 1;
772: }
773:
774: # test software installation
775: checksoft();
776:
777: # read command line parameters
778: my $args = parseargs();
779:
780: # source dir
781: my $srcdir = $$args{'src'};
782:
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'};
811: }
812:
813: # Overwrite
814: if ($$args{'replace'}) {
815: logger('INFO', "Set to overwrite existing files!");
816: $overwrite = 1;
817: }
818:
819: # debug
820: if ($$args{'debug'}) {
821: logger('INFO', "Set debug level to $$args{'debug'}!");
822: $debug = $$args{'debug'};
823: }
824:
825: # simulate
826: if ($$args{'simulate'}) {
827: logger('INFO', "Set to simulate operation only ($$args{'simulate'})!");
828: $simulate = $$args{'simulate'};
829: }
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