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