package Text::Editor::Easy::Program::Save;

use warnings;
use strict;

=head1 NAME

Text::Editor::Easy::Program::Save - This module makes regular saves of the entire "Text::Editor::Easy" tree under developpement.

This is a temporary module to replace the annulation functionnality which is not yet implemented.
The process of regular save is launched only if the Editor.pl program finds a "../../save" directory.

=head1 VERSION

Version 0.49

=cut

our $VERSION = '0.49';

use Text::Editor::Easy;
use Text::Editor::Easy::Comm;

use File::Find;
use Archive::Zip;
use File::Compare qw( compare compare_text );
use File::Copy;
use File::Basename;
use File::Path;



sub init {
    my ( $self ) = @_;
    #print "Dans le thread ", threads->tid, " : exécution de l'ajout de méthode...\n";
    
    $self->{'current'} = "../../save/regular/current_list.txt";
    $self->{'old'} = "../../save/regular/old_list.txt";
    $self->{'dirs_to_clean'} = "../../save/regular/old_dirs_list.txt";
    
    Text::Editor::Easy->repeat_class_method( 10, 'save_arbo');
    
    #open ( OK, "../save/compil_OK
    save_arbo( $self );
}


my @month = qw( Janvier Fevrier Mars Avril Mai Juin Juillet Aout Septembre Octobre Novembre Decembre );
# find ne renvoie pas toujours la liste des fichiers dans le même ordre
# et en plus, sa fonction "wanted" n'accepte ni paramètre et n'en renvoie pas non plus
my $tab_ref;


# La procédure "save_arbo" (méthode de classe) sera lancée périodiquement par le thread 0 (réutilisation du "repeat" Tk)
sub save_arbo {
    my ( $self ) = @_;
   
    #print "Dans save_arbo de Save.pm, self $self, tid = ", threads->tid, "\n";
   
    # Récupération de tous les éditeurs "zone1"
    my @refs = Text::Editor::Easy->list_in_zone("zone1");

    # On récupère le file_name complet à chaque fois (il peut changer... même si pour l'instant, en cas de changement, Data n'est pas à jour)
    for my $ref ( @refs ) {
        # Méthode pas très propre pour appeler une méthode d'un objet pas créé dont on connait la référence... évite le bless et l'AUTOLOAD
        # Thread dédié => sauvegarde synchrone (pas de gestion de l'attente de fin d'exécution)
        Text::Editor::Easy::Comm::ask_named_thread(
            #$ref,
            Text::Editor::Easy->get_from_id( $ref ),
            'Text::Editor::Easy::File_manager::save_internal',
            'File_manager'
        );
    }
    
    # Récupération des noms de répertoire et d'archive à créer éventuellement (fonctions de l'heure)
    my ( $short_dir, $long_dir, $prefix ) = give_dirs_and_archive_name();
    
    # Constitution de la liste des fichiers actuellement en cours d'édition (tous ceux qui se trouvent dans
    # l'arborescence sous le répertoire courant sauf le répertoire "tmp/"
    my @files = ();
    $tab_ref = \@files;
    find({
        'wanted' => \&wanted,
        'no_chdir' => 1,
        }, 
        '.',
    );
    open (FIC, ">$self->{'current'}") or die "Impossible d'ouvrir $self->{'current'} : $!\n";
    for my $file ( sort @files ) {
        print FIC "$file\n";
    }
    close FIC;

    # Si il n'y a jamais eu de précédentes sauvegardes (ou que les fichiers d'information ont été supprimés)
    if ( ! -f $self->{'dirs_to_clean'} ) {
        tree_copy( $self, $self->{'current'}, $long_dir, $short_dir, $prefix );
        return;
    }
    
    # Récupération du répertoire le plus ancien contenant des fichiers non compressés (premier elligible à la suppression) : première ligne du fichier
    # et récupération du répertoire correspondant à la sauvegarde la plus récente : dernière ligne du fichier
    open ( OLD,     $self->{'dirs_to_clean'} ) or die "Impossible d'ouvrir $self->{'dirs_to_clean'} en lecture : $!\n";
    my @old_dirs;
    my $to_clean = <OLD>;
    chomp $to_clean;
    my $old_dir = $to_clean;

    while ( <OLD> ) {
        push @old_dirs, $_;
        chomp;
        $old_dir = $_;
    }

    # Vérification des changements éventuels (comparaison des fichiers édités et des fichiers sauvegardés)
    my $evolution;
    if ( compare( $self->{'current'}, $self->{'old'} ) != 0) {
        # Changement dans la liste des fichiers édités (ajout ou suppression)
        #print "Différence trouvée dans la liste des fichiers édités\n";
        $evolution = 1;
    }
    else {
        # Pas de changement de la liste, mais un fichier en édition peut avoir été modifié
        open ( LIST, $self->{'current'} ) or die "Impossible d'ouvrir $self->{'current'} : $!\n";

        FILE: while (<LIST>) {            
            chomp;
            if ( compare_text( "tmp/$_", "$old_dir/$_" ) != 0) {
                #print "Différence trouvée sur le fichier $_ entre\n";
                #print "\ttmp/$_\n";
                #print "\t$old_dir/$_\n";
                $evolution = 1;
                last FILE;
            }
        }
        close LIST;
    }
    
    #print "Pas de différence trouvée\n" if ( ! defined $evolution ); 
    if ( $evolution ) {
        tree_copy( $self, $self->{'current'}, $long_dir, $short_dir, $prefix, \@old_dirs );
    }

    # Ménage éventuel : on s'autorise 100 historiques non compressés (moins de 300 Mo)
    if ( scalar ( @old_dirs ) > 100 ) {
        rmtree( $to_clean );
        open ( OLD,     ">$self->{'dirs_to_clean'}" ) or die "Impossible d'ouvrir $self->{'dirs_to_clean'} en écriture : $!\n";
        for ( @old_dirs ) {
            print OLD;
        }
        close OLD;
    }
}

