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