package oEdtk::libDev ;
#[JW for editor]:mode=perl:tabSize=8:indentSize=2:noTabs=true:indentOnEnter=true:
#
BEGIN {
                use oEdtk::logger       1.032;
                use oEdtk::Main 0.42;
                use oEdtk::trackEdtk    qw (ini_Edtk_Conf conf_To_Env env_Var_Completion);
                use Config::IniFiles;
                # use File::Copy;       # a prevoir pour mettre le dev dans le contexte de la prod
                use File::Basename;
                use Date::Calc          qw(Gmtime Today Compress);
                require oEdtk::libC7;
                require oEdtk::tuiEdtk;
                use Exporter;
                use vars        qw($VERSION @ISA @EXPORT @EXPORT_OK); # %EXPORT_TAGS);
                use strict;
                use warnings;
                $VERSION        = 0.314;
                @ISA            = qw(Exporter);
                @EXPORT         = qw(
                                        $NOK
                                        run_Edtk_dev
                                        IdUniqueSur7
                                        lastLong
                                        lastCourt
                                        delSp
                                        );
                @EXPORT_OK      = qw(
                                        check_EDTK_DIR  wait_Enter
                                        tree_Directory_Completion
                                        clean_full_dir          file_list
                                        prep_Edtk_Data
                                        )
#                                       catSp
        }