sub tree_copy {
    my ( $self, $file_list, $cible, $short_dir, $prefix, $old_dir_ref ) = @_;
    
    my $zip = Archive::Zip->new();
    open ( LIST, $file_list ) or die "Impossible d'ouvrir $file_list : $!\n";

    FILE: while (<LIST>) {            
        chomp;
        copy_with_dir_check ("tmp/$_", "$cible/$_" ) or print STDERR "Erreur lors de la copie de tmp/$_ vers $cible/$_ : $!\n";        
        $zip->addFile( "tmp/$_", $_ );
    }
    close LIST;
    $zip->addString( "Emplacement initial de l'archive :\n\n\t$cible", '.aaa_date.txt' );
    $zip->addDirectory( 'tmp/' );
    $zip->writeToFileNamed( "$short_dir/$prefix.zip" );
    
    mkpath( "$cible/tmp" );    

    open ( OLD,     ">>$self->{'dirs_to_clean'}" ) or die "Impossible d'ouvrir $self->{'dirs_to_clean'} en append : $!\n";
    print OLD "$cible\n";
    close OLD;
    push @$old_dir_ref, "$cible\n" if ( defined $old_dir_ref );
    
    copy( $self->{'current'}, $self->{'old'} );
}

sub copy_with_dir_check {
    my ( $source, $cible ) = @_;

    return 1 if ( copy ( $source, $cible) );

    my ($file_name, $path ) = fileparse( $cible );
    mkpath( $path );    
    
    return copy ( $source, $cible);
}

sub wanted {
    return if ( /tmp\// or -d $_ );

    # On laisse $_ inchangé...
    my $file = $_;
    $file =~ s/^\.\///;
    
    copy_with_dir_check ($_,"tmp/$file") or print STDERR "Erreur lors de la copie de $file vers tmp/$file : $!\n";
    push @$tab_ref, $file;
}

sub give_dirs_and_archive_name {
    my ($sec,$min,$hour,$mday,$mon,$year) = localtime(time);
    $year += 1900;    
    $mday = sprintf("%02d", $mday);
    $hour = sprintf("%02d", $hour);
    $min = sprintf("%02d", $min);
    $sec = sprintf("%02d", $sec);
    
    my $num_mon = sprintf("%02d", $mon + 1);
    
    my $short_dir = "../../save/regular/$year/${num_mon}__$month[$mon]/$mday/${hour}_h/${min}_min";
    my $long_dir = $short_dir . "/${sec}_sec";
    
    return ( 
        $short_dir, 
        $long_dir,
        "${sec}_sec",
    );
}



=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;