vagabonding electron has asked for the wisdom of the Perl Monks concerning the following question:
Dear Monks,
I have noticed a strange behavior on different versions of Perl (namely v5.16.3 vs. v5.26.2). To illustrate I made a minimal working example which is not that small in this case since it deals with a sorting of a list of items in Tk.
#!/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; }
The menu option “Sort and Filter” -> “Advanced sorting” can sort the list on up to 3 columns. It seems to work in both versions. In 5.16.3, the mask “Advanced sorting”, that is, a grid of three rows of BrowseEntry (to choose a column) and Checkbuttons (to define ascending or descending sorting) – this mask is empty on every new call. In 5.26.2, if I call the menu more times, some BrowseEntrys are set with the name of the first columns (not empty as the should). I can change the column choice or even delete an entry. However I cannot get why the entries are set just on call of the menu.
What change in 5.26.2 (probably earlier?) results in this behavior?
Thank you very much!
The content of test.csv
ID;Name;Date 1;Harry;20180501 2;Ronald;20180319 3;Hermine;20180129 4;Arthur;20180202 5;Minerva;20180430
|
---|
Replies are listed 'Best First'. | |
---|---|
Re: Different behavior of Tk program in two versions of Perl
by Anonymous Monk on Jul 01, 2018 at 23:23 UTC | |
by vagabonding electron (Curate) on Jul 02, 2018 at 09:33 UTC | |
by Anonymous Monk on Jul 02, 2018 at 18:10 UTC | |
by vagabonding electron (Curate) on Jul 03, 2018 at 18:43 UTC | |
by Anonymous Monk on Jul 02, 2018 at 18:13 UTC |