#!/perl
use strict;
use warnings FATAL => qw(all);

use Tk;
use Tk::HList;
use Tk::BrowseEntry; 
use Tk::DialogBox;
use Text::CSV_XS; 
use FindBin qw($Bin);

my $csv_par = 
{ 
    binary => 1,	auto_diag => 1,	allow_whitespace => 1,
    sep_char => ';', eol       => $/,	quote_char => undef, #
};

open my $in, "<", "$Bin/test.csv" or die "$!";
my $csv = Text::CSV_XS->new($csv_par);
my @header = @{$csv->getline($in)};

my %sort_order;
@sort_order{@header} = (1, 0, 1);

my %field_nr;
@field_nr{@header} = 0 .. $#header;

my %rec;
$csv->bind_columns(\@rec{@header});

my @data;
while ( $csv->getline($in) )
{
 push @data, [@rec{@header}];
}

my $mw = MainWindow->new();

my $frame0 = $mw->Frame(-borderwidth => 2, -relief => 'groove', 
)->pack(-side => 'top', -expand => 1, -fill => 'both');

my $hlist = $frame0->Scrolled("HList",
		-header => 1,
		-columns => 3, 
		-scrollbars => 'osoe',
)->pack( -side => 'left', -expand => 1, -fill => 'both');

_filling($hlist, [@data]);

$hlist->header('create', 0, -text => 'ID');
$hlist->header('create', 1, -text => 'Name');
$hlist->header('create', 2, -text => 'Date');

my $menuitems = [
    [Cascade => "~Sort and Filter", -menuitems =>
        [
            [Button => "~Advanced sorting", -command => \&_dialog,],
            [Separator => ""],
  
            [Button => "~Quit", -command => sub{$mw->destroy;}],
        ],
    ],
];

my $menu = $mw->Menu(-menuitems => $menuitems);

$mw->configure(-menu => $menu);

MainLoop();

sub _filling
{
 my ($this_hlist, $this_aref) = @_;
 $this_hlist->delete('all');

 for my $index (0..$#$this_aref) 
 {
	$this_hlist->add($index);

	for my $textin (0.. $#{$this_aref->[$index]}) 
	{
		$this_hlist->itemCreate(
			$index, $textin,-text => $this_aref->[$index][$textin],);
	}
 }
}

sub _dialog
{

	my(@popup_opts) = (-popover => undef, 
                           qw/-overanchor c -popanchor c/);


	my $d1 = $mw->DialogBox( -title => 'Advanced Sorting',
	@popup_opts,
	-default_button => 'Sort', -buttons => [ 'Back', 'Sort'],
	);


	my @sorts = ('') x 3; 
	my @orders = (0) x 3; 
	
	my $be1 = $d1->BrowseEntry(-variable => \$sorts[0], 
           -choices => [@header],);

	my $cb1 = $d1->Checkbutton(-text => 'Z>A', 
           -variable => \$orders[0]);
	
	my $be2 = $d1->BrowseEntry(-variable => \$sorts[1], 
           -choices => [@header],);
	my $cb2 = $d1->Checkbutton(-text => 'Z>A', 
           -variable => \$orders[1]);

	my $be3 = $d1->BrowseEntry(-variable => \$sorts[2], 
           -choices => [@header],);
	my $cb3 = $d1->Checkbutton(-text => 'Z>A', 
           -variable => \$orders[2]);


	$be1->grid( -row => 0, -column => 0);
	$cb1->grid( -row => 0, -column => 1);
	
	$be2->grid( -row => 1, -column => 0);
	$cb2->grid( -row => 1, -column => 1);
	
	$be3->grid( -row => 2, -column => 0);
	$cb3->grid( -row => 2, -column => 1);

	my $answer = $d1->Show || ''; # 



	if ( $answer eq 'Sort' )
	{
		_after_dialog([@sorts], [@orders]); 
	}
}

sub _after_dialog
{
	my @choices = @{$_[0]};
	my @ord = @{$_[1]}; 

	@choices = grep {length($_)} _uniq(@choices);
	@ord = @ord[0..$#choices];





	if ( scalar @choices)
	{
		@data = sort {_custom_sort($a, $b, [@choices], [@ord])} 
                        @data;

		_filling($hlist, [@data]);
	}
}

sub _uniq
{
	my %seen; grep !$seen{$_}++, @_;
}

sub _custom_sort # https://stackoverflow.com/questions/24154744/dynamically-sorting-array-of-hash-by-multiple-keys-in-perl --- with some additions.
{
	my ($x, $y, $keyref, $ordref) = @_;
	my @keys = @$keyref;
	my @ords = @$ordref;
    
    for my $key_idx ( 0 .. $#keys )
    {
        my $key		= $keys[$key_idx];
	   
	my $direction 	= $ords[$key_idx]; 
	   
	   my $key_nr = $field_nr{$key};
   
	   my $cmp;
   
	   if ( $sort_order{$key} == 1 )
	   {
		if ( $direction == 0 )
		{
			$cmp = $x->[$key_nr] <=> $y->[$key_nr];
		}
		


		else
		{
			$cmp = $y->[$key_nr] <=> $x->[$key_nr];
		}
	   }

   
   
	   elsif ( $sort_order{$key} == 0 )
	   {
		if ( $direction == 0 )
		{
			$cmp = $x->[$key_nr] cmp $y->[$key_nr];
		}
		else
		{
			$cmp = $y->[$key_nr] cmp $x->[$key_nr];
		}

	   }
   
	   return $cmp if $cmp;
   
    }
    return 0;

}



##</code><code>##

ID;Name;Date
1;Harry;20180501
2;Ronald;20180319
3;Hermine;20180129
4;Arthur;20180202
5;Minerva;20180430