#!/usr/bin/perl                

###############################################################################
#Ce script permet d'extraire des fichiers de collation à partir d'un apparat  #
#simplifié au format demandé par le logiciel ADAIN.                           #
#Cet utilitaire est libre: vous pouvez l'utiliser, le copier et le modifier   #
#selon les termes de la licence GNU-GPL.                                      #
###############################################################################

use strict;
#use warnings;

my $pascherche = "";
my $ms = $ARGV[0];

if ($ms =~ /pc/) {$pascherche = "$ms"."ac"; 
$pascherche =~ s/pc//g;} 
else {$pascherche = "$ms"."pc"; };

@ARGV = glob "apparat.txt" or die "Le fichier apparat.txt n'a pas été trouvé.";

my $pastrouve = 0;

while (<>) {
    if (/^>/) {

    s/> //;
    s/:/\/:\//;

    s/ codd\. / \/codd\.\/ /g;
    s/ codd\.$/ \/codd\.\//g;
        s/ edd\. / \/edd.\/ /g;
    s/ edd.$/ \/edd.\/ /g;
        s/ scripsi /\/scripsi\//g;
    s/ scripsi\./ \/scripsi\//g;
        s/et plerique//g;
        s/ut uid.//g;
    s/codd\./$ms/g;

    s/$pascherche//g;

    s/ut glossema//g;

    s/om\.//g;
    s/def\.//g;
    s/del\.//g;

    s/\'//g;
    s/\!//g;
    s/\?//g;

    s/\(.*\)//g;

    my @lectiones = split /\//, $_;
    my $lemme = $lectiones[0];

        if (! /$ms/) {$lectiones[1] = $ms;};

        my $demilongueur = int(((length($lemme) - 1)/2));
        my $tierslongueur = int(((length($lemme) - 1)/3));
        my $debut = substr $lemme, 0, $demilongueur;
        my $fin = substr $lemme, $demilongueur, $demilongueur + 1;
        my $debuttiers = substr $lemme, 0, $tierslongueur;
        my $fintiers = substr $lemme, (2 * $tierslongueur), $tierslongueur + 1;
    

    my $nombre = @lectiones;

    my $compteur = 1;
    my $nonlegitur = "";

    for ($compteur = 1; $compteur < length($lemme); $compteur +=1) {
        $nonlegitur = $nonlegitur."*";
    }

    my $i = 0;
    for ($i = 1; $i <= $nombre; $i += 2) {
        if ($lectiones[$i] =~ (/$ms/)) {
            my $lectio =  $lectiones[$i-1];
            $lectio =~ s/ -(\w*)- / $debuttiers\*$1\*$fintiers /g;
            $lectio =~ s/ -/ $debut\*/;
            $lectio =~ s/- /\*$fin /;
            $lectio =~ s/non leg\./$nonlegitur/g;
            printf "$lectio\n";} 
        else {printf "";};
    }

    }

}
