#!/usr/bin/perl -w
###############################################################################
##    Copyright (C) 2002 by Eric Gerbier
##    Bug reports to: gerbier@users.sourceforge.net
##    $Id: afick-tk.pl 1261 2009-01-10 16:41:44Z gerbier $
##
##    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 warnings;

use Pod::Usage;
use English '-no_match_vars';

#use diagnostics;

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

# Tk modules
use Tk;                 # interface
use Tk::Balloon;        # context help
use Tk::Checkbutton;    # directives configuration
use Tk::Entry;          # for search filter
use Tk::HList;          # tree
use Tk::ItemStyle;      # for colors
use Tk::LabFrame;       # frame with a label
use Tk::Label;
use Tk::ProgressBar;    # the progress bar
use Tk::ROText;         # to have read-only text
use Tk::Text;
use Tk::Tree;

use POSIX qw( strftime );
use File::Basename;     # for path

# constants
my $EMPTY = q{};
my $STAR  = q{*};
my $SLASH = q{/};

my $afick_path =
  dirname($PROGRAM_NAME) . $SLASH;    # check we use tools from same directory
require $afick_path . 'afick-common.pl';    # afick common library

# global var
my $Version          = '2.13-1';
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_total_text;                           # text number of scanned files
my $W_balloon;                              # context help
my $W_elapsed;                              # elapsed time
my $W_remain;                               # remaining time
my $W_filter_entry;                         # filter entry (search)

#my $W_status;                     # status bar

# command line arguments
my $Configfile = $EMPTY;
my $Report_full_newdel;
my $Warn_missing_file;
my $Warn_dead_symlinks;
my $Follow_symlinks;
my $Allow_overload;
my $Running;
my $Timing;
my $Ignore_case;
my $Debug_level;
my $Exclude_re;
my $Exclude_prefix;
my $Exclude_suffix;
my $Only_suffix;
my $Max_checksum_size;
my $Report_syslog;

# does not need to be use vars because we have our self debug
my $Verbose;

# configuration parameters
my $Report_full_newdel_conf;
my $Warn_missing_file_conf;
my $Warn_dead_symlinks_conf;
my $Follow_symlinks_conf;
my $Allow_overload_conf;
my $Running_conf;
my $Timing_conf;
my $Ignore_case_conf;
my $Debug_level_conf;
my $Exclude_re_conf;
my $Exclude_prefix_conf;
my $Exclude_suffix_conf;
my $Only_suffix_conf;
my $Max_checksum_size_conf;
my $Report_syslog_conf;

# 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',
	deleted  => 'brown',
	dangling => 'yellow',
	normal   => 'black',
	ok       => 'green',
	warning  => 'red',
	comment  => 'blue',
	link     => 'blue',
);

