#! /usr/bin/perl
###############################################################################
##    Copyright (C) 2002 by Eric Gerbier
##    Bug reports to: eric.gerbier@tutanota.com
##    $Id$
##
##    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 utf8;
use strict;
use warnings;

use Pod::Usage;
use English '-no_match_vars';
use Getopt::Long;    # arg analysis

use Locale::gettext;
use Encode;
use Cwd;

#use diagnostics;
#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 Tk::Widget;         # methodes busy / Unbusy

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

setlocale(LC_CTYPE,"");
setlocale(LC_MESSAGES,"");
bindtextdomain("afick-tk","/usr/share/locale");
textdomain("afick-tk");
sub _($){
    my $param = shift(@_);
    return decode('utf8', gettext($param));
}
my $cur_lev = `macid -l`;
my $cur_cat = `macid -c`;

chomp $cur_lev;
chomp $cur_cat;

if (($cur_lev != 0) || ($cur_cat != 0)){
    print _("unable to run with maclabel\n");
    exit;
}

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

# constants
my $EMPTY = Afick::Constant->EMPTY;
my $STAR  = Afick::Constant->STAR;
my $SLASH = Afick::Constant->SLASH;

# global var
my $Version          = get_afick_version();
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

# current configuration directives
my $Configfile = $EMPTY;
my $Mask_sysupdate;
my $Report_full_newdel;
my $Report_summary;
my $Report_context;
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;
my $Archive;
my $History;

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

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

# configuration directives from config file
my %Directives;

# styles
my %styles = ();

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

#####################################################################
# display warnings in warning section or 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;
}
#####################################################################
# display info in warning section or 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;
}
#####################################################################
# display debug in warning section or console
sub debug ($;$) {
	my $text = shift @_;

	return if ( !$Verbose );

	chomp $text;

	# because some messages may appear before all windows 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 );
}
#####################################################################
# return command line option if exists else config file value
sub get_history() {
	return $History || $Directives{'history'};
}
#####################################################################
# return command line option if exists else config file value
sub get_archive() {
	return $Archive || $Directives{'archive'};
}
#####################################################################
# display results in windows
sub display($) {
	my $file_df = shift @_;    # file descriptor

	# set a waiting cursor
	$W_change_text->Busy();

	# 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;
			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 {
						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->Unbusy();
	clear_text($W_progress_text);
	return;
}
#####################################################################
# low-level sub to start a command
sub wrapper($$) {
	my $cmd     = shift @_;
	my $options = shift @_;

	# force use same path for all afick commands
	$cmd = $afick_path . $SLASH . $cmd;

	# on windows, the afick path is often "program files"
	# and the space make it not work with options : so quote the program
	if ( is_microsoft() ) {
		my $DQUOTE = Afick::Constant->DQUOTE;
		$cmd = 'perl ' . $DQUOTE . $cmd . $DQUOTE;
	}

	print "$cmd $options\n" if ($Verbose);

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

	if ( !open $fh_action, "$cmd $options 2>&1 |" ) {
		warning((_"can not execute "). $cmd." : $ERRNO");
		return;
	}
	else {
		display($fh_action);
	}
	return;
}
#####################################################################
# add an argument if necessary for directives (binaries)
# in afick option syntaxe
sub add_binarg($$$) {
	my $option = shift @_;    # directive value
	my $rh_dir = shift @_;    # hash config from file
	my $key    = shift @_;    # directive name

	if ( $option != is_binary( $rh_dir->{$key} ) ) {
		return ($option) ? ' --' . $key : ' --no' . $key;
	}
	else {
		return $EMPTY;
	}
}
#####################################################################
sub build_cmdline() {
	my $arg;

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

	# force values (overload values in config file)
	# only if they are different from config file
	$arg .= add_binarg( $Warn_missing_file, \%Directives, 'warn_missing_file' );
	$arg .=
	  add_binarg( $Report_full_newdel, \%Directives, 'report_full_newdel' );
	$arg .= add_binarg( $Mask_sysupdate, \%Directives, 'mask_sysupdate' );
	$arg .= add_binarg( $Report_summary, \%Directives, 'report_summary' );
	$arg .= add_binarg( $Report_context, \%Directives, 'report_context' );
	$arg .=
	  add_binarg( $Warn_dead_symlinks, \%Directives, 'warn_dead_symlinks' );
	$arg .= add_binarg( $Follow_symlinks, \%Directives, 'follow_symlinks' );
	$arg .= add_binarg( $Allow_overload,  \%Directives, 'allow_overload' );
	$arg .= add_binarg( $Running,         \%Directives, 'running_files' );
	$arg .= add_binarg( $Timing,          \%Directives, 'timing' );
	$arg .= add_binarg( $Ignore_case,     \%Directives, 'ignore_case' );
	$arg .= add_binarg( $Report_syslog,   \%Directives, 'report_syslog' );

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

	return $arg;
}
#####################################################################
# used to spawn afick commands
sub do_action($) {
	my $arg = shift @_;

	$arg .= build_cmdline();

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

	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 $xpm = $main->Photo(-file => "/usr/share/pixmaps/afick.xpm", - format => 'xpm');
	$top->Icon(-image => $xpm);
	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 = 
	  _('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
- stat_date : display chronological list of changed files
- duplicates : display files with same contents
- 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
- learn : learn from logs to adapt config file

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%

');

	display_message( $main, _('help'), $baratin );
	return;
}
#####################################################################
# 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/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.

');

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

	my $baratin =
	  _('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)
ctrl+d : stat_date action
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
ctrl+U : duplicates 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+d : stat_date action
- ctrl+U : duplicates 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+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

');

	display_message( $main, _('bind keys'), $baratin );
	return;
}
#####################################################################
# 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
- 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 ...

');

	display_message( $main, _('wizard'), $baratin );
	return;
}
#####################################################################
## begin tree section
#####################################################################
# display help text
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 );
	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/^([[:alpha:]]:)//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 => $styles{$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
