Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

Tk Date::Entry

by reaper9187 (Scribe)
on Jan 20, 2013 at 09:38 UTC ( #1014268=perlquestion: print w/ replies, xml ) Need Help??
reaper9187 has asked for the wisdom of the Perl Monks concerning the following question:

Hello wise monks,
I need some help with a code.. i'm trying to implement a calendar using Tk::Date Entry but for some reason i am not able to return the result back to the calling function: Here is the code
use Tk; use Tk::DateEntry; my $tl = MainWindow->new(); my $frame = $tl->Frame()->pack(-side=>'left'); my $lab = $frame->Label(-text=>"From")->pack(-side=>'left'); my $ent = $frame->Entry()->pack(-side=>'left'); my $frame1 = $tl->Frame()->pack(-side=>'right'); my $lab1 = $frame1->Label(-text=>"To ")->pack(-side=>'right +'); my $ent1 = $frame1->Entry()->pack(-side=>'right'); my $textarea = $tl -> Frame(); my $text = $textarea -> Text(-width=>170 , -height=>30, -font=> "Couri +er 9 bold", -wrap =>'none'); my $srl_y = $textarea -> Scrollbar(-orient=>'v',-command=>[yview => $t +ext]); my $srl_x = $textarea -> Scrollbar(-orient=>'h',-command=>[xview => $t +ext]); $text -> configure(-yscrollcommand=>['set', $srl_y], -xscrollcommand=>['set',$srl_x]); $text -> grid(-row=>3,-column=>1); $srl_y -> grid(-row=>3,-column=>2,-sticky=>"ns"); $srl_x -> grid(-row=>4,-column=>1,-sticky=>"ew"); $textarea -> grid(-row=>3,-column=>1,-columnspan=>2); #Geometry Management $lab -> grid(-row=>0,-column=>0); $ent -> grid(-row=>0,-column=>1); $frame -> grid(-row=>0,-column=>1,-columnspan=>2); $lab1 -> grid(-row=>1,-column=>0); $ent1 -> grid(-row=>1,-column=>1); $frame1 -> grid(-row=>1,-column=>1,-columnspan=>2); my $push_button1 = sub { print "Hello"; }; my $push_button2 = sub { my $out = calendar(); print $out; #return value here }; my $but1 = $tl->Button( -text => 'Enter', -command => $push_button1 + ); my $but2 = $tl->Button( -text => 'Enter', -command => $push_button2 + ); my $but3 = $tl->Button( -text => 'Generate Reports', -command => $p +ush_button2 ); $but1 -> grid(-row=>0,-column=>2); $but2 -> grid(-row=>1,-column=>2); $but3 -> grid(-row=>2,-column=>2); MainLoop; sub calendar { %idx_for_mon = ( JAN=>1, FEB=>2, MAR=>3, APR=> 4, MAY=> 5, JUN=> 6, JUL=>7, AUG=>8, SEP=>9, OCT=>10, NOV=>11, DEC=>12 ); $input = '01-JAN-2013'; # Initial value for display $mw = MainWindow->new(); $mw->geometry( '200x80' ); $mw->resizable( 0, 0 ); $entry = $mw->DateEntry( -textvariable=>\$input, -width=>11, -parsecmd=>\&parse, -formatcmd=>\&format )->pack; $mw->Button( -text=>'Cancel', -command=>sub{ $mw->destroy; } )->pack( +-side=>'right' ); $mw->Button( -text=>'OK', -command=>sub{ convert( $input ); } )->pack( -side=>'left' ); # called on dropdown with content of \$textvariable, must return ( $yr +, $mon, $day ) sub parse { ( $day, $mon, $yr ) = split '-', $_[0]; return ( $yr, $idx_for_mon{$mon}, $day ); } # called on user selection with ($yr, $mon, $day), must return formatt +ed string sub format { ( $yr, $mon, $day ) = @_; %mon_for_idx = reverse %idx_for_mon; return sprintf( "%02d-%s-%2d", $day, $mon_for_idx{ $mon }, $yr ); } # perform the conversion to epoch seconds when the corresponding butto +n is pressed sub convert { ( $input) = @_; ( $yr, $mon, $day ) = parse( $input ); $output = "$day-$mon-$yr"; return $output; } }
I need to use it for further processing.. I believe its related to scope of variable and i'm a newbie to perl, so cant figure it out.. please help ..

Comment on Tk Date::Entry
Download Code
Re: Tk Date::Entry
by zentara (Archbishop) on Jan 20, 2013 at 10:08 UTC
    I believe its related to scope of variable and i'm a newbie to perl, so cant figure it out..

    As a newbie, you should be using

    use warnings; use strict;
    Also, you should not be using a second mainwindow to pop your calendar, use a toplevel window instead. I'm not going to fix your messed up code, but to get the date back into your entry, use a -textvariable in the entry options.

    This will return the output of the calendar to the second entry widget, but I would not say the rest of the code is OK, but it works,

    #!/usr/bin/perl use warnings; #use strict; use Tk; use Tk::DateEntry; my $tl = MainWindow->new(); my $frame = $tl->Frame()->pack(-side=>'left'); my $lab = $frame->Label(-text=>"From")->pack(-side=>'left'); my $ent1_var = 1111111; my $ent = $frame->Entry(-textvariable => \$ent1_var)->pack(- +side=>'left'); my $frame1 = $tl->Frame()->pack(-side=>'right'); my $lab1 = $frame1->Label(-text=>"To ")->pack(-side=>'right +'); my $ent2_var = 2222222; my $ent1 = $frame1->Entry(-textvariable => \$ent2_var)->pack +(-side=>'right'); my $textarea = $tl -> Frame(); my $text = $textarea -> Text(-width=>170 , -height=>30, -font=> "Couri +er 9 bold", -wrap =>'none'); my $srl_y = $textarea -> Scrollbar(-orient=>'v',-command=>[yview => $t +ext]); my $srl_x = $textarea -> Scrollbar(-orient=>'h',-command=>[xview => $t +ext]); $text -> configure(-yscrollcommand=>['set', $srl_y], -xscrollcommand=>['set',$srl_x]); $text -> grid(-row=>3,-column=>1); $srl_y -> grid(-row=>3,-column=>2,-sticky=>"ns"); $srl_x -> grid(-row=>4,-column=>1,-sticky=>"ew"); $textarea -> grid(-row=>3,-column=>1,-columnspan=>2); #Geometry Management $lab -> grid(-row=>0,-column=>0); $ent -> grid(-row=>0,-column=>1); $frame -> grid(-row=>0,-column=>1,-columnspan=>2); $lab1 -> grid(-row=>1,-column=>0); $ent1 -> grid(-row=>1,-column=>1); $frame1 -> grid(-row=>1,-column=>1,-columnspan=>2); my $push_button1 = sub { print "Hello"; }; my $push_button2 = sub { my $out = calendar(); # print "$out\n"; #return value here }; my $but1 = $tl->Button( -text => 'Enter', -command => $push_button1 + ); my $but2 = $tl->Button( -text => 'Enter', -command => $push_button2 + ); my $but3 = $tl->Button( -text => 'Generate Reports', -command => $p +ush_button2 ); $but1 -> grid(-row=>0,-column=>2); $but2 -> grid(-row=>1,-column=>2); $but3 -> grid(-row=>2,-column=>2); MainLoop; sub calendar { %idx_for_mon = ( JAN=>1, FEB=>2, MAR=>3, APR=> 4, MAY=> 5, JUN=> 6, JUL=>7, AUG=>8, SEP=>9, OCT=>10, NOV=>11, DEC=>12 ); $input = '01-JAN-2013'; # Initial value for display $mw = MainWindow->new(); $mw->geometry( '200x80' ); $mw->resizable( 0, 0 ); $entry = $mw->DateEntry( -textvariable=>\$input, -width=>11, -parsecmd=>\&parse, -formatcmd=>\&format )->pack; $mw->Button( -text=>'Cancel', -command=>sub{ $mw->destroy; } )->pack( +-side=>'right' ); $mw->Button( -text=>'OK', -command=>sub{ convert( $input ); } )->pack( -side=>'left' ); # called on dropdown with content of \$textvariable, must return ( $yr +, $mon, $day ) sub parse { ( $day, $mon, $yr ) = split '-', $_[0]; return ( $yr, $idx_for_mon{$mon}, $day ); } # called on user selection with ($yr, $mon, $day), must return formatt +ed string sub format { ( $yr, $mon, $day ) = @_; %mon_for_idx = reverse %idx_for_mon; return sprintf( "%02d-%s-%2d", $day, $mon_for_idx{ $mon }, $yr ); } # perform the conversion to epoch seconds when the corresponding butto +n is pressed sub convert { ( $input) = @_; ( $yr, $mon, $day ) = parse( $input ); print "convert\n"; $output = "$day-$mon-$yr"; $ent2_var = $output; #return $output; } }

    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku ................... flash japh
Re: Tk Date::Entry
by Anonymous Monk on Jan 20, 2013 at 10:16 UTC

    I need to use it for further processing.. I believe its related to scope of variable and i'm a newbie to perl, so cant figure it out.. please help ..

    Why don't you use the scope helpers strict/warnings?

Re: Tk Date::Entry
by reaper9187 (Scribe) on Jan 20, 2013 at 10:16 UTC
    Thank you zentara for the help and suggestions.!!

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1014268]
Approved by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others exploiting the Monastery: (4)
As of 2014-07-26 04:33 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (175 votes), past polls