# configuration structures
my %Macros;
my %Alias;
my %Directives;
my %Rules;
my %Onlydir;

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

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

	chomp $text;

	# because some messages may appear before all windows are built
	if ($W_warning_text) {

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

		# to console
		warn "WARNING: $text\n";
	}
	return;
}
#####################################################################
# print warnings in warning section and console
sub info ($) {
	my $text = shift @_;

	chomp $text;

	# because some messages may appear before all windows are built
	if ($W_warning_text) {

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

		# to console
		print "info: $text\n";
	}
	return;
}
#####################################################################
sub debug ($;$) {
	my $text = shift @_;

	return if ( !$Verbose );

	chomp $text;

	# because some messages may appear before all windowss are built
	if ($W_change_text) {
		$W_change_text->insert( 'insert', "$text\n", 'comment' );
		$W_change_text->update();
	}
	else {
		print "DEBUG : $text\n";
	}
	return;
}
#####################################################################
# transform a time from seconds to hour, minutes, seconds
sub sec2human($) {

	my @date = gmtime shift @_;
	return strftime( '%H:%M:%S ', @date );
}
#####################################################################
# 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();
	clear_text($W_elapsed);
	$W_elapsed->update();
	clear_text($W_remain);
	$W_remain->update();
	$Progress_percent = 0;
	$W_progress_bar->update();
	clear_text($W_percent_text);
	$W_percent_text->update();

	my $begin_date = time;
	my $elapsed    = 0;
	my $refresh    = 0;
	my $nb         = 0;
	my $total      = 0;
	while (<$file_df>) {

		## no critic (ProhibitCascadingIfElse)
		if ( $_ =~ m/^progress total (\d+)/ ) {

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

			# get current scanned file and compute percent
			$nb++;
			clear_text($W_total_text);
			$W_total_text->insert( 'end', $nb );
			$W_total_text->update();

			# compute percents
			my $old_percent = $Progress_percent;
			## no critic (ProhibitParensWithBuiltin)
			if ($total) {
				$Progress_percent = int( ( $nb * 100 ) / $total );
			}

			# a test to avoid too many updates
			if ( $Progress_percent != $old_percent ) {

				# progress bar
				$W_progress_bar->update();

				# percent number
				my $txt = sprintf '%02d%%', $Progress_percent;
				clear_text($W_percent_text);
				$W_percent_text->insert( 'end', $txt );
				$W_percent_text->update();
			}

			# elapsed time display
			my $old_elapsed = $elapsed;

			# is there too many time calls ?
			$elapsed = time() - $begin_date;

			# another test to avoid too many updates
			if ( $old_elapsed != $elapsed ) {
				clear_text($W_elapsed);
				$W_elapsed->insert( 'end', sec2human($elapsed) );

				# remaining time display
				if ($Progress_percent) {
					clear_text($W_remain);
					if ( $Progress_percent > 100 ) {

					  # can occur whem file number is greater than previous scan
					  # we cannot estimate ...
						$W_remain->insert( 'end', 'unknown' );

					}
					else {
						## no critic (ProhibitParensWithBuiltin)
						my $remain =
						  int( $elapsed *
							  ( 100 - $Progress_percent ) /
							  $Progress_percent );
						$W_remain->insert( 'end', sec2human($remain) );
					}
				}
			}

			# current scan file
			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', $_ );
		}
		## use critic

		# refresh all 10 changes
		$refresh++;
		if ( $refresh == 10 ) {
			$refresh = 0;
			$W_change_text->update();
			$W_elapsed->update();
			$W_remain->update();
		}
	}    # while
	## no critic (RequireCheckedClose,RequireCheckedSyscalls)
	close $file_df;
	## use critic

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

	# update all
	$W_change_text->update();
	$elapsed = time() - $begin_date;
	clear_text($W_elapsed);
	$W_elapsed->insert( 'end', sec2human($elapsed) );
	$W_elapsed->update();
	clear_text($W_remain);
	$W_remain->insert( 'end', sec2human(0) );
	$W_remain->update();

	# restore cursor
	$W_change_text->configure( -cursor => $cursor );
	clear_text($W_progress_text);
	return;
}
#####################################################################
# low-level sub to start a command
sub wrapper($$) {
	my $cmd     = shift @_;
	my $options = shift @_;

	# on windows, the afick path is often "program files"
	# and the space make it not work with options : so quote the program
	my $QUOTE = q{"};
	$cmd = $QUOTE . $afick_path . $cmd . $QUOTE;

	my $fh_action;
	## no critic(TwoArgOpen);
	## no critic (RequireBriefOpen)

	if ( !open $fh_action, "$cmd $options 2>&1 |" ) {
		warning("can not execute $cmd : $ERRNO");
		return;
	}
	else {
		display($fh_action);
	}
	return;
}
#####################################################################
sub add_arg($$$$) {
	my $option     = shift @_;
	my $rh_dir     = shift @_;
	my $config_key = shift @_;
	my $cmd_key    = shift @_;

	if ( $option != is_binary( $rh_dir->{$config_key} ) ) {
		return ($option) ? ' --' . $cmd_key : ' --no' . $cmd_key;
	}
	else {
		return $EMPTY;
	}
}
#####################################################################
# 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
	$arg .= add_arg(
		$Warn_missing_file,  \%Directives,
		'warn_missing_file', 'missing_files'
	);

	$arg .= add_arg(
		$Report_full_newdel,  \%Directives,
		'report_full_newdel', 'full_newdel'
	);

	$arg .= add_arg(
		$Warn_dead_symlinks,  \%Directives,
		'warn_dead_symlinks', 'dead_symlinks'
	);

	$arg .= add_arg(
		$Follow_symlinks,  \%Directives,
		'follow_symlinks', 'follow_symlinks'
	);

	$arg .= add_arg( $Allow_overload, \%Directives, 'allow_overload',
		'allow_overload' );

	$arg .= add_arg( $Running, \%Directives, 'running_files', 'running_files' );

	$arg .= add_arg( $Timing, \%Directives, 'timing', 'timing' );

	$arg .= add_arg( $Ignore_case, \%Directives, 'ignore_case', 'ignore_case' );

	$arg .=
	  add_arg( $Report_syslog, \%Directives, 'report_syslog', 'report_syslog' );

	if ( $Debug_level != $Directives{'debug'} ) {
		$arg .= " --debug $Debug_level";
	}

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

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

	wrapper( 'afick.pl', $arg );
	return;
}

