diff options
Diffstat (limited to 'fonts/psfonts/corelpak-contrib/translate-font.pl,v')
-rwxr-xr-x | fonts/psfonts/corelpak-contrib/translate-font.pl,v | 133 |
1 files changed, 133 insertions, 0 deletions
diff --git a/fonts/psfonts/corelpak-contrib/translate-font.pl,v b/fonts/psfonts/corelpak-contrib/translate-font.pl,v new file mode 100755 index 0000000000..aeb723c2e1 --- /dev/null +++ b/fonts/psfonts/corelpak-contrib/translate-font.pl,v @@ -0,0 +1,133 @@ +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 = <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"; +} +@ + + +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: "; +@ |