our $NOK =-1;
#
# CODE - DOC AT THE END
#
# limiter l'esportation de ces fonctions (export OK)
sub check_EDTK_DIR () {
        # controle l'environnement Edtk, 
        # en particulier l'existance des Directories EDTK_DIR déclarés dans l'environnement 
        while ((my $cle, my $valeur) = each (%ENV)){
                if ($cle=~/EDTK\_DIR/) {
                        #print "$cle => $valeur\n";
                        env_Var_Completion($valeur);
                        tree_Directory_Completion($valeur);
                }
        }
1;
}
sub tree_Directory_Completion ($){
        # complète si nécessaire l'arborescence entière du chemin passé en paramètre
        # en créant les répertoires du chemin transmis en paramètre
        my $tree=shift;
        #print $tree."\n";
        my @listDir = split (/[\/\\]/, $tree);
        $tree="";
        if (-e "$listDir[0]/$listDir[1]") {
                for (my $i=0 ; $i le $#listDir; $i++) {
                        $tree.=$listDir[$i]."/";
                        #print "\t $i = $listDir[$i]\n";
                        if              (-e $tree){
                        } elsif         (-d $tree){             
                        } else {
                                warn "-> mkdir, create $tree\n";
                                eval {
                                        mkdir $tree;
                                } ; die "ERR. mkdir $tree  $@" if $@;
                        }
                }
        }
1;
}
sub run_Edtk_dev() {
        import oEdtk::tuiEdtk;
         
        my $iniEdtk=ini_Edtk_Conf;
        conf_To_Env($iniEdtk, 'DEFAULT');
        conf_To_Env($iniEdtk, 'ENVDESC');
#       $ENV{EDTK_FTYP_DFLT} ||=$ENV{EDTK_FTYP_HOMOL};
        if ($ENV{EDTK_DIR_BASE} eq "") {
                not_Configured();
                exit $NOK;
        }
        &check_EDTK_DIR;
         
        start_Screen();
         
        my $styleApp=$ENV{EDTK_DIR_SCRIPT}."/".$ENV{EDTK_PRGNAME};
        env_Var_Completion($styleApp);
        env_Var_Completion($ENV{EDTK_DIR_APPTMP});
        warn "INFO : ".nowTime()." -START- \n";
        my $doclean = 1;
        if (-e "$styleApp.".$ENV{EDTK_EXT_COMSET}) {
                import oEdtk::libC7;
                my $work_file =$ENV{EDTK_FDATWORK}.".".$ENV{EDTK_EXT_WORK};
                env_Var_Completion($work_file);
                                 
                &conf_To_Env($iniEdtk, 'COMSET');
                my $ctrl = &prep_Edtk_Data($ENV{EDTK_FDATAIN}.".".$ENV{EDTK_EXT_DATA}); #, $work_file); #
                warn "INFO : ".nowTime()." -END Perl- \n";
                 
                if ($ctrl eq $NOK) {
                        warn "ERROR : return $? in prep_Edtk_Data\n";
                        &wait_Enter();
                        exit $NOK;      
                } else {
                        #warn "INFO : data extraction seem good\n";
                }
                # contrôler l'appariement des balises
                if (c7_Control_Bal($work_file) eq $NOK) {
                        warn "ERROR : return $? in c7_Control_Bal\n";
                        &wait_Enter();
                        exit $NOK;      
                } else {
                        #warn "INFO : intermediate file seem good\n";
                }
                # #
                if (defined $ENV{EDTK_TESTDATE}) { oe_set_sys_date($ENV{EDTK_TESTDATE}) };
                $ENV{EDTK_DOC_OUTPUT}= "$ENV{EDTK_FDATAOUT}.$ENV{EDTK_EXT_PDF}";
                $ENV{EDTK_EXT_DEFAULT}=$ENV{EDTK_EXT_PDF};
                if (c7EdtkComp("PDF") eq $NOK) {
                        warn "ERROR : return $? in c7EdtkComp\n";
                        &wait_Enter();
                        exit $NOK;      
                } else {
                        warn "INFO : Compo seem good\n";
                }
                if (c7EdtkEmit("PDF") eq $NOK) {
                        warn "ERROR : return $? in c7EdtkEmit\n";
                        &wait_Enter();
                        exit $NOK;      
                } else {
                        warn "INFO : Emit seem good\n";
                }
        } else {
                # Cas LaTeX
                $doclean = 0;
                $ENV{EDTK_DOC_OUTPUT}= "$ENV{EDTK_FDATAOUT}.$ENV{EDTK_EXT_WORK}";
                $ENV{EDTK_EXT_DEFAULT}=$ENV{EDTK_EXT_WORK};
                chdir($ENV{EDTK_DIR_APPTMP})
                    or die "Cannot change current directory: $!\n";
                my $ctrl = &prep_Edtk_Data($ENV{EDTK_FDATAIN}.".".$ENV{EDTK_EXT_DATA}); #, $ENV{EDTK_DOC_OUTPUT});  
                warn "INFO : ".nowTime()." -END Extract- \n";
                 
                if ($ctrl eq $NOK) {
                        warn "ERROR : return $? in prep_Edtk_Data\n";
                        &wait_Enter();
                        exit $NOK;      
                } else {
                        #warn "INFO : data extraction seem good\n";
                        #$ENV{EDTK_DOC_OUTPUT} =$ctrl;
                }
        }
        warn "INFO : ".nowTime()." -END- \n";
        # si tout c correctement deroulé, vidage des tmp
        # $| = 1; # autoflush
        if ($doclean) {
                warn "INFO : clean temp\n";
                clean_full_dir($ENV{EDTK_DIR_APPTMP});
        }
        stop_Screen();
1;
}
sub prep_Edtk_Data ($;$$) {
        # déclenchement du traitement d'extraction de données 
        # dans le contexte du lancement automatisé run_Edtk_dev
        my $command     ="$ENV{EDTK_DIR_APP}/$ENV{EDTK_PRGNAME}/$ENV{EDTK_PRGNAME}.$ENV{EDTK_EXT_PERL}";
        my $arg1        =shift;
        my $arg2        =shift || "";
        my $option=shift || "";
        env_Var_Completion($arg2);
        warn "$command $arg1 $arg2\n";
        env_Var_Completion($command);
        env_Var_Completion($arg1);
        env_Var_Completion($option);
        eval {
                #system($command, $arg1, $arg2, $option);
                system($command, $arg1, $option);
        };
          
        if ($?){
                warn " ERROR -> $@";
                warn " ERROR $command $arg1 $arg2 return $? ";
                return $NOK;
        }
1;
}
sub wait_Enter() {
        print "\nPause, taper <enter> pour continuer...\n";
        until (<STDIN>) {
        }
1;
}
         
