1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
|
#!/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 = <CDMNT>;
chop $cd;
close CDMNT;
} else {
print "Please enter a mountpoint (or device letter) for the Corel CD.\n: ";
$cd = <STDIN>;
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 = <TBL>) {
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";
}
|