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: ";
@