deb-goldedplus/cfgs/config/xlatcfg.pl

#!/usr/bin/perl
# $Id$
# xlatcfg.pl
# 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[0]' is not exists, exiting\n";
}
my $dir=$ARGV[0], $out=$ARGV[1];

my @files=<$dir/*.chs>;

if( $#files < 0 ){
 die "$dir/ don't contains files like *.chs, exit\n";
}
open OUT, ">$out" || die "Can't open/create file '$out': $!\n";
print OUT <<HEAD;
// Character translation definitions
// (include file for Golded+ config)
//
//  Generated by 'xlatcfg.pl' script written by Stas Degteff 2:5080/102\@fidonet
//
HEAD

print "Found " . ($#files+1) . " *.CHS files in $dir\n";

my $errors = 0;
foreach my $f (@files) {
  if( ! open( IN, "$f" ) ){ print STDERR "Can't open file '$f': $!\n"; next; }
  print "Proceed $f\n";
  my $count=1, $fromchs, $tochs;
  $f =~ s%.*/%%g;
  while( <IN> ) {
     next if( /^;/ ); # comment
     next if( m%^//% ); # comment
     next if( m%^#% ); # comment
     chomp;
     next if( m%^$% ); # empty line
     if( m%^([^\s]+)% ) {
       if($count==4){
         $fromchs=uc($1);
       }
       elsif($count==5){
         my $comment;
         $tochs=uc($1);
         if(length($tochs) > 16) {
           print STDERR "Charset name $tochs too long (max 16 characters). File $f can't used yet.\n";
           printf OUT "; Error: $tochs too long\n";
           $errors++; $comment="; ";
         }
         if(length($fromchs) > 16) {
           print STDERR "Charset name $fromchs too long (max 16 characters). File $f can't used yet.\n";
           printf OUT "; Error: $fromchs too long\n";
           $errors++; $comment="; ";
         }
         printf OUT "%sXLATCHARSET %-12s %-12s %s\n", $comment, $fromchs, $tochs, $f;
         if($fromchs =~ /-/) {
           ( my $temp = $fromchs ) =~ s/-//g ;
           print OUT $comment."XLATCHARSETALIAS $fromchs $temp\n";
         }
         if($tochs =~ /-/) {
           ( my $temp = $tochs ) =~ s/-//g ;
           print OUT $comment."XLATCHARSETALIAS $tochs $temp\n";
         }
       }
       $count++;
     }
  }
  close IN;
}

close OUT;

if( $errors >0 ) { print "\n*** Errors found. Please check output file. ***\n"; }