package Text::Editor::Easy::Trace::Full;

use warnings;
use strict;

=head1 NAME

Text::Editor::Easy::Trace::Full - Full trace management. The following events are saved on files : print (on STDOUT or STDERR), inter-thread call and
user event (key press, mouse move, ...). For each trace, the client thread and the stack call are saved.

=head1 VERSION

Version 0.48

=cut

our $VERSION = '0.48';

# Ce thread génère le fichier d'info et le hachage permettant d'y accéder rapidement
# Ce fichier d'info contient :
#   La liste des print (thread, liste d'appels ayant générée ce print, heure)
#   La liste des calls de méthodes inter-thread (call_id, méthode, liste d'appels ayant générée cet appel de méthode, heure, paramètres d'appels ?)
#   La liste des débuts de réponse (call_id)
#   La liste des fins de réponse (call_id, paramètres de retour ?)

use Fcntl;
use SDBM_File;

use Devel::Size qw(size total_size);
use IO::File;

Text::Editor::Easy::Comm::manage_debug_file( __PACKAGE__, *DBG );

use constant {

    #------------------------------------
    # LEVEL 1 : $self->[???]
    #------------------------------------
    HASH      => 0,
    OUT_NAME  => 1,
    INFO_DESC => 2,
    DBG_DESC  => 3,
    CALL_DESC => 4,
    HIDE => 5,
    INTER_CALL => 6,
    EVAL_DESC => 7,
    EXTENDED_SELF => 8,
};

# Hash content : depends on the key shape
#
# key = "\d+" (seek position, digits only : 5678) :
#     => the key corresponds to the position of text displayed in the redirected file (redirection of STDOUT and STDERR)
#     => the value corresponds to the position of the stack call ( at the time of the print ) in the print trace file

# key = "\d+_\d+" (call_id form : 0_345)
#     => the key corresponds to call_id, call identification
#     => the value corresponds to the position of the stack call ( at the time of the call ) in the call trace file

# key = "U_\d+" (user event : U_345 ) => "extended call"
#     => the key corresponds to the pseudo-call_id : the user made the "initial call"
#     => the value corresponds to the position of the user event description in the call trace file

# key = "E_\d+_\d+" (eval : E_0_345 = 'E' . $call_id)
#     => the second part of the key corresponds to the call_id that made the eval
#     => the value corresponds to the position(s) (if several, positions are separated by ';') of the code that has been 'evaled' in the eval file

=head1 FUNCTIONS

=head2 init_trace_print

This function is called just after the Trace::Full thread has been created. It initializes the files that will make possible to link a print and the
code that generated it.

=cut

my $length_s_n;

sub init_trace_full {
    my ( $self, $reference, $file_name ) = @_;

# Faire de même avec le fichier info. Référencer également
# le nom initial du fichier STDOUT (pour analyse : ouverture et réouverture régulières dans full_trace)
#$self = 'Bidon';
    print DBG "Dans init_trace_print ", total_size($self), " : $file_name|\n";
    my %h;

    # Hash (tied to a file to enable huge size)
    my $suppressed = unlink( $file_name . '.pag', $file_name . '.dir' );
    tie( %h, 'SDBM_File', $file_name, O_RDWR | O_CREAT, 0666 )
      or die "Couldn't tie SDBM file $file_name: $!; aborting";
    $self->[HASH]     = \%h;
    $self->[OUT_NAME] = $file_name;
    use IO::File;
    
    # print trace file
    open( $self->[INFO_DESC], "+>${file_name}.print_info" )
      or print DBG "Ouverture Info impossible\n";
    autoflush { $self->[INFO_DESC] };
    
    # call trace file
    open( $self->[CALL_DESC], "+>${file_name}.call_info" )
      or print DBG "Ouverture Call impossible\n";
    autoflush { $self->[CALL_DESC] };
    
    # eval trace file
    open( $self->[EVAL_DESC], "+>${file_name}.eval_info" )
      or print DBG "Ouverture Eval impossible\n";
    autoflush { $self->[EVAL_DESC] };

    my %package = (
        'Text::Editor::Easy' => 1,
        'Text::Editor::Easy::Comm' => 1,
        'Text::Editor::Easy::Abstract' => 1,
    );

    my $indice = 0;
    FILE: while ( my ( $pack, $file, $line ) = caller( $indice++ ) ) {
        if ( $pack eq 'Text::Editor::Easy::Comm' ) {
            # Comm
            $package{$pack} = $file;
            
            # Abstract
            $file =~ s/Comm\.pm/Abstract\.pm/;
            $package{'Text::Editor::Easy::Abstract'} = $file;
            
            # Easy
            $file =~ s/Easy\/Abstract\.pm/Easy\.pm/;
            $package{'Text::Editor::Easy'} = $file;
        }
        last FILE;
    }

    print "Fichiers trouvés :\n\t", join( "\n\t", values %package), "\n";

    while ( my ( $package, $file ) = each %package ) {
        open ( FIC, $file ) or die "Can't open file $file : $!\n";
        while ( <FIC> ) {
            if ( /# Following call not to be shown in trace/ ) {
                $self->[HIDE]{$package}{$. + 1} = 1;
                print "Package $package, ligne à ignorer : ", $. + 1, " :\n";
                print scalar <FIC>;
            }
            if ( /# Inter-thread call, not to be shown in trace/ ) {
                $self->[INTER_CALL]{$. + 1} = 1;
            }
        }
        close FIC;
    }
    $length_s_n = Text::Editor::Easy->tell_length_slash_n;
}

