can'yt figure out whats wrong in this code?

[yedukondalu]

#!usr/bin/perl

use warnings;
use strict;
use Tk;
#$\="\n";

my $name;
my $age;
my $dob;

open(my $fh,'+<','details.txt') || die "Can't open the file details.tx
+t $!";

#creating a Mainwindow:
my $window = MainWindow->new();
$window->geometry('480'."x".'320');
#my $first_frame = $window -> Frame(-background => 'red' ,-foreground 
+=> 'black',)->pack(-side => 'top',-ipadx => 10,-fill => 'x', -ipady =
+> 1);
my $first_frame = $window -> Frame(-relief=>"solid")->pack(-side => 't
+op',-ipadx => 10,-fill => 'x', -ipady => 1);
$first_frame -> Label(-text => 'Fill the details listed below') ->  gr
+id(-row => 0 ,-column => 2,-rowspan => 1);

my $frame = $window -> Frame(-background => 'grey')->pack(-side => 'to
+p',-ipadx =>150,-fill => 'x',-ipady => 60);


my $name_label=$frame -> Label(-text => 'Name') -> grid(-row => 2, -co
+lumn=> 0);
my $name_entry=$frame->Entry(-background => 'white',-foreground => 'bl
+ack', -textvariable => \$name, -validate => 'focusout',-validatecomma
+nd => \&check_name)->grid(-row =>2, -column=>1);
my $age_label=$frame -> Label(-text => 'age')-> grid(-row => 4, -colum
+n=> 0);

my $age_entry = $frame -> Entry(-background => 'white',-foreground => 
+'black', -textvariable => \$age,-validate => 'focusout',-validatecomm
+and => \&check_age) -> grid(-row =>4, -column=>1);

my $dob_label=$frame -> Label(-text => 'DOB')-> grid(-row => 6, -colum
+n=> 0);


my $dob_entry = $frame -> Entry(-background => 'white',-foreground => 
+'black',-textvariable => \$dob,-validate => 'focusout',-validatecomma
+nd => \&validate_dob) ->  grid(-row =>6, -column=>1);

$name = $name_entry -> get();
$age  = $age_entry -> get();
$dob  = $dob_entry -> get();


#my $submit = $frame -> Button(-text => 'submit', -command =>sub {prin
+t " Name : $name \n Age : $age \n DOB : $dob \n"} ) -> grid(-row =>5,
+ -column=>1);
my $submit = $frame -> Button(-text => 'submit', -command =>sub {&subm
+it} ) -> grid(  -row =>8, -column=>1);
$frame -> Label(-background => 'grey') -> grid(-rowspan=> 6);
$frame -> Label(-text => 'After adding all the details click quit to e
+xit') -> grid( -row => 16, -column=> 1);
$frame -> Label(-background => 'grey') -> grid(-rowspan=> 6);
my $quit = $frame -> Button(-text => 'Quit', -command =>sub {exit} ) -
+> grid(-row =>25, -column=>1);

sub submit
{
  if((!$name) || ($name =~ m/[0-9]/) || (($age =~ m/[a-z]/i)|| (!$age)
+) || ((!$dob)|| ($dob !~ m/\d{1,2}[\/|\:]\d{1,2}[\/|\:]\d{4}/)))
  {
    $frame -> messageBox( -icon => 'info',-message => 'Fill the fileld
+s correctly', -type => 'Ok' );
  }
 else
  {
     my $line= join('   ',$name,$age,$dob);
     print $fh $line,"\n";
     if(!($?))
    {
          my $button = $frame -> messageBox( -icon => 'info',-message 
+=> 'Details added successfully to file', -type => 'Ok' );
      $name_entry->delete('0', 'end');
      $age_entry->delete('0', 'end');
      $dob_entry->delete('0', 'end');
      $name_entry->focus();
    }
    }
}
sub check_name
{
  if ((!$name) || ($name =~ m/[0-9]/))
  {
    $name_entry->messageBox( -icon => 'info',-message => 'Name should 
+not contain numeric values' ,-type => 'Ok');
     $name_entry->delete('0', 'end');
     $name_entry->focus();
  }
  else
  {
    $name_entry->checkbutton(-indicatoron);
  }
}
sub check_age
{
  if ((!$age) || ($age=~ m/[a-z]/i))
  {
    $age_entry->messageBox( -icon => 'error',-message => 'age  should 
+not contain characters' ,-type => 'Ok');
    $age_entry->delete('0','end');
    $age_entry->focus();
  }
} 

sub validate_dob
{
  if ((!$dob) || ($dob !~ m/\d{1,2}[\/|\:]\d{1,2}[\/|\:]\d{4}/))
  {
     $dob_entry->messageBox( -icon => 'error',-message => 'Enter valid
+ date' ,-type => 'Ok');
     $dob_entry->delete('0', 'end');
     $dob_entry->focus();
  }
}

When trying to validate the age the dob validation pops without calling it's subroutine.

[kcott]

G'day yedukondalu,

"can'yt figure out whats wrong in this code?"

If I could run your code, I'd take a look; however, it's clear that it will die with something like

Can't open the file details.txt No such file

so there's little point in me trying.

Please provide a cutdown version, that only contains code relevant to your problem, which we can run — see "How do I post a question effectively?" for more details about this.

Also, that's a terrible title. Consider changing it to something meaningful, perhaps: "Problem validating Tk::Entry field"

"When trying to validate the age the dob validation pops without calling it's subroutine."

I can't tell what your problem is from this description. My best guess about the first part is that "-validatecommand => \&check_age" is somehow acting as if it was coded as "-validatecommand => \&validate_dob"; however, the last part is just far too vague (what's calling who's unnamed subroutine?). Please write a description which is descriptive!

As far as I can see, none of your validation routines are reading the arguments passed to them. Please see the Tk::Entry documentation; in particular, the VALIDATION section. You may also want to look at Tk::callbacks.

Your actual validation checks are also problematic. As an example:

sub check_age
{
  if ((!$age) || ($age=~ m/[a-z]/i))
  {
    $age_entry->messageBox( -icon => 'error',-message => 'age  should 
+not contain characters' ,-type => 'Ok');
...

According to this, an age of, say, "~!@#$%^&*()_+" would be perfectly OK. I don't think so!

I'd be more than happy to help you. Help me to do so.

[Anonymous Monk]

You're changing focus and triggering focus events ... you're also popping up popups, popups are annoying :) its better to validate on key without popups, popup at most only once on submit, on all others ring the bell and flash invalid

#!/usr/bin/perl --
use strict;
use warnings;
use Tk;

my $mw = tkinit;
my $name = $mw->Entry(  -validatecommand => \&nodigits, -validate => '
+key',)->pack;
$name->focus;
#~ $mw->WidgetDump; use Tk::WidgetDump;

$mw->MainLoop;

sub nodigits {
    my( $newstring, $difference, $oldstring, $index, $insertOrDelete )
+ = @_;
    my $entry = $Tk::event->W;
    if( $newstring =~ m/\d/ ){
        $entry->bell;
        $entry->configure( -bg => 'red' );
        $entry->after( 300, sub { $entry->configure( -bg => 'white' ) 
+} );
        return undef;
    } else {
        $entry->configure( -bg => 'white' );
        return 1;
    }
}