source: app/dist/common/utt_make_config.pl @ a4d0da5

#!/usr/bin/perl
#c:\usr\perl\bin\perl.exe

use Cwd 'abs_path';
use File::Basename;
use File::HomeDir;
use File::Spec::Functions;
use POSIX;

my $sys_home = catdir(dirname(abs_path($0)), "..");
my $usr_home = catdir(home(), '.utt');

prepareUttUsrHome($usr_home);
conf_utt(catfile($usr_home, 'utt.conf'), $sys_home);

conf_cor(catfile($usr_home, 'cor.conf'), $sys_home);
conf_compiledic(catfile($usr_home, 'compiledic.conf'), $sys_home);
conf_grp(catfile($usr_home, 'grp.conf'), $sys_home);
conf_gue(catfile($usr_home, 'gue.conf'), $sys_home);
conf_lem(catfile($usr_home, 'lem.conf'), $sys_home);
conf_ser(catfile($usr_home, 'ser.conf'), $sys_home);

print "UTT user configuration created in $usr_home\n";



#Kasuje stare configi i tworzy katalog .utt
sub prepareUttUsrHome() {
    my $dir = shift;

    print "Preparing user configuration.\n";

    if(-d $dir) {
        print "Old configuration detected. ";
        my $cnt = unlink <$dir/*>;
        print "($cnt files deleted)\n";
    }
    else {
        print "Creating directory $dir\n";
        if(1 != mkdir $dir) {
            die "Unable to create UTT user configuration!\n";
        }
    }
}

# Tworzy naglowek dla wszystkich plikow konfiguracyjnych
sub makeConfigHeader() {
  return "# ************************************************************\n".
                 "# * This file was created automatically during installation. *\n".
                 "# * If you don't need do not change it.                      *\n".
                 "# *                                                          *\n".
                 "# * UAM Text Tools                                           *\n".
                 "# * Adam Mickiewicz University, Poland                       *\n".
                 "# * http://utt.amu.edu.pl                                    *\n".
                 "# ************************************************************\n".
                 "#\n".
                 "# All lines must looks like:\n".
                 "# parameter_name [=] value\n".
                 "#\n\n";
}

sub conf_compiledic() {
        my $compiledic_file = shift;
        my $utthome = shift;
  open(FILE, ">$compiledic_file");

  print FILE makeConfigHeader();
  my $hm = home();
  my $lang=`grep language $hm/.utt/utt.conf | cut -d= -f 2`;
  chomp $lang;
# powinno byc $utthome/share/utt/pl_PL.ISO-8859-2/pl_PL.ISO-8892-2.sym
# ale to bez sensu
  print FILE "symbols=", abs_path("$utthome/share/utt");
  print FILE "/$lang/$lang.sym\n";

  close FILE;
}

sub conf_grp() {
        my $grp_file = shift;
        my $utthome = shift;
  open(FILE, ">$grp_file");

  print FILE makeConfigHeader();
  print FILE "macros=", abs_path("$utthome/lib/utt/terms.m4"), "\n";

  close FILE;
}

sub conf_cor() {
        my $cor_file = shift;
        my $utthome = shift;
  open(FILE, ">$cor_file");

  print FILE makeConfigHeader();
  print FILE "dictionary-home=", abs_path("$utthome/share/utt"), "\n";

  close FILE;
}

sub conf_grp() {
        my $grp_file = shift;
        my $utthome = shift;
  open(FILE, ">$grp_file");

  print FILE makeConfigHeader();
  print FILE "macros=", abs_path("$utthome/lib/utt/terms.m4"), "\n";

  close FILE;
}

sub conf_gue() {
        my $gue_file = shift;
        my $utthome = shift;
  open(FILE, ">$gue_file");

  print FILE makeConfigHeader();

  close FILE;
}

sub conf_lem() {
        my $lem_file = shift;
        my $utthome = shift;
  open(FILE, ">$lem_file");

  print FILE makeConfigHeader();
  print FILE "dictionary-home=", abs_path("$utthome/share/utt"), "\n";

  close FILE;
}

sub conf_ser() {
        my $ser_file = shift;
        my $utthome = shift;
  open(FILE, ">$ser_file");

  print FILE makeConfigHeader();
  print FILE "macros=", abs_path("$utthome/lib/utt/terms.m4"), "\n";
  print FILE "flex-template=", abs_path("$utthome/lib/utt/ser.l.template"), "\n";

  close FILE;
}

sub conf_utt() {
        my $utt_file = shift;
        my $utthome = shift;

        my $lang = getUserLanguage(abs_path(catdir($utthome, "share/utt")));

  open(FILE, ">$utt_file");

  print FILE makeConfigHeader();
  print FILE "# user locale (dictionary)\n";
  print FILE "language=", $lang, "\n";

  close FILE;
}

sub getUserLanguage() {
    my $dict_dir = shift;

    print "Setup dictionaries.\n";
    
    opendir(DIR, $dict_dir) || die "Install dictionary first!\n";
    @files = grep(/[^\.{1,2}]/ && -d "$dict_dir/$_", readdir(DIR));
    closedir DIR;
    my $cnt = scalar @files;
    print "$cnt dictionary(ies) found.\n";
    if(0 == $cnt) {
        die("Install dictionary first!\n");
    }

    foreach my $file (@files) {
        print "Do you select dictionary $file [yes/no]? ";
        my $ans = <STDIN>;
        if($ans =~ /y(es)?/i) {
            return $file;
        }
    }
    die "No dictionary selected - setup failed!\n";
}

# Szuka locali u uzytkownika
sub findLocale() {
        $cur_locale = setlocale(LC_CTYPE);

        # we replace Latinx to ISO-8859-x
        $cur_locale =~ s/(.+?)Latin(.+?)/$1ISO\-8859\-$2/g;

        if($cur_locale =~ /\w+_\w+\.\S+/) {
          $best_locale = $cur_locale;
        }
        elsif($cur_locale =~ /\w+_\w+/) {
          $best_locale = $cur_locale.".UTF-8";
        }
        else {
          $best_locale = toupper($cur_locale).'_'.tolower($cur_locale).'.UTF-8';
        }
        return $best_locale;
}