=head2 trace_full_print

This function saves the link between a print and the code that generated it.

=cut

sub trace_full_print {
    my ( $self, $seek_start, $seek_end, $tid, $call_id, $on, $calls_dump, $data ) = @_;

    print DBG "Appel à trace_full_print : seek_start $seek_start|seek_end $seek_end|$data\n";

    return if ( !$self->[INFO_DESC] );

    # Valeur de la clé (ou des clés de hachage)
    my $value = tell $self->[INFO_DESC];
    $self->[HASH]{$seek_start} = $value;
    print { $self->[INFO_DESC] } "$seek_start|$seek_end\n";
    $call_id = '' if ( !defined $call_id );
    print { $self->[INFO_DESC] } "\t$tid|$call_id|$on\n";
    my @calls = eval $calls_dump;
    for my $tab_ref ( @calls ) {
        my ( $pack, $file, $line ) = @$tab_ref;
        print { $self->[INFO_DESC] } "\t$file|$line|$pack\n";
    }

# La donnée a été écrite sur le fichier, on peut l'ouvrir et analyser les départs de nouvelles lignes
    # On utilise pour cette analyse la variable $length_s_n (pas d'ouverture du fichier)
    my @lines = split ( /\n/, $data );
    my $seek_current = $seek_start;
    return if ( scalar ( @lines ) < 2 );
    for my $line ( @lines ) {
        $seek_current += length ( $line ) + $length_s_n;
        $self->[HASH]{$seek_current} = $value;
    }
}

=head2 get_info_for_display 

This function recovers the link between a print and the code that generated it.

=cut

