Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

Different behavior of Tk program in two versions of Perl

by vagabonding electron (Curate)
on Jul 01, 2018 at 19:09 UTC ( [id://1217708]=perlquestion: print w/replies, xml ) Need Help??

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

    <h1> for the honor

    What change in 5.26.2 (probably earlier?) results in this behavior?

    Does it matter? The answer is no :)

    #!/usr/bin/perl -- use strict; use warnings; use Tk; my $db = tkinit->DialogBox; my $init = q{inits}; my @choices = ( 1, 2, 3 ); $db->BrowseEntry( -variable, \$init , -choices, \@choices, )->pack; $db->Show;

    So "Tk::BrowseEntry" usage solution is obvious :)

    my @choices = ( '', 1 , 2, 3 ); $init = $choices[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.

    That is kind of difficult to read, anyway, see spoiler above (and notice its short),

    but

    With one click for a menu/submenu/popup/dropdown/checkbox ... thats too many clicks for simple sort.

    A better idea is to use one of Tk::MListbox , Tk::Table, https://metacpan.org/pod/distribution/Tk-TableMatrix/pod/TableMatrix.pod, Sorted lists in Tk ... to sort you simply click on the column heading. one ascending, one descending, one no sorting*.

     

    <h1> for the honor

    2018-07-03 Athanasius removed <h1> tags

      Thank you very much for your reply! I am ageing but can still read well :-))

      Thank you for the hints to the other Tk modules too. I will certainly read the documentation.

      The posted "minimal example" is a part of a bigger application, I just did not change the menu portion here.

      The simple sort in the real application is actually performed per mouse click on the column header. The menu is for the advanced sort, that is on column1 then on column2 then on column3 (there are more than 3 columns in the real application too). This intention is not obvious with the short test file provided, I admit. I should make many Harrys with different dates to show that.

      Probably I did not describe the actual problem sufficiently. It is as follows. If I start the dialog where the user choose the columns to sort on, the entries should be empty. They are empty in v.5.16 but are partially set in v.5.26 and I do not understand why.

      Thanks again!

      Update: Just thought - probably your example behaves differently in v.5.16 and v.5.26 too? Cannot check it now (have only 5.16 here), will do it @home and report.

      Update 2: Now @home I run your example with v.5.16 and v.5.26 and I do see different behaviour. Whereas under v.5.16 the BrowseEntry always start with "inits", it starts sometimes with "inits" and sometimes with 1 under v.5.26 (I have to start skript more times in sequence to see this effect).

      So, first I learned that the minimal working example can be really small. :-) Thank you very much again, also for the hints about the other modules.

      Second, however, I see that this different behaviour is not just me. I would like to understand why. Is it something I should worry about?

      Update 3: I added two print statements to your example: print "Debug1: $init\n"; straight after $db->BrowseEntry(-variable, \$init, -choices, \@choices,)->pack; and print "Debug2: $init\n"; straight after $db->Show;. Under v.5.16 the output is always Debug1: inits for the first print statement and the chosen value for the second print statement. Unter v.5.26 the first print statement is sometimes Debug1: inits and sometimes Debug1: 1. The second print statement is the same way as under v.5.16. Still curious, why $init is set to the first value of @choices under v.5.26 and also not always but somehow randomly.

        Um. Does solution work for you (initialize variable from choices array with empty being the first )? Yes even with more columns it should still work by clicking header, thats as advanced as it needs to get :) i cant see a reason otherwise. Multiple dropdowns is definitely too laborious esp as number of columns increases. In the spirit of that approach would be a listbox with reorderable items where each item is a 3 radio buttons: asc desc ignore and label column header (and maybe uparrow button move item up in order...) Try both and see what makes more sense to you, i dont see extra popup clicks as advancement :)

        Second, however, I see that this different behaviour is not just me. I would like to understand why. Is it something I should worry about?

        dont worry about it use solution that provides consistent behaviour across all perl versions

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://1217708]
Approved by beech
Front-paged by haukex
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others learning in the Monastery: (3)
As of 2024-03-28 16:48 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found