sub delSp(\$){
        #suppression des espaces
        # le parametre est une reference implicite, exemple : delSp($chaine)
        # retourne le nombre de caracteres retires
        my $rChaine =shift;
        return ${$rChaine} =~s/\s//go;
}
sub IdUniqueSur6 () { # fonction déprécié
        #formatage d'un Id sur 6 caractères alphanumériques
        # reçoit en paramètre la référence à un identifiant
        # gestion des doublons en interne à l'exécution de la fonction
        my $rId =shift;
        my %hListeId;
        my $cpt =0;
        ${$rId} =sprintf ("%-6.6s",${$rId});
        ${$rId} =~s/\s/x/g;
        while (exists ($hListeId{${$rId}})) {
                ${$rId} =sprintf ("%-4.4s%0.2d",${$rId}, $cpt++);
        }
        $hListeId{${$rId}} =1;
1;
}
{
my $appelIUS7=0;                        # variable constante propre a la fonction
        sub IdUniqueSur7 () {
                # definition d'un identifiant unique sur 7 caracteres
                # les 6 premiers caracteres de la clef transmises sont extraits
                # si l'id est deja connu, on prend les 4 premiers et on ajoute un compteur sur 3 (correspond a la séquence des appels)
                # s'il est n'est toujours pas unique, on prend les 3 premiers caracteres et on complète le compteur sur 3 par un caractere
                # recoit : - une reference a une clef
                #          - optionnel : une reference a une valeur de compteur (3 numerique)
                my ($refId, $rInit)=@_;
                if ($rInit) {$appelIUS7=${$rInit}} else {$appelIUS7++};
                ${$refId}=sprintf ("%-7.7s",${$refId});
                ${$refId}=~s/\s/x/g;
                if (exists ($hListeId{${$refId}})){
                        ${$refId}=sprintf ("%-4.4s%0.3d",${$refId}, $appelIUS7);
                        my $cpt=97;    # pour le caractere "a"
                        while (exists ($hListeId{${$refId}})) {
                                ${$refId}=sprintf ("%-3.3s%0.3d%1.1s",${$refId}, $appelIUS7, chr($cpt++));
                                die &logger ($NOK,"impossible de creer une clef unique") if ($cpt >= 123);
                                # use Log::Log4perl;
                                # Log::Log4perl->init("log.conf"); => read log.conf
                                # $logger = Log::Log4perl->get_logger("");
                                # $logger->logdie("impossible de creer une clef unique") if ($cpt >= 123);
                                # $logger->trace("...");  # Log a trace message
                                # $logger->debug("...");  # Log a debug message
                                # $logger->info("...");   # Log a info message
                                # $logger->warn("...");   # Log a warn message       / $logger->error_warn("..."); (comprend l'appel à warn() )
                                # $logger->error("...");  # Log a error message      / $logger->logdie ("..."); (comprend l'appel à die() )
                                # $logger->fatal("...");  # Log a fatal message
                        }
                }
                $hListeId{${$refId}}=1;
        return 1;
        }
}
         
sub lastLong($) {
        # selectionne le terme alpha le plus significatif de la chaine transmise en reference
        # exemple d'appel : $mot=&lastLong ($chaine);
        # les caractères séparateurs sont des espaces, des _ ou des -
        my $chaine =shift;
        $chaine =~s/-/ /g;
        $chaine =~s/_/ /g;
        trimSP($chaine);
        # Si MOTIF contient des parenthèses (et donc des sous-motifs), un élément supplémentaire est créé 
        # dans le tableau résultat pour chaque chaîne reconnue par le sous-motif.
        #    split(/([,-])/, "1-10,20", 3);
        # produit la liste de valeurs
        #    (1, '-', 10, ',', 20)
        # http://perl.enstimac.fr/DocFr/perlfunc.html#item_split
        my @mots =split(" ",$chaine); 
        my ($mot, $motLong);
        my $taille=0;
        while ($mot =shift (@mots)){
                if (length($mot)>=$taille) {
                        $taille  =length($mot);
                        $motLong =$mot;
                }
        }
         
return $motLong;
}
         