#####################################################################
# 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');
	return;
}
#####################################################################
# display general help page
sub do_help($) {
	my $main = shift;

	my $baratin = <<'EOF_HELP';
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 syntax
- clean config : check configuration file syntax and comments bad lines

Analysis menu
- tree-view : display the change in a tree view
- stat_ext  : display a list of file extension, sorted by numbers (for windows)
- stat_secu : display "dangerous" files (suid, sgid, group and world writable)
- stat_size : display statistics on file size
- search : filter the dump of database (to seach specific files)

configuration menu :
- select : select afick\'s configuration file (filebrowser)
- edit : edit afick\'s configuration file
- secure : run afickonfig with this options to secure config file
- directives : change afick\'s directives

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
- report to syslog
- debug

archive menu (interface to afick_archive tool)
- check : check archive consistency
- search : search in old reports
- clean : remove old reports

Help menu
- help : this page
- about : legal informations
- wizard : how to use afick
- check_update : check for new releases
- 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%
EOF_HELP

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

	my $baratin = <<"EOF_ABOUT";
afick-tk version $Version : a graphical interface to afick\n
url  : http://afick.sourceforge.net
Copyright (c) 2002/2006 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.
EOF_ABOUT

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

	my $baratin = <<'EOF_BIND';
by key
------
alt+a  : action menu
alt+A  : about screen
ctrl+a : secure configuration (addpath/addlib)
alt+b  : bind keys screen
alt+c  : configuration menu
alt+C  : check config
ctrl+c  : clean config
ctrl+C  : clean archive (old reports)
alt+d  : dead symlinks option
alt+e  : edit config file
ctrl+e : stat_ext action
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
ctrl+k : check archive 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
ctrl+s : search action
ctrl+S : search archive action
alt+t  : tree-view screen
alt+T  : Timing option
alt+u  : update action
alt+U  : check for update
ctrl+u : stat_secu action
alt+v  : archive menu
alt+w  ; wizard screen
alt+x  : exit
alt+y  : history
alt+Y  : report to syslog
ctrl+z : stat_size action

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
- ctrl+e : stat_ext action
- ctrl+u : stat_secu action
- ctrl+z : stat_size action
- ctrl+s : search action

alt+c  : configuration menu
- alt+S  : Select config file
- alt+e  : edit config file
- ctrl+a : secure configuration (addpath/addlib)

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+Y  : report to syslog

alt+v : archive menu
- ctrl+k : check archive action
- ctrl+S : search archive action
- ctrl+C  : clean archive (old reports)

alt+h  : help menu
- alt+H  : help screen
- alt+w  : wizard screen
- alt=U  : check for new releases
- alt+k  : bind keys screen
- alt+A  : about screen
EOF_BIND

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

	my $baratin = <<'EOF_WIZARD';
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
- you can use afickonfig.pl with --addpath and --addlib options to
  adapt the config file to your environment

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

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

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

	my $baratin = <<'EOF_TREEHELP';
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
EOF_TREEHELP

	display_message( $main, 'tree help', $baratin );
	return;
}
#####################################################################
# 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, -msg => '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, -msg => '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, -msg => '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, -msg => '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, -msg => 'display help on tree view' );

	#quit button
	my $bquit =
	  $frame_text->Button( -text => 'quit', -command => [ $mw => 'destroy' ] )
	  ->pack( -side => 'left' );
	$W_balloon->attach( $bquit, -msg => '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 ( is_microsoft() ) {
		if ( $fulldir =~ s/^([a-z]:)//i ) {
			$parent = $1;
		}
	}
	else {
		$parent = $SLASH;
	}

	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 $SLASH, @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 );
	}
	return;
}

########################################################################
# 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 );
	return;
}