sub tree_parse($$$$$$) {
	my ( $w_maintree, $wnew, $wdel, $wmod, $wdang, $h_change ) = @_;

	my %nb = (
		new      => 0,
		deleted  => 0,
		changed  => 0,
		dangling => 0,
	);

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

	my @logs = split /\n/, $logs;
	my $log  = Afick::Log->new();
	$log->parse_array( \@logs );

	#$log->stats();

	foreach my $type ( sort $log->get_data_types_k() ) {
		## no critic (ProhibitStringySplit)
		# type may be changed_file, new_directory
		# we want to keep only first part
		my ( $style, undef ) = split q{_}, lc $type;

		#print "(tree_parse) type=$type style=$style\n";
		foreach my $name ( $log->get_data_names_k($type) ) {
			add_tree( $w_maintree, $name, $style );
			$h_change->{$name}{'type'} = $style;
			foreach my $field ( sort $log->get_data_fields_k( $type, $name ) ) {
				$h_change->{$name}{$field} =
				  $log->get_data_field( $type, $name, $field );
			}
			$nb{$style}++;
		}
	}

	#print "debug nbnew=$nb{'new'}\n";
	#print "debug nbdel=$nb{'deleted'}\n";
	#print "debug nbmod=$nb{'changed'}\n";
	#print "debug nbdan=$nb{'dangling'}\n";

	$w_maintree->autosetmode();

	# write in text box
	$wnew->insert( 'end', $nb{'new'} );
	$wdel->insert( 'end', $nb{'deleted'} );
	$wmod->insert( 'end', $nb{'changed'} );
	$wdang->insert( 'end', $nb{'dangling'} );
	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
	$styles{'normal'} = $w_maintree->ItemStyle(
		'text',
		-stylename  => 'normal',
		-foreground => $Colors{'normal'},
	);

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

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

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

	$styles{'dangling'} = $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 $xpm = $main->Photo(-file => "/usr/share/pixmaps/afick.xpm", - format => 'xpm');
	$mw->Icon(-image => $xpm);

	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";
		if ( open my $fh_log, '>', $filename ) {
			print {$fh_log} @logs;
			close $fh_log or warning(_("can not close").$filename." : $ERRNO");
		}
		else {
			warning(_("can not write on ").$filename." : $ERRNO");
		}
	}
	return;
}
#####################################################################
# load afick log file
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;
}
#####################################################################
# gui interface to load afick log
# load a log file into change part
sub do_load_log($) {
	my $main = shift;

	my $filename = $main->getOpenFile( -filetypes => $log_types );
	if ($filename) {
		load_file($filename);
	}
	return;
}
#####################################################################
# learn
#####################################################################
# launch afick learning on an afick log
sub do_learn($) {
	my $main = shift;

	my $filename = $main->getOpenFile( -filetypes => $log_types );
	if ($filename) {
		wrapper( 'afick_learn.pl', "-c $Configfile -s -l $filename" );
	}
	return;
}
#####################################################################
## history section
#####################################################################
# 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 $history = get_history();
	if ( !-f $history ) {
		$label->configure( -text => _('no history file') );
		return;
	}
	else {
		my $archive_dir = get_archive();

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

			my $changes = 0;
			my @newhistory;

			while ( my $ligne = <$fh_hist> ) {

				# 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 ").$history." : $ERRNO");

			# only rewrite history file if some changes occurs
			if ($changes) {
				if ( open my $fh_hist, '>', $history ) {
					foreach my $ligne (@newhistory) {
						print {$fh_hist} $ligne;
					}
					close $fh_hist
					  or
					  warning(_("can not close history file ").$history." : $ERRNO");
				}
				else {
					$label->configure( -text =>
						  _("can not write to history file ")." $Configfile->{'history'}"." : $!" );
				}
			}
		}
		else {
			warning(_("can not read history file ").$history." : $ERRNO");
			return;
		}
	}
	return;
}
#####################################################################
# display help on history
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