sub get_info_for_eval_display {
    my ( $self, $ref_editor, $ref_line, $pos_in_line ) = @_;

    print DBG "Dans get_info_for_eval_display : ref_editor : $ref_editor| ref_line $ref_line| pos_in_line $pos_in_line\n";
    my $editor = Text::Editor::Easy->get_from_id( $ref_editor );
    my $seek_start = $editor->line_get_info( $ref_line );
    my $text = $editor->line_text ( $ref_line );
    print DBG "Seek start de la ligne : $seek_start| texte : $text\n";
    
    # Décomposition de la ligne
    my @seek_start = split ( /;/, $seek_start );
    my $to_calc = scalar(@seek_start);
    #my $current_length = length ( $text );
    my $current_length = 0;
    print DBG "\tCURRENT LENGTH $current_length\n";
    my $indice = 0;
    my ( $top_start, $real_start ) = split ( /,/, $seek_start[0] );

    while ( $to_calc ) {
        my ( $start, $end, $length ) = split ( /,/, $seek_start[$indice] );
        if ( ! defined $length ) {
            print STDERR "No information for following eval display : ", $editor->line_text( $ref_line ), "\n";
            print DBG "No information for following eval display : ", $editor->line_text( $ref_line ), "\n";
            last;
        }
        print DBG "\tSEEK_START $start de la position ", $current_length, " à la position ", $current_length + $length, "\n";
        if ( $pos_in_line <= $current_length + $length - ( $end - $start ) ) {
            print DBG "C'est ce seek_start $start qu'il faut renvoyer :\n";
            my $seek = $self->[HASH]{$start};
            if ( print_info_is_more_precise ( $self, $seek, $length ) ) {
                my ( $ref_first, $pos_first ) = get_first_line_for_print ( $self, $editor, $ref_line, $current_length, $end - $start );
                # Analyse de $@ : les messages sont par ligne entière (voir "trace_full_eval_err").
                # Seule la première ligne peut commencer au milieu (message précédent le $@ sans \n)
                print DBG "Après analyse ref_first $ref_first, pos_first $pos_first, ref_line $ref_line\n";
                if ( $ref_first != $ref_line ) {
                    return get_info_for_display ( $self, $end, $pos_in_line, $ref_editor, $ref_line );
                }
                my ( $ref1, $pos1, @next ) = get_info_for_display ( $self, $start, $pos_in_line, $ref_editor, $ref_line );
                return ( $ref1, $pos1 + $pos_first, @next );
            }
            print DBG "\tcurrent_length = $current_length\n";
            print DBG "\tpos_in_line = $pos_in_line\n";
            print DBG "\treal_start = $real_start\n";
            print DBG "\tstart = $start\n";
            print DBG "\tend = $end\n";
            print DBG "\tlength = $length\n";
            
            return (
                get_first_line_for_print ( $self, $editor, $ref_line, $current_length, $end - $start ),
                get_last_line_for_print ( $self, $editor, $ref_line, 0, $length + $current_length - ( $end - $start )),
                get_call_list_for_print ( $self, $seek ),
            );
        }
        $current_length += $length - ( $end - $start );
        print DBG "\tCURRENT LENGTH $current_length\n";
        $to_calc -= 1;
        $indice += 1;
    }
    my ( $start, $end, $length ) = split ( /,/, $seek_start[$indice - 1] );
    #print DBG "\tCURRENT LENGTH $current_length\n";
    #print DBG "\tPour finir, SEEK_START $start de la position ", $end - $real_start , " à la position ", $end + $current_length - $real_start, "\n";
    
    my $last_info_seek = $self->[HASH]{$start};
    print DBG "\tlast_info_seek = $last_info_seek\n";
    seek $self->[INFO_DESC], $last_info_seek, 0;
    my $info = readline ( $self->[INFO_DESC] );
    chomp $info;
    print DBG "\tinfo lu pour start = $start : $info\n";
    my ( $seek_1, $seek_2 ) = split ( /\|/, $info );
    print DBG "\tla longueur de SEEK_START $start est de ", $seek_2 - $seek_1, "\n";
    print DBG "\tIl reste donc ", $seek_2 - ( $end + $length ), " caractères sur le dernier seek_start\n";

    print DBG "\tIl reste également 1 ", $real_start - $top_start, " caractères à lire pour start $top_start\n";
    my $first_info_seek = $self->[HASH]{$top_start};
    print DBG "\tfirst_info_seek = $first_info_seek\n";
    seek $self->[INFO_DESC], $first_info_seek, 0;
    $info = readline ( $self->[INFO_DESC] );
    print DBG "\tinfo lu pour start = $top_start : $info\n";
    ( $seek_1, $seek_2 ) = split ( /\|/, $info );
    print DBG "\tIl reste également 2 ", $real_start - $seek_1, " caractères à lire pour start $top_start\n";

    seek $self->[INFO_DESC], 0, 2;
    return;
}

sub print_info_is_more_precise {
    my ( $self, $seek, $length ) = @_;

    seek $self->[INFO_DESC], $seek, 0;    
    my $enreg = readline( $self->[INFO_DESC] );
    seek $self->[INFO_DESC], 0, 2;
    chomp $enreg;
    my ( $seek_1, $seek_2 ) = split ( /\|/, $enreg );
    my $info_length = $seek_2 - $seek_1;
    if ( $info_length < $length ) {
        print DBG "Il y a plus d'information sur le fichier print info... :\n";
        print DBG "START = $seek_1 | End = $seek_2 | length $info_length (au lieu de $length)\n";
        return 1;
    }
    return;
}