#####################################################################
# parse display and build tree
## no critic (ProhibitManyArgs)
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
			## no critic (ProhibitCascadingIfElse)
			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/^# 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;
			}
			## use critic
		}
		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 );
	return;
}
## use critic
########################################################################
# 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($EMPTY);
	$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($EMPTY);

			$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++;
			}
		}
	}
	return;
}
########################################################################
# 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' );
	return;
}
#####################################################################
# build tree + detailled widget
sub create_tree_widget($$) {
	my $mw       = shift @_;
	my $h_change = shift @_;

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

	my $w_details = $mw->Scrolled(
		'HList',
		-header  => 1,
		-columns => 4,
		-width   => 100
	);
	$W_balloon->attach( $w_details, -msg => '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 );
	return;
}
#####################################################################
##  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',   $STAR, ],
];
#####################################################################
# 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";
		my $fh_log;
		if ( !open $fh_log, '>', $filename ) {
			warning("can not write on $filename : $ERRNO");
		}
		else {
			print {$fh_log} @logs;
			close $fh_log or warning("can not close $filename : $ERRNO");
		}
	}
	return;
}
#####################################################################
sub load_file($) {
	my $filename = shift @_;
	clear_text($W_change_text);
	clear_text($W_warning_text);

	## no critic (RequireBriefOpen)
	my $fh_log;
	if ( !open $fh_log, '<', $filename ) {
		warning("can not read $filename : $ERRNO");
	}
	else {
		display($fh_log);
	}
	return;
}
#####################################################################
# 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);
	}
	return;
}
#####################################################################
## 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" );
	}
	return;
}
#####################################################################
# 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" );
	}
	return;
}
#####################################################################
# 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;
		}
		my $fh_hist;
		## no critic (RequireBriefOpen)
		if ( open $fh_hist, '<', $config->{'history'} ) {

			my $changes = 0;
			my @newhistory;

			while ( my $ligne = <$fh_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 $fh_hist
			  or warning(
				"can not close history file $config->{'history'} : $ERRNO");

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

	my $baratin = <<'EOF_HISTORY';
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
EOF_HISTORY

	display_message( $main, 'history help', $baratin );
	return;
}
#####################################################################
# 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, \%Directives ); $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 ( !%Directives ) {
		$label->configure( -text => 'can not read configuration' );
	}
	elsif ( !-f $Directives{'history'} ) {
		$label->configure( -text => 'no history file' );
	}
	else {
		my $archive_dir = $Directives{'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,
			-msg => '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'}
		);

		my $fh_hist;
		## no critic (RequireBriefOpen)
		if ( open $fh_hist, '<', $Directives{'history'} ) {
			while ( my $ligne = <$fh_hist> ) {
				chomp $ligne;
				my $e = $w_history->addchild($EMPTY);

				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 $fh_hist
			  or
			  warning("can not close history $Directives{'history'} : $ERRNO");
		}
		else {
			warning("can not open history $Directives{'history'} : $ERRNO");
		}
	}
	return;
}
#####################################################################
## config section
#####################################################################
# a global var for select_config and save_config
my $conf_types = [ [ 'config files', '.conf', ], [ 'All Files', $STAR, ], ];
#####################################################################
# 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 $EMPTY ) {
		$entree->delete( 0, 'end' );
		$entree->insert( 0, $filename );
		$entree->xview('end');

		init_options($filename);
	}
	return;
}
#####################################################################
# 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' );
	warning( get_error() ) if ( !write_config( $filename, \@conf ) );

	$top->destroy();
	init_options($Configfile);
	return;
}
#####################################################################
# 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');
	}
	return;
}
###############################################################################
sub init_options($) {
	my $configfile = shift @_;

	get_configuration( $configfile, \%Macros, \%Alias, \%Directives, \%Rules,
		\%Onlydir );

	$Report_full_newdel_conf = is_binary( $Directives{'report_full_newdel'} );
	$Report_full_newdel      = $Report_full_newdel_conf
	  if ( !defined $Report_full_newdel );

	$Warn_missing_file_conf = is_binary( $Directives{'warn_missing_file'} );
	$Warn_missing_file      = $Warn_missing_file_conf
	  if ( !defined $Warn_missing_file );

	$Running_conf = is_binary( $Directives{'running_files'} );
	$Running = $Running_conf if ( !defined $Running );

	$Warn_dead_symlinks_conf = is_binary( $Directives{'warn_dead_symlinks'} );
	$Warn_dead_symlinks      = $Warn_dead_symlinks_conf
	  if ( !defined $Warn_dead_symlinks );

	$Follow_symlinks_conf = is_binary( $Directives{'follow_symlinks'} );
	$Follow_symlinks      = $Follow_symlinks_conf
	  if ( !defined $Follow_symlinks );

	$Allow_overload_conf = is_binary( $Directives{'allow_overload'} );
	$Allow_overload      = $Allow_overload_conf
	  if ( !defined $Allow_overload );

	$Timing_conf = is_binary( $Directives{'timing'} );
	$Timing = $Timing_conf if ( !defined $Timing );

	$Ignore_case_conf = is_binary( $Directives{'ignore_case'} );
	$Ignore_case      = $Ignore_case_conf
	  if ( !defined $Ignore_case );

	$Report_syslog_conf = is_binary( $Directives{'report_syslog'} );
	$Report_syslog      = $Report_syslog_conf
	  if ( !defined $Report_syslog );

	$Debug_level_conf = $Directives{'debug'};
	$Debug_level = $Debug_level_conf if ( !defined $Debug_level );

	$Exclude_re_conf        = $Directives{'exclude_re'};
	$Exclude_re             = $Exclude_re_conf;
	$Exclude_prefix_conf    = $Directives{'exclude_prefix'};
	$Exclude_prefix         = $Exclude_prefix_conf;
	$Exclude_suffix_conf    = $Directives{'exclude_suffix'};
	$Exclude_suffix         = $Exclude_suffix_conf;
	$Only_suffix_conf       = $Directives{'only_suffix'};
	$Only_suffix            = $Only_suffix_conf;
	$Max_checksum_size_conf = $Directives{'max_checksum_size'};
	$Max_checksum_size      = $Max_checksum_size_conf;
	return;
}
#####################################################################
# display an entry to get a filter
sub ana_search($) {
	my $main = shift @_;    # parent widget

	my $top = $main->Toplevel( -title => 'enter your database filter' );
	my $frame1 = $top->Frame()->pack();
	$W_filter_entry = $frame1->Entry()->pack();

	my $frame2 = $top->Frame()->pack();
	$frame2->Button( -text => 'filter', -command => [ \&ana_search_action ] )
	  ->pack( -side => 'left' );
	$frame2->Button( -text => 'abort', -command => [ $top => 'destroy' ] )
	  ->pack( -side => 'left' );
	$frame2->Button(
		-text    => 'help',
		-command => [ \&ana_search_help, $top ]
	)->pack( -side => 'left' );
	return;
}
#####################################################################
# called by 'filter' button
# call afick program
sub ana_search_action() {

	my $filter = $W_filter_entry->get();

	# be careful : on windows the following line bugs when the filter contains >
	#do_action("--search '$filter'");
	# so we have to use double-quotes insted simple-quotes
	do_action("--search \"$filter\"");
	return;
}
#####################################################################
# called by help button
sub ana_search_help($) {
	my $main = shift;

	my $baratin = <<'EOF_SEARCH';

	  "filters are to written with all print column keywords and perl operators

keywords are :  filetype, name, md5, sha1, checksum, device, inode, filemode, links, uid, acl, gid, filesize, blocs, atime, mtime, ctime

for examples :

filetype =~ m/symbolic/  : filter on file type

filesize > 5000000 : filter on file size

filemode & 04000 : extract suid files

(filesize > 5000) and (name =~ m/urpmi/) : you can combine filters
EOF_SEARCH

	display_message( $main, 'search help', $baratin );
	return;
}
#####################################################################
# display an entry to get a filter
sub archive_search($) {
	my $main = shift @_;    # parent widget

	my $top = $main->Toplevel( -title => 'enter your archive filter' );
	my $frame1 = $top->Frame()->pack();
	$W_filter_entry = $frame1->Entry()->pack();

	my $frame2 = $top->Frame()->pack();
	$frame2->Button(
		-text    => 'filter',
		-command => [ \&archive_search_action ]
	)->pack( -side => 'left' );
	$frame2->Button( -text => 'abort', -command => [ $top => 'destroy' ] )
	  ->pack( -side => 'left' );
	$frame2->Button(
		-text    => 'help',
		-command => [ \&archive_search_help, $top ]
	)->pack( -side => 'left' );
	return;
}
#####################################################################
# called by 'filter' button
# call afick program
sub archive_search_action() {

	my $filter = $W_filter_entry->get();

	# be careful : on windows the following line bugs when the filter contains >
	#do_action("--search '$filter'");
	# so we have to use double-quotes insted simple-quotes
	wrapper( 'afick_archive.pl', "-c $Configfile --search \"$filter\"" );
	return;
}
#####################################################################
# called by help button
sub archive_search_help($) {
	my $main = shift;

	my $baratin = <<'EOF_ARCHIVE_SEARCH';

search in all reports located in archive directory :

for exemple : 
afick.pl
search for changes on afick.pl file

deleted file :.*\.pl
search for deleted perl files

buttons :
---------
filter : apply the filter on old reports
abort : quit the clean window
help : show this help

EOF_ARCHIVE_SEARCH

	display_message( $main, 'archive search help', $baratin );
	return;
}
#####################################################################
# display an entry to get a filter
sub archive_clean($) {
	my $main = shift @_;    # parent widget

	my $top = $main->Toplevel( -title => 'enter your age filter' );
	my $frame1 = $top->Frame()->pack();
	$W_filter_entry = $frame1->Entry()->pack();

	my $frame2 = $top->Frame()->pack();
	$frame2->Button( -text => 'clean', -command => [ \&archive_clean_action ] )
	  ->pack( -side => 'left' );
	$frame2->Button( -text => 'abort', -command => [ $top => 'destroy' ] )
	  ->pack( -side => 'left' );
	$frame2->Button(
		-text    => 'help',
		-command => [ \&archive_clean_help, $top ]
	)->pack( -side => 'left' );
	return;
}
#####################################################################
# called by 'filter' button
# call afick program
sub archive_clean_action() {

	my $age = $W_filter_entry->get();

	# we clean history file too !
	wrapper( 'afick_archive.pl', "-c $Configfile --keep $age -H" );
	return;
}
#####################################################################
# called by help button
sub archive_clean_help($) {
	my $main = shift;

	my $baratin = <<'EOF_ARCHIVE_CLEAN';

"remove all reports older than the specified period from archive directory :

age in the form xP, x un number, P can be d for days, w for weeks, m for months 

exemple : 2w ask for 2 weeks

buttons :
---------
clean : apply cleaning
abort : quit the clean window
help : show this help
EOF_ARCHIVE_CLEAN

	display_message( $main, 'archive clean help', $baratin );
	return;
}
#####################################################################
sub config_directives($) {
	my $main = shift @_;    # parent widget

	my $top = $main->Toplevel( -title => 'configure directives' );
	my $frame1 = $top->Frame()->pack();

	$frame1->Checkbutton(
		-text      => 'Timing',
		-underline => 0,
		-variable  => \$Timing_conf,
	)->pack();
	$frame1->Checkbutton(
		-text      => 'Running',
		-underline => 0,
		-variable  => \$Running_conf,
	)->pack();
	$frame1->Checkbutton(
		-text      => 'dead symlinks',
		-underline => 0,
		-variable  => \$Warn_dead_symlinks_conf,
	)->pack();
	$frame1->Checkbutton(
		-text      => 'follow symlinks',
		-underline => 8,
		-variable  => \$Follow_symlinks_conf,
	)->pack();
	$frame1->Checkbutton(
		-text      => 'allow overload',
		-underline => 6,
		-variable  => \$Allow_overload,
	)->pack();
	$frame1->Checkbutton(
		-text      => 'report full newdel',
		-underline => 7,
		-variable  => \$Report_full_newdel_conf,
	)->pack();
	$frame1->Checkbutton(
		-text      => 'warn on missing files',
		-underline => 8,
		-variable  => \$Warn_missing_file_conf,
	);
	$frame1->Checkbutton(
		-text      => 'Ignore case',
		-underline => 0,
		-variable  => \$Ignore_case_conf,
	)->pack();

	$frame1->Label( -text => 'exclude_re' )->pack();
	$frame1->Entry( -textvariable => \$Exclude_re_conf )->pack();

	$frame1->Label( -text => 'exclude_prefix' )->pack();
	$frame1->Entry( -textvariable => \$Exclude_prefix_conf )->pack();

	$frame1->Label( -text => 'exclude_suffix' )->pack();
	$frame1->Entry( -textvariable => \$Exclude_suffix_conf )->pack();

	$frame1->Label( -text => 'only_suffix' )->pack();
	$frame1->Entry( -textvariable => \$Only_suffix_conf )->pack();

	$frame1->Label( -text => 'max_checksum_size' )->pack();
	$frame1->Entry( -textvariable => \$Max_checksum_size_conf )->pack();

	$frame1->Label( -text => 'debug' )->pack( -side => 'left' );

	#print "debug = $Debug_level\n";
	foreach my $elem ( ( 0, 1, 2, 3 ) ) {
		$frame1->Radiobutton(
			-text     => $elem,
			-value    => $elem,
			-variable => \$Debug_level_conf
		)->pack( -side => 'left' );
	}

	my $frame2 = $top->Frame()->pack();
	$frame2->Button( -text => 'save', -command => [ \&save_directives ] )
	  ->pack( -side => 'left' );
	$frame2->Button( -text => 'abort', -command => [ $top => 'destroy' ] )
	  ->pack( -side => 'left' );
	$frame2->Button(
		-text    => 'help',
		-command => [ \&directives_help, $top ]
	)->pack( -side => 'left' );
	return;
}
#####################################################################
sub save_directives($) {

	my $options;
	if ( $Timing_conf != is_binary( $Directives{'timing'} ) ) {
		$options .= " 'timing := $Timing_conf'";
	}
	if ( $Running_conf != is_binary( $Directives{'running_files'} ) ) {
		$options .= " 'running_files := $Running_conf'";
	}
	if ( $Report_full_newdel_conf !=
		is_binary( $Directives{'report_full_newdel'} ) )
	{
		$options .= " 'report_full_newdel := $Report_full_newdel_conf'";
	}
	if ( $Warn_missing_file_conf !=
		is_binary( $Directives{'warn_missing_file'} ) )
	{
		$options .= " 'warn_missing_file := $Warn_missing_file_conf'";
	}
	if ( $Warn_dead_symlinks_conf !=
		is_binary( $Directives{'warn_dead_symlinks'} ) )
	{
		$options .= " 'warn_dead_symlinks := $Warn_dead_symlinks_conf'";
	}
	if ( $Follow_symlinks_conf != is_binary( $Directives{'follow_symlinks'} ) )
	{
		$options .= " 'follow_symlinks := $Follow_symlinks_conf'";
	}
	if ( $Allow_overload_conf != is_binary( $Directives{'allow_overload'} ) ) {
		$options .= " 'allow_overload := $Allow_overload_conf'";
	}
	if ( $Ignore_case_conf != is_binary( $Directives{'ignore_case'} ) ) {
		$options .= " 'ignore_case := $Ignore_case_conf'";
	}

	if ( $Exclude_re_conf ne $Directives{'exclude_re'} ) {
		$options .= " 'exclude_re := $Exclude_re_conf'";
	}
	if ( $Exclude_prefix_conf ne $Directives{'exclude_prefix'} ) {
		$options .= " 'exclude_prefix := $Exclude_prefix_conf'";
	}
	if ( $Exclude_suffix_conf ne $Directives{'exclude_suffix'} ) {
		$options .= " 'exclude_suffix := $Exclude_suffix_conf'";
	}
	if ( $Only_suffix_conf ne $Directives{'only_suffix'} ) {
		$options .= " 'only_suffix := $Only_suffix_conf'";
	}
	if ( $Max_checksum_size_conf != $Directives{'max_checksum_size'} ) {
		$options .= " 'max_checksum_size := $Max_checksum_size_conf'";
	}

	if ( $Debug_level_conf != $Directives{'debug'} ) {
		$options .= " 'debug := $Debug_level_conf'";
	}

	# test changes and call afickonfig.pl
	wrapper( 'afickonfig.pl', "-c $Configfile $options" ) if ($options);

	# reset parameters
	init_options($Configfile);
	return;
}
#####################################################################
sub directives_help($) {
	my $main = shift;

	my $baratin = <<'EOF_DIR';
change directives in configuration file
directives are :

database : name with full path : the database to use to store informations

history : history file keep all dates and summary results

archive : directory with full path : the archive dir keep all logs, and can be used by webmin module

debug : set  a  level  of  debugging messages, from 0 (none) to 3 (full)

timing : print timing statistics (user and system time)

warn_dead_symlinks : warn about dead symlinks

follow_symlinks : do checksum on target file

allow_overload : allow more than one rule on a file (the last wins)

report_full_newdel : if true report all new files, else only  first  directory  level
(avoid too long outputs)

running_files : warn about 'running' files : modified since program begin

warn_missing_file : print a warning message  if  file  selection  does  not exist

ignore_case : ignore case for file names (usefull on windows)

exclude_prefix : list of file names prefix to ignore

exclude_suffix : list of file names suffixes to ignore

exclude_re : list of regular expressions to ignore files

only_suffix : list of file names suffixes to scan (and only this)

max_checksum_size : maximum file size for checksum (0 for unlimited)
EOF_DIR

	display_message( $main, 'directives help', $baratin );
	return;
}
#####################################################################
##                       main
#####################################################################