clean button : remove deleted log entries from history file
help button : show this help
quit button : quit history window
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' );
	my $xpm = $main->Photo(-file => "/usr/share/pixmaps/afick.xpm", - format => 'xpm');
	$top->Icon(-image => $xpm);

	# frame for all buttons
	my $frame_b = $top->Frame()->pack();
	$frame_b->Button(
		-text    => _('clean'),
		-command => sub { clean_history($label); $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);
	my $history = get_history();

	if ( !%Directives ) {
		$label->configure( -text => _('can not read configuration') );
	}
	elsif ( !-f $history ) {
		$label->configure( -text => _('no history file') );
	}
	else {
		my $archive_dir = get_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', -foreground => $Colors{'normal'} );

		my $style_ok =
		  $w_history->ItemStyle( 'text', -foreground => $Colors{'ok'} );

		my $style_change =
		  $w_history->ItemStyle( 'text', -foreground => $Colors{'changed'} );

		my $style_link =
		  $w_history->ItemStyle( 'text', -foreground => $Colors{'link'} );

		my $fh_hist;
		## no critic (RequireBriefOpen)
		if ( open $fh_hist, '<', $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 =~

					## no critic(ProhibitEscapedMetacharacters)
					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 ")."$history : $ERRNO");
		}
		else {
			warning(_("can not open history ")."$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 $filename = $main->getSaveFile(
		-initialfile => $Configfile,
		-filetypes   => $conf_types
	);
	if ($filename) {

		# ok : save config to filename
		my @conf = $text->get( '1.0', 'end' );

		# because Cfg only allow set config file to existing file
		touch($filename);
		my $config = Afick::Cfg->new($filename);
		warning( Afick::Msg->get_error() )
		  if ( !$config->_write_config( \@conf ) );

		# reload new config
		init_options($Configfile) if ( $Configfile eq $filename );
	}
	$top->destroy();
	return;
}
#####################################################################
# open selected config file
sub open_config($) {
	my $main = shift;

	my $top  = $main->Toplevel( -title => $Configfile );
	my $xpm = $main->Photo(-file => "/usr/share/pixmaps/afick.xpm", - format => 'xpm');
	$top->Icon(-image => $xpm);
	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 = Afick::Cfg->new($Configfile);
	my @config = $config->_read_config();
	if ( !@config ) {
		warning( Afick::Msg->get_error() );
		return;
	}
	else {
		foreach (@config) {
			$text->insert( 'end', $_ . "\n" );
		}
		$text->see('1.0');
	}
	return;
}
###############################################################################
# read parameters *_conf from config file
sub init_options($) {
	my $configfile = shift @_;

	my $config = Afick::Cfg->new();

	if ($configfile) {
		$config->set_configfile($configfile);
		$config->read_configuration();
	}
	%Directives = $config->directives();

	$Mask_sysupdate     = is_binary( $Directives{'mask_sysupdate'} );
	$Report_full_newdel = is_binary( $Directives{'report_full_newdel'} );
	$Report_summary     = is_binary( $Directives{'report_summary'} );
	$Report_context     = is_binary( $Directives{'report_context'} );
	$Warn_missing_file  = is_binary( $Directives{'warn_missing_file'} );
	$Running            = is_binary( $Directives{'running_files'} );
	$Warn_dead_symlinks = is_binary( $Directives{'warn_dead_symlinks'} );
	$Follow_symlinks    = is_binary( $Directives{'follow_symlinks'} );
	$Allow_overload     = is_binary( $Directives{'allow_overload'} );
	$Timing             = is_binary( $Directives{'timing'} );
	$Ignore_case        = is_binary( $Directives{'ignore_case'} );
	$Report_syslog      = is_binary( $Directives{'report_syslog'} );
	$Debug_level        = $Directives{'debug'};
	$Exclude_re         = $Directives{'exclude_re'};
	$Exclude_prefix     = $Directives{'exclude_prefix'};
	$Exclude_suffix     = $Directives{'exclude_suffix'};
	$Only_suffix        = $Directives{'only_suffix'};
	$Max_checksum_size  = $Directives{'max_checksum_size'};

	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 $xpm = $main->Photo(-file => "/usr/share/pixmaps/afick.xpm", - format => 'xpm');
	$top->Icon(-image => $xpm);
	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 =
	  _('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 :

name =~ m/afick/i        : filter on name with an ignore case      

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

');

	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 $xpm = $main->Photo(-file => "/usr/share/pixmaps/afick.xpm", - format => 'xpm');
	$top->Icon(-image => $xpm);
	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 =
	  _('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

');

	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 $xpm = $main->Photo(-file => "/usr/share/pixmaps/afick.xpm", - format => 'xpm');
	$top->Icon(-image => $xpm);
	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 =
	  _('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

');

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

	my $top    = $main->Toplevel( -title => _('configure directives') );
	my $xpm = $main->Photo(-file => "/usr/share/pixmaps/afick.xpm", - format => 'xpm');
	$top->Icon(-image => $xpm);
	my $frame1 = $top->Frame()->pack();

	# binaries
	# ########
	$frame1->Checkbutton(
		-text      => _('Timing'),
		-underline => 0,
		-variable  => \$Timing,
	)->pack( -anchor => 'w', );
	$frame1->Checkbutton(
		-text      => _('Running'),
		-underline => 0,
		-variable  => \$Running,
	)->pack( -anchor => 'w', );
	$frame1->Checkbutton(
		-text      => _('dead symlinks'),
		-underline => 0,
		-variable  => \$Warn_dead_symlinks,
	)->pack( -anchor => 'w', );
	$frame1->Checkbutton(
		-text      => _('follow symlinks'),
		-underline => 8,
		-variable  => \$Follow_symlinks,
	)->pack( -anchor => 'w', );
	$frame1->Checkbutton(
		-text      => _('allow overload'),
		-underline => 6,
		-variable  => \$Allow_overload,
	)->pack( -anchor => 'w', );
	$frame1->Checkbutton(
		-text      => _('mask system updates'),
		-underline => 7,
		-variable  => \$Mask_sysupdate,
	)->pack( -anchor => 'w', );
	$frame1->Checkbutton(
		-text      => _('report full newdel'),
		-underline => 7,
		-variable  => \$Report_full_newdel,
	)->pack( -anchor => 'w', );
	$frame1->Checkbutton(
		-text => _('report summary'),

		#		-underline => 7,
		-variable => \$Report_summary,
	)->pack( -anchor => 'w', );
	$frame1->Checkbutton(
		-text => _('report context'),

		#		-underline => 7,
		-variable => \$Report_context,
	)->pack( -anchor => 'w', );
	$frame1->Checkbutton(
		-text      => _('Missing files'),
		-underline => 1,
		-variable  => \$Warn_missing_file,
	)->pack( -anchor => 'w', );
	$frame1->Checkbutton(
		-text      => _('Ignore case'),
		-underline => 0,
		-variable  => \$Ignore_case,
	)->pack( -anchor => 'w', );
	$frame1->Checkbutton(
		-text      => _('syslog report'),
		-underline => 1,
		-variable  => \$Report_syslog,
	)->pack( -anchor => 'w', );

	# text
	my $frame2 = $top->Frame()->pack();
	$frame2->Label( -text => _('exclude_re') )->pack();
	$frame2->Entry( -textvariable => \$Exclude_re )->pack();

	$frame2->Label( -text => _('exclude_prefix') )->pack();
	$frame2->Entry( -textvariable => \$Exclude_prefix )->pack();

	$frame2->Label( -text => _('exclude_suffix') )->pack();
	$frame2->Entry( -textvariable => \$Exclude_suffix )->pack();

	$frame2->Label( -text => _('only_suffix') )->pack();
	$frame2->Entry( -textvariable => \$Only_suffix )->pack();

	$frame2->Label( -text => _('max_checksum_size') )->pack();
	$frame2->Entry( -textvariable => \$Max_checksum_size )->pack();

	$frame2->Label( -text => _('debug') )->pack( -side => 'left' );
	foreach my $elem ( ( 0, 1, 2, 3 ) ) {
		$frame2->Radiobutton(
			-text     => $elem,
			-value    => $elem,
			-variable => \$Debug_level
		)->pack( -side => 'left' );
	}

	# buttons
	my $frame3 = $top->Frame()->pack();
	$frame3->Button( -text => _('keep'), -command => [ $top => 'destroy' ] )
	  ->pack( -side => 'left' );
	$frame3->Button( -text => _('save'), -command => [ \&save_directives ] )
	  ->pack( -side => 'left' );
	$frame3->Button(
		-text    => _('abort'),
		-command => sub {
			init_options($Configfile);
			$top->destroy();
		}
	)->pack( -side => 'left' );
	$frame3->Button(
		-text    => _('help'),
		-command => [ \&directives_help, $top ]
	)->pack( -side => 'left' );
	return;
}
#####################################################################
# only add directive changes
# for afickonfig (file syntaxe)
sub add_directive($$$) {
	my $param  = shift @_;    # current value
	my $rh_dir = shift @_;    # hash from config file
	my $name   = shift @_;    # directive name

	return ( $param ne $rh_dir->{$name} ) ? " '$name := $param'" : q{};
}
#####################################################################
# save current config to file
sub save_directives() {

	my $options = build_cmdline();

	$options .= add_directive( $Exclude_re, \%Directives, 'exclude_re' );
	$options .=
	  add_directive( $Exclude_prefix, \%Directives, 'exclude_prefix' );
	$options .=
	  add_directive( $Exclude_suffix, \%Directives, 'exclude_suffix' );
	$options .= add_directive( $Only_suffix, \%Directives, 'only_suffix' );
	$options .=
	  add_directive( $Max_checksum_size, \%Directives, 'max_checksum_size' );

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

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

	my $baratin = 
	  _('change directives in configuration file
directives are :

timing : print timing statistics (user and system time)

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

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)

report summary : display summary (or not if false)

report context : display all attributes changes, not only attributes from rule

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

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

syslog report : also send the report to syslog

exclude_re : list of regular expressions to ignore files

exclude_prefix : list of file names prefix to ignore

exclude_suffix : list of file names suffixes to ignore

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

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

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

buttons :
keep : keep directives changes for current session
save : keep changes and save to config file
abort : abort changes, reload config from file
help : this file

');

	display_message( $main, _('directives help'), $baratin );
	return;
}
#####################################################################
my $b_state = 'both';    # can be balloon / both / status
my $tearoff = 1;         # to be able to detach menu
my $side    = 'top';
#####################################################################
# frame 1 : top menus
#####################################################################
# file menu
sub menu_file($$) {
	my $main   = shift @_;
	my $frame1 = shift @_;

	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.') );

	$filemenu->command(
		-label     => _('history'),
		-underline => 6,
		-command   => [ \&do_history, $main ]
	);
	$main->bind( '<Alt-Key-y>' => sub { do_history($main); } );

	$filemenu->command(
		-label     => _('load'),
		-underline => 0,
		-command   => [ \&do_load_log, $main ]
	);
	$main->bind( '<Alt-Key-l>' => sub { do_load_log($main); } );

	$filemenu->command(
		-label     => _('save'),
		-underline => 0,
		-command   => [ \&do_save_log, $main ]
	);
	$main->bind( '<Alt-Key-s>' => sub { do_save_log($main); } );

	$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'),
		]
	);
	return;
}
#####################################################################
# action menu
sub menu_action($$) {
	my $main   = shift @_;
	my $frame1 = shift @_;

	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.') );

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

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

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

	$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'),
		]
	);
	return;
}
#####################################################################
# analysis menu
sub menu_analysis($$) {
	my $main   = shift @_;
	my $frame1 = shift @_;

	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.') );

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

	$anamenu->command(
		-label     => _('stat_ext'),
		-underline => 6,
		-command   => sub { do_action('--stat_ext') }
	);
	$main->bind( '<Control-Key-e>' => sub { do_action('--stat_ext') } );

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

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

	$anamenu->command(
		-label     => _('stat_date'),
		-underline => 7,
		-command   => sub { do_action('--stat_date') }
	);
	$main->bind( '<Control-Key-d>' => sub { do_action('--stat_date') } );

	$anamenu->command(
		-label     => _('duplicates'),
		-underline => 2,
		-command   => sub { do_action('--duplicates') }
	);
	$main->bind( '<Control-Key-U>' => sub { do_action('--duplicates') } );

	$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')
		]
	);
	return;
}
#####################################################################
# configuration menu
sub menu_configuration($$) {
	my $main   = shift @_;
	my $frame1 = shift @_;

	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;
	$configmenu->command(
		-label     => _('Select'),
		-underline => 0,
		-command   => sub { select_config( $main, $entry ) }
	);
	$main->bind( '<Alt-Key-S>' => sub { select_config( $main, $entry ) } );

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

	$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" );
		}
	);

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

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

	$configmenu->command(
		-label     => 'learn',
		-underline => 0,
		-command   => sub { do_learn($main) }
	);

	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'),
			_('learn from log'),
		]
	);
	$entry =
	  $frame1->Entry( -textvariable => \$Configfile, -width => 30 )
	  ->pack( -side => 'left' );
	$W_balloon->attach( $entry, -msg => _('configuration file name') );

	return;
}
#####################################################################
#sub menu_options($$) {
#	my $main   = shift @_;
#	my $frame1 = shift @_;
#
#	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.' );
#
#	# timing
#	$optionmenu->checkbutton(
#		-label     => 'Timing',
#		-underline => 0,
#		-variable  => \$Timing,
#	);
#	$main->bind( '<Alt-Key-T>' => sub { $Timing = !$Timing; } );
#
#	# running
#	$optionmenu->checkbutton(
#		-label     => 'Running',
#		-underline => 0,
#		-variable  => \$Running,
#	);
#	$main->bind( '<Alt-Key-R>' => sub { $Running = !$Running; } );
#
#	# dead_symlinks
#	$optionmenu->checkbutton(
#		-label     => 'dead symlinks',
#		-underline => 0,
#		-variable  => \$Warn_dead_symlinks,
#	);
#	$main->bind(
#		'<Alt-Key-d>' => sub { $Warn_dead_symlinks = !$Warn_dead_symlinks; } );
#
#	# follow symlinks
#	$optionmenu->checkbutton(
#		-label     => 'follow symlinks',
#		-underline => 8,
#		-variable  => \$Follow_symlinks,
#	);
#	$main->bind( '<Alt-Key-Y>' => sub { $Follow_symlinks = !$Follow_symlinks; }
#	);
#
#	# allow overload
#	$optionmenu->checkbutton(
#		-label     => 'allow overload',
#		-underline => 6,
#		-variable  => \$Allow_overload,
#	);
#	$main->bind( '<Alt-Key-o>' => sub { $Allow_overload = !$Allow_overload; } );
#
#	# report full newdel
#	$optionmenu->checkbutton(
#		-label     => 'report full newdel',
#		-underline => 7,
#		-variable  => \$Report_full_newdel,
#	);
#	$main->bind(
#		'<Alt-Key-F>' => sub { $Report_full_newdel = !$Report_full_newdel; } );
#
#	# summary
#	$optionmenu->checkbutton(
#		-label => 'report summary',
#
#		#	-underline => 8,
#		-variable => \$Report_summary,
#	);
#
#   #$main->bind( '<Alt-Key-U>' => sub { $Report_summary = !$Report_summary; } );
#
#	# context
#	$optionmenu->checkbutton(
#		-label => 'report context',
#
#		#	-underline => 7,
#		-variable => \$Report_context,
#	);
#
#   #$main->bind( '<Alt-Key-F>' => sub { $Report_context = !$Report_context; } );
#
#	# warn on missing files
#	$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; } );
#
#	# Ignore case
#	$optionmenu->checkbutton(
#		-label     => 'Ignore case',
#		-underline => 0,
#		-variable  => \$Ignore_case,
#	);
#	$main->bind( '<Alt-Key-I>' => sub { $Ignore_case = !$Ignore_case; } );
#
#	# syslog
#	$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 .. Afick::Msg->get_max_msg_level() ) ) {
#		$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',
#			'syslog report',
#			'debug level from 0 (none) to '
#			  . Afick::Msg->get_max_msg_level()
#			  . ' (full)',
#		]
#	);
#	return;
#}
#####################################################################
# archives menu
sub menu_archive($$) {
	my $main   = shift @_;
	my $frame1 = shift @_;

	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.') );

	$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" ) } );

	$archivemenu->command(
		-label     => _('search'),
		-underline => 0,
		-command   => sub { archive_search($main) }
	);
	$main->bind( '<Control-Key-S>' => sub { archive_search($main); } );

	$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'),
		]
	);
	return;
}
#####################################################################
# help menu : administratives info
sub menu_help($$) {
	my $main   = shift @_;
	my $frame1 = shift @_;

	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.') );

	$helpmenu->command(
		-label     => _('help'),
		-underline => 0,
		-command   => [ \&do_help, $main ]
	);
	$main->bind( '<Alt-Key-H>' => sub { do_help($main); } );

	$helpmenu->command(
		-label     => _('check_update'),
		-underline => 0,
		-command   => sub { check_update( 'afick-gui', $Version ) }
	);
	$main->bind( '<Alt-Key-U>' => sub { do_action('-U'); } );

	$helpmenu->command(
		-label     => _('wizard'),
		-underline => 0,
		-command   => [ \&do_wizard, $main ]
	);
	$main->bind( '<Alt-Key-w>' => sub { do_wizard($main); } );

	$helpmenu->command(
		-label     => _('bind keys'),
		-underline => 1,
		-command   => [ \&do_bind, $main ]
	);
	$main->bind( '<Alt-Key-b>' => sub { do_bind($main); } );

	$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 ...)'),
		]
	);
	return;
}
#####################################################################
# frame 1  : menus
#####################################################################
sub menu_frame1($) {
	my $main = shift @_;

	my $frame1 =
	  $main->LabFrame( -label => _('menus'), -labelside => 'acrosstop' );
	$frame1->pack( -side => $side, -expand => 0, -fill => 'x' );

	# file menu
	menu_file( $main, $frame1 );

	# action menu
	menu_action( $main, $frame1 );

	# analysis menu
	menu_analysis( $main, $frame1 );

	# configuration file
	menu_configuration( $main, $frame1 );

	# options menu
	#menu_options( $main, $frame1 );

	# archive menu
	menu_archive( $main, $frame1 );

	# help menu
	menu_help( $main, $frame1 );

	return;
}
#####################################################################
# frame 2  : output
#####################################################################
sub menu_frame2($) {
	my $main = shift @_;

	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'} );

	return;
}
#####################################################################
# frame 3  : warning
#####################################################################
sub menu_frame3($) {
	my $main = shift @_;

	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'} );

	return;
}
#####################################################################
# frame 4  : progress
#####################################################################
sub menu_frame4($) {
	my $main = shift @_;

	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') );

	return;
}
#####################################################################
##                       main
#####################################################################

