#!/usr/bin/perl -w
###############################################################################
##    Copyright (C) 2002 by Eric Gerbier
##    Bug reports to: gerbier@users.sourceforge.net
##    $Id: afick-tk.pl,v 1.45 2004/12/15 11:04:23 gerbier Exp $
##
##    This program is free software; you can redistribute it and/or modify
##    it under the terms of the GNU General Public License as published by
##    the Free Software Foundation; either version 2 of the License, or
##    (at your option) any later version.
##
##    This program is distributed in the hope that it will be useful,
##    but WITHOUT ANY WARRANTY; without even the implied warranty of
##    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
##    GNU General Public License for more details.
##
################################################################################
# this program just provide a graphical interface to afick
# it just launch afick commands
################################################################################
# rem : can not work in tainted mode : too many errors from Tk modules
################################################################################

use strict;
use diagnostics;

use Getopt::Long;      # arg analysis
use Carp qw(cluck);    # debugging

use File::Basename;    # for path
my $dirname = dirname($0);
require $dirname . '/afick-common.pl';

use Tk;                # interface
use Tk::Balloon;       # context help
use Tk::HList;
use Tk::ItemStyle;
use Tk::LabFrame;       # frame with a label
use Tk::Label;
use Tk::ItemStyle;
use Tk::ProgressBar;    # the progress bar
use Tk::ROText;         # to have read-only text
use Tk::Text;
use Tk::Tree;

# global var
my $Version          = '2.6-0';
my $Progress_percent = 0;         # progress bar var
my $ToggleProgress   = 1;         # checkbox var

# global widgets
my $W_change_text;                # text widget for change display
my $W_warning_text;               # text widget for warnings
my $W_progress_text;              # text widget for progress file name
my $W_progress_bar;               # progress bar
my $W_percent_text;               # text percent
my $W_balloon;                    # context help

# command arguments
my $Configfile = '';
my $Report_full_newdel;
my $Warn_missing_file;
my $Warn_dead_symlinks;
my $Running;
my $Timing;
my $Ignore_case;
my $Debug_level;

# labels for Optionmenu widgets (option configuration)
#my @verbose_values     = qw(verbose_config verbose noverbose);
#my @missing_values     = qw(missing_files_config missing_files nomissing_files);
#my @dead_sym_values    = qw(dead_symlinks_config dead_symlinks nodead_symlinks);
#my @full_newdel_values = qw(full_newdel_config full_newdel nofull_newdel);
#my @running_files_values =
#  qw(running_files_config running_files norunning_files);
#my @timing_values = qw(timing_config timing notiming);

my %colors = (
	changed  => 'red',
	new      => 'green',    # to be change
	deleted  => 'brown',    # to be change
	dangling => 'yellow',
	normal   => 'black',
	ok       => 'green',
	warning  => 'red',
	comment  => 'blue',
	link     => 'blue'
);

my %Config;

#####################################################################
# just some space to have groups of buttons
sub separator($) {
	my $w = shift(@_);    # widget
	$w->Label( -text => '     ' )->pack( -side => 'left' );
}
#####################################################################
# used to clear output screen before each command
sub clear_text($) {
	my $widget = shift(@_);    # widget
	$widget->delete( '1.0', 'end' );
}

#####################################################################
# print warnings in warning section and console
sub warning ($) {
	my $text = shift(@_);

	# display warnings in color (set on main by tagConfigure on widget)
	$W_warning_text->insert( 'insert', "$text\n", 'warning' );
	$W_warning_text->update();

	# to console ?
	#warn "$text\n";
}
#####################################################################
# display results in windows
sub display($) {
	my $file_df = shift(@_);    # file descriptor

	# save current cursor and set a waiting cursor
	my $cursor = $W_change_text->cget('-cursor');
	$W_change_text->configure( -cursor => 'watch' );

	# clear all windows
	clear_text($W_change_text);
	$W_change_text->update();
	clear_text($W_warning_text);
	$W_warning_text->update();
	clear_text($W_progress_text);
	$W_progress_text->update();

	my $refresh = 0;
	my $nb      = 0;
	my $total   = 0;
	$Progress_percent = 0;
	while (<$file_df>) {
		if ( $_ =~ m/^progress total (\d+)/ ) {

			# get number of file in database
			$total = $1;
		}
		elsif ( $_ =~ m/^progress (.*)/ ) {

			# get current scanned file
			$nb++;
			$Progress_percent = ( $nb * 100 ) / $total if ($total);
			$W_progress_bar->update();

			my $txt = sprintf( "%02d%% (%d)", $Progress_percent, $nb );
			clear_text($W_percent_text);
			$W_percent_text->insert( 'end', $txt );
			$W_percent_text->update();

			my $fic = $1;
			clear_text($W_progress_text);
			$W_progress_text->insert( 'end', $fic );
			$W_progress_text->update();
		}
		elsif ( $_ =~ m/^WARNING: (.*)/ ) {
			warning($1);
		}
		elsif ( $_ =~ m/^#/ ) {
			$W_change_text->insert( 'insert', $_, 'comment' );
		}

		# todo : complete log parsing and add colors ?
		else {
			$W_change_text->insert( 'insert', $_ );
		}

		# rafraichissement regulier
		$refresh++;
		if ( $refresh == 10 ) {
			$refresh = 0;
			$W_change_text->update();
		}
	}    # while
	close($file_df);

	# go to end of both screens
	$W_change_text->see('end');
	$W_warning_text->see('end');

	# restore cursor
	$W_change_text->configure( -cursor => $cursor );
	clear_text($W_progress_text);
}
#####################################################################
# used to spawn afick commands
sub do_action($) {
	my $arg = shift(@_);

	$arg .= " -c \"$Configfile\"" if ($Configfile);

	# force values (overload values in config file)
	# only if they are different from config file
	if ( $Warn_missing_file != $Config{'warn_missing_file'} ) {
		$arg .=
		  ($Warn_missing_file) ? ' --missing_files' : ' --nomissing_files';
	}

	if ( $Report_full_newdel != $Config{'report_full_newdel'} ) {
		$arg .= ($Report_full_newdel) ? ' --full_newdel' : ' --nofull_newdel';
	}

	if ( $Warn_dead_symlinks != $Config{'warn_dead_symlinks'} ) {
		$arg .=
		  ($Warn_dead_symlinks) ? ' --dead_symlinks' : ' --nodead_symlinks';
	}
	if ( $Running != $Config{'running_files'} ) {
		$arg .= ($Running) ? ' --running_files' : ' --norunning_files';
	}

	if ( $Timing != $Config{'timing'} ) {
		$arg .= ($Timing) ? ' --timing' : ' --notiming';
	}
	if ( $Ignore_case != $Config{'ignore_case'} ) {
		$arg .= ($Ignore_case) ? ' --ignore_case' : ' --noignore_case';
	}
	if ( $Debug_level != $Config{'debug'} ) {
		$arg .= " --debug $Debug_level";
	}

	# progress Checkbutton
	$arg .= ' --progress' if ($ToggleProgress);

	#print "arg = $arg \n" if ($verbose);

	if ( !open( ACTION, "afick.pl $arg  2>&1 |" ) ) {
		warning("can not execute afick.pl : $!");
		return;
	}
	else {
		display(*ACTION);
	}
}