# command line arg
my $opt_version;
my $opt_help;
my $opt_man;

# options
# we define a set of afick options
Getopt::Long::Configure('no_ignore_case');
if (
	!GetOptions(
		'config_file|c=s'    => \$Configfile,
		'full_newdel|f!'     => \$Report_full_newdel,
		'help|h'             => \$opt_help,
		'man'                => \$opt_man,
		'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,
		'follow_symlinks|Y!' => \$Follow_symlinks,
		'allow_overload|o!'  => \$Allow_overload,
		'timing|t!'          => \$Timing,
		'verbose|v'          => \$Verbose,
		'version|V'          => \$opt_version
	)
  )
{
	pod2usage('incorrect option !');
}

if ($opt_help) {
	pod2usage(1);
}
elsif ($opt_man) {
	pod2usage( -verbose => 2 );
}

if ($opt_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" );

# status bar : todo ?
# must be defined before balloon is created !
#$W_status = $main->Label(-width => 60, -relief => "sunken", -bd => 1, -anchor => 'w');
#$W_status->pack(-side => "bottom", -fill => "y", -padx => 2, -pady => 1);
#$W_balloon = $main->Balloon( -statusbar => $W_status );

$W_balloon = $main->Balloon();

my $b_state = 'both';    # can be balloon / both / status
my $tearoff = 1;         # to be able to detach menu

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   => $tearoff
)->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 => $b_state,
	-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   => $tearoff
)->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 $aamenu = $actionmenu->cget( -menu );
$W_balloon->attach(
	$aamenu,
	-state => $b_state,
	-msg   => [
		'detach menu',
		'create database',
		'update database',
		'compare with database',
		'print database',
		'print configuration',
		'check configuration syntax',
		'clean configuration file',
	]
);

