sub myReadLine {
    my $fh = shift;
    
    my $s = '';
    while ( sysread( $fh, my $c, 1 ) ) {
        last if ( $c eq "\x0A" or  $c eq "\x0D" );
        $s = $s. $c;
    }
    return $s;
}

open( my $fh, '<', $oldname ) or die "$oldname: $!";
binmode $fh;
while ( my $s = myReadLine( $fh ) ) {
    ($newname) = $s =~ /\/FullName\s+\(([^)]+)\)/;
    last if defined $newname;
}
close ($fh);
    
warn "$oldname: name of font not found!\n" if not defined $newname;