my $config = Afick::Cfg->new();

# 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,
		'help|h'          => \$opt_help,
		'man'             => \$opt_man,
		'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 || $config->get_configfile();
init_options($Configfile);

# tk page
my $main = MainWindow->new( -title => "afick-gui $Version" );
my $xpm = $main->Photo(-file => "/usr/share/pixmaps/afick.xpm", - format => 'xpm');
$main->Icon(-image => $xpm);

# 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();

# we will have
# frame 1 : menus
menu_frame1($main);

# frame 2 : outpout
menu_frame2($main);

# frame 3 : warning
menu_frame3($main);

# frame 4 : progress bar
menu_frame4($main);

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

click on afick icon or type the afick-tk.pl command, 
and the graphical interface will appear

=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

afick-tk does not need any options to run

=head1 OPTIONS

You can use any number of the following options :

=over 4

=item B<--config_file|-c configfile>

read the configuration in config file named "configfile".

=item B<--help|-h>

Output help information and exit.

=item B<--man>

Output full help information and exit.

=item B<--version|-V>

Output version information and exit.

=item B<--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 menu

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

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

=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

= duplicates

display files with same contents

=item search

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

=back

=head3 Configuration menu

=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

=item learn

learn from previous afick run (logs) to remove false positives

=back

=head3 Archive menu

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 menu

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