# analysis menu
#-------------------
my $anamenu = $frame1->Menubutton(
	-text      => 'analysis',
	-underline => 1,
	-tearoff   => $tearoff
)->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 $statextmenu = $anamenu->command(
	-label     => 'stat_ext',
	-underline => 6,
	-command   => sub { do_action('--stat_ext') }
);
$main->bind( '<Control-Key-e>' => sub { do_action('--stat_ext') } );

my $statsecmenu = $anamenu->command(
	-label     => 'stat_secu',
	-underline => 8,
	-command   => sub { do_action('--stat_secu') }
);
$main->bind( '<Control-Key-u>' => sub { do_action('--stat_secu') } );

my $statsizemenu = $anamenu->command(
	-label     => 'stat_size',
	-underline => 7,
	-command   => sub { do_action('--stat_size') }
);
$main->bind( '<Control-Key-z>' => sub { do_action('--stat_size') } );

my $printfiltermenu = $anamenu->command(
	-label     => 'search',
	-underline => 0,
	-command   => sub { ana_search($main) }
);
$main->bind( '<Control-Key-s>' => sub { ana_search($main) } );

my $ymenu = $anamenu->cget( -menu );
$W_balloon->attach(
	$ymenu,
	-state => $b_state,
	-msg   => [
		'detach menu',
		'display changes in a tree view',
		'display file extension, by use',
		'display dangerous files (suid, sgid, group and word writable',
		'display file size statistics',
		'apply filter on database dump'
	]
);

