2005-10-01 23:47:08 +00:00
|
|
|
#!/usr/bin/perl
|
2005-12-15 20:31:05 +00:00
|
|
|
# $Id$
|
2005-12-17 18:27:09 +00:00
|
|
|
# xlatcfg.pl
|
2005-10-01 23:47:08 +00:00
|
|
|
# Generate xlatcharset directives for the config of Golded+
|
|
|
|
# using Golded+ charset conversion modules in text form (*.chs).
|
|
|
|
#
|
|
|
|
# Format:
|
|
|
|
# XLATCHARSET RUS IBMPC RUS_IBM.CHS
|
|
|
|
|
|
|
|
if($#ARGV<1){
|
|
|
|
die "Need two parameters: directory witn *.chs (1) and output file name (2)\n";
|
|
|
|
}
|
|
|
|
|
|
|
|
if( -f $ARGV[1] ){
|
|
|
|
die "File '$ARGV[1]' is exists, exiting\n";
|
|
|
|
}
|
|
|
|
|
|
|
|
if( ! -d $ARGV[0] ){
|
|
|
|
die "Directory '$ARGV[1]' is not exists, exiting\n";
|
|
|
|
}
|
|
|
|
my $dir=$ARGV[0], $out=$ARGV[1];
|
|
|
|
|
|
|
|
my @files=<$dir/*.chs>;
|
|
|
|
|
2005-10-02 01:21:59 +00:00
|
|
|
if( $#files < 0 ){
|
|
|
|
die "$dir/ don't contains files like *.chs, exit\n";
|
|
|
|
}
|
2005-10-01 23:47:08 +00:00
|
|
|
open OUT, ">$out" || die "Can't open/create file '$out': $!\n";
|
2005-10-02 01:21:59 +00:00
|
|
|
print OUT <<HEAD;
|
|
|
|
// Character translation definitions
|
|
|
|
// (include file for Golded+ config)
|
|
|
|
//
|
2005-11-05 23:17:47 +00:00
|
|
|
// Generated by 'xlatcfg.pl' script written by Stas Degteff 2:5080/102\@fidonet
|
2005-10-02 01:21:59 +00:00
|
|
|
//
|
|
|
|
HEAD
|
2005-10-01 23:47:08 +00:00
|
|
|
|
|
|
|
print "Found " . ($#files+1) . " *.CHS files in $dir\n";
|
|
|
|
|
|
|
|
foreach my $f (@files) {
|
2005-12-17 18:27:09 +00:00
|
|
|
if( ! open( IN, "$f" ) ){ print STDERR "Can't open file '$f': $!\n"; next; }
|
|
|
|
print "Proceed $f\n";
|
2005-10-01 23:47:08 +00:00
|
|
|
my $count=1, $fromchs, $tochs;
|
2005-12-17 18:27:09 +00:00
|
|
|
$f =~ s%.*/%%g;
|
2005-10-01 23:47:08 +00:00
|
|
|
while( <IN> ) {
|
|
|
|
next if( /^;/ ); # comment
|
|
|
|
next if( m%^//% ); # comment
|
|
|
|
next if( m%^#% ); # comment
|
|
|
|
chomp;
|
|
|
|
next if( m%^$% ); # empty line
|
|
|
|
if( m%^([^\s]+)% ) {
|
2005-12-17 18:27:09 +00:00
|
|
|
if($count==4){ $fromchs=uc($1); }
|
2005-10-01 23:47:08 +00:00
|
|
|
elsif($count==5){
|
2005-12-17 18:27:09 +00:00
|
|
|
$tochs=uc($1);
|
2005-10-01 23:47:08 +00:00
|
|
|
printf OUT "XLATCHARSET %-12s %-12s %s\n", $fromchs, $tochs, $f;
|
2005-12-15 20:31:05 +00:00
|
|
|
if($fromchs =~ /-/) {
|
|
|
|
( my $temp = $fromchs ) =~ s/-//g ;
|
|
|
|
printf OUT "XLATCHARSET %-12s %-12s %s\n", $temp, $tochs, $f;
|
|
|
|
}
|
|
|
|
if($tochs =~ /-/) {
|
|
|
|
( my $temp = $tochs ) =~ s/-//g ;
|
|
|
|
printf OUT "XLATCHARSET %-12s %-12s %s\n", $fromchs, $temp, $f;
|
|
|
|
}
|
|
|
|
if( ($tochs =~ /-/) && ($fromchs =~ /-/) ) {
|
|
|
|
( my $temp1 = $fromchs ) =~ s/-//g ;
|
|
|
|
( my $temp2 = $tochs ) =~ s/-//g ;
|
|
|
|
printf OUT "XLATCHARSET %-12s %-12s %s\n", $temp1, $temp2, $f;
|
|
|
|
}
|
2005-10-01 23:47:08 +00:00
|
|
|
}
|
|
|
|
$count++;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
close IN;
|
|
|
|
}
|
|
|
|
|
|
|
|
close OUT;
|