head 1.3; access; symbols; locks; strict; comment @# @; 1.3 date 99.01.12.15.52.33; author tinne; state Exp; branches; next 1.2; 1.2 date 99.01.08.11.30.25; author tinne; state Exp; branches; next 1.1; 1.1 date 99.01.08.09.13.53; author tinne; state Exp; branches; next ; desc @@ 1.3 log @Added Shorthelp, use some more perl modules but shell commands. @ text @#!/app/unido-inf/sun4_55/perl/5.004.03/bin/perl die "Syntax: $0 pattern [suffix]\n" if ($#ARGV == -1 || $#ARGV > 1); use Cwd qw/cwd/; use File::Copy qw/cp/; use File::Basename qw(dirname); $destination=cwd(); $prgdir = dirname $0; $tblfile = $prgdir . "/transtabl"; $mntfile = $prgdir . "/mountpoint"; if (open CDMNT, $mntfile) { $cd = ; chop $cd; close CDMNT; } else { print "Please enter a mountpoint (or device letter) for the Corel CD.\n: "; $cd = ; chop $cd; die "No such directory: $cd.\n" unless -d $cd; system "echo $cd > $mntfile"; } $fontdir="$cd/fonts/type1"; open TBL, $tblfile or die "$tblfile - $!"; while ($entry = ) { next if length($entry) == 1 or $entry =~ /^#/; ($key, $name) = split /\s+/, $entry; # print "Translation of $key is $name.\n"; @@translation{$key} = $name; } close TBL; $searchname=$ARGV[0]; $firstchar=substr $searchname, 0, 1; $firstchar =~ /[a-z]/ or die "$searchname doesn't start with letter.\n"; chdir "$fontdir/$firstchar" or die "cannot cd to $fontdir/$firstchar.\n"; @@files = glob $searchname; $justscan = not ($suffix = $ARGV[1]); print "Obtaining .$suffix-suffixed files.\n" unless $justscan; foreach $file (@@files) { next if ($file !~ m/pfb$/); $head = `strings $file | head -1`; (undef, $name, undef) = split " ", $head; print "»$file«:", " " x (15 - length $file), "$name\n"; } exit if $justscan; foreach $file (@@files) { next if ($file !~ /$suffix$/); ($rawfile) = split /.$suffix$/, $file; if (not defined $translation{$rawfile}) { print "»$file«:", " " x (15 - length $file), "Translation ($rawfile) unknown, skipping.\n"; next; } $destfile = "$translation{$rawfile}.$suffix"; print "Copying $file to $destfile.\n"; cp $file, "$destination/$destfile"; } @ 1.2 log @added dos specific comment. @ text @d3 1 a3 1 use File::Copy "cp"; d5 6 a10 2 $cwd=`pwd`; chop $cwd; $prgdir = `dirname $0`; chop $prgdir; d70 1 a70 1 cp $file, "$cwd/$destfile"; @ 1.1 log @Initial revision @ text @d16 1 a16 1 print "Please enter a mountpoint for the Corel CD.\n: "; @