# configuration file
#-------------------
my $configmenu = $frame1->Menubutton(
	-text      => 'configuration',
	-underline => 0,
	-tearoff   => $tearoff
)->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 $addmenu = $configmenu->command(
	-label     => 'secure',
	-underline => 0,
	-command =>
	  sub { wrapper( 'afickonfig.pl', "-c $Configfile --addpath --addlib" ) }
);
$main->bind( '<Control-Key-a>' =>
	  sub { wrapper( 'afickonfig.pl', "-c $Configfile --addpath --addlib" ) } );

my $directivemenu = $configmenu->command(
	-label     => 'directives',
	-underline => 0,
	-command   => sub { config_directives($main) }
);

#$main->bind( '<Control-Key-a>' =>
#	  sub { wrapper('afickonfig.pl', "-c $Configfile --addpath --addlib") } );

my $cmenu = $configmenu->cget( -menu );
$W_balloon->attach(
	$cmenu,
	-state => $b_state,
	-msg   => [
		'detach menu',
		'select a configuration file',
		'edit the configuration file',
		'secure config : apply afickonfig --addpath --addlib',
		'change directives in configuration file',
	]
);
$entry =
  $frame1->Entry( -textvariable => \$Configfile, -width => 30 )
  ->pack( -side => 'left' );
$W_balloon->attach( $entry, -msg => 'configuration file name' );

# options menu
#-------------------
my $optionmenu = $frame1->Menubutton(
	-text      => 'options',
	-underline => 0,
	-tearoff   => $tearoff
)->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     => 'follow symlinks',
	-underline => 8,
	-variable  => \$Follow_symlinks,
);
$main->bind( '<Alt-Key-Y>' => sub { $Follow_symlinks = !$Follow_symlinks; } );
$optionmenu->checkbutton(
	-label     => 'allow overload',
	-underline => 6,
	-variable  => \$Allow_overload,
);
$main->bind( '<Alt-Key-o>' => sub { $Allow_overload = !$Allow_overload; } );
$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->checkbutton(
	-label     => 'syslog report',
	-underline => 1,
	-variable  => \$Report_syslog,
);
$main->bind( '<Alt-Key-Y>' => sub { $Report_syslog = !$Report_syslog; } );
$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 .. max_debug() ) ) {
	$optionmenu->radiobutton(
		-label    => $elem,
		-variable => \$Debug_level
	);
}
my $omenu = $optionmenu->cget( -menu );
$W_balloon->attach(
	$omenu,
	-state => $b_state,
	-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 ' . max_debug() . ' (full)',
	]
);

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

my $checkarchive_menu = $archivemenu->command(
	-label     => 'check',
	-underline => 4,
	-command => sub { wrapper( 'afick_archive.pl', "-c $Configfile --check" ) }
);
$main->bind( '<Control-Key-k>' =>
	  sub { wrapper( 'afick_archive.pl', "-c $Configfile --check" ) } );
my $searcharchive_menu = $archivemenu->command(
	-label     => 'search',
	-underline => 0,
	-command   => sub { archive_search($main) }
);
$main->bind( '<Control-Key-S>' => sub { archive_search($main); } );
my $cleanarchive_menu = $archivemenu->command(
	-label     => 'clean',
	-underline => 0,
	-command   => sub { archive_clean($main) }
);
$main->bind( '<Control-Key-C>' => sub { archive_clean($main); } );

my $amenu = $archivemenu->cget( -menu );
$W_balloon->attach(
	$amenu,
	-state => $b_state,
	-msg   => [
		'detach menu',
		'check archive consistency',
		'search in old reports',
		'remove old reports',
	]
);

