|
chungley2000 has asked for the wisdom of the Perl Monks concerning the following question:
I was asked to debug a production GUI perl/TK program (the developer was let go) that have no documentation and no knowledge transfer. I did some basic perl programming, but not with TK. The user had claimed that the code worked before (a few days ago) and stopped working around yesterday. The code hadn't been touched since 11/2017 and the Perl executable also didn't seem to be touch. I will tried to verify that the Tk lib also hadn't been touched.
Basically, the symptom/problem is that even though the rows are "selected/highlighted" on the GUI, when the user clicked on the "Get Files" button to act on the selection, nothing happened because it didn't see the selected rows!
Here are the snippets from the code (I had inserted additional comments using ### in the code)...
$mw1 = new MainWindow;
$mw1 -> title("CMVC File Retriever");
#-----------------------------------------------------------------
# Set up two frames:
# - $frameTop - contains radio buttons for selecting table.
# - $frameBottom - contains button to quit without update.
#-----------------------------------------------------------------
$frameTop = $mw1 -> Frame(-label => "QUERY Table (Last update as
+of $update)", -relief => 'groove', -borderwidth => 1)->pack(-side =>
+'top', -fill => 'both');
$table = "fileview" ; # default table (turns radio button on)
$frameTop -> Radiobutton(-text => "file table", -value => "fi
+leview", -variable => \$table)->pack(-side => 'left');
### Skipping some of the lines...
$frameBottom -> Button( -bg => 'green', -text => "Get Files", -a
+nchor => 'center', -command => \&getSelection) -> pack ( -side => 'le
+ft' ) if $table eq "fileview";
### Skipping more of the lines...
my $t = $frameTop -> Scrolled (
'Spreadsheet',
-rows => $rows,
-cols => $cols,
-width => 150,
-height => 10,
-titlerows => 1,
-titlecols => 2,
-rowtagcommand => \&rowSub,
-coltagcommand => \&colSub,
-selectmode => 'extended',
-variable => $arrayVar,
-selecttitle => 1,
);
$t -> configure (
-browsecommand => sub {
my ($index) = @_ ;
$currentText = $index ;
$activeText = $t -> get($index) ;
}
);
$t -> configure (
-validate => 1,
-validatecommand => sub {
my ( $row, $col, $old, $new, $index ) =
+ @_;
$activeText = $new;
return 1;
}
);
###
### This here is interesting since I think getting selection
### should be easy. I would expect selectioncommand is meant
### to be used to "extend" the default behavior... But I don't
### see a real problem with this approach.
###
$t -> configure (
-selectioncommand => sub {
my ( $NumRows, $Numcols, $selectio
+n, $noCells ) = @_;
$results = $selection ; # assign re
+sults to var to read later
print "DEBUG: I am here at selecti
+oncommand with results = $results,\n";
return $selection ; # NOT sure
+where this is returned, so assign above
}
);
### Skip again to where we are trying to "access" the
### selection's results:
#-----------------------------------------------------------------
# Subroutine to get the selected data and copy it to a user dir
#-----------------------------------------------------------------
sub getSelection
{
#--------------------------------------------------------------
+---
# Get selected item and parse into values.
#--------------------------------------------------------------
+---
### The program was meant to operate on this global $results,
### but it is empty...
### It seems that selectioncommand never got executed.
### What is even more weird for me is that out of the 15/20
### different tests that I ran to try to debug this, "twice"
### (and I don't know how to replicate it), the
### selectioncommand executed some seconds AFTER.
### I tried explicitly declared $results as a global variable
### by adding "our $results;" before the use in this AND also
### in selectioncommand's subroutine.
### The other thing that I tried is do use $table->curselection
+(),
### but I don't know how to use that properly; I tried
### $table->curselection() and $frameTop->curselection(),
### but they failed.
print "get Selection results are , $results,\n" ; # TESTING
print Dumper($results) ; # TESTING
|
Re: Retrieving selections from Tk:TableMatrix
by Aldebaran (Curate) on Oct 10, 2018 at 22:38 UTC
|
Hi chungley2000 and welcome to the monastery,
I was happy to see your post, because I've been thinking about working up a Tk project. It helps for you to specify in code what modules you use. There can be some overlap in cpan resources in some namespaces. It seems that I didn't have Tk, if that is the module you use. It was a truly eye-poppng install. At one point, the screen was covered in camels.
I state without proof that I think all contemporary perl should be written with "strictness." I achieve this by the line use 5.011; . Then I just took wild guesses for values in order to get the script to compile. Then I can hit it with perltidy to make it legible. The idea is that you come up with some self-contained example such that it can be run:
$ ./1.tk.pl
Can't call method "title" on an undefined value at ./1.tk.pl line 7.
$ perltidy -i=2 -b 1.tk.pl
$ cat 1.tk.pl
#!/usr/bin/perl -w
use 5.011;
use warnings;
use Tk;
use Data::Dumper;
my $mw1->title("CMVC File Retriever");
#-----------------------------------------------------------------
# Set up two frames:
# - $frameTop - contains radio buttons for selecting table.
# - $frameBottom - contains button to quit without update.
#-----------------------------------------------------------------
my $update = undef;
my $frameTop = $mw1->Frame(
-label => "QUERY Table (Last update as of $update)",
-relief => 'groove',
-borderwidth => 1
)->pack( -side => 'top', -fill => 'both' );
my $table = "fileview"; # default table (turns radio button on)
$frameTop->Radiobutton(
-text => "file table",
-value => "fileview",
-variable => \$table
)->pack( -side => 'left' );
### Skipping some of the lines...
my $frameBottom->Button(
-bg => 'green',
-text => "Get Files",
-anchor => 'center',
-command => \&getSelection
)->pack( -side => 'left' )
if $table eq "fileview";
### Skipping more of the lines...
my ( $rows, $cols, $arrayVar ) = ( 10, 5, undef );
my $t = $frameTop->Scrolled(
'Spreadsheet',
-rows => $rows,
-cols => $cols,
-width => 150,
-height => 10,
-titlerows => 1,
-titlecols => 2,
-rowtagcommand => \&rowSub,
-coltagcommand => \&colSub,
-selectmode => 'extended',
-variable => $arrayVar,
-selecttitle => 1,
);
my ( $currentText, $activeText ) = ( "current", "active" );
$t->configure(
-browsecommand => sub {
my ($index) = @_;
$currentText = $index;
$activeText = $t->get($index);
}
);
$t->configure(
-validate => 1,
-validatecommand => sub {
my ( $row, $col, $old, $new, $index ) = @_;
$activeText = $new;
return 1;
}
);
my $results = "not much yet, but started writing code....";
###
### This here is interesting since I think getting selection
### should be easy. I would expect selectioncommand is meant
### to be used to "extend" the default behavior... But I don't
### see a real problem with this approach.
###
$t->configure(
-selectioncommand => sub {
my ( $NumRows, $Numcols, $selection, $noCells ) = @_;
$results = $selection; # assign results to var to read later
print "DEBUG: I am here at selectioncommand with results = $resul
+ts,\n";
return $selection; # NOT sure where this is returned, so as
+sign above
}
);
### Skip again to where we are trying to "access" the
### selection's results:
#-----------------------------------------------------------------
# Subroutine to get the selected data and copy it to a user dir
#-----------------------------------------------------------------
sub getSelection {
#-----------------------------------------------------------------
# Get selected item and parse into values.
#-----------------------------------------------------------------
### The program was meant to operate on this global $results,
### but it is empty...
### It seems that selectioncommand never got executed.
### What is even more weird for me is that out of the 15/20
### different tests that I ran to try to debug this, "twice"
### (and I don't know how to replicate it), the
### selectioncommand executed some seconds AFTER.
### I tried explicitly declared $results as a global variable
### by adding "our $results;" before the use in this AND also
### in selectioncommand's subroutine.
### The other thing that I tried is do use $table->curselection(),
### but I don't know how to use that properly; I tried
### $table->curselection() and $frameTop->curselection(),
### but they failed.
print "get Selection results are , $results,\n"; # TESTING
print Dumper($results); # TESTING
}
$
The first problem is the first line, line 7 in this listing. Start tracking your values. A say statement after lines when values are set keeps bad ones from propagating.
say "result is $result";
If your code is too long to post here, put it on github and post a link to it.
I hope this helps, and I'm grateful to have the perl community helping to solve problems for me.
| [reply]
[d/l]
[select] |
|
|
Hi chungley2000 and welcome to the monastery,
I was happy to see your post, because I've been thinking about working up a Tk project. It helps for you to specify in code what modules you use. There can be some overlap in cpan resources in some namespaces. It seems that I didn't have Tk, if that is the module you use. It was a truly eye-popping install. At one point, the screen was covered in camels.
I state without proof that I think all contemporary perl should be written with "strictness." I achieve this by the line use 5.011; . Then I just took wild guesses for values in order to get the script to compile. Then I can hit it with perltidy to make it legible. The idea is that you come up with some self-contained example such that it can be run:
$ ./1.tk.pl
Can't call method "title" on an undefined value at ./1.tk.pl line 7.
$ perltidy -i=2 -b 1.tk.pl
$ cat 1.tk.pl
#!/usr/bin/perl -w
use 5.011;
use warnings;
use Tk;
use Data::Dumper;
my $mw1->title("CMVC File Retriever");
#-----------------------------------------------------------------
# Set up two frames:
# - $frameTop - contains radio buttons for selecting table.
# - $frameBottom - contains button to quit without update.
#-----------------------------------------------------------------
my $update = undef;
my $frameTop = $mw1->Frame(
-label => "QUERY Table (Last update as of $update)",
-relief => 'groove',
-borderwidth => 1
)->pack( -side => 'top', -fill => 'both' );
my $table = "fileview"; # default table (turns radio button on)
$frameTop->Radiobutton(
-text => "file table",
-value => "fileview",
-variable => \$table
)->pack( -side => 'left' );
### Skipping some of the lines...
my $frameBottom->Button(
-bg => 'green',
-text => "Get Files",
-anchor => 'center',
-command => \&getSelection
)->pack( -side => 'left' )
if $table eq "fileview";
### Skipping more of the lines...
my ( $rows, $cols, $arrayVar ) = ( 10, 5, undef );
my $t = $frameTop->Scrolled(
'Spreadsheet',
-rows => $rows,
-cols => $cols,
-width => 150,
-height => 10,
-titlerows => 1,
-titlecols => 2,
-rowtagcommand => \&rowSub,
-coltagcommand => \&colSub,
-selectmode => 'extended',
-variable => $arrayVar,
-selecttitle => 1,
);
my ( $currentText, $activeText ) = ( "current", "active" );
$t->configure(
-browsecommand => sub {
my ($index) = @_;
$currentText = $index;
$activeText = $t->get($index);
}
);
$t->configure(
-validate => 1,
-validatecommand => sub {
my ( $row, $col, $old, $new, $index ) = @_;
$activeText = $new;
return 1;
}
);
my $results = "not much yet, but started writing code....";
###
### This here is interesting since I think getting selection
### should be easy. I would expect selectioncommand is meant
### to be used to "extend" the default behavior... But I don't
### see a real problem with this approach.
###
$t->configure(
-selectioncommand => sub {
my ( $NumRows, $Numcols, $selection, $noCells ) = @_;
$results = $selection; # assign results to var to read later
print "DEBUG: I am here at selectioncommand with results = $resul
+ts,\n";
return $selection; # NOT sure where this is returned, so as
+sign above
}
);
### Skip again to where we are trying to "access" the
### selection's results:
#-----------------------------------------------------------------
# Subroutine to get the selected data and copy it to a user dir
#-----------------------------------------------------------------
sub getSelection {
#-----------------------------------------------------------------
# Get selected item and parse into values.
#-----------------------------------------------------------------
### The program was meant to operate on this global $results,
### but it is empty...
### It seems that selectioncommand never got executed.
### What is even more weird for me is that out of the 15/20
### different tests that I ran to try to debug this, "twice"
### (and I don't know how to replicate it), the
### selectioncommand executed some seconds AFTER.
### I tried explicitly declared $results as a global variable
### by adding "our $results;" before the use in this AND also
### in selectioncommand's subroutine.
### The other thing that I tried is do use $table->curselection(),
### but I don't know how to use that properly; I tried
### $table->curselection() and $frameTop->curselection(),
### but they failed.
print "get Selection results are , $results,\n"; # TESTING
print Dumper($results); # TESTING
}
$
The first problem is the first line, line 7 in this listing. Start tracking your values. A say statement after lines when values are set keeps bad ones from propagating.
say "result is $result";
If your code is too long to post here, put it on github and post a link to it.
I hope this helps, and I'm grateful to have the perl community helping to solve problems for me.
| [reply]
[d/l]
[select] |
Re: Retrieving selections from Tk:TableMatrix
by Marshall (Canon) on Oct 11, 2018 at 00:29 UTC
|
I've built a complex GUI using TableMatrix in the past. However this program went End of Life a few years back and source code is archived on a CD somewhere. I did have some fancy left click, right click with drop down action menu of user features for a selected line.
My first challenge in helping you is to get TableMatrix installed on my current 64 bit Windows, Active State Perl. I looked at the Active State Build Matrix: https://code.activestate.com/ppm/Tk-TableMatrix/ The issue appears to be:
Can't locate Tk/MMtry.pm in @INC (you may need to install the Tk::MMtr
+y module) (@INC contains: C:/cpanfly-5.24-64/var/megalib C:/Perl-5.24
+-64/site/lib C:/Perl-5.24-64/lib) at ./myConfig line 7.
BEGIN failed--compilation aborted at ./myConfig line 7.
Compilation failed in require at Makefile.PL line 19.
BEGIN failed--compilation aborted at Makefile.PL line 23.
Warning: No success on command[C:\Perl-5.24-64\bin\perl.exe Makefile.P
+L]
CERNEY/Tk-TableMatrix-1.23.tar.gz
C:\Perl-5.24-64\bin\perl.exe Makefile.PL -- NOT OK
Finished 2016-09-09T08:09:09
I've never built a .ppd myself or installed directly from CPAN to an Active State Perl installation. Advice from other Monks would be appreciated!
So, I'd like for some Monks to help me help you.
Everything you want to do with TableMatrix is possible and even more.
Can you generate a small self contained runnable program using TableMatrix? So that we can focus on the selection and mouse issues?
| [reply]
[d/l] |
|
|
Hi, Aldebaran and Marshall
Thank you so so much for your time and efforts; I am really sorry about the late reply.
The program file has 2200 lines of code. I will see if I can get a smaller sample setup that replicates the problem; maybe I can solve it then. If I can get this replicable thru small code, I will post that; if I cannot, then I will clean up the current code as much as I can and post a link to GitHub. I had used Perl only as a newbie; so this may take a little time (hopefully by early next week)
In the meantime, I had included the header of the program below:
- the Perl version is 5.10.1 and the archname = "x86_64-linux-thread-multi" (I put a print statement right after the assignment using Config)
- I did an ls on /proj/pdkfc8/tools/perl/lib/perl5/site_perl/5.10.1, and I don't see any folder that resembles archname.
#!/usr/bin/perl -- -w
=head1 NAME
cmvcq.pl
- Uses TK to create GUI windows to obtain metadata and files fro
+m the original
CMVC AMS family used by the Enablement team from 1998 to 2016+
=head1 DEPENDENCIES/CONDITIONS
1. Requires TK and DB/SQL skills for development.
=head1 FUNCTIONS
:
:
=head1 HISTORY
Original build 06/21/2016
Updates
- / /201 - -
=cut
#*****************************************************************
+******************************
# Set environment
#-----------------------------------------------------------------
+-------------------------------
use Config ; # gets the version and directory architecture - used
+ in BEGIN block
BEGIN
{
# location of afs installed modules
# NOTE: must place arch dependent location first to eliminate th
+e arch name include
# in the module name, e.g., x86_64-linux-thread-multi::Bundle::
+DBD::mysql
$basedir = '/proj/pdkfc8/tools/perl'
+ ;
$version = $Config{'version'}
+ ; # perl version
$archname = $Config{'archname'}
+ ; # os architecture
print("version=$version, archname=$archname\n\n");
push @INC, "$basedir/lib/perl5/site_perl/$version/$archname"
+ ; # at bottom of array
push @INC, "$basedir/lib/perl5/site_perl/$version"
+ ; # at bottom of array
push @INC, "$basedir/lib64/perl5/site_perl/$version/$archname
+"; # at bottom of arra
push @INC, "$basedir/lib64/perl5/site_perl/$version"
+ ; # at bottom of array
push @INC, "$basedir/lib64/perl5"
+ ; # at bottom of array
push @INC, "$basedir/share/perl5"
+ ; # at bottom of array
# use this when trying to install DBI and DBD::DB2 perl modules.
+ DBD::DB2 would not install in aix
push @INC, "$basedir/lib/site_perl/$version/$archname"
+ ; # at bottom of array for aix
}
# print "\n\nlarry $version, $archname";
# exit;
use DBI ; # database module
use File::Basename ; # basepath module
use Tk ; # TK gui module
use Tk::Text ; # TK text widget
use Tk::TableMatrix ; # used in $showSelection to show query resul
+ts
# There is a bug in the Tk TableMatrix widget using th Ctrl-mouse
+method to
# select a row of data - it always select one less cell than the n
+umber of
# rows in the table. Module creator gve me fix, so make sure you
+add it to
# the the appropriate module - add changes and re-install.
#
# Following is from John Cerney who wrote the module:
# It appears to be an issue with extended mode selection when the
+number of
# rows in the table is less than the number of columns. It looks l
+ike an error
# in finding the end of the row, using the max-row and not the max
+ column number
# in the code. This can be fixed by making a mod to the TableMatri
+x.pm file as
# follows (diff -c output).
#
# *** TableMatrix.pm.bak Mon Jun 27 15:20:37 2016
# --- TableMatrix.pm Mon Jun 27 15:20:43 2016
# ***************
# *** 769,775 ****
# else
# {
# ## We're in a row header
# ! $end = "$r,".$w->index('end','row');
# }
# }
# else
# --- 769,775 ----
# else
# {
# ## We're in a row header
# ! $end = "$r,".$w->index('end','col');
# }
# }
# else
use Tk::BrowseEntry ; # used in $MakeSelectWIndow for @Choices
use Tk::ProgressBar ; # not used
use Tk::DateEntry ; # TK Calendar
use Tk::TableMatrix::Spreadsheet ; # TK Calendar
use Data::Dumper ;
use List::Util qw(first); # for original attempt to determine if a
+rray had a value (abandoned use)
| [reply]
[d/l]
[select] |
|
|
Yes, see if you make a simple example using only a Tk::TableMatrix gizmo. Your large program has a lot of stuff that is irrelevant to the selection issues. I would imagine that you will wind up with something like 2 pages of code to play with.
BTW. I don't know if you've figured this out or not yet, but if you have say a couple of thousand line display, the the scroll widget will become smaller and it's hard to see if you are actually on the very last line or not? In my application I added something like 3-5 blank lines at the end so that the user could be sure that they actually reached the last line when scrolling. Of course these blank lines were ignored for processing purposes. But my users really liked this feature.
| [reply] |
|
|
for ( keys %Config ) {
if ( defined $Config{$_} ) {
if ( $Config{$_} =~ m%/x86_64-linux-gnu/% ) {
say "$_ matched: $Config{$_}";
}
}
Where the module data will go is certainly system-dependent. What I did to suss out where perl was looking for modules was type
$ perl -le 'print for @INC'
, and then I paid attention to where cpan was creating files such as DBI.pm . I've reformatted what you had. For example, I deleted whitespace between the module name and the semi-colon. Many of those had wrapped around and gotten newlines where they shouldn't be. And whatever you have needs to be broken down into chunks:
I hope this helps,
| [reply]
[d/l]
[select] |
|
|
|
|
