version 1.2, 2004/07/23 18:00:33
|
version 1.4, 2004/11/18 20:10:17
|
Line 1
|
Line 1
|
#!/usr/bin/perl |
#!/usr/bin/perl |
|
|
|
# Copyright (C) 2003,2004 Robert Casties, IT-Group MPIWG |
|
# |
|
# This program is free software; you can redistribute it and/or modify it |
|
# under the terms of the GNU General Public License as published by the Free |
|
# Software Foundation; either version 2 of the License, or (at your option) |
|
# any later version. |
|
# |
|
# Please read license.txt for the full details. A copy of the GPL may be found |
|
# at http://www.gnu.org/copyleft/lgpl.html |
|
# |
|
# You should have received a copy of the GNU General Public License along with |
|
# this program; if not, write to the Free Software Foundation, Inc., 59 Temple |
|
# Place, Suite 330, Boston, MA 02111-1307 USA |
|
|
use strict; |
use strict; |
|
use sigtrap qw(die normal-signals); |
|
|
# MPIWG libraries |
# MPIWG libraries |
use lib '/usr/local/mpiwg/scripts'; |
use lib '/usr/local/mpiwg/scripts'; |
Line 9 use MPIWGlib;
|
Line 24 use MPIWGlib;
|
|
|
$| = 1; # unblock IO |
$| = 1; # unblock IO |
|
|
my $version = "V0.9.2 (ROC 22.4.2004)"; |
my $version = "V0.9.3 (ROC 18.11.2004)"; |
|
|
$debug = 0; |
$debug = 0; |
|
|
Line 116 sub findfile {
|
Line 131 sub findfile {
|
} |
} |
|
|
|
|
|
sub cleanpath { |
|
my ($path, $startslash) = @_; |
|
|
|
if ($path =~ /^(\/)*(.*?)\/*$/) { |
|
if ($startslash) { |
|
print "$path --> $1$2\n"; |
|
return $1 . $2; |
|
} else { |
|
print "$path --> $2\n"; |
|
return $2; |
|
} |
|
} |
|
print "hä? $path\n"; |
|
return $path; |
|
} |
|
|
# |
# |
# ($basename, $extension) = splitfn($filename) |
# ($basename, $extension) = splitfn($filename) |
# |
# |
Line 142 sub mmkdir {
|
Line 173 sub mmkdir {
|
# does the directory already exist? |
# does the directory already exist? |
if (-d $dirname) { |
if (-d $dirname) { |
chmod $dir_perm, $dirname or do { |
chmod $dir_perm, $dirname or do { |
logger('ERROR', "unable to change permission on $dirname!"); |
logger('WARNING', "unable to change permission on $dirname!"); |
return 0; |
|
}; |
}; |
return 1; |
return 1; |
} |
} |
Line 175 sub mmkdir {
|
Line 205 sub mmkdir {
|
# |
# |
sub identify { |
sub identify { |
my ($filepath) = @_; |
my ($filepath) = @_; |
my $pictype; |
my $pictype = ""; |
my $picwidth; |
my $picwidth = 0; |
my $picheight; |
my $picheight = 0; |
my $bitdepth = 0; |
my $bitdepth = 0; |
# use quickident first |
# use quickident first |
$pictype = quickident($filepath); |
$pictype = quickident($filepath); |
Line 188 sub identify {
|
Line 218 sub identify {
|
while (<IDENT>) { |
while (<IDENT>) { |
chomp; |
chomp; |
if (/Image Width:\s*(\d+)\s*Image Length:\s*(\d+)/) { |
if (/Image Width:\s*(\d+)\s*Image Length:\s*(\d+)/) { |
$picwidth = $1; |
$picwidth = $1 if ($1 > $picwidth); |
$picheight = $2; |
$picheight = $2 if ($2 > $picheight); |
next; |
next; |
} |
} |
if (/Bits\/Sample:\s*(\d+)/) { |
if (/Bits\/Sample:\s*(\d+)/) { |
$bitdepth = $1; |
$bitdepth = $1 if ($1 > $bitdepth); |
next; |
next; |
} |
} |
} |
} |
if ($picwidth) { |
if ($picwidth) { |
logger('DEBUG', "TIFF $1 x $2"); |
logger('DEBUG', "TIFF $picwidth x $picheight"); |
return ($pictype, $picwidth, $picheight, $bitdepth); |
return ($pictype, $picwidth, $picheight, $bitdepth); |
} |
} |
} |
} |
Line 778 checksoft();
|
Line 808 checksoft();
|
my $args = parseargs(); |
my $args = parseargs(); |
|
|
# source dir |
# source dir |
my $srcdir = $$args{'src'}; |
my $srcdir = cleanpath($$args{'src'}, 1); |
|
|
# destination dir |
# destination dir |
my $destdir = $$args{'dest'}; |
my $destdir = cleanpath($$args{'dest'}, 1); |
|
|
# working dir |
# working dir |
my $workdir = $$args{'dir'}; |
my $workdir = cleanpath($$args{'dir'}); |
|
|
# destination size |
# destination size |
if ($$args{'scaleby'}) { |
if ($$args{'scaleby'}) { |