this program use perl and its standard modules.
the perl-tk module is used for the gui.

=head1 SEE ALSO

=for html
<a href="afick.conf.5.html">afick.conf(5)</a> for the configuration file syntax
<br>
<a href="afick-tk.1.html">afick-tk(1)</a> for the graphical interface
<br>
<a href="afick.1.html">afick(1)</a> for the command-line interface
<br>
<a href="afickonfig.1.html">afickonfig(1)</a> for a tool to change afick's configuration file
<br>
<a href="afick_archive.1.html">afick_archive(1)</a> for a tool to manage archive's reports
<br>
<a href="afick_learn.1.html">afick_learn(1)</a> for a learning tool

=for man
\fIafick.conf\fR\|(5) for the configuration file syntaxe
.PP
\fIafick\-tk\fR\|(1) for the graphical interface
.PP
\fIafick\fR\|(1) for the 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
.PP
\fIafick_learn\fR\|(1) for a learning tool

=head1 DIAGNOSTICS

the verbose command line option can help to provide diagnostics

=head1 EXIT STATUS

not meaningful

=head1 CONFIGURATION

same as for afick(1) 

for config file syntax see afick.conf(5)

=head1 INCOMPATIBILITIES

none known

=head1 BUGS AND LIMITATIONS

afick works on files, it is not a Version Control System,
and it does not show changes in registry for windows users

=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 eric.gerbier@tutanota.com