#####################################################################
# general texte display in a new text window
# is used by all help buttons
sub display_message($$$) {
	my $main    = shift(@_);    # parent widget
	my $title   = shift(@_);    # window title
	my $baratin = shift(@_);    # text to display

	my $top = $main->Toplevel( -title => $title );
	$top->Button( -text => 'quit', -command => [ $top => 'destroy' ] )->pack();
	my $text = $top->Scrolled(
		'ROText',
		-scrollbars => 'e',
		-height     => 25,
		-width      => 128,
		-wrap       => 'word'
	)->pack( -side => 'left', -expand => 1, -fill => 'both' );

	$text->insert( 'end', $baratin );
	$text->see('1.0');
}
#####################################################################
# display general help page
sub do_help($) {
	my $main = shift;

	my $baratin =
	  'this is a graphical interface to afick (another file integrity checker)
to monitor file system changes

menu buttons :
-----------------
File menu
- save  : save output screen to a local file
- load  : display a saved outpout in outpout screen
- history : open history file
- exit : to quit this interface

Action menu
- init : to create the database
- update : compare and update the database
- compare : compare the files with the database
- print : print database content
- check config : check configuration file syntaxe
- clean config : check configuration file syntaxe and comments bad lines

Analysis menu
- tree-view : display the change in a tree view

configuration menu : 
- select : select afick\'s configuration file (filebrowser)
- edit : edit afick\'s configuration file

options menu (pre-loaded with afick-tk options and afick\'s configuration file)
- timing
- running
- dead symlinks
- report full newdel
- warn on missing files
- ignore case
- debug

Help menu
- help : this page
- about : legal informations
- wizard : how to use afick
- bind keys : summary of all keyboards

the change section :
--------------------
display file changes

the warning section :
---------------------
display afick errors and warnings

the progress section :
----------------------
can be activated/desactivated by the "display progress" checkbutton
it is useful fo follow afick progress (compare on update mode only)
it display the currently scanned file
then a progress bar, from 0 to 100%, with a line each 10%

';

	display_message( $main, 'help', $baratin );

}
#####################################################################
# display about page
sub do_about($) {
	my $main = shift;

	my $baratin = "afick-tk version $Version : a graphical interface to afick\n
url  : http://afick.sourceforge.net
Copyright (c) 2002 Eric Gerbier <gerbier\@users.sourceforge.net>
send remarks or bug reports to gerbier\@users.sourceforge.net

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

";

	display_message( $main, 'about', $baratin );
}
#####################################################################
# display about page
sub do_bind($) {
	my $main = shift;

	my $baratin = '
by key
------
alt+a  : action menu
alt+A  : about screen
alt+b  : bind keys screen
alt+c  : configuration menu
alt+C  : check config
ctrl+c  : clean config
alt+d  : dead symlinks option
alt+e  : edit config file
alt+f  : file menu
alt+F  : full newdel option
alt+g  : print config
alt+h  : help menu
alt+H  : help screen
alt+i  : init action
alt+I  : ignore case option
alt+k  : compare action
alt+l  : load file
alt+M  : missing file option
alt+n  : analysis menu
alt+o  : option menu
alt+p  : print action
alt+R  : running option
alt+s  : save file
alt+S  : Select config file
alt+t  : tree-view screen
alt+T  : Timing option
alt+u  : update action
alt+w  ; wizard screen
alt+x  : exit
alt+y  : history

by menu
-------
alt+f  : file menu
- alt+y  : history
- alt+l  : load file
- alt+s  : save file
- alt+x  : exit
alt+a  : action menu
- alt+i  : init action
- alt+k  : compare action
- alt+u  : update action
- alt+p  : print action
- alt+g  : print config
- alt+C  : check config
- crtl+c  : clean config
alt+n  : analysis menu
- alt+t  : tree-view screen
alt+c  : configuration menu
- alt+S  : Select config file
- alt+e  : edit config file
alt+o  : option menu
- alt+T  : Timing option
- alt+R  : running option
- alt+d  : dead symlinks
- alt+F  : full newdel option
- alt+M  : missing file option
- alt+I  : ignore case option
alt+h  : help menu
- alt+H  : help screen
- alt+w  ; wizard screen
- alt+k  : bind keys screen
- alt+A  : about screen

';

	display_message( $main, 'bind keys', $baratin );
}
#####################################################################
# display about page
sub do_wizard($) {
	my $main = shift;

	my $baratin = 'How to use afick ?

First : create a config file according to your needs :
- afick provide 2 config file sample : windows.conf and linux.conf
- read configuration documentation (afick.conf man page or config.html)
- customize your config file with afick-tk or your favorite editor

Second : initiate your database :
- apply "init" button

you are now ready for afick use : compare, update, print ...
';

	display_message( $main, 'wizard', $baratin );
}
#####################################################################
## begin tree section
#####################################################################
sub do_tree_help($) {
	my $main = shift;

	my $baratin = 'afick tree view allow to see a tree of changed files

colors :
- green for new files
- red for file changes
- blue for deleted files
- yellow for dangling files

actions :
- simple click : display details on selected file
- double click : clear color
';

	display_message( $main, 'tree help', $baratin );
}
#####################################################################
# create all counters and buttons at top of tree widget
sub create_tree_buttons($) {
	my $mw = shift(@_);

	my $frame_text = $mw->LabFrame( -label => 'statistics' );
	$frame_text->pack( -expand => 0, -fill => 'x' );

	# new files label
	$frame_text->Label( -text => 'new' )->pack( -side => 'left' );
	my $wnew = $frame_text->ROText(
		-height     => 1,
		-width      => 7,
		-foreground => $colors{'new'}
	);
	$wnew->pack( -side => 'left' );
	$W_balloon->attach( $wnew, -balloonmsg => 'number of new files' );

	# deleted files label
	$frame_text->Label( -text => 'deleted' )->pack( -side => 'left' );
	my $wdel = $frame_text->ROText(
		-height     => 1,
		-width      => 7,
		-foreground => $colors{'deleted'}
	);
	$wdel->pack( -side => 'left' );
	$W_balloon->attach( $wdel, -balloonmsg => 'number of deleted files' );

	# changed files label
	$frame_text->Label( -text => 'changed' )->pack( -side => 'left' );
	my $wmod = $frame_text->ROText(
		-height     => 1,
		-width      => 7,
		-foreground => $colors{'changed'}
	);
	$wmod->pack( -side => 'left' );
	$W_balloon->attach( $wmod, -balloonmsg => 'number of changed files' );

	# dangling files label
	$frame_text->Label( -text => 'dangling' )->pack( -side => 'left' );
	my $wdang = $frame_text->ROText(
		-height     => 1,
		-width      => 7,
		-foreground => $colors{'dangling'}
	);
	$wdang->pack( -side => 'left' );
	$W_balloon->attach( $wdang, -balloonmsg => 'number of dangling links' );

	separator($frame_text);

	# help button
	my $bhelptree = $frame_text->Button(
		-text    => 'help',
		-command => [ \&do_tree_help, $mw ]
	)->pack( -side => 'left' );
	$W_balloon->attach( $bhelptree,
		-balloonmsg => 'display help on tree view' );

	#quit button
	my $bquit =
	  $frame_text->Button( -text => 'quit', -command => [ $mw => 'destroy' ] )
	  ->pack( -side => 'left' );
	$W_balloon->attach( $bquit, -balloonmsg => 'quit tree view' );

	return ( $wnew, $wdel, $wmod, $wdang );
}
########################################################################
# add a file to the widget tree
# this add all directories level until top
sub add_tree($$$) {
	my ( $w, $fulldir, $style ) = @_;

	# top dir
	my $parent;
	if ( $^O eq 'MSWin32' ) {
		if ( $fulldir =~ s/^([a-z]:)//i ) {
			$parent = $1;
		}
	}
	else {
		$parent = '/';
	}

	add_to_tree( $w, $parent, $parent ) unless $w->infoExists($parent);

	my $cur_parent = $parent;
	my @dirs       = ($cur_parent);
	foreach my $name ( split( /[\/\\]/, $fulldir ) ) {
		next unless length $name;
		push @dirs, $name;
		my $dir = join( '/', @dirs );
		add_to_tree( $w, $dir, $name, $cur_parent )
		  unless $w->infoExists($dir);
		$cur_parent = $dir;
	}

	# set color
	my $entry = $parent . $fulldir;
	if ( defined $style ) {
		$w->entryconfigure( $entry, -style => $style );
	}
}

########################################################################
# add to tree only one element
sub add_to_tree {
	my ( $w, $dir, $name, $parent ) = @_;

	my $mode = 'close';

	my @args = ( -text => $name, -data => $name );
	if ($parent) {    # Add in alphabetical order.
		foreach my $sib ( $w->infoChildren($parent) ) {
			if ( $sib gt $dir ) {
				push @args, ( -before => $sib );
				last;
			}
		}
	}

	$w->add( $dir, @args );
	$w->setmode( $dir, $mode );
}

#####################################################################
# parse display and build tree
sub tree_parse($$$$$$) {
	my ( $w_maintree, $wnew, $wdel, $wmod, $wdang, $h_change ) = @_;
	my $nbnew = 0;
	my $nbdel = 0;
	my $nbmod = 0;
	my $nbdan = 0;

	my $name;
	my $summary = 1;
	my $logs    = $W_change_text->get( '1.0', 'end' );

	my @logs = split( /\n/, $logs );

	foreach (@logs) {
		chomp();

		if ($summary) {

			# summary part
			if (m/^new.*: (.*)/) {
				add_tree( $w_maintree, $1, 'new' );
				$h_change->{$1}{type} = 'new';
				$nbnew++;
			}
			elsif (m/^deleted.*: (.*)/) {
				add_tree( $w_maintree, $1, 'deleted' );
				$h_change->{$1}{type} = 'deleted';
				$nbdel++;
			}
			elsif (m/^changed.*: (.*)/) {
				add_tree( $w_maintree, $1, 'changed' );
				$h_change->{$1}{type} = 'changed';
				$nbmod++;
			}
			elsif (m/^Dangling.*: (.*)/) {
				add_tree( $w_maintree, $1, 'dangling' );
				$h_change->{$1}{type} = 'dangling';
				$nbdan++;
			}
			elsif (m/^# detailed changes/) {

				# summary part end at first blank line
				$summary = 0;
			}
		}
		else {

			# detailed part
			if (m/^\w.*: (.*)/) {
				$name = $1;
			}
			elsif (m/\t(\w+)\s+: (.*)\t(.*)/) {
				my $field = $1;
				my $old   = $2;
				my $new   = $3;
				$h_change->{$name}{$field} = "$old\t$new";
			}
			elsif (m/\t(.*)\s+: (.*)/) {
				my $field = $1;
				my $old   = $2;
				$h_change->{$name}{$field} = "$old";
			}
		}
	}

	$w_maintree->autosetmode();

	# write in text box
	$wnew->insert( 'end',  $nbnew );
	$wdel->insert( 'end',  $nbdel );
	$wmod->insert( 'end',  $nbmod );
	$wdang->insert( 'end', $nbdan );
}
########################################################################
# to display changes info in display panel
sub tree_display_detail($$$) {
	my $d        = shift;
	my $w_detail = shift;
	my $h_change = shift;

	#print "debug : tree_display_detail d=$d\n";
	$d =~ s!//!/!;    # remove first //

	$w_detail->delete('all');
	my $item = $w_detail->addchild('');
	$w_detail->itemCreate( $item, 0, -itemtype => 'text', -text => $d );

	if ( exists $h_change->{$d} ) {
		my $var = $h_change->{$d};
		$w_detail->itemCreate(
			$item, 1,
			-itemtype => 'text',
			-text     => $var->{type}
		);
		foreach my $elem ( keys %$var ) {
			next if ( $elem eq 'type' );
			$item = $w_detail->addchild('');

			$w_detail->itemCreate(
				$item, 0,
				-itemtype => 'text',
				-text     => $elem
			);

			my @tab = split( /\t/, $var->{$elem} );
			my $col = 1;
			foreach my $t (@tab) {
				$w_detail->itemCreate(
					$item, $col,
					-itemtype => 'text',
					-text     => $t
				);
				$col++;
			}
		}
	}
}
########################################################################
# used to change color to black if user valid entry
sub tree_remove_color($$) {
	my $d          = shift;
	my $w_maintree = shift;
	$w_maintree->entryconfigure( $d, -style => 'normal' );
}
#####################################################################
# build tree + detailled widget
sub create_tree_widget($$) {
	my $mw       = shift(@_);
	my $h_change = shift(@_);

	my $w_maintree = $mw->Scrolled(
		'Tree',
		-itemtype   => 'text',
		-separator  => '/',
		-selectmode => 'single',
		-scrollbars => 'osoe',
		-width      => 35,
		-height     => 35
	);
	$W_balloon->attach( $w_maintree, -balloonmsg => 'tree of changes files' );

	my $w_details = $mw->Scrolled(
		'HList',
		-header  => 1,
		-columns => 4,
		-width   => 100
	);
	$W_balloon->attach( $w_details,
		-balloonmsg => 'details about changes files' );

	my @header = ( 'filename / field', 'old value', 'new_value' );
	my $nbcol = scalar(@header) - 1;
	for ( 0 .. $nbcol ) {
		$w_details->header( 'create', $_, -text => $header[$_] );
	}

	# single click : display info
	$w_maintree->configure( -browsecmd =>
		  sub { tree_display_detail( $_[0], $w_details, $h_change ) } );

	# double click : remove color
	$w_maintree->configure(
		-command => sub { tree_remove_color( $_[0], $w_maintree ) } );

	$w_maintree->packAdjust( -side => 'left', -fill => 'both', -delay => 1 );
	$w_details->pack( -side => 'right', -fill => 'both', -expand => 1 );

	# creation des style
	$w_maintree->ItemStyle(
		'text',
		-stylename  => 'normal',
		-foreground => 'black',
	);

	$w_maintree->ItemStyle(
		'text',
		-stylename  => 'changed',
		-foreground => $colors{'changed'}
	);

	$w_maintree->ItemStyle(
		'text',
		-stylename  => 'new',
		-foreground => $colors{'new'}
	);

	$w_maintree->ItemStyle(
		'text',
		-stylename  => 'deleted',
		-foreground => $colors{'deleted'}
	);

	$w_maintree->ItemStyle(
		'text',
		-stylename  => 'dangling',
		-foreground => $colors{'dangling'}
	);
	return ( $w_maintree, $w_details );
}
#####################################################################
# main tree sub
sub do_tree($) {
	my $main = shift;
	my %h_change;

	my $mw = $main->Toplevel( -title => 'afick tree view' );

	my ( $wnew, $wdel, $wmod, $wdang ) = create_tree_buttons($mw);
	my ( $w_maintree, $w_details ) = create_tree_widget( $mw, \%h_change );

	tree_parse( $w_maintree, $wnew, $wdel, $wmod, $wdang, \%h_change );
}
#####################################################################
##  load section
#####################################################################
# a global var for do_save_log and do_load_log
my $log_types = [
	[ 'Afick Files', 'afick*', ],
	[ 'log files',   '.log' ],
	[ 'text files',  '.txt' ],
	[ 'All Files',   '*', ],
];
#####################################################################
# save change screen to a log file
sub do_save_log($) {
	my $main = shift;

	my @logs = $W_change_text->get( '1.0', 'end' );
	my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday ) =
	  localtime(time);
	$year += 1900;
	$mon  += 1;
	my $date     = "${year}_${mon}_${mday}_${hour}_${min}";
	my $logname  = 'afick.' . $date . '.log';
	my $filename = $main->getSaveFile(
		-initialfile => "$logname",
		-filetypes   => $log_types
	);

	if ($filename) {
		print "log in $filename\n";
		if ( !open( LOG, '>', $filename ) ) {
			warning("can not write on $filename");
		}
		else {
			print LOG @logs;
			close LOG;
		}
	}
}
#####################################################################
sub load_file($) {
	my $filename = shift(@_);
	clear_text($W_change_text);
	clear_text($W_warning_text);

	if ( !open( LOG, '<', $filename ) ) {
		warning("can not read $filename : $!");
	}
	else {
		display(*LOG);
	}
}
#####################################################################
# load a log file into change part
sub do_load_log($) {
	my $main = shift;

	my @logs = $W_change_text->get( '1.0', 'end' );
	my $filename = $main->getOpenFile( -filetypes => $log_types );
	if ($filename) {
		load_file($filename);
	}
}
#####################################################################
## history section
#####################################################################
# ask afick.pl about config
# avoid duplicate code on parsing config file and options
sub get_config($) {
	my $configfile = shift(@_);

	# first ask for config
	my $arg = '--print_config';
	$arg .= " -c \"$configfile\"" if ($configfile);

	if ( !open( ACTION, "afick.pl $arg  2>&1 |" ) ) {

		# errors messages are set by caller
		return undef;
	}
	else {
		my %config;

		while (<ACTION>) {
			chomp();
			s/^DEBUG\d: //;
			my @ret;
			if ( @ret = is_directive($_) ) {
				my $dir = shift(@ret);
				my $val = shift(@ret);

				#print "get_config  $dir --> $val\n";
				$config{$dir} = $val;
			}
		}    # while
		close(ACTION);

		return %config;
	}
}
#####################################################################
# simple click : show history
sub click_history($$$$) {
	my $w           = shift(@_);
	my $num         = shift(@_);
	my $archive_dir = shift(@_);
	my $label       = shift(@_);

	# get date
	my $item = $w->itemCget( $num, 0, 'text' );
	if ( $item =~ m/^(\d+)\/(\d+)\/(\d+) (\d+):(\d+):(\d+)/ ) {
		my $log = $archive_dir . '/afick.' . $1 . $2 . $3 . $4 . $5 . $6;

		if ( -f $log ) {
			load_file($log);
			$label->configure( -text => "archive file $log loaded" );
		}
		else {
			$label->configure( -text => "archive file $log not found" );
		}
	}
	else {
		$label->configure( -text => "bad date entry in history : $item" );
	}
}
#####################################################################
# double click : delete archive file
sub delete_archive($$$$) {
	my $w           = shift(@_);
	my $num         = shift(@_);
	my $archive_dir = shift(@_);
	my $label       = shift(@_);

	$label->configure( -text => "call delete_archive $num" );

	my $style_normal = $w->ItemStyle(
		'text',

		#                       -stylename  => 'normal',
		-foreground => $colors{'normal'}
	);

	# get date
	my $item = $w->itemCget( $num, 0, 'text' );
	if ( $item =~ m/^(\d+)\/(\d+)\/(\d+) (\d+):(\d+):(\d+)/ ) {
		my $log = $archive_dir . '/afick.' . $1 . $2 . $3 . $4 . $5 . $6;

		if ( -f $log ) {
			unlink($log);
			print "delete $log\n";
			$label->configure( -text => "archive file $log deleted" );

			# change item color to mark it was deleted
			$w->itemConfigure( $num, 0, 'style', $style_normal );
		}
		else {
			print "$log not found\n";
			$label->configure( -text => "archive file $log not found" );
		}
	}
	else {
		print "bad date $item\n";
		$label->configure( -text => "bad date entry in history : $item" );
	}
}
#####################################################################
# in charge to remove deleted log entries from history file
sub clean_history($$) {
	my $label  = shift(@_);
	my $config = shift(@_);
	if ( !-f $config->{'history'} ) {
		$label->configure( -text => 'no history file' );
		return;
	}
	else {
		my $archive_dir = $config->{'archive'};

		if ( !-d $archive_dir ) {
			$label->configure( -text => 'no archive directory' );
			return;
		}
		open( HIST, '<', $config->{'history'} );

		my $changes = 0;
		my @newhistory;

		while ( my $ligne = <HIST> ) {
			my $log;
			my $date;

			# decode date to write links to archive files
			if ( $ligne =~ m/^(\d+)\/(\d+)\/(\d+) (\d+):(\d+):(\d+) (.*)/ ) {
				my $log =
				  $archive_dir . '/afick.' . $1 . $2 . $3 . $4 . $5 . $6;

				if ( -f $log ) {
					push( @newhistory, $ligne );
				}
				else {

					# no archive file
					$label->configure( -text => "skip $log" );
					$changes++;
				}
			}
			else {

				# bad date format
				$label->configure( -text => "bad date format on $ligne" );
				$changes++;
			}
		}    # while
		close(HIST);

		# only rewrite history file if some changes occurs
		if ($changes) {
			open( HIST, '>', $config->{'history'} )
			  or $label->configure( -text =>
				  "can not write to history file $config->{'history'} : $!" );
			foreach my $ligne (@newhistory) {
				print HIST $ligne;
			}
			close(HIST);
		}
	}
}
#####################################################################
sub do_history_help($) {
	my $main = shift;

	my $baratin = 'afick history view allow to see old runs
colors are :
- red for runs with changes
- green for "clean" runs without any changes

if the date is in blue, the archive file in available and you can :
- simple click : load selected file
- double click : delete selected file
';

	display_message( $main, 'history help', $baratin );
}
#####################################################################
# display history file
sub do_history($) {
	my $main = shift;

	my $label;
	my %config;

	my $top = $main->Toplevel( -title => 'history' );

	# frame for all buttons
	my $frame_b = $top->Frame()->pack();
	$frame_b->Button(
		-text    => 'clean',
		-command => sub { clean_history( $label, \%config ); $top->destroy() }
	)->pack( -side => 'left' );
	$frame_b->Button(
		-text    => 'help',
		-command => [ \&do_history_help, $top ]
	)->pack( -side => 'left' );
	$frame_b->Button( -text => 'quit', -command => [ $top => 'destroy' ] )
	  ->pack( -side => 'left' );

	$label = $top->Label( -width => 72 )->pack();

	%config = get_config($Configfile);

	if ( !%config ) {
		$label->configure( -text => 'can not read configuration' );
	}
	elsif ( !-f $config{'history'} ) {
		$label->configure( -text => 'no history file' );
	}
	else {
		my $archive_dir = $config{'archive'};

		if ( !-d $archive_dir ) {
			$label->configure( -text => 'no archive directory' );
		}

		my $w_history;
		$w_history = $top->Scrolled(
			'HList',
			-header     => 1,
			-columns    => 3,
			-width      => 100,
			-height     => 20,
			-selectmode => 'single',
			-browsecmd  => sub {
				my $num = shift;
				click_history( $w_history, $num, $archive_dir, $label );
			},
			-command => sub {
				my $num = shift;
				delete_archive( $w_history, $num, $archive_dir, $label );
			}
		)->pack( -expand => 1, -fill => 'both' );
		$W_balloon->attach( $w_history,
			-balloonmsg => 'history show afick run results' );

		my @header = ( 'date', 'summary', 'details' );
		my $nbcol = scalar(@header) - 1;
		for ( 0 .. $nbcol ) {
			$w_history->header( 'create', $_, -text => $header[$_] );
		}

		# creation des style
		my $style_normal = $w_history->ItemStyle(
			'text',

			#			-stylename  => 'normal',
			-foreground => $colors{'normal'}
		);

		my $style_ok = $w_history->ItemStyle(
			'text',

			#			-stylename  => 'ok',
			-foreground => $colors{'ok'}
		);

		my $style_change = $w_history->ItemStyle(
			'text',

			#			-stylename  => 'changed',
			-foreground => $colors{'changed'}
		);

		my $style_link = $w_history->ItemStyle(
			'text',

			#			-stylename  => 'link',
			-foreground => $colors{'link'}
		);

		open( HIST, '<', $config{'history'} );
		while ( my $ligne = <HIST> ) {
			chomp($ligne);
			my $e = $w_history->addchild('');

			my $style = $style_ok;
			if ( $ligne =~ m/files scanned, (\d+) changed/ ) {
				my $nb = $1;
				$style = $style_change if ( $nb != 0 );
			}

			# decode date to write links to archive files
			if ( $ligne =~
				m/^(\d+)\/(\d+)\/(\d+) (\d+):(\d+):(\d+) (.*) (\(.*)/ )
			{

				# format AAAA/MM/JJ HH:MM:SS
				my $date = "$1\/$2\/$3 $4:$5:$6";
				my $log  =
				  $archive_dir . '/afick.' . $1 . $2 . $3 . $4 . $5 . $6;
				my $text   = $7;
				my $detail = $8;

				my $style_date = $style_normal;
				$style_date = $style_link if ( -f $log );
				$w_history->itemCreate(
					$e, 0,
					-itemtype => 'text',
					-text     => $date,
					-style    => $style_date
				);
				$w_history->itemCreate(
					$e, 1,
					-itemtype => 'text',
					-text     => $text,
					-style    => $style
				);
				$w_history->itemCreate(
					$e, 2,
					-itemtype => 'text',
					-text     => $detail,
					-style    => $style_normal
				);
			}
			else {
				$w_history->itemCreate(
					$e, 0,
					-itemtype => 'text',
					-text     => $ligne,
					-style    => $style
				);
			}
		}

		close(HIST);
	}
}
#####################################################################
## config section
#####################################################################
# a global var for select_config and save_config
my $conf_types = [ [ 'config files', '.conf' ], [ 'All Files', '*', ], ];
#####################################################################
# to select a config file
sub select_config($$) {
	my $FenetreP = shift;
	my $entree   = shift;

	my $filename = $FenetreP->getOpenFile( -filetypes => $conf_types );
	if ( defined $filename and $filename ne '' ) {
		$entree->delete( 0, 'end' );
		$entree->insert( 0, $filename );
		$entree->xview('end');

		init_options($filename);
	}
}
#####################################################################
# to save a config file
sub save_config($$$) {
	my $main     = shift;
	my $text     = shift;
	my $top      = shift;
	my $initfile = $Configfile;
	$initfile =~ s?/?\\?g;
	my $filename = $main->getSaveFile(
		-initialfile => "$initfile",
		-filetypes   => $conf_types
	);

	my @conf = $text->get( '1.0', 'end' );
	my $w_msg = write_config( $Configfile, \@conf );
	warning($w_msg) if ($w_msg);

	$top->destroy();
	init_options($Configfile);
}
#####################################################################
# open selected config file
sub open_config($) {
	my $main = shift;

	my $top = $main->Toplevel( -title => $Configfile );
	my $text = $top->Scrolled(
		'Text',
		-scrollbars => 'e',
		-height     => 25,
		-width      => 128,
		-wrap       => 'word'
	)->pack( -side => 'left', -expand => 1, -fill => 'both' );

	my $SaveButton = $top->Button(
		-text    => 'save',
		-command => [ \&save_config, $main, $text, $top ]
	);
	$SaveButton->pack();
	$top->Button( -text => 'quit', -command => [ $top => 'destroy' ] )
	  ->pack( -after => $SaveButton );

	my @config;
	my $r_msg = read_config( $Configfile, \@config );
	if ( !defined $r_msg ) {
		warning( get_error() );
		return;
	}
	else {
		foreach (@config) {
			$text->insert( 'end', $_ . "\n" );
		}
		$text->see('1.0');
	}

}
###############################################################################
sub init_options($) {
	my $configfile = shift(@_);
	%Config = get_config($configfile);

	$Report_full_newdel = $Config{'report_full_newdel'}
	  if ( !defined $Report_full_newdel );
	$Warn_missing_file = $Config{'warn_missing_file'}
	  if ( !defined $Warn_missing_file );
	$Running = $Config{'running_files'} if ( !defined $Running );
	$Warn_dead_symlinks = $Config{'warn_dead_symlinks'}
	  if ( !defined $Warn_dead_symlinks );
	$Timing      = $Config{'timing'}      if ( !defined $Timing );
	$Ignore_case = $Config{'ignore_case'} if ( !defined $Ignore_case );
	$Debug_level = $Config{'debug'}       if ( !defined $Debug_level );
}
#####################################################################
sub usage($) {

	my $version = shift(@_);
	print <<EOHELP
afick-tk ($version) : a graphical interface to afick
Usage: afick-tk [options]
Options:
--ignore_case|-a
	helpful on windows plateforms, dangerous on unix ones
        reverse : --noignore_case
--config_file|-c config
	name of config file to use
--debug level|-d
	set a level of debugging messages, from 0 (none) to 3 (full)
--full_newdel|-f
	report full  information on new and deleted directories
	reverse : --nofull_newdel
--help|-h
	this help
--missing_files|-m
	warn about files declared in config files which does not exists
	reverse : --nomissing_files
--running_files|-r
	warn about files modified during program run
	reverse: --norunning_files
--dead_symlinks|-s
	warn about dead symlinks
	reverse: --nodead_symlinks
--timing|-t
	Print timing statistics
	reverse : --notiming
--version|-V
	print program version

#################################################################
This script is intended to provide a means for
detecting changes made to files, via a regular
comparison of MD5 hashes to an established baseline. 
#################################################################
Copyright (c) 2002 Eric Gerbier <gerbier\@users.sourceforge.net>

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.
#################################################################
EOHELP
}

#####################################################################
##                       main
#####################################################################

# command line arg
my $version;
my $help = '';

# options
Getopt::Long::Configure('no_ignore_case');
unless (
	GetOptions(
		'config_file|c=s'  => \$Configfile,
		'full_newdel|f!'   => \$Report_full_newdel,
		'help|h'           => \$help,
		'ignore_case|a!'   => \$Ignore_case,
		'debug|d=i'        => \$Debug_level,
		'missing_files|m!' => \$Warn_missing_file,
		'running_files|r!' => \$Running,
		'dead_symlinks|s!' => \$Warn_dead_symlinks,
		'timing|t!'        => \$Timing,
		'version|V'        => \$version
	)
  )
{
	usage($Version);

	# can not use warning : no widget this time
	die('incorrect option !');
}

if ($help) {
	usage($Version);
	exit;
}

if ($version) {
	print "afick-tk  version $Version\n";
	exit;
}

# set default config file if not specified
$Configfile = $Configfile || get_default_config();
init_options($Configfile);

# tk page
my $main = MainWindow->new( -title => "afick-gui $Version" );

$W_balloon = $main->Balloon();

my $side = 'top';

# we will have
# frame 1 : action
# frame 2 : outpout
# frame 3 : warning
# frame 4 : progress bar
# frame 5 : configuration
# frame 6 : options

# frame 1 : actions
####################
my $frame1 = $main->LabFrame( -label => 'menus', -labelside => 'acrosstop' );
$frame1->pack( -side => $side, -expand => 0, -fill => 'x' );

#     file menu
my $filemenu = $frame1->Menubutton(
	-text      => 'File',
	-underline => 0,
	-tearoff   => 1
)->pack( -side => 'left' );
$W_balloon->attach( $filemenu,
	-msg => 'Press and hold this button to see the File menu.' );

my $historymenu = $filemenu->command(
	-label     => 'history',
	-underline => 6,
	-command   => [ \&do_history, $main ]
);
$main->bind( '<Alt-Key-y>' => sub { do_history($main); } );
my $loadmenu = $filemenu->command(
	-label     => 'load',
	-underline => 0,
	-command   => [ \&do_load_log, $main ]
);
$main->bind( '<Alt-Key-l>' => sub { do_load_log($main); } );
my $savemenu = $filemenu->command(
	-label     => 'save',
	-underline => 0,
	-command   => [ \&do_save_log, $main ]
);
$main->bind( '<Alt-Key-s>' => sub { do_save_log($main); } );
my $exitmenu = $filemenu->command(
	-label     => 'exit',
	-underline => 1,
	-command   => sub { exit; }
);
$main->bind( '<Alt-Key-x>' => sub { exit; } );

my $fmenu = $filemenu->cget( -menu );
$W_balloon->attach(
	$fmenu,
	-state => 'both',
	-msg   => [
		'detach menu',
		'consult history',
		'load previous log from file',
		'save log to file',
		'exit from afick-tk',
	]
);

#       action menu
my $actionmenu = $frame1->Menubutton(
	-text      => 'Action',
	-underline => 0,
	-tearoff   => 1
)->pack( -side => 'left' );
$W_balloon->attach( $actionmenu,
	-msg => 'Press and hold this button to see the Action menu.' );

my $initmenu = $actionmenu->command(
	-label     => 'init',
	-underline => 0,
	-command   => sub { do_action('-i') }
);
$main->bind( '<Alt-Key-i>' => sub { do_action('-i') } );

my $updatemenu = $actionmenu->command(
	-label     => 'update',
	-underline => 0,
	-command   => sub { do_action('-u') }
);
$main->bind( '<Alt-Key-u>' => sub { do_action('-u') } );

my $comparemenu = $actionmenu->command(
	-label     => 'kompare',
	-underline => 0,
	-command   => sub { do_action('-k') }
);
$main->bind( '<Alt-Key-k>' => sub { do_action('-k') } );

my $printmenu = $actionmenu->command(
	-label     => 'print',
	-underline => 0,
	-command   => sub { do_action('-p') }
);
$main->bind( '<Alt-Key-p>' => sub { do_action('-p') } );

$actionmenu->command(
	-label     => 'print config',
	-underline => 11,
	-command   => sub { do_action('--print_config') }
);
$main->bind( '<Alt-Key-g>' => sub { do_action('--print_config') } );

$actionmenu->command(
	-label     => 'Check config',
	-underline => 0,
	-command   => sub { do_action('--check_config') }
);
$main->bind( '<Alt-Key-C>' => sub { do_action('--check_config') } );

$actionmenu->command(
	-label     => 'Clean config',
	-underline => 0,
	-command   => sub { do_action('--clean_config') }
);
$main->bind( '<Control-Key-c>' => sub { do_action('--clean_config') } );

my $amenu = $actionmenu->cget( -menu );
$W_balloon->attach(
	$amenu,
	-state => 'both',
	-msg   => [
		'detach menu',
		'create database',
		'update database',
		'compare with database',
		'print database',
		'print configuration',
		'check configuration syntaxe',
		'clean configuration file',
	]
);

# analysis menu
my $anamenu = $frame1->Menubutton(
	-text      => 'analysis',
	-underline => 1,
	-tearoff   => 1
)->pack( -side => 'left' );
$W_balloon->attach( $anamenu,
	-msg => 'Press and hold this button to see the Analysis menu.' );

my $treemenu = $anamenu->command(
	-label     => 'tree-view',
	-underline => 0,
	-command   => [ \&do_tree, $main ]
);
$main->bind( '<Alt-Key-t>' => sub { do_tree($main); } );

my $ymenu = $anamenu->cget( -menu );
$W_balloon->attach(
	$ymenu,
	-state => 'both',
	-msg   => [ 'detach menu', 'display changes in a tree view' ]
);

# configuration file
my $configmenu = $frame1->Menubutton(
	-text      => 'configuration',
	-underline => 0,
	-tearoff   => 1
)->pack( -side => 'left' );
$W_balloon->attach( $configmenu,
	-msg => 'Press and hold this button to see the Configuration menu.' );

my $entry;
my $smenu = $configmenu->command(
	-label     => 'Select',
	-underline => 0,
	-command   => sub { select_config( $main, $entry ) }
);
$main->bind( '<Alt-Key-S>' => sub { select_config( $main, $entry ) } );

my $emenu = $configmenu->command(
	-label     => 'edit',
	-underline => 0,
	-command   => [ \&open_config, $main ]
);
$main->bind( '<Alt-Key-e>' => sub { open_config($main) } );

my $cmenu = $configmenu->cget( -menu );
$W_balloon->attach(
	$cmenu,
	-state => 'both',
	-msg   => [
		'detach menu',
		'select a configuration file',
		'edit the configuration file',
	]
);
$entry =
  $frame1->Entry( -textvariable => \$Configfile, -width => 30 )
  ->pack( -side => 'left' );

# options menu
my $optionmenu = $frame1->Menubutton(
	-text      => 'options',
	-underline => 0,
	-tearoff   => 1
)->pack( -side => 'left' );
$W_balloon->attach( $optionmenu,
	-msg => 'Press and hold this button to see the Option menu.' );

$optionmenu->checkbutton(
	-label     => 'Timing',
	-underline => 0,
	-variable  => \$Timing,
);
$main->bind( '<Alt-Key-T>' => sub { $Timing = !$Timing; } );
$optionmenu->checkbutton(
	-label     => 'Running',
	-underline => 0,
	-variable  => \$Running,
);
$main->bind( '<Alt-Key-R>' => sub { $Running = !$Running; } );
$optionmenu->checkbutton(
	-label     => 'dead symlinks',
	-underline => 0,
	-variable  => \$Warn_dead_symlinks,
);
$main->bind(
	'<Alt-Key-d>' => sub { $Warn_dead_symlinks = !$Warn_dead_symlinks; } );
$optionmenu->checkbutton(
	-label     => 'report full newdel',
	-underline => 7,
	-variable  => \$Report_full_newdel,
);
$main->bind(
	'<Alt-Key-F>' => sub { $Report_full_newdel = !$Report_full_newdel; } );
$optionmenu->checkbutton(
	-label     => 'warn on missing files',
	-underline => 8,
	-variable  => \$Warn_missing_file,
);
$main->bind( '<Alt-Key-M>' => sub { $Warn_missing_file = !$Warn_missing_file; }
);
$optionmenu->checkbutton(
	-label     => 'Ignore case',
	-underline => 0,
	-variable  => \$Ignore_case,
);
$main->bind( '<Alt-Key-I>' => sub { $Ignore_case = !$Ignore_case; } );
$optionmenu->separator();

# pseudo button without any command
$optionmenu->command(
	-label   => 'debug',
	-command => sub { },
);

#my $ldebug = 'debug';
#$optionmenu->cascade( -label => $ldebug );
#my $mbpm  = $optionmenu->cget( -menu );
#my $mbpmp = $mbpm->Menu;
#$optionmenu->entryconfigure( $ldebug, -menu => $mbpmp );
#
foreach my $elem ( ( 0, 1, 2, 3 ) ) {
	$optionmenu->radiobutton(
		-label    => $elem,
		-variable => \$Debug_level
	);
}
my $omenu = $optionmenu->cget( -menu );
$W_balloon->attach(
	$omenu,
	-state => 'both',
	-msg   => [
		'detach menu',
		'display cpu statistics',
		'display files changed during run',
		'display dangling symlinks',
		'display all changes',
		'warn about missing files',
		'ignore case',
		'debug level from 0 (none) to 3 (full)',
	]
);

# help menu
my $helpmenu = $frame1->Menubutton(
	-text      => 'help',
	-underline => 0,
	-tearoff   => 1
)->pack( -side => 'left' );
$W_balloon->attach( $helpmenu,
	-msg => 'Press and hold this button to see the Help menu.' );

my $hhelpmenu = $helpmenu->command(
	-label     => 'help',
	-underline => 0,
	-command   => [ \&do_help, $main ]
);
$main->bind( '<Alt-Key-H>' => sub { do_help($main); } );
my $wizardmenu = $helpmenu->command(
	-label     => 'wizard',
	-underline => 0,
	-command   => [ \&do_wizard, $main ]
);
$main->bind( '<Alt-Key-w>' => sub { do_wizard($main); } );
my $bindmenu = $helpmenu->command(
	-label     => 'bind keys',
	-underline => 1,
	-command   => [ \&do_bind, $main ]
);
$main->bind( '<Alt-Key-b>' => sub { do_bind($main); } );
my $aboutmenu = $helpmenu->command(
	-label     => 'About',
	-underline => 1,
	-command   => [ \&do_about, $main ]
);
$main->bind( '<Alt-Key-A>' => sub { do_about($main); } );

my $hmenu = $helpmenu->cget( -menu );
$W_balloon->attach(
	$hmenu,
	-state => 'both',
	-msg   => [
		'detach menu',
		'display help text',
		'small wizard display',
		'list of bind keys',
		'display about text (author, licence ...)',
	]
);

# frame 2 : text vue
####################
my $frame2 =
  $main->LabFrame( -label => 'changes section', -labelside => 'acrosstop' );
$frame2->pack( -side => $side, -expand => 1, -fill => 'both' );

$W_change_text = $frame2->Scrolled(
	'ROText',
	-scrollbars => 'e',
	-height     => 20,
	-width      => 128,
	-wrap       => 'word'
)->pack( -side => $side, -expand => 1, -fill => 'both' );
$W_balloon->attach( $W_change_text, -balloonmsg => 'change window' );

# configure colors
$W_change_text->tagConfigure( 'comment',  '-foreground', $colors{'comment'} );
$W_change_text->tagConfigure( 'change',   '-foreground', $colors{'changed'} );
$W_change_text->tagConfigure( 'new',      '-foreground', $colors{'new'} );
$W_change_text->tagConfigure( 'deleted',  '-foreground', $colors{'deleted'} );
$W_change_text->tagConfigure( 'dangling', '-foreground', $colors{'dangling'} );

# frame 3 : warning vue
####################
my $frame3 =
  $main->LabFrame( -label => 'warnings section', -labelside => 'acrosstop' );
$frame3->pack( -side => $side, -expand => 0, -fill => 'x' );

$W_warning_text = $frame3->Scrolled(
	'ROText',
	-scrollbars => 'e',
	-height     => 5,
	-width      => 128,
	-wrap       => 'word'
)->pack( -side => $side, -expand => 1, -fill => 'both' );
$W_balloon->attach( $W_warning_text, -balloonmsg => 'warning window' );

# set colors tag
$W_warning_text->tagConfigure( 'warning', '-foreground', $colors{'warning'} );

# frame 4 : progress
####################
my $frame4 =
  $main->LabFrame( -label => 'progress section', -labelside => 'acrosstop' );
$frame4->pack( -side => $side, -expand => 0, -fill => 'x' );

my $btoggleprogress = $frame4->Checkbutton(
	-text     => 'display progress',
	-variable => \$ToggleProgress
)->pack( -side => $side );
$W_balloon->attach( $btoggleprogress, -balloonmsg => 'toggle progress bar' );

#$frame4->Label( -text => 'scan') ->pack( -side => 'right' );
$W_progress_text = $frame4->ROText(
	-height => 1,
	-width  => 128,
	-wrap   => 'word'
)->pack( -side => $side );
$W_balloon->attach( $W_progress_text,
	-balloonmsg => 'display current scanned file' );

$W_percent_text = $frame4->ROText(
	-height => 1,
	-width  => 16,
	-wrap   => 'word'
)->pack( -side => 'right' );
$W_balloon->attach( $W_percent_text,
	-balloonmsg => 'display percent progress' );

$W_progress_bar = $frame4->ProgressBar(
	-length      => 780,
	-colors      => [ 0, 'green' ],
	-troughcolor => 'grey55',
	-variable    => \$Progress_percent
)->pack( -side => $side );
$W_balloon->attach( $W_progress_bar, -balloonmsg => 'progress bar' );

MainLoop;

__END__


=head1 NAME

afick-tk - a graphical interface for afick (Another File Integrity Checker)

=head1 DESCRIPTION

afick-tk is designed to help to use afick
for people who prefer graphical interfaces.

Graphical reports such "tree-view" may help to
have a quick overview.

=head1 SYNOPSIS

afick [L<options|options>]

afick use posix syntaxe, which allow many possibilities : 

=over 4

=item *

long (--) options

=item *

short (-) options

=item *

negative (--no) options

=back

=head1 OPTIONS

You can use any number of the following options :

=over 4

=item *
--config_file|-c configfile

read the configuration in config file named "configfile".

=item *
--full_newdel|-f,(--nofull_newdel)

(do not) report full information on new and deleted directories. Default : no

=item *
--help|-h

Output help information and exit.

=item *
--ignore_case|-a

ignore case for file names. Can be helpfull on windows plateforms, but is dangerous on unix ones.

=item *
--missing_files|-m,(--nomissing_files)

(do not) warn about files declared in config files which does not exists. Default : no

=item *
--dead_symlinks|-s,(--nodead_symlinks)

(do not) warn about dead symlinks. Default : no

=item *
--running_files|-r,(--norunning_files)

(do not) warn about "running" files : modified since program begin. Default : no

=item *
--timing|-t,(--notiming)

(do not) Print timing statistics. Default : no

=item *
--version|-V

Output version information and exit.

=item *
--verbose|-v,(--noverbose)

(not in) verbose mode (obsolete). Default : no

=back

=head1 SCREEN

the interface is composed from

=head2 menu buttons

menus are used to control actions, short-keys are associated for a quicker usage

=head3 File

=over 4

=item *
save

save output screen to a local file

=item *
load

display a saved outpout in outpout screen

=item *
history

open history file

=item *
exit

to quit this interface

=back

=head3 Action

=over 4

=item *
init

to create the database

=item *
update

compare and update the database

=item *
compare

compare the files with the database

=item *
print

print database content

=item *
print config

print afick's configuration

=item *
check config

check afick's configuration

=item *
clean config

check and clean afick's configuration (comments bad lines)

=back

=head3 Analysis

=over 4

=item *
tree-view

display the change in a tree view

=back

=head3 Configuration

=over 4

=item *
select

select afick's configuration file (filebrowser)

=item *
edit

edit afick's configuration file

=back

=head3 Options

they are set from afick's configuration file

=over 4

=item *
timing

=item *
running

=item *
dead symlinks

=item *
report full newdel

=item *
warn on missing files

=item *
ignore case

=item *
debug

=back

=head3 Help

=over 4

=item *
help

the screen description

=item *
wizard

how to use afick

=item *
bind keys

summary of all keyboards commands

=item *
about

legal informations

=back

=head2 changes section

to display the results

=head2 warnings section

to display errors and warnings

=head2 progress section

useful to follow the disk scan

=head1 NOTES

this program only use perl and its standard modules.

=head1 SEE ALSO

=for html
<a href="afick.conf.5.html">afick.conf(5)</a> for configuration file
<br>
<a href="afick.1.html">afick(1)</a> for command-line interface
<br>
<a href="afickonfig.1.html">afickonfig(1)</a> for a tool to change afick's configuration file

=for man
\fIafick.conf\fR\|(5) for configuration file
.PP
\fIafick\fR\|(1) for command-line interface
.PP
\fIafickonfig\fR\|(1) for a tool to change afick's configuration file

=head1 COPYRIGHT

Copyright (c) 2002,2003,2004 Eric Gerbier
All rights reserved.

This program is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the Free
Software Foundation; either version 2 of the License, or (at your option)
any later version.

=head1 AUTHORS

Eric Gerbier

you can report any bug or suggest to gerbier@users.sourceforge.net
