Anonymous Monk has asked for the
wisdom of the Perl Monks concerning the following question:
Relatively new to writing Perl, I've recently come across an error that, for the life of me, I cannot figure out how to resolve when using Tk::Gauge. The issue comes when the window holding the gauge, and associated scripts, is opened, used, closed, and then re-opened within the same "session" of the script. The gauge refuses to continue working beyond that first presence.
Below is the error that Terminal is spitting out (I am running Ubuntu with 5.12.4 at the moment), followed by the actual code itself extracted from the main script.
###############
# Error print #
###############
prompt$ perl gaugetest2
XS_Tk__Callback_Call error:Can't use an undefined value as an ARRAY re
+ference at /usr/local/share/perl/5.12.4/Tk/Gauge.pm line 408.
XS_Tk__Callback_Call error:Can't use an undefined value as an ARRAY re
+ference at /usr/local/share/perl/5.12.4/Tk/Gauge.pm line 408.
Tk::Error: Can't use an undefined value as an ARRAY reference at /usr/
+local/share/perl/5.12.4/Tk/Gauge.pm line 408.
Tk::Gauge::maxradius at /usr/local/share/perl/5.12.4/Tk/Gauge.pm line
+ 408
Tk::Gauge::centerpoint at /usr/local/share/perl/5.12.4/Tk/Gauge.pm li
+ne 398
Tk::Gauge::setvalue at /usr/local/share/perl/5.12.4/Tk/Gauge.pm line
+321
Tk::Gauge::tracew at /usr/local/share/perl/5.12.4/Tk/Gauge.pm line 38
+3
Tk::Trace::store at /usr/lib/perl5/Tk/Trace.pm line 94
Tie::Watch::callback at /usr/lib/perl5/Tie/Watch.pm line 399
Tie::Watch::Scalar::STORE at /usr/lib/perl5/Tie/Watch.pm line 453
Tk::Widget::traceVdelete at /usr/lib/perl5/Tk/Trace.pm line 182
Tk::Gauge::delete_traces at /usr/local/share/perl/5.12.4/Tk/Gauge.pm
+line 299
Tk::Gauge::ConfigChanged at /usr/local/share/perl/5.12.4/Tk/Gauge.pm
+line 279
Tk::After::once at /usr/lib/perl5/Tk/After.pm line 90
[once,[{},after#11,idle,once,[ConfigChanged,{},{}]]]
("after" script)
Tk::Error: Can't use an undefined value as an ARRAY reference at /usr/
+local/share/perl/5.12.4/Tk/Gauge.pm line 408.
Tk::Gauge::maxradius at /usr/local/share/perl/5.12.4/Tk/Gauge.pm line
+ 408
Tk::Gauge::centerpoint at /usr/local/share/perl/5.12.4/Tk/Gauge.pm li
+ne 398
Tk::Gauge::setvalue at /usr/local/share/perl/5.12.4/Tk/Gauge.pm line
+321
Tk::Gauge::tracew at /usr/local/share/perl/5.12.4/Tk/Gauge.pm line 38
+3
Tk::Trace::store at /usr/lib/perl5/Tk/Trace.pm line 94
Tie::Watch::callback at /usr/lib/perl5/Tie/Watch.pm line 399
Tie::Watch::Scalar::STORE at /usr/lib/perl5/Tie/Watch.pm line 453
Tk::Widget::traceVdelete at /usr/lib/perl5/Tk/Trace.pm line 182
Tk::Gauge::delete_traces at /usr/local/share/perl/5.12.4/Tk/Gauge.pm
+line 299
Tk::Gauge::ConfigChanged at /usr/local/share/perl/5.12.4/Tk/Gauge.pm
+line 279
Tk::After::once at /usr/lib/perl5/Tk/After.pm line 90
[once,[{},after#12,idle,once,[ConfigChanged,{},{}]]]
("after" script)
#######
# end #
#######
Perl code
#########
#!/usr/bin/perl -w
use Tk;
use Tk::Table;
use Tk::Gauge;
use strict;
use diagnostics;
my $mw = MainWindow->new;
$mw->geometry("75x75");
$mw->title("Gauge testing");
my $button = $mw->Button(-text => "Null", -command => \&button3_sub)-
+>pack(-anchor=>'center');
our ($alpha,$alphaone,$beta,$betaone,$mh,$output_text,$gaugevar,$cur);
sub button3_sub {
$mh= (35+(29-1)*6);
$cur=$mh;
my $hw = $mw -> Toplevel;
$hw ->geometry("650x450");
$hw ->title('Health Track (!!!WARNING:DO NOT EXIT THIS WINDOW UNTIL DO
+NE)');
my $hf = $hw -> Frame(-background => 'white')->pack(-ipadx => 250, -fi
+ll => 'both', -expand =>'yes');
my $left_frame = $hf -> Frame (-background=>'white')->pack(-side=>'lef
+t', -fill => 'y');
my $right_frame = $hf->Frame(-background=>'white')->pack(-ipadx=>150,
+-fill =>'y', -anchor=>'n',-expand=>1);
$betaone = $left_frame->Entry(-background => "green",)->pack(
+-anchor=>'nw');
my $beta_button = $left_frame->Button(-text => "Alpha Null", -
+command => \&update_output)->pack(-anchor=>'nw');
$alphaone = $left_frame->Entry(-background => "red",)->pack(-
+anchor=>'nw');
my $alpha_button = $left_frame->Button(-text => "Alpha Null",
+-command => \&update_output)->pack(-anchor=>'nw');
$output_text = $left_frame->Text(-height=>5,-width=>15)->pack(-expand
+=>0,);
my $gauge= $right_frame->Gauge(
-background => 'white',
-bands =>[
{
-piecolor => 'green',
-minimum=> 50,
-maximum=> 100,
-tag=> 'Healthy',
},
{
-piecolor => 'yellow',
-minimum=> 25,
-maximum=> 50,
-tag=> 'Bloodied',
},
{
-piecolor => 'red',
-minimum=> 0,
-maximum=> 25,
-tag=> 'Critical',
}
],
-bandplace => 'underticks',
-bandstyle=> 'pieslice',
-bandwidth=> 0,
-caption => 'Current Value',
-captioncolor=> 'black',
-extent => -180,
-from => 0,
-hubcolor => 'black',
-huboutline => 'blue',
-hubradius => 15,
-majortickinterval => 10,
-majorticklabelplace =>'outside',
-finetickinterval => 1,
-minortickinterval => 5,
-margin =>40,
-needles => [
{
-arrowshape => [ 12, 23, 6 ],
-color => 'black',
-command => undef,
-format => '%d',
-radius => 196,
-showvalue => 1,
-tag => 'null',
-title => 'null',
-titlecolor => 'white',
-titlefont =>'Helvetica-12',
-titleplace => 'south',
-variable => \$gaugevar,
-width => 5,
}
] ,
-start => 180,
-to => 100,
)->pack(-fill=>'both',-expand=>1);
##my $gaugebutton1 = $left_frame ->Button(-text => "Update", -command
+=> \&gaugebutton1_sub)->pack(-side=>'bottom'); #currently pointless.
+will leave in for possible diagnostics.
}
sub gaugebutton1_sub {
$gaugevar=($cur/$mh)*100;
}#above sub redundant(?) due to &update_output#
sub update_output {
my $beta = $betaone->get();
my $alpja = $alphaone->get();
if ($alpha eq "") { $alpha = 0; }
if ($beta eq "") { $beta = 0; }
$cur=$cur+$beta-$alpha;
if ($cur gt $mh){$cur=$mh;}
if ($cur lt 0){$cur=0;}
my $output = "Current value:\n$cur";
$output_text->delete('0.0', 'end');
$output_text->insert("end", $output);
$betaone->delete('0.0', 'end');
$alphaone->delete('0.0', 'end');
$gaugevar=($cur/$mh)*100;
}
MainLoop;
###end
If anyone has some ideas on what's wrong, I'd love to know how to fix it. I believe it can be fixed by framing the gauge within the GUI's primary window, but I'm hoping there's a solution that'll keep me from have to do that. |
Re: Tk::Gauge errors
by Khen1950fx (Canon) on Aug 06, 2012 at 04:43 UTC
|
Take a closer look at your first subroutine. Make sure that you declare your variables. So, fixed:
sub button3_sub {
my $mh = ( 35 + ( 29 - 1 ) * 6 );
my $cur = $mh;
}
As for the rest, I couldn't reproduce your problem. This
worked for me.
#!/usr/bin/perl
use strict;
use autodie;
use warnings;
use Tk;
use Tk::Table;
use Tk::Gauge;
my $mw = MainWindow->new;
$mw->geometry("75x75");
$mw->title("Gauge testing");
my $button =
$mw->Button( -text => "Null", -command => \&button3_sub )
->pack( -anchor => 'center' );
my ( $alpha, $alphaone, $beta, $betaone, $mh, $output_text, $gaugevar,
+ $cur );
sub button3_sub {
my $mh = ( 35 + ( 29 - 1 ) * 6 );
my $cur = $mh;
my $hw = $mw->Toplevel;
$hw->geometry("650x450");
$hw->title('Health Track (!!!WARNING:DO NOT EXIT THIS WINDOW UNTIL
+ DONE)');
my $hf =
$hw->Frame( -background => 'white' )
->pack( -ipadx => 250, -fill => 'both', -expand => 'yes' );
my $left_frame =
$hf->Frame( -background => 'white' )
->pack( -side => 'left', -fill => 'y' );
my $right_frame =
$hf->Frame( -background => 'white' )
->pack( -ipadx => 150, -fill => 'y', -anchor => 'n', -expand =>
+1 );
$betaone =
$left_frame->Entry( -background => "green", )->pack( -anchor =>
+'nw' );
my $beta_button =
$left_frame->Button( -text => "Alpha Null", -command => \&update
+_output )
->pack( -anchor => 'nw' );
$alphaone =
$left_frame->Entry( -background => "red", )->pack( -anchor => 'n
+w' );
my $alpha_button =
$left_frame->Button( -text => "Alpha Null", -command => \&update
+_output )
->pack( -anchor => 'nw' );
$output_text =
$left_frame->Text( -height => 5, -width => 15 )->pack( -expand =
+> 0, );
my $gauge = $right_frame->Gauge(
-background => 'white',
-bands => [
{
-piecolor => 'green',
-minimum => 50,
-maximum => 100,
-tag => 'Healthy',
},
{
-piecolor => 'yellow',
-minimum => 25,
-maximum => 50,
-tag => 'Bloodied',
},
{
-piecolor => 'red',
-minimum => 0,
-maximum => 25,
-tag => 'Critical',
}
],
-bandplace => 'underticks',
-bandstyle => 'pieslice',
-bandwidth => 0,
-caption => 'Current Value',
-captioncolor => 'black',
-extent => -180,
-from => 0,
-hubcolor => 'black',
-huboutline => 'blue',
-hubradius => 15,
-majortickinterval => 10,
-majorticklabelplace => 'outside',
-finetickinterval => 1,
-minortickinterval => 5,
-margin => 40,
-needles => [
{
-arrowshape => [ 12, 23, 6 ],
-color => 'black',
-command => undef,
-format => '%d',
-radius => 196,
-showvalue => 1,
-tag => 'null',
-title => 'null',
-titlecolor => 'white',
-titlefont => 'Helvetica-12',
-titleplace => 'south',
-variable => \$gaugevar,
-width => 5,
}
],
-start => 180,
-to => 100,
)->pack( -fill => 'both', -expand => 1 );
}
sub gaugebutton1_sub {
$gaugevar = ( $cur / $mh ) * 100;
}
sub update_output {
my $beta = $betaone->get();
my $alpja = $alphaone->get();
if ( $alpha eq "" ) { $alpha = 0; }
if ( $beta eq "" ) { $beta = 0; }
$cur = $cur + $beta - $alpha;
if ( $cur gt $mh ) { $cur = $mh; }
if ( $cur lt 0 ) { $cur = 0; }
my $output = "Current value:\n$cur";
$output_text->delete( '0.0', 'end' );
$output_text->insert( "end", $output );
$betaone->delete( '0.0', 'end' );
$alphaone->delete( '0.0', 'end' );
$gaugevar = ( $cur / $mh ) * 100;
}
MainLoop;
| [reply]
[d/l]
[select] |
|
|
Even with the fixed code you provided, I'm still getting the exact same error messages. Could it be a system-specific error? Beyond that, any ideas on how to possibly fix it? I recently compiled 5.16.0 on my computer, so if I insert 'require 5.16.0' after the Tk modules, I get an entirely different error of:
Perl v5.16.0 required--this is only v5.12.4, stopped at gaugetest2 lin
+e 10.
If I can fix that, is there a chance it'd fix the errors I'm getting? | [reply]
[d/l] |
|
|
Yes, that would fix it, chances are that one of the modules has a use v5.16.0 declaration, so anything less will crash it
--linuxkid
imrunningoutofideas.co.cc
| [reply]
[d/l] |
Re: Tk::Gauge errors
by zentara (Archbishop) on Aug 06, 2012 at 09:08 UTC
|
Hi, I see the same error as you on both versions of the script. I'm on Linux with Perl 14.2. I don't know the reason it is happening, but you can make a workaround by making your toplevel window reusable, inhibiting its Window Manager's Close icon, and packForgetting its old widgets. This works for me. ( the code could use some cleanup, but it shows the way) :-)
#!/usr/bin/perl -w
use Tk;
use Tk::Table;
use Tk::Gauge;
use strict;
use diagnostics;
my $hw; # make a reusable toplevel
my $mw = MainWindow->new;
$mw->geometry("75x75");
$mw->title("Gauge testing");
my $button = $mw->Button(-text => "Null", -command => \&button3_sub)->
+pack(-anchor=>'center');
my ($alpha,$alphaone,$beta,$betaone,$mh,$output_text,$gaugevar,$cur);
#our ($alpha,$alphaone,$beta,$betaone,$mh,$output_text,$gaugevar,$cur)
+;
sub button3_sub {
$mh= (35+(29-1)*6);
$cur=$mh;
do_Toplevel();
#my $hw = $mw -> Toplevel;
$hw ->geometry("650x450");
$hw ->title('Health Track (!!!WARNING:DO NOT EXIT THIS WINDOW UNTIL DO
+NE)');
my $hf = $hw -> Frame(-background => 'white')->pack(-ipadx => 250, -fi
+ll => 'both', -expand =>'yes');
my $left_frame = $hf -> Frame (-background=>'white')->pack(-side=>'lef
+t', -fill => 'y');
my $right_frame = $hf->Frame(-background=>'white')->pack(-ipadx=>150,
+-fill =>'y', -anchor=>'n',-expand=>1);
$betaone = $left_frame->Entry(-background => "green",)->pack(
+-anchor=>'nw');
my $beta_button = $left_frame->Button(-text => "Alpha Null", -
+command => \&update_output)->pack(-anchor=>'nw');
$alphaone = $left_frame->Entry(-background => "red",)->pack(-
+anchor=>'nw');
my $alpha_button = $left_frame->Button(-text => "Alpha Null",
+-command => \&update_output)->pack(-anchor=>'nw');
$output_text = $left_frame->Text(-height=>5,-width=>15)->pack(
+-expand=>0,);
my $gauge= $right_frame->Gauge(
-background => 'white',
-bands =>[
{
-piecolor => 'green',
-minimum=> 50,
-maximum=> 100,
-tag=> 'Healthy',
},
{
-piecolor => 'yellow',
-minimum=> 25,
-maximum=> 50,
-tag=> 'Bloodied',
},
{
-piecolor => 'red',
-minimum=> 0,
-maximum=> 25,
-tag=> 'Critical',
}
],
-bandplace => 'underticks',
-bandstyle=> 'pieslice',
-bandwidth=> 0,
-caption => 'Current Value',
-captioncolor=> 'black',
-extent => -180,
-from => 0,
-hubcolor => 'black',
-huboutline => 'blue',
-hubradius => 15,
-majortickinterval => 10,
-majorticklabelplace =>'outside',
-finetickinterval => 1,
-minortickinterval => 5,
-margin =>40,
-needles => [
{
-arrowshape => [ 12, 23, 6 ],
-color => 'black',
-command => undef,
-format => '%d',
-radius => 196,
-showvalue => 1,
-tag => 'null',
-title => 'null',
-titlecolor => 'white',
-titlefont =>'Helvetica-12',
-titleplace => 'south',
-variable => \$gaugevar,
-width => 5,
}
] ,
-start => 180,
-to => 100,
)->pack(-fill=>'both',-expand=>1);
##my $gaugebutton1 = $left_frame ->Button(-text => "Update", -command
+=> \&gaugebutton1_sub)->pack(-side=>'bottom'); #currently pointless.
+will leave in for possible diagnostics.
}
sub gaugebutton1_sub {
$gaugevar=($cur/$mh)*100;
}#above sub redundant(?) due to &update_output#
sub update_output {
my $beta = $betaone->get();
my $alpja = $alphaone->get();
if ($alpha eq "") { $alpha = 0; }
if ($beta eq "") { $beta = 0; }
$cur=$cur+$beta-$alpha;
if ($cur gt $mh){$cur=$mh;}
if ($cur lt 0){$cur=0;}
my $output = "Current value:\n$cur";
$output_text->delete('0.0', 'end');
$output_text->insert("end", $output);
$betaone->delete('0.0', 'end');
$alphaone->delete('0.0', 'end');
$gaugevar=($cur/$mh)*100;
}
MainLoop;
###end
sub do_Toplevel {
if ( !Exists( $hw ) ) {
$hw = $mw->Toplevel();
$hw->protocol('WM_DELETE_WINDOW' => sub {}); #prevent WM close
+ button working
$hw->title( "Toplevel" );
$hw->Button(
-text => "Close",
-command => sub { $hw->withdraw }
)->pack;
}
else {
#clear out old widgets
my @w = $hw->packSlaves;
foreach (@w) { $_->packForget; }
$hw->Button(
-text => "Close",
-command => sub { $hw->withdraw }
)->pack;
$hw->deiconify();
$hw->raise();
}
}
| [reply]
[d/l] |
|
|
Thank you so much zentara, from the testing I've done so far, the script changes work for me as well (although I did find out there was a typoed variable name in the process). I assume that I can extract the do_TopLevel sub and use it in places that are causing similar issues, replacing the variable names as needed?
I'll likely continue stalking this to see if someone can figure out what's causing it. To which I'll ask: is it worth sending a bug report to the module page on CPAN even though it appears to have been left to gather dust by the author?
| [reply] |
|
|
As far as reusing that sub by replacing variable names, sure, Perl is free to modify.
What I originally used it for, was I had problems with toplevels accumulating memory, even though they were being destroyed. This may be a another symptom of that.
Tk::Gauge is old, and I doubt the author, has high priorities for it. A bug report can't hurt, but a better thing would be to offer to take over the module and fix it. :-)
| [reply] |
|
|
