mfannot

#!/usr/bin/perl -w -- -*-Perl-*-

##############################################################################
#
#                                 mfannot
#
# DESCRIPTION:
# Attempts to do a quick first pass at annotating a masterfile
# with meaningfull start/stop lines by calling blast on collections
# of known genes. Manual intervention is still required to check/adjust
# the new annotations.
#
# Known issues: - Annotations for START/STOP introns are interleaved (they
#                 are at the correct position, though).
#
##############################################################################

#############################################################################
#                                 MFANNOT                                   #
#                                                                           #
#                          Copyright (C) 2008                               #
#                         Departement de Biochimie,                         #
#                          Universite de Montreal,                          #
#                     C.P. 6128, succursale Centre-ville,                   #
#                      Montreal, Quebec, Canada, H3C 2J7                    #
#                                                                           #
#                Programming:  Natacha Beck, Pierre Rioux.                  #
#                Old version programming: David To, Thomas Hoellinger.      #
#                Project management: Franz Lang (OGMP)                      #
#                E-Mail information: Franz.Lang@Umontreal.ca                #
#                                                                           #
#     This software is distributed under the GNU GENERAL PUBLIC LICENSE, as #
# published by the Free Software Foundation. A copy of version 2 of this    #
# license should be included in a file called COPYING. If not, write to the #
# Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.   #
#############################################################################


##########################
# Initialization section #
##########################

require 5.00;
use strict;

use IO::File;
use IO::Dir;
use Cwd;
use File::Basename;
use File::Path;
use File::Spec;
use PirObject;                                        # Pir module treatment
use Bio::AlignIO;                                     # Bioperl (used for parsing alignement)
use Bio::SeqUtils;                                    # Some biological tools
use Bio::Tools::CodonTable;                           # To create a codon table, to be used with genewise
use Bio::Matrix::IO;                                  # Used for read matrix like PAM
use List::Util qw(min max);
use Sys::Hostname;
use FindBin;
use List::MoreUtils 'first_index';
use Data::Dumper;

sub info;

BEGIN {
# Load PirObject
  PirObject->LoadDataModel("Masterfile");               # Masterfile object
  PirObject->LoadDataModel("MfAnnotExternalProgs");     # Support for execution of external programs
  PirObject->LoadDataModel("AnnotPairCollection");      # Also for external programs.
  PirObject->LoadDataModel("ExonerateOutput");          # Parser for Exonerate output
  PirObject->LoadDataModel("FlipBlastProt");            # Objects for storing ORFs predicted by Flip and kept with blast
  PirObject->LoadDataModel("HypProt");                  # Hypothetical protein : We believe its a protein after flip.
  PirObject->LoadDataModel("HypFusion");                # Contain information about gene fusion
  PirObject->LoadDataModel("Option");                   # A module for options gestion
  PirObject->LoadDataModel("EmptyOrf");                 # Object containing Orfs having no corresponding genes
  PirObject->LoadDataModel("BlastOutput");              # Model of blast results in XML (blastall -m 7)
  PirObject->LoadDataModel("AlignedSeq");
  PirObject->LoadDataModel("MultAlign");
  PirObject->LoadDataModel("HMMsearchOutput");
} # End Begin

# Default umask
umask 027;

# Program's name and version number.
our $MFANNOT_COMMIT_DATE = "Unknown";
my $resultat     = system("git -C /mfannot/ show --summary | grep Date  > /dev/null 2>&1");
my $hascoredump  = ($resultat & 128) >> 7;  # 0 if no core dump, 1 if core dump
my $signal       = $resultat & 127;  # SIGNAL received by subprocess, from 0 to 127;
my $returncode   = $resultat >> 8;   # exit status of subprogram
if (!($returncode > 1 || $signal > 0 || $hascoredump == 1)) {
    $MFANNOT_COMMIT_DATE =  `git -C /mfannot/ show --summary | grep Date | head -1`;
    chomp($MFANNOT_COMMIT_DATE);
}


our $VERSION     = "Unknown";
my $MFANNOT_PATH = $FindBin::Bin;
$resultat        = system("git -C $MFANNOT_PATH tag > /dev/null 2>&1");
$hascoredump     = ($resultat & 128) >> 7;  # 0 if no core dump, 1 if core dump
$signal          = $resultat & 127;  # SIGNAL received by subprocess, from 0 to 127;
$returncode      = $resultat >> 8;   # exit status of subprogram
if (!($returncode > 1 || $signal > 0 || $hascoredump == 1)) {
    $VERSION =  `git -C $MFANNOT_PATH tag | tail -n 1`;
    chomp($VERSION);
}

our $COMMIT  = "commit Unknown";
$resultat    = system("git -C $MFANNOT_PATH log > /dev/null 2>&1");
$hascoredump = ($resultat & 128) >> 7;  # 0 if no core dump, 1 if core dump
$signal      = $resultat & 127;  # SIGNAL received by subprocess, from 0 to 127;
$returncode  = $resultat >> 8;   # exit status of subprogram
if (!($returncode > 1 || $signal > 0 || $hascoredump == 1)) {
    $COMMIT =  `git -C $MFANNOT_PATH log | head -n 1`;
    chomp($COMMIT);
}

our $PIR_COMMIT = "Unknown";
$resultat     = system("git -C  $ENV{'PIR_DATAMODEL_PATH'} log > /dev/null 2>&1");
$hascoredump  = ($resultat & 128) >> 7;  # 0 if no core dump, 1 if core dump
$signal       = $resultat & 127;  # SIGNAL received by subprocess, from 0 to 127;
$returncode   = $resultat >> 8;   # exit status of subprogram
if (!($returncode > 1 || $signal > 0 || $hascoredump == 1)) {
    $PIR_COMMIT =  `git -C $ENV{'PIR_DATAMODEL_PATH'} log | head -1`;
    chomp($PIR_COMMIT);
}


our ($BASENAME) = ($0 =~ /([^\/]+)$/);
our $MAINPROGRAM_PID = $$;

# Get login name
my $USER = getpwuid($<) or getlogin or die "Can't find USER from environment!\n";

##################################
# Global variables and constants #
##################################

# Command-line args (first, original program)
my $ANNOT_STATS         = {'Added' => {} };        # Use for create the header.
my $FLIPBLASTPROTS      = [];                      # Array containing the Proteins predicted by Blast and Flip
my $HYPPROTS            = [];                      # Array containing the Proteins predicted by Blast and Flip and reprocessed after
my $ENDO_BY_CG          = {};                      # Hash with endonuclease by contig
my $EMPTYORFS           = [];                      # Array containing ORFs having no corresponding genes
my $TRI_NT_START_COUNT  = {};                      # Hash with count of tri_nt start.
my $FAMILY_LIST         = {};                      # Hash with family list.
my $TMPDIR              = "";                      # Temporary directory

# General options
my $DEBUG;                                      # Debug mode. If true, display message on the screen
my $GENCODE          = undef;                   # Genetique code
my $LOG_FILE;                                   # Log file : store all the information about run
my $ISLOGFILE        = 0;                       # Just to know if the $LOG_FILE is not empty (0 or 1)
my $MASTERFILE       = undef;                   # Path for Masterfile
my $CACHE_PEPLIBRARY = {};                      # Cache of all proteins in library
my @PROT_FOR_EXONERATE;                         # Array with homolog protein for Exonerate
my $OUTPUTFILE;                                 # Path for the new
my $ORFPROCESS;                                 # Allows ORF appearing in the masterfile as annotations
my $PEPLIBRARIES;                               # The libraries, in input, by default datagenescollection and dataorfcollection
my $EXTCONFIGFILE;                              # The path for configuration file, it's use for annotation of rnpB, rnl and rns;
my $MOTFILE;                                    # The path of pattren file.
my $LVL_MOT;                                    # Indicate level of motif identification.
my $EXTSELECTPROG;                              # List of name for external programs.
my $LVL_INTRON;                                 # Indicate level of intron identification (1 or 2).
my $BLASTOUTPUT       = "";                     # The path for blast file results
my $BLASTEVALUECUTOFF;                          # Cutoff value for the blast
my $HMMVALUECUTOFF    = "10e-3";                # Cutoff value for HMM
my $MINLENGTHORF;                               # This is the minimum length for creating an ORF with flip
my $MAXLENGTHFORGROUPINGORF;                    # Maximum size of a gap between 2 ORf. If 2 same ORF
my $MAXLENINTRONS;                              # Max intron size for exonerate.
my $MINLENEMPTYORF;                             # Minimum length for ORF empty orfs (non corresponding orfs)
my $OVERLAPPINGCUTOFF;                          # Overlapping cutoff for ORFs
my $OVERLORFOVORF;                              # Overlapping cutoff for ORFs
my $OVERLAPORFOVGENE;                           # Overlapping cutoff for ORFs
my $MININTRONSIZE;                              # Opposite of MAXLENGTHFORGROUPINGORF. Minimum size for intron
my $MINEXONSIZE;                                # Minimum exon size for intron.
my $MATRIX;                                     # PAM or BLOSUM matrix
my $PARTIAL;                                    # This will cause mfannot to only run a subset of all its built-in analysis
my $INSERTION;                                  # Minimum length for report insertion.
my $LIGHT;                                      # Don't run endonuclease search and don't search for every gene by HMM
my $USEPRM;                                     # Set to 1 if user want to use .prm file
my $SQN_FORMAT;                                 # Boolean if set does the converstion mf -> sqn
my $TBL_FORMAT;                                 # Boolean if set save tbl output
my $ENDO_HASH = {};                             # Hash with endonuclease list.

$ENDO_HASH->{"HNH"}++; $ENDO_HASH->{"GIY-YIG"}++ ;$ENDO_HASH->{"LAGLIDADG"}++;
$ENDO_HASH->{"ReverseTranscriptase"}++; $ENDO_HASH->{"matR"}++; $ENDO_HASH->{"matK"}++;
$ENDO_HASH->{"rpo"} = "PSEUDO"; $ENDO_HASH->{"dpo"} = "PSEUDO";

# Command line Program's paths
my $PATH = $ENV{"PATH"} || "";
my @PATH = split(/:/, $PATH);

my $HOME                    = $ENV{"HOME"};
my $FLIPPATH                = &GetPath("flip");
my $MAKEBLASTDBPATH         = &GetPath("makeblastdb");
my $BLASTPATH               = &GetPath("blastp");
my $BLASTNPATH              = &GetPath("blastn");
my $MUSCLEPATH              = &GetPath("muscle");
my $UMACPATH                = &GetPath("umac");
my $HMMBUILDPATH            = &GetPath("hmmbuild");
my $HMMALIGNPATH            = &GetPath("hmmalign");
my $HMMSEARCHPATH           = &GetPath("hmmsearch");
my $EXONERATEPATH           = &GetPath("exonerate");
my $GETORFPATH              = &GetPath("getorf");
my $MF2SQNPATH              = &GetPath("mf2sqn");

# First get option in order to check some variables.
&GetOptions ;     # Get the different options and put them into global variables

###################################################################
# Check file existance: models, external config file, motif file. #
###################################################################

# 1. Check for models path
my @MOD_PATH      = (($ENV{"MFANNOT_MOD_PATH"} || $HOME || ".") . "/MFannot_data/models");
push(@MOD_PATH,split(/:/,$ENV{"MFANNOT_MOD_PATH"})) if $ENV{"MFANNOT_MOD_PATH"};

my $MODEL_PATH = "";
foreach my $path (@MOD_PATH) {
  next if !(-d $path);
  $MODEL_PATH = $path;
}

#HMMmodel path
my $HMM_model_path = "$MODEL_PATH/HMM_models/id_by_gene";
die "Directory for gene identified by HMM model not found\n"
   if (! -e "$HMM_model_path");

$MODEL_PATH =~ s/\/$//;
die "No path for ErpinModels and HMMweaselModels were found\n"
  if !$MODEL_PATH;

#  2. Check for external config file
die "File $EXTCONFIGFILE give with option 'ext_select' doesn't exist.\n"
  if (! -e "$EXTCONFIGFILE");

# 3. Check for motif file
die "File $MOTFILE give with option 'motfile' doesn't exist.\n"
  if ( ! -e "$MOTFILE");

my $LISTPAT = &read_pat_file($MOTFILE) if ($LVL_MOT != 0);

# 4. Check for library path
my @LIB_PATH      = (($ENV{"MFANNOT_LIB_PATH"} || $HOME || ".")); # You can add other search directories here
push(@LIB_PATH,split(/:/,$ENV{"MFANNOT_LIB_PATH"})) if $ENV{"MFANNOT_LIB_PATH"};


#Check for directory
#Check for intronic lib
my $intronic_lib    = "";
foreach my $dir (@LIB_PATH) {
    next if !( -e "$dir/intronic/intronic_orfs.pep" );
    $intronic_lib    = "$dir/intronic/intronic_orfs.pep";
    last;
}
die "File not found in intronic orf library\n"
     if !$intronic_lib;

#Check for family lib
my $family_lib = "";
foreach my $dir (@LIB_PATH) {
    next if !( -e "$dir/family.lib" );
    $family_lib    = "$dir/family.lib";
    last;
}
die "File not found in family library\n"
     if !$family_lib;

die "Please make sure the BLASTMAT environment variable is set\n".
    "to point to a directory where the blast matrices are stored.\n"
    unless defined($ENV{"BLASTMAT"}) and (-d $ENV{"BLASTMAT"}) and (-f ($ENV{"BLASTMAT"} . "/PAM70"));

my $matrix_path = $ENV{"BLASTMAT"}."/PAM70";

my $parser           = new Bio::Matrix::IO(-format => 'scoring',
                                           -file   => $matrix_path);
my $matrix           = $parser->next_matrix;


# TODO
# Parameters that don't have (yet) options on the command-line
# E-value cutoff for HSPS
my $SHORT_HSPS_MIN_EVALUE = "1e-11";

################
# Trap Signals #
################
$SIG{'INT'}  = \&SigCleanup;
$SIG{'TERM'} = \&SigCleanup;
$SIG{'HUP'}  = \&SigCleanup;
$SIG{'QUIT'} = \&SigCleanup;
$SIG{'PIPE'} = \&SigCleanup;
$SIG{'ALRM'} = \&SigCleanup;

###############################
#   M A I N   P R O G R A M   #
###############################

my $LOG_F = new IO::File ">$LOG_FILE" if $ISLOGFILE;

#----------HEADER PRINTED OUT----------------------------------------------------------
my $header = "\n".
             "######################################################################\n".
             "MFANNOT, ORGANELLAR GENOME ANNOTATION PROGRAM                         \n".
             "\n".
	         "MFANNOT   $MFANNOT_COMMIT_DATE                                         \n".
             "MFANNOT:  version $VERSION                                             \n".
             "MFANNOT:  $COMMIT                                                      \n".
             "PirModel: $PIR_COMMIT                                                  \n".
             "\n".
             "Programmed by N. Beck and P. Rioux                                    \n".
             "######################################################################\n\n";

print $header;
print $LOG_F "$header" if $ISLOGFILE;
my $add_text_in_header = "";

# OPTIONS OF THE PROGRAM #
my $options ="----------------------------------\n".
             "        General Options           \n".
             "----------------------------------\n";
$options   .= "Masterfile used : $MASTERFILE\n";
$options   .= "New Masterfile created : $OUTPUTFILE\n";
$options   .= "Genetic code : $GENCODE\n";
$options   .= "Logfile : $LOG_FILE\n" if $ISLOGFILE;
$options   .= "Usage of RNAweasel\n";
$options   .= "The Path of configfile is : $EXTCONFIGFILE\n";
$options   .= "The Path of pattern file is : $MOTFILE\n";
$options   .= "Look in the peptide library $PEPLIBRARIES\n";

print $LOG_F "$options" if $ISLOGFILE;           # Print options in the logfile
print $options          if $DEBUG;               # Print the options on the screen

# CREATE THE TMPDIR #
my $EGC_FILE = "$ENV{'EGC'}/EGC.$GENCODE";
die "No EGC file (with ncbi genetic code) was found for your genetic code '$GENCODE'\n"
  if (!(-f $EGC_FILE));
$TMPDIR = "/tmp/mfannot.$$" if !$TMPDIR;
if (! -d $TMPDIR) {
  mkdir($TMPDIR,0700) or die "Error: can't create working directory '$TMPDIR': $!\n";
}

# Initialization of $CODON_TABLE (Hashtable with genetic code)
my $BIOCODONTABLE   = Bio::Tools::CodonTable->new( -id => $GENCODE);
die "Genetic id does not exist\n" if   (not $BIOCODONTABLE->id($GENCODE));
my ($CODON_TABLE,$DEVIATION,$START_CODONS) = &CacheCodonTableWithGeneticId ($BIOCODONTABLE); # Hashtable with genetic code

my $ALTERNATIVE_ACCEPTED_START = {};
# Foreach key in $START_CODON fill $ALTERNATIVE_ACCEPTED_START
# with the alternative accepted start codon and the associated aa
foreach my $start_codon (keys %$START_CODONS) {
    my $aa = $CODON_TABLE->{$start_codon};
    $ALTERNATIVE_ACCEPTED_START->{$start_codon} = [$aa];
}

# Define all aa accepted as start codon based on list of alternative accepted
# and the standard genetic code
my $AA_ACCEPTED_START = {};
$AA_ACCEPTED_START = &GetAaAcceptedStartCodon($ALTERNATIVE_ACCEPTED_START, $CODON_TABLE);

# LIB CREATION #
die "'$PEPLIBRARIES' isn't a directory\n"
    if (not -d $PEPLIBRARIES);
my $LIB_FILE                   = "$TMPDIR/library.pep";

my ($MITO_GENE_LIST,$CHLORO_GENE_LIST) = ({},{});
   ($CACHE_PEPLIBRARY,$MITO_GENE_LIST,$CHLORO_GENE_LIST) = &CreatePepfileWithLibrary;
die "Unable to read '$LIB_FILE'\n"
  if (not -r $LIB_FILE);

# List of typiccal gene in order to determine if the genome is a mitochondiral genome or a chloroplastic genome.
my $MITO_GENE_TYP   = ["cox1","cox2","cox3","cob","atp6"];
my $CHLORO_GENE_TYP = ["apcA","apcB","apcD","apcE","apcF","cpcG","petA","petB"];

# ANNOTATION #
# Print option of the annotation
print "----------------------------------\n",
      "         Gene Annotation          \n",
      "----------------------------------\n";
print $LOG_F  "----------------------------------\n",
              "         Gene Annotation          \n",
              "----------------------------------\n" if $ISLOGFILE;

print "File used for motif finding is '$MOTFILE'\n" if $LVL_MOT != 0;

$options  = "Options : \n";                  # Options & parameters used for the blast
$options .= "Minimum size ORF, for flip running $MINLENGTHORF\n";
$options .= "Blast e-value cutoff : $BLASTEVALUECUTOFF\n";
$options .= "Minimum exon size : $MINEXONSIZE\n";
$options .= "Maximum intron size : $MAXLENGTHFORGROUPINGORF\n";
$options .= "Minimum intron size : $MININTRONSIZE\n";
$options .= "Matrix : $MATRIX\n";
$options .= "Minimum length of non corresponding ORFs : $MINLENEMPTYORF\n";
$options .= "Overlapping cutoff for non-corresponding ORFs: $OVERLAPPINGCUTOFF\n";

print $options if $DEBUG;
print $LOG_F $options if $ISLOGFILE;

# - Create a masterfile object
# - Load the annotations
# - Load the sequence of each contig

print "Parsing masterfile $MASTERFILE...\n\n";
my $pirmaster     = PirObject::Masterfile->ObjectFromMasterfile($MASTERFILE,1);
my $contigs       = $pirmaster->get_contigs();
my $numbercontigs = scalar (@$contigs);        # Number of contigs in the masterfile
die "No contig header found in the masterfile '$MASTERFILE'\n" if $numbercontigs == 0;
my $numberannot   = 0;                         # Number of annotations detected in the program

my $CONTIG = {};
&CleanPirmaster() if ($LVL_MOT != 1);
my $NB_PROC   = &DefineNumberOfProcessor();

print "Number of contigs in Masterfile : $numbercontigs\n",
      "Number of annotations (or comments) detected : $numberannot\n" if $DEBUG;

print $LOG_F "Number of contigs in Masterfile : $numbercontigs\n",
            "Number of annotations (or comments) detected : $numberannot\n" if $ISLOGFILE;

# START THE PROCESS #
my $step        = 1;

# Core #
if ($LVL_MOT != 1) {
# Run the programm step by, to know the right step
# Flip running, generate ORFS
print "$step) Translate (flip)...\n";
$step += 1;
&RunFlip;

# Blast the flip result with the blast
print "$step) Blast...\n";
$step += 1;
&BlastFlipVSGene;

# Parse the blast result, create a flipblastprot object
print "$step) Parse Blast Results...\n";
$step += 1;
&ParseInformationFromBlastResult;

# Selection of protein
print "$step) Select best proteins for Exonerate...\n";
$step += 1;
&SelectProteinForExo;

# Create hypothetical proteins
print "$step) Annotate genes w/o introns...\n";
$step += 1;
&FillHYPPROTSArrayWithFLIPBLASTPROTSArray;

# Annotation of all introns
if ($LVL_INTRON == 2 ) {
  print "$step) Intron identification...\n";
  &Annotate_Using_external_programs("IntronII,IntronI");
  $step += 1;
}

# Make the alignement and give the exons
print "$step) Annotate genes with introns...\n";
$step += 1;
&FindExonsInHypProtArray;

# Organise the hypothetical proteins (find the real start)
print "$step) Identify gene fusions...\n";
$step += 1;
&TreatGeneFusion;

# Search mini exons
if (!$PARTIAL) {
    print "$step) Annotate mini exons...\n";
    $step += 1;
    &AnnotateMiniExonsByHMM;
}

# Annotate rRNA -> Use RNAweasel for 5SrRNA and rnpB, Use HMMweasel for rns and rnl
print "$step) Annotate RNA genes...\n";
$step += 1;
&Annotate_Using_external_programs;

&AnnotateMfFromHYPPROTSArray;

# Adjust intronic boundaries with rules for type I and type II
print "$step) Adjust intron boundaries...\n";
$step += 1;
&Adjust_all_intronic_junctions;

print "$step) Identify start codons; identify gene fusions...\n";
$step += 1;
&CommentFusion;

print "$step) Find extra genes with HMM\n";
$step +=1;
$ENDO_BY_CG = &FindLowConservedGenesAndEndoByHMM();

# Process empty orfs, -> annotate empty ORFs in the masterfile (whose who correspond to something good)
if ($ORFPROCESS) {
    print "$step) ORF annotation...\n";
    $step += 1;
    &AnnotateEmptyOrfs;
}

# Process intronical ORF -> annotate intronicale ORF not detected by Blast
print "$step) Intron ORF annotation...\n";
$step += 1;
&AnnotateIntronicOrfs($ENDO_BY_CG);

&MulticommentConfidence;
&LcIntrons;
}

if ($LVL_MOT != 0) {
    print "$step) Process motifs...\n";
    $step += 1;
    &SearchMotAndMakeAP;
}

&ReplaceCgName if $LVL_MOT != 1;
# PROGRAMME ENDING #

print "\n----------------------------------\n",
      "       This is it, Folks !     \n",
      "----------------------------------\n";

# Unreferencing
undef $FLIPBLASTPROTS;
undef $HYPPROTS;
undef $EMPTYORFS;

# Renumber genes with _1, _2 etc correctly this time.
&RenumberFeatures;

# Add informations in the masterfile
&LogInfo;

# Dump it
print "Writing new masterfile in $OUTPUTFILE\n";
$pirmaster->ObjectToMasterfile("$OUTPUTFILE");

&CreateTBLoutput($OUTPUTFILE) if $SQN_FORMAT || $TBL_FORMAT;

if (0) {
print "Writing PirMaster object to $OUTPUTFILE.xml\n";
$pirmaster->ObjectToFile("$OUTPUTFILE.xml");
}

if ($ISLOGFILE == 1) {
    print "close Logfile : $LOG_FILE\n" if $DEBUG;
    $LOG_F->close() or print "Logfile not closed\n";
}

my $filename = basename($OUTPUTFILE);
system("cp $OUTPUTFILE $TMPDIR/$filename");
exit 0;

END {
    # With exit, programme will go here
    # Cleanup temp directory when program exits.
    return unless $$ == $MAINPROGRAM_PID; # We don't want to run this in a CHILD!
    return unless defined($TMPDIR) and $TMPDIR =~ m#^/tmp/#;
    print "Temporary work directory $TMPDIR NOT cleaned up ...\n" if $DEBUG;
    rmtree($TMPDIR) unless $DEBUG;
}

#############################
#   S U B R O U T I N E S   #
#############################

#-------------------------------------------------------------#
# Subs calling at beginning before to run the core of Mfannot #
#-------------------------------------------------------------#
sub GetPath {
    my $name_prog = shift;

    foreach my $dir (@PATH) {
        if (-f "$dir/$name_prog") {
            if (-r _ && -x _) {
                return "$dir/$name_prog";
            }
            else {
                die "   -> ERROR: $name_prog is not readable and executable! Please run:\n",
                    "             chmod 755 \"$dir/ $name_prog\"\n";
            }
        last;
        }
    }
    die "-> ERROR: Could not find '$name_prog' in your search path. Please install\n",
        "   $name_prog from the source (see INSTALL.txt).\n";
}

sub SigCleanup {
     die "\nExiting: received signal \"" . $_[0] . "\".\n";
     # Note that some cleanup will be performed in the END block at this point.
}

sub CreatePepfileWithLibrary {
    my ($library,$pepfile) = ($PEPLIBRARIES,$LIB_FILE);

    opendir (DIR, $library) or die "Cannot open directory '$library': $!\n"; # Open the directory
    my @files = grep((/\.faa$/ and -f "$library/$_"), readdir(DIR));         # Keep the existing *.pep files
    close (DIR);                                                             # Close the directory

    my $outfh = new IO::File ">$pepfile"
        or die "Can't write to library file '$pepfile': $!\n";

    my $desc_to_prot = {}; # Save all proteins
    my ($mito_gene,$chloro_gene) = ({},{});
    # Concatenate all the file from the library
    my $desc = "";
    foreach my $file (@files) {
        my $loc_file = "$library/$file";
        my $name = $file =~ s/\.faa$//r;

        my $PEP_F = new IO::File "<$loc_file" or die "Cannot open the pepfile '$loc_file': $!\n";
        my $to_annot = 0;
        while (my $line = <$PEP_F>) {
            next if $line =~ /^;|^\s*$/;
            if ($line =~ /^>/) {
                die "The library file \"$loc_file\" has incorrect FASTA syntax.\nThe line faulty line is: \n$line"
                if (!($line =~ m/(pt|pt_cyano|mt|mt_alpha)\s+[\S]+\s*;/i));
                my $origin = lc($1);

                $chloro_gene->{$name}++ if $origin =~ m/pt/ || !$to_annot;
                $mito_gene->{$name}++   if $origin =~ m/mt/ || !$to_annot;

                $desc = $line;
                $desc =~ s/^>?\s*//;
                $desc =~ s/\s*$//;
                print $outfh ">$desc\n";
                die "Error in library $library: duplicated FASTA header '$desc'.\n"
                    if exists $desc_to_prot->{$desc};
                next;
            }
            print $outfh $line; # seq line
            $line =~ s/^\s*//;  # cleanup seq line
            $line =~ s/\s*$//;
            $desc_to_prot->{$desc} .= $line;
        }
        $PEP_F->close();
    }
    $outfh->close();
    return ($desc_to_prot,$mito_gene,$chloro_gene); # cache of all proteins in library
} # End sub

sub GetOptions {
    # This function is here to manipulate options
    my $option = new PirObject::Option ();      #  Buil a new option model
    $option->FillOption ();                     #  This one build with the default option and look for a rc file
    # Now The object contains all the options

    # General options
    $DEBUG                   = $option->debug;             # Debug mode. If true, display message on the screen
    $GENCODE                 = $option->genetic;           # Genetique code
    $MASTERFILE              = $option->masterfile;        # Path for Masterfile
    $OUTPUTFILE              = $option->outputfile;        # Path for the new
    $ORFPROCESS              = $option->orf;               # For Orf process, allowing presence or not in the masterfile
    $PEPLIBRARIES            = $option->pepdirectory;      # List of path for peplibrary directory
    $EXTCONFIGFILE           = $option->ext_config;        # Path for configfile
    $MOTFILE                 = $option->motfile;           # Path for pattern file.
    $LVL_MOT                 = $option->lvlmot;            # Indicate level of motif identification.
    die "Option --lvlmot must be 0,1 or 2\n" if $LVL_MOT < 0 || $LVL_MOT > 2;
    $EXTSELECTPROG           = $option->ext_select;        # List of names for external prog
    $LVL_INTRON              = $option->lvlintron;         # Indicate level of intron identification (0,1 or 2).
    die "Option --lvlintron must be 1 or 2\n" if $LVL_INTRON < 1 || $LVL_INTRON > 2;
    $BLASTEVALUECUTOFF       = $option->blast2;            # Cutoff value for the blast
    $MINLENGTHORF            = $option->flip2;             # This is the minimum length for creating an ORF with flip
    $MAXLENGTHFORGROUPINGORF = $option->maxintronsize;     # Minimum size of a gap between 2 ORf. If 2 same ORF
    $MAXLENINTRONS           = $option->maxintronsize;     # Max intron size for exonerate.
    $MINLENEMPTYORF          = $option->minlenemptyorf;    # Minimum length for ORF empty orfs (non corresponding orfs)
    $OVERLAPPINGCUTOFF       = $option->overlappingcutoff; # Overlapping cutoff for ORFs
    $OVERLORFOVORF           = $option->orfOVorf;          # Overlapping cutoff for ORFs
    $OVERLAPORFOVGENE        = $option->orfOVgene;         # Overlapping cutoff for ORFs
    $MININTRONSIZE           = $option->minintronsize;     # Opposite of $MAXLENGTHFORGROUPINGORF. Minimum size for intron
    $MINEXONSIZE             = $option->minexonsize;       # Minimum exon size for intron. In genewise.
    $MATRIX                  = $option->matrix;            # The matrix used in genewise alignement
    $PARTIAL                 = $option->partial;           # This will cause mfannot to only run a subset of all its built-in analysis
    $INSERTION               = $option->insertion;         # Minimum length for report insertion
    $LIGHT                   = $option->light;             # Don't search for endonuclease and don't search all gene by HMM
    $SQN_FORMAT              = $option->sqnformat;         # If true do mf -> sqn conversion
    $TBL_FORMAT              = $option->tblformat;         # If true save tbl file
    $TMPDIR                  = $option->tmpdir;            # Temporary work directory
    $USEPRM                  = $option->prm;               # 1 if user want use .prm

    if($option->islogfile and defined($option->logfile)) {
        if(-w (dirname($option->logfile))) {
            $ISLOGFILE       = $option->islogfile;     #  Just to know if the $LOG_FILE is not empty (0 or 1)
            $LOG_FILE        = $option->logfile;       #  log file : store all the information about run
        }
        else {
            print "\nThe path to your logfile \"" . ($option->logfile). "\" is not writable by you.\n";
            print "No file logging will be performed\n";
            $ISLOGFILE = 0;
            $LOG_FILE  = undef;
        }
    }

    my $count = "";
    my $name  = $OUTPUTFILE;

    # Checking to see if the path to the output file is writable
    die "\nThe path for your outputfile is not writable by you ($name).\nPlease resolve this problem before running again\n"
        if (!-w (dirname($name)));

    # Determing new name of output file if file already exists
    chomp ($name);
    $name =~ s/\d*$//;
    while (-r ("$name"."$count")) {
        if ($count eq "") {$count = 1;}
        else              {$count++;}
    }
    $OUTPUTFILE = "$name"."$count";
} # End sub

sub CacheCodonTableWithGeneticId {
    # This function create a file
    # Having a codon table.
    # ATT F....
    # ATG M...
    # Comment will begin with "!"
    my $codontable = shift;   # The bio::tools::codontable

    # Parse "prot.prm" present in the current directory to take into account the deviation of the genetic code
    my $initial_dir   = getcwd;
    my ($tri_nt_to_change,$dev_line,$start_codons) = ({},"",{});
    my $protprmFile   = "$initial_dir/prot.prm";

    # Read `prm` file to set $tri_nt_to_change
    if (-f $protprmFile && $USEPRM == 1) {
        system("cp $protprmFile $TMPDIR");
        my $infh  = new IO::File "<$protprmFile"
             or die "Can't read from file '$protprmFile': $!\n";
        # Read prm file to define deviation codon
        while( <$infh> ){
            my $line = $_;
            next if $line !~ m/^Deviation\s*=/;
            $dev_line = $line;
            $dev_line =~ s/^Deviation\s*=\s*//;
            $dev_line =~ s/\s+$//;
            my @correspondence = split(/,/,$dev_line);
            foreach my $cor (@correspondence) {
                my @tab = split(/=/,$cor);
                $tri_nt_to_change->{uc($tab[0])} = uc($tab[1]);
            }
        }
        $infh->close();
    }

    $start_codons = &read_and_change_EGC_file($tri_nt_to_change);

    # Cache codon table
    my $ct_cache = {};
    my @letter = qw (A T C G N);
    my $i      = 0;
    my $j      = 0;
    my $z      = 0;

    while ($i < scalar(@letter)) {
        $j = 0;
        while ($j < scalar(@letter)) {
            $z = 0;
            while ($z < scalar(@letter)) {
                my $codon = $letter[$i].$letter[$j].$letter[$z];
                my $aa    = $codontable->translate($codon);
                $ct_cache->{$codon} = $aa;
                $ct_cache->{$codon} = $tri_nt_to_change->{$codon} if $tri_nt_to_change->{$codon};
                $z++;
            }
            $j++;
        }
        $i++;
    }

    return ($ct_cache,$dev_line,$start_codons);
} # End sub CacheCodonTableWithGeneticId

sub read_and_change_EGC_file {
    my $tri_nt_to_change = shift;

    # Read EGC File
    my $infh  = new IO::File "<$EGC_FILE"
        or die "Can't read from file '$EGC_FILE': $!\n";

    my $outfh = new IO::File ">$TMPDIR/EGC.$GENCODE"
        or die "Can't write to $TMPDIR file '$TMPDIR/EGC.$GENCODE': $!\n";

    my $isHeader = 1;
    my ($AAs,$Starts,$Base1,$Base2,$Base3)    = ([],[].[],[],[]);
    my ($Starts_l,$Base1_l,$Base2_l,$Base3_l) = ("","","","");
    while ( my $line = <$infh> ) {
        $isHeader = 0 if ($line =~ m/^AAs  =/);
        # If line is before AAs line
        if ($isHeader) {
          print $outfh $line;
        # Otherwise
        } else {
            $line              =~ s/\n$//;
            my @this_line      = split(/\s*=\s*/,$line);
            my $info_for_array = $this_line[-1];
            next if !$info_for_array;
            my @this_array     = split(//,$info_for_array);

            if ($line =~ m/^AAs/) {
                $AAs = \@this_array;
            }
            elsif ($line =~ m/^Starts/) {
                $Starts   = \@this_array;
                $Starts_l = $line;
            }
            elsif ($line =~ m/^Base1/) {
                $Base1   = \@this_array;
                $Base1_l = $line;
            }
            elsif ($line =~ m/^Base2/) {
                $Base2 = \@this_array;
                $Base2_l = $line;
            }
            elsif ($line =~ m/^Base3/) {
                $Base3 = \@this_array;
                $Base3_l = $line;
            }
        }
    }
    $infh->close();

    my $tri_nt_list = [];
    for (my $i = 0; $i < @$AAs; $i++) {
        my $AA     = $AAs->[$i];
        my $start  = $Starts->[$i];
        my $tri_nt = $Base1->[$i].$Base2->[$i].$Base3->[$i];

        push(@$tri_nt_list,[$AA, $start, $tri_nt]);
    }

    my $new_AAs      = "";
    my $start_codons = {};
    foreach my $info (@$tri_nt_list) {
        my ($AA,$start,$tri_nt) = ($info->[0],$info->[1],$info->[2]);

        $start_codons->{$tri_nt} = 1  if $start eq "M";
        $new_AAs .= $tri_nt_to_change->{$tri_nt} ? $tri_nt_to_change->{$tri_nt} : $AA;
    }

    print $outfh "\nAAs  =   $new_AAs\n";
    print $outfh "$Starts_l\n";
    print $outfh "$Base1_l\n";
    print $outfh "$Base2_l\n";
    print $outfh "$Base3_l\n";
    $outfh->close();

    return $start_codons;
}

sub CleanPirmaster {
     my $AP_to_rm = [];

     # Check each annot push all annot to remove on $AP_to_rm, changed the other one
     my $isUnique = {};
     my $count    = 0;
     foreach my $contig (@$contigs) {
         my $annotations = $contig->get_annotations();
         my $contigname  = $contig->get_name();
         my $comments    = $contig->get_namecomments() || "";
         my $header      = $contigname.$comments;
         $isUnique->{$header}++;
         die "Two contigs have same header '$header'\n" if $isUnique->{$header} > 1;
         $count++;
         $CONTIG->{"contig$count"} = "$header";
         $contig->set_namecomments("");
         $contig->set_name("contig$count");
         my $seq = $contig->get_sequence();
            $seq =~ s/\!//g;
            $seq = $seq;
         $contig->set_sequence($seq);
         foreach my $AP (@$annotations) {
             my $type      = $AP->get_type();
             my $startline = $AP->get_startline() || "";
             my $endline   = $AP->get_endline()   || "";
             my ($new_startline,$new_endline) = ("","");
             my $id_AP     = $1 if scalar($AP) =~ m/0x(.+)\)/;
             # push (@$AP_to_rm, $id_AP) if $startline =~ m/;;\s+mfannot:/;
             next if ($type eq "C");
             $AP->set_type("C");

             if ($endline ne "" && $startline ne "") {
                 $new_startline = $2 if $startline =~ m/(.+)\s*(;;.+)$/ && $2 !~ m/mfannot:/;
                 $AP->set_startline($new_startline);
                 $AP->set_startpos() if $new_startline eq "";
                 $new_endline   = $2 if $endline =~ m/(.+)\s*(;;.+)$/   && $2 !~ m/mfannot:/;
                 $AP->set_endline($new_endline) ;
                 $AP->set_endpos() if $new_endline eq "";
                 push (@$AP_to_rm, $id_AP) if $new_endline eq "" && $new_startline eq "";
                 next;
             }
             elsif ($endline eq "") {
                 $new_startline = ";$startline ;; mfannot: no end found";
                 $AP->set_startline($new_startline);
                 next;
             }
             else {
                 $new_endline = ";$endline ;; mfannot: no start found";
                 $AP->set_endline($new_endline);
                 next;
             }
         }
         &Remove_AP($AP_to_rm,$contig);
     }
     $pirmaster->ObjectToMasterfile("$TMPDIR/Masterfile_copy");
}

sub Remove_AP {
    my ($AP_to_rm,$contig) = @_;

    my $all_annots = $contig->get_annotations();
    for (my $i = @$all_annots - 1; $i >= 0 ; $i--) {
        my $contig_AP    = @$all_annots[$i];
        my $id_contig_AP = $1 if  scalar($contig_AP) =~ m/0x(.+)\)/;
        foreach my $id_rm_AP (@$AP_to_rm) {
            splice(@$all_annots, $i, 1) if $id_rm_AP eq $id_contig_AP;
        }
    }
}

sub CreateCgFile {
    my $cg = shift;

    my $dir = "$TMPDIR/CgFiles";
    mkdir($dir) if !(-d $dir);

    my $cg_name = $cg->get_name();
    my $cg_seq  = $cg->get_sequence();
    my $cg_file = "$dir/$cg_name";

    my $cg_Fh = new IO::File ">$cg_file"
        or die "Can't write to file '$cg_file': $!\n";
    $cg_seq =~ s/\s+$/\n/;
    print $cg_Fh ">$cg_name\n$cg_seq\n";
    $cg_Fh->close();
}

sub DefineNumberOfProcessor {
    my $nb_proc = "$TMPDIR/nb_proc";
    system("grep processor /proc/cpuinfo > $nb_proc");
    my $count_proc = 0;
    my $infh = new IO::File "<$nb_proc"
        or die "Can't read from file '$nb_proc': $!\n";
    while (my $line = <$infh>) {
        next if $line !~ m/^processor\s*:\s*\d+$/;
        $count_proc++;
    }
    return $count_proc;
}


#-----------------------------------#
# Subs forming the core of Mfannot  #
#-----------------------------------#

#------------------------#
# Subs for running flip  #
#------------------------#

sub RunFlip {
    # This function run flip with the masterfile
    # Flip is a program generating ORF
    my $cwd  = cwd();  # Get current working directory name
    chdir ("$TMPDIR"); # Need to change the temporary directory to run flip

    # Just check if Flip outfiles exist here already, if so get rid of them
    unlink("prot.lst") if (-e "prot.lst");
    unlink("prot.src") if (-e "prot.src");
    unlink("compl")    if (-e "compl");
    unlink("uncompl")  if (-e "uncompl");

    # Checking the see if the masterfile path is aboslute or relative
    my $tmpMasterfile = "$TMPDIR/Masterfile_copy";

    # Need to remove CR from masterfile, so let's make a local copy
    print "Making local copy of masterfile with no CRs.\n" if $DEBUG;
    my $ifh = new IO::File "<$tmpMasterfile"
        or die "Cannot read from masterfile '$tmpMasterfile': $!\n";
    my $ofh = new IO::File ">mf_noCr.all"
        or die "Cannot write to temp file 'mf_noCr.all': $!\n";  # in TMPDIR
    while (my $line = <$ifh>) {
        $line =~ s/\s+$/\n/;
        print $ofh $line;
    }
    $ofh->close();
    $ifh->close();

    my $to_add  = $DEVIATION ne "" ?  "-d '$DEVIATION'" : "";
    my $cmdflip = "$FLIPPATH $to_add -m -l $MINLENGTHORF -g $GENCODE mf_noCr.all > $TMPDIR/flip.output";
    # -m With this switch, flip will translate the first codon of a protein by 'M' if the codon is a start codon

    system("$cmdflip >/dev/null 2>/dev/null");
    print "$cmdflip\n" if $DEBUG;
    chdir($cwd); # Changing back to the original directory
} # End sub

#--------------------------#
# Subs for running Blast   #
#--------------------------#
sub BlastFlipVSGene {
    # It runs blast with the flip results against file containing genes
    $BLASTOUTPUT     = $TMPDIR . "/blastoutput.xml";
    my $file         = $LIB_FILE;                                # Undef should never happen in fact.
    my $escaped_file = $file;
       $escaped_file =~ s#'#'\\'#g;
    my $command      = "$MAKEBLASTDBPATH -in $escaped_file -dbtype prot -out $TMPDIR/mf >/dev/null 2>/dev/null";

    print "$command\n" if $DEBUG;
    system($command);

    # RUN FOR BLAST : run blast with the db created and the flip results
    my $cmdblast     = "nice -19 $BLASTPATH -outfmt 5 -matrix $MATRIX -db $TMPDIR/mf -query $TMPDIR/prot.lst -out $BLASTOUTPUT 2> $TMPDIR/blasterr_1.txt";
    print "$cmdblast\n" if $DEBUG;
    system ($cmdblast);
} # End sub


#--------------------------------------------------#
# Subs for parsing information from Blast results  #
#--------------------------------------------------#

sub ParseInformationFromBlastResult {
    my $type        = 'PROT';
    my $file        = $LIB_FILE;
    my $blastoutput = $BLASTOUTPUT;

    die "Error: can't find $type report from blastall ?!?\n"
        if (! -r $blastoutput); # It's supposed to be here at this point

    my $searchfh = new IO::File "<$blastoutput"
        or die "Can't read from '$blastoutput': $!\n";

    while (my $result = PirObject::BlastOutput->FileHandleToObject($searchfh)) {
        my $iterations = $result->BlastOutput_iterations() || next;
        foreach my $iteration (@$iterations) {
            &FillFLIPBLASTPROTArrayFromBlastResult($type,$result,$iteration);
        }
    }
    $searchfh->close();

    foreach my $flipblastprot (@$FLIPBLASTPROTS) {
        my $homologous = $flipblastprot->homologous();
        my @sorted = sort {
            &CompareHighPrecisionFloats($a->get_evalue(),$b->get_evalue());
        } @$homologous;
        my $length = scalar(@sorted);
           $length = ($length < 10 ? $length : 10 );

        my %already_here    = ();
        my @best_homologous = ();
        foreach my $similar (@sorted) {
            next if scalar(@best_homologous) >= $length;
            my $ident = $similar->get_similarprot();
            push(@best_homologous,$similar) unless ($already_here{$ident}++);
        }
        $flipblastprot->set_homologous( \ @best_homologous );
    }
} # End sub

sub CompareHighPrecisionFloats {
    # Only for floats that are in NORMALIZED scientific form.
    # Examples of different cases :
    #
    #    1       1.      1.2
    #    1.2e    1.2e3   1.2e-3
    #    e-3     1e3
    #
    # Each of these can optionally be prefixed with "+" or "-".
    #
    # Unlike Math::BigFloat, this routine handles "e-3".

    my ($x,$y) = @_;

    die "Unparsable number '$x'\n"
        unless $x =~ m/^([\+\-]?)             # sign
                        ([\d\.]*)             # significand
                        (?:e(-?\d*))?         # exponent
                       $/x;
    my ($xsig,$xman,$xexp) = ($1,$2,$3);

    die "Unparsable number '$y'\n"
        unless $y =~ m/^([\+\-]?)             # sign
                        ([\d\.]*)             # significand
                        (?:e(-?\d*))?         # exponent
                       $/x;
    my ($ysig,$yman,$yexp) = ($1,$2,$3);

    # Define missing optional components of number representation
    $xsig ||= "+";
    $ysig ||= "+";
    $xman = 1 if !defined($xman) || $xman eq "";
    $yman = 1 if !defined($yman) || $yman eq "";
    $xexp = 0 if !defined($xexp) || $xexp eq "";
    $yexp = 0 if !defined($yexp) || $yexp eq "";

    # Compare numbers when $x or $y are effectively zero
    return 0
        if $xman == 0 && $yman == 0;  # $x == 0 and $y == 0
    return ($xsig eq '-' ? -1 : +1)
        if $xman != 0 && $yman == 0;  # $x != 0 and $y == 0
    return ($ysig eq '-' ? +1 : -1)
        if $xman == 0 && $yman != 0;  # $x == 0 and $y != 0

    # Easy comparisons when signs differ
    if ($xsig ne $ysig) {
        return $xsig eq '+' ? 1 : -1;
    }

    # Permutate X <=> Y if both signs are negative
    ($xman,$xexp,$yman,$yexp) = ($yman,$yexp,$xman,$xexp)
        if $xsig eq '-'; # $ysig is '-' too at this point.

    # At this point, $x and $y both have mantissas > 0
    return ($xexp <=> $yexp) if $xexp != $yexp;  # $x and $y have different EXP, so compare EXP
    return ($xman <=> $yman);                    # $x and $y have same EXP, so compare mantissas
}

sub FillFLIPBLASTPROTArrayFromBlastResult {
    my $type      = shift; # 'DNA' or 'PROT'
    my $result    = shift; # An object implementing PirObject::BlastOutput
    my $iteration = shift; # An object implementing PirObject::BlastOutput::Iteration

    return if (!$result);

    my $rdesc = $iteration->Iteration_query_def() ||   # priority to iteration's value
                $result->BlastOutput_query_def()  ||
                "Unknown Query Description";
    $rdesc =~ m/^\s*(\S+)/;
    my $contigname = $1 || "Unknown contig name";
    $contigname =~ s/;$//; # spurious semicolon introduced by flip

    my ($strand, $start, $end) = ($rdesc =~ /(orig|compl).\s+(\d+)\s+to\s+(\d+)/);
    $strand   = ($strand eq 'orig' ? 1 : -1);

    my $hitslist = $iteration->Iteration_hits() || return;
    # If we have no match.
    if (!@$hitslist){
        my $newemptyorf = new PirObject::EmptyOrf (
                                                   start      => $start,
                                                   end        => $end,
                                                   strand     => $strand,
                                                   evalue     => 9999,
                                                   contigname => $contigname,
                                                  );
        push (@$EMPTYORFS, $newemptyorf);          # Put into the array, to be processed after
        return;
    }

    return if @$hitslist < 1; # normally, only one.
    # Note: the significance() method is defined in Hit.pir
    my @hits = sort { &CompareHighPrecisionFloats($a->significance(), $b->significance() ) } @$hitslist;

    # We have an hypothetical protein and we want to know if it'real
    # Quit the function if evalue is too weak #
    # Note: CompareHighPrecisionFloats(a,b) returns: 1 if a > b, -1 if a < b, 0 if a == b
    my $hit   = $hits[0];
    my @hsps         = @{$hit->Hit_hsps()};
    if (&CompareHighPrecisionFloats($hit->significance(),$BLASTEVALUECUTOFF) == 1
    || $hsps[0]->frac_identical() < 0.5 && &CompareHighPrecisionFloats($hit->significance(),$SHORT_HSPS_MIN_EVALUE) == 1) {
        # If the e-value is not enough for these ORF you can create an Empty ORF
        my $newemptyorf = new PirObject::EmptyOrf (
                                                   start      => $start,
                                                   end        => $end,
                                                   strand     => $strand,
                                                   evalue     => $hit->significance(),
                                                   contigname => $contigname,
                                                  );
        push (@$EMPTYORFS, $newemptyorf);          # Put into the array, to be processed after
        return;                                    # Exit the function, because there is no significant ORF
    }

    # Now we have the start, we have the end, the strand and we would like to know if more than one hit is allowed
    my @overlapping;
    my $homo_hash = {};
    for (my $i = 0 ;; $i++) {
        my $hit         = $hits[$i] || last;
        my $fullheader  = $hit->Hit_def();
        my ($origine,$name) = (lc($1),$2) if $fullheader =~ m/(pt|pt_cyano|mt|mt_alpha)\s*([\S]*)\s*;/i;
        next if (not (defined ($name)) or $name eq "");
        my $evalue      = $hit->significance();
        last if &CompareHighPrecisionFloats($evalue,$BLASTEVALUECUTOFF) == 1; # $eva > $BL
        my $prot        = &TakeProteinFromPepfile ($fullheader, $LIB_FILE);

        my $homo_tab = $homo_hash->{$name} || ();
        my $newhomologous = new PirObject::Homologous ( similarprot      => $prot,
                                                        evalue           => $evalue,
                                                        origine          => $origine);
        push(@$homo_tab, $newhomologous) unless $homo_tab && scalar(@$homo_tab) >= 10;  # hash ref
        $homo_hash->{$name} = $homo_tab;
    }

    # Now we have the start, we have the end, the strand and we would like to know if more than one hit is allowed
    my $hypfusiongene = 0;
    HIT : foreach my $hit (@hits) {
        my $fullheader   = $hit->Hit_def();  # Get the description of the query sequence
        my ($origine,$hypprotein)   = (lc($1),$2) if $fullheader =~  m/(pt|pt_cyano|mt|mt_alpha)\s*([\S]*)\s*;/i; # prot name is before the semicolon
        next if (not (defined ($hypprotein)) or $hypprotein eq "");
        my $evalue       = $hit->significance(); # Get the e-value
        my @hsps         = @{$hit->Hit_hsps()};  # High Scoring pairs

        last if (scalar(@hsps) == 0); # An ORF that has a good evalue but no HSP => impossible but ...
        last if &CompareHighPrecisionFloats($evalue,$BLASTEVALUECUTOFF) == 1; # ev > $BL
        last if $hsps[0]->frac_identical() < 0.5 && &CompareHighPrecisionFloats($evalue,$SHORT_HSPS_MIN_EVALUE) == 1;

        my $prot = &TakeProteinFromPepfile ($fullheader, $LIB_FILE);   # Take the protein corresponding to the hit

        #------- Calculate a sort of frame to see what's the region covered by this ORF
        #  Story : You can have, for some case, more than one protein per gene.
        #  It's a sort of fusion protein.
        #  Each of both have a functional part
        #-----------------------------------------------------------------------------#
        # To make distinction between a protein fusion and a protein annotated as twice
        # We have to check the High Scoring Pair frame. If there is no overllapping between
        # HSP frames, it means you have many proteins on the same frame
        # If there is, it's probably because many similar proteins corresponds to the same gene

        my $frame      = {};
        my ($framestart,$frameend) = ($hsps[0]->start,$hsps[0]->end);

        # We don't need to check for strand because HSP are sorted as if there were on the right strand
        foreach my $hsp (@hsps) {
            next if &CompareHighPrecisionFloats($hsp->significance,$BLASTEVALUECUTOFF) == 1; # si > BL
            $framestart     = $hsp->start if ($hsp->start < $framestart);
            $frameend       = $hsp->end   if ($hsp->end   > $frameend);
        }

        $frame -> {"start"} = $framestart;
        $frame -> {"end"}   = $frameend;

        my $isoverlapping = 0; # Indiquate if wheter or not, accept the hit as annotation of the ORF
        CURRENTFRAME : foreach my $currentframe (@overlapping) {
            # For each strand there is 4 cases when frame are overlapping

            # 1)     |----------------|             first frame
            #               |-----------------|     second frame

            # 2)            |----------------|      first frame
            #        |-----------------|            second frame

            # 3)          |---------|               first frame
            #        |-----------------|            second frame

            # 4)    |-----------------|             first frame
            #         |---------|                   second frame

            #       Case were we are on the right strand
            $isoverlapping = 1 if (($currentframe->{"start"} <=  $frame -> {"start"}) and ($currentframe->{"end"} >=  $frame -> {"start"}));
            $isoverlapping = 1 if (($frame -> {"start"} <=  $currentframe->{"start"}) and ($frame -> {"end"} >=  $currentframe->{"start"}));
            $isoverlapping = 1 if (($frame -> {"start"} <=  $currentframe->{"start"}) and ($currentframe -> {"end"} <=  $frame->{"end"}));
            $isoverlapping = 1 if (($currentframe -> {"start"} <=  $frame->{"start"}) and ($frame -> {"end"} <=  $currentframe->{"end"}));

            last CURRENTFRAME  if $isoverlapping == 1; # Go out of the loop if there is a overlapping frame
        }
        next HIT if ($isoverlapping == 1); # If there is an overlapping, the HIT isn't good for annotation
        push (@overlapping, $frame);

        my $neworf = new PirObject::Orf (start      => $start,
                                         startBlast => [],
                                         end        => $end,
                                         strand     => $strand,
                                         evalue     => $evalue,
                                         protein    => $prot,    # Assign the protein to the ORF
                                         hsps       => []);

        my @start_b;
        my $refhsparray = $neworf->hsps;           # An array reference,
        foreach my $hsp (@hsps) {
            next if &CompareHighPrecisionFloats($hsp->significance,$BLASTEVALUECUTOFF) == 1; # si > BL
            my $newhsp = new PirObject::Hsp_query_sbjct (
                                                         start_q  => $hsp->Hsp_query_from(),
                                                         end_q    => $hsp->Hsp_query_to(),
                                                         start_s  => $hsp->Hsp_hit_from(),
                                                         end_s    => $hsp->Hsp_hit_to(),
                                                         strand   => 0,
                                                        );
            push (@$refhsparray, $newhsp);

            if ($hsp->Hsp_query_from() > $hsp->Hsp_hit_from()) {
                my $start_cor = $start + ( ($hsp->Hsp_query_from() *3) - ($hsp->Hsp_hit_from() *3) ) if $strand == 1;
                   $start_cor = $start - ( ($hsp->Hsp_query_from() *3) - ($hsp->Hsp_hit_from() *3) ) if $strand != 1;
                push (@start_b, $start_cor);
            }
        }

        my $newstartblast = $neworf->startBlast;
        my $start_bl      = ($strand == 1 ? min(@start_b) : max(@start_b));
        push (@$newstartblast, $start_bl);

        my $newflipblastprot = &GetFlipBlastProtByNameAndContigName($hypprotein, $contigname);

        # If we can't find it, create it once, and push it on @$FLIPBLASTPROTS
        if (! defined ($newflipblastprot)) {
            $newflipblastprot = new PirObject::FlipBlastProt (   name           => $hypprotein, # First we create the flipblast prot
                                                                 contigname     => $contigname,
                                                                 origine        => $origine,
                                                                 orfs           => [],
                                                                 homologous     => []);
            if ($hypfusiongene != 0) {
                my $index = &FindIndexOfGeneFusion($start,$end,$FLIPBLASTPROTS);
                @$FLIPBLASTPROTS[$index]->set_hypfusiongene($hypprotein);
                $newflipblastprot->set_hypfusiongene(@$FLIPBLASTPROTS[$index]->get_name());
            }
            push (@$FLIPBLASTPROTS, $newflipblastprot);
        }
        $hypfusiongene++;

        my $ref_orf_array        = $newflipblastprot->get_orfs();
        my $ref_homologous_array = $newflipblastprot->get_homologous();
        push (@$ref_orf_array, $neworf);    #    And we just add a new orf
        my $homo = $homo_hash->{$hypprotein};
        push (@$ref_homologous_array, @$homo);
    } # End foreach $hit
} # End sub

sub TakeProteinFromPepfile {
    # This function takes a protein from the blast result with a descritpion line
    # A kind of pareser of fasta file
    my $description = shift;
    my $pepfile     = shift; # not used anymore

    $description =~ s/^>?\s*//;
    $description =~ s/\s*$//;

    # Certain XML entitites are produced by blastall's XML output,
    # but not handled by PirObject XML parser. Replace them here.
    $description =~ s/&apos;/'/g;
    $description =~ s/&quot;/"/g;

    my $protein     = $CACHE_PEPLIBRARY->{$description}
       || die "Internal error: can't find library protein with description '$description'.\n";

    return ">$description\n" . $protein;
} # End sub

sub GetFlipBlastProtByNameAndContigName {
    # This function gives a FlipBlastProt with his name and contig name
    my $name       = shift;  #    This the name of the GetFlipBlastProt
    my $contigname = shift;  #    This is the contigname of the FlipBlastProt

    foreach my $result (@$FLIPBLASTPROTS) {
         return $result if ($result->name eq $name and $result->contigname eq $contigname);
    }
    return undef; # In the case where any object has been found
} # End sub

sub FindIndexOfGeneFusion {
    my $start_orf        = shift;
    my $end_orf          = shift;
    my $all_prev_hypprot = shift;

    my $index = 0;
    foreach my $prot (@$all_prev_hypprot) {
        my $orfs  = $prot->get_orfs();
        foreach my $orf (@$orfs){
            my $start = $orf->get_start();
            my $end   = $orf->get_end();
            return $index if $start == $start_orf && $end == $end_orf;
        }
        $index++;
    }
}

#-----------------------------------------------------------#
#                                                           #
# Subs for selecting hypotetical protein for identification #
# of protein with exon/intron (In order to run Exonerate)   #
#                                                           #
# If we have:                                               #
#  - matches on 2 different strand, we take the             #
# store information in order to run Exonerate               #
#  - matches on the same strand:                            #
#     - If we have 2 match with a distance > 142, store     #
#      information in order to run Exonerate                #
#     - Else indicate a potential frameshift                #
#                                                           #
# Finally remove protein from @$FLIPBLASTPROTS if we have   #
# no information for run Exonerate                          #
#                                                           #
#-----------------------------------------------------------#

sub SelectProteinForExo {
    # This function is create in order to select the protein for run Exonerate or not
    my $compt = 0;
    my @index;
    foreach my $flipblastprot (@$FLIPBLASTPROTS) {
        my $name           = $flipblastprot->get_name();
        my $contigname     = $flipblastprot->get_contigname();
        my $orfs           = $flipblastprot->get_orfs();
        my $homologous     = $flipblastprot->get_homologous();
        my $genefusionname = $flipblastprot->get_hypfusiongene();
        my $origine        = $flipblastprot->get_origine();
        my $number_orfs    = scalar (@$orfs);
        my %strand;  # Hashtable with the number of each strand for one flipblastprot

        next if ($number_orfs < 1); # Impossible but ..........

        if ($number_orfs > 1) {
            my @prot_score; # Tab for score of blast and protein
            foreach my $orf(@$orfs) {
                $orf->strand == 1 ? $strand{1}++ : $strand{-1}++;
                my $info_prot_score = [$orf->evalue(), $orf->protein()];
                push (@prot_score, $info_prot_score);
            }

            @prot_score = sort { $a->[0] <=> $b->[0] } @prot_score; # Sort @protein_score by score
            my $prot = $prot_score[0]->[1];                         # Protein who have bigger score

            if ($strand{1} && $strand{-1}) {
                my $info = [$name, $contigname, $prot, 2, $homologous, $genefusionname, $origine];
                push(@PROT_FOR_EXONERATE, $info);
                push(@index, $compt);
            }
            elsif ($strand{1} || $strand{-1}) {
                my @start_end_orf;
                my $strand = 1 if $strand{1};
                   $strand = -1 if $strand{-1};
                foreach my $orf(@$orfs){
                    my (@start_hsp,@end_hsp) = ((),());
                    my $hsps          = $orf->get_hsps();
                    my $evalue        = $orf->get_evalue();
                    my $orf_start_end = [$orf->start,$orf->end];

                    foreach my $hsp(@$hsps){
                        push (@start_hsp, $hsp->start_q);
                        push (@end_hsp, $hsp->end_q);
                    }

                    my ($min_start_hsp,$max_end_hsp)  = (min(@start_hsp),max(@end_hsp)); # Give the lower start and the bigger end of hsp
                    my $cor_start = $orf->start + (3 * $min_start_hsp) if $strand ==  1; # The really start of orf if strand +
                       $cor_start = $orf->start - (3 * $min_start_hsp) if $strand == -1; # The really start of orf if strand -
                    my $cor_end   = $orf->start + (3 * $max_end_hsp)   if $strand ==  1; # The really end of orf if strand +
                       $cor_end   = $orf->start - (3 * $max_end_hsp)   if $strand == -1; # The really end of orf if strand -
                    my $pair_start_end = [ $cor_start, $cor_end, $evalue ];
                    push (@start_end_orf, [$pair_start_end, $orf_start_end]);
                }

                @start_end_orf  = sort { $a->[0]->[0] <=> $b->[0]->[0] } @start_end_orf if $strand ==  1; # Sort @start_end_orf by start for strand +
                @start_end_orf  = sort { $b->[0]->[0] <=> $a->[0]->[0] } @start_end_orf if $strand == -1; # Sort @start_end_orf by start for strand -

                for (my $i=0; $i < @start_end_orf - 1; $i++) {
                    my $current_cor_start_end = $start_end_orf[$i]->[0];
                    my $next_cor_start_end    = $start_end_orf[$i+1]->[0];
                    my $diff                  = abs($current_cor_start_end->[1]-$next_cor_start_end->[0]);
                    if ( 142 <= $diff ) {
                        # if distance between 2 orf who have match with one protein is higher than 142 nt => Run exonerate
                        my $info = [$name,
                                    $contigname,
                                    $prot,
                                    $strand,
                                    $homologous,
                                    $genefusionname,
                                    $origine,
                                    [$start_end_orf[$i], $start_end_orf[$i+1]]
                        ];
                        push(@PROT_FOR_EXONERATE, $info);
                        push(@index, $compt);
                    }
                    else {
                       $flipblastprot->set_frameshift(1);
                       print "   Potential frameshift in $name\n";
                    }
                } # End for $i
            } # End elsif
        } # End if
        $compt++;
    } # End foreach $flipblastprot

    # In order to run exonerate only one time foreach protein
    my %index_deja_vu = ();
    my @index_uni;
    foreach my $index (@index) {
        push(@index_uni,$index) unless $index_deja_vu{$index}++;
    }

     my %prot_deja_vu = ();
     my @prot_uni;
     foreach my $prot (@PROT_FOR_EXONERATE) {
         my $ident = $prot->[1] . "-" . $prot->[2];
         push(@prot_uni,$prot) unless ($prot_deja_vu{$ident}++);
     }

     @PROT_FOR_EXONERATE = @prot_uni;
     @index_uni = sort {$b <=> $a} @index_uni;

     # In order to remove the protein of flipblastprot when we run Exonerate
     for (my $i=0; $i < @index_uni; $i++) {
         splice(@$FLIPBLASTPROTS,$index_uni[$i],1);
     }
} # End sub

#------------------------------------#
# Subs for identifying similar ORFs  #
#------------------------------------#

#-----------------------------------------------------------#
# This function fill the HYPPROTS array (array of           #
# hypothetical proteins with FLIPBLASTPROTS array           #
# (array of ORF and hsp)                                    #
#-----------------------------------------------------------#

sub FillHYPPROTSArrayWithFLIPBLASTPROTSArray {

    # This is mainly the algorithm given by Franz
    foreach my $flipblastprot (@$FLIPBLASTPROTS) {        # For each flip blast protein
        my $name           = $flipblastprot->get_name();
        my $contigname     = $flipblastprot->get_contigname();
        my $orfs           = $flipblastprot->get_orfs();
        my $namefusiongene = $flipblastprot->get_hypfusiongene() || undef;
        my $homologous     = $flipblastprot->get_homologous()    || undef;
        my $frameshift     = $flipblastprot->get_frameshift()    || undef;
        my $origine        = $flipblastprot->get_origine()    || undef;
        my $numberorfs     = scalar (@$orfs);

        next if ($numberorfs < 1); # Impossible but ..........

        my $contig      = $pirmaster->GetContigByName($contigname);
        my $seq         = $contig->get_sequence();

        # if there is more than one orf
        my ($neworfs,$newhypprot) = ([],undef);

        # Sort the orf #
        # The ORFs are classified and sorted by strand and start, stop positions
        @$orfs = sort {
            my ($stranda,$strandb) = ($a->strand,$b->strand);
            my ($evaluea,$evalueb) = ($a->evalue,$b->evalue);
            if ($evaluea != $evalueb) {
                &CompareHighPrecisionFloats($evaluea,$evaluea)
            }
            elsif ($stranda != $strandb) {
                $a->strand <=> $b->strand;
            }
            elsif ($stranda == 1) {
                $a->start  <=> $b->start;
            }
            else {
                $a->end    <=> $b->end;
            }
        } @$orfs;

        # Iterate over the orfs
        # If no hypothetical protein is created, we create one
        # If an hypothetical protein is created, we check if the conditions
        # are required to create a new one:
        #   - present on the opposite strand
        #   - If ORF is close to the previous one (distance < 142)
        #     => we create a new hypothetical protein
        #   - If ORF is far from the previous one (distance > 142)
        #     => run exonerate
        #   - If trimmed 3' => run exonerate
        foreach my $orf(@$orfs) {
            # Now the thing is to create a new hyp prot if the conditions are not required
            # First : if the $currentprot is not defined
            my $start_bl = $orf->startBlast;
            my $start_cor = ( !(@$start_bl[0]) ? $orf->start : @$start_bl[0]);

            # Case 1 : first ORF
            if (not defined($newhypprot)) {
                # Here we create a new protein
                $newhypprot = new PirObject::HypProt (
                                                      name       => $name,
                                                      contigname => $contigname,
                                                      blaststart => $start_cor,
                                                      start      => $start_cor,
                                                      end        => $orf->end,
                                                      strand     => $orf->strand,
                                                      numorfs    => 1,
                                                      protein    => $orf->protein,
                                                      evalue     => $orf->evalue(),
                                                      exons      => [],
                                                      introns    => [],
                                                      homologous => $homologous,
                                                      idbyblast  => 1,
                                                      frameshift => $frameshift,
                                                      origine    => $origine,
                                                     );
                next;
            }

            # Case 2 : not the same strand
            if ($newhypprot->strand !=  $orf->strand) {
                push (@$HYPPROTS,  $newhypprot);
                $newhypprot = new PirObject::HypProt (
                                                      name       => $name,
                                                      contigname => $contigname,
                                                      blaststart => $start_cor,
                                                      start      => $start_cor,
                                                      end        => $orf->end,
                                                      strand     => $orf->strand,
                                                      numorfs    => 1,
                                                      protein    => $orf->protein,
                                                      evalue     => $orf->evalue(),
                                                      exons      => [],
                                                      introns    => [],
                                                      homologous => $homologous,
                                                      idbyblast  => 1,
                                                      frameshift => $frameshift,
                                                      origine    => $origine,
                                                     );
                next;
            }

            # Case 3-4 : Check space between 2 ORFs, including overlapping
            # If 2 ORFs match with minimal distance, we merge them (include overlapping)
            # Two case : right strand or opposite strand
            if ($orf->strand == 1) {
                if (($newhypprot->end > $orf->start) or (abs ($orf->start - $newhypprot->end) < $MAXLENGTHFORGROUPINGORF)) {
                    my $newstart = ( $orf->start < $newhypprot->start ? $orf->start : $newhypprot->start);
                    $newhypprot->set_start ($newstart);

                    my $newend = ( $orf->end   > $newhypprot->end ? $orf->end : $newhypprot->end);
                    $newhypprot->set_end ($newend);

                    # Check which protein is the best
                    if (&CompareHighPrecisionFloats($orf->evalue(),$newhypprot->evalue()) == -1) {
                        $newhypprot->set_protein($orf->protein);
                        $newhypprot->set_evalue($orf->evalue());
                    }

                    # Increase from 1, the number of orf, if we concatenate
                    my $numorfs = $newhypprot->numorfs;
                    $numorfs++;
                    $newhypprot->set_numorfs($numorfs);
                    next;
                }
                else {
                    push (@$HYPPROTS,  $newhypprot);
                    $newhypprot = new PirObject::HypProt (
                                                          name       => $name,
                                                          contigname => $contigname,
                                                          blaststart => $start_cor,
                                                          start      => $start_cor,
                                                          end        => $orf->end,
                                                          strand     => $orf->strand,
                                                          numorfs    => 1,
                                                          protein    => $orf->protein,
                                                          evalue     => $orf->evalue(),
                                                          exons      => [],
                                                          introns    => [],
                                                          homologous => $homologous,
                                                          idbyblast  => 1,
                                                          frameshift => $frameshift,
                                                          origine    => $origine,
                                                        );
                    next;
                }
            }
            else {
                # Opposite strand
                if (($newhypprot->start > $orf->end) or (abs ($orf->end - $newhypprot->start) < $MAXLENGTHFORGROUPINGORF)) {
                    my $newstart = ( $orf->start > $newhypprot->start ? $orf->start : $newhypprot->start);
                    $newhypprot->set_start ($newstart);

                    my $newend = ( $orf->end < $newhypprot->end ? $orf->end : $newhypprot->end);
                    $newhypprot->set_end ($newend);

                    # Check which protein is the best
                    if (&CompareHighPrecisionFloats($orf->evalue(),$newhypprot->evalue()) == -1) {
                        $newhypprot->set_protein ($orf->protein);
                        $newhypprot->set_evalue($orf->evalue());
                    }

                    # Add 1 to the number of orf if there is concatenation
                    my $numorfs = $newhypprot->numorfs;
                    $numorfs++;
                    $newhypprot->set_numorfs($numorfs);
                    next;
                }
                else {
                    push (@$HYPPROTS,  $newhypprot);
                    $newhypprot = new PirObject::HypProt (
                                                          name       => $name,
                                                          contigname => $contigname,
                                                          blaststart => $start_cor,
                                                          start      => $start_cor,
                                                          end        => $orf->end,
                                                          strand     => $orf->strand,
                                                          numorfs    => 1,
                                                          protein    => $orf->protein,
                                                          evalue     => $orf->evalue(),
                                                          exons      => [],
                                                          introns    => [],
                                                          homologous => $homologous,
                                                          idbyblast  => 1,
                                                          frameshift => $frameshift,
                                                          origine    => $origine,
                                                         );
                    next;
                }
            }
        }  # End for each ORF
        # Set hypfusiongene if it exists
        if ($namefusiongene) {
            my $info_gene_fusion = new PirObject::HypFusion ( name => $namefusiongene );
            $newhypprot->set_hypfusiongene($info_gene_fusion);
        }
        &AdjustStartByHMM($newhypprot, $seq, $contigname);
        if ($newhypprot->get_trimIndexThree && $newhypprot->get_trimIndexThree > 10) {
           my $info = [
                        $newhypprot->get_name(),
                        $newhypprot->get_contigname(),
                        $newhypprot->get_protein(),
                        $newhypprot->get_strand(),
                        $newhypprot->get_homologous(),
                        $newhypprot->get_namefusiongene(),
                        $newhypprot->get_origine(),
                        [$newhypprot->get_start(), $newhypprot->get_end()]
                      ];
            push(@PROT_FOR_EXONERATE, $info);
        } else {
            push (@$HYPPROTS,  $newhypprot);
        }
    } # End for each Flip Blast Prot
} # End sub

sub AdjustStartByHMM {
    my ($hypprot,$seq,$contigname) = @_;

    my $dir = "$TMPDIR/HMM_For_Start";
    unless(-d $dir){ mkdir $dir or die "Cannot create '$dir'";}

    $seq = uc($seq);
    my $isMinus     = $hypprot->get_strand() == 1 ? 0 : 1;
    my $arrow       = $isMinus ? "<==" : "==>";
    my $start       = $hypprot->get_start();
    my $old_start   = $hypprot->get_blaststart() || $start;
    my $end         = $hypprot->get_end();
    my $exons       = $hypprot->get_exons();
    my $introns     = $hypprot->get_introns();
    my $WithIntrons = (scalar(@$exons) > 1 ? 1 : 0);
    my $idByExo     = $hypprot->get_idbyexo() ? 1 : 0;

    # Def this_prot
    my $prot      = $hypprot->get_name();
    my $this_prot = &GetProteinForGeneWithoutIntrons($seq, $start, $end, $isMinus)  if !$WithIntrons;
       $this_prot = &GetProteinSequenceAndIntronsPos($exons,$introns,$seq,$hypprot) if  $WithIntrons;
    $hypprot->set_thisprot($this_prot);

    if ($this_prot eq "Frame-Shift-Detected") {
        $hypprot->set_startwarning("Aproximate start");
        &SearchForEndIfGeneHaveIntron($hypprot,$exons,$isMinus,$seq);
        return "Frame-Shift-Detected";
    }

    # Def Full5
    my $full5 = &GetFull5($seq,$isMinus,$this_prot,$start);
    $hypprot->set_full5($full5);
    my $hyp_st_full5 = length($full5) - length($this_prot);

    # Create Seq for HMM and run HMM
    my ($this_fasta,$homo_fasta) = &ExtractLibSeqs($hypprot,$this_prot);
    my $flag     = $1 if  scalar($hypprot) =~ m/0x(.+)\)/;
    my $protaln  = &RunHMM($prot,$prot.$flag,$this_fasta,$homo_fasta,"_For_Start");

    # Read ali and def each start in homologous
    my $ali        = &ReadStockholmMultAligns($protaln);
    my $each_st    = &DefEachStartInHMM($ali,$hypprot);
    my $hyp_st_ali = $each_st->{"myProt"};
    delete $each_st->{"myProt"};

    # Def lim of reasearch in Full5
    my $st_pos_cmp_st_orf = {};
    while (my ($id, $homo_st_ali) = each(%$each_st)) {
        $st_pos_cmp_st_orf->{$id} = $hyp_st_full5 + ($homo_st_ali - $hyp_st_ali);
    }
    my ($right_lim_for_st,$left_lim_for_st) = &DefMaxAndMinStartInAli($st_pos_cmp_st_orf);

    # Def first exon if gene with intron(s).
    my $first_exon = undef;
    if ($WithIntrons) {
           $first_exon      = $exons->[0];
        my $end_first_exon  = $first_exon->get_protend();
           $full5           = substr($full5,0,$end_first_exon+(length($full5)-length($this_prot)))
    }

    my $all_possible_st      = &DefineAllPossibleStart($full5,$AA_ACCEPTED_START);
    my ($best_start,$median) = &ChooseBestStart($st_pos_cmp_st_orf,$all_possible_st,$right_lim_for_st);
    # If no M or v or l was found, def by similarity !!!
    my ($firstMaj,$StartInMyProt) = &DefFirstMaj($ali,$prot);
    my $SimiStart  = ($firstMaj - $StartInMyProt);
       $SimiStart  = $hyp_st_full5 + $SimiStart < 0 ? -$hyp_st_full5 : $SimiStart;

    if (!(defined $best_start)) {
        &ChangeHypProtVal($hypprot, $SimiStart, $isMinus, $seq);
        $hypprot->set_startwarning("Def by similarity no start found");
        return;
    }

    # Add info about alternative start
    my $first_M = undef;
    foreach my $st_pos (sort { $a <=> $b } keys %$all_possible_st) {
        next if $all_possible_st->{$st_pos}->{"aa"} ne "M";
        $first_M = $st_pos;
        last;
    }

    my $alt_start = $first_M    - $hyp_st_full5 if $first_M;
    my $new_start = $best_start - $hyp_st_full5;

    if ( defined($alt_start) && $alt_start != $new_start) {
        my $alternative_st_in_seq = $isMinus ? ($old_start - ($alt_start*3)) : ($old_start + ($alt_start*3));
        $hypprot->set_altstart($alternative_st_in_seq);
    }

    # Annotate similary start if 1st start is too up or down.
    # and add First start info in HypProt
    # Note (17/08/2023): Adjust the best_start with the trim5 if it exists
    # in order to know if we should add or not the comment about similar start in other species
    my $best_start_minus_trim5 = $best_start - ($hypprot->get_trimIndexFive() || 0);

    if (abs($best_start_minus_trim5 -$right_lim_for_st) > 2 && $best_start_minus_trim5 > $right_lim_for_st) {
        $SimiStart = $isMinus ? ($old_start - ($SimiStart*3)) + 1 : ($old_start + ($SimiStart*3));

        if ($best_start_minus_trim5 > $right_lim_for_st){
            &ChangeHypProtVal($hypprot, $new_start, $isMinus, $seq);
            $hypprot->set_SimiStart($SimiStart);
        } else {
            &ChangeHypProtVal($hypprot, $new_start, $isMinus, $seq);
        }
    } else {
        $SimiStart = $isMinus ? ($old_start - ($SimiStart*3)) + 1 : ($old_start + ($SimiStart*3));
        if ($best_start < $left_lim_for_st-10) {
            &ChangeHypProtVal($hypprot, $new_start, $isMinus, $seq);
            $hypprot->set_SimiStart($SimiStart);
        } else {
            &ChangeHypProtVal($hypprot, $new_start, $isMinus, $seq);
        }
    }
    return if !$idByExo;
    &SearchForEndIfGeneHaveIntron($hypprot,$exons,$isMinus,$seq);
}

sub ExtractLibSeqs {
    my ($hypprot,$this_prot)  = @_;

    my $this_fasta = ">myProt\n";
    while ($this_prot ne "") {
            $this_prot   =~ s/\*/X/;
            $this_prot   =~ s/[^a-zA-Z]//g;
            $this_prot   = uc($this_prot);
            my $slice    = length($this_prot) > 60 ? 60 : length($this_prot);
            $this_fasta .= substr($this_prot,0,$slice)."\n";
            $this_prot   = substr($this_prot,$slice);
    }

    my $homologous = $hypprot->get_homologous();
    my $name = "a";
    my $homo_fasta = "";
    foreach my $prot (@$homologous) {
        my $seq = $prot->get_similarprot();
                  $prot->set_shortname($name);
        $homo_fasta .= ">$name\n";
        $seq =~ s/>.+\n//;
        while ($seq ne "") {
            $seq         =~ s/\*/X/;
            $seq         =~ s/[^a-zA-Z]//g;
            $seq         = uc($seq);
            my $slice    = length($seq) > 60 ? 60 : length($seq);
            $homo_fasta .= substr($seq,0,$slice)."\n";
            $seq         = substr($seq,$slice);
        }
        $name++;
    }
    return ($this_fasta,$homo_fasta);
}


sub RunHMM {
    my ($Prot,$ShortName,$ProtSeq,$HomoSeq,$Sup) = @_;
    $Sup = $Sup || "";

    my $Dir = "$TMPDIR/HMM$Sup";
    unless(-d "$Dir"){ mkdir "$Dir" or die "Cannot create '$Dir'";}
    my $SubDir = "$TMPDIR/HMM$Sup/$ShortName";
    unless(-d "$SubDir"){ mkdir "$SubDir" or die "Cannot create '$SubDir'";}
    my $ProtHomo = "$SubDir/$Prot.homo";
    my $ProtIn   = "$SubDir/$Prot.seq";
    my $ProtOut  = "$SubDir/$Prot.pir";
    my $AliOut   = "$SubDir/$Prot.sto";
    my $ProtHMM  = "$SubDir/$Prot.hmm";
    my $ProtAln  = "$SubDir/$Prot.aln";

    # Create homo input file
    my $HomoFh = new IO::File ">$ProtHomo"
        or die "Can't write to file '$ProtHomo': $!\n";
    print $HomoFh $HomoSeq;
    $HomoFh->close();

    # Create input file
    my $InFh = new IO::File ">$ProtIn"
        or die "Can't write to file '$ProtIn': $!\n";
    print $InFh "${ProtSeq}$HomoSeq";
    $InFh->close();

    # 1. Run Muscle...
    my $cmd = "$MUSCLEPATH -in '$ProtHomo' -out '$ProtOut' >/dev/null 2>/dev/null";
    print "\n$cmd\n" if $DEBUG;

    my $resultat = system("$cmd");
    my $hascoredump = ($resultat & 128) >> 7;  # 0 if no core dump, 1 if core dump
    my $signal      = $resultat & 127;  # SIGNAL received by subprocess, from 0 to 127;
    my $returncode  = $resultat >> 8;   # exit status of subprogram
    if ($returncode > 1 || $signal > 0 || $hascoredump == 1) {
        print "Error in execution of Muscle in sub RunHMM...\n";
    }

    # 2. Run Umac...
    $cmd = "$UMACPATH -i '$ProtOut' -o '$AliOut' -f stockholm >/dev/null 2>/dev/null";
    print "\n$cmd\n" if $DEBUG;

    $resultat = system("$cmd");
    $hascoredump = ($resultat & 128) >> 7;  # 0 if no core dump, 1 if core dump
    $signal      = $resultat & 127;  # SIGNAL received by subprocess, from 0 to 127;
    $returncode  = $resultat >> 8;   # exit status of subprogram
    if ($returncode > 1 || $signal > 0 || $hascoredump == 1) {
        print "Error in execution of Umac in sub RunHMM...\n";
    }

    # 3. Run HMMBuild...
    $cmd = "nice -19 $HMMBUILDPATH $ProtHMM $AliOut >/dev/null 2>/dev/null";
    print "\n$cmd\n" if $DEBUG;

    $resultat = system("$cmd");
    $hascoredump = ($resultat & 128) >> 7;  # 0 if no core dump, 1 if core dump
    $signal      = $resultat & 127;  # SIGNAL received by subprocess, from 0 to 127;
    $returncode  = $resultat >> 8;   # exit status of subprogram
    if ($returncode > 1 || $signal > 0 || $hascoredump == 1) {
        print "Error in execution of HMMBuild in sub RunHMM...\n";
    }

    # 4. Run HMMAlign...
    $cmd = "nice -19 $HMMALIGNPATH --trim --outformat stockholm -o $ProtAln $ProtHMM $ProtIn >/dev/null 2>/dev/null";
    print "\n$cmd\n" if $DEBUG;

    $resultat = system("$cmd");
    $hascoredump = ($resultat & 128) >> 7;  # 0 if no core dump, 1 if core dump
    $signal      = $resultat & 127;  # SIGNAL received by subprocess, from 0 to 127;
    $returncode  = $resultat >> 8;   # exit status of subprogram
    if ($returncode > 1 || $signal > 0 || $hascoredump == 1) {
        print "Error in execution of HMMAlign in sub RunHMM...\n";
    }

    return $ProtAln;
}

sub ReadStockholmMultAligns {
    my $infile  = shift;
    my $content = [];

    # Read input file. This is a memory hungry slurp.
    my $alifh = new IO::File "<$infile"
        or die "Cannot read from input file '$infile': $!\n";
    my $text = [<$alifh>]; # slurp
    $alifh->close();

    # Separate all block
    my $each_block = {};
    my $block      = ();
    my $i          = 0;
    while (@$text) {
        my $line   = shift(@$text);
        my $isLast = 1 if scalar(@$text) == 0;
        if ($line !~ m/^\n$/ && !$isLast) {
            push(@$block,$line);
        }
        else {
            $each_block->{$i} = $block;
            $block = ();
            $i++;
        }
    }

    # Treat block by block.
    my %global_seenids    = ();
    my $nb_block_with_seq = 0;
    my $info              = {};
    my $seqlist           = [];
    my $seqobj            = undef;
    my ($PP_cons,$RF)     = ("","");

    my @sorted = ();
    while (my ($key, $value) = each( %$each_block)){push (@sorted,$key);}
    @sorted = sort { $a <=> $b } @sorted;

    foreach my $key (@sorted) {
        $block  = $each_block->{$key};
        my $nb_seq = 0;
        my %seenids = ();
        for (my $i = 0; $i < @$block; $i++) {
            my $line = $block->[$i];
            #Treat #=GC
            if ($line =~ m/#=GC\s*/) {
                my @split = split(/\s+/, $line);
                $PP_cons .= $split[-1] if $line =~ m/PP_cons/;
                $RF      .= $split[-1] if $line =~ m/RF/;
            }

            # Treat sequence
            next if $line =~ m/^#/;
            my @split_line  = split(/\s+/, $line);
            my ($name,$seq) = @split_line;
            my $id = $name && $name =~ m/(.+)\// ? $1 : $name;
            $nb_seq++;
            $seenids{$id}++;
            $global_seenids{$id}++;

            my $begin_seq = $info->{$id}->{$seenids{$id}}->{seq};
            $seq = defined($begin_seq) ? "${begin_seq}$seq": $seq;
            $info->{$id}->{$seenids{$id}}->{seq} = $seq;

            # Treat #GR if next $line =~ m/^#=GR/
            my $next_line       = $block->[$i+1];
            next if !$next_line;
            next if $next_line  !~ m/^#=GR/;
            my @split_next_line = split(/\s+/, $next_line);
            my ($tag,$name_next,$feat,$mark)  = @split_next_line;
            my $id_next = $name_next && $name_next =~ m/(.+)\// ? $1 : $name_next;
            print "$name doesn't match with #=GR PP line\n" if $id_next ne $id;
            next if $feat ne "PP";
            my $begin_PP = $info->{$id}->{$seenids{$id}}->{PP};
            my $PP = defined($begin_PP) ? "${begin_PP}$mark": $mark;
            $info->{$id}->{$seenids{$id}}->{PP} = $PP;
        }
        $nb_block_with_seq++ if $nb_seq != 0;
    }

    while ( my ($id, $value) = each(%global_seenids) ) {
          my $mod   = $value % $nb_block_with_seq;
          die "Sequence $id not present in all blocks\n" if $mod != 0;
    }

    my $length_stand = 0;
    for my $id ( keys %$info ) {
        my $info_for_id = $info->{$id};
        my $nb_dupli    = scalar( keys %$info_for_id);

        for my $num_dupli ( keys %$info_for_id ) {
            my $info_for_dupli = $info_for_id->{$num_dupli};
            my $id  = $nb_dupli == 1 ? $id : "${num_dupli}${id}";
            my $seq = $info_for_dupli->{seq};
            my $PP  = $info_for_dupli->{PP};
            my $length_PP    = length($PP) if $PP;
            my $length_seq   = length($seq);
            $length_stand = $length_seq if $length_stand == 0;
            die "PP and sequence do not have the same length for $id\n"
                if $PP && $length_PP != $length_seq;
            die "$id do not have standard length\n"
                if $length_seq != $length_stand;
            $seqobj = new PirObject::AlignedSeq(
                seqId        => $id,
                sequence     => $seq,
                PP           => $PP,
            );
            push(@$seqlist,$seqobj);
        }
    }
    my $length_PP_cons  = length($PP_cons);
    die "PP_cons do not have standard length\n"
        if $length_PP_cons && $length_PP_cons != $length_stand;

    $text = []; # Zap input array text, free memory

    my $ma = new PirObject::MultAlign(
        alignedSeqs => $seqlist,
        PP_cons     => $PP_cons,
    );
    push(@$content,$ma);
    return $content;
}

sub DefEachStartInHMM {
    my ($align,$hypprot) = @_;

    my $each_start = {};
    my $multalign     = $align->[0];
    my $alignedSeqs   = $multalign->get_alignedSeqs();

    # Create a hash with each protein used in HMM
    my $full_sequences = {};
    my $homologous     = $hypprot->get_homologous();
    foreach my $homo (@$homologous) {
        my $shortname = $homo->get_shortname();
        my $protein   = $homo->get_similarprot();

        $protein =~ s/>.+\n//;
        $full_sequences->{$shortname} = $protein;
    }

    # The Hash with each protein will be used to correct the start position in
    # each alignment it should be done due the the usage of --trim option for HMM
    foreach my $alignedSeq (@$alignedSeqs) {
        my $id    = $alignedSeq->get_seqId();
        my $full  = $full_sequences->{$id} || $hypprot->get_thisprot();

        my $seq        = $alignedSeq->get_sequence();
        my $dash_seq   = $seq;
           $dash_seq   =~ s/\./\-/g;
        my $raw_seq    = $dash_seq;
           $raw_seq    =~ s/\-//g;
        my $dash_chain = $1 if $dash_seq =~ m/^(-*)/;
        my $len_dash   = length($dash_chain);
        my $full_without_stop = $full;
           $full_without_stop =~ s/\*/X/g;
        my $trim_index = index(uc($full_without_stop),uc($raw_seq));
        $each_start->{$id} = $len_dash + $trim_index;

        if ($id eq "myProt") {
            $hypprot->set_trimIndexFive($trim_index);
            my $ending_dash = $1 if $seq =~ m/(-+)$/;
            my $trim_three  = length($ending_dash);
            $hypprot->set_trimIndexThree($trim_three);
        }
    }
    return $each_start;
}

sub DefFirstMaj {
    my ($ali,$prot) = @_;

    my $FirstMajs = ();
    my $multalign     = $ali->[0];
    my $alignedSeqs   = $multalign->get_alignedSeqs();
    my $StartInMyProt = "";
    # Define first letter in my current protein
    foreach my $alignedSeq (@$alignedSeqs) {
        my $id  = $alignedSeq->get_seqId();
        next if $id ne "myProt";
        my $seq = $alignedSeq->get_sequence();
        for ( my $i = 0 ; $i < length($seq) ; $i++) {
            my $char = uc(substr($seq,$i,1));
            next if $char !~ m/[A-Z]/;
            $StartInMyProt = $i  if $id eq "myProt";
            last;
        }
    }

    # Define first letter in each homologous protein
    foreach my $alignedSeq (@$alignedSeqs) {
        my $id  = $alignedSeq->get_seqId();
        next if $id eq "myProt";
        my $seq = $alignedSeq->get_sequence();
        for ( my $i = 0 ; $i < length($seq) ; $i++) {
            my $char = substr($seq,$i,1);
            next if $char !~ m/[A-Z]/;
            push(@$FirstMajs,$i);
            last;
        }
    }

    return (-1,$StartInMyProt) if !$FirstMajs;
    @$FirstMajs  = sort { $a <=> $b } @$FirstMajs;
    my $FirstMaj = $FirstMajs->[0];
    return ($FirstMaj,$StartInMyProt);
}

# Get the protein sequence for a gene with lower case for
# possible start codons.
sub GetProteinForGeneWithoutIntrons {
    my ($seq, $start, $end, $isMinus) = @_;

    # 1. Make hyp prot def by blast
    # If !isMinus subtract 1 from start and end else add 1
    # $start = $start - 1 if !$isMinus;
    # $start = $start + 1 if  $isMinus;
    my $nt_seq = &Get_nt_seq($seq, $start, $end, $isMinus);

    my $protein    = "";
    foreach (my $i = 0; $i <= length($nt_seq) - 3; $i += 3) {
        my $tri_nt   = uc (substr($nt_seq, $i , 3));
        my $aa       = $CODON_TABLE->{$tri_nt} || "X";
        # Lower case for possible start codons
        my $accepted_aa_for_tri_nt = $ALTERNATIVE_ACCEPTED_START->{$tri_nt} || [];
        # If $accepted_aa_for_tri_nt contains "x" then all tri_nt is possible start codon and should be lower case
           $aa       = lc($aa) if  grep { uc($_) eq "X" } @$accepted_aa_for_tri_nt;
        # If $aa is one of the value present in $accepted_aa_for_tri_nt then it is possible start codon and should be lower case
           $aa       = lc($aa) if  grep { uc($_) eq $aa } @$accepted_aa_for_tri_nt;
        $protein .= $aa;
    }
    return $protein;
}

sub Get_nt_seq {
    my ($seq, $start, $end, $isMinus) = @_;

    my $g_length =  !$isMinus ? $end - $start + 1 : $start - $end + 1;
    my $nt_seq   =  !$isMinus ? uc(substr($seq, $start - 1 , $g_length)) : uc(substr($seq, $end - 1 , $g_length));
       $nt_seq   =~ tr/ACGT/TGCA/ if $isMinus;
       $nt_seq   = reverse $nt_seq        if $isMinus;

    return $nt_seq;
}

sub GetFull5 {
    my ($seq, $isMinus, $prot_seq, $start) = @_;

    my $use_seq =  uc($seq);
    $use_seq =~ tr/ACGT/TGCA/    if $isMinus;
    $use_seq =  reverse $use_seq if $isMinus;

    my $full_5  = $prot_seq;
    $prot_seq   = uc($prot_seq);
    my $len_seq = length($seq);
       $start   = $len_seq - $start + 1 if $isMinus;

    my $shift  = -3;
    my $tail_5 = [];
    for (my $currentpos = $start - 3; ; $currentpos += $shift) {
        last if $currentpos < 1;
        my $tri_nt = uc (substr($use_seq, $currentpos - 1,3));
        my $aa       = $CODON_TABLE->{$tri_nt} || "X";
        # Lower case for possible start codons
        my $accepted_aa_for_tri_nt = $ALTERNATIVE_ACCEPTED_START->{$tri_nt} || [];
        # If $accepted_aa_for_tri_nt contains "x" then all tri_nt is possible start codon and should be lower case
           $aa       = lc($aa) if  grep { uc($_) eq "X" } @$accepted_aa_for_tri_nt;
        # If $aa is one of the value present in $accepted_aa_for_tri_nt then it is possible start codon and should be lower case
           $aa       = lc($aa) if  grep { uc($_) eq $aa } @$accepted_aa_for_tri_nt;
        last if $aa eq "*";
        push(@$tail_5, $aa);
    }
    @$tail_5  = reverse(@$tail_5);
    my $tail  = join("",@$tail_5);
    $full_5   = $tail.$full_5;
    return $full_5;
}

sub DefMaxAndMinStartInAli {
    my $each_start = shift;

    my ($max_start,$min_start)  = (0,999999);
    while ( my ($seq_id, $val) = each(%$each_start) ) {
        $max_start = $val if $val > $max_start;
        $min_start = $val if $val < $min_start;
    }
    return ($max_start,$min_start);
}

sub DefineAllPossibleStart {
    my ($full5,$aa_accepted) = @_;

    my $all_possible_start = {};
    my @t_full5 = split(//, $full5);

    for (my $i = 0 ; $i <= $#t_full5 ; $i++) {
        my $aa = $t_full5[$i];
        next if !$aa_accepted->{$aa};
        $all_possible_start->{$i}->{"aa"} = $aa;
    }
    return $all_possible_start;
}

sub ChooseBestStart {
    my ($each_st,$all_possible_st,$right_lim_for_st) = @_;

    # No start was found before last start in alignment
    my $best_start  = undef;
       $best_start  = &ChooseStartIfTooFar($all_possible_st,$right_lim_for_st);
    my $median      = &Median($each_st);
    return ($best_start,$median) if $best_start;

    foreach my $st_pos (sort { $a <=> $b } keys %$all_possible_st) {
        #xxxxxxx +2 need to be an option.
        delete $all_possible_st->{$st_pos} if $st_pos > ($right_lim_for_st + 2);
    }

    &AddInfoForPosStart($each_st,$all_possible_st);
    my $nb_homo  = scalar(keys %$each_st);

    # Start is defined with close homologous.
    $best_start   = &ChooseStartWithCloseHomo($all_possible_st,$nb_homo);
    return ($best_start,$median) if $best_start;

    # Start is defined with median.
    $best_start   = &ChooseStartWithAllHomo($each_st,$all_possible_st,$median);
    return ($best_start,$median);
}

sub ChooseStartIfTooFar {
    my ($all_possible_st,$limite) = @_;

    foreach my $st_pos (sort { $a <=> $b } keys %$all_possible_st) {
        return $st_pos if $st_pos > $limite;
        last;
    }
    return undef;
}

sub AddInfoForPosStart {
    my $each_st         = shift;
    my $all_possible_st = shift;

    # Foreach close homologous
    while (my ($id, $st_homo) = each(%$each_st)) {
        next if $id gt "d";
        my $close_hyp_st = undef;
        my $min_diff_Whomo  = 100000;  #very hight value
        # Foreach hypothetic start
        foreach my $st_pos (sort { $a <=> $b } keys %$all_possible_st) {
            my $aa                 = $all_possible_st->{$st_pos}->{"aa"};
            my $min_diff_pos_start = defined($all_possible_st->{$st_pos}->{"min"}) ? $all_possible_st->{$st_pos}->{"min"} : 100000;
            my $diff = abs($st_homo-$st_pos);
            #print " id : $id st_pos : $st_pos diff : $diff\n";
            # Choose se closest poss start
            if ($diff < $min_diff_Whomo) {
                ($close_hyp_st,$min_diff_Whomo) = ($st_pos,$diff);

            }
            # Set min dist for this start
            if ($diff < $min_diff_pos_start) {
                $all_possible_st->{$st_pos}->{"min"} = $diff;
            }
        }
        next if !(defined $close_hyp_st);
        $all_possible_st->{$close_hyp_st}->{"count"}++;
    }
}

sub ChooseStartWithCloseHomo {
    my $all_possible_st = shift;
    my $nb_homo         = shift;

    while ( my ($st_pos, $hash) = each(%$all_possible_st) ) {
        my ($aa,$count) = ($hash->{"aa"},$hash->{"count"});
        next if !$count;
        if ($nb_homo >= 4) {
           return $st_pos if $count >= 3;
        }
        elsif ($nb_homo == 2 || $nb_homo == 3) {
            return $st_pos if $count >= 2;
        }
        elsif ($nb_homo == 1) {
            return $st_pos if $count >= 1;
        }
    }
    return undef;
}

sub ChooseStartWithAllHomo {
    my $each_st         = shift;
    my $all_possible_st = shift;
    my $median          = shift;

    foreach my $st_pos (sort (keys(%$all_possible_st))) {
        delete $all_possible_st->{$st_pos}->{"count"};
        delete $all_possible_st->{$st_pos}->{"min"};
    }

    my $close_hyp_st = undef;
    my $min_diff     = 100000;  # very hight value
    foreach my $st_pos (sort { $a <=> $b } keys %$all_possible_st) {
        my $diff = abs($median-$st_pos);
        ($close_hyp_st,$min_diff) = ($st_pos,$diff) if $diff < $min_diff;
    }
    return $close_hyp_st;
}

sub Median {
    my $each_st = shift;

    my @all_pos = ();
    while ( my ($id, $pos) = each(%$each_st) ) {
        push(@all_pos,$pos);
    }
    @all_pos = sort { $a <=> $b } @all_pos;
    my $median   = "";
    my $nb_elem  = scalar(@all_pos);
    my $last_ind = $nb_elem - 1;
    if ($nb_elem == 1) {
        $median = $all_pos[0];
    }
    elsif (($nb_elem % 2) == 0) {
        $median = $all_pos[($last_ind / 2)];
    }
    else {
        $median = int ( $all_pos[int($last_ind / 2)]
                    + (($all_pos[int($last_ind / 2) + 1]
                      - $all_pos[int($last_ind / 2)]) / 2));
    }
    $median = $median >= 0 ? $median : 0;
    return $median;
}

sub ChangeHypProtVal {
    my ($hypprot,$new_start,$isMinus,$seq) = @_;

    my $old_start  = $hypprot->get_start;
    my $end        = $hypprot->get_end;
    my $name       = $hypprot->get_name;
    my $new_st_pos = $isMinus ? ($old_start - ($new_start*3)): ($old_start + ($new_start*3));
    $new_st_pos = length($seq) if $new_st_pos > length($seq);
    $new_st_pos = 0 if $new_st_pos < 0;
    my $exons      = $hypprot->get_exons();
    my $first_exon = $exons->[0] if scalar(@$exons);
    $first_exon->set_dnastart($new_st_pos) if $first_exon;
    $hypprot->set_start($new_st_pos);

    # 1. Def tri_nt start
    my $start    = $new_st_pos;
    my $g_length =  !$isMinus ? $end - $start + 1 : $start - $end + 1;
    my $nt_seq   =  !$isMinus ? substr($seq, $start - 1 , $g_length) : substr($seq, $end - 1 , $g_length);
       $nt_seq   =~ tr/ACGT/TGCA/    if $isMinus;
       $nt_seq   = reverse $nt_seq   if $isMinus;
    my $tri_nt   = uc (substr($nt_seq, 0 , 3));

    my $prot    = $hypprot->get_thisprot();
    $hypprot->set_thisprot(substr($prot,int(($start-$old_start)/3)));

    $TRI_NT_START_COUNT ->{$tri_nt}++;
}

sub SearchForEndIfGeneHaveIntron {
    my $hypprot     = shift;
    my $exons       = shift;
    my $isMinus     = shift;
    my $seq         = shift;

    my $len_seq    = length($seq);
    my $first_exon = $exons->[0];
    my $end_exon   = $exons->[-1];
    my $end_e      = $end_exon->get_dnaend();

    if (!$isMinus) {
        for (my $i = -3;; $i += 3) {
            last if $end_e + $i > $len_seq -3;
            my $tri_nt  = uc (substr($seq, $end_e + $i, 3));
            my $codon   = $CODON_TABLE->{$tri_nt};
            next if $codon ne "*";
            my $new_end = $end_e + $i + 3;
            $end_exon->set_dnaend($new_end);
            $hypprot->set_end($new_end);  # Set the new end to the protein
            last;
        }
    }
    elsif ($isMinus) {
        for (my $i = 0;; $i -= 3) {
            last if $end_e +$i-1 < 0;
            my $tri_nt = uc (substr($seq, $end_e + $i - 1 , 3));
               $tri_nt =~ tr/ATUGCatugc/TAACGTAACG/;
               $tri_nt = reverse ($tri_nt);# Reverse and complementary
            my $codon  = $CODON_TABLE->{$tri_nt};
            next if $codon ne "*";
            my $new_end = $end_e + $i;
            $end_exon->set_dnaend($new_end);
            $hypprot->set_end($new_end);       # Set the new end to the protein
            last;
        }
    }
}

#-----------------------------------------#
# Subs for internal structure prediction  #
#-----------------------------------------#

sub FindExonsInHypProtArray {
    # The main is to find exons by making a local alignement
    mkdir("$TMPDIR/Exonerate",0700) or die "Error: can't create working directory '$TMPDIR/Exonerate': $!\n";
    mkdir("$TMPDIR/Intron",0700) or die "Error: can't create working directory '$TMPDIR/Intron': $!\n";
    for (my $i=0; $i < @PROT_FOR_EXONERATE ; $i++) {

        my $info = $PROT_FOR_EXONERATE[$i]; # table with values for each prot
        my ($name, $contigname, $protein, $strand, $homologous, $namefusiongene, $origine, $ORF_start_end) = @$info;

        # In order to have the contig sequence
        my $contig  = $pirmaster->GetContigByName($contigname)
            or die "Internal error: can't find contig named '$contigname'.\n";
        my $dna_seq = $contig->get_sequence();
           $dna_seq = uc($dna_seq);
        my $seq     = ">sequence\n$dna_seq";

        my $length = 0;
        my @tab_prot = split(/\n/, $protein);  # check this, it may not work properly
        for (my $i = 0 ; $i <= $#tab_prot ; $i++) {
            my $line = uc $tab_prot[$i];
            next if $line =~ /^>/;
            $line =~ tr/A-Z//cd;
            $length += length($line);
        }
        my $overlappe_authorized = ((5*$length)/100);

        # Write protein and gene in fasta files
        my $fileprot      = "$TMPDIR/Exonerate/prot_for_exonerate_${i}_${name}";
        my $filecontig    = "$TMPDIR/Exonerate/gene_for_exonerate_${contigname}";
        my $exonerate_out = "$TMPDIR/Exonerate/exonerate_${i}_${name}";

        # Check if it exists
        unlink($fileprot)      or die "Impossible to delete $fileprot\n"      if (-f $fileprot);
        unlink($exonerate_out) or die "Impossible to delete $exonerate_out\n" if (-f $exonerate_out);

        # Create protein for exonerate
        my $FILEPROT = new IO::File ">$fileprot" or die "Impossible to open $fileprot\n";
        print $FILEPROT $protein, "\n";
        $FILEPROT->close() or die "Impossible to close $fileprot\n";

        # Create genome for exonerate
        if (! -f $filecontig) {
            my $FH = new IO::File ">$filecontig" or die "Impossible to open $filecontig\n";
            print $FH $seq, "\n";
            $FH->close() or die "Impossible to close $filecontig\n";
        }

        my $Exonerate_parameter = "--model protein2genome --showcigar T --useaatla F --showquerygff T --showtargetgff T --minintron 142 --maxintron $MAXLENINTRONS --intronpenalty -35 --splice3 $MODEL_PATH/Splice/neutral.pssm --splice5 $MODEL_PATH/Splice/neutral.pssm --geneticcode $GENCODE";
        my $cmd = "$EXONERATEPATH $Exonerate_parameter $fileprot '$filecontig' > $exonerate_out"; # $Exonerate_parameter $fileprot $filecontig
        print "\n$cmd\n" if $DEBUG;

        my $resultat = system("$cmd");

        my $hascoredump = ($resultat & 128) >> 7;  # 0 if no core dump, 1 if core dump
        my $signal      = $resultat & 127;  # SIGNAL received by subprocess, from 0 to 127;
        my $returncode  = $resultat >> 8;   # exit status of subprogram
        if ($returncode > 1 || $signal > 0 || $hascoredump == 1) {
            print "Error in execution of Exonerate \n";
        }

        my $infh  = new IO::File "<$exonerate_out"
            or die "Can't read from file '$exonerate_out': $!\n";
        my @tab   = <$infh>;
        $infh->close();

        my $flobj = new PirObject::ExonerateOutput();
        $flobj->FillFeaturesFromTextOutput(\@tab);

        my $ExoReports      = $flobj->report;   # One report contain information about one C4 section present in exonerate Output
        my $grouped_reports = &SortAndGroupC4Report($ExoReports,$overlappe_authorized,$info);

        my %group_len_covered = ();
        foreach my $groupref (@$grouped_reports) {
           my $covered = 0;
           foreach my $report (@$groupref) {
               my $cover = abs($report->query_stop() - $report->query_start()) + 1;
               $covered += $cover;
           }
           $group_len_covered{$groupref} = $covered;
        }

        @$grouped_reports = sort { $group_len_covered{$b} <=> $group_len_covered{$a}
                                                         ||
                                             scalar(@$a) <=> scalar(@$b)
                                } @$grouped_reports;

        for (my $group_n=0; $group_n < @$grouped_reports; $group_n++) {  # Push information about the new exon
            my $group = @$grouped_reports[$group_n];
            my @exon_start_end = ();                                  # Tab with information about start and end of all exons present in Exonerte Output
            my %strand;
            for (my $report_n=0; $report_n < @$group; $report_n++) {  # Push information about the new exon
                my $report = @$group[$report_n];
                my $features                 = $report->dnafeatures;  # $features contains all information present in the part GFF DNA per lines
                my $query_range              = $report->query_range;
                my $raw_score                = $report->raw_score;
                my ($start_query,$end_query) = ($query_range =~ m#(\d+)\s*->\s*(\d+)#);

                my $num_exon = 0;
                foreach my $lineobj (@$features) {
                    my $feat = $lineobj->feature;
                    next if $feat ne "exon";
                    my $strand_exon = $lineobj->strand;
                    $strand{1}++  if $strand_exon eq "+";         # Just in order to know if we have a transpliced gene
                    $strand{-1}++ if $strand_exon eq "-";
                    $num_exon++;
                 }

                 my $count_exon = 0;
                 foreach my $lineobj (@$features) {
                     my $feat        = $lineobj->get_feature();
                     next if $feat ne "exon";

                     my $strand_exon = $lineobj->get_strand();
                     my $start       = ($strand_exon eq "-" ? $lineobj->get_end()   : $lineobj->get_start());
                     my $end         = ($strand_exon eq "-" ? $lineobj->get_start() : $lineobj->get_end());
                     my $attributes  = $lineobj->get_attributes();
                     my $info  = [$start,$end,$strand_exon,$start_query,$attributes,$end_query,$raw_score,$report_n,$count_exon];
                     push(@exon_start_end, $info);
                     # @exon_start_end contain information about exon with start end and strand of each exons
                     $count_exon++;
                 }
             }

             if ($strand{1} && $strand{-1}) {
                 # If we have a transpliced gene
                 &Add_comment_for_transpliced($contigname,$name,\@exon_start_end);
                 $add_text_in_header .= ";;    $name may be either split by linearization of a circular-mapping genome, or it is trans-spliced (annotation in comments)\n";
                 next;
             }

             my $isMinus = (($strand{1} && !$strand{-1}) ? 0 : 1);
             @exon_start_end = sort {    ($a->[3] <=> $b->[3])
                                     ||  ($a->[0] <=> $b->[0])} @exon_start_end if $isMinus == 0; # Sort exons_start_end by start strand-

             @exon_start_end = sort {    ($a->[3] <=> $b->[3])
                                     ||  ($b->[0] <=> $a->[0])} @exon_start_end if $isMinus == 1; # Sort exons_start_end by start strand+


             # Adjust exons position if overlap at protein level
             my $reduce_size =  0;
             my $prot_start  = -1;
             for (my $i = 0; $i < (@exon_start_end-1); $i++) {
                if ($isMinus == 0) {
                  if ( $exon_start_end[$i]->[5] > $exon_start_end[$i+1]->[3]) {
                    $reduce_size = abs ( $exon_start_end[$i]->[5] - $exon_start_end[$i+1]->[3] );
                    # If it is the first exon adjust exon position at dna level
                    if ($exon_start_end[$i+1]->[8] == 0) {
                      $exon_start_end[$i+1]->[0] = $exon_start_end[$i+1]->[0] + ($reduce_size * 3) + 3;
                      $prot_start = $exon_start_end[$i+1]->[3] + $reduce_size + 1;
                    }
                    # Foreach exon of the group adjust exon position at protein level
                    if ($prot_start != -1) {
                      $exon_start_end[$i+1]->[3] = $prot_start;
                    }
                  }
                } else {
                  if ( $exon_start_end[$i]->[5] > $exon_start_end[$i+1]->[3]) {
                    $reduce_size = abs ( $exon_start_end[$i]->[5] - $exon_start_end[$i+1]->[3] );
                    # If it is the first exon adjust exon position at dna level
                    if ($exon_start_end[$i+1]->[8] == 0) {
                      $exon_start_end[$i+1]->[0] = $exon_start_end[$i+1]->[0] - ($reduce_size * 3) - 3;
                      $prot_start                = $exon_start_end[$i+1]->[3] + $reduce_size + 1;
                    }
                    # Foreach exon of the group adjust exon position at protein level
                    if ($prot_start != -1) {
                      $exon_start_end[$i+1]->[3] = $prot_start;
                    }
                  }
                }
             }

             # Correction about start and end of exon if two exons is overlapping #
             my @exon_start_end_cor =();                                             # Correction about start and end of exon if two exons is overlapping
             for (my $i = 0; $i < (@exon_start_end-1); $i++) {
                 if ($isMinus == 0) {
                     if (!( ($exon_start_end[$i]->[1] + 1 < $exon_start_end[$i+1]->[0]) || ($exon_start_end[$i+1]->[1] + 1 < $exon_start_end[$i]->[0]) )) {
                         # Take the minus start and the bigger stop if exons is on strand +
                         my $boolean = (($exon_start_end[$i]->[1] + 1 >= $exon_start_end[$i+1]->[0]) == 1 ? 0 : 1);
                         my $start   = $exon_start_end[$i]->[0]   if !$boolean; # if E1_end > E2_start
                         my $end     = $exon_start_end[$i+1]->[1] if !$boolean; # if E1_end > E2_start
                            $start   = $exon_start_end[$i+1]->[0] if  $boolean; # if E2_end > E1_start
                            $end     = $exon_start_end[$i]->[1]   if  $boolean; # if E2_end > E1_start
                         my $strand_exon = $exon_start_end[$i]->[2];
                         my $start_query = $exon_start_end[$i]->[3];
                         my $raw_score   = $exon_start_end[$i]->[6];
                         my $info = [$start,$end,$strand_exon,$i,$start_query,$raw_score]; # Start, End, Strand and Index
                         push(@exon_start_end_cor, $info);
                     }
                 }

                elsif ($isMinus == 1) {
                    if (!( ($exon_start_end[$i+1]->[0] + 1 < $exon_start_end[$i]->[1]) || ($exon_start_end[$i]->[0] + 1 < $exon_start_end[$i+1]->[1]) )) {
                        # Take the minus start and the bigger stop if exons is on strand +
                        my $boolean = (($exon_start_end[$i+1]->[0] + 1 >= $exon_start_end[$i]->[1]) == 1 ? 0 : 1);
                        my $start   = $exon_start_end[$i]->[0]   if !$boolean; # if E2_start > E1_end
                        my $end     = $exon_start_end[$i+1]->[1] if !$boolean; # if E2_start > E1_end
                           $start   = $exon_start_end[$i+1]->[0] if  $boolean; # if E1_start > E2_end
                           $end     = $exon_start_end[$i]->[1]   if  $boolean; # if E1_start > E2_end
                        my $strand_exon = $exon_start_end[$i]->[2];
                        my $start_query = $exon_start_end[$i]->[3];
                        my $raw_score   = $exon_start_end[$i]->[6];
                        my $info = [$start,$end,$strand_exon,$i,$start_query,$raw_score]; # Start, End, Strand and Index
                        push(@exon_start_end_cor, $info);
                    }
                }
            }

            @exon_start_end_cor = sort { $b->[3] <=> $a->[3] } @exon_start_end_cor; # Sort by index

            for (my $i=0; $i < @exon_start_end_cor; $i++) {
                splice(@exon_start_end,$exon_start_end_cor[$i]->[3],2); # Splice information about overlapping exons
            }

            for (my $i=0; $i < @exon_start_end_cor; $i++) {  # Push information about the new exon
                my $start       = $exon_start_end_cor[$i]->[0];
                my $end         = $exon_start_end_cor[$i]->[1];
                my $strand_exon = $exon_start_end_cor[$i]->[2];
                my $start_query = $exon_start_end_cor[$i]->[4];
                my $raw_score   = $exon_start_end_cor[$i]->[5];
                my $info        = [$start,$end,$strand_exon,$start_query,$raw_score];
                push(@exon_start_end, $info );  # Push information about the exon corrected into @exons_start_end
            }

            @exon_start_end = sort { $a->[3] <=> $b->[3] || $a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] } @exon_start_end if $isMinus == 0;
            @exon_start_end = sort { $a->[3] <=> $b->[3] || $b->[0] <=> $a->[0] || $b->[1] <=> $a->[1] } @exon_start_end if $isMinus == 1;

            # Check if we haven't an exon that's makes no sense
            my ($gene_start,$gene_end) = ($exon_start_end[0]->[0],$exon_start_end[-1]->[1]);
               ($gene_start,$gene_end) = ($gene_end,$gene_start) if $isMinus == 1;

            my $isTranspliced = 0;
            for (my $i = @exon_start_end - 1; $i >= 0 ; $i--) {
                my ($start,$end) = ($exon_start_end[$i]->[0],$exon_start_end[$i]->[1]);
                next if !$start || !$end;
                if (($start < $gene_start ) || ($end > $gene_end)) {
                    my $file_with_alt = &Create_alternative_prot($dna_seq,\@exon_start_end,$i,$name);
                    my $delete_or_not = &Choose_best_solution($file_with_alt,$fileprot,$i,$name);
                       $isTranspliced = ( !$delete_or_not ? 1 : 0);
                    splice(@exon_start_end, $i, 1) if !$isTranspliced;
                    if ($isTranspliced) {
                        &Add_comment_for_transpliced($contigname,$name,\@exon_start_end);
                        $add_text_in_header .= ";;    $name may be either split by linearization of a circular-mapping genome, or it is trans-spliced (annotation in comments)\n";
                        last;
                    }
                }
            }
            next if $isTranspliced;

            # Define the tab of intron with the information about exons localisation
            my @intron_start_end;
            for (my $i = 0; $i < (@exon_start_end-1); $i++) {
                my $start  = ($isMinus == 1 ? $exon_start_end[$i]->[1] - 1 : $exon_start_end[$i]->[1] + 1);
                my $end    = ($isMinus == 1 ? $exon_start_end[$i+1]->[0] + 1 : $exon_start_end[$i+1]->[0] - 1);
                my $strand_intron = $exon_start_end[$i]->[2];
                my $info = [$start,$end,$strand_intron];
                push(@intron_start_end, $info);
            }

            my $hypprot = undef;
            my ($start,$end) = ($exon_start_end[0]->[0],$exon_start_end[-1]->[1]);
            my $FirstExonerateMatch = $exon_start_end[0]->[3];
            my $strand = $isMinus ? -1 : 1;
            $hypprot = new PirObject::HypProt (
                                                  name       => $name,
                                                  contigname => $contigname,
                                                  exostart   => $start,
                                                  start      => $start,
                                                  end        => $end,
                                                  strand     => $strand,
                                                  numorfs    => 1,
                                                  protein    => $protein,
                                                  exons      => [],
                                                  introns    => [],
                                                  homologous => $homologous,
                                                  firstExonerateMatch => $FirstExonerateMatch,
                                                  idbyexo    => 1,
                                                  origine    => $origine,
                                                 );
            push (@$HYPPROTS,  $hypprot);

            if ($namefusiongene) {
                my $info_gene_fusion = new PirObject::HypFusion ( name => $namefusiongene );
                $hypprot->set_hypfusiongene($info_gene_fusion);
            }

            my $hypprotexonarray = $hypprot->exons;
            for (my $i = 0; $i < @exon_start_end; $i++){
                # Fill information about exon
                my $attributes      = $exon_start_end[$i]->[4] || "";
                my $frameshift_size = $1 if $attributes =~ m/frameshifts\s+(\d+)/;
                my $hypprotexon = new PirObject::Exon (
                                                       dnastart       => $exon_start_end[$i]->[0],
                                                       dnaend         => $exon_start_end[$i]->[1],
                                                       strand         => $exon_start_end[$i]->[2],
                                                       exoscore       => $exon_start_end[$i]->[6],
                                                       frameshiftsize => $frameshift_size,
                                                       FirstExoMatch  => $exon_start_end[$i]->[3],
                                                      );
                push (@$hypprotexonarray, $hypprotexon);
            }

            my $hypprotintronarray = $hypprot->introns;
            for (my $i = 0; $i < @intron_start_end; $i++){
                # Fill information about intron
                my $hypprotintron = new PirObject::Intron (
                                                           start  => $intron_start_end[$i]->[0],
                                                           end    => $intron_start_end[$i]->[1],
                                                           strand => $intron_start_end[$i]->[2],
                                                          );
                push (@$hypprotintronarray, $hypprotintron);
            }

            my $introns = $hypprot->get_introns();
            for (my $i = 0; $i < @$introns; $i++) {
                 my $intron  = $introns->[$i];
                 my $isMinus = ($intron->get_strand() eq "+" ? 0 : 1);
                 my $OV      = &WhatOverlapsThis($intron->get_start(),$intron->get_end(),$contig);
                 my $APC     = &MakeApCollection($OV,$contigname);
                 $intron->set_idbyRNAw($APC);
                 foreach my $info_who_overlap (@$OV){
                     foreach my $OV_AP (@$info_who_overlap ){
                         my ($AP_min,$AP_max,$AP)  = @$OV_AP;
                         my $id_AP  = $1 if scalar($AP) =~ m/0x(.+)\)/;
                         my $tab_id = [$id_AP];
                         &Remove_AP($tab_id,$contig);
                         &AddGroupUseAP($intron,$AP);
                     }
                 }
                 next if $intron->get_type() || $LVL_INTRON == 2;
                 &LocateIntrons($dna_seq,$intron,undef,$name,$contigname,$isMinus);
            }

            &CheckRealIntrons($hypprot,$dna_seq,$name,$contigname,$pirmaster);
            my $msg = &AdjustStartByHMM($hypprot, $dna_seq, $contigname);

            if ($msg && $msg eq "Frame-Shift-Detected-Length") {
                my $arrow = $strand == 1 ? "==>" : "<==";

                my $exons = $hypprot->get_exons();
                for (my $i = 0; $i < @$exons; $i++) {
                    my $idx = $i + 1;
                    my $exon = new PirObject::AnnotPair(
                        type      => "C",
                        genename  => $name,
                        startpos  => $exons->[$i]->get_dnastart(),
                        endpos    => $exons->[$i]->get_dnaend(),
                        startline => ";; $name-E$idx $arrow start ;; mfannot: potential frameshift" ,
                        endline   => ";; $name-E$idx $arrow end"
                        );
                    &AddAnnotToPirMaster($contigname,$exon);
                }

                my $hyp_prot = new PirObject::AnnotPair(
                                                 type      => "C",
                                                 genename  => $name,
                                                 startpos  => $start,
                                                 endpos    => $exons->[-1]->get_dnaend(),
                                                 direction => $arrow,
                                                 startline => ";; $name $arrow start ;; mfannot: potential frameshift",
                                                 endline   => ";; $name $arrow end",
                                                 );
                &AddAnnotToPirMaster($contigname,$hyp_prot);
                pop @$HYPPROTS;
                next;
            }

            my $hypprot_list = &CheckLenIntrons($hypprot,$dna_seq,$name,$contigname,$pirmaster);
            if (scalar(@$hypprot_list) > 1) {
                splice(@$HYPPROTS,-1,1);
                foreach my $hypprot (@$hypprot_list) {
                    push (@$HYPPROTS,  $hypprot);
                }
            }
        }
    }  # End of each prot
} # End sub

sub SortAndGroupC4Report {
    my ($ExoReports,$OV_authorized,$info) = @_;
    my $name           = $info->[0];


    my $Group_ER      = [];
    foreach my $ER (@$ExoReports) {
        if ($ER->get_raw_score() >= 200) {
            push(@$Group_ER,[$ER]);
        } else {
            my $name           = $info->[0];
            my $contigname     = $info->[1];
            my $strand         = $info->[3];
            my $match_orf_info = $info->[7];

            # If we $match_orf_info is an array we have the start and the end of the an ORF
            if (!(ref($match_orf_info) eq 'ARRAY' && ref($match_orf_info->[0]) eq 'ARRAY')) {
                my $emptyorf = new PirObject::EmptyOrf(
                    start        => $match_orf_info->[0],
                    end          => $match_orf_info->[1],
                    strand       => $strand,
                    evalue       => 9999,
                    contigname   => $contigname,
                    similar_prot => $name,
                );
                push(@$EMPTYORFS,$emptyorf);
            } else {
                # If we $match_orf_info is an array of array we have the start and the end of the an ORF for each ORF
                # Iterate over each ORF
                for (my $i = 0; $i < @$match_orf_info; $i++) {
                    my $orf_info = $match_orf_info->[$i];
                    my ($start,$end,$evalue)        = ($orf_info->[1]->[0],$orf_info->[1]->[1],$orf_info->[0]->[2]);
                    my ($target_start,$target_stop) = ($ER->get_target_start(),$ER->get_target_stop());
                    # TODO; should we use check of OV here?
                    # Next if $start is not between $target_start and $target_stop
                    # next if !($start >= $target_start && $start <= $target_stop);
                    my $emptyorf = new PirObject::EmptyOrf(
                        start        => $start,
                        end          => $end,
                        strand       => $strand,
                        evalue       => 9999,
                        contigname   => $contigname,
                        similar_prot => $name,
                    );
                    push(@$EMPTYORFS,$emptyorf);
                }
            }
        }
    }

    for (my $i = 0; ;) {
        last if !($i < scalar(@$Group_ER));
        my $GR        = $Group_ER->[$i];
        my $GR_ini    = $GR->[0];
        my $GR_fin    = $GR->[-1];
        my $p_startGR = $GR_ini->get_query_start();
        my $p_endGR   = $GR_fin->get_query_stop();
        my $g_startGR = $GR_ini->get_target_start();
        my $g_endGR   = $GR_fin->get_target_stop();

        my $best_sol     = &DefineBestSol($Group_ER,$p_startGR,$p_endGR,$g_startGR,$g_endGR,$OV_authorized,$i);

        $i++ if !(defined($best_sol));
        next if !(defined($best_sol));

        # Check if best solution of $i have for best solution $i
        my $GR_bs        = $Group_ER->[$best_sol];
        my $GR_ini_bs    = $GR_bs->[0];
        my $GR_fin_bs    = $GR_bs->[-1];
        my $p_startGR_bs = $GR_ini_bs->get_query_start();
        my $p_endGR_bs   = $GR_fin_bs->get_query_stop();
        my $g_startGR_bs = $GR_ini_bs->get_target_start();
        my $g_endGR_bs   = $GR_fin_bs->get_target_stop();
        my $best_sol_bs  = &DefineBestSol($Group_ER,$p_startGR_bs,$p_endGR_bs,$g_startGR_bs,$g_endGR_bs,$OV_authorized,$best_sol);

        $i++ if $best_sol_bs != $i;
        next if $best_sol_bs != $i;
        my $len_GR_bs = scalar(@$GR_bs);
        ($p_startGR < $p_startGR_bs ?
                splice(@$GR,@$GR,0,@$GR_bs) # add $best_sol at end
              : splice(@$GR,0,0,@$GR_bs));  # add $best_sol at begin
        splice(@$Group_ER,$best_sol,1);
        next;
    }
    return $Group_ER;
}

sub DefineBestSol {
    my ($Group_ER_cp,$p_startGR,$p_endGR,$g_startGR,$g_endGR,$OV_authorized,$i) = @_;

    my ($best_sol,$min_dist) = (undef,undef);
    for (my $j = @$Group_ER_cp - 1; $j >= 0 ; $j--) {
        # Def best solution if several solution ws found choose the closest in genome
        next if $i == $j;
        my $GR_ini_cp    = $Group_ER_cp->[$j]->[0];
        my $GR_fin_cp    = $Group_ER_cp->[$j]->[-1];
        my $p_startGR_cp = $GR_ini_cp->get_query_start();
        my $p_endGR_cp   = $GR_fin_cp->get_query_stop;
        my $g_startGR_cp = $GR_ini_cp->get_target_start();
        my $g_endGR_cp   = $GR_fin_cp->get_target_stop();

        if ($p_startGR < $p_startGR_cp) {
            next if !($p_startGR_cp > $p_endGR || $p_endGR - $p_startGR_cp < $OV_authorized);
            my $dist     = abs($g_endGR - $g_startGR_cp);
               ($min_dist,$best_sol) = ($dist,$j) if !(defined($min_dist));
               ($min_dist,$best_sol) = ( $dist < $min_dist ? ($dist, $j): ($min_dist, $best_sol));
        }
        elsif ($p_startGR > $p_startGR_cp) {
            next if !($p_startGR > $p_endGR_cp || $p_endGR_cp - $p_startGR < $OV_authorized);
            my $dist  = abs($g_endGR_cp - $g_startGR);
               ($min_dist,$best_sol) = ($dist,$j) if !(defined($min_dist));
               ($min_dist,$best_sol) = ( $dist < $min_dist ? ($dist, $j) : ($min_dist, $best_sol));
        }
    }
    return $best_sol;
}

sub Create_alternative_prot {
    my ($dna_seq,$exon_start_end,$i,$name) = @_;

     my $r_dna_seq = $dna_seq;
        $r_dna_seq =~ tr/ACGT/TGCA/;
        $r_dna_seq = reverse $r_dna_seq;
    my ($with_exons,$without_exons,$count) = ("","",0);
    foreach my $exon_coord (@$exon_start_end) {
       my $use_seq   = ( $exon_coord->[2] eq "-" ? $r_dna_seq : $dna_seq );
       my ($start,$stop) = ( $exon_coord->[2] eq "-" ?
                           ( (length($use_seq) + 1 - $exon_coord->[0]),(length($use_seq) + 1 - $exon_coord->[1]))
                           : ($exon_coord->[0],$exon_coord->[1]));
        my $exon_seq = substr($use_seq,$start-1,$stop-$start+1);
        $with_exons    .= $exon_seq;
        $without_exons .= $exon_seq if $count ne $i;
        $count++;
    }
    my $prot_with_exons     = ">With_exon\n";
       $prot_with_exons    .= &TranslateInProt($with_exons);
    my $prot_without_exons  = ">Without_exon\n";
       $prot_without_exons .= &TranslateInProt($without_exons);
    my $proteins            = "$prot_with_exons\n$prot_without_exons";

    my $fileprot = "$TMPDIR/Exonerate/for_blast_${name}_e$i";

    unlink($fileprot) or die "Impossible to delete $fileprot\n" if (-f $fileprot);
    # Create protein for exonerate
    my $FILEPROT = new IO::File ">$fileprot" or die "Impossible to open $fileprot\n";
    print $FILEPROT $proteins, "\n";
    $FILEPROT->close() or die "Impossible to close $fileprot\n";

    return $fileprot;
}

sub Choose_best_solution {
    # return 1 if we must to delete the exon else 0
    my ($file_for_blast,$protein_file,$i,$name) = @_;

    # 1. FORMATDB
    my $base_name    = "$TMPDIR/Exonerate/mf_${name}_e$i";
    unlink($base_name) or die "Impossible to delete $base_name\n" if (-f $base_name);
    my $command      = "$MAKEBLASTDBPATH -in $protein_file -dbtype nucl -out $base_name >/dev/null 2>/dev/null";
    print "$command\n" if $DEBUG;
    my $resformatdb  = system($command);

    # 2. BLAST
    my $output         = "$TMPDIR/Exonerate/out_${name}_e$i";
    unlink($output) or die "Impossible to delete $output\n" if (-f $output);
    my $cmdblast = "nice -19 $BLASTPATH -outfmt 5 -matrix $MATRIX -db $base_name -query $file_for_blast -out $output 2> $TMPDIR/Exonerate/blasterr_1.txt";
    print "$cmdblast\n" if $DEBUG;
    my $resblast = system ($cmdblast);

    my $searchfh = new IO::File "<$output"
       or die "Can't read from '$output': $!\n";

    my ($eval_with_exons,$eval_without_exons) = (9999,9999); # Very bad evalue
    while (my $result = PirObject::BlastOutput->FileHandleToObject($searchfh)) {
        my $iterations = $result->BlastOutput_iterations() || next;
        foreach my $iteration (@$iterations) {
           my $rdesc = $iteration->Iteration_query_def() ||   # priority to iteration's value
                       $result->BlastOutput_query_def()  ||
                       "Unknown Query Description";

           my $hitslist = $iteration->Iteration_hits();
           return if @$hitslist < 1; # normally, only one.

           # Note: the significance() method is defined in Hit.pir
           my @hits = sort { &CompareHighPrecisionFloats($a->significance(), $b->significance() ) } @$hitslist;
           next if !$hits[0];
           my $evalue          = $hits[0]->significance(); # Get the e-value
           $eval_with_exons    = $evalue if $rdesc eq "With_exon";
           $eval_without_exons = $evalue if $rdesc eq "Without_exon";
        }
    }
    $searchfh->close();
    return ( $eval_without_exons < $eval_with_exons  ? 1 : 0);
}

sub CheckRealIntrons {
    my ($hypprot,$seq,$name,$contigname) = @_;

    my $exons   = $hypprot->get_exons();
    my $introns = $hypprot->get_introns();
    my $len_seq = length($seq);
    my ($exons_to_rm,$introns_to_rm) = ([],[]);
    for (my $i = 0;  $i < scalar(@$introns) ; $i++) {
        my $intron    = $introns->[$i];
        next if !$intron;
        my $exon      = $exons->[$i];
        my $next_exon = $exons->[$i + 1];
        my $isMinus   = ($intron->get_strand() eq "+" ? 0 : 1);

        my $intron_start = $intron->get_start();
        my $intron_end   = $intron->get_end();
           $intron_end   = $intron_end - 2 if $isMinus;
        my $intron_len   = !$isMinus ? ($intron_end - $intron_start + 1 ) : ($intron_start - $intron_end - 1 );

        &LocateIntrons($seq,$intron,undef,$name,$contigname,$isMinus) if $LVL_INTRON != 2;
        my $intron_type = $intron->get_type();
        next if $intron_type;

        # Special case for last intron
        if ($i == (scalar(@$introns) - 1)){
            push(@$exons_to_rm,$i+1);
            push(@$introns_to_rm,$i);
        } else {
            next if $intron_len % 3 != 0;
            my $intron_seq   = &GetProteinForGeneWithoutIntrons($seq, $intron_start, $intron_end, $isMinus);
            next if length($intron_seq) == 0;
            next if $intron_seq =~ m/\*/;

            # Add comment for insertion
            my $exoStart = $intron->get_exoStart();
            my $exoEnd   = $intron->get_exoEnd();
            my $max_ins_permitted = ( $exoStart && $exoEnd && $exoStart < $exoEnd  ?
                                            $INSERTION + abs($exoStart - $exoEnd)
                                          : $INSERTION );
            my $intron_len_aa = $intron_len/3;

            # Changed info for exon
            my $number_frameshift = ($exon->get_frameshiftsize() || 0) + ($next_exon->get_frameshiftsize() || 0);
            $exon->set_frameshiftsize($number_frameshift) if $number_frameshift != 0;
            $exon->set_dnaend($next_exon->get_dnaend());
            $exon->set_insertion($intron_len_aa) if $intron_len_aa >= $max_ins_permitted;
            push(@$exons_to_rm,$i+1);
            push(@$introns_to_rm,$i);
        }
    }
    # Removed exon and intron if necessary
    for (my $i = @$exons - 1; $i >= 0 ; $i--) {
        splice(@$exons, $i, 1) if grep($_ == $i, @$exons_to_rm);
    }
    for (my $i = @$introns - 1; $i >= 0 ; $i--) {
        splice(@$introns, $i, 1) if grep($_ == $i, @$introns_to_rm);
    }
}

sub CheckLenIntrons {
    my $hypprot = shift;

    my $introns      = $hypprot->get_introns();
    my $BadList      = &BadIntron($introns);
    return [$hypprot] if scalar(@$BadList) == 0;
    my $hypprot_list = &SplitEachProt($BadList,$hypprot);
    return $hypprot_list;
}

sub BadIntron {
    my $introns = shift;

    my $BadList = [];
    for (my $i = 0;  $i < scalar(@$introns) ; $i++) {
        my $intron    = $introns->[$i];
        next if !$intron;

        my $idbyRNAw = $intron->get_idbyRNAw();
        my $APC = $idbyRNAw;
        my $APL = $APC->get_annotpairlist();
        my $nb_intron = scalar(@$APL);
        $nb_intron = 1 if $nb_intron == 0;
        my $isMinus   = ($intron->get_strand() eq "+" ? 0 : 1);

        my $intron_start = $intron->get_start();
        my $intron_end   = $intron->get_end();
           $intron_end   = $intron_end - 2 if $isMinus;
        my $intron_len   = !$isMinus ? ($intron_end - $intron_start + 1) : ($intron_start - $intron_end - 1);
        next if $intron_len >= ($MININTRONSIZE * $nb_intron) && $intron_len <= ($MAXLENINTRONS * $nb_intron);
        push(@$BadList,$i);
    }
    return $BadList;
}

sub SplitEachProt {
    my ($BadList,$hypprot)= @_;

    my $hypprot_list = [];
    for (my $i = @$BadList - 1; $i >= 0 ; $i--) {
        my $Bad = $BadList->[$i];
        my $new_hypprot = $hypprot->DeepClone();

        # Treat exons.
        my $introns     = $hypprot->get_introns();
        my $nb_intron   = scalar(@$introns);
        next if ($nb_intron == 0);
        my $exons        = $hypprot->get_exons();
        my @new_exons_p1 = @$exons[$Bad+1..$nb_intron];
        my @new_exons_p2 = @$exons[0..$Bad];
           $new_hypprot->set_exons([@new_exons_p1]);
           $new_hypprot->set_altstart("");
           $new_hypprot->set_exostart("");
           $hypprot->set_exons([@new_exons_p2]);

        # Treat introns.
        my @new_introns_p1 = $Bad == $nb_intron - 1 ? () : @$introns[$Bad+1..$nb_intron-1];
        my @new_introns_p2 = $Bad == 0              ? () : @$introns[0..$Bad-1];
        $new_hypprot->set_introns([@new_introns_p1]);
        $hypprot->set_introns([@new_introns_p2]);
        push(@$hypprot_list,$new_hypprot);
        push(@$hypprot_list,$hypprot) if $i == 0;
    }
    # Re-Defined start, end and firstExonerateMatch.
    foreach $hypprot (@$hypprot_list) {
        my $exons = $hypprot->get_exons();
        my ($start,$end,$ExoStart) = ($exons->[0]->get_dnastart(),$exons->[-1]->get_dnaend(),$exons->[0]->get_FirstExoMatch());
        $hypprot->set_start($start);
        $hypprot->set_end($end);
        $hypprot->set_firstExonerateMatch($ExoStart);
    }
    return $hypprot_list;
}
sub Add_comment_for_transpliced {
    my ($contigname,$name,$exon_start_end) = @_;

    # Add comment about start and end of gene
    my $first_exon   = @$exon_start_end[0];
    my $last_exon    = @$exon_start_end[-1];
    my ($start,$end) = (@$first_exon[0], @$last_exon[1]);
    my $arrow        = @$first_exon[2] eq "+" ? "==>" : "<==";


    my $full_gene = new PirObject::AnnotPair(
                                                 type      => "G",
                                                 genename  => $name,
                                                 startpos  => $start,
                                                 endpos    => $end,
                                                 startline => ";; G-$name $arrow /note= likely split by linearization of a circular-mapping genome",
                                                 endline   => ";; G-$name  $arrow end",
                                                 );
    &AddAnnotToPirMaster($contigname,$full_gene);

}

sub MakeApCollection {
    my ($OV,$contigname) = @_;

    my $APC = new PirObject::AnnotPairCollection(
                  genename   => "Intron",
                  contigname => $contigname,
                  annotpairlist => [],
    );

    my $APL = $APC->get_annotpairlist();
    foreach my $info_who_overlap (@$OV){
       foreach my $features_who_overlap (@$info_who_overlap ){
           my $AP = $features_who_overlap->[2];
           push(@$APL,$AP);
       }
    }
    return $APC;
}

sub CommentAllRNAwIntron {
    my $contigs   = $pirmaster->get_contigs();

    foreach my $contig (@$contigs) {
    my $annotations = $contig->get_annotations();
    foreach my $annot (@$annotations) {
        my $genename = $annot->get_genename();
        next if $genename && $genename ne "comment";
        my $start_line = $annot->get_startline();
        next if $start_line !~ m/group=/;
        $annot->set_type("C")
        }
    }
}

#------------------------------------#
# Subs for processing ORFs => genes  #
#------------------------------------#

sub TreatGeneFusion {
    # This function is supposing to find start
    # to find end for gene with exons and introns
    # to treat the case of gene fusion
    &AddInfoAboutGeneFusion($HYPPROTS);

    foreach my $hypprot (@$HYPPROTS) {
        my $strand      = $hypprot->get_strand();
        my $isMinus     = ($strand == 1 ? 0 : 1);
        my $contig      = $pirmaster->GetContigByName ($hypprot->get_contigname());
        my $exons       = $hypprot->get_exons();
        my $idByExo     = (scalar(@$exons) != 0 ? 1 : 0);

        my $seq         = $contig->get_sequence();
        my $len_seq     = length($seq);

        # We have a gene fusion.
        my $isFusioned = $hypprot->get_hypfusiongene() || undef;
        if ($isFusioned) {
            &TreatmentOfFusion($hypprot,$contig,$isMinus,$len_seq,$exons);
        }
    } # End foreach $hypprot
} # End function

sub AddInfoAboutGeneFusion {
    my $hypprots = shift;

    foreach my $hypprot1 (@$hypprots) {
        my $contigname1 = $hypprot1->get_contigname();

        my $infofusiongene1 = $hypprot1->get_hypfusiongene() || undef;
        next if !$infofusiongene1;

        my $namefusiongene1 = $infofusiongene1->get_name() || undef;
        next if !$namefusiongene1;

        my $strand1        =  $hypprot1->get_strand();
        my ($start1,$end1) = ($hypprot1->get_start(),$hypprot1->get_end());
           ($start1,$end1) = ($end1,$start1) if $strand1 != 1;

        foreach my $hypprot2 (@$hypprots) {
            next if $hypprot1 eq $hypprot2;

            my $contigname2 = $hypprot2->get_contigname();
            next if $contigname1 ne $contigname2;

            my $genename2   = $hypprot2->get_name();
            next if $genename2 ne $namefusiongene1;

            my $strand2        =  $hypprot2->get_strand();
            my ($start2,$end2) = ($hypprot2->get_start(),$hypprot2->get_end());
               ($start2,$end2) = ($end2,$start2) if $strand2 != 1; ;

            next if $strand1 != $strand2;
            next if ( $start2 < $start1 && $end2 < $start1 ) || ($start2 > $end1 && $end2 > $end1);

            my $start_f = $hypprot2->get_blaststart() || $hypprot2->get_exostart();
            $infofusiongene1->set_start($start_f);
            $infofusiongene1->set_end($hypprot2->get_end());
        }
    }
}

sub TreatmentOfFusion {
    my $hypprot   = shift;
    my $contig    = shift;
    my $isMinus   = shift;
    my $len_seq   = shift;
    my $exons     = shift;
    my $idByExo   = (scalar(@$exons) != 0 ? 1 : 0);

    my $start_gene   = $hypprot->get_start();
       $start_gene   = ( $isMinus ? $len_seq - $start_gene + 1 : $start_gene);
    my $fusion_info  = $hypprot->get_hypfusiongene();
    my $startwarning = $hypprot->get_startwarning() || "";
    my $start_fusion = $fusion_info->get_start();
    return if !(defined($start_fusion));
       $start_fusion = ( $isMinus ? $len_seq - $start_fusion + 1 : $start_fusion);
    my $fusion_name  = $fusion_info->get_name();

    # Add comment for the second gene
    if ($start_gene > $start_fusion) {
        my $simi_start = $hypprot->get_blaststart() || $hypprot->get_exostart();
        $hypprot->set_start($simi_start);
        my $first_exon =  $exons->[0]          if $idByExo;
        $first_exon->set_dnastart($simi_start) if $idByExo;
        $startwarning .= $startwarning ne "" ?
                         " / contiguous and in phase with $fusion_name"
                         : "contiguous and in phase with $fusion_name";
        $hypprot->set_startwarning("$startwarning") if $startwarning;
        $hypprot->set_posiffusion(2);
        return;
    }

    $hypprot->set_posiffusion(1);
    # Adjust end if it's first gene
    my $newendpos  = ( $isMinus ? $len_seq - $start_fusion + 2 : $start_fusion - 1);
    $hypprot->set_end($newendpos);

    # Adjust end of last exon
    my $end_exon = $exons->[-1]       if $idByExo;
    $end_exon->set_dnaend($newendpos) if $idByExo;
}

#-------------------------------------------------#
# Subs for making annotations of mini exons       #
#-------------------------------------------------#

sub AnnotateMiniExonsByHMM {
    foreach my $hypprot (@$HYPPROTS) {
        my $Name       = $hypprot->get_name();
        next if (not (defined ($Name)) or ($Name eq ""));

        # Def var for file name.
        my $Flag       = $1 if  scalar($hypprot) =~ m/0x(.+)\)/;

        # Extract Seq and ReverseSeq
        my $Contigname    = $hypprot->get_contigname();
        my $Contig        = $pirmaster->GetContigByName($Contigname);
        my $Seq           = $Contig->get_sequence();
        my $ReverseSeq    = $Seq;
           $ReverseSeq    =~ tr/ACGT/TGCA/;
           $ReverseSeq    = reverse $ReverseSeq;

        my ($Introns,$Exons)  = ($hypprot->get_introns(),$hypprot->get_exons());
        next if scalar(@$Exons) < 2; # For protein without exon/intron
        # Def control var.
        my ($GroupI,$GroupII) = ({},{});
        my ($NbChange,$MakeAli,$DefIntron) = (0,1,1);
        my ($ThisProt,$Align,$PP,$PercentId,$AliSeq,$protaln) = ("","","","","","");

        INTRON: for (my $i = 0; $i < @$Introns; $i++) {
            my $ShortName  = "${Name}_$Flag";
            if ($MakeAli == 1) {
                # Make Ali with HMMalign, remake ali if exon was add
                ($Align,$PP,$PercentId,$AliSeq,$protaln) = &CreateAlignForMiniEx($Exons,$Introns,$Seq,$hypprot,$Name,$ShortName,$NbChange);
                next if $Align eq "Frame-Shift-Detected";

                # To redefine get_trimIndexFive
                &DefEachStartInHMM(&ReadStockholmMultAligns($protaln),$hypprot);
                $MakeAli = 0;
            }
            my $Intron    = $Introns->[$i];
            my $IntronPos = $Intron->get_intronpos();
            my $isMinus   = $Intron->get_strand() eq "+" ? 0 : 1;
            my $UseSeq    = $isMinus ? "$ReverseSeq" : "$Seq";
            my $LenSeq    = length($Seq);
            my ($HypprotSeq,$IntronPosAli,$LenAli) = &DefineSeqOfHypprotAndPosOfIntronInAlignment($Align,$IntronPos,$hypprot->get_trimIndexFive());
            my $Exon_p = @$Exons[$i]   || next;
            my $Exon_n = @$Exons[$i+1] || next;

            # Make sub-alignement
            my ($SubAliHomo,$IntronPosSub,$Sub_PP,$Sub_Ali)  = &MakeSubAlignment($Align,$HypprotSeq,$IntronPosAli,$Exon_p,$Exon_n,$PP,$AliSeq);
            # Use HMM in order to def missing exons
            my ($LenAdj_p,$Dash_p,$LenAdj_n,$Dash_n,$id_HMM) = &DefAdjIntronByHMM($Sub_PP,$Sub_Ali,$IntronPosSub);
            # Locate Intron by RNAweasel.
            my $apc = $Intron->get_idbyRNAw() || die "idbyRNAw() is Empty\n";
            my $apl = $apc->get_annotpairlist();
            my $NbIntron = scalar(@$apl);
            # Make Sub Ali
            my $SubAliProt = &RemoveHypprotInAlignment($SubAliHomo);
            # Percent of each aa on each pos in homologous prot
            my $Percent    = &AaPercentInHomologous($SubAliHomo);

            # Special case if the sequence around the exon/intron junction
            # is the same between my_prot and the closest homologous prot,
            # only if there is one intron or less.
            if ($NbIntron < 2)  {
                next if &SameSeqAroundExonIntronJunction($SubAliHomo,$Sub_Ali,$IntronPosSub,$LenAdj_p,$LenAdj_n) ;
            }

            if ($NbIntron >= 2 && $LenAdj_p == 0 && $LenAdj_n == 0) {
                # Indicate if the position is conserved on hypprot
                # compare hypprot aa with the other aa in alignment
                my $ConservedSeq      = &CompareEachPosOfHypprotWithHomologous($SubAliProt,$Percent);
                # Use old method in order to def missing exons.
                ($LenAdj_p,$LenAdj_n) = &DefineAdjustIntron($ConservedSeq,$IntronPosSub,$PercentId);
            }

            my $LenAdj_f = $LenAdj_p + $LenAdj_n;
            next if $LenAdj_f == 0;
            if ( $LenAdj_f >= 20) {
               $Intron->set_comment("Potentially missing exon (~$LenAdj_f)");
               next;
            }
            my ($SubPercent,$ExonAli)  = &DefineSeqAndAliOfResearchExon($Percent,$SubAliHomo,$IntronPosSub,$LenAdj_p,$LenAdj_n);

            next if $NbIntron < 2 && $LenAdj_f <= 2; # Initial annotation is considered to be true
            my ($Seq_p,$Seq_n) = &AdjustExonsIntron($Intron,$Exon_p,$Exon_n,$LenAdj_p,$LenAdj_n,"deconstruct",$isMinus,$UseSeq,$Dash_p,$Dash_n);
            if ($Seq_n eq "") {
              &AdjustExonsIntron($Intron,$Exon_p,$Exon_n,$LenAdj_p,$LenAdj_n,"reconstruct",$isMinus,$UseSeq,$Dash_p,$Dash_n);
              next;
            }
            &SortAPL($apl,$isMinus) if $NbIntron > 1;

            # Create HMM model
            my ($More_p,$More_n)  = (2,2);
            my ($ProtHMM,$lenHMM) = &CreateFileForHMMBuild($Align,$Introns,$i,$NbChange,$ShortName,$LenAli,$LenAdj_p,$LenAdj_n,$Dash_p,$Dash_n,$More_p,$More_n,$hypprot->get_trimIndexFive());
            my ($ListHypExons)    = &FindHypMiniExon($UseSeq,$Intron,$SubPercent,$isMinus,$apl,$Exon_p,$Exon_n,$ProtHMM,$Seq_p,$Seq_n,$More_p,$More_n,$lenHMM,$NbIntron);
            # If no Hyp exons was return
            if (scalar(@$ListHypExons) == 0) {
              &AdjustExonsIntron($Intron,$Exon_p,$Exon_n,$LenAdj_p,$LenAdj_n,"reconstruct",$isMinus,$UseSeq,$Dash_p,$Dash_n);
              next;
            }

            # Add score for splice site
            &DefineEachIntronType($ListHypExons,$apl,$isMinus,$LenSeq);
            ($GroupI,$GroupII) = &AddSpliceScore($UseSeq,$ListHypExons,$isMinus,$Exon_p,$Exon_n,"intron${i}_it$NbChange",$ShortName,$GroupI,$GroupII);
            @$ListHypExons   = sort {
                                 &CompareHighPrecisionFloats($a->{"gEvalue"},$b->{"gEvalue"});
                               } @$ListHypExons;
            # Select BestSol and add mini exon
            my $BestSol      = shift(@$ListHypExons);

            # Reajust Exon_p and Exon_n if core == 0
            if ($BestSol->{"core"} == 0) {
                &ReajustExonAndIntron($Introns,$Exons,$i,$BestSol,$isMinus)
            }
            else {
                &AddMiniExon($Introns,$Exons,$i,$BestSol,$isMinus);
                ($DefIntron,$MakeAli) = (0,1);
                $NbChange++;
                $i--;
            }
        }
    }
}

sub CreateAlignForMiniEx {
    my ($Exons,$Introns,$Seq,$hypprot,$Name,$ShortName,$NbChange) = @_;

    my $ProtSeq = &GetProteinSequenceAndIntronsPos($Exons,$Introns,$Seq,$hypprot);
    return "Frame-Shift-Detected" if $ProtSeq eq "Frame-Shift-Detected";
    $ProtSeq    = substr($ProtSeq, 0, -1);
    # $ProtSeq    =~ s/\*/n/g;

    # Create Seq for HMM and run HMM
    my ($this_fasta,$homo_fasta) = &ExtractLibSeqs($hypprot,$ProtSeq);
    my $ProtAln  = &RunHMM("${Name}_$NbChange",$ShortName,$this_fasta,$homo_fasta,"_For_Exo");

    my $StocAln  = &ReadStockholmMultAligns($ProtAln);
    my ($PP_Info,$AliSeq)  = ("","");
    foreach my $MultAln ( @$StocAln ) {
        my $AliSeqs = $MultAln->get_alignedSeqs();
        foreach my $Ali (@$AliSeqs) {
            my $id = $Ali->get_seqId();
            next if $id !~ m/myProt/;
            $PP_Info = $Ali->get_PP();
            $AliSeq  = $Ali->get_sequence();
        }
    }

    # Run Umac...
    my $ProtAli  = $ProtAln;
       $ProtAli  =~ s/.aln/.ali/;
    my $cmd = "$UMACPATH -i '$ProtAln' -o '$ProtAli' -f clustal >/dev/null 2>/dev/null";
    print "\n$cmd\n" if $DEBUG;

    my $resultat = system("$cmd");
    my $hascoredump = ($resultat & 128) >> 7;  # 0 if no core dump, 1 if core dump
    my $signal      = $resultat & 127;  # SIGNAL received by subprocess, from 0 to 127;
    my $returncode  = $resultat >> 8;   # exit status of subprogram
    if ($returncode > 1 || $signal > 0 || $hascoredump == 1) {
        print "Error in execution of Umac in sub CreateAlignForMiniEx...\n";
    }

    my $Alignio = new Bio::AlignIO(-format => 'clustalw',
                                   -file   => $ProtAli);

    my $Align     = $Alignio->next_aln();
    my $PercentId = $Align->percentage_identity();
    return ($Align,$PP_Info,$PercentId,$AliSeq,$ProtAln);
}

sub CreateFileForHMMBuild {
    my ($Align,$Introns,$i,$NbChange,$ShortName,$LenAli,$LenAdj_p,$LenAdj_n,$Dash_p,$Dash_n,$More_p,$More_n,$TrimIndexFive) = @_;

    my $Intron    = $Introns->[$i];
    my $IntronPos = $Intron->get_intronpos() - $TrimIndexFive;
    my $Pos_p     = $IntronPos - $LenAdj_p ;
    my $Pos_n     = $IntronPos + $LenAdj_n ;

    foreach my $Seq ($Align->each_seq) {
        my $id = $Seq->display_id();
        next if $id ne "myProt";
        $Pos_p = $Align->column_from_residue_number( $id, $Pos_p) + $Dash_p - $More_p;
        $Pos_n = $Align->column_from_residue_number( $id, $Pos_n) - $Dash_n + $More_n;
    }
    my $SubAlign = $Align->slice($Pos_p,$Pos_n);

    my $FileName   = "$TMPDIR/HMM_For_Exo/$ShortName/i${i}_$NbChange.fas";
    my $SubAliFile = new IO::File ">$FileName" or die "Impossible to open $FileName\n";
    my $len_HMM    = $Pos_n - $Pos_p + 1;
    foreach my $Seq ($SubAlign->each_seq) {
        my $id       = $Seq->display_id();
        my $Sequence = $Seq->seq();
        next if $id eq "myProt";
        print $SubAliFile ">$id\n";
        print $SubAliFile "$Sequence\n";
    }
    $SubAliFile->close;

    # 1. Run Umac and HMMBuild...
    my $AliOut  = "$TMPDIR/HMM_For_Exo/$ShortName/i${i}_$NbChange.ali";
    my $ProtHMM = "$TMPDIR/HMM_For_Exo/$ShortName/i${i}_$NbChange.hmm";
    &RunUmacAndHMMBuild($FileName,$AliOut,$ProtHMM,"CreateFileForHMMBuild");

    return ($ProtHMM,$len_HMM);
}

sub RunUmacAndHMMBuild {
    my ($FileName,$AliOut,$ProtHMM,$SubName) = @_;

    # 1. Run Umac...
    my $cmd = "$UMACPATH -i '$FileName' -o '$AliOut' -f stockholm >/dev/null 2>/dev/null";
    print "\n$cmd\n" if $DEBUG;

    my $resultat = system("$cmd");
    my $hascoredump = ($resultat & 128) >> 7;  # 0 if no core dump, 1 if core dump
    my $signal      = $resultat & 127;  # SIGNAL received by subprocess, from 0 to 127;
    my $returncode  = $resultat >> 8;   # exit status of subprogram
    if ($returncode > 1 || $signal > 0 || $hascoredump == 1) {
        print "Error in execution of Umac in sub $SubName...\n";
    }

    # 2. Run HMMBuild...
    $cmd = "nice -19 $HMMBUILDPATH --amino $ProtHMM $AliOut >/dev/null 2>/dev/null";
    print "\n$cmd\n" if $DEBUG;

    $resultat = system("$cmd");
    $hascoredump = ($resultat & 128) >> 7;  # 0 if no core dump, 1 if core dump
    $signal      = $resultat & 127;  # SIGNAL received by subprocess, from 0 to 127;
    $returncode  = $resultat >> 8;   # exit status of subprogram
    if ($returncode > 1 || $signal > 0 || $hascoredump == 1) {
        print "Error in execution of HMMBuild in sub $SubName...\n";
    }
}

sub RunHMMSearchForMiniEx {
    my ($prothmm,$ListHypExons,$prev_seq,$next_seq,$More_p,$More_n,$hmmLen,$z) = @_;

    my $ShortName = $prothmm;
       $ShortName =~ s/.hmm$//;

    my $FastaName = "${ShortName}_z$z.fas";
    my $fasta_fh = new IO::File ">$FastaName" or die "Impossible to open $FastaName\n";
    $More_p = $More_p;
    $prev_seq = substr($prev_seq,length($prev_seq)-($More_p+1),$More_p+1);
    $next_seq = substr($next_seq,0,$More_n);

    my $i = 0;
    return [] if scalar(@$ListHypExons) == 0;
    foreach my $exon (@$ListHypExons) {
        my $exon_seq = $exon->{seq} || "";
        my $seq = "${prev_seq}${exon_seq}${next_seq}";
        print $fasta_fh ">Sol_$i\n$seq\n" if $seq !~ m/\*/;
        $i++;
    }
    $fasta_fh->close();

    my $FileRes = "${ShortName}_z$z.res";

    my $cmd = "nice -19 $HMMSEARCHPATH -o $FileRes $prothmm  $FastaName";
    print "\n$cmd\n" if $DEBUG;

    my $resultat = system("$cmd");

    my $hascoredump = ($resultat & 128) >> 7;  # 0 if no core dump, 1 if core dump
    my $signal      = $resultat & 127;  # SIGNAL received by subprocess, from 0 to 127;
    my $returncode  = $resultat >> 8;   # exit status of subprogram
    if ($returncode > 1 || $signal > 0 || $hascoredump == 1) {
        print "Error in execution of HMMsearch \n";
    }

    my $Searchfh  = new IO::File "<$FileRes"
            or die "Can't read from file '$FileRes': $!\n";
    my @tab   = <$Searchfh>;
    $Searchfh->close();

    my $HMMRes = new PirObject::HMMsearchOutput();
       $HMMRes->FillFeaturesFromTextOutput(\@tab);
     my $AllHMMRes =  $HMMRes->get_Iterations()->[0]->get_resume();

    foreach my $Res (@$AllHMMRes) {
        my $id = $Res->get_SequenceId();
           $id =~ s/Sol_//;
           $ListHypExons->[$id]->{'HmmRes'} = $Res;
    }
    for (my $i = @$ListHypExons - 1; $i >= 0 ; $i--) {
        splice(@$ListHypExons, $i, 1) if !$ListHypExons->[$i]->{'HmmRes'};
    }

    for (my $i = @$ListHypExons - 1; $i >= 0 ; $i--) {
        my $Res  = $ListHypExons->[$i]->{'HmmRes'};
        my $Zone = $ListHypExons->[$i]->{'zone'};
        my $alignments = $Res->get_alignments();
        splice(@$ListHypExons, $i, 1) if !(defined($alignments));
        next if !(defined($alignments));

        foreach my $dom (sort keys %$alignments) {
            my $ali = $alignments->{$dom};
            my ($hmmFrom,$hmmTo) = ($ali->get_hmmFrom(),$ali->get_hmmTo());
            my $pos = 2;   #Intern match
            if ($hmmFrom == 1 && $hmmTo != $hmmLen) {
                $pos = 5;  #5' match
            }
            elsif ($hmmFrom != 1 && $hmmTo == $hmmLen) {
                $pos = 3;  #3' match
            }
            elsif ($hmmFrom == 1 && $hmmTo == $hmmLen) {
                $pos = WhichPartWellId($ali,$More_p,$More_n);
            }
            $ali->set_pos($pos);
            if ($pos == 2 || ($hmmFrom > $hmmLen - $More_n) || ($hmmTo   < $More_p+1 )) {
                delete $alignments->{$dom};
                next;
            }
        }
    }
    return $ListHypExons;
}

sub WhichPartWellId {
    my ($HMMAli,$More_p,$More_n) = @_;

    my $ali = $HMMAli->get_ali();
    my $PP  = $ali->[-1];
       $PP  =~ s/\s+PP$//;
       $PP  = substr($PP,$More_p);
       $PP  = substr($PP,0,-$More_n);
    my $lenPP   = length($PP);
    my $LenHalf = (length($PP) % 2 == 1) ?  ($lenPP-1)/2 : $lenPP/2;
    my $FiveSt  = substr($PP,0,$LenHalf);
    my @Five    = split(//,$FiveSt);
    my $FiveSc  = 0;
    foreach my $pos (@Five) {
        $pos = 10 if $pos eq "*";
        $pos = 0  if $pos eq ".";
        $FiveSc += $pos eq "*" ? 10 : $pos;
    }
    my $ThreeSt   = substr($PP,-$LenHalf);
    my @Three     = split(//,$ThreeSt);
    my $ThreeSc    = 0;
    foreach my $pos (@Three) {
        $pos = 10 if $pos eq "*";
        $pos = 0  if $pos eq ".";
        $ThreeSc += $pos eq "*" ? 10 : $pos;
    }
    return 4 if ($ThreeSc == $FiveSc) || (scalar(@Five) == 0 && scalar(@Three));
    return $ThreeSc > $FiveSc ? 3 : 5;
}

sub GetProteinSequenceAndIntronsPos {
    my ($exons,$introns,$seq,$hypprot) = @_;

    my $name         = $hypprot->get_name();
    my $dna_sequence = "";
    my $length_tot   = 0;

    for (my $i = 0 ; $i < scalar(@$exons) ; $i++) {
        my $hasFrameshift = $exons->[$i]->frameshiftsize();
        return "Frame-Shift-Detected" if $hasFrameshift;
        my $start         = $exons->[$i]->dnastart()   || next;
        my $end           = $exons->[$i]->dnaend()     || next;
        my $isMinus       = ($exons->[$i]->strand eq "+" ? 0 : 1);
        ($start,$end)     = ($end,$start) if $isMinus;
        my $length_exon   = $end - $start + 1;
        my $exon_seq      = uc (substr($seq, $start - 1 , $length_exon ));
        my $reverse_exon  = $exon_seq;
           $reverse_exon  =~ tr/ACGT/TGCA/;
           $reverse_exon  = reverse $reverse_exon;
           $dna_sequence .= (!$isMinus ? $exon_seq : $reverse_exon);
        my $start_pos     = int($length_tot/3) + 1;
        $length_tot      += $length_exon;
        my $end_pos       = int($length_tot/3);
        my $phase         = $length_tot % 3;
        $exons->[$i]->set_protstart($start_pos);
        $exons->[$i]->set_protend($end_pos);
        $introns->[$i]->set_intronpos($end_pos) if defined($introns->[$i]);
        $introns->[$i]->set_phase($phase)       if defined($introns->[$i]);
    }

    my $dna_length    = length($dna_sequence);
    return "Frame-Shift-Detected" if $dna_length % 3 != 0;

    my $prot_sequence = &TranslateInProt($dna_sequence,@$introns[0]->get_intronpos());
    $hypprot->set_thisprot($prot_sequence);
    return $prot_sequence;
}

sub DefineSeqOfHypprotAndPosOfIntronInAlignment {
    # In order to define the sequence of the hyppothetical protein
    # and to define the position of intron on the alignment.
    my ($align,$intron_pos_hypprot,$trim_index) = @_;

    my $hypprot_seq        = undef;
    my $pos_in_alignment   = undef;
    my $length_ali         = undef;
    foreach my $seq ($align->each_seq) {
        my $id = $seq->display_id();
        next if $id ne "myProt";
        $hypprot_seq      = $seq;
        $pos_in_alignment = $align->column_from_residue_number( $id, $intron_pos_hypprot - $trim_index);
        $length_ali       = length($seq->seq());
        last;
    }

    return ($hypprot_seq,$pos_in_alignment,$length_ali);
}

sub DefAdjIntronByHMM {
    my ($Sub_PP,$Sub_Ali,$IntronPosSub) = @_;

    # Treat prev Exon
    my $HMM_p    = substr($Sub_PP,0,$IntronPosSub);
    my @HMM_prev = split(//,$HMM_p);
       @HMM_prev = reverse(@HMM_prev);
    my $AA_p     = substr($Sub_Ali,0,$IntronPosSub);
    my @AA_prev  = split(//,$AA_p);
       @AA_prev  = reverse(@AA_prev);

    my ($LenAdj_p,$Dash_p) = (0,0);
    my $id_HMM = 0;
    for (my $i = 0 ; $i < scalar(@HMM_prev) ; $i++) {
        my $PP = $HMM_prev[$i];
        last if $PP eq "*";
        $PP = 0 if $PP eq ".";
        $id_HMM += $PP;
        $LenAdj_p++;
        my $AA = $AA_prev[$i];
        $Dash_p++ if $AA eq "-" || $AA eq ".";
    }

    # Treat next Exon
    my $HMM_n    = substr($Sub_PP,$IntronPosSub);
    my @HMM_next = split(//,$HMM_n);
    my $AA_n     = substr($Sub_Ali,$IntronPosSub);
    my @AA_next  = split(//,$AA_n);

    my ($LenAdj_n,$Dash_n) = (0,0);
    for (my $i = 0 ; $i < scalar(@HMM_next) ; $i++) {
        my $PP = $HMM_next[$i];
        last if $PP eq "*";
        $PP = 0 if $PP eq ".";
        $id_HMM += $PP;
        $LenAdj_n++;
        my $AA = $AA_next[$i];
        $Dash_n++ if $AA eq "-" || $AA eq ".";
    }

    $id_HMM = $id_HMM / ($LenAdj_p+$LenAdj_n) if ($LenAdj_p+$LenAdj_n) != 0;
    $id_HMM = $id_HMM || 10;
    return ($LenAdj_p,$Dash_p,$LenAdj_n,$Dash_n,$id_HMM);
}

sub MakeSubAlignment {
    # In order to make sub-alignment
    my ($align,$hypprot_seq,$IntronPosAli,$PreviousExon,$NextExon,$PP,$AliSeq) = @_;
    my ($PreviousExon_start,$PreviousExon_End) = ($PreviousExon->get_protstart(),$PreviousExon->get_protend());
    my ($NextExon_start,$NextExon_End)         = ($NextExon->get_protstart()    ,$NextExon->get_protend());

    my $IntronPosSub = $PreviousExon_End - $PreviousExon_start;
    my $start        = $IntronPosAli - $IntronPosSub;
       $start        = 1 if $start < 1;

    my $num2         = $NextExon_End-$NextExon_start+1;
    my $end          = $IntronPosAli + $num2;

    my $SubAliHomo    = $align->slice($start, $end);
    my $Len          = $end - $start + 1;
    my $Sub_PP       = substr($PP, $start - 1,$Len);
    my $Sub_Ali      = substr($AliSeq, $start - 1,$Len);

    return ($SubAliHomo,$IntronPosSub,$Sub_PP,$Sub_Ali)
}

# Return 1 if the sequence around the intron is the same
# between the closest species and the current species.
sub SameSeqAroundExonIntronJunction {
    my ($SubAliHomo,$Sub_Ali,$IntronPosSub,$LenAdj_p,$LenAdj_n) = @_;

    my $ClosestSeq      = $SubAliHomo->get_seq_by_id('a')->seq();

    my $StartPos       = $IntronPosSub-$LenAdj_p;
    my $Length         = $LenAdj_p+$LenAdj_n;

    my $ClosestJunction = substr($ClosestSeq,$StartPos,$Length);
    my $CurrentJunction = substr($Sub_Ali,   $StartPos,$Length);

    return 1 if $ClosestJunction eq $CurrentJunction;
}

sub RemoveHypprotInAlignment {
    # Remove hypprot in each sub-alignment
    # and return sub-alignment for hypprot.
    my $align = shift;

    my $sub_ali_prot = undef;
    foreach my $seq ($align->each_seq) {
        next if $seq->display_id() ne "myProt";
        $sub_ali_prot = $seq;
        $align->remove_seq($seq);
        last;
    }
    return $sub_ali_prot;
}

sub AaPercentInHomologous {
    my $homologous_align = shift;

    my $position = [];
    my $length   = $homologous_align->length();
    my $nb_seq   = scalar($homologous_align->each_seq);
    for (my $pos = 1; $pos <= $length; $pos++) {
        my $count    = {};
        my $percent  = {};
        foreach my $seq ($homologous_align->each_seq) {
            my $sub = $seq->subseq($pos, $pos);
            $count->{$sub}++;
        }
        while ( my ($key, $value) = each(%$count) ) {
            my $percentage = ($value/$nb_seq);
            $percent->{ $key } = $percentage;
        }
        $position->[$pos - 1] = $percent;
    }
    return $position;
}

sub CompareEachPosOfHypprotWithHomologous {
    my ($SubAliProt,$PercentInHomo) = @_;

    my $similarity = [];
    my $length     = $SubAliProt->length();
    for (my $pos = 1; $pos <= $length; $pos++) {
        my $aa_in_homo_same_pos = $PercentInHomo->[$pos - 1];
        my $sub = $SubAliProt->subseq($pos, $pos);
        my $aa  = ($aa_in_homo_same_pos->{$sub} ? "-" : $sub );
        $aa = "X" if $sub eq "-" && !$aa_in_homo_same_pos->{$sub};
        $similarity->[$pos - 1] = $aa;
        # Put 1 in $pos when we have a similar aa in hypprot and in homologous protein.
        # Put a letter in $pos when we have a difference between hypprot and homologous.
    }
    return $similarity;
}

sub DefineAdjustIntron {
    # Define portion of non homologous region taking into account
    # of the accepeted separation between 2 disimilarity
    my $conserved_seq  = shift;
    my $intron_pos     = shift;
    my $percent_id     = shift;

    my $string = join('', @$conserved_seq);
    # String is : -------------FLML----------
    # 1 is used for a similar aa in hypprot and in homologous protein.
    # Letters is used for when we have a difference between hypprot and homologous
    my $length       = length($string);

    my $left         = substr($string,0,$intron_pos+1);
    my $one_aa_left  = substr($string,$intron_pos,1);

    my $right        = substr($string,$intron_pos+1);
    my $one_aa_right = substr($string,$intron_pos+1,1);

    my $missing_left  = &DefineMissingLeft($left);
    my $missing_right = &DefineMissingRight($right);

    my $length_left   = length($missing_left);
    my $length_right  = length($missing_right);
    return($length_left,$length_right);
}

sub DefineMissingLeft {
    my $substring = shift;

    my $length = length($substring);
    my $missing_left = "";
    my $max_similarity_accepted = 2;
    my $max_similarity_string = "";
    for (my $i = 0; $i < $max_similarity_accepted; $i++){
         $max_similarity_string .= "-";
    }
    for (my $i = $length; $i > 1; $i--){
        my $aa = substr($substring,$i - $max_similarity_accepted,$max_similarity_accepted);
        last if $aa eq $max_similarity_string;
        $aa = chop($aa) if $i != $max_similarity_accepted;
        $missing_left = $aa . $missing_left;
    }
    return $missing_left;
}

sub DefineMissingRight {
    my $substring = shift;

    my $length                  = length($substring);
    my $missing_right           = "";
    my $max_similarity_accepted = 2;
    my $max_similarity_string   = "";
    for (my $i = 0; $i < $max_similarity_accepted; $i++){
         $max_similarity_string .= "-";
    }
    for (my $i = 0; $i <= $length - $max_similarity_accepted; $i++){
        my $aa = substr($substring,$i,$max_similarity_accepted);
        last if $aa eq $max_similarity_string;
        $aa = substr($substring,$i,1) if $i != $length - $max_similarity_accepted;
        $missing_right .= $aa;
    }
    return $missing_right;
}

sub AdjustExonsIntron {
    my ($intron,$exon_p,$exon_n,$len_adj_p,$len_adj_n,$DeOrReConstruct,$isMinus,$UseSeq,$dash_p,$dash_n) = @_;

    my $first_adjust    = ($DeOrReConstruct eq "deconstruct" ? 1 : 0);
    my $phase           = $intron->get_phase();
    my $adjust_phase_p  = -$phase;
    my $adjust_phase_n  = (3 - $phase);
    $dash_p = -$dash_p if !$first_adjust;
    $dash_n = -$dash_n if !$first_adjust;

    my $LenSeq = length($UseSeq);
    my ($exon_p_start,$exon_p_end) = $isMinus ? &ExPosStrandFW($exon_p,$LenSeq)
                                              : ($exon_p->get_dnastart,$exon_p->get_dnaend);
    my ($exon_n_start,$exon_n_end) = $isMinus ? &ExPosStrandFW($exon_n,$LenSeq)
                                              : ($exon_n->get_dnastart,$exon_n->get_dnaend);

    my $adjust_end     = (-3 * $len_adj_p) + $adjust_phase_p;
       $adjust_end     = -$adjust_end if !$first_adjust;
       $exon_p_end     = $exon_p_end + $adjust_end + ($dash_p*3);
    my $intron_start   = $exon_p_end + 1;
       $exon_p_end     = $LenSeq + 1 - $exon_p_end   if $isMinus;
       $intron_start   = $LenSeq + 1 - $intron_start if $isMinus;
    $exon_p->set_dnaend($exon_p_end);
    $intron->set_start($intron_start);

    my $adjust_start   =  (3*($len_adj_n-1)) + $adjust_phase_n;
       $adjust_start   = -$adjust_start if !$first_adjust;
       $exon_n_start   = $exon_n_start + $adjust_start - ($dash_n*3);
    my $intron_end     = $exon_n_start - 1;
       $exon_n_start   = $LenSeq + 1 - $exon_n_start if $isMinus;
       $intron_end     = $LenSeq + 1 - $intron_end   if $isMinus;
    $exon_n->set_dnastart($exon_n_start);
    $intron->set_end($intron_end);

    return if !$UseSeq;

    # Prev exon
    my $seq_len = length($UseSeq);
    my $prev_start = $exon_p->get_dnastart();
       $prev_start = $seq_len + 1 - $prev_start if $isMinus;
    my $prev_end   = $exon_p->get_dnaend();
       $prev_end   = $seq_len + 1 -  $prev_end if $isMinus;
    my $prev_len   = $prev_end - $prev_start + 1;
    my $prev_mod   = $prev_len % 3;
    my $prev_seq   = substr($UseSeq,$prev_start - 1 + $prev_mod ,$prev_len);
       $prev_seq   = &TranslateInProt($prev_seq);

    # Next exon
    my $next_start = $exon_n->get_dnastart();
       $next_start = $seq_len + 1 - $next_start if $isMinus;
    my $next_end   = $exon_n->get_dnaend();
       $next_end   = $seq_len + 1 -  $next_end  if $isMinus;
    my $next_len   = $next_end - $next_start + 1;
    my $next_mod   = $next_len % 3;
    my $next_seq   = substr($UseSeq,$next_start - 1 ,$next_len - $next_mod);
       $next_seq   = &TranslateInProt($next_seq);

    return($prev_seq,$next_seq);
}

sub DefineSeqAndAliOfResearchExon {
    my ($percent,$sub_ali_homo,$intron_pos_sub,$len_adj_p,$len_adj_n) = @_;

    my $start = $intron_pos_sub - $len_adj_p + 1;
    my $end   = $intron_pos_sub + $len_adj_n;
    my $sub_percent  = [];
      @$sub_percent  = @$percent[$start..$end];
    my $sub_align    = $sub_ali_homo->slice($start + 1, $end + 1);

    return ($sub_percent,$sub_align);
}

sub Arrondi {
    my ($n,$precision) = @_;
    return int((10**$precision)*$n + 0.5) / (10**$precision);
}

sub LocateIntrons {
    my ($seq,$intron,$annot,$name,$contigname,$isMinus) = @_;

    my $isExoIntron = defined($intron) ? 1 : 0;
    my $start       = $isExoIntron ? $intron->get_start() : $annot->get_startpos();
    my $end         = $isExoIntron ? $intron->get_end()   : $annot->get_endpos();
    ($start,$end)   = ($end,$start) if $isMinus;
    my $length      = $end - $start + 1;
    my $intron_seq  = substr($seq,$start - 1,$length);

    my $conf_file       = PirObject::MfAnnotExternalProgs->ImportFromTextFile($EXTCONFIGFILE);
    my $genecomsets     = $conf_file->get_geneprogs(); # This is a HASH genename => <MfAnnotGeneCommandSet>
    my $commandobjectII = $genecomsets->{"IntronII"};
    my $commandobjectI  = $genecomsets->{"IntronI"};

    my $flag = $1 if $intron && scalar($intron) =~ m/0x(.+)\)/;
       $flag = $1 if $annot  && scalar($annot)  =~ m/0x(.+)\)/;

    my $name_of_file      = "$TMPDIR/Intron/$name.$flag.fasta";
    my $outputfile_prefix = "$TMPDIR/Intron/$name.$flag";

    die "The file $name_of_file already exist"
        if (-e $name_of_file);

    # Open the file
    my $intron_file = new IO::File ">$name_of_file" or die "Impossible to open $name_of_file\n";
    # Write into the file
    print $intron_file ">myintron\n";
    print $intron_file $intron_seq;
    # Close the file
    $intron_file->close() or die "Impossible to close $name_of_file\n";

    my $annotpaircollectionsII = &ExecuteExternalProgram($commandobjectII,"IntronII",undef,$name_of_file,"$outputfile_prefix-II.xml");
    my $annotpaircollectionsI  = &ExecuteExternalProgram($commandobjectI,"IntronI",  undef,$name_of_file,"$outputfile_prefix-I.xml");
    my $annotpaircollection    = &MakeOneApCollection($annotpaircollectionsII,$annotpaircollectionsI,$contigname);
    if ($isExoIntron == 1) {
        &AddGroupUseAPC($intron,$annotpaircollection,$isMinus);
        &AddInfoAboutIdIntrons($intron,$annotpaircollection,$contigname,$isMinus);
    }
    else {
        my $APL = $annotpaircollection->get_annotpairlist();
        foreach my $AP (@$APL) {
            my ($AP_start,$AP_end) = ($AP->get_startpos(),$AP->get_endpos());
            &AdjustCoordInWholeMF($annot->get_startpos(),$annot->get_endpos(),$AP,$isMinus);
            my $contig = $pirmaster->GetContigByName($contigname) or die "Can't get contig by name in LocateIntrons\n";
            $AP->set_type("C");
            &AddAnnotToPirMaster($contigname,$AP);
        }
    }
}

sub MakeOneApCollection {
    my ($APCII,$APCI,$contigname) = @_;

    my $APC = new PirObject::AnnotPairCollection(
                             genename      => "Intron",
                             contigname    => $contigname,
                             annotpairlist => [],
    );

    my $annotpairlistarray = $APC->get_annotpairlist();
    foreach my $APCs (@$APCII,@$APCI) {
        my $APL = $APCs->get_annotpairlist();
        push(@$annotpairlistarray, @$APL);
    }
    return $APC;
}

sub AddGroupUseAPC {
    my ($intron,$APC,$isMinus) = @_;

    my $APL = $APC->get_annotpairlist();
    @$APL = $isMinus ? sort { $b->get_startpos() <=> $a->get_startpos() } @$APL
                     : sort { $a->get_startpos() <=> $b->get_startpos() } @$APL;
    foreach my $AP (@$APL) {
        &AddGroupUseAP($intron,$AP);
    }
}

sub AddGroupUseAP {
    my ($intron,$AP) = @_;

    my $AP_startline = $AP->get_startline();
    my $AP_endline   = $AP->get_endline();

    my $type        = $1    if $AP_startline =~ m#group=(.+)#;
    return if !$type;
    #    die "Internal error: external AP does not contain type on startline?!?\n" unless $type;

    my $intron_type  = $intron->get_type() || "";
       $intron_type .= "," if $intron_type;
       $intron_type .= $type;
       $intron->set_type($intron_type);
}

sub AddInfoAboutIdIntrons {
    # Used in order to define position of AP in whole masterfile
    my ($intron,$APC,$contigname,$isMinus,$IsExoIntron) = @_;

    my ($i_start,$i_end) = ($intron->get_start(),$intron->get_end());
    my $APL = $APC->get_annotpairlist();
    foreach my $AP (@$APL) {
        &AdjustCoordInWholeMF($i_start,$i_end,$AP,$isMinus);
    }
    $intron->set_idbyRNAw($APC);
}

sub AdjustCoordInWholeMF {
    my ($start,$end,$AP,$isMinus) = @_;

    my $AP_start  = $AP->get_startpos();
    my $AP_end    = $AP->get_endpos();
    my $new_start = ($isMinus ? $end + $AP_start - 1 : $start + $AP_start - 1);
    my $new_end   = ($isMinus ? $end + $AP_end   - 1 : $start + $AP_end   - 1);
    $AP->set_startpos($new_start);
    $AP->set_endpos($new_end);
}

sub SortAPL {
    my ($apl,$isMinus) = @_;

    @$apl = sort { $a->get_startpos() <=> $b->get_startpos() } @$apl if !$isMinus;
    @$apl = sort { $b->get_startpos() <=> $a->get_startpos() } @$apl if  $isMinus;
}

sub FindHypMiniExon {
    my ($Seq,$Intron,$ResearchSeq,$isMinus,$apl,$Exon_p,$Exon_n,$ProtHMM,$Seq_p,$Seq_n,$More_p,$More_n,$lenHMM,$nbIntron) = @_;

    my $LenSeq      = length($Seq);
    # Intron coord
    my $IntronStart = $Intron->get_start();                           # Bio coord
    my $IntronEnd   = $Intron->get_end();                             # Bio coord
       $IntronStart = $LenSeq + 1 - $IntronStart if $isMinus;
       $IntronEnd   = $LenSeq + 1 - $IntronEnd   if $isMinus;

    my $GroupsZones     = &DefineZone($Intron,$isMinus,$IntronStart,$IntronEnd,$LenSeq);
    my $LenMissingExon = scalar(@$ResearchSeq);
    my $RegionNtLength = $LenMissingExon * 3;

    my $ListHypExonsWoCore = [];
    if ($nbIntron < 2) {
        foreach my $LenPrefix (0 .. $RegionNtLength) {
           foreach my $LenSuffix (0 .. ($RegionNtLength-$LenPrefix)) {
               next if ($LenPrefix+$LenSuffix != $RegionNtLength);
               my $Prefix   = substr($Seq,$IntronStart - 1,$LenPrefix);
               my $Suffix   = substr($Seq,$IntronEnd - $LenSuffix,$LenSuffix);
               my $InfoHypExon = &CreateInfoHypExon($Prefix,"",$Suffix,$LenPrefix,0,$LenSuffix,0,-1,$IntronStart);
               push(@$ListHypExonsWoCore,$InfoHypExon);
           }
        }
    }

    my $ListHypExons = [];
    for (my $i = 0; $i < scalar(@$GroupsZones); $i++) {
        $ListHypExons   = [];
        my $Group = $GroupsZones->[$i];
        foreach my $Zone (@$Group) {
            my $ZoneStart = $Zone->[0];  # Computer coord
            my $ZoneEnd   = $Zone->[1];  # Computer coord
            my $subZone   = $Zone->[2];
            my $ZoneLen   = $ZoneEnd - $ZoneStart + 1;
            next if $ZoneLen < $MINEXONSIZE;
            foreach my $LenPrefix (0 .. ($RegionNtLength - $MINEXONSIZE)) {
                foreach my $LenSuffix (0 .. ($RegionNtLength - $MINEXONSIZE-$LenPrefix)) {
#print STDERR "ZONE = $i    PREFIX = $LenPrefix    SUFF = $LenSuffix TIME = ",(time - $^T),"\n";
                    my $NtLenMissingExon = $RegionNtLength - ($LenPrefix + $LenSuffix);
                    next if $NtLenMissingExon > $RegionNtLength;

                    my $Prefix   = substr($Seq,$IntronStart - 1,$LenPrefix);
                    my $Suffix   = substr($Seq,$IntronEnd - $LenSuffix,$LenSuffix);

                    foreach my $pos ($ZoneStart..($ZoneEnd-$NtLenMissingExon)) {
                        my $Core    = substr($Seq,$pos,$NtLenMissingExon);
                        my $LenCore = length($Core);

                        next if $LenCore < 3;
                        my $scalar = scalar(@$ListHypExons);
                        my $InfoHypExon = &CreateInfoHypExon($Prefix,$Core,$Suffix,$LenPrefix,$LenCore,$LenSuffix,$pos,$subZone,$IntronStart);
                        push(@$ListHypExons,$InfoHypExon);
                    }
                }
            }
        }
        push(@$ListHypExons,@$ListHypExonsWoCore);
        # Run hmmsearch
        ($ListHypExons) = &RunHMMSearchForMiniEx($ProtHMM,$ListHypExons,$Seq_p,$Seq_n,$More_p,$More_n,$lenHMM,$i);
        last if scalar(@$ListHypExons) != 0;
    }
    return ($ListHypExons);
}

sub DefineZone {
    my ($Intron,$isMinus,$IntronStart,$IntronEnd,$LenSeq) = @_;

    my $APC      = $Intron->get_idbyRNAw();
    my $APL      = $APC->get_annotpairlist();
    my $NbIntron = scalar(@$APL);
    my $Zones    = [];

    if ($NbIntron == 0) {
        my $Start = $IntronStart + $MININTRONSIZE - 1;
        my $End   = $IntronEnd   - $MININTRONSIZE - 1;
        push(@$Zones, [[$Start,$End,0]]);
        return $Zones;
    }
    for (my $i = 0; $i < scalar(@$APL); $i++) {
        my $AP    = $APL->[$i];
        my $AP_p  = $i != 0 ? $APL->[$i-1] : 0;
        my ($AP_Start,$AP_End)     = &ApPosStrandFW($AP,$LenSeq);
        my ($AP_p_Start,$AP_p_End) = $AP_p ? &ApPosStrandFW($AP_p,$LenSeq) : ("","");

        my $start = $i == 0 ? $IntronStart+$MININTRONSIZE-1 : $AP_p_End;
        my $end   = $AP_Start-2;
        push(@$Zones, [$start,$end,$i]);

        # Special case if last AP in APL
        if ($i == scalar(@$APL)-1) {
            $start = $AP_End;
            $end   = $IntronEnd-$MININTRONSIZE-1;
            push(@$Zones, [$start,$end,$i+1]);
        }
    }

    $Zones = &SortZones($Zones);
    return $Zones;
}

sub SortZones {
    my $Zones = shift;

    my $SortZones = [];
    my $LenZones = scalar(@$Zones);
    my $mod      = $LenZones % 2;
    my $Middle   = $mod == 1 ? ($LenZones-1)/2 : $LenZones/2;

    push(@$SortZones,$Zones) if $LenZones <=2;
    return $SortZones if $LenZones <=2;

    my ($SecondTab,$LastTab) = ([],[]);
    $LastTab       = splice(@$Zones,$Middle,1) if $mod == 1;
    my @FirstPart  = @$Zones[0..$Middle-1];
    my @SecondPart = $mod == 1 ? @$Zones[$Middle..$LenZones-2] : @$Zones[$Middle..$LenZones-1];
       @SecondPart = reverse(@SecondPart);
    for (my $i = 0; $i < scalar(@FirstPart); $i++) {
        my $First  = $FirstPart[$i];
        my $Second = $SecondPart[$i];
        my $tab =[$First,$Second];
        $SecondTab = $tab            if $i ==0;
        push(@$SortZones,$tab)       if $i !=0;
        push(@$SortZones,$SecondTab) if $i ==1;
    }
    push(@$SortZones,[$LastTab]) if scalar(@$LastTab) != 0;
    push(@$SortZones,$SecondTab) if $LenZones == 3;
    return $SortZones;
}

sub CreateInfoHypExon {
    my ($Prefix,$Core,$Suffix,$LenPrefix,$LenCore,$LenSuffix,$pos,$subZone,$IntronStart) = @_;

    my $ExonSeq        = $Prefix.$Core.$Suffix;
    my $ProtSeq        = &TranslateInProt($ExonSeq);
    my $LenFirstIntron = $pos - $IntronStart + 1;
    my $InfoHypExon    = { seq              => $ProtSeq,
                           nt_seq           => $ExonSeq,
                           prefix           => $LenPrefix,
                           core             => $LenCore,
                           suffix           => $LenSuffix,
                           position         => $pos,
                           len_first_intron => $LenFirstIntron,
                           zone             => $subZone
                          };
    return $InfoHypExon;
}

sub DefineEachIntronType {
    my ($BestHypExons,$apl,$isMinus,$LenSeq) = @_;

    my $i = 0;
    foreach my $BestHypExon (@$BestHypExons) {
        my $HypExonPos = $BestHypExon->{"position"};
        my $res = $BestHypExon->{"HmmRes"};
        my $SequenceId = $res->get_SequenceId();
        $BestHypExon->{"ap_first_intron"}  = undef;
        $BestHypExon->{"ap_second_intron"} = undef;

        my ($close_r,$close_l)  = (0,$LenSeq);
        my ($closeAp_r,$closeAp_l) = (undef,undef);
        for (my $i = 0; $i < scalar(@$apl); $i++) {
            my $ap = $apl->[$i];
            my ($ap_start,$ap_end) = &ApPosStrandFW($ap,$LenSeq);
            ($closeAp_r,$close_r) = ($i,$ap_start) if $HypExonPos > $ap_start && $ap_start > $close_r;
            ($closeAp_l,$close_l) = ($i,$ap_start) if $HypExonPos < $ap_start && $ap_start < $close_l;
        }
        $BestHypExon->{"ap_first_intron"}  = $apl->[$closeAp_r] if defined($closeAp_r);
        $BestHypExon->{"ap_second_intron"} = $apl->[$closeAp_l] if defined($closeAp_l);
        $i++;
    }
}

sub AddSpliceScore {
    my ($Seq,$BestHypExons,$isMinus,$Exon_p,$Exon_n,$Name,$DirName,$GroupI,$GroupII) = @_;

    my ($Exon_pEnd,$Exon_nStart) = ($Exon_p->get_dnaend(),$Exon_n->get_dnastart());
       $Exon_pEnd   = length($Seq) +1 - $Exon_pEnd   if $isMinus;
       $Exon_nStart = length($Seq) +1 - $Exon_nStart if $isMinus;

    my ($Flanking_5,$Flanking_3) = ({},{});
    my $ListOfFile = {};

    foreach my $BestHypExon (@$BestHypExons) {
        my $HmmRes     = $BestHypExon->{HmmRes};
        my $alignments = $HmmRes->get_alignments();
        my $SeqId      = $HmmRes->get_SequenceId();

        my ($prefix,$suffix) = ($BestHypExon->{prefix},$BestHypExon->{suffix});
        my ($position,$core) = ($BestHypExon->{position},$BestHypExon->{core});

        my ($start_I1,$end_I1) = ($Exon_pEnd+$prefix  , $position);
        my ($start_I2,$end_I2) = ($position + $core, $Exon_nStart-$suffix);

        my ($Group_I1,$Group_I2) = &DefIntronType($BestHypExon);

        my $cnt = 0;
        foreach my $dom (sort keys %$alignments) {
            next if $cnt != 0;
            my $ali = $alignments->{$dom};
            my $pos = $ali->get_pos();
            my ($SpliceSeq,$Flanking_5,$Flanking_3)
                = &CreateNtAliForIntron($Seq,$Group_I1,$Group_I2,$start_I1,$end_I1,$start_I2,$end_I2,$pos,$Flanking_5,$Flanking_3,$prefix,$suffix);
            my $add = $prefix             if $pos == 5;
               $add = $suffix             if $pos == 3;
               $add = "${prefix}_$suffix" if $pos == 4 || $pos == -1;
            my $FileName = "$TMPDIR/HMM_For_Exo/$DirName/${Name}_${pos}_$add";
            $BestHypExon->{"SpliceRes"} = "$FileName.res";
            $ListOfFile->{$FileName}++;

            # Read olnly one times Splice*.mod
            if (($pos == 4 && ($Group_I1 ne "II"  || $Group_I2 ne "II"))
             || ($pos == 5 &&  $Group_I1 ne "II") || ($pos == 3 && $Group_I2 ne "II")
             || ($pos == -1 && $Group_I2 ne "II")) {
                $GroupI = &ReadSpliceModel("$MODEL_PATH/Splice/SpliceI.mod",$GroupI) if scalar(keys %$GroupI) == 0;
            }

            if ( ($pos == 4 && ($Group_I1 eq "II"  || $Group_I2 eq "II"))
              || ($pos == 5 &&  $Group_I1 eq "II") || ($pos == 3 && $Group_I2 eq "II")
              || ($pos == -1 && $Group_I2 eq "II")) {
                $GroupII = &ReadSpliceModel("$MODEL_PATH/Splice/SpliceII.mod",$GroupII)  if scalar(keys %$GroupII) == 0;
            }
            my $ThisFlanking_5 = $Flanking_5->{$prefix} if ($pos != 3);
            my $ThisFlanking_3 = $Flanking_3->{$suffix} if ($pos != 5);
            &CreateSpliceModel($FileName,$ThisFlanking_5,$ThisFlanking_3,$Group_I1,$Group_I2,$GroupI,$GroupII,$position) if (!(-e $FileName));
            my ($AliOut,$ProtHMM) = ("$FileName.ali","$FileName.hmm");
            &RunUmacAndHMMBuild($FileName,$AliOut,$ProtHMM,"AddSpliceScore") if (!(-e $ProtHMM));
            &CreateQueryFile($FileName,$SpliceSeq,$SeqId);
            $cnt++;
        }
    }
    &RunHMMForeachSplice($ListOfFile,$BestHypExons);
    return($GroupI,$GroupII);
}

sub ReadSpliceModel {
    my ($File,$Group) = @_;

    my $Modelfh  = new IO::File "< $File"
            or die "Can't read from file '$File': $!\n";
    my @tab   = <$Modelfh>;
    $Modelfh->close();

    my $count = 0;
    my $Header = "";
    foreach my $line (@tab) {
        $line =~ s/\n$//;
        if ($count % 2 == 0 && $line =~ m/^>.+/) {
            $line   =~ s/^>//;
            $Header = $line;
        }
        elsif ($count % 2 != 0 && $line !~ m/^>.+/) {
            $Group->{$Header} = $line;
        }
        $count++;
    }
    return $Group;
}

sub CreateSpliceModel {
    my ($File,$Flanking_5,$Flanking_3,$Group_I1,$Group_I2,$GroupI,$GroupII,$position) = @_;

    $Flanking_5              = "" if !$Flanking_5;
    $Flanking_3              = "" if !$Flanking_3;

    my $Group5 = $Group_I1 ne "II" ? $GroupI : $GroupII;
       $Group5 = {} if $Flanking_5 eq "";
    my $Group3 = $Group_I2 ne "II" ? $GroupI : $GroupII;
       $Group3 = {} if $Flanking_3 eq "";

    my $Fasta  = &CreateFastaForSpliceModel($Group5,$Group3,$Flanking_5,$Flanking_3,$position);

    my $Modelfh = new IO::File ">$File"
        or die "Impossible to open $File\n";
    print $Modelfh $Fasta;
    $Modelfh->close();
}

sub CreateFastaForSpliceModel {
    my ($Group5,$Group3,$Flanking_5,$Flanking_3,$position) = @_;
    my $Fasta = "";

    if (scalar (keys %$Group5) != 0 && scalar (keys %$Group3) != 0 && $position != 0) {
        foreach my $Header1 ( keys %$Group5){
            my $Seq1 = $Group5->{$Header1};
            foreach my $Header2 ( keys %$Group3){
                my $Seq2   = $Group3->{$Header2};
                $Fasta .= ">${Header1}_$Header2\n";
                $Fasta .= "${Flanking_5}${Seq1}${Seq2}${Flanking_3}\n";
            }
        }
    }
    else {
        my $Group = scalar (keys %$Group5) != 0 ? $Group5 : $Group3;
        foreach my $Header ( keys %$Group){
            my $Seq = $Group->{$Header};
            $Fasta .= ">$Header\n${Flanking_5}${Seq}${Flanking_3}\n";
        }
    }
    return $Fasta;
}

sub CreateQueryFile {
    my ($File,$SpliceSeq,$SeqId)= @_;

    $File = "$File.fas";

    my $Fastafh = new IO::File ">>$File"
        or die "Impossible to open $File\n";
    my $Fasta = ">$SeqId\n$SpliceSeq\n";
    print $Fastafh $Fasta;
    $Fastafh->close();
}

sub DefIntronType {
    my $BestHypExon = shift;

    my ($Group_I1,$Group_I2)  = ("I","I");
    if ($BestHypExon->{"ap_first_intron"}) {
        my $FirstIntron            = $BestHypExon->{"ap_first_intron"};
        my $FirstIntron_startline  = $FirstIntron->get_startline();
           $Group_I1               = $1    if $FirstIntron_startline =~ m#group=(.+)#;
    }

    if ($BestHypExon->{"ap_second_intron"}) {
        my $SecondIntron           = $BestHypExon->{"ap_second_intron"} if $BestHypExon->{"ap_second_intron"};
        my $SecondIntron_startline = $SecondIntron->get_startline();
           $Group_I2               = $1    if $SecondIntron_startline =~ m#group=(.+)#;
    }
    return ($Group_I1,$Group_I2);
}

sub CreateNtAliForIntron {
    my ($seq,$Group_I1,$Group_I2,$start_I1,$end_I1,$start_I2,$end_I2,$pos,$Flanking_5,$Flanking_3,$prefix,$suffix) = @_;

    my ($Ali5,$Ali3,$Ali) = ("","","");
    my ($Add5,$Add3)      = ("","");
    if ($pos == 5 || $pos == 4) {
        my ($Right,$Left) = ("","");
        if ($Group_I1 ne "II") {
            my $pos = $start_I1 < 38 ? $start_I1 : 38;
            $Add5  = $Flanking_5->{$prefix} || substr($seq,$start_I1-$pos,$pos-8);
            $Flanking_5->{$prefix} =  $Add5 if !$Flanking_5->{$prefix};
            $Left  = substr($seq,$start_I1-8,8);
            $Right = $end_I1 != 0 ? substr($seq,$end_I1-9,9) : "";
        }
        else {
            my $pos = $start_I1 < 30 ? $start_I1 : 30;
            $Add5  = $Flanking_5->{$prefix} || substr($seq,$start_I1-$pos,$pos);
            $Flanking_5->{$prefix} =  $Add5 if !$Flanking_5->{$prefix};
            $Left  = substr($seq,$start_I1,9);
            $Right = substr($seq,$end_I1-10,10);
        }
        $Ali5 = $Add5.$Left.$Right;
    }

    if ($pos == 3 || $pos == 4) {
        my ($Right,$Left) = ("","");
        my $pos = $end_I2-2+30 < length($seq) ? 30 : length($seq)-$$end_I2-2;
        $Add3  = $Flanking_3->{$suffix} || substr($seq,$end_I2-1,$pos);
        $Flanking_3->{$suffix} =  $Add3 if !$Flanking_3->{$suffix};
        if ($Group_I2 ne "II") {
            $Left  = $start_I2 != 0 ? substr($seq,$start_I2-8,8) : "";
            $Right = substr($seq,$end_I2-10,9);
        }
        else {
            $Left  = substr($seq,$start_I2,9);
            $Right = substr($seq,$end_I2-11,10);
        }
        $Ali3 = $Left.$Right.$Add3;
    }
    $Ali = uc($Ali5.$Ali3);
    return ($Ali,$Flanking_5,$Flanking_3);
}

sub RunHMMForeachSplice {
    my ($List,$BestHypExons) = @_;

    my $evalue = {};
    foreach my $File (keys %$List) {
        &RunHMMSearchForSplice("$File.res","$File.hmm","$File.fas");
        my $Searchfh  = new IO::File "<$File.res"
            or die "Can't read from file '$File.res': $!\n";
        my @tab   = <$Searchfh>;
        $Searchfh->close();

        my $HMMRes = new PirObject::HMMsearchOutput();
           $HMMRes->FillFeaturesFromTextOutput(\@tab);
        my $AllHMMRes = $HMMRes->get_Iterations()->[0]->get_resume();
        foreach my $Res (@$AllHMMRes) {
            my $id = $Res->get_SequenceId();
            $evalue->{$id} = $Res->get_fEvalue();
        }
    }
    foreach my $BestHypExon (@$BestHypExons) {
        my $HMMRes = $BestHypExon->{"HmmRes"};
        my $id = $HMMRes->{"SequenceId"};
        my $ntEvalue = $evalue->{$id} || 1;
        my $aaEvalue = $HMMRes->{"fEvalue"};
        $BestHypExon->{"ntEvalue"} = $ntEvalue;
        my $gEvalue = $ntEvalue * $aaEvalue;
        $BestHypExon->{"gEvalue"} = $gEvalue;
    }
}

sub RunHMMSearchForSplice {
    my ($FileRes,$hmm,$FastaName) = @_;

    my $cmd = "nice -19 $HMMSEARCHPATH --noali --max -o $FileRes $hmm  $FastaName";
    print "\n$cmd\n" if $DEBUG;

    my $resultat = system("$cmd");

    my $hascoredump = ($resultat & 128) >> 7;  # 0 if no core dump, 1 if core dump
    my $signal      = $resultat & 127;  # SIGNAL received by subprocess, from 0 to 127;
    my $returncode  = $resultat >> 8;   # exit status of subprogram
    if ($returncode > 1 || $signal > 0 || $hascoredump == 1) {
        print "Error in execution of HMMsearch \n";
    }
}

sub AddMiniExon {
    my ($Introns,$Exons,$i,$BestSol,$isMinus) = @_;

    my $LenPref         = ( $isMinus ? -$BestSol->{"prefix"} :  $BestSol->{"prefix"});
    my $LenCore         = ( $isMinus ? -$BestSol->{"core"}   :  $BestSol->{"core"});
    my $LenSuf          = ( $isMinus ?  $BestSol->{"suffix"} : -$BestSol->{"suffix"});
    my $LenFirstIntron  = ( $isMinus ? -$BestSol->{"len_first_intron"} : $BestSol->{"len_first_intron"});
    my $strand          = ( $isMinus ? "-" : "+");
    my $AdjStart        = ( $isMinus ?  -1 :  1);
    my $AdjEnd          = ( $isMinus ?   1 : -1);

    my $PrevExon    = $Exons->[$i];
    my $LargeIntron = $Introns->[$i];
    my $zone        = $BestSol->{"zone"};

    # Exons #
    # Adjust end of previous exon
    my $EndPrevExon = $PrevExon->get_dnaend() + $LenPref;
    $PrevExon->set_dnaend($EndPrevExon);

    # Add the mini exon
    my $StartNewExon = $EndPrevExon  - $LenPref + $LenFirstIntron + $AdjStart;
    my $EndNewExon   = $StartNewExon + $LenCore + $AdjEnd;
    my $NewExon = new PirObject::Exon ( dnastart  => $StartNewExon,
                                        dnaend    => $EndNewExon,
                                        strand    => $strand);
    splice(@$Exons, $i + 1, 0, $NewExon);

    # Adjust start of next exon
    my $NextExon = $Exons->[$i+2];
    my $StartNextExon  = $NextExon->get_dnastart() + $LenSuf;
    $NextExon->set_dnastart($StartNextExon);

    # Introns #
    my $APC               = $LargeIntron->get_idbyRNAw();
    my $APL               = $APC->get_annotpairlist();
    # First Intron
    my @APL_FirstIntron   = @$APL[0..$zone-1];
    my $APC_FirstIntron   = $APC->DeepClone();
       $APC_FirstIntron->set_annotpairlist(\@APL_FirstIntron);
    my $FirstIntron_type  = "";
    foreach my $AP (@APL_FirstIntron) {
        my $startline  = $AP->get_startline();
        my $type       = $1    if $startline =~ m#group=(.+)#;
        $FirstIntron_type .= "$type,";
    }
    $FirstIntron_type =~ s/,$//;
    my $StartFirstIntron = $EndPrevExon  + $AdjStart;
    my $EndFirstIntron   = $StartNewExon + $AdjEnd;
    my $FirstIntron = new PirObject::Intron ( start    => $StartFirstIntron,
                                              end      => $EndFirstIntron,
                                              strand   => $strand,
                                              idbyRNAw => $APC_FirstIntron,
                                              type     => $FirstIntron_type);

    # Second Intron
    my $EndTab            = scalar(@$APL)-1;
    my @APL_SecondIntron  = @$APL[$zone..$EndTab];
    my $APC_SecondIntron  = $APC->DeepClone();
       $APC_SecondIntron->set_annotpairlist(\@APL_SecondIntron);
    my $SecondIntron_type  = "";
    foreach my $AP (@APL_SecondIntron) {
        my $startline  = $AP->get_startline();
        my $type       = $1    if $startline =~ m#group=(.+)#;
        $SecondIntron_type .= "$type,";
    }
    $SecondIntron_type =~ s/,$//;
    my $StartSecondIntron = $EndNewExon    + $AdjStart;
    my $EndSecondIntron   = $StartNextExon + $AdjEnd;
    my $SecondIntron = new PirObject::Intron ( start   => $StartSecondIntron,
                                              end      => $EndSecondIntron,
                                              strand   => $strand,
                                              idbyRNAw => $APC_SecondIntron,
                                              type     => $SecondIntron_type);

    splice(@$Introns, $i, 1);
    splice(@$Introns, $i, 0, $FirstIntron,$SecondIntron);
}

sub ReajustExonAndIntron {
    my ($Introns,$Exons,$i,$BestSol,$isMinus) = @_;

    my $LenPref         = ( $isMinus ? -$BestSol->{"prefix"} :  $BestSol->{"prefix"});
    my $LenSuf          = ( $isMinus ?  $BestSol->{"suffix"} : -$BestSol->{"suffix"});
    my $strand          = ( $isMinus ? "-" : "+");
    my $AdjStart        = ( $isMinus ?  -1 :  1);
    my $AdjEnd          = ( $isMinus ?   1 : -1);

    # Exons #
    # Adjust end of previous exon
    my $PrevExon    = $Exons->[$i];
    my $EndPrevExon = $PrevExon->get_dnaend() + $LenPref;
    $PrevExon->set_dnaend($EndPrevExon);

    # Adjust start of next exon
    my $NextExon = $Exons->[$i+1];
    my $StartNextExon  = $NextExon->get_dnastart() + $LenSuf;
    $NextExon->set_dnastart($StartNextExon);

    # Reajust intron
    my $Intron = @$Introns[$i];
    my $StartIntron = $EndPrevExon   + $AdjStart;
    my $EndIntron   = $StartNextExon + $AdjEnd;
    $Intron->set_start($StartIntron);
    $Intron->set_end($EndIntron);
}

#-------------------------------------------------#
# Subs for putting annotations in the masterfile  #
#-------------------------------------------------#

sub AnnotateMfFromHYPPROTSArray {
    # This function annotates the masterfile from the blast results
    foreach my $hyprot (@$HYPPROTS) {
        my $name = $hyprot->get_name();
        next if (not (defined ($name)) or ($name eq ""));

        my $contigname = $hyprot->get_contigname();
        my $contig     = $pirmaster->GetContigByName($contigname);
        my $start      = $hyprot->get_start();
        my $alt_start  = $hyprot->get_altstart();
        my $end        = $hyprot->get_end();
        my $prot       = $hyprot->get_protein();
        my $exons      = $hyprot->get_exons();
        my $isMinus    = ($hyprot->get_strand() == 1 ? 0 : 1);
        my $fusion     = $hyprot->get_hypfusiongene();
        my $idByBlast  = $hyprot->get_idbyblast();
        my $idByExo    = $hyprot->get_idbyexo();
        my $frameshift = $hyprot->get_frameshift();
        my $homologous = $hyprot->get_homologous();
        my $arrow      = ($isMinus ? '<==' : '==>');

        my $NotToAnnot = &SuspectIsInAFamily($hyprot,$contig);
        next               if $NotToAnnot == 1;
        my $ToComment  = 1 if $NotToAnnot == 2;

        # Annot the gene
        my $linename             = $name;                     # The name gene in start and endline
        my ($startline,$endline) = ( $ToComment ? (";",";") : ("",""));

        # Define start line and end line
        $startline  .= ";     G-$linename $arrow start";
        $endline    .= ";     G-$linename $arrow end";

        my $isFusioned      = $hyprot->get_hypfusiongene() || undef;
        my $startlinenumber = ( $isMinus && $isFusioned ? 0 : 2);
        my $endlinenumber   = ( $isMinus && $isFusioned ? 2 : 0);

        my $info_fusion     = $hyprot->get_hypfusiongene() || undef;
        my $fusion_name     = $info_fusion->get_name()     || undef if $info_fusion;
        my $posiffusion     = $hyprot->get_posiffusion()   || undef;

        my $len_orf = 0;
        if ( !(defined($isFusioned)) && $alt_start && (abs($start-$alt_start)/3 >= 100)
           && ((!$isMinus && $alt_start < $start) || ($isMinus && $start < $alt_start))) {
            my $annot_who_overlap = &WhatOverlapsThis($alt_start,$start,$contig);
            # Keep only RNA
            my $list_of_pos = [];
            foreach my $list_who_overlap (@$annot_who_overlap) {
                foreach my $AP_who_overlap (@$list_who_overlap ) {
                    my $annot = $AP_who_overlap->[2];
                    my $name  = $annot->get_genename();
                    next if $name !~ m/^trn/i && $name !~ m/rrn5/i && $name !~ m/rnpb/i && $name !~ m/rns/i && $name !~ m/rnl/i;
                    push(@$list_of_pos, $annot->get_startpos(),  $annot->get_endpos())
                }
            }
            @$list_of_pos = sort { $a <=> $b } @$list_of_pos;
            my $retain_val   = $isMinus ? @$list_of_pos[0] || $alt_start : @$list_of_pos[-1] || $alt_start ;
            if ($isMinus) {
                while ($alt_start > $retain_val) {
                    $alt_start = $alt_start - 3;
                }
            }
            else {
                while ($alt_start < $retain_val) {
                    $alt_start = $alt_start + 3;
                }
            }
            if (abs($start-$alt_start)/3 >= 100) {
                $len_orf     = abs($start-$alt_start)/3;
                $fusion_name = "orf$len_orf";
                $posiffusion = 2;
                $startlinenumber = ( $isMinus ? 0 : 2);
                $endlinenumber   = ( $isMinus ? 2 : 0);
            }
        }

        my $A_type           = "C" if $ToComment;
        my $altexons         = $hyprot->get_altexons();
        my $FirstMissingExon = ($hyprot->get_firstExonerateMatch() && $hyprot->get_firstExonerateMatch() > 10) ? 1 : 0;
        my $protannot = new PirObject::AnnotPair (
                                                   type              => $A_type || "G",
                                                   genename          => "$name",
                                                   startpos          => $start,
                                                   endpos            => $end,
                                                   direction         => $arrow,
                                                   startline         => $startline,
                                                   endline           => $endline,
                                                   startlinenumber   => $startlinenumber,
                                                   endlinenumber     => $endlinenumber,
                                                   posiffusion       => $posiffusion,
                                                   namefusiongene    => $fusion_name,
                                                   idbyblast         => $idByBlast,
                                                   idbyexo           => $idByExo,
                                                   altexons          => $altexons,
                                                   firstmissingexon  => $FirstMissingExon,
                                                   origine           => $hyprot->get_origine || ""
                                                 );
        $protannot->set_exoscore($exons->[0]->get_exoscore) if scalar(@$exons) == 1;
        my $startwarning = $hyprot->get_startwarning() || "";
        # Add comment for frameshift
        $startwarning .= ($startwarning ne "" ?
                         " / potential frameshift"
                       : "potential frameshift")
                           if $frameshift;

        # Add comment for alternative start
        $startwarning .= ($startwarning ne "" ?
                         " / alternative ATG start pos $alt_start"
                       : "alternative ATG start pos $alt_start")
                           if (!$fusion && $alt_start && $len_orf < 100);

        # Annotation of fusion between Orf and gene
        if ($alt_start && $len_orf >= 100 && !$fusion) {
            my $orf_end                = ( $isMinus ? $start + 1 : $start - 1);
            my ($start_line,$end_line) = ( $ToComment ? (";",";") : ("",""));
               $start_line            .= ";     G-$fusion_name $arrow start";
               $end_line              .= ";     G-$fusion_name $arrow end";

            my $orfannot = new PirObject::AnnotPair (
                                       type              => $A_type || "G",
                                       genename          => $fusion_name,
                                       startpos          => $alt_start,
                                       endpos            => $orf_end,             # gene start
                                       direction         => $arrow,
                                       startline         => $start_line,
                                       endline           => $end_line,
                                       startlinenumber   => $startlinenumber,
                                       endlinenumber     => $endlinenumber,
                                       namefusiongene    => $name,
                                       posiffusion       => 1
                                     );
            &AddAnnotToPirMaster($contigname,$orfannot);
            $startwarning .= ($startwarning ne "" ?
                         " / contiguous and in phase with $fusion_name"
                       : "contiguous and in phase with $fusion_name");
        }

        my $prot_startline = $protannot->get_startline();
        $prot_startline .= " ;; mfannot: $startwarning" if $startwarning;
        $protannot->set_startline($prot_startline);

        my $res = &AddAnnotToPirMaster($contigname,$protannot);

        # Go out of the function if the protein has not been added
        next if (!defined ($res) or $res == 0);
        &AddCommForSimiStart($hyprot,$contigname);

        next if ($name =~ /^orf/);       # if it's an ORF, then it goes to through, because an ORF must not have
        next if (scalar (@$exons) <= 1); # if there is only one exon, and if option is not checked, go to the next prot

        # Annotating exons
        my $number = 1;
        foreach my $exon (@$exons) {
            my $start     = $exon->get_dnastart();
            my $end       = $exon->get_dnaend();
            my $strand    = $exon->get_strand();
            my $exo_score = $exon->get_exoscore();
            my $insertion = $exon->get_insertion();
            my $frameshift_size = $exon->get_frameshiftsize();

            my ($start_line,$end_line) = ( $ToComment ? (";",";") : ("",""));

               $start_line .= ";     G-$linename-E$number $arrow start";
               $start_line .= " ;; mfannot: frameshift of $frameshift_size nt" if $frameshift_size;
               if (defined($insertion)) {
               $start_line .= $start_line =~ m/ ;; mfannot:/ ?
                              " / insertion of $insertion a.a"
                            : " ;; mfannot: insertion of $insertion a.a";
               }
               $end_line   .= ";     G-$linename-E$number $arrow end";

            my $annot = new PirObject::AnnotPair (     type      => $A_type || "E",
                                                       genename  => "$name",
                                                       startpos  => $start,
                                                       endpos    => $end,
                                                       direction => $arrow,
                                                       startline => $start_line,
                                                       endline   => $end_line,
                                                       exoscore  => $exo_score
                                                     );
            $number++;
            &AddAnnotToPirMaster($contigname,$annot);
        } # End foreach $exon

        # Annotating introns
        my $introns = $hyprot->get_introns();
        $number = 1;
        foreach my $intron (@$introns) {
            my $start    = $intron->get_start();
            my $end      = $intron->get_end();
            my $strand   = $intron->get_strand();
            my $type     = $intron->get_type();
            my $idbyRNAw = $intron->get_idbyRNAw();
            my $comment  = $intron->get_comment() || "";

            my ($start_line,$end_line) = ( $ToComment ? (";",";") : ("",""));
               $start_line .= ";     G-$linename-I$number $arrow start";
               $start_line .= " /group=$type" if $type;
               $end_line   .= ";     G-$linename-I$number $arrow end";
           my $I_startwarning = "$comment" if $comment;

            my $annot = new PirObject::AnnotPair (       type         => $A_type || "I",
                                                         genename     => "$name",
                                                         startpos     => $start,
                                                         endpos       => $end,
                                                         direction    => $arrow,
                                                         startline    => $start_line,
                                                         endline      => $end_line,
                                                         introntype   => $type
                                                        );
            my $I_startline = $annot->get_startline();

            $I_startline   .= " ;; mfannot: $I_startwarning" if $I_startwarning;
            if ($I_startwarning) {
                            $I_startwarning .= $I_startwarning =~ m/ ;; mfannot:/ ?
                           " / $I_startwarning"
                         : " ;; mfannot: $I_startwarning";
            }
            $annot->set_startline($I_startline);
            $number++;
            &AddAnnotToPirMaster($contigname,$annot);

            my $APC = $idbyRNAw;
            next if !$idbyRNAw;
            my $APL = $APC->get_annotpairlist();
            my $nb_intron = scalar(@$APL);
            if ($nb_intron > 1){
                foreach my $AP (@$APL) {
                    &AddAnnotToPirMaster($contigname,$AP) if scalar(@$APL > 1);
                }
            }
        } # End foreach $intron
    } # End foreach $hyprot
    &CommentAllRNAwIntron;
} # End sub

sub SuspectIsInAFamily {
    my ($hyprot,$contig) = @_;
    my $HP_start     = $hyprot->get_start();
    my $HP_stop      = $hyprot->get_end();
    my $HP_name      = $hyprot->get_name();
    my $HP_idbyblast = $hyprot->get_idbyblast();
    my $HP_introns   = $hyprot->get_introns();
    my $HP_exons     = $hyprot->get_exons();

    ($HP_start, $HP_stop) = ($HP_stop, $HP_start) if $HP_start > $HP_stop;
    my $annot_who_overlap = &WhatOverlapsThis($HP_start,$HP_stop,$contig);
    return 0 if scalar(@$annot_who_overlap) == 0;

    my ($IsInAP,$ContainAP)    = &IsInOrContainAP($annot_who_overlap,$HP_start,$HP_stop);
    my ($OVInPercent,$AP_name,$AP_score) = (0,"",0);
    my $hyprot_score = GetExoScore($HP_exons);
    if (scalar(@$IsInAP) != 0) {
        # HP is in AP
        my $to_rm            = [];
        foreach my $list_who_overlap (@$IsInAP) {
            my ($HP_isIntronic,$G_AP,$G_score,$count) = (0,"",0,0);
            my $containComment = 0;
            foreach my $AP_who_overlap (@$list_who_overlap ) {
                my $AP        = $AP_who_overlap->[2];
                my $AP_type   = $AP->get_type();
                my $AP_name = $AP->get_genename();
                $containComment = 1 if $AP_name eq "comment";
                   $G_AP      = $AP if $AP_type eq "G";
                my $exo_score = $AP->get_exoscore();
                $G_score     += $exo_score if $exo_score;
                $count++                   if $exo_score;

                next if $AP_type ne "I"; # Was id by exo
                my ($I_start, $I_stop) = ($AP_who_overlap->[0],$AP_who_overlap->[1]);
                   ($I_start, $I_stop) = ($I_stop, $I_start) if $I_start > $I_stop;
                if ($I_start <= $HP_start && $I_stop >= $HP_stop) {
                    $HP_isIntronic = 1;
                    last;
                }
            }
            next if $containComment;

            $G_score = ($count == 0 ? $G_AP->get_exoscore : $G_score/$count);
            if ($HP_isIntronic == 0) {
                if ($HP_idbyblast) {
                    push(@$to_rm,$list_who_overlap);
                }
                else {
                    return 1 if !$G_AP->get_idbyexo();
                    ($G_score > $hyprot_score) ? return 1 : return 2;
                }
            }
        }
        &RemoveAPlist($to_rm,$contig);
    }

    if (scalar(@$ContainAP) != 0) {
        # HP is in AP
        my ($to_rm,$to_cm,$same_annot) = ([],[],0);
        foreach my $list_who_overlap (@$ContainAP) {
            my ($G_AP_isIntronic,$G_AP,$G_score,$count) = (0,"",0,0);
            my $containComment = 0;
            foreach my $AP_who_overlap (@$list_who_overlap) {
                my $AP      = $AP_who_overlap->[2];
                my $AP_type = $AP->get_type();
                my $AP_name = $AP->get_genename();
                $containComment = 1 if $AP_name eq "comment";
                   $G_AP    = $AP if $AP_type eq "G";
                my $exo_score = $AP->get_exoscore();
                $G_score += $exo_score if $exo_score;
                $count++ if $exo_score;

                next if $AP_type ne "G";
                my ($AP_start, $AP_stop) = ($AP_who_overlap->[0],$AP_who_overlap->[1]);
                   ($AP_start, $AP_stop) = ($AP_stop, $AP_start) if $AP_start > $AP_stop;

                $same_annot = 1 if $AP_start == $HP_start && $AP_stop == $HP_stop && $AP_name eq $HP_name;
                foreach my $intron (@$HP_introns) {
                    my ($I_start, $I_stop) = ($intron->get_start(),$intron->get_end());
                       ($I_start, $I_stop) = ($I_stop, $I_start) if $I_start > $I_stop;
                    if ($I_start <= $AP_start && $I_stop >= $AP_stop) {
                        $G_AP_isIntronic   = 1;
                        last;
                    }
                }
                last if $G_AP_isIntronic;
            }
            next if $containComment;

            $G_score = ($count == 0 ? 0 : $G_score/$count);
            if ($G_AP_isIntronic == 0) {
                if ($HP_idbyblast || $same_annot == 1) {
                    push(@$to_rm,$list_who_overlap);
                }
                elsif ( !$HP_idbyblast && $G_AP->get_idbyexo()) {
                    return 1 if ( $G_score > $hyprot_score );
                    push(@$to_rm,$list_who_overlap);
                }
                else {
                    return 1 if !$G_AP->get_idbyexo();
                    push(@$to_cm,$list_who_overlap);
                }
            }
        }
        &RemoveAPlist($to_rm,$contig);
        &CommentAPlist($to_cm)
    }
    else {
        &ReadFamilyList() if (scalar(keys %$FAMILY_LIST) == 0);
        ($OVInPercent,$AP_name,$AP_score) = &OVInPercent($annot_who_overlap,$HP_start,$HP_stop,$HP_name);
    }
    return 0 if (scalar(@$ContainAP) != 0 || scalar(@$IsInAP) != 0) ;

    if    ($OVInPercent == 101 && !$HP_idbyblast){
        return 1;
    }
    elsif ($OVInPercent >  75 && !$HP_idbyblast && $hyprot_score < $AP_score){
        return 1;
    }
    elsif ($OVInPercent >  75){
        my $ByOVInPercent    = sprintf("%.2f", $OVInPercent);
        $add_text_in_header .= ";;    $HP_name and $AP_name genes have an unusually long overlap ($AP_name overlaps by $ByOVInPercent%)\n";
        return 0;
    }
    else {
        return 0;
    }
}

sub ReadFamilyList {
    my $infh  = new IO::File "<$family_lib"
        or die "Can't read from file '$family_lib': $!\n";

  while( <$infh> ){
        my $line = $_;
        next if $line =~ m/^#/ || $line =~ m/^\s+$/;
        $line =~ s/\n$//;
        my @list = split(/\s+=\s+/,$line);
        next if scalar(@list) == 0;
        my $MainName = lc($list[0]);
        foreach my $name (@list) {
            $name = lc($name);
            $FAMILY_LIST->{$name} = $MainName;
        }
    }
}

sub OVInPercent {
    my ($annot_who_overlap,$HP_start,$HP_stop,$HP_name) = @_;

    my $HP_len    = abs($HP_start-$HP_stop);
    my ($OVPercent,$AP_name,$AP_score) = (0,"","");
    foreach my $list_who_overlap (@$annot_who_overlap) {
        foreach my $AP_who_overlap (@$list_who_overlap ) {
            my $AP      = $AP_who_overlap->[2];
            my $All     = $AP_who_overlap->[3];
            my $AP_type = $AP->get_type();
            next if $AP_type ne "G";
            return 0 if $AP->get_startline() =~ /G-orf\d+/;
            $AP_name    = $AP->get_genename();
            $AP_score   = $AP->get_exoscore || 0;

            # Special case know is a family...
            if (defined($FAMILY_LIST->{lc($HP_name)}) && defined($FAMILY_LIST->{lc($AP_name)})) {
                return (101,$AP_name,$AP_score) if $FAMILY_LIST->{lc($HP_name)} eq $FAMILY_LIST->{lc($AP_name)};
            }
            my ($AP_start, $AP_stop) = ($AP_who_overlap->[0],$AP_who_overlap->[1]);
               ($AP_start, $AP_stop) = ($AP_stop, $AP_start) if $AP_start > $AP_stop;
            my $AP_len = abs($AP_start - $AP_stop);
            my $Min_len = $AP_len > $HP_len ? $HP_len + 1 : $AP_len + 1;
            my $OVLen = 0;
            if ($HP_start < $AP_start){
                $OVLen = $HP_stop - $AP_start + 1;
            }
            else {
                $OVLen = $AP_stop - $HP_start + 1;
            }
            $OVPercent = ($OVLen*100)/$Min_len;
        }
    }
    return ($OVPercent,$AP_name,$AP_score);
}

sub IsInOrContainAP {
    my ($annot_who_overlap,$HP_start,$HP_stop) = @_;

    my $IsInAP    = []; # If HP is in an other Gene
    my $ContainAP = []; # List of AP contained in HP

    foreach my $list_who_overlap (@$annot_who_overlap) {
        foreach my $AP_who_overlap (@$list_who_overlap ) {
            my $AP      = $AP_who_overlap->[2];
            my $All     = $AP_who_overlap->[3];
            my $AP_type = $AP->get_type();
            next if $AP_type ne "G";
            my ($AP_start, $AP_stop) = ($AP_who_overlap->[0],$AP_who_overlap->[1]);
               ($AP_start, $AP_stop) = ($AP_stop, $AP_start) if $AP_start > $AP_stop;
            if ($HP_start <= $AP_start && $HP_stop >= $AP_stop) {
                # AP in HP
                push(@$ContainAP, $list_who_overlap);
                last;
            }
            elsif ($AP_start <= $HP_start && $AP_stop >= $HP_stop) {
                # HP in AP
                push(@$IsInAP, $list_who_overlap);
                last;
            }
        }
    }
    return ($IsInAP,$ContainAP);
}
sub GetExoScore {
    my $exons = shift;

    my ($count,$score) = (0,0);
    foreach my $exon (@$exons){
        next if !$exon->get_exoscore();
        $score += $exon->get_exoscore();
        $count++;
    }
    my $hyprot_score = ($count == 0 ? 0 : $score/$count);
    return $hyprot_score;
}

sub RemoveAPlist {
    my ($list_to_rm,$contig) = @_;

    my $all_annots = $contig->get_annotations();
    my $alt_exons = [];
    foreach my $list_who_overlap (@$list_to_rm) {
        foreach my $AP_who_overlap (@$list_who_overlap) {
            my $AP_alt_exons  = $AP_who_overlap->[2]->get_altexons();
            push(@$alt_exons,$AP_alt_exons) if scalar(@$AP_alt_exons) != 0;
        }
    }

    # Remove Gene Exon and Intron.
    for (my $i = @$all_annots - 1; $i >= 0 ; $i--) {
        my $contig_AP    = @$all_annots[$i];
        my $id_contig_AP = $1 if  scalar($contig_AP) =~ m/0x(.+)\)/;

        foreach my $list_who_overlap (@$list_to_rm) {
            foreach my $AP_who_overlap (@$list_who_overlap ) {
                my $rm_AP         = $AP_who_overlap->[2];
                my $AP_alt_exons  = $rm_AP->get_altexons();
                my $id_rm_AP   =  $1 if  scalar($rm_AP) =~ m/0x(.+)\)/;
                splice(@$all_annots, $i, 1) if $id_rm_AP eq $id_contig_AP;
            }
        }
    }

    # Remove alt exons
    return if !$alt_exons;
    for (my $i = @$all_annots - 1; $i >= 0 ; $i--) {
        my $contig_AP    = @$all_annots[$i];
        my $id_contig_AP = $1 if  scalar($contig_AP) =~ m/0x(.+)\)/;

        foreach my $list_who_overlap (@$alt_exons) {
            foreach my $rm_AP (@$list_who_overlap) {
                my $id_rm_AP   =  $1 if  scalar($rm_AP) =~ m/0x(.+)\)/;
                splice(@$all_annots, $i, 1) if $id_rm_AP eq $id_contig_AP;
            }
        }
    }
}

sub AddCommForSimiStart {
    my ($hyprot,$contigname) = @_;

    my $posiffusion   = $hyprot->get_posiffusion()  || 0;
    my $arrow         = $hyprot->get_strand() eq "1" ? "==>" : "<==";
    my $name          = $hyprot->get_name();
    my $SimiStart     = $hyprot->get_SimiStart();
    my $start         = $hyprot->get_start();

    return if !$SimiStart || ($hyprot->get_posiffusion() && $hyprot->get_posiffusion() == 2);
    my $comment = new PirObject::AnnotPair( type            => "C",
                                            genename        => $name,
                                            startpos        => $SimiStart,
                                            startline       => ";; mfannot: G-$name $arrow start Def by similarity",
                                            );

    &AddAnnotToPirMaster($contigname,$comment);
}

sub CommentAPlist {
    my $list_to_comment = shift;

    foreach my $list_who_overlap (@$list_to_comment) {
        foreach my $AP_who_overlap (@$list_who_overlap ) {
            my $cm_AP      = $AP_who_overlap->[2];
            my $genename   = $cm_AP->get_genename();
            next if $genename eq "comment";
            $cm_AP->set_type("C");
            my ($startline,$endline) = (";",";");
            $startline .= $cm_AP->get_startline();
            $endline   .= $cm_AP->get_endline();
            $cm_AP->set_startline($startline);
            $cm_AP->set_endline($endline);
        }
    }
}

#-----------------------------------#
# Subs for using external programs  #
#-----------------------------------#

sub Annotate_Using_external_programs {
    my $conf_file       = PirObject::MfAnnotExternalProgs->ImportFromTextFile($EXTCONFIGFILE);
    my $genecomsets     = $conf_file->get_geneprogs(); # This is a HASH genename => <MfAnnotGeneCommandSet>
    my $ext_select_prog = shift || $EXTSELECTPROG;
    # Here we build a list of external programs to run; by default all
    # of them are executed, but this can be modified by the option --ext_select, which
    # we parse here.

    # Create one file per contig
    my $work_dir = "$TMPDIR/Contig_ext";
    &CreateContigFile if (!(-d $work_dir));

    # Default: all of them
    my @allprogs      = map { split(/\s*,\s*/,$_) } keys %$genecomsets;
    my %allprogs      = map { lc($_) => 1  }        @allprogs;
    my %progs_to_run  = %allprogs; # copy, which will be adjusted

    # What do we have in --ext_select? Parse it
    $ext_select_prog="" if $ext_select_prog eq "all";
    my @ext_selected  = split(/\s*,\s*/, $ext_select_prog);

    my @no_ext = grep(/^no/ && $_ ne "none",@ext_selected);
    if (@no_ext) {
        # There are some 'no', which means ( ALL minus the 'no's )
        foreach my $noext (@no_ext) {
            $noext =~ s/^no//;
            delete $progs_to_run{lc $noext};
        }
    }
    elsif (@ext_selected) {
        # There are no 'nos', which means --ext_select is the full list
        %progs_to_run = map { lc($_) => 1 } @ext_selected;
    } # No else needed

    # Print warnings about unknown names in --ext_select
    foreach my $prog (sort keys %progs_to_run) {
        next if $prog eq "none";
        print "   Warning: no external programs specified for '$prog' in '$EXTCONFIGFILE'\n"
        unless $allprogs{lc $prog};
    }

    # Run each external program command set.
    my @extcomsets = sort {
        $genecomsets->{$a}->get_filerank() <=> $genecomsets->{$b}->get_filerank()
    } keys %$genecomsets; # Now sorted; these are keys with possible MULTIPLE names, e.g. "rns,rnl"

    my %dir = ();
    tie %dir, 'IO::Dir', $work_dir;
    foreach my $comsetnames (@extcomsets) {
        foreach my $genename (split(/\s*,\s*/,$comsetnames)) {
            next if ! $progs_to_run{lc $genename};
            if (lc($genename) ne lc("IntronI") && lc($genename) ne lc("IntronII")) {
                print "    '$genename'...\n" if !$DEBUG;
            }
            foreach (keys %dir) {
                next if $_ =~ /^\./;
                next if $_ =~ /\.xml$/;
                next if !(-f "$work_dir/$_");
                my $commandobject = $genecomsets->{$comsetnames};
                my $mf            = "$work_dir/$_";
                my $out           = "$mf-$genename.xml";
                my $APC           = &ExecuteExternalProgram($commandobject,$genename,undef,$mf,$out);
                &ReconstructFullRNA($genename,$APC) if $genename eq "rns" || $genename eq "rnl";
                &AnnotateFromExternalAPC($genename,$APC);
            } # End foreach genename1, genename2, ...
        } # End foreach "genename1,genename2"
    } # End foreach keys
} # End sub

sub CreateContigFile {
    mkdir("$TMPDIR/Contig_ext",0700);
    my $contigs = $pirmaster->get_contigs();
    foreach my $contig (@$contigs) {
        my $seq       = $contig->get_sequence();
           $seq       =~ s/!//g;
        my $name      = $contig->get_name();

        my $contig_file = "$TMPDIR/Contig_ext/$name";
        my $CF = new IO::File ">$contig_file" or die "Cannot open : $contig_file\n";
        print $CF ">$name\n$seq\n";
        $CF->close();
    }
}

sub ExecuteExternalProgram {
    my $commandobject             = shift;
    my $genename                  = shift;
    my $alternate_masterfile      = shift;
    my $alternate_plainmasterfile = shift;
    my $alternate_outfile         = shift;

    my $outfile_gene = $alternate_outfile || "$TMPDIR/result_for_$genename.xml";

    my $substitutions = {
        "OUTFILE"        => "$outfile_gene",       # What will be created, a series of AnnotPairCollections
        "PLAINFASTAFILE" => ($alternate_plainmasterfile || "$TMPDIR/mf_noCr.all"),
        "MASTERFILE"     => ($alternate_masterfile || "$MASTERFILE"),
        "DEBUG"          => $DEBUG ? "#" : "",     # See the config file text
        "GENENAME"       => $genename,             # Optional; the Execute command use this but you can override it yourself)
        "TMPDIR"         => "$TMPDIR",             # Mfannot's tmp dir
        "GENCODE"        => "$GENCODE",
        "MODPATH"        => "$MODEL_PATH",
    };

    $commandobject->set_debug($DEBUG);
    my $OutAndErrDir = dirname($outfile_gene)."/err_out";
    unless(-d $OutAndErrDir) {mkdir $OutAndErrDir or die "Cannot create '$OutAndErrDir'";}
    my ($outfile,$errfile) = $commandobject->Execute(
                                                     "$OutAndErrDir",
                                                     "$OutAndErrDir",
                                                      $substitutions,
                                                     );

    # Read back AnnotPairCollections;
    my $infh = new IO::File "<$outfile_gene"; # Which should be your %OUTFILE%
    if (! $infh){
        print "Cannot read result for '$genename'; maybe there were problems with the commands?\n";
        print "See outfile '$outfile' and errfile '$errfile' for more info.\n" if $DEBUG;
        return [];
    }

    my @annotpaircollections = PirObject->FileHandleToObject($infh);
    $infh->close();
    \@annotpaircollections;
}

sub ReconstructFullRNA {
    my ($genename,$annotpaircollections) = @_;

    foreach my $annotcollection (@$annotpaircollections) {
        my $header       = $annotcollection->get_contigname();
        my ($contigname) = ($header =~ m#^>?\s*(\S+)#)
            or die "Can't parse header line '$header'\n";
        next if $contigname eq "consensus";
        my $contig      = $pirmaster->GetContigByName($contigname)
            or die "Can't get contig by name in AnnotateFromExternalAPC\n";
        my $dna_seq     = $contig->get_sequence();
           $dna_seq     =~ s/\!//g;
        my $seq_length  = $contig->get_sequencelength();
        # Annotate the results, using the annotpairlist field of
        # your annotcollection (an AnnotPairCollection object).
        my $annotpairs = $annotcollection->get_annotpairlist();

        my $minus_annots  = {};
        my $plus_annots   = {};
        my $start_comment = "";
        my $end_comment   = "";
        foreach my $annot (@$annotpairs){
            my $idbyHMM = $annot->get_idbyHMM() || 0;
            next if $idbyHMM == 1 && &CompareHighPrecisionFloats($annot->get_score(), $HMMVALUECUTOFF) == 1; # score > $HMMVALUECUTOFF
            my $type       = $annot->get_type()     || "G";
            my $a_genename = $annot->get_genename() || $genename;
            my $startpos   = $annot->get_startpos()
               || die "Can't find startpos() from annotpair obtained from external analysis?!? Object=\n" . $annot->ObjectToXML() . "\n";
            my $endpos     = $annot->get_endpos(); # Can be undef

            my $isMinus    = 1  if defined($endpos) && $startpos > $endpos;
            my $RNAcomment = $annot->get_RNAcomment();
            if ($annot->get_startline =~ m/5\'/ || $RNAcomment =~ m/5\'/i) {
              $isMinus ? $minus_annots->{1} = $annot : $plus_annots->{1} = $annot;
              $start_comment = $annot->get_RNAcomment();
            }
            elsif ($annot->get_endline =~ m/3\'/i || $RNAcomment =~ m/3\'/i) {
              $isMinus ? $minus_annots->{9999} = $annot : $plus_annots->{9999} = $annot;
              $end_comment = $annot->get_RNAcomment();
            }
            else {
              my ($start) = ($RNAcomment =~ m#pos\s+(\d+)#);
              $isMinus ? $minus_annots->{$start} = $annot : $plus_annots->{$start} = $annot;
            }
        }

        # Check if annot on plus strand is in order
        my $plus_is_in_order = 1;
        my $prev_pos = 0;
        foreach my $key (sort { $a <=> $b } keys %$plus_annots) {
            my $annot =  $plus_annots->{$key};
            my $pos = $annot->get_startpos();
            if ($prev_pos == 0) {
                $prev_pos = $pos;
                next;
            }
            $plus_is_in_order = 0 if $pos < $prev_pos;
            last if $plus_is_in_order == 0;
            $prev_pos = $pos;
        }

        # Check if annot on minus strand is in order
        my $minus_is_in_order = 1;
        $prev_pos = 0;
        foreach my $key (sort { $b <=> $a } keys %$minus_annots) {
            my $annot =  $minus_annots->{$key};
            my $pos = $annot->get_startpos();
            if ($prev_pos == 0) {
                $prev_pos = $pos;
                next;
            }
            $minus_is_in_order = 0 if $pos < $prev_pos;
            last if $minus_is_in_order == 0;
            $prev_pos = $pos;
        }

        next if $plus_is_in_order == 0 && $minus_is_in_order == 0;

        # Check what overlap plus strand
        my @sorted_plus_keys  = (sort { $a <=> $b } keys %$plus_annots);
        my $annot_who_overlap_plus =  keys( %$plus_annots) > 0 ? &WhatOverlapsThis($plus_annots->{$sorted_plus_keys[0]}->get_startpos(),$plus_annots->{$sorted_plus_keys[-1]}->get_endpos(),$contig) : [];
        # Check what overlap minus strand
        my @sorted_minus_keys = (sort { $b <=> $a } keys %$minus_annots);
        my $annot_who_overlap_minus = keys( %$minus_annots) > 0 ? &WhatOverlapsThis($minus_annots->{$sorted_minus_keys[-1]}->get_startpos(),$minus_annots->{$sorted_minus_keys[0]}->get_endpos(),$contig) : [];

        # Remove annotation with type I in @$annot_who_overlap_plus and @$annot_who_overlap_minus
        my ($rm_annot_who_overlap_plus,  $intron_overlapping_plus)  = RemoveIntronFromOverlap($annot_who_overlap_plus);
        my ($rm_annot_who_overlap_minus, $intron_overlapping_minus) = RemoveIntronFromOverlap($annot_who_overlap_minus);

        next if scalar(@$rm_annot_who_overlap_plus) != 0 || scalar(@$rm_annot_who_overlap_minus) != 0;

        # Check which part is the first one.YYYY
        my $add_to_plus  = "";
        my $add_to_minus = "";
        if (keys( %$plus_annots) > 0 && keys( %$minus_annots) > 0) {
           my ($last_pos_in_plus, $first_pos_in_minus) = ($sorted_plus_keys[-1],$sorted_minus_keys[0]);
           ($add_to_plus,$add_to_minus) = $last_pos_in_plus < $first_pos_in_minus ? ("_1","_2") : ("_2","_1");
        }

        my $intron_overlapping   = 1 if $intron_overlapping_plus || $intron_overlapping_minus;
        # Only in + strand
        if ( keys( %$plus_annots) > 0) {
            my $start_annot    = $plus_annots->{$sorted_plus_keys[0]}->get_startpos();
            my $end_annot      = $plus_annots->{$sorted_plus_keys[-1]}->get_endpos();
            my $startline      = ";     G-${genename}${add_to_plus} ==> start";
               $start_comment .= " intron boundaries not identified, needs expert intervention" if $intron_overlapping;
               $startline     .= ";; $start_comment" if $start_comment ne "";
            my $endline        = ";     G-${genename}${add_to_plus} ==> end";
               $endline       .= ";; $end_comment"  if $end_comment ne "";
            my $annot          = new PirObject::AnnotPair(
                                        type            => "G",
                                        genename        => $genename,
                                        startpos        => $start_annot,
                                        endpos          => $end_annot,
                                        direction       => "==>",
                                        startline       => $startline,
                                        endline         => $endline,
                                       );
           &AddAnnotToPirMaster($contigname,$annot);
        }
        # Only in - strand
        if ( keys( %$minus_annots) > 0 ) {
            my $start_annot    = $minus_annots->{$sorted_minus_keys[-1]}->get_startpos();
            my $end_annot      = $minus_annots->{$sorted_minus_keys[0]}->get_endpos();
            my $startline      = ";     G-${genename}${add_to_minus} <== start";
               $start_comment .= " intron boundaries not identified, needs expert intervention" if $intron_overlapping;
               $startline     .= ";; $start_comment" if $start_comment ne "";
            my $endline        = ";     G-${genename}${add_to_minus} <== end";
               $endline       .= ";; $end_comment"  if $end_comment ne "";
            my $annot          = new PirObject::AnnotPair(
                                        type            => "G",
                                        genename        => $genename,
                                        startpos        => $start_annot,
                                        endpos          => $end_annot,
                                        direction       => "<==",
                                        startline       => $startline,
                                        endline         => $endline,
                                       );
           &AddAnnotToPirMaster($contigname,$annot);
        }
        $annotcollection->set_annotpairlist([])
    }
}

sub AnnotateFromExternalAPC {
    my ($genename,$annotpaircollections) = @_;

    # Process each AnnotPairCollection
    foreach my $annotcollection (@$annotpaircollections) {
        my $header       = $annotcollection->get_contigname();
        my ($contigname) = ($header =~ m#^>?\s*(\S+)#)
            or die "Can't parse header line '$header'\n";
        next if $contigname eq "consensus";
        my $contig      = $pirmaster->GetContigByName($contigname)
            or die "Can't get contig by name in AnnotateFromExternalAPC\n";
        my $dna_seq     = $contig->get_sequence();
           $dna_seq     =~ s/\!//g;
        my $seq_length  = $contig->get_sequencelength();
        # Annotate the results, using the annotpairlist field of
        # your annotcollection (an AnnotPairCollection object).
        my $annotpairs = $annotcollection->get_annotpairlist();
        foreach my $annot (@$annotpairs){
            my $idbyHMM = $annot->get_idbyHMM() || 0;
            next if $idbyHMM == 1 && &CompareHighPrecisionFloats($annot->get_score(),"$HMMVALUECUTOFF") == 1; # score > $HMMVALUECUTOFF

            my $type       = $annot->get_type()     || "G";
            my $a_genename = $annot->get_genename() || $genename;
            my $startpos   = $annot->get_startpos()
               || die "Can't find startpos() from annotpair obtained from external analysis?!? Object=\n" . $annot->ObjectToXML() . "\n";
            my $endpos     = $annot->get_endpos(); # Can be undef

            my $isMinus = 1  if defined($endpos) && $startpos > $endpos;
            my $arrow = $isMinus ? "<==" : "==>";
            &LocateIntrons($dna_seq,undef,$annot,$a_genename,$contigname,$isMinus)
                if (lc($a_genename) eq "rnl" || lc($a_genename) eq "rns" || lc($a_genename) eq "rnpb")
                                                   && $LVL_INTRON != 2;

            my $direction  = $annot->get_direction()  || $arrow;
            my $score      = $annot->get_score() || "";
            my $start_line = $annot->get_startline();
               $start_line = ";     G-$genename $arrow start" if !defined($start_line);
            my $end_line   = $annot->get_endline();  # Can be undef
               $end_line   = ";     G-$genename $arrow end"   if !defined($end_line) && $type eq "G";

            my ($AP_start, $AP_stop) = $startpos > $endpos ? ($endpos, $startpos) : ($startpos, $endpos);
            my $annot_who_overlap    = &WhatOverlapsThis($AP_start,$AP_stop,$contig);
            my ($IsInAP,$ContainAP)  = ([],[]);
               ($IsInAP,$ContainAP)  = &IsInOrContainAP($annot_who_overlap,$AP_start,$AP_stop) if $type ne "AC";
            if ((scalar(@$ContainAP) !=  0 || scalar(@$IsInAP) != 0) &&  $start_line !~ m/group=/) {
               my $idByHMMdef  = !$annot->get_idbyHMM() ? 0 : 1;
               $start_line    .= $idByHMMdef && $annot->get_idbyHMM() == 1 ? " ;; mfannot: score : $score" :" ;; mfannot: evalue : $score";
            }

            $annot->set_type($type);
            $annot->set_genename($a_genename);
            $annot->set_direction($direction);
            $annot->set_startline($start_line);
            $annot->set_endline($end_line);

            # Added comment and adjust pos for partial rna
            my $a_startline    = $annot->get_startline() || next;

            if ($annot->get_idbyHMM() && $annot->get_idbyHMM() == 1 || lc($a_genename) eq "rnpb" ) {
                if (lc($a_genename) ne "rns" && lc($a_genename) ne "rnl" && lc($a_genename) ne "ssra" ) {
                    $a_startline .= $a_startline =~ m/ ;; mfannot:/ ?
                               " / Approximate position"
                             : " ;; mfannot: Approximate position";
                    $annot->set_startline($a_startline);
                }
            }

            if ( $endpos < 0 || $startpos < 0 ) {
                if ($startpos < 0) {
                    $a_startline .= $a_startline =~ m/ ;; mfannot:/ ?
                           " / Partial annotation, start found at pos : $startpos"
                         : " ;; mfannot: Partial annotation, start found at pos : $startpos";
                    $annot->set_startline($a_startline);
                    $annot->set_startpos(1);
                }
                else {
                    $a_startline .= $a_startline =~ m/ ;; mfannot:/ ?
                           " / Partial annotation, stop found at pos : $endpos"
                         : " ;; mfannot: Partial annotation, stop found at pos : $endpos";
                    $annot->set_startline($a_startline);
                    $annot->set_endpos(1);
                }
            }
            if ( $endpos > $seq_length || $startpos > $seq_length ) {
                if ($startpos > $seq_length) {
                    $a_startline .= $a_startline =~ m/ ;; mfannot:/ ?
                           " / Partial annotation, start found at pos : $startpos"
                         : " ;; mfannot: Partial annotation, start found at pos : $startpos";
                    $annot->set_startline($a_startline);
                    $annot->set_startpos($seq_length);
               }
                else {
                    $a_startline .= $a_startline =~ m/ ;; mfannot:/ ?
                           " / Partial annotation, stop found at pos : $endpos"
                         : " ;; mfannot: Partial annotation, stop found at pos : $endpos";
                    $annot->set_startline($a_startline);
                    $annot->set_endpos($seq_length);
                }
            }

            # Add comment
            my $RNAcomment = $annot->get_RNAcomment() || "";
            if ($RNAcomment ne "") {
                $a_startline .= $a_startline =~ m/ ;; mfannot:/ ?
                           " / $RNAcomment"
                         : " ;; mfannot: $RNAcomment";
                $annot->set_startline($a_startline);
            }

            my $add_external_annot = 1;
            if ($genename eq "IntronII" || $genename eq "IntronI") {
                &AdjustIntronicAnnot_ForInitialAnnot($contigname,$annot);
                $add_external_annot = (scalar(@$annotpairs) > 1 || $LVL_INTRON == 2 ) ? 1 : 0;
            }
            &AddAnnotToPirMaster($contigname,$annot) if $add_external_annot == 1;
        } # End foreach annotpair
    } # End foreach annotpaircollection (one per contig)
} # End sub

sub AdjustIntronicAnnot_ForInitialAnnot {
    my ($contigname,$annot) = @_;

    my $contig            = $pirmaster->GetContigByName($contigname) or die "Can't get contig by name in AnnotateEmptyOrfs\n";
    my $a_start           = $annot->startpos() || die "Start position is not defined in AnnotPair :\n ".$annot->ObjectToXML()."\n";
    my $a_end             = $annot->endpos()   || die "End position is not defined in AnnotPair :\n ".$annot->ObjectToXML()."\n";
    my $annot_who_overlap = &WhatOverlapsThis($a_start,$a_end,$contig);

    foreach my $info_who_overlap (@$annot_who_overlap){
        FEATURE: foreach my $features_who_overlap (@$info_who_overlap ){
            my $features_min    = $features_who_overlap->[0];
            my $features_max    = $features_who_overlap->[1];
            my $feature         = $features_who_overlap->[2];

            next if $feature->type ne 'I';
            next if $features_min >  $a_start || $a_start > $features_max ||
                    $features_min >  $a_end   || $a_end   > $features_max;

            my $a_startline = $annot->startline();
            my $type        = $1    if $a_startline =~ m#group=(.+)#;
            die "Internal error : external AP does not contain type on startline?!?\n" unless $type;

            my $intron_type  = $feature->introntype() || "";
               $intron_type .= "," if $intron_type;
               $intron_type .= $type;
            $feature->set_introntype($intron_type);

            my $feature_startline = $feature->startline();

            $feature_startline  =~ s/\s*\/\s*group\s*=\s*\S+//i;
            $feature_startline .= " /group=$intron_type";
            $feature->set_startline($feature_startline);
        } # End foreach $features_who_overlap
    } # End foreach $info_who_overlap
} # End sub

#-----------------------------------------#
# Subs for adjusting intronic boundaries  #
#-----------------------------------------#

sub Adjust_all_intronic_junctions {
    my $contigs     = $pirmaster->get_contigs();

   my %adjustement = (   # This used to be a more complex table...
        -6 => [-6],-5 => [-5],-4 => [-4],
        -3 => [-3],-2 => [-2],-1 => [-1],
         0 => [0],1 => [1],2 => [2],
         3 => [3],4 => [4],5 => [5],
         6 => [6]
    );

    my @introns_info = ();
    foreach my $contig (@$contigs) {
        my $annotations = $contig->get_annotations();
        my $contig_name = $contig->get_name();

        my $seq         = uc($contig->sequence());
           $seq         =~ s/!//g;
        my $reverse_seq = $seq;
           $reverse_seq =~ tr/ACGT/TGCA/;
           $reverse_seq = reverse $reverse_seq;

        foreach my $annot (@$annotations){
            my $a_type = $annot->type();
            next if $a_type ne "I";
            my $a_strand    = $annot->direction()  || next;
            my $isMinus     = ($a_strand eq "==>" ? 0 : 1 );
            my $use_seq     = ($isMinus ? "$reverse_seq" : "$seq");
            push (@introns_info,[$contig,$annot,$seq,$use_seq]);
        }
    }
    return if !@introns_info;

    # Add comment if 0 or 2 introns are id.
    foreach my $intron (@introns_info) {
        my ($contig,$annot,$seq,$use_seq,$adjust_info) = @$intron;

        my $a_introntype   = $annot->get_introntype()   || "";
        my $a_startline    = $annot->get_startline()    || next;
        my @intron_type    = split(/,/, $a_introntype);
        my $nb_type        = @intron_type;

        if ($nb_type == 0) {
            $a_startline .= $a_startline =~ m/ ;; mfannot:/ ?
                          " / no intron type identified"
                        : " ;; mfannot: no intron type identified";
            $annot->set_startline($a_startline);
            $annot->set_globaltype("I");
        }
        elsif ($nb_type == 1) {
            my $global_type = $intron_type[0] =~ m/II/ ? "II" : "I";
            $annot->set_globaltype($global_type);
        }
        elsif ($nb_type >= 2 ) {
            my $add = $nb_type > 2 ? "more than " : "";
            my $global_type = &DefGlobalIntronType(\@intron_type);
            $a_startline .= $a_startline =~ m/ ;; mfannot:/ ?
                          " / $add two introns identified"
                        : " ;; mfannot: ${add}two introns identified";
            $annot->set_startline($a_startline);
            $annot->set_globaltype($global_type);
        }
    }

    #Adjust intron type II
    foreach my $intron (@introns_info) {
        my ($contig,$annot,$seq,$use_seq) = @$intron;

        my $a_introntype = $annot->globaltype() || "";
        next if $a_introntype eq "I";
        if ($a_introntype eq "-1" ) {
            $intron->[1] = undef;
        }
        elsif ($a_introntype eq "II") {
            &Adjust_TypeII($contig,$annot,$use_seq,\%adjustement);
            $intron->[1] = undef; # This intron is done
        }
    } # End foreach intron

    @introns_info = grep( defined($_->[1]) , @introns_info);
    return if !@introns_info;

    # Add splicescore for other intron (maybe type I)
    foreach my $intron (@introns_info) {
        my ($contig,$annot,$seq,$use_seq) = @$intron;

        my $adjust_info = &Add_splicescore($contig,$annot,$use_seq,\%adjustement);
        next if !$adjust_info;
        push(@$intron, $adjust_info);
    } # End foreach $intron

    # Adjust intron if splicescore is good
    foreach my $intron (@introns_info) {
        my ($contig,$annot,$seq,$use_seq,$adjust_info) = @$intron;
        next if !$adjust_info;
        my ($tab_scores,$name_intron,$num_intron,$annot_who_overlap,$annotation,$isMinus) = @$adjust_info;

        my $a_splicescore = $annot->splicescore();
        next if $a_splicescore < 19;
        &AdjustBoundaries($tab_scores,$name_intron,$num_intron,$annot_who_overlap,$annotation,$isMinus,$contig);
        $intron->[1] = undef; # This intron is done
    }

    @introns_info = grep( defined($_->[1]) , @introns_info);
    return if !@introns_info;

    # Add comment if adjustement failed.
    foreach my $intron (@introns_info) {
        my ($contig,$annot,$seq,$use_seq,$adjust_info) = @$intron;
        my ($tab_scores,$name_intron,$num_intron,$annot_who_overlap,$annotation,$isMinus) = @$adjust_info;

        my $a_splicescore  = $annot->get_splicescore();
        my $a_introntype   = $annot->get_globaltype()   || "";
        my $a_startline    = $annot->get_startline()    || next;
        my @intron_type    = split(/,/, $a_introntype);
        my $nb_type        = @intron_type;

        next if $nb_type != 1;
        &AdjustBoundaries($tab_scores,$name_intron,$num_intron,$annot_who_overlap,$annotation,$isMinus,$contig);
    } # End foreach $intron
} # End sub

sub DefGlobalIntronType {
    my $IntronTypes = shift;

    my ($nb_typeI,$nb_typeII) = (0,0);
    foreach my $type (@$IntronTypes) {
        $type =~ m/II/ ? $nb_typeII++ : $nb_typeI++;
    }
    my $GlobalType = -1;
       $GlobalType = "I"  if ($nb_typeI  == scalar(@$IntronTypes));
       $GlobalType = "II" if ($nb_typeII == scalar(@$IntronTypes));
    return $GlobalType;
}

sub Adjust_TypeII {
    my ($contig,$annot,$use_seq,$adjustement) = @_;

    my $contig_name = $contig-> get_name();
    my $a_start     = $annot->startpos()   || return;
    my $a_end       = $annot->endpos()     || return;
    my $a_startline = $annot->startline()  || return;
    my $a_endline   = $annot->endline()    || return;
    my $a_strand    = $annot->direction()  || return;
    my $isMinus     = ($a_strand eq "==>" ? 0 : 1 );
    my ($name_intron , $num_intron)  = ($1,$2) if  $a_startline =~ m#;\s+(G-.+)-I(\d+).+#;
    my $name_of_gene = $1 if ($a_startline =~ m#;\s*[gG]-(\S+)\s+(==>|<==)\s*start#);
    my ($start_pos,$end_pos) = ($isMinus ? ((length($use_seq) + 1 - $a_start),(length($use_seq) + 1 - $a_end)) : ($a_start,$a_end));

    my $phase             = &WhichPhase($annot, $num_intron, $contig);
    my $annot_who_overlap = &WhatOverlapsThis($a_start,$a_end,$contig);

    # View for previous and next exons
    my $previous_exon_name  = $name_intron."-E".$num_intron;
    my $next_exon_name      = $name_intron."-E".($num_intron+1);
    my ($previous_exon_feat,$next_exon_feat) = &Previous_and_next_exons($previous_exon_name,$next_exon_name,$annot_who_overlap);
    last if (!$previous_exon_feat || !$next_exon_feat);

    # Length of previous exon
    my $previous_exon_length = &Length_annot($previous_exon_feat);
    # Length of next exon
    my $next_exon_length     = &Length_annot($next_exon_feat);

    my @tab_scores = ();
    foreach my $adjust_start_pos (sort { $a <=> $b } keys %$adjustement) {
        my $tab = $adjustement->{$adjust_start_pos};
        foreach my $adjust_end_pos (@$tab){
            my $key      = $adjust_start_pos.','.$adjust_end_pos;
            my $scores   = undef;

            next if (($previous_exon_length + $adjust_start_pos) <= 5);
            next if (($next_exon_length     - $adjust_end_pos)   <= 5);

            my $score_nt = &ScoreNtLTypeII($use_seq,$start_pos,$adjust_start_pos)
                         + &ScoreNtRTypeII($use_seq,$end_pos,$adjust_start_pos);

            $score_nt -= abs($adjust_start_pos);
            # $scores is a ref to quintuplet ($score_nt,$score_aa,abs($adjust_start),$adjust_start,$adjust_end) or undef if adjustment is invalid
            $scores = &CheckForCorrespondance($phase, $start_pos, $end_pos, $use_seq, $key,$score_nt,$annot);
            push (@tab_scores, $scores ) if defined $scores;
        }
    }

    @tab_scores = sort { ($b->[0] - $b->[2]) <=> ($a->[0] - $a->[2])
                                  || $b->[1] <=> $a->[1]
                                  || $a->[2] <=> $b->[2]
                                  || $a->[3] <=> $b->[3]} @tab_scores;

    if (!$tab_scores[0]->[0] || $tab_scores[0]->[0] < 40) {
        my $start_line = $annot->get_startline();
        $start_line .= $start_line =~ m/ ;; mfannot:/ ?
                       " / splice boundaries uncertain"
                     : " ;; mfannot: splice boundaries uncertain";
        $annot->set_startline($start_line);
        return;
    }
    &AdjustBoundaries(\@tab_scores,$name_intron,$num_intron,$annot_who_overlap,$annot,$isMinus,$contig);
} # End sub

sub Add_splicescore {
    my ($contig,$annot,$use_seq,$adjustement) = @_;

    my $contig_name = $contig->get_name();
    my $a_start     = $annot->startpos()   || next;
    my $a_end       = $annot->endpos()     || next;
    my $a_startline = $annot->startline()  || next;
    my $a_endline   = $annot->endline()    || next;
    my $a_strand    = $annot->direction()  || next;
    my $isMinus     = ($a_strand eq "==>" ? 0 : 1 );
    my ($name_intron , $num_intron)  = ($1,$2) if  $a_startline =~ m#;\s+(G-.+)-I(\d+).+#;
    my $name_of_gene = $1 if ($a_startline =~ m#;\s*[gG]-(\S+)\s+(==>|<==)\s*start#);
    my ($start_pos,$end_pos) = ($isMinus ? ((length($use_seq) + 1 - $a_start),(length($use_seq) + 1 - $a_end)) : ($a_start,$a_end));

    my $phase = &WhichPhase($annot, $num_intron, $contig);
    my $annot_who_overlap = &WhatOverlapsThis($a_start,$a_end,$contig);

    # View for previous and next exons
    my $previous_exon_name  = $name_intron."-E".$num_intron;
    my $next_exon_name      = $name_intron."-E".($num_intron+1);
    my ($previous_exon_feat,$next_exon_feat) = &Previous_and_next_exons($previous_exon_name,$next_exon_name,$annot_who_overlap);
    return if (!$previous_exon_feat || !$next_exon_feat);

    # Length of previous exon
    my $previous_exon_length = &Length_annot($previous_exon_feat);
    # Length of next exon
    my $next_exon_length     = &Length_annot($next_exon_feat);

    my @tab_scores = ();
    foreach my $adjust_start_pos (sort { $a <=> $b } keys %$adjustement) {
        my $tab = $adjustement->{$adjust_start_pos};
        foreach my $adjust_end_pos (@$tab){
            my $key      = $adjust_start_pos.','.$adjust_end_pos;
            my $scores   = undef;

            next if (($previous_exon_length + $adjust_start_pos) <= 5 && $key ne "0,0");
            next if (($next_exon_length - $adjust_end_pos) <= 5 && $key ne "0,0");

             my $score_nt = &ScoreNtLTypeI($use_seq,$start_pos,$adjust_start_pos)
                          + &ScoreNtRTypeI($use_seq,$end_pos,$adjust_start_pos);

            # $scores is a ref to quintuplet ($score_nt,$score_aa,abs($adjust_start),$adjust_start,$adjust_end) or undef if adjustment is invalid
            $scores = &CheckForCorrespondance($phase, $start_pos, $end_pos, $use_seq, $key,$score_nt,$annot);
            push (@tab_scores, $scores ) if defined $scores;
        }
    }

    @tab_scores = sort { ($b->[0] - $b->[2]) <=> ($a->[0] - $a->[2])
                                  || $b->[1] <=> $a->[1]
                                  || $a->[2] <=> $b->[2]
                                  || $a->[3] <=> $b->[3]} @tab_scores;

    my $splice_score = $tab_scores[0]->[0];
    $annot->set_splicescore($tab_scores[0]->[0]);
    return [\@tab_scores,$name_intron,$num_intron,$annot_who_overlap,$annot,$isMinus];
} # End sub

sub ScoreNtLTypeII {
    my ($use_seq,$start_pos,$adjust_start_pos) = @_;

    my $start_char_plus1 = substr($use_seq,$start_pos + $adjust_start_pos - 1,1);  # Each nt between -6 and 6 of feature_min
    my $start_char_plus2 = substr($use_seq,$start_pos + $adjust_start_pos ,1);
    my $start_char_plus3 = substr($use_seq,$start_pos + $adjust_start_pos + 1,1);
    my $start_char_plus4 = substr($use_seq,$start_pos + $adjust_start_pos + 2,1);
    my $start_char_plus5 = substr($use_seq,$start_pos + $adjust_start_pos + 3,1);

   my $score_nt  = 0;
      $score_nt += 10  if  $start_char_plus1   eq 'G';
      $score_nt += 7.5 if  $start_char_plus2   eq 'T';
      $score_nt += 9   if  $start_char_plus3   eq 'G';
      $score_nt += 10  if  ($start_char_plus4  eq 'C' || $start_char_plus4  eq 'T');
      $score_nt += 10  if  $start_char_plus5   eq 'G';

    return $score_nt;
}

sub ScoreNtRTypeII {
    my ($use_seq,$end_pos,$adjust_end_pos) = @_;

    my $end_char_minus1  = substr($use_seq,$end_pos + $adjust_end_pos -1,1);
    my $end_char_minus2  = substr($use_seq,$end_pos + $adjust_end_pos -2,1);


    my $score_nt  = 0;
       $score_nt += 9   if ($end_char_minus1    eq 'C' || $end_char_minus1  eq 'T');
       $score_nt += 9   if  $end_char_minus2    eq 'A';
   return $score_nt;
}

sub ScoreNtLTypeI {
    my ($use_seq,$start_pos,$adjust_start_pos) = @_;

    my $start_char_minus1 = substr($use_seq,$start_pos + $adjust_start_pos -2,1);  # Each nt between -6 and 6 of feature_min
    my $start_char_minus2 = substr($use_seq,$start_pos + $adjust_start_pos -3,1);
    my $start_char_minus3 = substr($use_seq,$start_pos + $adjust_start_pos -4,1);

    my $score_nt  = 0;
       $score_nt += 5   if $start_char_minus1 eq 'T';
       $score_nt += 3   if $start_char_minus2 eq 'G';
       $score_nt += 3   if $start_char_minus3 eq 'G';

   return $score_nt;
}

sub ScoreNtRTypeI {
    my ($use_seq,$end_pos,$adjust_end_pos) = @_;

    my $end_char_minus1   = substr($use_seq,$end_pos + $adjust_end_pos -1,1);
    my $end_char_minus2   = substr($use_seq,$end_pos + $adjust_end_pos -2,1);
    my $end_char_minus3   = substr($use_seq,$end_pos + $adjust_end_pos -3,1);
    my $end_char_minus4   = substr($use_seq,$end_pos + $adjust_end_pos -4,1);
    my $end_char_minus5   = substr($use_seq,$end_pos + $adjust_end_pos -5,1);
    my $end_char_minus6   = substr($use_seq,$end_pos + $adjust_end_pos -6,1);
    my $end_char_minus7   = substr($use_seq,$end_pos + $adjust_end_pos -7,1);
    my $end_char_minus8   = substr($use_seq,$end_pos + $adjust_end_pos -8,1);
    my $end_char_minus9   = substr($use_seq,$end_pos + $adjust_end_pos -9,1);

     my $score_nt  = 0;
        $score_nt += 10  if $end_char_minus1   eq 'G';
        $score_nt += 0.5 if ($end_char_minus2  eq 'T' || $end_char_minus2  eq 'A');
        $score_nt += 0.5 if ($end_char_minus3  eq 'T' || $end_char_minus3  eq 'A');
        $score_nt += 0.5 if ($end_char_minus4  eq 'T' || $end_char_minus4  eq 'A');
        $score_nt += 0.5 if ($end_char_minus5  eq 'T' || $end_char_minus5  eq 'A');
        $score_nt += 0.5 if ($end_char_minus6  eq 'T' || $end_char_minus6  eq 'A');
        $score_nt += 0.5 if ($end_char_minus7  eq 'T' || $end_char_minus7  eq 'A');
        $score_nt += 0.5 if ($end_char_minus8  eq 'T' || $end_char_minus8  eq 'A');
        $score_nt += 0.5 if ($end_char_minus9  eq 'T' || $end_char_minus9  eq 'A');

    return $score_nt;
}

sub AdjustBoundaries {
    my ($tab_scores,$name_intron,$num_intron,$annot_who_overlap,$feature_intron,$isMinus,$contig) = @_;

    my ($adjust_start,$adjust_end) = ($tab_scores->[0]->[3],$tab_scores->[0]->[4]);
    my $previous_exon_name         = $name_intron."-E".$num_intron;
    my $next_exon_name             = $name_intron."-E".($num_intron+1);

    # Use to defined previous and next exon
    my ($previous_exon_feat,$next_exon_feat) = &Previous_and_next_exons($previous_exon_name,$next_exon_name,$annot_who_overlap);
    ($adjust_start,$adjust_end) = (-$adjust_start,-$adjust_end) if $isMinus;

    # Adjust intron
    my $feature_intron_start = $feature_intron->get_startpos();
    $feature_intron->set_startpos($feature_intron_start + $adjust_start);

    my $feature_intron_end   = $feature_intron->get_endpos();
    $feature_intron->set_endpos($feature_intron_end + $adjust_end);

    # Adjust previous exon
    if (defined $previous_exon_feat) {
        my $previous_exon_end   = $previous_exon_feat->get_endpos();
        $previous_exon_feat->set_endpos($previous_exon_end + $adjust_start);
    }

    # Adjust next exon
    if (defined $next_exon_feat) {
        my $next_exon_start   = $next_exon_feat->get_startpos();
        $next_exon_feat->set_startpos($next_exon_start + $adjust_end);
    }
} # End sub

sub Previous_and_next_exons {
    my ($previous_exon_name,$next_exon_name,$annot_who_overlap) = @_;

    my $previous_exon_feat = undef;
    my $next_exon_feat     = undef;

    foreach my $annotation_who_overlap (@$annot_who_overlap){
        foreach my $feature_overlap (@$annotation_who_overlap) {
            my $feature            = $feature_overlap->[2];
            # next if $feature->get_genename() eq "comment";
            next if $feature->get_genename() eq "comment" || $feature->get_type eq "G";
            my $feature_startline  = $feature->get_startline();
            my ($annotname)        = ($feature_startline =~ m#^;\s+(\S+)#);
            $previous_exon_feat    = $feature if ($annotname eq $previous_exon_name);
            $next_exon_feat        = $feature if ($annotname eq $next_exon_name);
            last if $previous_exon_feat && $next_exon_feat;
        } # End foreach $feature_who_overlap
    } # End foreach $annotation_who_overlap
    return($previous_exon_feat,$next_exon_feat);
} # End sub

sub CheckForCorrespondance {
    my ($phase,$start_pos,$end_pos,$seq,$key,$score_nt,$annot) = @_;

    my $startline = $annot->startline();

    my ($adjust_start,$adjust_end)       = split(/,/,$key);
    my ($old_substring1,$old_substring2) = ("","");
    my ($new_substring1,$new_substring2) = ("","");

    my $comp_phase     = $phase == 0 ? 0 : 3-$phase;
    my $new_phase      = ($phase + $adjust_start) % 3;
    my $comp_new_phase = $new_phase == 0 ? 0 : 3-$new_phase;

    if ($adjust_start <= 0) {
        my $from_old = $start_pos + $adjust_start - 1 - $new_phase;
        my $len_old  = abs($adjust_start)+$new_phase;
        my $from_new = $start_pos + $adjust_start - $new_phase - 1;
        $old_substring1 = substr($seq,$from_old,$len_old);
        $new_substring1 = substr($seq,$from_new,$new_phase);
    }
    elsif ($adjust_start > 0) {
        my $from_old = $start_pos - $phase - 1;
        my $len_old  = $phase;
        my $from_new = $start_pos - $phase - 1;
        my $len_new  = $adjust_start + $phase;
        $old_substring1 = substr($seq,$from_old,$len_old);
        $new_substring1 = substr($seq,$from_new, $len_new);
    }

    if ($adjust_end >= 0) {
        my $from_old = $end_pos;
        my $len_old  = $comp_new_phase + $adjust_end;
        my $from_new = $end_pos + $adjust_end;
        my $len_new  = $comp_new_phase;
        $old_substring2   = substr($seq,$from_old, $len_old);
        $new_substring2   = substr($seq,$from_new, $len_new);
    }
    elsif ($adjust_end < 0) {
        my $from_old = $end_pos ;
        my $len_old  = $comp_phase;
        my $from_new = $end_pos + $adjust_end;
        my $len_new  = - $adjust_end + $comp_phase;
        $old_substring2   = substr($seq,$from_old, $len_old);
        $new_substring2 = substr($seq,$from_new,$len_new);
    }

    my $old_substring = "$old_substring1$old_substring2";
    my $new_substring = "$new_substring1$new_substring2";

    if (length($old_substring) != length($new_substring)){
        print "   WARNING : Combination $adjust_start,$adjust_end not used to adjust boundaries, as they add or delete an amino acid \n";
        return undef;
    }

    if (length($new_substring)%3 != 0){
        print "   WARNING : Combination $adjust_start,$adjust_end not used to adjust boundaries, as they shift the initial readingframe\n
                  Initial phase is $phase the new phase is $new_phase \n
                  Sequence used at start of intron is $new_substring1 \n
                  Sequence used at end of intron is $new_substring2 \n
                  Whole sequence used to check for stop codon is $new_substring\n";
        return undef;
    }

    my @new_aa = ();
    my @old_aa = ();
    for (my $sub_start_pos = 0;  $sub_start_pos <= length($new_substring)-3; $sub_start_pos += 3){
        my $new_codon = substr($new_substring,$sub_start_pos,3);
        push (@new_aa, $CODON_TABLE->{$new_codon} );  # undef is OK here
        my $old_codon = substr($old_substring,$sub_start_pos,3);
        push (@old_aa, $CODON_TABLE->{$old_codon} );  # undef is OK here
    }

    my $score_aa = 0;
    for (my $i = 0;  $i < @new_aa; $i++){
        my $old_aa    = $old_aa[$i] || "X";
        my $new_aa    = $new_aa[$i] || "X";
        $score_aa += $matrix->get_entry($old_aa,$new_aa);
        return undef if $score_aa < 0;
    }

    $score_aa = $score_aa / (@new_aa || 1);
    $score_aa = 9999 if $adjust_start == 0 && $adjust_end == 0;  # 9999 is SUPER GOOD
    return [$score_nt,$score_aa,abs($adjust_start),$adjust_start,$adjust_end];
} # End sub



#---------------------------------#
# Subs for comment gene fusion    #
#---------------------------------#

sub CommentFusion {
    my $contigs   = $pirmaster->get_contigs();

    foreach my $contig ( @$contigs) {
        my $annotations = $contig->get_annotations();
        my $contig_name = $contig->get_name();

        foreach my $annot (@$annotations) {
            my $posiffusion = $annot->get_posiffusion();
            next if !$posiffusion;
            my $arrow       = $annot->get_direction();
            my $gene_name   = $annot->get_genename();
            my $start       = $annot->get_startpos();
            my $end         = $annot->get_endpos();
            my $fusion_name = $annot->get_namefusiongene();
            &AddCommentForFusion($contig_name,$start,$arrow,$gene_name,$fusion_name,"start",1) if $posiffusion == 1;
            &AddCommentForFusion($contig_name,$end,$arrow,$gene_name,$fusion_name,"end",1) if $posiffusion == 2;
            my $comment = &ModifCommentForFirstStart($annot,$annotations);
            next if !$comment;
            my $contig  = $pirmaster->GetContigByName($contig_name);
            my $id_comment  = $1 if scalar($comment) =~ m/0x(.+)\)/;
            my $tab_id = [$id_comment];
            &Remove_AP($tab_id,$contig);
        }
    }
}

sub AddCommentForFusion {
    # Add comment if it's first gene this comment surround the two genes
    my ($contigname,$pos,$arrow,$gene_name,$fusion_name,$tag,$line_number) = @_;

    $pos = $pos + 1 if $arrow eq "==>" and $tag eq "end";
    $pos = $pos - 1 if $arrow eq "<==" and $tag eq "end";

    my $name = ($tag eq "start" ? "${gene_name}_$fusion_name" : "${fusion_name}_$gene_name");
    my $line = ";; G-$name $arrow $tag";

    my $comment = new PirObject::AnnotPair(
                                        type            => "C",
                                        genename        => $name,
                                        startpos        => $pos,
                                        direction       => $arrow,
                                        startline       => $line,
                                        startlinenumber => $line_number
                                       );
    &AddAnnotToPirMaster($contigname,$comment);
}

#---------------------------------#
# Subs for processing empty ORFs  #
#---------------------------------#

sub AnnotateEmptyOrfs {
    # This function takes the empty array of ORF and annotate it as ORFs
    # It means ORF having non corresponding gene in a pepfile
    foreach my $emptyorf (@$EMPTYORFS) {
        # Process each non corresponding orf
        # Get informations  about empty ORF
        my $contigname = $emptyorf->get_contigname();     # Get the contigname corresponding to the empty ORFs
        my $contig     = $pirmaster->GetContigByName($contigname) or die "Can't get contig by name in AnnotateEmptyOrfs\n";
        my $contiglen = $contig->get_sequencelength();

        next if $emptyorf->get_strand() == 2; # Skip ORF on both strand

        # Add endo note
        my $endo_list  = $ENDO_BY_CG->{$contigname};
        my $orf_strand = $emptyorf->get_strand() == 1 ? "==>" : "<==";
        &AddEndoNoteToEmptyOrf($endo_list,$emptyorf,$orf_strand,$contiglen);

        my $strand_orf           = $emptyorf->get_strand();
        my ($isMinus,$step)      = ($strand_orf == 1 ? (0,3) : (1,-3));
        my ($start_orf,$end_orf) = ($emptyorf->get_start(),$emptyorf->get_end());

        my $annot_who_overlap = &WhatOverlapsThis($start_orf,$end_orf,$contig);
        # Keep only !RNA
        my $list_of_pos = [];
        foreach my $list_who_overlap (@$annot_who_overlap) {
            foreach my $AP_who_overlap (@$list_who_overlap ) {
                my $annot = $AP_who_overlap->[2];
                my $name  = $annot->get_genename();
                next if !($name !~ m/rrn5/i && $name !~ m/rnpb/i && $name !~ m/rns/i && $name !~ m/rnl/i && $name !~ m/ssra/i);
                push(@$list_of_pos, $annot->get_startpos(),  $annot->get_endpos())
            }
        }

        @$list_of_pos = sort { $a <=> $b } @$list_of_pos;
        if (scalar(@$list_of_pos) != 0 ) {
            my $retain_val = $isMinus ? @$list_of_pos[0] : @$list_of_pos[-1] ;
            $start_orf    += $step while (($isMinus ? ($start_orf > $retain_val) : ($start_orf < $retain_val)));
        }

        # Do not consider too short ORF
        my $length_orf = $strand_orf == 1 ? $end_orf - $start_orf + 1 : $start_orf - $end_orf + 1;
        next if  ($length_orf < $MINLENEMPTYORF);

         my $annotations       = $contig->get_annotations(); # Get the annotations, for the same contig belonging to empty ORF
         my $seq               = $contig->get_sequence();    # Get the sequence
            $seq               =~ s/!//g;                    # Remove ! from the sequence

        my $possible_start = ();
        my $start_info     = ();
        # Other checking, such as overlapping..........
        for (;;$start_orf += $step) {
            my $start_info = undef;
            # Do not consider too short ORF
            $length_orf    = $strand_orf == 1 ? $end_orf - $start_orf + 1 : $start_orf - $end_orf + 1;
            last if  ($length_orf < $MINLENEMPTYORF);

            my $tri_nt = $isMinus ? uc (substr($seq, $start_orf - 3, 3)) : uc (substr($seq, $start_orf - 1, 3));
               $tri_nt =~ tr/ACGT/TGCA/  if $isMinus;
               $tri_nt = reverse $tri_nt if $isMinus;

            # Check if the tri_nt is a start codon
            my $aa     = uc($CODON_TABLE->{$tri_nt})|| "X";
            my $accepted_aa_for_tri_nt = $ALTERNATIVE_ACCEPTED_START->{$tri_nt} || [];
               $start_info = [$tri_nt,$start_orf] if grep { uc($_) eq "X" } @$accepted_aa_for_tri_nt;
               $start_info = [$tri_nt,$start_orf] if grep { uc($_) eq $aa } @$accepted_aa_for_tri_nt;
            push(@$possible_start,$start_info)    if $start_info;
        }
        $emptyorf->set_possible_start($possible_start);
    }

    my $hash_OV    = {};
    foreach my $emptyorf (@$EMPTYORFS) {
        # Process each non corresponding orf
        # Get informations about empty ORF
        my $possible_starts   = $emptyorf->get_possible_start();
        next if !$possible_starts || scalar(@$possible_starts) == 0;

        my $strand_orf           = $emptyorf->get_strand();
        my ($arrow,$isMinus)     = ($strand_orf == 1 ? ('==>',0) : ('<==',1));

        my ($start_orf,$end_orf) = ($emptyorf->get_start(),$emptyorf->get_end());

        my $contigname        = $emptyorf->get_contigname();     # Get the contigname corresponding to the empty ORFs
        my $contig            = $pirmaster->GetContigByName($contigname) or die "Can't get contig by name in AnnotateEmptyOrfs\n";
        my $annotations       = $contig->get_annotations(); # Get the annotations, for the same contig belonging to empty ORF

        my $tab_OV = !$hash_OV->{$contigname} ? () : $hash_OV->{$contigname};

        my $annotIsOK_gene_without_intron =  scalar(@$possible_starts) != 0 ? 1 : 0;
        next if $annotIsOK_gene_without_intron == 0;

        # The only case to annotate a ORF without know start is when it is long enough
        if (scalar(@$possible_starts) == 0) {
            my ($min_orf,$max_orf) = ($strand_orf == 1 ? ($start_orf,$end_orf) : ($end_orf,$start_orf));
            my $isLongOrf = ((($max_orf-$min_orf+1)/3)-1 >= $OVERLAPORFOVGENE) ? 1 : 0;
            if ($isLongOrf) {
                # Add note about no start found
                my $notes    = $emptyorf->get_notes() || [];
                push(@$notes, "no initiation codon identified");
                $emptyorf->set_notes($notes);
            }
        }

        my ($ToAnnot,$isOV,$start_index) = (0,0,-1);

        # my $remaining_possible_starts = @$possible_starts;

        foreach my $possible_start (@$possible_starts) {
            $start_index++;
            # Accept only ATG as start codon for the ORF
            # then all the other start codons will be considered as alternative start codons
            my $tri_nt    = $possible_start->[0];

            $start_orf    = $possible_start->[1];
            # Use the strand of the ORF to define the min and max of the ORF
            my ($min_orf,$max_orf) = ($strand_orf == 1 ? ($start_orf,$end_orf) : ($end_orf,$start_orf));

            # Special case annotate if the ORF is long enough even if it overlaps a gene
            my $isLongOrf = ((($max_orf-$min_orf+1)/3)-1 >= $OVERLAPORFOVGENE) ? 1 : 0;
            $ToAnnot      = 1 if $isLongOrf;

            # Check if the ORF overlaps a gene or not.
            my $annot_who_overlap = &WhatOverlapsThis($start_orf,$end_orf,$contig);
            @$annot_who_overlap = grep { my $name = $_->[0]->[2]->get_genename(); $name =~ m/^trn/i || ($name !~ m/rrn5/i && $name !~ m/rnpb/i && $name !~ m/rns/i && $name !~ m/rnl/i && $name !~ m/ssra/i) } @$annot_who_overlap;

            # If it does not overlap a gene, then it is annotated
            if (scalar(@$annot_who_overlap) == 0) {
                $ToAnnot = 1;
                last;
            }
            # If it overlaps a gene, check if we need to annotate.
            else {
                ($tab_OV,$isOV,$ToAnnot) = &CheckIfOrfIsToAnnot($annot_who_overlap,$min_orf,$max_orf,$emptyorf,$tab_OV,$isOV,$isLongOrf);
                last if $ToAnnot;
            }
        }

        # Add information about first ATG
        my $firstATG = -1;
        foreach my $possible_start (@$possible_starts[$start_index..$#$possible_starts]) {
            next if $possible_start->[0] ne "ATG";
            $firstATG = $possible_start->[1];
            last;
        }

        # Annotate the ORF
        if ( $ToAnnot == 1) {
            if ($firstATG == -1) {
                my $notes    = $emptyorf->get_notes() || [];
                push(@$notes, "no ATG initiation codon identified");
                $emptyorf->set_notes($notes);
            }
            if ($firstATG != -1 && $start_orf != $firstATG) {
                my $notes    = $emptyorf->get_notes() || [];
                push(@$notes, "first ATG found at position $firstATG");
                $emptyorf->set_notes($notes);
            }
            my $orfannot = &CreateOrfAnnot($end_orf,$start_orf,$isMinus,$possible_starts,$emptyorf);
            &AddAnnotToPirMaster($contigname,$orfannot);
            push(@$tab_OV,$orfannot) if $isOV;
        } # End of if
        $hash_OV->{$contigname} = $tab_OV;
    } # End of for each empty orfs
    &RemovedOVOrfs($hash_OV);
}

sub CheckIfOrfIsToAnnot {
    my ($annot_who_overlap,$min_orf,$max_orf,$emptyorf,$tab_OV,$isOV,$isLongORF) = @_;

    my $ToAnnot = 0;
    my $overlappingcutoff = "";
    foreach my $info_who_overlap (@$annot_who_overlap){
        FEAT: foreach my $features_who_overlap (@$info_who_overlap ){
            my $features_min            = $features_who_overlap->[0];
            my $features_max            = $features_who_overlap->[1];
            my $feature_annot_type      = $features_who_overlap->[2]->type;
            my $feature_annot_direction = $features_who_overlap->[2]->direction;
            my $feature_startpos        = $features_who_overlap->[2]->startpos;
            my $feature_endpos          = $features_who_overlap->[2]->endpos;
            my $feature_endline         = $features_who_overlap->[2]->endline;
            my $feature_contain         = $features_who_overlap->[2]->containStruc || 0;

            #       ------------         ORF
            # * ------------------- **   Gene
            return ($tab_OV,1,$ToAnnot) if ( ($features_min <= $min_orf && $features_max >= $max_orf) && $feature_annot_type eq "G" );
            return ($tab_OV,1,$ToAnnot) if ( ($features_min <= $min_orf && $features_max >= $max_orf) && $feature_annot_type eq "O" );

            # No overlap with tRNA
            if ($isLongORF == 0) {
                $overlappingcutoff = &DefineOVByPercent($min_orf,$max_orf,$info_who_overlap,$emptyorf)
                    if $feature_annot_type ne "O" && $overlappingcutoff eq "";

                # Overlap with gene start or end accepted if < overlappingcutoff
                if ( ($feature_annot_type eq "G" && $features_who_overlap->[3] eq "YES")    # Gene without intron
                || ($feature_annot_type eq "E" && $features_who_overlap->[3] eq "YES")) {   # First or last exon

                    if ( ( $feature_annot_type eq "G" )                                    # Gene whithout intron
                    || ( ($features_who_overlap->[4] eq "FIRST" || $features_who_overlap->[4] eq "LAST")
                    && ( ! ($max_orf < $features_min || $min_orf > $features_max)))) {
                        my $max_start = ( ( $features_min > $min_orf ) ? $features_min : $min_orf);
                        my $min_end   = ( ( $features_max < $max_orf ) ? $features_max : $max_orf );
                        return ($tab_OV,$isOV,$ToAnnot) if ($overlappingcutoff < ( $min_end - $max_start + 1));
                    }
                }
            }

            if ($isLongORF) {
                # If it is in phase with the gene, then annotate the gene and add comment on startline of the gene
                # Should be on same strand and in phase, check for gene without intron and for first exon
                my $annot_direction = $emptyorf->get_strand() eq "==>" ? 1 : -1;
                if ( $annot_direction eq $emptyorf->get_strand() &&
                        (($features_who_overlap->[3] eq "YES" && !$features_who_overlap->[4]) ||
                        ($features_who_overlap->[3] eq "YES" && ($features_who_overlap->[4] && $features_who_overlap->[4]) eq "FIRST"))
                    ) {
                        my $gene_start = $features_who_overlap->[2]->get_startpos();
                        my $orf_start  = $emptyorf->get_start();

                        my $diff = (int($gene_start) - int($orf_start));
                        return($tab_OV,$isOV,$ToAnnot) if ( (int($gene_start) - int($orf_start)) % 3 == 0 );
                }
            }

            if ($feature_annot_type eq "O") {
                push(@$tab_OV,$features_who_overlap->[2]);
                $isOV = 1;
            }
        }
    }
    $ToAnnot = 1;
    return($tab_OV,$isOV,$ToAnnot);
}

sub DefineOVByPercent {
    my ($min_orf,$max_orf,$info_who_overlap,$emptyorf) = @_;

    my $OV_autorized  = "";
    foreach my $features_who_overlap (@$info_who_overlap ){
        my $type   = $features_who_overlap->[2]->type;
        my $isFull = $features_who_overlap->[3] eq "YES" ? 1 : 0;
         next if $type eq "O" || $type ne "G";
        $OV_autorized = $isFull ?
                     &DefineCutForGeneWithoutIntron($min_orf,$max_orf,$info_who_overlap,$emptyorf)
                   : &DefineCutForGeneWithIntron($min_orf,$max_orf,$info_who_overlap,$emptyorf);
        $OV_autorized = 1 if $OV_autorized eq  "";
    }

    return $OV_autorized;
}

sub DefineCutForGeneWithoutIntron {
    my ($min_orf,$max_orf,$info_who_overlap,$emptyorf) = @_;

    foreach my $features_who_overlap (@$info_who_overlap ){
        my $min_gen = $features_who_overlap->[0];
        my $max_gen = $features_who_overlap->[1];
        my $len_ORF = $max_orf - $min_orf + 1;
        my $len_GEN = $max_gen - $min_gen + 1;
        my $OV_autorized = $len_ORF < $len_GEN ? ($OVERLAPPINGCUTOFF*$len_ORF)/100 : ($OVERLAPPINGCUTOFF*$len_GEN)/100;
        return $OV_autorized;
    }
}

sub DefineCutForGeneWithIntron {
    my ($min_orf,$max_orf,$info_who_overlap,$emptyorf) = @_;

    foreach my $features_who_overlap (@$info_who_overlap ){
        next if  $features_who_overlap->[2]->type ne "E";
        my $isFirst = $features_who_overlap->[4] eq "FIRST" ? 1 : 0;
        my $isLast  = $features_who_overlap->[4] eq "LAST"  ? 1 : 0;
        next if !$isLast && !$isFirst;
        my $GEN_isMinus = $features_who_overlap->[2]->direction eq "<==" ? 1 : 0;
        my $min_gen = $features_who_overlap->[0];
        my $max_gen = $features_who_overlap->[1];
        next if ($max_orf < $min_gen || $min_orf > $max_gen);
        my $len_ORF = $max_orf - $min_orf + 1;
        my $len_GEN = $max_gen - $min_gen + 1;
        my $OV_autorized = $len_ORF < $len_GEN ? ($OVERLAPPINGCUTOFF*$len_ORF)/100 : ($OVERLAPPINGCUTOFF*$len_GEN)/100;
        return $OV_autorized;
    }
}

sub CreateOrfAnnot {
    my ($end_orf,$start_orf,$isMinus,$possible_starts, $empty_orf) = @_;

    my $arrow   = !$isMinus ? "==>" : "<==";
    my $orfsize = !$isMinus ? (($end_orf - $start_orf + 1)/3) - 1 : (($start_orf - $end_orf + 1)/3) -1;
    my $GenenameORF = "orf". $orfsize;

    # Annotate the longer ORF and keep the other in comment.
    my ($startline,$endline,$orfannot) = ("","","");
    $startline    = ";     G-$GenenameORF $arrow start";

    # Add info about similar protein
    my $similar_prot = $empty_orf->get_similar_prot();
    $startline   .= " /note=(partially similar to $similar_prot)" if $similar_prot;

    # Add other notes
    my $notes = $empty_orf->get_notes() || undef;
    my $str_notes = join(', ', @$notes) if $notes;
    $startline .= " /note=$str_notes" if $str_notes;

    $endline      = ";     G-$GenenameORF $arrow end";

    $orfannot = new PirObject::AnnotPair(
                                     type      => "O",
                                     genename  => $GenenameORF,
                                     startpos  => $start_orf,
                                     endpos    => $end_orf,
                                     direction => $arrow,
                                     startline => $startline,
                                     endline   => $endline,
                                     possStart => $possible_starts
                                   );
    return ($orfannot);
}

sub RemovedOVOrfs() {
    my ($hash_ORFs) = @_;

    foreach my $contigname ( keys %$hash_ORFs ) {
        my $OV_ORFs = $hash_ORFs->{$contigname};

        # Removed duplicate to $OV_ORFs
        my ($already_in,$clean_ORFs) = ({},());
        foreach my $ORF (@$OV_ORFs){
            my $id = $1 if scalar($ORF) =~ m/0x(.+)\)/;
            next if $already_in->{$id};
            $already_in->{$id}++;
            push(@$clean_ORFs,$ORF);
        }

        # Make a list of AP to rm.
        @$clean_ORFs = sort { abs($b->get_startpos() - $b->get_endpos()) <=> abs($a->get_startpos() - $a->get_endpos()) ||
                        $b->get_direction()                        cmp $a->get_direction()                        ||
                        $a->get_startpos()                         <=> $b->get_startpos()} @$clean_ORFs;

        my $AP_toRM = &MakeListOfORFsToRM($clean_ORFs);

        my $tab_AP_toRM = ();
        foreach my $id (keys %$AP_toRM) {
            push(@$tab_AP_toRM,$id);
        }

        my $contig = $pirmaster->GetContigByName($contigname) or die "Can't get contig by name in AnnotateEmptyOrfs\n";
        &Remove_AP($tab_AP_toRM,$contig)
    }
}

sub MakeListOfORFsToRM {
    my ($ATG_ORFs) = @_;
    my $AP_toRM = {};
    foreach my $ORF_1 (@$ATG_ORFs) {
        my $id_1 = $1 if scalar($ORF_1) =~ m/0x(.+)\)/;
        next if $AP_toRM->{$id_1};
        my $start_1   = $ORF_1->get_startpos();
        my $end_1     = $ORF_1->get_endpos();
        my $isMinus_1 = $ORF_1->get_direction() eq "==>" ? 0 : 1;
        my ($min_1,$max_1) = !$isMinus_1 ? ($start_1,$end_1) : ($end_1,$start_1);
        my $orfsize_1   = (($max_1 - $min_1 + 1)/3) - 1;
        foreach my $ORF_2 (@$ATG_ORFs){ # Attention a ne pas retraiter 2 * les meme cas
            my $id_2 = $1 if scalar($ORF_2) =~ m/0x(.+)\)/;
            next if $AP_toRM->{$id_2};
            next if $ORF_1 eq $ORF_2;
            my $start_2   = $ORF_2->get_startpos();
            my $end_2     = $ORF_2->get_endpos();
            my $isMinus_2 = $ORF_2->get_direction() eq "==>" ? 0 : 1;
            my ($min_2,$max_2) = !$isMinus_2 ? ($start_2,$end_2) : ($end_2,$start_2);
            my $orfsize_2   = (($max_2 - $min_2 + 1)/3) - 1;
            next if $orfsize_2 >= $OVERLORFOVORF;
            my $OV_autorized = ($OVERLAPPINGCUTOFF*$orfsize_2)/100;
            $OV_autorized    =  &Arrondi(abs($OV_autorized),1);
            my $max_start = ( ( $min_1 > $min_2) ? $min_1 : $min_2);
            my $min_end   = ( ( $max_1 < $max_2) ? $max_1 : $max_2);
            my $OV_len = ( $min_end - $max_start + 1);
            next if $OV_len < 0;
            next if ($OV_autorized > ( $min_end - $max_start + 1));
            $AP_toRM->{$id_2}++;
        }
    }
    return $AP_toRM;
}

# sub AnnotateUpstreamAlternativeStart {
#     my $contigs   = $pirmaster->get_contigs();

#     foreach my $contig (@$contigs) {
#         my $annotations = $contig->get_annotations();
#         my $cg_len      = $contig->get_sequencelength();
#         foreach my $annot (@$annotations) {
#         next if $annot->get_type() ne "O";
#         my $lim_5 = &define5lim($annot,$annotations,$cg_len);
#         &DefineAlternativeUpstreamStart($annot,$lim_5);
#         }
#     }
# }

sub define5lim {
    my ($ORFannot,$annotations,$cg_len)= @_;

    my $lim_5 = "";
    foreach my $annot (@$annotations) {
        next if $ORFannot eq $annot;
        next if $annot->get_type() eq "C";
        my $ORF_five   = $ORFannot->get_startpos();
        my $ORFisMinus = $ORFannot->get_direction eq "==>" ? 0 : 1;
        if ($ORFisMinus == 1) {
            my $min = $annot->get_startpos() < $annot->get_endpos() ? $annot->get_startpos : $annot->get_endpos();
            next if $min < $ORF_five;
            $lim_5 = $min if !$lim_5;
            $lim_5 = $lim_5 < $min ? $lim_5 : $min;
        }
        else {
            my $max = $annot->get_startpos() > $annot->get_endpos() ? $annot->get_startpos : $annot->get_endpos();
            next if $max > $ORF_five;
            $lim_5 = $max if !$lim_5;
            $lim_5 = $lim_5 > $max ? $lim_5 : $max;
        }
    }
    if ($lim_5 eq "") {
    my $isMinus = $ORFannot->get_direction eq "<==" ? 1 : 0;
        $lim_5 = !$isMinus ? 1 : $cg_len;
    }
    return $lim_5;
}

sub DefineAlternativeUpstreamStart {
    my ($annot,$lim_5) = @_;

    my $possible_starts = $annot->get_possStart();
    my $isMinus         = $annot->get_direction eq "<==" ? 1 : 0;
    my $ori_start       = $annot->get_startpos();

    my ($alt_start,$aa)   = "";
    foreach my $pos_start (@$possible_starts) {
        next if ($pos_start->[1] < $lim_5)      && !$isMinus;
        next if ($pos_start->[1] >= $ori_start) && !$isMinus;
        next if ($pos_start->[1] > $lim_5)      && $isMinus;
        next if ($pos_start->[1] <= $ori_start) && $isMinus;
        $aa = $pos_start->[0];
        next if $aa eq "ATG";
        $alt_start = $pos_start->[1];
        last;
    }
    my $startline = $annot->get_startline();
    $startline .= " ;; mfannot: $aa upstream: $alt_start" if $alt_start;
    $annot->set_startline($startline);
}

#---------------------------------#
# Subs used to annotate ORFs      #
#     intronic and empty          #
#---------------------------------#

sub AddEndoNoteToEmptyOrf {
    my ($endo_list,$orf,$orf_strand,$contiglen) = @_;

    foreach my $endo_name(keys %$endo_list) {
        my $info_by_endo = $endo_list->{$endo_name};
        foreach my $contig_name_match( keys %$info_by_endo) {
            my $annots  = $info_by_endo->{$contig_name_match}->[0];
            my $fEvalue = $info_by_endo->{$contig_name_match}->[1]->fEvalue;
            foreach my $match_number (keys %$annots){
                my $endo = $annots->{$match_number};

                next if $orf_strand ne $endo->get_direction();

                # Endonuclease
                my $endo_start = $endo->get_startpos();
                my $endo_end   = $endo->get_endpos();

                # ORF
                my $orf_start  = $orf->get_start();
                my $orf_end    = $orf->get_end();

                my $isOV = &OverlappingRegions($contiglen,$orf_start ,$orf_end ,$orf_strand,
                                                          $endo_start,$endo_end,$endo->get_direction());
                next if !$isOV;
                my ($first_start,$second_start)
                            = $endo_start < $orf_start ? ( $endo_start, $orf_start) : ($orf_start, $endo_start);
                my $distance = $second_start - $first_start;

                next if ($distance % 3 != 0);
                my $empty_orf_note = $orf->get_notes() || [];
                my $name          = $endo->get_genename();
                my $note          = $name;
                $note            .= " (likely a pseudo-gene, introduced by plasmid integration)" if $ENDO_HASH->{$name} eq "PSEUDO";
                $note            .= " ;; evalue:$fEvalue";
                push(@$empty_orf_note, $note);
                $orf->set_notes($empty_orf_note);
                last
            }
        }
    }
}

sub GetFirstATGIndex {
    my ($isMinus,$seq,$start_orf,$end_orf) = @_;

    my $orf_seq  = $isMinus ? uc(substr($seq, $end_orf - 1, $start_orf - $end_orf + 1)) :
                              uc(substr($seq, $start_orf - 1, $end_orf - $start_orf + 1));
        $orf_seq  =~ tr/ACGT/TGCA/   if $isMinus;
        $orf_seq  = reverse $orf_seq if $isMinus;
    my @orf_seq_a  = $orf_seq =~ /.{3}/g;
    my $ATGindex = first_index { uc($_) eq 'ATG' } @orf_seq_a;

    return $ATGindex;
}

sub FindORFFirstStartAndValidate {
    my ($start_orf,$end_orf,$isMinus,$isInPhase,$seq,$minimumlengthorf_nt,$orf,$annotIsOk) = @_;

    my $posOffset = $isMinus ? -3 : 3;

    for (;;$start_orf += $posOffset) {
        last if $start_orf >= $end_orf   && !$isMinus;
        last if $end_orf   >= $start_orf && $isMinus;
        last if (($end_orf - $start_orf + 1 ) < $minimumlengthorf_nt) && !$isMinus;
        last if (($start_orf - $end_orf + 1 ) < $minimumlengthorf_nt) &&  $isMinus;  #  Size verification

        my $codon = uc (substr($seq, $start_orf - 1, 3)) if !$isMinus;
           $codon = uc (substr($seq, $start_orf - 3, 3)) if $isMinus;
           $codon =~ tr/ACGT/TGCA/ if $isMinus;
           $codon = reverse $codon if $isMinus;
            if ($isInPhase) {
                my $aa = $CODON_TABLE->{$codon};
                $orf->set_firstAA($aa);
                $codon = "ATG" if $isInPhase;
            }

        # next unless $codon is a key of ALTERNATIVE_ACCEPTED_START
        next unless defined($ALTERNATIVE_ACCEPTED_START->{$codon});
        $annotIsOk = 1;
        last;
    }

    return ($start_orf, $annotIsOk)
}

#------------------------------------#
# Subs for processing intronic ORFs  #
#------------------------------------#

sub AnnotateIntronicOrfs {
    my $Endo_by_cg          = shift;
    my $contigs             = $pirmaster->get_contigs();
    my $minimumlengthorf_nt = $MINLENEMPTYORF;
    my $minimumlengthorf_aa = $minimumlengthorf_nt / 3;
    my $intronic_orfs;
    my $potential_intronic_orfs;

    foreach my $contig (@$contigs) {
        my $name       = $contig->get_name();
        my $annotation = $contig->get_annotations();
        my $seq        = $contig->get_sequence();
           $seq        =~ s/[^atcgATCGnN]//g;
        my $test_prot  = "";
        foreach my $annot (@$annotation) {
            my $type      = $annot->get_type();
            next if $type ne "I";
            my $direction = $annot->get_direction();
            my $start     = $annot->get_startpos();
            my $end       = $annot->get_endpos();
            my $startline = $annot->get_startline();
            my $endline   = $annot->get_endline();
            my ($prefix,$prot) = ("","");

               $prefix     = $1 if $endline   =~ /;\s+G-(\S+)/;
            my $num_intron = $2 if $startline =~ m#G-(\S+)-I(\d+)#;
            for (my $j = 0; $j < 3; $j++) {
                $start                 = $annot->get_startpos() + $j if $direction eq "==>";
                $start                 = $annot->get_startpos() - $j if $direction eq "<==";
                my $min_pos            = ($direction eq "==>" ? $start : $end );
                my $max_pos            = ($direction eq "==>" ? $end : $start );
                my $diff               = $max_pos - $min_pos + 1;
                my $intronic_sequence  = substr($seq, $min_pos -1, $diff);
                my $modulo             = length($intronic_sequence) % 3;
                $intronic_sequence     =~ tr/acgt/ACGT/;
                $intronic_sequence     =~ tr/ACGT/TGCA/ if $direction eq "<==";
                $intronic_sequence     = reverse $intronic_sequence if $direction eq "<==";
                $intronic_sequence     = substr($intronic_sequence,0, length($intronic_sequence)-$modulo);
                $intronic_sequence     =~ tr/a-z/A-Z/;
                my @pos_of_stop        = ();
                ($prot = $intronic_sequence ) =~ s/(...)/$CODON_TABLE->{$1}/ge;
                for (my $i = 0; $i <= length($intronic_sequence) - 3 ; $i += 3) {
                    my $orf;
                    my $strand_current_orf = $direction;
                    my $nt = substr($intronic_sequence,$i,3);
                    my $aa = $CODON_TABLE->{$nt};
                    if ($aa eq "*") {
                        my $relative_pos_of_stop = $i + 3; # In order to include stop codon
                        push(@pos_of_stop, $relative_pos_of_stop);
                    } # if
                } # for
                unshift(@pos_of_stop, 0);
                for (my $i = 0; $i < @pos_of_stop - 1; $i++){
                    next if !( abs($pos_of_stop[$i+1] - $pos_of_stop[$i]) >= $minimumlengthorf_nt );
                    my ($start_orf,$end_orf) = ($direction eq "==>" ?
                                                    ($start + $pos_of_stop[$i],$start + $pos_of_stop[$i+1] - 1) :
                                                    ($start - $pos_of_stop[$i],$start - $pos_of_stop[$i+1] + 1));

                    my $intronic_orf = new PirObject::EmptyOrf (
                                                                start      => $start_orf,
                                                                end        => $end_orf,
                                                                strand     => $direction,
                                                                contigname => $name,
                                                                intron     => $num_intron,
                                                                phase      => $j,
                                                                prefix     => $prefix
                                                               );
                    push (@$intronic_orfs, $intronic_orf);
                } # for $i
            } # for $j
        } # foreach annot
    } # foreach contig

    foreach my $intronic_orf (@$intronic_orfs) {
        my $annotIsOk         = 0;
        my $start_orf         = $intronic_orf->get_start();
        my $end_orf           = $intronic_orf->get_end();
        my $direction         = $intronic_orf->get_strand();
        my $contigname        = $intronic_orf->get_contigname();
        my $prefix            = $intronic_orf->get_prefix();
        my $contig            = $pirmaster->GetContigByName($contigname) or die "Can't get contig by name in AnnotateIntronicOrfs\n";
        my $seq               = $contig->sequence;              # Get the sequence
           $seq               =~ s/!//g;                        # Remove ! from the sequence
        my $annot_who_overlap = &WhatOverlapsThis($start_orf,$end_orf,$contig);
        my $isInPhase         = &IsInPhase($intronic_orf,@$annot_who_overlap);
        my $isMinus           = ($direction eq "==>" ? 0 : 1);
        my $posOffset         = ($isMinus ? -3 : 3);

        # Find the first ATG codon in the ORF
        my $ATGindex = &GetFirstATGIndex($isMinus,$seq,$start_orf,$end_orf);
        if ($ATGindex == -1) {
            my $notes    = $intronic_orf->get_notes() || [];
            push(@$notes, "no ATG initiation codon identified");
            $intronic_orf->set_notes($notes);
        }

        # Iterate over the ORF to find the first accepted start codon
        ($start_orf,$annotIsOk) = &FindORFFirstStartAndValidate($start_orf,$end_orf,$isMinus,$isInPhase,$seq,$minimumlengthorf_nt,$intronic_orf,$annotIsOk);

        if ($ATGindex != -1 && !$isInPhase) {
            my $firstATG = $isMinus ? $intronic_orf->get_start() - $ATGindex * 3 + 1 : $intronic_orf->get_start() + $ATGindex * 3 ;
            if ($firstATG != $start_orf) {
                my $notes    = $intronic_orf->get_notes() || [];
                push(@$notes, "first ATG found at position $firstATG");
                $intronic_orf->set_notes($notes);
            }
        }

        # In case of no start was found but ORF is long enough, add a note
        if ($annotIsOk != 1) {
            $start_orf = $intronic_orf->get_start();
            my $notes  = $intronic_orf->get_notes() || [];
            push(@$notes, "no initiation codon identified");
            $intronic_orf->set_notes($notes);
        }

        # Creating an annotation object for storing in the masterfile
        my $orfsize = $isMinus ? (($start_orf - $end_orf + 1)/3) - 1 : (($end_orf - $start_orf + 1)/3) -1;
        my $GenenameORF = "orf". $orfsize;

        my $diff_nt = $isMinus ? $start_orf - $end_orf + 1 : $end_orf - $start_orf + 1;

        my $seq_orf_nt = substr($seq, $start_orf - 1, $diff_nt) if $direction eq "==>";
           $seq_orf_nt = substr($seq, $end_orf - 1 , $diff_nt)  if $direction eq "<==";
           $seq_orf_nt =~ tr/ACGT/TGCA/                         if $direction eq "<==";
           $seq_orf_nt = reverse $seq_orf_nt                    if $direction eq "<==";
           $seq_orf_nt =~ tr/a-z/A-Z/;

        my $seq_orf_aa = "";
        ($seq_orf_aa = $seq_orf_nt ) =~ s/(...)/$CODON_TABLE->{$1}/ge;

        my $potential_intronic_orf = new PirObject::EmptyOrf (
                                                              start      => $start_orf,
                                                              end        => $end_orf,
                                                              strand     => $direction,
                                                              contigname => $contigname,
                                                              intron     => $intronic_orf->get_intron(),
                                                              phase      => $intronic_orf->get_phase(),
                                                              prefix     => $prefix,
                                                              size       => $orfsize,
                                                              seq        => $seq_orf_aa,
                                                              firstAA    => $intronic_orf->get_firstAA(),
                                                              notes      => $intronic_orf->get_notes(),
                                                             );
        push (@$potential_intronic_orfs, $potential_intronic_orf);
    }

    my %no_annotation;
    return if !$potential_intronic_orfs;
    for (my $i = 0; $i < @$potential_intronic_orfs; $i++) {
        my $start_orf_1     = @$potential_intronic_orfs[$i]->get_start();
        my $end_orf_1       = @$potential_intronic_orfs[$i]->get_end();
        my $direction_orf_1 = @$potential_intronic_orfs[$i]->get_strand();
        my $contig_orf_1    = @$potential_intronic_orfs[$i]->get_contigname();
        my $min_pos_orf_1   = ($direction_orf_1 eq "==>" ? $start_orf_1 : $end_orf_1);
        my $max_pos_orf_1   = ($direction_orf_1 eq "==>" ? $end_orf_1   : $start_orf_1);
        my @tab_for_choose_intron;
        my $selected_orf    = "";
        push(@tab_for_choose_intron, [$i, @$potential_intronic_orfs[$i]]);
        for (my $j = 0; $j < @$potential_intronic_orfs; $j++) {
            next if !($j != $i);
            my $contig_orf_2    = @$potential_intronic_orfs[$j]->get_contigname();
            next if ($contig_orf_1 ne $contig_orf_2);
            my $start_orf_2     = @$potential_intronic_orfs[$j]->get_start();
            my $end_orf_2       = @$potential_intronic_orfs[$j]->get_end();
            my $direction_orf_2 = @$potential_intronic_orfs[$j]->get_strand();
            my $min_pos_orf_2   = ($direction_orf_2 eq "==>" ? $start_orf_2 : $end_orf_2 );
            my $max_pos_orf_2   = ($direction_orf_2 eq "==>" ? $end_orf_2   : $start_orf_2);
            next if !(!($max_pos_orf_1 < $min_pos_orf_2 || $max_pos_orf_2 < $min_pos_orf_1));
            push(@tab_for_choose_intron, [$j, @$potential_intronic_orfs[$j]]);
         }

        if (@tab_for_choose_intron > 1) {
            my $num_selected_orf = &choice_orf(\@tab_for_choose_intron);
            $selected_orf = @$potential_intronic_orfs[$i] if $num_selected_orf == $i;
        }
        else {
            $selected_orf = @$potential_intronic_orfs[$i];
        }

        next if !($selected_orf ne "");
        #  Treatment to add a number after the genename #
        my $GenenameORF = "orf".$selected_orf->get_size();
        my $direction   = $selected_orf->get_strand();
        my $prefix      = $selected_orf->get_prefix();
        my $contigname  = $selected_orf->get_contigname();
        my $first_aa    = $selected_orf->get_firstAA();
        my $startline   = ";     G-$GenenameORF $direction start";
        if ($prefix ne "") {
           $startline   = $first_aa ? ";     G-$prefix-"."$GenenameORF $direction start /first_aa=$first_aa"
                                    : ";     G-$prefix-"."$GenenameORF $direction start";
        }
        my $endline     = ";     G-$GenenameORF $direction end";
           $endline     = ";     G-$prefix-"."$GenenameORF $direction end" if $prefix ne "";

        # Treatment to add a number after the genename #
        my $endo_list = $Endo_by_cg->{$contigname};
        my $contig    = $pirmaster->GetContigByName($contigname) or die "Can't get contig by name in AnnotateIntronicOrfs\n";
        my $contiglen = $contig->get_sequencelength();

        my $strand = $selected_orf->get_strand();
        my $string_strand = "$strand";
        if ($string_strand ne "2") {
            &AddEndoNoteToEmptyOrf($endo_list,$selected_orf,$selected_orf->get_strand(),$contiglen);
        }

        # Add notes information on startline
        my $notes = $selected_orf->get_notes() || undef;
        my $str_notes = join(', ', @$notes) if $notes;
        $startline .= " /note=$str_notes" if $str_notes;

        my $orfannot = new PirObject::AnnotPair(
                                                type      => "O",
                                                genename  => $GenenameORF,
                                                startpos  => $selected_orf->get_start(),
                                                endpos    => $selected_orf->get_end(),
                                                direction => $direction,
                                                startline => $startline,
                                                endline   => $endline,
                                               );

        # Put into the table containing all of the masterfile annotations
        # So before, being put in the masterfile (means in a first time in the annotation table), there are some verification
        &AddAnnotToPirMaster($contigname,$orfannot);
    } # End for
} # End sub

sub choice_orf {
    my $orfs = shift;  # Ref to array of pairs [ idx, Orf_object ]

    if (!(-e "$TMPDIR/fdb_intronic_orf.log")) {
        my $LIB = new IO::File "$intronic_lib" || die ("Can not open the library for intronic orfs");
        while (<$LIB>) {
            next if !($_ =~ /^>/);
            die "The file $intronic_lib doesn't have the good syntax\nat the corresponding line $_"
                if (!($_ =~ /\s*([\S]*)\s*;/));
        }
        $LIB->close();

        my $command      = "$MAKEBLASTDBPATH -dbtype nucl -in $intronic_lib -out $TMPDIR/mf_intronic_orf >/dev/null 2>/dev/null";
        print "$command\n" if $DEBUG;
        my $resformatdb  = system($command);
    }

    foreach my $orf ( @$orfs ) {
        my $name_of_file = "$TMPDIR/orf_".$orf->[0];
        my $orf_seq      = $orf->[1]->get_seq();
        my $orf_num      = $orf->[0];
        my $output       = "$TMPDIR/blastoutput_orf_".$orf->[0];
        my $type         = 'PROT';
        if (!(-e "$name_of_file")){
            my $ORFFILE = new IO::File ">$name_of_file" or die "Cannot open the orffile";
            print $ORFFILE ">ORF_$orf_num\n";
            print $ORFFILE $orf_seq;
            $ORFFILE->close();

            # RUN FOR BLAST : run blast with the db created and the flip results
            my $cmdblast = "nice -19 $BLASTNPATH -outfmt 5 -db $TMPDIR/mf_intronic_orf -query $name_of_file -out $output 2> $TMPDIR/blasterr_1.txt";
            print "$cmdblast\n" if $DEBUG;
            my $resblast = system ($cmdblast);
        }

        my $searchfh = new IO::File "<$output"
           or die "Error: can't find $type report from blastall ?!?\n";
        my @results = PirObject::BlastOutput->FileHandleToObject($searchfh);
        $searchfh->close();

        my $num    = @results;
        die "More than one blast result for one orf\n" if $num > 1;

        $orf->[1]->set_evalue(9999);                # Really bad evalue by default

        my $iters  = $results[0]->BlastOutput_iterations() || next;
        next if @$iters == 0;
        my $hits   = $iters->[0]->Iteration_hits();
        next if !@$hits;
        my $best_evalue = $hits->[0]->significance();

        $orf->[1]->set_evalue($best_evalue);
    }

    my @orfs_sorted = sort{ &CompareHighPrecisionFloats($a->[1]->get_evalue(),$b->[1]->get_evalue())
                                                  ||
                            $b->[1]->get_size()  <=>  $a->[1]->get_size() } @$orfs;

    return $orfs_sorted[0]->[0];
} # End sub

sub IsInPhase {
    my ($intronic_orf,$annot_who_overlap) = @_;

    my $strand_orf     = $intronic_orf->get_strand();
    my $start_orf      = $intronic_orf->get_start();
    my $phase_orf      = $intronic_orf->get_phase();
    my $num_intron     = $intronic_orf->get_intron();
    my ($length_add,$distance_inf_3) = (0,0);

    foreach my $features_who_overlap (@$annot_who_overlap) {
        my $feature     = $features_who_overlap->[2];
        my $f_type      = $feature->get_type();
        my $f_start     = $feature->get_startpos();
        my $f_end       = $feature->get_endpos();
        my $f_direction = $feature->get_direction();
        my $f_startline = $feature->get_startline();
        next if !($f_type eq "E");
        $f_startline =~ m#G-(\S+)-E(\d+)#;
        my $num_exon       = $2;
        my $min_pos        = ($f_direction eq "==>" ? $f_start : $f_end );
        my $max_pos        = ($f_direction eq "==>" ? $f_end   : $f_start );
        if ($num_exon == $num_intron) {
            $distance_inf_3 = 1 if $f_direction eq "==>" && $start_orf - $f_end <= 3;
            $distance_inf_3 = 1 if $f_direction eq "<==" && $f_end - $start_orf <= 3;
        }
        if ($num_exon <= $num_intron) {
            my $length   = $max_pos - $min_pos + 1;
            $length_add += $length;
        }
    } # End foreach $features_who_overlap
    $length_add += $phase_orf;
    return 1 if ($length_add % 3 == 0 && $distance_inf_3 == 1);
    return 0;
} # End sub

#--------------------------------------------------#
# Subs used for find low conserved genes by HMM    #
#--------------------------------------------------#

sub FindLowConservedGenesAndEndoByHMM {
    my $contigs = $pirmaster->get_contigs();

    my $Endo_by_cg = {};
    foreach my $cg (@$contigs) {
        my $OrfFile = &GetORFForLowConservedGenes($cg->get_sequence(),$cg->get_name());
        my ($volume,$directories,$file_name) = File::Spec->splitpath($OrfFile);

        # For gene
        my $ResDirForGene  = "$directories/hmmRes_gene";
        mkdir($ResDirForGene) if !(-d $ResDirForGene);
        &FindLowConservedGenes($cg,$ResDirForGene,$OrfFile,$directories);

        # For endonuclease
        my $ResDirForEndo  = "$directories/hmmRes_endo";
        mkdir($ResDirForEndo) if !(-d $ResDirForEndo);
        $Endo_by_cg = &FindEndo($cg,$ResDirForEndo,$OrfFile,$directories);
    }
    return $Endo_by_cg;
}

sub FindLowConservedGenes {
    my ($cg,$ResDir,$OrfFile,$directories) = @_;

    my ($gene_list,$nb_mito,$nb_chloro) = &GetGeneForThisCg($cg);
    my ($isMito,$isChloro)              = &ChooseGenomeType($gene_list,$MITO_GENE_LIST,$CHLORO_GENE_LIST,$MITO_GENE_TYP,$CHLORO_GENE_TYP,$nb_mito,$nb_chloro);
    my ($missing_genes,$add_name) = ({},"");
    if ($isMito) {
        $missing_genes = &DefinedMissingGene($gene_list,$MITO_GENE_LIST);
        $add_name      = ["_mito"];
    }
    elsif ($isChloro) {
        $missing_genes = &DefinedMissingGene($gene_list,$CHLORO_GENE_LIST);
        $add_name      = ["_chloro"];
    }
    else {
        my $missing_genes_mito   = &DefinedMissingGene($gene_list,$MITO_GENE_LIST);
        my $missing_genes_chloro = &DefinedMissingGene($gene_list,$CHLORO_GENE_LIST);
        foreach my $prot_mito (keys %$missing_genes_mito) {
            my $nb_chloro = $missing_genes_chloro->{$prot_mito} || 0;
            $missing_genes->{$prot_mito} = $missing_genes_mito->{$prot_mito} + $nb_chloro;
        }
        foreach my $prot_chloro (keys %$missing_genes_chloro) {
            next if $missing_genes->{$prot_chloro};
            $missing_genes->{$prot_chloro} = $missing_genes_chloro->{$prot_chloro};
        }
        $add_name      = ["_mito","_chloro"]
    }
    &RunHMMSearchForLowConservedGenes($missing_genes,$OrfFile,$ResDir,$add_name);
    &CreateAllGeneAnnotFindByHMM($directories,$ResDir,$cg->name(),$add_name,$missing_genes);
}

sub FindEndo {
    my ($cg,$ResDir,$OrfFile,$directories) = @_;

    return {} if ($LIGHT);

    my $endo = $ENDO_HASH;
    &RunHMMSearchForLowConservedGenes($endo,$OrfFile,$ResDir);
    my $Endo_by_cg = &CreateAllEndoAnnotFindByHMM($directories,$ResDir,$cg->name());

    # Select the best endonuclease for each contig
    my $best_endo_by_cg = {};
    foreach my $contig_name ( keys %$Endo_by_cg ) {
        my $endo_list = $Endo_by_cg->{$contig_name};
        foreach my $endo_name (keys %$endo_list) {
            my $all_match_by_name = $endo_list->{$endo_name};
            foreach my $match_name (keys %$all_match_by_name) {
                my $fValue = $all_match_by_name->{$match_name}->[1]->fEvalue;
                # Add an entry in best_endo_by_cg if it doesn't exist or if the fValue is better
                # than the previous one key of the entry == name of endonuclease, value == contig name
                if (!$best_endo_by_cg->{$match_name}) {
                    $best_endo_by_cg->{$match_name} = [$endo_name,$fValue];
                } else {
                    my $best_endo_evalue = $best_endo_by_cg->{$match_name}->[1];
                    next if &CompareHighPrecisionFloats($fValue,$best_endo_evalue) == 1;
                    $best_endo_by_cg->{$match_name} = [$endo_name,$fValue];
                }
            }
        }
    }

    # Delete all the endonuclease which are not the best
    foreach my $contig_name ( keys %$Endo_by_cg ) {
        my $endo_list = $Endo_by_cg->{$contig_name};
        foreach my $endo_name (keys %$endo_list) {
          my $all_match_by_name = $endo_list->{$endo_name};
            foreach my $match_name (keys %$all_match_by_name) {
                my $best_match = $best_endo_by_cg->{$match_name};
                delete($Endo_by_cg->{$contig_name}->{$endo_name}->{$match_name}) if
                    $endo_name ne $best_match->[0];
            }
        }
    }

    return $Endo_by_cg;
}

#---- GetGeneForThisCg ----#
sub GetGeneForThisCg {
    my $cg = shift;

    my $gene_list   = [];
    my $annotations = $cg->get_annotations();
    my ($nb_mito,$nb_chloro) = (0,0);
    foreach my $annot (@$annotations) {
        my $gene_type = $annot->get_type();
        next if $gene_type ne "G";
        my $gene_name = $annot->get_genename();
        my $gene_ori  = $annot->get_origine();
        push(@$gene_list,[$gene_name,$gene_ori]);
        next if !$gene_ori;
        $nb_mito++   if $gene_ori eq "mt" || $gene_ori eq "mt_cyano";
        $nb_chloro++ if $gene_ori eq "pt" || $gene_ori eq "pt_cyano";
    }
    return ($gene_list,$nb_mito,$nb_chloro);
}

#---- GetGeneForThisCg ----#
sub ChooseGenomeType {
    my ($gene_list,$mito_gene_list,$chloro_gene_list,$mito_gene_typ,$chloro_gene_typ,$nb_mito,$nb_chloro) = @_;
    my ($isMito,$isChloro) = (0,0);

    foreach my $gene (@$gene_list) {
        my $gene_name = $gene->[0];

        if ($isMito   == 0) {
            my @list = grep(/$gene_name/, @$mito_gene_typ);
            $isMito  = 1 if scalar(@list) != 0;
        }
        if ($isChloro == 0) {
            my @list = grep(/$gene_name/, @$chloro_gene_typ);
            $isChloro  = 1 if scalar(@list) != 0;
        }
    }

    if (($isMito && $isChloro) || (!$isMito && $isChloro)) {
        my $nb_gene = $nb_mito+$nb_chloro;
        my $percent_mito = $nb_mito/$nb_gene;
        if ($percent_mito > 0.5) {
             ($isMito,$isChloro) = (1,0);
        } else {
            ($isMito,$isChloro) = (0,1);
        }
    }
    return ($isMito,$isChloro);
}

#---- DefinedMissingGene ----#
sub DefinedMissingGene {
    my ($cg_gene_list,$global_gene_list) = @_;

    my $missing_gene_list = {%$global_gene_list};
    foreach my $gene (@$cg_gene_list) {
        my $gene_name = $gene->[0];
        delete($missing_gene_list->{$gene_name});
    }
    return $missing_gene_list;
}

#---- GetORFForLowConservedGenes ----#
sub GetORFForLowConservedGenes {
    my ($seq,$name) = @_;

    my $dir = "$TMPDIR/contig";
    mkdir($dir) if !(-d $dir);
    my $subdir = "$dir/$name";
    mkdir($subdir) if !(-d $subdir);
    my $file_name = "$subdir/$name.faa";
    my $fasta_fh  = new IO::File ">$file_name"
        or die "Cannot open $file_name in GetORFForLowConservedGenes\n";
    print $fasta_fh ">$name\n$seq\n";
    $fasta_fh->close();

    my $file_out = "$subdir/$name.orf";
    my $cwd = getcwd();
    chdir("$TMPDIR");
    my $cmd = "$GETORFPATH $file_name -table $GENCODE -outseq $file_out";
    print "$cmd\n" if $DEBUG;
    my $resultat = system("$cmd >/dev/null 2>/dev/null");
    my $hascoredump = ($resultat & 128) >> 7;  # 0 if no core dump, 1 if core dump
    my $signal      = $resultat & 127;  # SIGNAL received by subprocess, from 0 to 127;
    my $returncode  = $resultat >> 8;   # exit status of subprogram
    if ($returncode > 1 || $signal > 0 || $hascoredump == 1) {
        print "Error in execution of HMMsearch in RunHMMSearchForLowConservedGenes subroutine\n";
    }
    chdir("$cwd");
    return $file_out;
}

#---- RunHMMSearchForLowConservedGenes ----#
sub RunHMMSearchForLowConservedGenes {
  my ($missing_genes,$OrfFile,$ResDir,$add_name) = @_;
  $add_name = [""] if !defined($add_name);
  my ($FileRes,$hmm,$FastaName) = ("","","");

  my $totalstart = time;
  my %pidsprots=();
  my %protstarttime=();

  my @prots_todo = sort keys %$missing_genes;
  info "Starting processing for HMMbuild and Align on $NB_PROC processor(s).\n" if $DEBUG;
  for (;;) {
    my $ongoing = scalar(keys %pidsprots);
    last if !@prots_todo && !$ongoing;
    if ($ongoing >= $NB_PROC || !@prots_todo) {
      my $donepid = wait;
      next if $donepid < 0; # should never happen?
      my $prot  = delete($pidsprots{$donepid}) || next;
      my $start = $protstarttime{$prot};
      info "INFO: Processing of protein '$prot' completed in ",(time-$start)," seconds.\n" if $DEBUG;
      next;
    }

    my $prot = shift(@prots_todo);

    # Manage child subprocesses.
    if (my $pid = fork()) {
      $pidsprots{$pid}=$prot;
      $protstarttime{$prot}=time;
      info "INFO: Starting processing of '$prot'\n" if $DEBUG;
      next;
    }

    # Count to know how many models available
    my $cnt = 0;
    $cnt++ if (-f "$HMM_model_path/$prot.hmm");
    foreach my $add (@$add_name) {
      next if $add eq "";
      $cnt++ if (-f "$HMM_model_path/${prot}$add.hmm");
    }

    if ($cnt == 0) {
      print "No HMM model found for $prot in $HMM_model_path, $prot is not searched\n"; next;
    }
    if (   scalar(@$add_name) == 1 && $cnt == 2) {
      print "Too many HMM models found for $prot in $HMM_model_path, $prot is not searched\n"; next;
    }
    elsif (scalar(@$add_name) == 2 && $cnt == 3) {
      print "Too many HMM models found for $prot in $HMM_model_path, $prot is not searched\n"; next;
    }

    foreach my $add (@$add_name) {
      my $hmmFile = (-f "$HMM_model_path/$prot.hmm") ? "$HMM_model_path/$prot.hmm" : "$HMM_model_path/${prot}$add.hmm";

      my $FileRes .= $add eq "" ? "$ResDir/$prot" :"$ResDir/${prot}$add" ;
      my $cmd = "nice -19 $HMMSEARCHPATH --noali --max -E 0.0001 -o $FileRes $hmmFile $OrfFile";
      print "$cmd\n" if $DEBUG;

      my $resultat = system("$cmd >/dev/null 2>/dev/null");

      my $hascoredump = ($resultat & 128) >> 7;  # 0 if no core dump, 1 if core dump
      my $signal      = $resultat & 127;  # SIGNAL received by subprocess, from 0 to 127;
      my $returncode  = $resultat >> 8;   # exit status of subprogram
      if ($returncode > 1 || $signal > 0 || $hascoredump == 1) {
        print "Error in execution of HMMsearch in RunHMMSearchForLowConservedGenes subroutine\n";
      }
      last if (-f "$HMM_model_path/$prot.hmm");
    }
    exit 0;
  }
}

#---- CreateAllGeneAnnotFindByHMM ----#
sub CreateAllGeneAnnotFindByHMM {
    my ($HighDir,$ResDir,$contigname,$add_name) = @_;

    my $both       = scalar(@$add_name) == 2 ? 1 : 2;
    my $contig     = $pirmaster->GetContigByName($contigname);
    my $seq        = $contig->get_sequence();
       $seq        = lc($seq);
    my $contiglen  = $contig->get_sequencelength();

    my $AllHMMAnnot = &CreateAllHMMAnnot($ResDir,$contigname,$contig,$both);

    my $keepAnnot = [];
    my $OrfFile = "$HighDir/$contigname.orf";

    # Check and remove false intron.
    $AllHMMAnnot = &CheckForFalseIntrons($AllHMMAnnot,$OrfFile,$contigname,$seq,$contiglen);
    # Case of simple duplication
    $AllHMMAnnot = &CheckForDuplicate($AllHMMAnnot,$OrfFile);

    # sort_annots_simple  --> just one match or simple duplicate
    # sort_annots_complex --> case whith intron(s) ?
    my ($sort_annots_simple,$sort_annots_complex) = &SortHMMAnnot($AllHMMAnnot);

    return if scalar(@$sort_annots_simple) == 0 && scalar(@$sort_annots_complex) == 0;
    $sort_annots_simple  = &MakeSelectionForSimpleCase($sort_annots_simple,$contig);

    my $complex_struct   = [];
    ($sort_annots_simple,$complex_struct) = &MakeSelectionForComplexCase($sort_annots_simple,$sort_annots_complex,$contig);

    # Add complete annotation and exons annotations if required
    foreach my $annot (@$sort_annots_simple) {
        my $tab_exons = [];
        foreach my $hash (@$complex_struct) {
            foreach my $cnt (keys %$hash) {
                my $complete_gene = $hash->{$cnt}->{"complete"};
                next if $complete_gene ne $annot;
                my $exons = $hash->{$cnt}->{"exons"};
                foreach my $exons (@$exons) {
                    push(@$tab_exons,$exons);
                }
            }
        }

        # W/o introns or with introns
        if (scalar(@$tab_exons) == 0) {
            $annot = &FindStartAndStopForSimpleGeneIdByHMM($annot,$seq,$contiglen);
            my $genename = $annot->get_genename;
            &AddAnnotToPirMaster($contigname,$annot);
        }
        else {
            foreach my $exon (@$tab_exons) {
                my $HMMmatch  = $exon->get_HMMmatch();
                my $startline = $exon->get_startline();
                   $startline = "$startline ;; $HMMmatch";
                $exon->set_startline($startline);
                &AddAnnotToPirMaster($contigname,$exon);
            }
            &FindStartAndStopForComplexGeneIdByHMM($annot,$tab_exons,$OrfFile,$seq);
            my $genename = $annot->get_genename;
        }
    }
}

sub CreateAllHMMAnnot {
    my ($ResDir,$contigname,$contig,$both) = @_;

    my $AllHMMAnnot = {};
    my %dir  = ();
    tie %dir, 'IO::Dir', $ResDir;

    foreach my $Res (keys %dir) {
        next if $Res =~ m/^\./;
        my $FileRes = "$ResDir/$Res";
        my $Searchfh  = new IO::File "<$FileRes"
            or die "Can't read from file '$FileRes': $!\n";
        my @tab   = <$Searchfh>;
        $Searchfh->close();

        my $HMMRes = new PirObject::HMMsearchOutput();
           $HMMRes->FillFeaturesFromTextOutput(\@tab);

        my $AllHMMRes =  $HMMRes->get_Iterations()->[0]->get_resume();

        my $resumes = $HMMRes->get_Iterations()->[0]->get_resume();
        if (scalar(@$resumes) == 0) {
            unlink($FileRes);
            next;
         }
         my $QueryInfo = $HMMRes->get_Iterations()->[0]->get_QueryModel();
         my $QueryLen  = $1 if $QueryInfo =~ m/\(\s*(\d+)\s*nodes\s*\)/;

         foreach my $resume (@$resumes) {
            next if $resume->get_BeforeThresh() == 0;
            my $fEvalue = $resume->get_fEvalue();
            next if &CompareHighPrecisionFloats($fEvalue,"$HMMVALUECUTOFF") == 1; # fEvalue > $HMMVALUECUTOFF
            my $alignments = $resume->get_alignments();
            my $annots     = {};
            # Important need to be sort by aliFrom for remove false intron after
            foreach my $key (sort{ $alignments->{$a}->{aliFrom} <=> $alignments->{$b}->{aliFrom}} keys %$alignments) {
                my $ali = $alignments->{$key};
                my $annot = &CreateAnnotCommentForHMM($resume,$ali,$Res,$contigname,$both);
                my $idORF = $annot->get_IdORF();
                $annot->set_HMMlen($QueryLen);
                $annots->{$key} = $annot;
             }
             $AllHMMAnnot->{$Res}->{$resume->get_SeqIdAndDesc()} = [$annots,$resume];
         }
    }
    return $AllHMMAnnot;
}

sub CheckForFalseIntrons {
    my ($AllHMMAnnot,$OrfFile,$contigname,$seq,$contiglen) = @_;

    my $stock_annot = [];
    foreach my $name (keys %$AllHMMAnnot) {
        my $AllHMMAnnotByGene = $AllHMMAnnot->{$name};
        foreach my $Orf (keys %$AllHMMAnnotByGene) {
            my $annots = $AllHMMAnnotByGene->{$Orf}->[0];
            next if scalar(keys %$annots) == 1;

            my $resume    = $AllHMMAnnotByGene->{$Orf}->[1];
            my $isInOrder = &CheckHMMMatchOrder($resume);
            next if !$isInOrder;

            # Make verification for intron position
            if ($LVL_INTRON == 1) {
                my $description        = $resume->get_Description();
                my $direction          = $description =~ m/REVERSE SENSE/ ? "<==" : "==>";
                my $isMinus            = $direction eq "==>" ? 0 : 1;
                my ($StartOrf,$EndOrf) = ($1,$2) if $description =~ m/\[\s*(\d+)\s*-\s*(\d+)\s*\]/;
                my $annot = new PirObject::AnnotPair( type      => "C",
                                                      genename  => "ORF",
                                                      startpos  => $StartOrf,
                                                      endpos    => $EndOrf,
                                                      direction => $direction,
                                                      startline => "",
                                                      endline   => "");
                my $flag = $1 if $annot  && scalar($annot)  =~ m/0x(.+)\)/;
                push(@$stock_annot,$annot);
                &LocateIntrons($seq,undef,$annot,$name,$contigname,$isMinus);
            }

            # Generation of gap list.
            my $gap_list = CreateGapList($resume,$name,$contigname);

            # Check if 2 gap is OV.
            $gap_list    = &CheckIfTwoGapOV($gap_list);

            # If 2 gap OV make fusion between ali "before" and "after" gap
            my $alignments = $resume->get_alignments();
            ($gap_list,$alignments,$annots) = &RemoveFalseIntron($gap_list,$alignments,$annots);
            next if (scalar keys(%$gap_list) == 0);

            # Extract intron annotations.
            my $introns_list = &ExtractIntronsList($contigname);

            # Check if gap between match contain intron.
            foreach my $key (sort { $a <=> $b } keys(%$gap_list)) {
                my $gap = $gap_list->{$key};
                my ($gStart,$gEnd,$gDir) = ($gap->{start},$gap->{end},$gap->{dir});

                foreach my $annot (@$introns_list) {
                    my ($Istart,$Iend,$Idir) = ($annot->get_startpos(),$annot->get_endpos(),$annot->direction());
                    my $isOV = &OverlappingRegions($contiglen,$gStart,$gEnd,$gDir,$Istart,$Iend,$Idir);
                    $gap->{OVintron} = 1 if $isOV == 1;
                }
            }
            ($gap_list,$alignments,$annots) = &RemoveFalseIntron($gap_list,$alignments,$annots);
        }
    }
    return $AllHMMAnnot;
}

sub CheckHMMMatchOrder {
    my $resume = shift;

    my $alignments = $resume->get_alignments();
    my $prev_hmmFrom = -1;
    my $isOk = 1;
    foreach my $key (sort{ $alignments->{$a}->{aliFrom} <=> $alignments->{$b}->{aliFrom}} keys %$alignments) {
        my $ali = $alignments->{$key};
        my ($aliFrom,$hmmFrom) = ($ali->{aliFrom},$ali->{hmmFrom});
        if ($prev_hmmFrom == -1) {
            $prev_hmmFrom = $hmmFrom;
            next;
        }
        else {
            $isOk = 0 if $prev_hmmFrom > $hmmFrom;
            # As we sort ali by aliTo this test is enough to check good order.
        }
    }
    return $isOk;
}

sub CreateGapList {
    my ($resume,$name,$contigname) = @_;

    my $alignments = $resume->get_alignments();
    my $gap_list   = {};
    my $start_gap  = 0;
    my ($cnt_gl,$cnt_gap) = (0,0);
    foreach my $key (sort{ $alignments->{$a}->{aliFrom} <=> $alignments->{$b}->{aliFrom}} keys %$alignments) {
        my $ali = $alignments->{$key};
        my ($SimiStart,$SimiEnd) = &GetSimilarityPos($resume,$ali);
        my $description          = $resume->get_Description();
        my $direction            = $description =~ m/REVERSE SENSE/ ? "<==" : "==>";

        if ($cnt_gl % 2 == 0) {
            $start_gap = $SimiEnd;
        }
        else {
            my $addToStart = $direction eq "==>" ?  1 : -1;
            my $addToEnd   = $direction eq "==>" ? -1 :  1;

            $gap_list->{$cnt_gap} = { start => $start_gap + $addToStart, end => $SimiStart + $addToEnd, dir => $direction};
            $cnt_gap++
        }
        $cnt_gl++;
    }
    return $gap_list;
}

sub RemoveFalseIntron {
    my ($gap_list,$alignments,$annots) = @_;

    my $cnt = 0;
    my $prev_key = "";
    foreach my $key (sort{ $alignments->{$a}->{aliFrom} <=> $alignments->{$b}->{aliFrom}} keys %$alignments) {
        if ($prev_key eq "") {
            $prev_key = $key;
            $cnt++;
            next;
        }
        my $gap      = $gap_list->{$cnt-1};
        my $OV       = $gap->{OV}       || 0;
        my $OVintron = $gap->{OVintron} || 0;

        if ($OV == 0 && $OVintron == 1) {
            $cnt++; next;
        }

        # Change values in $ali and delete $prev_ali
        my $ali      = $alignments->{$key};
        my $prev_ali = $alignments->{$prev_key};

        my $From_key   = $prev_key;
        my $To_key     = $ali->{aliTo}  > $prev_ali->{aliTo}  ? $key : $prev_key;
        # Perahps not the better approximation
        my $evalue_key = $ali->{Cvalue} < $prev_ali->{Cvalue} ? $key : $prev_key;

        $ali->{aliFrom} = $alignments->{$From_key}->{aliFrom};
        $ali->{hmmFrom} = $alignments->{$From_key}->{hmmFrom};
        $ali->{envFrom} = $alignments->{$From_key}->{envFrom};

        $ali->{aliTo}   = $alignments->{$To_key}->{aliTo};
        $ali->{hmmTo}   = $alignments->{$To_key}->{hmmTo};
        $ali->{envTo}   = $alignments->{$To_key}->{envTo};

        $ali->{Cvalue}  = $alignments->{$evalue_key}->{Cvalue};
        $ali->{Ivalue}  = $alignments->{$evalue_key}->{Ivalue};
        delete $alignments->{$prev_key};

        # Change values in $ali
        my $annot        = $annots->{$key};
        my $prev_annot   = $annots->{$prev_key};
        my $new_startpos = $prev_annot->get_startpos();
        $annot->set_startpos($new_startpos);
        $annot->set_score($ali->{Cvalue});
        my $startline    = $annot->get_startline();
        my $startInHMM   = $ali->{hmmFrom};
        my $HMMmatch     = $annot->get_HMMmatch();
           $HMMmatch =~ s/(\d+)(,\d+)/${startInHMM}${2}/;
        $annot->set_HMMmatch($HMMmatch);
        delete $annots->{$prev_key};

        delete $gap_list->{$cnt-1};
        $prev_key = $key;
        $cnt++;
    }
    return ($gap_list,$alignments,$annots);
}

sub ExtractIntronsList {
    my ($contigname) = shift;

    my $contig      = $pirmaster->GetContigByName($contigname) or die "Can't get contig by name in AnnotateEmptyOrfs\n";
    my $annotations = $contig->get_annotations(); # Get the annotations, for the same contig belonging to empty ORF

    my $introns_list = [];
    foreach my $annot (@$annotations) {
         my $type = $annot->get_type();
         next if $type ne "C" && $type ne "I";
         my $line = $annot->get_startline();
         next if $line !~ m/\/group=/;
         push(@$introns_list,$annot);
    }
    return $introns_list;
}

sub CheckForDuplicate {
    my ($AllHMMAnnot,$OrfFile) = @_;

    # Extract resumes in order to check duplication.
    my $isDup = 0;
    foreach my $name (keys %$AllHMMAnnot) {
        my $AllHMMAnnotByGene = $AllHMMAnnot->{$name};
        my ($resume1,$resume2) = ("","");
        my $cnt = 1;
        foreach my $Orf (keys %$AllHMMAnnotByGene) {
            if (scalar (keys %$AllHMMAnnotByGene) != 2) {
                my $annots = $AllHMMAnnotByGene->{$Orf}->[0];
                my $cnt = 0;
                foreach my $key (keys %$annots) {
                    my $annot = $annots->{$key};
                    $annot->set_isDup(0);
                }
            }
            else {
                $resume1 = $AllHMMAnnotByGene->{$Orf}->[1] if $cnt == 1;
                $resume2 = $AllHMMAnnotByGene->{$Orf}->[1] if $cnt == 2;
                $cnt++;
            }
        }
        $isDup = &CheckIfHMMERFindADuplicate($resume1,$resume2,$OrfFile) if $resume1 ne "";
        return $AllHMMAnnot if $isDup == 0;
    }

    foreach my $name (keys %$AllHMMAnnot) {
        my $AllHMMAnnotByGene = $AllHMMAnnot->{$name};
        foreach my $Orf (keys %$AllHMMAnnotByGene) {
            my $annots = $AllHMMAnnotByGene->{$Orf}->[0];
            foreach my $key (keys %$annots) {
                my $annot = $annots->{$key};
                $annot->set_isDup(1);
            }
        }
    }
    return $AllHMMAnnot;
}

sub CheckIfHMMERFindADuplicate {
    my ($resume1,$resume2,$OrfFile) = @_;

    my $isMinus_resume1 = $resume1->get_Description() !~ m/\(REVERSE SENSE\)/ ? 0 : 1;
    my $isMinus_resume2 = $resume2->get_Description() !~ m/\(REVERSE SENSE\)/ ? 0 : 1;

    # If res1 and 2 is in same strand no duplicate.
    return 0 if $isMinus_resume1 == $isMinus_resume2;
    my $seqIdAndDesc1 = $resume1->get_SeqIdAndDesc();
    my $resume1_full5 = &GetORF($OrfFile,$seqIdAndDesc1);
    my $seqIdAndDesc2 = $resume2->get_SeqIdAndDesc();
    my $resume2_full5 = &GetORF($OrfFile,$seqIdAndDesc2);
    return $resume1_full5 eq $resume2_full5 ? 1 : 0;
}

sub SortHMMAnnot {
    my ($AllHMMAnnot) = shift;

    my ($sort_annots_simple,$sort_annots_complex) = ([],[]);

    foreach my $gene (keys %$AllHMMAnnot) {
        my $AllHMMAnnotByGene = $AllHMMAnnot->{$gene};

        # Simple case no intron
        if (scalar(keys %$AllHMMAnnotByGene) == 1) {
            foreach my $Orf (keys %$AllHMMAnnotByGene) {
                my $annots = $AllHMMAnnotByGene->{$Orf}->[0];
                foreach my $key (keys %$annots) {
                   my $annot = $annots->{$key};
                   push(@$sort_annots_simple,$annot);
                }
            }
        }
        # More complex can be a duplication or a gene with intron
        elsif (scalar(keys %$AllHMMAnnotByGene) == 2) {
            foreach my $Orf (keys %$AllHMMAnnotByGene) {
            my $annots = $AllHMMAnnotByGene->{$Orf}->[0];
                foreach my $key (keys %$annots) {
                    my $annot = $annots->{$key};
                    my $isDup = $annot->get_isDup() || 0;
                    $isDup == 1 ? push(@$sort_annots_simple,$annot) : push(@$sort_annots_complex,$annot);
                }
            }
        }
        # Gene with intron suspected
        else {
            foreach my $Orf (keys %$AllHMMAnnotByGene) {
            my $annots = $AllHMMAnnotByGene->{$Orf}->[0];
                foreach my $key (keys %$annots) {
                    my $annot = $annots->{$key};
                    push(@$sort_annots_complex,$annot);
                }
            }
        }
    }

    @$sort_annots_simple  = sort { &CompareHighPrecisionFloats($a->get_score(),$b->get_score) } @$sort_annots_simple;
    @$sort_annots_complex = sort { &CompareHighPrecisionFloats($a->get_score(),$b->get_score) } @$sort_annots_complex;
    return ($sort_annots_simple,$sort_annots_complex);
}

sub MakeSelectionForSimpleCase {
    my ($sort_annots_simple,$contig) = @_;

    # A quick pass to remove keep only one annot in case of duplicate
    # same genename and same IdORF, remove the one with the lowest score
    my $sort_annots_simple_wo_dup = [];
    foreach my $annot (@$sort_annots_simple) {
        my $genename = $annot->get_genename();
        my $IdORF    = $annot->get_IdORF();

        # Check if already in $sort_annots_simple_wo_dup
        next if (grep { $_->get_genename() eq $genename && $_->get_IdORF() eq $IdORF } @$sort_annots_simple_wo_dup);
        push(@$sort_annots_simple_wo_dup,$annot);
    }

    my $new_sort = [];
    my $contiglen  = $contig->get_sequencelength();

    # First time remove annot who OV gene id by DefineOVByPercentreviously.
    foreach my $annot (@$sort_annots_simple_wo_dup) {
        my $annot_who_overlap = &WhatOverlapsThis($annot->get_startpos(),$annot->get_endpos(),$contig);

        my $to_add = 0; # counter to decide if $annot should be keep or not
        foreach my $info_who_overlap (@$annot_who_overlap){
            foreach my $features_who_overlap (@$info_who_overlap ){
                my $min_annot = $annot->get_direction() eq "==>" ? $annot->get_startpos() : $annot->get_endpos() ;
                my $max_annot = $annot->get_direction() eq "==>" ? $annot->get_endpos()   : $annot->get_startpos;
                my $overlappingcutoff = &DefineOVByPercent($min_annot,$max_annot,$info_who_overlap,$annot);

                # Overlap with gene start or end accepted if < overlappingcutoff
                my $feature_annot_type      = $features_who_overlap->[2]->type;
                my $feature_annot_name      = $features_who_overlap->[2]->genename;
                my $features_min            = $features_who_overlap->[0];
                my $features_max            = $features_who_overlap->[1];

                # Special case if overlap rns or rnl gene
                if ($feature_annot_name eq "rnl" || $feature_annot_name eq "rns") {
                    $to_add++;
                } elsif ( ($feature_annot_type eq "G" && $features_who_overlap->[3] eq "YES")      # Gene without intron
                  || ($feature_annot_type eq "E" && $features_who_overlap->[3] eq "YES")
                  || ($feature_annot_type eq "O" && $features_who_overlap->[2]->containStruc)) {   # First or last exon

                    if ($feature_annot_type eq "O" && $features_who_overlap->[2]->containStruc) {
                    $to_add++;
                } elsif ( ( $feature_annot_type eq "G" )                                    # Gene whithout intron
                         || ( ($features_who_overlap->[4] eq "FIRST" || $features_who_overlap->[4] eq "LAST")
                         && ( ! ($max_annot < $features_min || $min_annot > $features_max)))) {

                        my $max_start = ( ( $features_min > $min_annot ) ? $features_min : $min_annot);
                        my $min_end   = ( ( $features_max < $max_annot ) ? $features_max : $max_annot );
                        $to_add++ if ($overlappingcutoff > ( $min_end - $max_start + 1));
                    }
                }
            }
        }
        push(@$new_sort,$annot) if scalar(@$annot_who_overlap) == $to_add;
    }

    $sort_annots_simple = $new_sort;

    # Second time remove OV gene id by HMM
    my $i_toDelete = [];
    for (my $i = @$sort_annots_simple - 1; $i >= 0 ; $i--) {
        my $annot_i = $sort_annots_simple->[$i];
        my $name = $annot_i->get_genename();
        my ($iStart,$iEnd,$iDir) = ($annot_i->get_startpos(),$annot_i->get_endpos,$annot_i->get_direction);
        for (my $j = $i - 1; $j >= 0 ; $j--) {
            next if $i_toDelete == 1;
            my $annot_j = $sort_annots_simple->[$j];
            my ($jStart,$jEnd,$jDir) = ($annot_j->get_startpos(),$annot_j->get_endpos,$annot_j->get_direction);
            my $isOV = &OverlappingRegions($contiglen,$iStart,$iEnd,$iDir,$jStart,$jEnd,$jDir);
            next if !$isOV;
            push(@$i_toDelete,$i) if (!(grep($i, @$i_toDelete)));
        }
    }

    return $sort_annots_simple if scalar(@$i_toDelete) == 0;
    for (my $i = @$sort_annots_simple - 1; $i >= 0 ; $i--) {
        splice(@$sort_annots_simple, $i, 1) if grep($_ == $i, @$i_toDelete);
    }

    return $sort_annots_simple;
}

sub MakeSelectionForComplexCase {
    my ($sort_annots_simple,$sort_annots_complex,$contig) = @_;

    # Select other simple annot in $sort_annots_complex which with > 95% OV model
    for (my $i = @$sort_annots_complex - 1; $i >= 0 ; $i--) {
        my $annot       = $sort_annots_complex->[$i];
        my $HMMlen      = $annot->get_HMMlen();
        my $Minlen      = $HMMlen * 0.95;
        my ($HMMmatchStart,$HMMmatchEnd) = ($1,$2) if $annot->get_HMMmatch =~ m/(\d+),(\d+)/;
        my $HMMmatchLen = $HMMmatchEnd-$HMMmatchStart +1;
        next if $HMMmatchLen < $Minlen;
        push(@$sort_annots_simple,$annot);
        splice(@$sort_annots_complex, $i, 1);
    }

    @$sort_annots_simple  = sort { &CompareHighPrecisionFloats($a->get_score(),$b->get_score) } @$sort_annots_simple;
    $sort_annots_simple   = &MakeSelectionForSimpleCase($sort_annots_simple,$contig);

    # Need to recalcul score for gene with intron
    my $complex_annot = &TryToReconstructFullGene($sort_annots_complex);
    my $sort_complex_annot = [];
    foreach my $hash (@$complex_annot) {
        foreach my $cnt (keys %$hash) {
            my $complete_gene = $hash->{$cnt}->{"complete"};
            push (@$sort_complex_annot, $complete_gene);
        }
    }

    $sort_annots_simple  = [@$sort_annots_simple,@$sort_complex_annot];
    @$sort_annots_simple = sort { &CompareHighPrecisionFloats($a->get_score(),$b->get_score) } @$sort_annots_simple;
    $sort_annots_simple  = &MakeSelectionForSimpleCase($sort_annots_simple,$contig);

    return ($sort_annots_simple,$complex_annot);
}

sub TryToReconstructFullGene {
    my $annotations = shift;

    my $AnnotByName = {};
    foreach my $annot (@$annotations) {
        my $name = $annot->get_genename();
        my $dir  = $annot->get_direction();
        my $tab  = $AnnotByName->{$name}->{$dir} || [];
        push(@$tab,$annot);
        $AnnotByName->{$name}->{$dir} = $tab;
    }

    my $tab_annots = [];
    foreach my $name (keys %$AnnotByName) {
        my $AnnotByDir = $AnnotByName->{$name};
        # FW and BW
        foreach my $dir (keys %$AnnotByDir) {
            my $new_annots = {};
            my $Annots = $AnnotByDir->{$dir};
            @$Annots   = $dir eq "==>" ?
                         sort { $a->get_startpos <=> $b->get_startpos } @$Annots
                       : sort { $b->get_startpos <=> $a->get_startpos } @$Annots;

            # Only one annotations in this strand
            if (scalar(@$Annots) == 1) {
                $new_annots->{0}->{"complete"} = $Annots->[0];
            }
            else {
                my ($First,$cnt)           = (1,0);
                my ($prev_start,$prev_end) = (0,0);
                foreach my $annot (@$Annots) {
                    if ($First == 1) {
                        ($prev_start,$prev_end) = ($1,$2) if $annot->get_HMMmatch =~ m/(\d+),(\d+)/;
                        $new_annots->{$cnt}->{"complete"} = $annot;
                        $First = 0;
                    }
                    else {
                        my ($start,$end) = ($1,$2) if $annot->get_HMMmatch =~ m/(\d+),(\d+)/;
                        # Accept OV or non OV of 15aa
                        my $dist = abs($start - $prev_end);
                        if ($dist < 15) {
                          # Creation of exon and modification of complete
                          my $exons = $new_annots->{$cnt}->{"exons"} || [];
                          if (scalar(@$exons) == 0) {
                              my $first_exon = $new_annots->{$cnt}->{"complete"}->DeepClone();
                              push(@$exons,$first_exon);
                              push(@$exons,$annot);
                          }
                          else {
                              push(@$exons,$annot);
                          }
                          $new_annots->{$cnt}->{"exons"} = $exons;
                          # change value in complete
                          $new_annots->{$cnt}->{"complete"}->set_endpos($exons->[-1]->get_endpos());
                          my $HMMstart = $1 if $exons->[0]->get_HMMmatch()  =~ m/(\d+),\d+/;
                          my $HMMend   = $1 if $exons->[-1]->get_HMMmatch() =~ m/\d+,(\d+)/;

                          my $HMMmatch = $annot->get_HMMmatch();
                             $HMMmatch =~ s/(\d+)(,\d+)/${HMMstart},${HMMend}/;
                             $new_annots->{$cnt}->{"complete"}->set_HMMmatch($HMMmatch);

                        }
                        # Create new complete annot
                        else {
                            $cnt++;
                            $new_annots->{$cnt}->{"complete"} = $annot;
                        }
                        ($prev_start,$prev_end) = ($start,$end);
                    }
                }
            }
            push(@$tab_annots,$new_annots);
        }
    }
    return $tab_annots;
}

sub FindStartAndStopForSimpleGeneIdByHMM {
    my ($annot,$seq,$contiglen) = @_;

    my $direction       = $annot->get_direction();
    my $isMinus         = $direction eq "==>" ? 0 : 1;
    my $start           = $annot->get_startpos();
    my $end             = $annot->get_endpos();
    my $this_prot       = &GetProteinForGeneWithoutIntrons($seq, $start, $end, $isMinus);
    my $full5           = &GetFull5($seq,$isMinus,$this_prot,$start);
    my $HMMmatch        = $annot->get_HMMmatch();
    my $all_possible_st = &DefineAllPossibleStart($full5,$AA_ACCEPTED_START);
    my $aliFrom         = length($full5) - length($this_prot);
    my $CloseStart      = &DefineCloseStart($all_possible_st,$aliFrom,$full5);
    my ($StartOrf,$EndOrf) = ($1,$2) if $annot->get_IdORF() =~ m/\[\s*(\d+)\s*-\s*(\d+)\s*\]/;

    # Define startpos, and comment
    # No start at all was found
    my $comment = "";
    if ($CloseStart == $aliFrom && !$all_possible_st->{$CloseStart}) {
        my $SimiStart = $start;
        $start        = $StartOrf;
        $comment      = "No start codon at $SimiStart and HMMmatch = $HMMmatch";
    }
    # A M or v was found after similarity beginning
    elsif ($CloseStart > $aliFrom) {
        my $FirstStart = $direction eq "==>" ? $StartOrf+($CloseStart*3) : $StartOrf-($CloseStart*3);
           $start      = $StartOrf;
        # my $aa_start   = $all_possible_st->{$CloseStart}->{aa};
        #    $aa_start   = $aa_start eq "M" ? "ATG" : "GTG";
        #    $comment    = "First $aa_stt found at $FirstStart HMMmatch = $HMMmatch";
        my $aa_start = $all_possible_st->{$CloseStart}->{aa};
           $comment  = "First start found at $FirstStart HMMmatch = $HMMmatch";
    }
    else {
        if ($aliFrom != $CloseStart) {
            $start = $direction eq "==>" ? $StartOrf+($CloseStart*3) : $StartOrf-($CloseStart*3);
        }
        # Remove double ; and pass annot in G type
        my $startline = $annot->get_startline();
        $startline =~ s/^;// if $startline =~ m/^;;/;
        $annot->set_startline($startline);

        my $endline = $annot->get_endline();
        $endline =~ s/^;// if $endline =~ m/^;;/;
        $annot->set_endline($endline);

        $annot->set_type("G");
    }

    if ($direction eq "==>" && ($EndOrf + 3) > $contiglen) {
      $end = $EndOrf;
    }
    elsif ($direction eq "<==" && $EndOrf - 3 < 1) {
        $end = $EndOrf;
    }
    else {
        $end   = $direction eq "==>" ? $EndOrf + 3 : $EndOrf - 3;
    }
    $annot->set_startpos($start);
    $annot->set_endpos($end);
    my $startline = $annot->get_startline();
    $startline    = "$startline ;; $comment" if $comment ne "";
    $annot->set_startline($startline);

    return $annot;
}

sub FindStartAndStopForComplexGeneIdByHMM {
    my ($annot,$tab_exons,$OrfFile,$seq) = @_;

    # Change endpos
    my $EndOrf    = $1 if $tab_exons->[-1]->get_IdORF() =~ m/\[\s*\d+\s*-\s*(\d+)\s*\]/;
    my $direction = $annot->get_direction();
    my $isMinus   = $direction eq "==>" ? 0 : 1;
    my $end       = !$isMinus ? $EndOrf + 3 : $EndOrf - 3;
    $annot->set_endpos($end);

    # Change startpos
    my $start           = $tab_exons->[0]->get_startpos();
       $end             = $tab_exons->[0]->get_endpos();
    my $this_prot       = &GetProteinForGeneWithoutIntrons($seq, $start, $end, $isMinus);
    my $full5           = &GetFull5($seq,$isMinus,$this_prot,$start);
    my $HMMmatch        = $tab_exons->[0]->get_HMMmatch();
    my $all_possible_st = &DefineAllPossibleStart($full5,$AA_ACCEPTED_START);
    my $aliFrom         = length($full5) - length($this_prot);
    my $CloseStart      = &DefineCloseStart($all_possible_st,$aliFrom,$full5);
    my $StartOrf        = $1 if $annot->get_IdORF() =~ m/\[\s*(\d+)\s*-\s*\d+\s*\]/;

    my $comment = "";
    if ($CloseStart == $aliFrom && !$all_possible_st->{$CloseStart}) {
        my $SimiStart = $start;
        $start        = $StartOrf;
        $comment      = "No ATG or GTG start codon at $SimiStart and HMMmatch = $HMMmatch";
    }
    # A M or v was found after similarity beginning
    elsif ($CloseStart > $aliFrom) {
        my $FirstStart = $direction eq "==>" ? $StartOrf+($CloseStart*3)  : $StartOrf-($CloseStart*3);
           $start      = $StartOrf;
        my $aa_start   = $all_possible_st->{$CloseStart}->{aa};
           $aa_start   = $aa_start eq "M" ? "ATG" : "GTG";
           $comment    = "First $aa_start found at $FirstStart HMMmatch = $HMMmatch";

    }
    else {
        if ($aliFrom != $CloseStart) {
            $start = $direction eq "==>" ? $StartOrf+($CloseStart*3) : $StartOrf-($CloseStart*3);
        }
    }

    $annot->set_startpos($start);
    my $startline = $annot->get_startline();
    $startline    = "$startline ;; $comment" if $comment ne "";
    $annot->set_startline($startline);
}


sub GetORF {
     my ($OrfFile,$seqIdAndDesc) = @_;

    my $contigList = $OrfFile;
       $contigList =~ s/\.orf$/\.list/;
    my $fh_contigList = new IO::File ">$contigList"
        or die "Can't write to file '$contigList': $!\n";
    print $fh_contigList "$seqIdAndDesc\n";
    my $cmd = "grab-fasta -f $OrfFile -H $contigList -o - 2>/dev/null";
    my $orf = `$cmd`;
    die "No contig found for $seqIdAndDesc in $OrfFile\n"
        if $orf eq "";
    unlink($contigList) if (-e $contigList);
    my $full5 = $orf;
       $full5 =~ s/^>.+\n//g;
    return $full5;
}

sub CreateAnnotCommentForHMM {
    my ($resume,$ali,$name,$contigname,$both) = @_;

    my @tab_name = split(/_/,$name);
    $name    = $tab_name[0];
    my $ori  = $tab_name[1] || "";
    my $description        = $resume->get_Description();
    my $direction          = $description =~ m/REVERSE SENSE/ ? "<==" : "==>";
    my $isMinus            = $direction eq "==>" ? 0 : 1;
    my ($StartOrf,$EndOrf) = ($1,$2) if $description =~ m/\[\s*(\d+)\s*-\s*(\d+)\s*\]/;
    my ($aliFrom,$aliTo)   = ($ali->get_aliFrom(),$ali->get_aliTo());
    my ($hmmFrom,$hmmTo)   = ($ali->get_hmmFrom(),$ali->get_hmmTo());
    my $start              = $direction eq "==>" ? $StartOrf+(($aliFrom-1)*3) : $StartOrf-(($aliFrom-1)*3);
    my $end                = $direction eq "==>" ? $StartOrf+(($aliTo)*3)-1   : $StartOrf-(($aliTo)*3)+1;
    my $startline          = ";;     G-$name $direction start";
       $startline         .= " ;; /ori= $ori" if $both == 1;
    my $endline            = ";;     G-$name $direction end";

    my $annot = new PirObject::AnnotPair( type      => "C",
                                          genename  => $name,
                                          startpos  => $start,
                                          endpos    => $end,
                                          direction => $direction,
                                          startline => $startline,
                                          endline   => $endline,
                                          score     => $ali->get_Cvalue(),
                                          IdORF     => $resume->get_SeqIdAndDesc(),
                                          HMMmatch  => "$hmmFrom,$hmmTo",
                                          origine   => $both == 1 ? $ori : undef
                                        );
    return $annot;
}

sub CheckIfTwoGapOV {
    my $gap_list = shift;

    foreach my $key (sort { $a <=> $b } keys(%$gap_list)) {
        my $gap = $gap_list->{$key};
        my ($gStart,$gEnd,$gDir) = ($gap->{start},$gap->{end},$gap->{dir});
        my $gapIsOV = 0;
        if ($gDir eq "==>") {
            $gapIsOV = 1 if $gEnd < $gStart;
        }
        else {
            $gapIsOV = 1 if $gStart < $gEnd;
        }
        next if $gapIsOV != 1;
        $gap->{OV} = 1;
    }

    return $gap_list;
}

sub GetSimilarityPos {
    my ($resume,$ali) = @_;

    my $description        = $resume->get_Description();
    my $direction          = $description =~ m/REVERSE SENSE/ ? "<==" : "==>";
    my ($StartOrf,$EndOrf) = ($1,$2) if $description =~ m/\[\s*(\d+)\s*-\s*(\d+)\s*\]/;
    # Treat information of ali and initialize
    my ($aliFrom,$aliTo) = ($ali->get_aliFrom(),$ali->get_aliTo());
    my $SimiStart = $direction eq "==>" ? $StartOrf+(($aliFrom-1)*3) : $StartOrf-(($aliFrom-1)*3);
    my $SimiEnd   = $direction eq "==>" ? $StartOrf+(($aliTo)*3 -1) : $StartOrf-(($aliTo)*3+1);

    return ($SimiStart,$SimiEnd);
}

sub DefineCloseStart {
    my ($all_possible_st,$aliFrom,$orf) = @_;

    # No start present in $ALTERNATIVE_ACCEPTED_START was found
    if (scalar(keys %$all_possible_st) == 0){
        return $aliFrom;
    }

    # Search M before aliFrom
    my $close_start = length($orf);
    foreach my $st_pos (sort { $a <=> $b } keys %$all_possible_st) {
        next if $st_pos > $aliFrom;
        $close_start = $st_pos;
    }
    # If no start was found before aliFrom return first M or l
    if ($close_start == length($orf)) {
        foreach my $st_pos (sort { $a <=> $b } keys %$all_possible_st) {
            $close_start = $st_pos;
            last;
        }
    }
    return $close_start;
}

#---- CreateAllEndoAnnotFindByHMM ----#
sub CreateAllEndoAnnotFindByHMM {
    my ($HighDir,$ResDir,$contigname) = @_;

    my $contig     = $pirmaster->GetContigByName($contigname);

    my $Endo_by_cg = {};
    $Endo_by_cg->{$contigname} = &CreateAllHMMAnnot($ResDir,$contigname,$contig,1);
    return $Endo_by_cg;
}

#--------------------------------------------------#
# Subs used for check Multicomments And Lc Introns #
#--------------------------------------------------#

sub MulticommentConfidence {
    my $contigs   = $pirmaster->get_contigs();

    foreach my $contig (@$contigs) {
        my $annotations = $contig->get_annotations();
        foreach my $annot (@$annotations) {
            my $startmulticomments = $annot->get_startmulticomment();
            my $endmulticomments   = $annot->get_endmulticomment();
            next if !$startmulticomments->[0] && !$endmulticomments->[0];

            if ($startmulticomments->[0]) {
                my $startline = $annot->get_startline();
                   $startline =~ s/\s*\\?\s*$/ \\/ ;
                   $annot->set_startline($startline);
                foreach my $line (@$startmulticomments) {
                    last if $line eq $startmulticomments->[-1];
                    $line      =~ s/\s*\\?\s*$/ \\/;
                }
            }

            if ($endmulticomments->[0]) {
                my $endline = $annot->get_endline();
                   $endline =~ s/\s*\\?\s*$/ \\/;
                   $annot->set_endline($endline);
                foreach my $line (@$endmulticomments) {
                    last if $line eq $endmulticomments->[-1];
                    $line    =~ s/\s*\\?\s*$/ \\/;
                }
            }
        }
    }
}

sub LcIntrons {
    my $contigs   = $pirmaster->get_contigs();

    foreach my $contig (@$contigs) {
        my $seq = $contig->get_sequence();
           $seq =~ s/!//g;
        my $annotations = $contig->get_annotations();
        foreach my $annot (@$annotations) {
            my $type = $annot->get_type();
            next if $type ne "I";
            my $intron_type = $annot->get_introntype();
            next if $intron_type && $intron_type =~ m/,/;
            &LCIntronInSeqContig($annot->get_startpos(),$annot->get_endpos(),$contig);
        }
        foreach my $annot (@$annotations) {
            my $genename = $annot->get_genename();
            next if !$genename || $genename ne "comment";
            my $start_line = $annot->get_startline();
            next if $start_line !~ m/group=/;
            &LCIntronInSeqContig($annot->get_startpos(),$annot->get_endpos(),$contig);
        }
    }
}

sub LCIntronInSeqContig {
    my ($AP_start,$AP_end,$contig) = @_;

    my $seq = $contig->get_sequence();
    my ($AP_min,$AP_max) = $AP_start < $AP_end ? ($AP_start,$AP_end) : ($AP_end,$AP_start);
    my $intron_seq = lc(substr($seq,$AP_min-1,$AP_max-$AP_min+1));
    substr($seq,$AP_min-1,length($intron_seq),$intron_seq);
    $contig->set_sequence($seq);
}

sub ReplaceCgName {
    my $contigs   = $pirmaster->get_contigs();

    foreach my $contig (@$contigs) {
        my $name   = $contig->get_name();
        my $header = $CONTIG->{"$name"};
           $header = "$header gc=$GENCODE" if $header !~ m/gc=/;
        $contig->set_name($header);
    }
}

#---------------------------------#
# Subs for processing motifs      #
#---------------------------------#

sub read_pat_file{
  my $pfile = shift;
  my $infh  = new IO::File "<$pfile"
    or die "Can't read from file '$pfile': $!\n";

  my($name, $regexp);
  my $list_of_mot = ();

  while( <$infh> ){
    chomp;
    my $line = $_;
    next if $line =~ m/^\s*$/ || $line =~ m/^#/ ; # skip blank lines
    # A pattern line
    if ( $line =~ m/^\s*\S+\s+(\S+)\s+(\S+)\s*$/ ){
      ($name, $regexp) = ($1,$2);
      die "Multiple patterns have the same name $name, please fix in $pfile"
        if $list_of_mot->{$name};
      $name =~ s/^\s*//, $name =~ s/\s*$//;
      # Validate name.
      &PrintError("name",$name,$pfile) if ( $name =~ /\s/ or !$name );
      # Validate regexp.
      my $invalid_pat = 0;
      $regexp =~ s/\s//g;
      &PrintError("regexp",$regexp,$pfile) if $regexp eq '';
      &PrintError("regexp",$regexp,$pfile) if $regexp =~ /[^ a c g t n { } \d \[ \] ( ) , \* \? \+ .]/i;
      eval "'' =~ /$regexp/";
      &PrintError("regexp",$regexp,$pfile) if $@;
      &PrintError("regexp",$regexp,$pfile) if '' =~ /$regexp/;
      &PrintError("regexp",$regexp,$pfile) if $regexp =~ / \*\? | \}\? | \+\? | \?\? /x;
      $list_of_mot->{$name} = $regexp;
    }
    # Line is invalid
    else {
      print "File $pfile contains syntax errors on line $..\n";
      print "Please correct them and rerun $BASENAME.\n";
      return 1;
    }
  }
  $infh->close();
  return $list_of_mot;
}

sub PrintError {
    my ($isInvalid,$name,$pfile) = @_;

    print "Invalid $isInvalid '$name' found in file $pfile\n";
    print "Please correct $pfile and rerun $BASENAME.\n";
}

sub SearchMotAndMakeAP {

    foreach my $name (keys %$LISTPAT) {
        my $pat = $LISTPAT->{$name};

        my $rev_pat = $pat;
           $rev_pat =~ tr/ACGT/TGCA/;
           $rev_pat = reverse $rev_pat;
        # Check for palindrome
        my $isPal   = $pat eq $rev_pat && $pat =~ /^[a_zA-Z]+$/ ? 1 : 0;

        foreach my $contig ( @$contigs) {
            my $contigname = $contig->get_name();

            my $seq     = uc($contig->sequence());
               $seq     =~ s/!//g;
            my $rev_seq = $seq;
               $rev_seq =~ tr/ACGT/TGCA/;
               $rev_seq = reverse $rev_seq;
            my $len_seq = length ($seq);

            for(;;){
                # Forward
                my ($start,$end,$prev_start) = (0,0,0);
                my $sub_seq      = $seq;
                for (;;) {
                    last if ($sub_seq !~ /(?i)$pat/ );
                    $start       = length($`) + $prev_start ;
                    $end         = $start + length($&);

                    my $mot = new PirObject::AnnotPair(
                                                     type      => "S",
                                                     genename  => $name,
                                                     startpos  => $start + 1,
                                                     endpos    => $end,
                                                     direction => "==>",
                                                     startline => "; G-Sig-$name ==> start",
                                                     endline   => "; G-Sig-$name ==> end",
                                                     );
                    &AddAnnotToPirMaster($contigname,$mot);

                    $prev_start      = $start + 1;
                    $sub_seq = substr($seq, $prev_start);
                }

                # Backward
                ($start,$end,$prev_start) = (0,0,0);
                $sub_seq      = $rev_seq;
                for (;;) {
                    last if $isPal;
                    last if ($sub_seq !~ /(?i)$pat/ );
                    $start       = length($`) + $prev_start ;
                    $end         = $start + length($&);

                    my $mot = new PirObject::AnnotPair(
                                                     type      => "S",
                                                     genename  => $name,
                                                     startpos  => $len_seq - $start,
                                                     endpos    => $len_seq - $end + 1,
                                                     direction => "<==",
                                                     startline => "; G-Sig-$name <== start",
                                                     endline   => "; G-Sig-$name <== end",
                                                     );
                    &AddAnnotToPirMaster($contigname,$mot);
                    $prev_start      = $start + 1;
                    $sub_seq = substr($rev_seq, $prev_start);
                }
                last;
            }
        }
    }
}


#------------------------------------------#
# Subs used at different times in Mfannot  #
#------------------------------------------#

sub AddAnnotToPirMaster {
    # Meaning code for this function
    # return 1 means ok, it has been added
    # return 0 means function quit before the end, => rediscovered
    my $contigname  = shift;
    my $annot       = shift;
    my $contig      = $pirmaster->GetContigByName($contigname) or die "Can't get contig by name in AddAnnotToPirMaster\n";
    my $annotations = $contig->get_annotations;

    # Here we compare all the annotations, with the one we try to add
    if (scalar(@$annotations) != 0 && $annot->type ne "S") {
        my $return_val = &CompareAllAnnot($annotations,$annot);
        return $return_val if $return_val != -1;
    }

    push (@$annotations, $annot) if ($annot->type eq "C");
    return 1                     if ($annot->type eq "C");

    # It mean, this annotation has already been seen
    return 0 if (&AnnotAlreadyAtSamePlace($annotations, $annot->startpos, $annot->endpos, $annot->genename,$annot->type,$annot->direction));

    push (@$annotations, $annot) if ($annot->type eq "S");
    return 1                     if ($annot->type eq "S");

    #  It means, force annot but this annotations doesn't seems to have an other copy
    my $name = $annot->get_genename();
       $name = $1 if $annot->get_startline() =~ m/(trn.\(.+\))/i;
    $ANNOT_STATS->{'Added'}->{$name} ||= {  'I' => 0, 'E' => 0, } if ($annot->genename ne "comment");
    push (@$annotations, $annot);
    return 1;
}

sub CompareAllAnnot {
    my ($annotations,$annot) = @_;

    foreach my $annotation (@$annotations) {
        my $annotname  = $annotation->get_genename();
        my $annottype  = $annotation->get_type() || "C";
        my $annotstart = $annotation->get_startpos();
        my $annotend   = $annotation->get_endpos();
        my $annotdir   = $annotation->get_direction();
        $annotname     = "comment" if (!defined  ($annotname));
        $annotstart    = -1        if (!defined  ($annotstart));
        $annotend      = -1        if (!defined  ($annotend));

        # First case : if both are same comment on the same line
        if (($annottype eq "C") and ($annot->type eq "C") and
            ($annot->startpos == $annotstart) and ($annot->startline eq $annotation->startline)) {
            # Nothing is done in this case,
            return 0;
        }

        # Second case : No comment, both have same start end, and genename;
        return 0 if (($annottype ne "C") and ($annotname eq $annot->genename) and
                     ($annotstart == $annot->startpos) and ($annotend == $annot->endpos)
                     and $annotdir eq $annot->get_direction());

        # Third case : Exons
        if ($annot->type eq "E") {
            # It's an exon. The protein has normally already been added
            $ANNOT_STATS->{'Added'}->{$annot->genename}->{'E'} ++ if (defined ($annot->genename));
            push (@$annotations, $annot);
            return 1;
        }

        # 4th case : Introns
        if ($annot->type eq "I") {
            # it's an intron. The protein has normally already been added
            $ANNOT_STATS->{'Added'}->{$annot->genename}->{'I'} ++ if (defined ($annot->genename));
            push (@$annotations, $annot);
            return 1;
        }
    }
    return -1;
}

sub AnnotAlreadyAtSamePlace {
    my ($annotations,$start,$end,$name,$type,$dir) = @_;

    return if $name =~ /^!/;
    ($start,$end) = ($end,$start) if $start > $end;
    $name =~ s/_\d+$//;

    foreach my $annotation (@$annotations) {
        next if $annotation->type eq "C";
        next if $annotation->genename =~ /^!/;
        my $annot_name  = $annotation->genename;
        my $annot_start = $annotation->startpos;
        my $annot_end   = $annotation->endpos;
        my $annot_dir   = $annotation->direction();
        if ($type ne "S") {
            $annot_name     =~ s/_\d+$//;
            ($annot_start,$annot_end) = ($annot_end,$annot_start) if $annot_start > $annot_end;
            return 1 if ( (!($end < $annot_start || $annot_end < $start)) && $name eq $annot_name);
        }
        else {
            ($annot_start,$annot_end) = ($annot_end,$annot_start) if $annot_start > $annot_end;
            return 1 if $start == $annot_start && $end == $annot_end && $name eq $annot_name && $dir eq $annot_dir;
        }
    } # End foreach $annot
    return 0;
} # End sub

sub WhatOverlapsThis {
    my $wstart     = shift;
    my $wend       = shift;
    my $contig     = shift;

    my $contiglen  = $contig->get_sequencelength();
    my $annotlist  = $contig->get_annotations() || [];

    ($wstart, $wend) = ($wend, $wstart) if $wend < $wstart;

    my @GEI_annots = grep( $_->get_type() =~ m#^[GEIO]$# , @$annotlist);
    my %RanksGEI   = ( G => 0, E => 1, I => 2, O => 3);
    @GEI_annots    = sort { $a->get_genename() cmp $b->get_genename()
                                                or
                     $RanksGEI{$a->get_type()} <=> $RanksGEI{$b->get_type()}
                                                or
                            $a->get_startpos() <=> $b->get_startpos();
                           } @GEI_annots;

    my $groups = [];
    foreach my $annotation (@GEI_annots) {
        my $genename  = $annotation->get_genename(); # Does NOT contain the _1
        my $type      = $annotation->get_type();
        my $startline = $annotation->get_startline();
        my $start     = $annotation->get_startpos();
        my $end       = $annotation->get_endpos();
        my $dir       = $annotation->get_direction() || "==>";

        my ($ostart,$oend) = ($start,$end); # Strandless interval
           ($ostart,$oend) = ($end,$start) if $end < $start;

        if ($type eq "G" || $type eq "O" || $type eq "I") {
            next unless # No overlap? next
                &OverlappingRegions($contiglen,$start,$end,$dir,$wstart,$wend,">"); # Real dir of orf not important
            push(@$groups, [ [ $ostart, $oend, $annotation ] ] );
            next;
        }

        # For introns and exons
        foreach my $group (@$groups) {
            my $geneinfo = $group->[0]; # First entry of group is always a gene object
            my $gi_name  = $geneinfo->[2]->get_genename();
            next unless $gi_name eq $genename;
            my $gstart = $geneinfo->[2]->get_startpos();
            my $gend   = $geneinfo->[2]->get_endpos();
            my $gdir   = $geneinfo->[2]->get_direction();
            next unless # if E or I is outside of gene
                &OverlappingRegions($contiglen,$start,$end,$dir,$gstart,$gend,$gdir);
            push(@$group, [ $ostart, $oend, $annotation ] );
            #  last; # commented out in case for some reason an exon overlap multiple genes with the same names!
        } # End foreach $group
    } # End foreach $annotation

    # Now, flag the first and last exon of each group in field ->[3] of each group
    foreach my $group (@$groups) {
        $group->[0]->[3] = "";  # Flag set to false for first entry
        if (@$group == 1) {     # Gene with no introns
            $group->[0]->[3] = "YES";
            next;
        }
        my $maxexnum=0;
        my $maxexinfo="";
        for (my $i=1;$i<@$group;$i++) {
            my $info = $group->[$i];
            $info->[3] = "";  # Flag set to false
            next unless $info->[2]->get_type() eq "E";
            my $startline = $info->[2]->get_startline() || "";
            next unless $startline =~ m#G-(\S+)-E(\d+)#;
            my $exnum = $2;
            $info->[3] = "YES"   if $exnum == 1; # First exon flaged
            $info->[4] = "FIRST" if $exnum == 1; # First exon flaged
            $info->[4] = ""      if $exnum != 1; # First exon flaged
            if ($exnum > $maxexnum) {
                $maxexnum = $exnum;
                $maxexinfo = $info;
            }
        }
        if ($maxexinfo) {             # Should always be true here
            $maxexinfo->[3] = "YES";  # This is the last exon of the group
            $maxexinfo->[4] = "LAST"; # This is the last exon of the group
        }
    }
    $groups;
} # End sub

sub OverlappingRegions {
    # Works even for circular genomes and regions that span the gap
    my ($seqlen,$start1,$end1,$dir1,$start2,$end2,$dir2) = @_;

    my $spansgap1 = (($dir1 =~ m#>#) xor ($start1 <= $end1)); # true means spans the gap
    my $spansgap2 = (($dir2 =~ m#>#) xor ($start2 <= $end2)); # true means spans the gap

    if ($spansgap1) {
        if ($dir1 =~ m#>#) {
            $end1 += $seqlen;
        }
        else {
            $start1 += $seqlen;
        }
    }

    if ($spansgap2) {
        if ($dir2 =~ m#>#) {
            $end2 += $seqlen;
        }
        else {
            $start2 += $seqlen;
        }
    }

    ($start1,$end1) = ($end1,$start1) if $start1 > $end1;
    ($start2,$end2) = ($end2,$start2) if $start2 > $end2;

    # Test for overlap
    return 1 if ! ($end1 < $start2 || $start1 > $end2);
    return 0 if $spansgap1 == $spansgap2; # same spanning sit -> we're done

    if (! $spansgap1) {
        $start1 += $seqlen;
        $end1   += $seqlen;
    }

    if (! $spansgap2) {
        $start2 += $seqlen;
        $end2   += $seqlen;
    }

    # Test for overlap again, new situation
    return 1 if ! ($end1 < $start2 || $start1 > $end2);
    return 0; # really, no overlap
} # End sub

sub WhichPhase {
    # In order to know the phase of the intron
    my ($annot,$num_intron,$contig) = @_;

    my $annot_who_overlap = &WhatOverlapsThis($annot->startpos(),$annot->endpos(),$contig);

    my $nb_nt = 0;     # Length of all exon before the intron who studies
    foreach my $annotation_who_overlap (@$annot_who_overlap){
        foreach my $feature_who_overlap (@$annotation_who_overlap) {
            my $feature_min = @$feature_who_overlap[0];
            my $feature_max = @$feature_who_overlap[1];
            my $feature     = @$feature_who_overlap[2];
            next if !($feature->get_startline() =~ m#;\s+G-.+E(\d+).+#);
            my $number = $1 if $feature->get_startline() =~ m#;\s+G-.+E(\d+).+#;
            $nb_nt += abs($feature_max - $feature_min + 1 ) if $1 <= $num_intron;
        } # End foreach $feature_who_overlap
    } # End foreach $annotation_who_overlap
    my $phase = $nb_nt % 3 ;
} # End sub

sub Length_annot {
    # Just in order to calculate the length of annot
    my $annot = shift;

    my $start = $annot->startpos();
    my $end   = $annot->endpos();
    ($start,$end) = ($end,$start) if $annot->direction() eq "<==";
    my $length = ($end - $start + 1);
    return $length;
} # End sub

sub TranslateInProt {
    my $nt_seq            = shift;
    my $end_of_first_exon = shift || -1;
    my $end_of_first_exon_in_nt = $end_of_first_exon * 3;

    my $prot_seq = "";
    foreach (my $i = 0; $i <= length($nt_seq) - 3; $i += 3) {
        my $tri_nt = uc (substr($nt_seq, $i , 3));
        my $aa     = $CODON_TABLE->{$tri_nt} || "X";
        # Lower case for possible start codons
        my $accepted_aa_for_tri_nt = $ALTERNATIVE_ACCEPTED_START->{$tri_nt} || [];
        if ($i < $end_of_first_exon_in_nt) {
            # If $accepted_aa_for_tri_nt contains "x" then all tri_nt is possible start codon and should be lower case
           $aa       = lc($aa) if  grep { uc($_) eq "X" } @$accepted_aa_for_tri_nt ;
            # If $aa is one of the value present in $accepted_aa_for_tri_nt then it is possible start codon and should be lower case
           $aa       = lc($aa) if  grep { uc($_) eq $aa } @$accepted_aa_for_tri_nt ;
        }
        $prot_seq .= $aa;
    }
    return $prot_seq;
}

sub ApPosStrandFW {
    my ($ap,$LenSeq) = @_;

    my $apMinus   = $ap->get_direction() eq "==>" ? 0 : 1;
    my $ap_start  = $apMinus ? $LenSeq + 1 - $ap->get_startpos() : $ap->get_startpos();
    my $ap_end    = $apMinus ? $LenSeq + 1 - $ap->get_endpos()   : $ap->get_endpos() ;
    return ($ap_start,$ap_end);
}

sub ExPosStrandFW {
    my ($ap,$LenSeq) = @_;

    my $apMinus   = $ap->get_strand() eq "-"  ? 1 : 0;
    my $ap_start  = $apMinus ? $LenSeq + 1 - $ap->get_dnastart() : $ap->get_dnastart();
    my $ap_end    = $apMinus ? $LenSeq + 1 - $ap->get_dnaend()   : $ap->get_dnaend() ;
    return ($ap_start,$ap_end);
}

#---------------------------------#
# Subs used at the end of Mfannot #
#---------------------------------#

sub RenumberFeatures {
    # Post-processing: renumber gene names with unique
    # extensions such as _1, _2 etc. The original mechanism
    # that was trying to do this using %ANNOTSEEN is
    # broken, this routine does a better job.
    my %genename2suffix = (); # cox3 => { _1 => [ [ obj obj ] [ obj ] ], "" => [ [ obj obj ] [ obj ] ] }

    my $contigs = $pirmaster->get_contigs(); # Get the masterfiles contigs

    foreach my $contig (@$contigs) {         # Parse all the contig
        my $contiglen = $contig->get_sequencelength();

        my $annotations = $contig->get_annotations();
        my @GEI_annots = grep( $_->get_type() =~ m#^[GEIOS]$# , @$annotations);
        my %RanksGEI = ( G => 0, E => 1, I => 2, O => 3, S => 4);
        @GEI_annots = sort { $RanksGEI{$a->get_type()} <=> $RanksGEI{$b->get_type()}
                                                        or
                                    &IsIntronicOrf($a) <=> &IsIntronicOrf($b)
                                                        or
                                    $a->get_startpos() <=> $b->get_startpos();
                           } @GEI_annots;

        my %local_genename2suffix = (); # the %genename2suffix local to the current contig.
        foreach my $annotation (@GEI_annots) {
            my $genename  = $annotation->get_genename(); # Does NOT contain the _1
            my $type      = $annotation->get_type();
            my $startline = $annotation->get_startline() || "";
            my $start     = $annotation->get_startpos();
            my $end       = $annotation->get_endpos();
            my $dir       = $annotation->get_direction() || "==>";
            next if $type ne "S" && $LVL_MOT == 1;

            # We need to override for G-cox1_3-I4-orf34 for instance We want cox1 not orf34
            $genename = $2 if ($startline =~ m#G-(Sig)?-?([^\-\s]+)#);
            my ($IntronicORF,$orfname)  = (1,$1) if  ($startline =~ m#G-.+-I\d+-(orf\d+)#);
            $genename =~ s/_\d+$//; # Make sure

            my %genenames = ();
            my $suffix = "";
               $suffix = $1 if $startline =~ m#(_\d+)# && !$IntronicORF;
            $genenames{$genename} = $suffix;

               $suffix = "";
               $suffix = $1 if $startline =~ m#orf\d+(_\d+)#;
            $genenames{$orfname} = $suffix if defined $orfname;

            foreach my $name (keys %genenames) {
                $suffix = $genenames{$name};
                my $local_suffix2groups = $local_genename2suffix{$name} ||= {};
                my $groups              = $local_suffix2groups->{$suffix}   ||= [];
                my $addedToExistingGroup = 0;
                foreach my $group (@$groups) {
                    my $firstfeat = $group->[0];
                    my $ffstart   = $firstfeat->get_startpos();
                    my $ffend     = $firstfeat->get_endpos();
                    my $ffdir     = $firstfeat->get_direction() || "==>";
                    my $fftype    = $firstfeat->get_type();
                    next if $fftype eq "C";

                    if (&OverlappingRegions($contiglen,$start,$end,$dir,$ffstart,$ffend,$ffdir)) {
                        push(@$group,$annotation);
                        $addedToExistingGroup=1;
                        last;
                    }
                }
            my $comment = &ModifCommentForFirstStart($annotation,$annotations) if $annotation->get_type() eq "G";
            push(@$groups, [ $annotation ])           if (!$addedToExistingGroup) && !$comment;
            push(@$groups, [ $annotation ,$comment ]) if (!$addedToExistingGroup) &&  $comment;
            }
        } # End foreach annotation

        # Fusion %local_genename2suffix into the global %genename2suffix
        # We need to do this to keeps each contig's group separate
        foreach my $genename (keys %local_genename2suffix) {
            my $local_suffix2groups = $local_genename2suffix{$genename};
            my $suffix2groups       = $genename2suffix{$genename} ||= {};
            foreach my $suffix (keys %$local_suffix2groups) {
                my $local_groups = $local_suffix2groups->{$suffix};
                my $groups       = $suffix2groups->{$suffix} ||= [];
                push(@$groups, @$local_groups); # append to list
            }
        }
    } # End foreach contig

    # At this point, we've regrouped all G, E and I features in
    # overlapping groups based on their EXISTING suffixes. Now
    # let's fix these suffixes.

    foreach my $genename (keys %genename2suffix) {
        my $suffix2groups = $genename2suffix{$genename};
        my @suffixes = sort keys %$suffix2groups; # "" , _1, _2 etc etc

        next if ( @suffixes == 1 &&            # only one type of suffix found
                  $suffixes[0] eq "" &&        # case where only "genename" exists with no suffix
                  @{$suffix2groups->{""}} == 1 # a single instance? All ok.
                );

        # print "RENUMBER: $genename has duplicates: [",join("][",@suffixes),"]\n";
        # Ok, so we have a "" or _1 or _2 or _nn and/or a mix, we need to renumber
        my @keepnumbering=(); # We set aside those that need no renumbering; not used actually
        my @dorenumber=();    # These groups will be renumbered
        foreach my $suffix (@suffixes) {
            my $groups = $suffix2groups->{$suffix};
            if ($suffix eq "") {
                push(@dorenumber,@$groups); # All of them are renumbered
                next;
            }
            my $unchangedgroup = shift(@$groups); # Only first group KEEPS its number
            push(@keepnumbering,$unchangedgroup);
            push(@dorenumber,@$groups); # These get new numbers
        }

        # Renumber all annots of each group (each group gets a single new number)
        for (my $i = 1; @dorenumber > 0 ; $i++) {
            my $newsuf = "_$i";
            next if $suffix2groups->{$newsuf}; # Already used? try next suffix
            my $group = shift(@dorenumber);
            foreach my $annot (@$group) {
                my $origname  = $annot->get_genename();
                my $startline = $annot->get_startline();
                my $endline   = $annot->get_endline();
                my $type      = $annot->get_type();
                my $start     = $annot->get_startpos();
                my $end       = $annot->get_endpos();
                print "Warning: gene '$genename' ($start..$end) was renamed with suffix $newsuf to make it distinct.\n"
                    if ($type eq "G" || $type eq "O") && $origname eq $genename && $genename ne "comment"; # no warn if "cox1_1-I1-orf344"
                $startline = &ReplaceNumber($startline,$newsuf,$genename,$annot);
                $endline   = &ReplaceNumber($endline,$newsuf,$genename,$annot) if $endline;
                $annot->set_startline($startline);
                $annot->set_endline($endline);
            } # End foreach $annot
        } # End foreach $i
    } # End foreach $genename
} # End sub

# Substitutes, in a G- annotation line, the numbered suffix _1 _2 etc (which
# might not even be there) by a new suffix ($newsuf).
sub ReplaceNumber {
    my ($line,$newsuf,$genename,$annot) = @_;

    if ($genename =~ m/orf\d+/ && &IsIntronicOrf($annot)) {
        $line =~ s/(orf\d+)_*\d*/${1}${newsuf}/;  # Remove existing _1
    }
    else {
        $line =~ s/(G-[^_\s]+)_\d+/$1/  if !&IsIntronicOrf($annot);  # Remove existing _1
        $line =~ s/(G-[^_\s]+)_\d+-/$1/ if  &IsIntronicOrf($annot); # Remove existing _1
        if ($line =~ m#G-\S+-[EI]\d+#) { # Exon or intron ?
            $line =~ s/(-[EI]\d+)/$newsuf$1/;
        }
        else {
            $line =~ s/(G-\S+)/$1$newsuf/;
        }
    }
    $line;
} # End sub

sub ModifCommentForFirstStart {
    my ($annotation,$annotations) = @_;

    my $AnnotationStart = $annotation->get_startpos();
    foreach my $annot (@$annotations){
        next if $annot->get_type() ne "C";
        my $startline = $annot->get_startline();
        next if !$startline;
        next if $startline !~ m/First start found (\d+)/;
        my $AnnotStart = $1;
        next if $AnnotStart != $AnnotationStart;
        $startline =~ s/First start found (\d+)/First start found/;
        $annot->set_startline($startline);
        return $annot;
    }
}

sub IsIntronicOrf {
    # Returns 1 if annotation line is like G-gene-Inn-orfblahblah
    my $annot = shift;
    return 0 unless $annot->get_type() eq "O";
    my $startline = $annot->get_startline() || "";
    print "WARNING NO START LINE IN OBJ:\n",$annot->ObjectToXML() if !defined($startline);
    $startline =~ m#G-\S+-I\d+-\S+#  ? return 1 : return 0;
} # End sub

sub info {
    my $messages = join("",@_);
    my $prefix = "INFO: ";
    $prefix = "$1: " if $messages =~ s/^([A-Z]+):\s*//;
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
       = localtime(time);
    $year += 1900;  # Must ADD it! Always! See the doc!
    my $stamp = sprintf("%2.2d:%2.2d:%2.2d",$hour,$min,$sec);
    my @splitm = split(/\n/,$messages);
    foreach my $line (@splitm) {
       $line =~ s/^\s*//;
       $line =~ s/\s*$/\n/;
       print $prefix,"[$stamp] ",$line;
    }
}

sub LogInfo {
    # This function is supposed to add information
    # in the head of the masterfile such as
    # - the genes added (with exons)
    my $comment   = $pirmaster->get_comment();
    my $header    = [];
    my @report    = ();
    my $added     = $ANNOT_STATS->{'Added'};
    my @added     = sort keys %$added;
    my $comp_add  = 0;

    foreach my $genename (@added){
        $comp_add++ if ( $genename =~ /^!/);
    }

    my $gene_add = scalar(@added) - $comp_add;
    push(@report, ";;    - Gene Totals: " . $gene_add,);
    push(@report, ";;    - List of genes added:",) if @added;

    my ($COLS,$cnt,$rep) = (3,0,"");

    print "Added : ", $gene_add, "\n" if $DEBUG;
    print $LOG_F "Added : ", $gene_add, "\n" if $ISLOGFILE;

    foreach my $genename (@added) {
        next if $genename !~ /^[^!]/;
        next if $genename =~ /comment/;
        my($e,$i) = (($added->{$genename}->{'E'} || 0),($added->{$genename}->{'I'} || 0));
        $rep      = ";;     " if !$cnt;
        $rep     .= sprintf(" %-20s", ("$genename" . ($i >= 1 ? " ($i introns)" : "")));
        $cnt++;
        next if $cnt < $COLS;
        push(@report, $rep);
        $cnt  = 0;
    }
    push(@report, $rep) if $cnt;

    push(@$header, ";; Masterfile modified automatically by $BASENAME");
    push(@$header, ";; version $VERSION") if $VERSION;
    push(@$header, ";; version $MFANNOT_COMMIT_DATE") if $MFANNOT_COMMIT_DATE;
    push(@$header, ";; on " . scalar(localtime(time))  . " by user $USER on host " . hostname());
    push(@$header, @report, ";;",);
    push(@$header, $add_text_in_header) if $add_text_in_header ne "";
    push(@$header, ";; end mfannot\n;;");
    push(@$header, @$comment);
    $pirmaster->set_header($header);}

sub CreateTBLoutput {
    my $filename = shift;

    # First pass in mf2sqn to generate the subInfo.
    my $initial_dir = getcwd;
    chdir("$TMPDIR");

    my $mf2sqnErr   = "$TMPDIR/mf2sqnErr1";
    my $mf2sqnOut   = "$TMPDIR/mf2sqnOut1";
    my $cmd = "$MF2SQNPATH -a Generic -m $filename -t";
    print STDERR $cmd if $DEBUG;
    my $ret = system("$cmd > $mf2sqnOut 2> $mf2sqnErr");

  if (($ret >> 8) > 1) {
      print STDERR "There was an error running mf2sqn.\n";
    print STDERR "Content of STDERR output:\n";
    system("cat",$mf2sqnErr);
  }

    # Changed param into SubInfo.
    my $basename     = basename($filename);
    my $oldSubInfofh = new IO::File "<$basename.subInfo"
        or die "Can't open SubInfo file '$basename.subInfo': $!\n";

    my $newSubInfofh = new IO::File ">$basename.subInfo.new"
        or die "Can't open SubInfo file '$basename.subInfo.new': $!\n";

    while (my $line = <$oldSubInfofh>) {
        $line =~ s/'TOPOLOGY'     => 'C'/'TOPOLOGY'     => 'O'/;
        $line =~ s/'GENOME'       => 'M'/'GENOME'       => 'U'/;
        $line =~ s/'TITLE' => 'Dictyostelium discoideum mitochondrial DNA, complete sequence.'/'TITLE' => ''/;
        $line =~ s/'NUC_CODE'         => '1'/'NUC_CODE'         => '${GENCODE}'/;
        $line =~ s/'MIT_CODE'         => '1'/'MIT_CODE'         => '${GENCODE}'/;
        $line =~ s/'CITATION' => '10821186'/'CITATION' => ''/;
        print $newSubInfofh "$line";
    }
    $oldSubInfofh->close();
    $newSubInfofh->close();
    system("mv $basename.subInfo.new $basename.subInfo");

    # Re-run mf2sqn
    $mf2sqnErr   = "$TMPDIR/mf2sqnErr1";
    $mf2sqnOut   = "$TMPDIR/mf2sqnOut1";
    print STDERR $cmd if $DEBUG;
    $ret = system("$cmd > $mf2sqnOut 2> $mf2sqnErr");

    if (($ret >> 8) > 1) {
        print STDERR "There was an error running mf2sqn.\n";
  print STDERR "Content of STDERR output:\n";
  system("cat",$mf2sqnErr);
    }

    if ($SQN_FORMAT) {
        if (-e "$initial_dir/$basename.sqn") {
          print "Cannot copy $basename.sqn the file already exist";
        } else {
           system("cp $basename.sqn $initial_dir/");
           print "Writing new sqn file in $basename.sqn\n";
        }
    }

    if ($TBL_FORMAT) {
        if (-e "$initial_dir/$basename.tbl") {
          print "Cannot copy $basename.tbl the file already exist";
        } else {
           system("cp $basename.tbl $initial_dir/");
           print "Writing new tbl file in $basename.tbl\n";
        }
    }

    chdir("$initial_dir");
}

sub RemoveIntronFromOverlap {
    my $annot_who_overlap = shift;

    my $annot_who_overlap_tmp = [];
    my $intron_overlapping    = 0;
    # Dump value of $annot_who_overlap
    foreach my $annot (@$annot_who_overlap) {
        my $type = $annot->[0]->[2]->get_type();
        if ($type eq "I") {
            $intron_overlapping = 1;
        } else {
            push @$annot_who_overlap_tmp, $annot;
        }

    }

    return ($annot_who_overlap_tmp,$intron_overlapping);
}

sub GetAaAcceptedStartCodon {
    my $alternative_accepted_start = shift;
    my $codon_table                = shift;

    my $aa_accepted_start = {};
    # Iterate over the codon table to find the accepted start codon
    foreach my $tri_nt (keys %$codon_table) {

        # Extract the aa define in the $alternative_accepted_start for the key
        my $accepted_aa_for_tri_nt = $alternative_accepted_start->{$tri_nt} || "";
        next if $accepted_aa_for_tri_nt eq "";
        my $aa                     = lc($codon_table->{$tri_nt});

        # If $accepted_aa_for_tri_nt is x then all aa are accepted
        if (grep { lc($_) eq "x" } @$accepted_aa_for_tri_nt) {
            $aa_accepted_start->{$aa} = 1;
        } else {
            # If the tri_nt is a valid amino acid then add it to the hash
            $aa_accepted_start->{$aa} = 1  if grep { lc($_) eq $aa } @$accepted_aa_for_tri_nt;
        }
    }

    return $aa_accepted_start;
}


# End Of File. Or is it? What's beyond? Maybe the lost characters of all the sentences that were trunca