summaryrefslogtreecommitdiff
path: root/fonts/psfonts/corelpak-contrib/translate-font.pl
diff options
context:
space:
mode:
Diffstat (limited to 'fonts/psfonts/corelpak-contrib/translate-font.pl')
-rwxr-xr-xfonts/psfonts/corelpak-contrib/translate-font.pl71
1 files changed, 71 insertions, 0 deletions
diff --git a/fonts/psfonts/corelpak-contrib/translate-font.pl b/fonts/psfonts/corelpak-contrib/translate-font.pl
new file mode 100755
index 0000000000..ab85ef4196
--- /dev/null
+++ b/fonts/psfonts/corelpak-contrib/translate-font.pl
@@ -0,0 +1,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";
+}