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