sub get_first_line_for_print {
    my ( $self, $editor, $ref_line, $start, $end ) = @_;
    
    my $remain = $end - $start;
    print DBG "Dans get_first_line_for_print : Il faut remonter de $remain caractères\n";
    my $text;
    if ( $remain <= 0 ) {
        return ( $ref_line, -$remain );
    }
    while ( $remain > 0 ) {
        $remain -= $length_s_n;
        ( $ref_line, $text ) = $editor->previous_line( $ref_line );
        my $length = length($text);
        if ( $length >= $remain ) {
            return ( $ref_line, $length - $remain );
        }
        else {
            $remain -= $length;
        }
    }
    return ( $ref_line, 0 );
}

sub get_last_line_for_print {
    my ( $self, $editor, $ref_line, $start_of_line, $end ) = @_;

    my $text = $editor->line_text ( $ref_line );

    my $remain = $end - length ( $text ) - $start_of_line;
    print DBG "Dans get_last_line_for_print : Il faut descendre de $remain caractères\n";

    if ( $remain < 0 ) {
        return ( $ref_line, length ( $text ) + $remain );
    }
    while ( $remain > 0 ) {
        $remain -= $length_s_n;
        
        # Contournement d'un bug sur la gestion des "\n" en fin de fichier (ligne suivante (vide) absente...à voir)
        my ( $new_ref_line, $new_text ) = $editor->next_line( $ref_line );
        if ( ! defined $new_ref_line ) {
            return ( $ref_line, length($text) );
        }
        ( $ref_line, $text ) = ( $new_ref_line, $new_text );
        
        my $length = length($text);
        if ( $length >= $remain ) {
            return ( $ref_line, $remain );
        }
        else {
            $remain -= $length;
        }
    }
    return ( $ref_line, 0 );
}

sub get_info_for_display {
    my ( $self, $start_of_line, $shift, $ref_editor, $ref_line ) = @_;

    print DBG "Dans get_info_for_display : |$start_of_line| décalage : $shift\n";
    my $editor = Text::Editor::Easy->get_from_id( $ref_editor );

    my $value = $self->[HASH]{$start_of_line};
    if ( ! defined $value ) {
        print DBG "No info for print at position $start_of_line\n";
    }
    print DBG "Clé $start_of_line trouvée !! valeur : |$value|\n";
    seek $self->[INFO_DESC], $value, 0;
    my $enreg = readline $self->[INFO_DESC];
    print DBG "Enreg lu : $enreg | start_of_line $start_of_line | shift $shift\n";
    my ( $start, $end ) = $enreg =~ /^(\d+)\|(\d+)/;
    print DBG "\tSTART et END : $start|$end\n";
    while ( $end < $start_of_line + $shift ) {
        ($start, $end ) = next_display( $self );
         print DBG "\tSTART et END : $start|$end\n";        
    }
    print DBG "\tRenvoyé ==> START et END : $start|$end\n";
    return (
       get_first_line_for_print ( $self, $editor, $ref_line, $start, $start_of_line ),
       get_last_line_for_print ( $self, $editor, $ref_line, $start_of_line, $end ),
       #$ref_line, $end,
       get_call_list_for_print( $self, $self->[HASH]{$start} )
    );
}
    
