Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

perl tk get user input

by vinoth.ree (Monsignor)
on Jul 04, 2019 at 06:05 UTC ( [id://11102390]=perlquestion: print w/replies, xml ) Need Help??

vinoth.ree has asked for the wisdom of the Perl Monks concerning the following question:

Hi,

I am writing a small perl script to process files, so for each file I should get some kind of input from user to further processing. So I have written a foreach loop and processing each file, to get the input from user i have written perl tk code. but after taking the input from user, its not processing further. I am doing doing destroy in okbutton.

sub okbutton(){ $repo_path = $path_entry ; print($repo_path ); my $mbox_error=''; if ( not $repo_path ){ $mbox_error =$mw->messageBox(-icon=>'error', -title=>'Error on Repository Path', -message=>"Error: Repository path s +hould not be empty." ); return (""); } if (! -d "$repo_path"){ $mbox_error =$mw->messageBox(-icon=>'error', -title=>'Error on Repository Path', -message=>"Error: Repository path i +s not a valid path." ); return (""); } $mw->destroy if Tk::Exists($mw); } foreach my $each_file (@files){ ..... ..... { $mw = MainWindow->new; $mw->geometry("400x120"); $mw->title("CI Generation"); #-----------------Frames-----------------------# my $main_frame = $mw->Frame()->pack( -side => 'top', - fill => 'x +' ); my $top_frame = $mw->Frame( -background => 'light green' )->pack( -side => 'to +p', -fill => 'x' ); my $left_frame = $mw->Frame( -background => 'white' )->pack( -side => 'top', -f +ill => 'x' ); $top_frame->Label( -text => "Copy generated *.[ch] files to host repository", #-background => 'cyan' ) ->pack( -side => 'top' ); $left_frame->Label( -text => "Enter host repository path:", -background => 'yellow' )->pack( -side => 'top', -fill => 'x' ); my $entry = $left_frame->Entry( -textvariable => \$path_entry, -width => 50)->pack( -side => 'top', -fill => 'x' ); my $buttons = $left_frame->Frame()->pack(-side => 'bottom', -fill=>'both', - +expand=> 0); my $executeButton= $buttons->Button( -text => "Continue", -command => \&okbutton, -width => 20, -height => 2, -underline => 11 )->pack(-side => "left"); my $exitButton = $buttons->Button( -text => "Cancel", -command => sub { exit 1; }, -width => 20, -height => 2, -underline => 11 )->pack(-side => "right"); MainLoop; } }

All is well. I learn by answering your questions...

Replies are listed 'Best First'.
Re: perl tk get user input
by GrandFather (Saint) on Jul 04, 2019 at 12:08 UTC

    I've refactored your code to use strictures and get rid of various global variables. The window variable and file path get passed into the OK dialog as closures instead of using global variables. The code now works as I understand you would like.

    use strict; use warnings; use Tk; my @files = 1 .. 10; for my $file (@files){ { my $mw = MainWindow->new; $mw->geometry("400x120"); $mw->title("CI Generation"); #-----------------Frames-----------------------# my $main_frame = $mw->Frame()->pack( -side => 'top', - fill => 'x +' ); my $top_frame = $mw->Frame( -background => 'light green' )->pack( -side => 'to +p', -fill => 'x' ); my $left_frame = $mw->Frame( -background => 'white' )->pack( -side => 'top', -f +ill => 'x' ); $top_frame->Label( -text => "Copy generated *.[ch] files to host repository", )->pack( -side => 'top' ); $left_frame->Label( -text => "Enter host repository path:", -background => 'yellow' )->pack( -side => 'top', -fill => 'x' ); my $pathEntry = "path/$file"; my $entry = $left_frame->Entry( -textvariable => \$pathEntry, -width => 50)->pack( -side => 'top', -fill => 'x' ); my $buttons = $left_frame->Frame()->pack(-side => 'bottom', -fill=>'both', - +expand=> 0); my $executeButton= $buttons->Button( -text => "Continue", -command => sub{okbutton($mw, $pathEntry)}, -width => 20, -height => 2, -underline => 11 )->pack(-side => "left"); my $exitButton = $buttons->Button( -text => "Cancel", -command => sub { exit 1; }, -width => 20, -height => 2, -underline => 11 )->pack(-side => "right"); MainLoop; } } sub okbutton{ my ($mw, $pathEntry) = @_; print $pathEntry; if (!$pathEntry) { $mw->messageBox( -icon=>'error', -title=>'Error on Repository Path', -message=>"Error: Repository path should not be empty." ); return ""; } if ($pathEntry !~ /[1245679]/) { $mw->messageBox( -icon=>'error', -title=>'Error on Repository Path', -message=>"Error: Repository path can not include 3, 8 or +0." ); return ""; } $mw->destroy if Tk::Exists($mw); }

    Note that I've altered the OK dialog file tests a little to make the code testable without needing a file system.

    Optimising for fewest key strokes only makes sense transmitting to Pluto or beyond
Re: perl tk get user input
by Corion (Patriarch) on Jul 04, 2019 at 08:52 UTC

    Maybe not using MainLoop at all works? See tk close window and the replies, which suggest that using $dialog->Show() works for showing a dialog.

      But, I am able to destroy the window, but the control is not coming back to the calling function.


      All is well. I learn by answering your questions...

        Maybe you are properly leaving the MainLoop, but Tk does not want to restart it? I don't know. I think the better approach is to not start the MainLoop at all.

Re: perl tk get user input
by BillKSmith (Monsignor) on Jul 04, 2019 at 14:43 UTC
    It appears that you are developing a sequential program that uses Tk only to request file names. GrandFather's example proves that this is possible. You probably see this as a compromise which gives your user some of the advantage of Tk, while sparing you the difficulty of developing a full GUI application. I suspect that it will fall short of your users' expectations, and still be more difficult than you expect. I recommend that you either replace the Tk with a prompt module (e.g. IO::Prompt::Hooked) or you commit to a full GUI application.
    Bill
Re: perl tk get user input
by Anonymous Monk on Jul 04, 2019 at 07:12 UTC

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others meditating upon the Monastery: (7)
As of 2024-04-23 15:09 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found