#!usr/bin/perl

use strict;
use warnings;

use Tk;

my @directories = ( 'c:/test', 'c:/AAAvalida/valida/enviados',
     'c:/AAAvalida/valida/respuestas' );
     
my ( %object, %files );

my $interval = 5;    #seconds

my $mw = MainWindow->new(
    -relief => 'raised',
    -bd     => 2,
    -title  =>
      "Asociacion de Agentes Aduanales de Matamoros --- Validacion Aut
+omatica"
);

$mw->geometry("1024x764+4+25");

my $head_frame = $mw->Frame()->pack;

my $main_frame = $mw->Frame()->pack(
    -fill   => 'both',
    -expand => 1,
);

$head_frame->Button(
    -text    => "Salir",
    -command => sub { exit }
)->pack;

setup($_) for @directories;

$mw->repeat( $interval * 1000, sub { monitor(@directories) } );

MainLoop;

sub setup {
    my $dir = shift;
    $object{$dir}{frame} = $main_frame->Frame()->pack(
        -side   => 'left',
        -fill   => 'both',
        -expand => 1,
        -padx   => 2,
    );
    $object{$dir}{message} = $object{$dir}{frame}->Label( -text => ' '
+ )->pack;
    $object{$dir}{label}   = $object{$dir}{frame}->Label( -text => $di
+r )->pack;

    $object{$dir}{listbox} = $object{$dir}{frame}->Scrolled(
        'Listbox',
        -scrollbars => 'ose',
        -relief     => 'sunken',
      )->pack(
        -fill   => 'both',
        -expand => 1
      );

    my ( $ok, @files ) = get_file_list($dir);

    if ($ok) {
        $files{$dir}{$_} = ( stat("$dir/$_") )[9] for @files;
        refresh_display( $dir );
    }
    else {
        read_error( $dir );
    }
}

sub monitor {
    my @directories = @_;
    for my $dir (@directories) {
        my @differences = file_lists_differ($dir);
        if ( @differences ) {
            $object{$dir}{message}->configure(
                -text => join "\n",
                @differences
            );
            # Do whatever with the info

            # Then refresh the display
            refresh_display( $dir );
        }
    }
}

sub refresh_display{
    my $dir = shift;
    my @view = $object{$dir}{listbox}->yview;
    $object{$dir}{listbox}->delete( 0, 'end' );
    $object{$dir}{listbox}->insert( 'end', $_ )
      for nsort( keys %{ $files{$dir} } );
    $object{$dir}{listbox}->yviewMoveto( $view[0] );
}

sub get_file_list {
    my $directory = shift;
    opendir my $dir, $directory or return 0;
    my @files = grep( !/^\.\.?$/, readdir $dir );
    closedir $dir;
    return 1, @files;
}

sub file_lists_differ {
    my $dir = shift;
    my ( %new_files, %old_files, @modified );
    $object{$dir}{message}->configure( -text => ' ' );
    my ( $ok, @files ) = get_file_list($dir);
    if ($ok) {
        $new_files{$_} = ( stat("$dir/$_") )[9] for @files;
        %old_files = %{ $files{$dir} };
        for ( keys %new_files ) {
            if ( defined $old_files{$_} ) {
                if ( $new_files{$_} eq $old_files{$_} ) {
                    delete $old_files{$_};
                    next;
                }
                push @modified, "$_ modified";
                delete $old_files{$_};
            }
            else {
                push @modified, "$_ added";
            }
        }
        for ( keys %old_files ) {
            push @modified, "$_ deleted";
        }
        %{ $files{$dir} } = %new_files;
    }
    else {
        read_error( $dir );
    }
    return @modified;
}

sub read_error {
    my $dir = shift;
    $object{$dir}{message}
          ->configure( -text => '*** COULD NOT READ DIRECTORY ***' );
}

sub deaccent{
    my $phrase = shift;
    return $phrase unless ($phrase =~ y/\xC0-\xFF//);
    $phrase =~ tr/ÀÁÂÃÄÅàáâãäåÇçÈÉÊËèéêëÌÍÎÏìíîïÒÓÔÕÖØòóôõöøÑñÙÚÛÜùúûü
+Ýÿý/AAAAAAaaaaaaCcEEEEeeeeIIIIiiiiOOOOOOooooooNnUUUUuuuuYyy/;
    my %trans = qw(Æ AE æ ae Þ TH þ th Ð TH ð th ß ss);
    $phrase =~ s/([ÆæÞþÐðß])/$trans{$1}/g;
    return $phrase;
}

sub nsort { # natural sort
    my $i;
    no warnings q/uninitialized/;
    s/((^\.0*)?)(\d+)/("\x0" x length $2) .
    (pack 'aNa*', 0, length $3, $3)/eg, $_ .= ' ' .
    $i++ for (my @x = map {lc deaccent $_} @_);
    @_[map {(split)[-1]} sort @x];
}
[download]