Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses

perl/Tk Entry validation

by Anonymous Monk
on Jul 24, 2012 at 09:42 UTC ( #983341=perlquestion: print w/replies, xml ) Need Help??
Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

Dear all. I use the following code to force a default value for the entry if the input value is rejected by -validatecommand.
use strict; use Tk; my $xVConsSflEmbMax0 = 1.0; my $xVConsSflEmbMax = $xVConsSflEmbMax0; my $emb1Entry = $embCanvas->Entry( -textvariable => \$xVConsSflEmbMax, -width => 3, -validate => 'focusout', -validatecommand => sub {$_[0] =~ /^\d*\.?\d+$/}, -invalidcommand => sub {$xVConsSflEmbMax=$xVConsSflEmbMax0}, );
It works fine but only once! If the user tries to modify the entry a second time with a wrong input the validate command is ineffective. Would you have any advice to make it work? Thanks a lot

Replies are listed 'Best First'.
Re: perl/Tk Entry validation
by zentara (Archbishop) on Jul 24, 2012 at 10:14 UTC
    Would you have any advice to make it work?

    Yes, show a complete example which demonstrates the problem. It look off the top of my head, that you may have a problem in the return value from -validatecommand .... it should return a 1 or 0. Look how this works.

    #!/usr/bin/perl use strict; use warnings; use Tk; my $top = MainWindow->new(); $top->geometry('200x200'); my %entries; for(1..4){ $entries{$_}{'value'} ||= 0; $entries{$_}{'entry'} = $top->Entry( -textvariable => \$entries{$_}{'value'}, -width => 5, -bg => 'white', -validate => 'key', -vcmd => \&validate, )->pack; } MainLoop; #have to make sure empty value has numeric context sub validate{ my $val = shift; $val ||= 0; #get alphas and punctuation out if( $val !~ /^\d+$/ ){ return 0 } if (($val >= 0) and ($val <= 100)) {return 1} else{ return 0 } }

    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku ................... flash japh
      Sorry for this lack of courtesy. Posting the complete example is indeed a good practice. I'll stick to it. Based on your example I tried the following code to add the boundaries as arguments of the validate subroutine. I cannot figure out how to reference the input value in the -validatecommand. I have tried $_, $_[0] and $xVConsSflEmbMax but none seems to work...
      use strict; use Tk; my $xVConsSflEmbMax0 = 1.0; my $xVConsSflEmbMax = $xVConsSflEmbMax0; my $mw = new MainWindow(); my $entry = $mw->Entry( -textvariable => \$xVConsSflEmbMax, -width => 3, -validate => 'focusout', -validatecommand => [\&validSub,$_[0],0,1], -invalidcommand => sub {$xVConsSflEmbMax=$xVConsSflEmbMax0}, ) -> pack; MainLoop; sub validSub { my ($val,$min,$max) = @_; $val ||= 0; $min ||= -1E10; $max ||= 1E10; if( $val !~ /^\d*\.?\d+$/ ) { return 0 } elsif (($val >= $min) and ($val <= $max)) {return 1} else { return 0 } }
        As you might have noticed in the documentation or in the example above, you do not have to send any arguments to validatecommand. They are sent automatically.
Re: perl/Tk Entry validation
by choroba (Bishop) on Jul 24, 2012 at 10:12 UTC
    For some reason I cannot see at the moment, validation is turned off (probably related to this part of the documentation:
    The validateCommand will turn itself off by setting validate to none when an error occurs, for example when the validateCommand or invalidCommand encounters an error in its script while evaluating, or validateCommand does not return a valid boolean value.
    ). An easy workaround is to reset the -validate in the invalidcommand:
    #!/usr/bin/perl use warnings; use strict; use Tk; my $embCanvas = MainWindow->new; my $xVConsSflEmbMax0 = 1; my $xVConsSflEmbMax = $xVConsSflEmbMax0; my $emb1Entry = $embCanvas->Entry( -textvariable => \$xVConsSflEmbMax, -width => 3, -validate => 'focusout', -validatecommand => sub { warn "@_\n"; $_[0] =~ /^\d*\.?\d+$/ } +, -invalidcommand => \&invalid, )->pack; my $qb = $embCanvas->Button( -text => 'Quit', -command => sub { exit } )->pack; MainLoop(); sub invalid { $xVConsSflEmbMax = $xVConsSflEmbMax0; $emb1Entry->configure(-validate => 'focusout'); }

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://983341]
Front-paged by Arunbear
[smarthacker67]: hi

How do I use this? | Other CB clients
Other Users?
Others scrutinizing the Monastery: (4)
As of 2018-05-26 12:09 GMT
Find Nodes?
    Voting Booth?