sub lastCourt ($) {
        # selectionne le terme alpha le plus court de la chaine transmise en reference
        # exemple d'appel : $mot=&lastCourt ($chaine);
        my $chaine =shift;
        $chaine=~s/-/ /g;
        $chaine=~s/_/ /g;
        trimSP($chaine);
        my @mots =split(" ",$chaine); 
        my ($mot, $motCourt);
        my $taille=1000;
        while ($mot =shift (@mots)){
                if (length($mot)<=$taille) {
                        $taille  =length($mot);
                        $motCourt=$mot;
                }
        }
        #print "$chaine $taille $motCourt\n";
return $motCourt;
}
sub clean_full_dir ($;$){
        # le unlink tout seul ne fonctionne pas sous windows avec des wildcards ???
        # cette fonction fait le ménage dans le répertoire passé en paramètre
        # et dans les sous répertoires
        my ($membre, $option, $key, @listRep);
        $membre =shift;
        $option =shift;
        $option ||="";
        # construction du motif de recherche pour l'expression reguliere
        my $suppr_motif;
        $suppr_motif =".*";
        # print "suppr. -> $suppr_motif -> $membre\n";
        # gestion des séparateurs de répertoire
        # le séparateur standard perl (sous *nix / windows ...) -> /
        $membre.="/";
        # le séparateur fourni sous Dos est converti \ -> /
        $membre =~s/\\+/\//g;
        # suppression des répétitions /+ -> /
        $membre =~s/\/+/\//g;
        unshift (@listRep, $membre);
        $key =pop @listRep;
        ITEMS: for (;$key;){
                # comme listRep est interactif foreach ne tient pas compte des valeurs ajoutees dans listRep
                # print "path= <$key> < \@listRep=>@listRep<\n";
                eval {
                        opendir(DIR, $key);
                };
             if ($?){
                        warn " WARNING opendir(DIR, $key) return $?\n";
                        next ITEMS ;
                }
                $membre= readdir(DIR);
                for (;$membre;){
                        if ($membre ne "." && $membre ne ".."){
                                # si le membre est un repertoire
                                if (-d $key.$membre){
                                        # print "$key$membre \t (repertoire)\n";
                                        push (@listRep, "$key$membre/");
                                } else {
                                        my $file =$key.$membre;
                                        # print "$file\n";
                                        if ($file =~m{$suppr_motif}){
                                                if ($option ne "--dry-run") {
                                                        warn "suppresion de $file\n" if ($option eq "--verbose");
                                                        unlink ($file);
                                                } else {
                                                        warn "--dry-run : $file\n";
                                                }
                                        }
                                } #fin de if
                        } #fin de if
                        $membre= readdir(DIR);
                } #fin de for
                closedir DIR;
                $key =pop @listRep;
        } #fin de for
        #close OUT;
1;
}
sub file_list ($$;$){
        my ($key, @listRep, @listFile);
        my $membre      =shift;
        my $motif       =shift;
        my $opt =shift;
        $opt ||="";
         
        # gestion des séparateurs de répertoire
        # le séparateur standard perl (sous *nix / windows ...) -> /
        $membre.="/";
        # le séparateur fourni sous Dos est converti \ -> /
        $membre =~s/\\+/\//g;
        # suppression des répétitions /+ -> /
        $membre =~s/\/+/\//g;
         
        unshift (@listRep, $membre);
        $key =pop @listRep;
        ITEMS: for (;$key;){
                # comme listRep est interactif foreach ne tient pas compte des valeurs ajoutees dans listRep
                # print "path= <$key> < \@listRep=>@listRep<\n";
                eval {
                        opendir(DIR, $key);
                };
                if ($?){
                        warn " WARNING opendir(DIR, $key) return $?\n";
                        next ITEMS ;
                }
                $membre= readdir(DIR);
                for (;$membre;){
                        if ($membre ne "." && $membre ne ".."){
                                # si le membre est un repertoire
                                if (-d $key.$membre){
                                        # print "$key$membre \t (repertoire)\n";
                                        push (@listRep, "$key$membre/");
                                } else {
                                        my $file =$key.$membre;
                                        # print "$file\n";
                                        if ($file =~m{$motif}){
                                                push (@listFile, $file);
                                        }
                                } #fin de if
                        } #fin de if
                        $membre= readdir(DIR);
                } #fin de for
                closedir DIR;
                $key =pop @listRep;
        } #fin de for
        #close OUT;
return @listFile;
}
         
END {
}
1;