http://qs1969.pair.com?node_id=1148859

yedukondalu has asked for the wisdom of the Perl Monks concerning the following question:

#!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.