sub get_call_list_for_print {
    my ( $self, $seek ) = @_;
    
    seek $self->[INFO_DESC], $seek, 0;
    readline $self->[INFO_DESC];
    my $enreg = readline $self->[INFO_DESC];
    $enreg =~ s/\t//;
    chomp $enreg;
    my @enreg = $enreg;
    my ( $tid, $call_id ) = split( /\|/, $enreg );
    $enreg = readline $self->[INFO_DESC];
    PRINT: while ( defined $enreg and $enreg =~ /^\t/ ) {
        chomp $enreg;
        my ( $file, $line, $package ) = split( /\|/, $enreg );
        if ( $package eq 'Text::Editor::Easy::Comm' or $package eq 'Text::Editor::Easy::Abstract' ) {
            if ( $self->[INTER_CALL]{$line} ) {
                push @enreg, "", get_info_for_call ( $self, $call_id );
                last PRINT;
            }
        }
        if ( my $hash_ref = $self->[HIDE]{$package} ) {
            if ( $hash_ref->{$line} ) {
                $enreg = readline $self->[INFO_DESC];
                next PRINT;
            }
        }
        if ( $file =~ /^\t\(eval / ) {
            $enreg = try_to_identify_eval ( $self, $enreg, $call_id, $self->[INFO_DESC] );
        }
        print DBG "J'empile $enreg\n";
        push @enreg, $enreg;
        
        if ( $package eq 'Text::Editor::Easy::Graphic' ) {
            push @enreg, "", get_info_for_call ( $self, $call_id );
            last PRINT;
        }
        
        $enreg = readline $self->[INFO_DESC];
    }
    seek $self->[INFO_DESC], 0, 2;
    
    print DBG "Retour de get_call_list...\n";
    return @enreg;
}

sub next_display {
    my ( $self ) = @_;
    
    my $enreg = readline $self->[INFO_DESC];
    while ( $enreg =~ /^\t.+/ ) {
        $enreg = readline $self->[INFO_DESC];
    }
    return $enreg =~ /^(\d+)\|(\d+)$/;
}

sub try_to_identify_eval {
    my ( $self, $enreg, $call_id, $file_desc ) = @_;
    
    print DBG "Dans try_to_identify : clé E$call_id\n";
    my $value = $self->[HASH]{'E_' . $call_id};
    return $enreg if ( ! defined $value );
    print DBG "Dans identify : trouvé $value pour clé E_$call_id\n";
    
    my $seek = tell $file_desc;
    my $eval_call = readline $file_desc;
    seek $file_desc, $seek, 0;
        
    return $enreg if ( $eval_call !~ /\t(.+)\|(.+)\|(.+)$/ );
    my ( $file, $line, $package ) = ( $1, $2, $3 );
    print "file line et package : $file | $line | $package\n";

    # Vérification de l'égalité de fichier et de ligne entre l'eval et la ligne suivante du fichier $file_desc
    my @position = split ( /;/, $value);
    my $indice = 0;
    my $found = 0;
    EVAL: for ( @position ) {
        seek $self->[EVAL_DESC], $_, 0;
        my $eval_info = readline $self->[EVAL_DESC];
        print "INFO Eval lu =\n\t$eval_info";
        
        chomp $eval_info;
        my ( $tid, $c_file, $c_package, $c_line, $c_call_id ) = split (/\|/, $eval_info );
        if ( $c_file eq $file and $line == $c_line ) {
            print "EVAL identifié : E_${call_id}__$indice\n";
            $found = 1;
            last EVAL;
        }
        $indice += 1;
    };
    if ( $found ) {
        my ( $file, $line, $package ) = $enreg =~ /\t(.+)\|(.+)\|(.+)$/;
        $enreg = "\teval E_${call_id}__$indice|$line|$package\n";
        print "Trouvé, on renvoie $enreg\n";
    }
    
    
    # Repositionement à la fin
    seek $self->[EVAL_DESC], 0, 2;

    return $enreg;
}

sub trace_full_call {
    my ( $self, $call_id, $client_call_id, @calls ) = @_;
    
    #print DBG "Dans trace_full_call (self = $self): $call_id\n";
    my $seek = tell $self->[CALL_DESC];
    no warnings;
    print { $self->[CALL_DESC] } "$call_id|$client_call_id\n";
    use warnings;
    for my $tab_ref ( @calls ) {
        if ( ref $tab_ref ) {
            my ( $pack, $file, $line ) = @$tab_ref;
            print { $self->[CALL_DESC] } "\t$file|$line|$pack\n";            
        }
        else {
            print { $self->[CALL_DESC] } "\t$tab_ref\n";
        }

    }
    $self->[HASH]{$call_id} = $seek;
    #print DBG "Fin de trace_full_call pour call_id $call_id => position $seek\n";
    #print DBG "Relecture du hachage : ", $self->[HASH]{$call_id}, "\n";
    #print DBG "Hash = ", $self->[HASH], "\n";
}

sub get_info_for_call {
    my ( $self, $call_id ) = @_;

    #print DBG "Dans get_info_for_call (self = $self): position de $call_id :\n";
    #print DBG "HASH = ", $self->[HASH], "\n";
    #print DBG "KEY  = ", $self->[HASH]{$call_id}, "\n";
    return if ( ! defined $call_id );
    
    my $seek = $self->[HASH]{$call_id};
    return if ( ! defined $seek );
    #print DBG "\tSEEK de $call_id => $seek\n";
    seek $self->[CALL_DESC], $seek, 0;
    my $enreg = readline $self->[CALL_DESC];
    chomp $enreg;
    my ( undef, $new_call_id ) = split ( /\|/, $enreg );
    my @return = $enreg;
    print DBG $enreg;
    $enreg = readline $self->[CALL_DESC];
    CALL: while ( $enreg =~ /^\t/ ) {
        chomp $enreg;
        my ( $file, $line, $package ) = split( /\|/, $enreg );
        if ( $package eq 'Text::Editor::Easy::Comm' or $package eq 'Text::Editor::Easy::Abstract' ) {
            if ( $self->[INTER_CALL]{$line} ) {
                if ( defined $new_call_id ) {
                    push @return, "", get_info_for_call ( $self, $new_call_id );
                }
                last CALL;
            }
        }
        if ( my $hash_ref = $self->[HIDE]{$package} ) {
            if ( $hash_ref->{$line} ) {
                $enreg = readline $self->[CALL_DESC];
                next CALL;
            }
        }
        push @return, $enreg;
        
        if ( $package eq 'Text::Editor::Easy::Graphic' ) {
            push @return, "", get_info_for_call ( $self, $new_call_id );
            last CALL;
        }
        
        $enreg = readline $self->[CALL_DESC];
    }
    # Repostionnement à la fin
    seek $self->[CALL_DESC], 0, 2;
    return @return;
}
=head2 trace_display_calls

This function is not used.

=cut

# Internal
sub trace_display_calls {
    my @calls = @_;
    for my $indice ( 1 .. scalar(@calls) / 3 ) {
        my ( $pack, $file, $line ) = splice @calls, 0, 3;

        #print ENC "\tF|$file|L|$line|P|$pack\n";
    }
}

sub trace_full_eval {
    my ( $self, $eval, $tid, $file, $package, $line, $call_id ) = @_;
    
    my $key = 'E_' . $call_id;
    my $value;
    if ( $value = $self->[HASH]{$key} ) {
        $value .= ';';
    }
    $value .= tell $self->[EVAL_DESC];
    $self->[HASH]{$key} = $value;
    print { $self->[EVAL_DESC] } "$tid|$file|$package|$line|$call_id\n";
    my @eval = split ( /\n/, $eval );
    for ( @eval ) {
        print { $self->[EVAL_DESC] } "\t$_\n";
    }
}

sub get_code_for_eval {
    my ( $self, $eval_id ) = @_;
    
    print "Dans get_code_for_eval : eval_id = $eval_id\n";
    return if ( $eval_id !~ /(E_.+)__(.+)$/ );
    my ( $key, $indice ) = ( $1, $2 );
    print "Dans get_code_for_eval : clé $key, indice $indice\n";
    my $value = $self->[HASH]{$key};
    my @position = split ( /;/, $value );
    seek $self->[EVAL_DESC], $position[$indice], 0;
    readline $self->[EVAL_DESC];
    my $enreg = readline $self->[EVAL_DESC];
    my @enreg;
    while ( $enreg =~ /^\t(.*)/ ) {
        push @enreg, $1;
        $enreg = readline $self->[EVAL_DESC];
    }
    seek $self->[EVAL_DESC], 0, 2;
    return @enreg;
}

sub trace_full_eval_err {
    my ( $self, $seek_start, $seek_end, $dump_hash, $message ) = @_;
    
    print DBG "Dans trace_full_eval_err, reçu : $seek_start | $seek_end | message\n$message";
    
    my @line = split ( /\n/, $message, -1 );
#    if ( scalar(@line) > 1 ) {
#        print "Cas pas encore géré : retrouver la taille du \\n\n";
#        return;
#    }
    
    my ( $num_eval, $num_line );
    my $seek_start_current = $seek_start;
    my $seek_end_current = $seek_start;
    my $to_write = 0;
    my $info = $line[0];
    my $value = tell $self->[INFO_DESC];
    
    # très dangereux !
    
    my %option = eval $dump_hash;
    for my $info ( @line ) {
        print DBG "Elément |$info| dans la boucle de traitement\n";
        if ( $info =~ / at \(eval (\d+)\) line (\d+)/ ) {
            if ( $to_write ) {
                print DBG "On va écrire $info et ce qui précède : seek_start : $seek_start_current\n";
                print DBG "SEEK end current : $seek_end_current\n";
                print DBG "Valeur $value pour la clé $seek_start_current\n";
                $self->[HASH]{$seek_start_current} = $value;   
                print { $self->[INFO_DESC] } "$seek_start_current|$seek_end_current\n";
                print { $self->[INFO_DESC] } "\t$option{'who'}|$option{'call_id'}|STDERR (\$@)\n";
                print { $self->[INFO_DESC] } "\t(eval $num_eval)|$num_line|$option{'package'}\n";
                print { $self->[INFO_DESC] } "\t$option{'file'}|$option{'line'}|$option{'package'}\n";
                my @calls = eval $option{'calls'};
                for my $tab_ref ( @calls ) {
                    my ( $pack, $file, $line ) = @$tab_ref;
                    print { $self->[INFO_DESC] } "\t$file|$line|$pack\n";
                }
                $value = tell $self->[INFO_DESC];
                $seek_start_current = $seek_end_current;
            }
            ( $num_eval, $num_line ) = ( $1, $2 );
            $to_write = 1;
        }
        $seek_end_current += $length_s_n + length( $info );
    }
    print DBG "Fin : On va écrire $info et ce qui précède : seek_start : $seek_start_current\n";
    $seek_end_current -= $length_s_n;
    print DBG "SEEK end current : $seek_end_current\n";
    print DBG "Valeur $value pour la clé $seek_start_current\n";
    $self->[HASH]{$seek_start_current} = $value;
    print { $self->[INFO_DESC] } "$seek_start_current|$seek_end_current\n";
    print { $self->[INFO_DESC] } "\t$option{'who'}|$option{'call_id'}|\$@\n";
    print { $self->[INFO_DESC] } "\t(eval $num_eval)|$num_line|$option{'package'}\n";
    print { $self->[INFO_DESC] } "\t$option{'file'}|$option{'line'}|$option{'package'}\n";
        
    my @calls = eval $option{'calls'};
    for my $tab_ref ( @calls ) {
        my ( $pack, $file, $line ) = @$tab_ref;
        print { $self->[INFO_DESC] } "\t$file|$line|$pack\n";
    }
}

sub declare_trace_for {
    my ( $self, $name, $file_name ) = @_;

    my $editor = Text::Editor::Easy->whose_name( $name );
    my $ref = $editor->id;
    
    my $new_self;
    $new_self->[OUT_NAME] = $file_name;
    $new_self->[HIDE] = {};
    $new_self->[INTER_CALL] = {};
    print DBG "Fin de declare_trace_for $name, $file_name, reference $ref\n";
    $self->[EXTENDED_SELF]{$ref} = $new_self;
    print DBG "1 self $self, new_self $new_self, out_name ", $new_self->[OUT_NAME], "\n";
}

sub get_info_for_extended_trace {
    my ( $self, $start, $shift, $ref_editor, $ref_line ) = @_;
    
    print DBG "Dans get_info_for_extended ref_editor = $ref_editor\n";
    my $new_self = $self->[EXTENDED_SELF]{$ref_editor};
    print DBG "2 self $self, new_self $new_self, out_name ", $new_self->[OUT_NAME], "\n";
    my $file_name = $new_self->[OUT_NAME];
    if ( ! -f $file_name or ! -f "${file_name}.print_info" ) {
        print DBG "Problème d'initialisation... fichiers de log absents\n";
        return;
    }
    my %h;
    if ( defined $new_self->[INFO_DESC] ) {
        close ( $new_self->[INFO_DESC] );
        untie %{$new_self->[HASH]};
    }
    open ( $new_self->[INFO_DESC], "${file_name}.print_info" ) or die "Can't open $file_name : $!\n";
    tie( %h, 'SDBM_File', $file_name, O_RDONLY, 0666 )
      or die "Couldn't tie SDBM file $file_name: $!; aborting";
    $new_self->[HASH] = \%h;
    
    return get_info_for_display ( $new_self, $start, $shift, $ref_editor, $ref_line );
}
=head1 COPYRIGHT & LICENSE

Copyright 2008 - 2009 Sebastien Grommier, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1;




# End