# help menu
#-------------------
my $helpmenu = $frame1->Menubutton(
	-text      => 'help',
	-underline => 0,
	-tearoff   => $tearoff
)->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 $checkupdatemenu = $helpmenu->command(
	-label     => 'check_update',
	-underline => 0,
	-command   => sub { check_update( 'afick-gui', $Version ) }
);
$main->bind( '<Alt-Key-U>' => sub { do_action('-U'); } );
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 => $b_state,
	-msg   => [
		'detach menu',
		'display help text',
		'check for new releases',
		'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, -msg => '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, -msg => 'warning window' );

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

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

my $frame4_1 =
  $frame4->Frame()->pack( -side => $side, -expand => 0, -fill => 'x' );
my $btoggleprogress = $frame4_1->Checkbutton(
	-text     => 'display progress',
	-variable => \$ToggleProgress
)->pack( -side => $side );
$W_balloon->attach( $btoggleprogress, -msg => 'toggle progress bar' );

my $frame4_2 =
  $frame4->Frame()->pack( -side => $side, -expand => 0, -fill => 'x' );
$W_total_text = $frame4_2->ROText(
	-height => 1,
	-width  => 10,
	-wrap   => 'word'
)->pack( -side => 'right' );
$W_balloon->attach( $W_total_text, -msg => 'display number of scanned files' );

$W_progress_text = $frame4_2->ROText(
	-height => 1,
	-width  => 128,
	-wrap   => 'word'
)->pack( -side => $side );
$W_balloon->attach( $W_progress_text, -msg => 'display current scanned file' );

my $frame4_3 =
  $frame4->Frame()->pack( -side => $side, -expand => 0, -fill => 'x' );
$W_percent_text = $frame4_3->ROText(
	-height => 1,
	-width  => 4,
	-wrap   => 'word'
)->pack( -side => 'right' );
$W_balloon->attach( $W_percent_text, -msg => 'display percent progress' );

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

my $frame4_4 =
  $frame4->Frame()->pack( -side => $side, -expand => 0, -fill => 'x' );
$frame4_4->Label( -text => 'elapsed time' )->pack( -side => 'left' );
$W_elapsed = $frame4_4->ROText(
	-height => 1,
	-width  => 10,
);
$W_elapsed->pack( -side => 'left' );
$W_balloon->attach( $W_elapsed, -msg => 'elapsed time' );

$frame4_4->Label( -text => 'remaining time' )->pack( -side => 'left' );
$W_remain = $frame4_4->ROText(
	-height => 1,
	-width  => 10,
);
$W_remain->pack( -side => 'left' );
$W_balloon->attach( $W_remain, -msg => 'estimated remaining time' );

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 USAGE

=head1 SYNOPSIS

afick-tk [L<options|options>]

afick use posix syntax, which allow many possibilities :

=over 4

=item *
long (--) options

=item *
short (-) options

=item *
negative (--no) options

=back

=head1 REQUIRED ARGUMENTS

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

=item --help|-h

Output help information and exit.

=item --man

Output full help information and exit.

=item --ignore_case|-a

ignore case for file names. Can be helpful on Windows platforms, 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.

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

(do not) warn about dead symlinks.

=item --follow_symlinks|-Y,(--nofollow_symlinks)

if set, do checksum on target link file, else on target link filename.

=item --allow_overload|-o,(--noallow_overload)

if set, allow more than one rule on a file (the last wins), else keep the first one, display a warning for others.

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

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

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

(do not) Print timing statistics.

=item --version|-V

Output version information and exit.

=item --verbose|-v

set verbose mode (for debugging purposes).

=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 output in output 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

=item stat_size

display from databases some dangerous files (suid, sgid, group writable, world writable )

=item stat_ext

display a list of file extension, sorted by numbers (for windows)

=item stat_secu

display from databases statistics on file size

=item search

print the content of the database, filtered by a regular expression

=back

=head3 Configuration

=over 4

=item select

select afick's configuration file (filebrowser)

=item edit

edit afick's configuration file

=item secure config

run afickonfig with this options to secure config file

=item directives

change afick's directives

=back

=head3 Option

they are set from afick's configuration file

=over 4

=item *
timing

=item *
running

=item *
dead symlinks

=item *
follow symlinks

=item *
allow_overload

=item *
report full newdel

=item *
warn on missing files

=item *
ignore case

=item *
debug

=back

=head3 Archive

this in an interface to afick_archive tool

=over 4

=item check

check archive's consistency

=item search

search for a regular expression in old reports

=item clean

remove all reports older than the specified period from archive directory

=back

=head3 Help

=over 4

=item help

the screen description

=item check_update

check for new releases on internet

=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 syntax
<a href="afick.1.html">afick(1)</a> for command-line interface
<a href="afickonfig.1.html">afickonfig(1)</a> for a tool to change afick's configuration file
<a href="afick_archive.1.html">afick_archive(1)</a> for a tool to manage archive's reports

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

=head1 DIAGNOSTICS

=head1 EXIT STATUS

=head1 CONFIGURATION

=head1 DEPENDENCIES

=head1 INCOMPATIBILITIES

=head1 BUGS AND LIMITATIONS


=head1 LICENSE AND COPYRIGHT

Copyright (c) 2002 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 AUTHOR

Eric Gerbier

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