#!/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/dynami
+cally-sorting-array-of-hash-by-multiple-keys-in-perl --- with some ad
+ditions.
{
    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;

}
[download]