Do I need to put all the "functional" parts of the script in subroutines in order to be able to trigger them with Tk GUI button presses and such?

Whilst you could do it that way, as you point out, it means making extensive modifications to (presumably) already working code. It also means letting your tool (Tk) dictate the architecture of your application which is never a good thing. Especially as it would make turning the gui off for those gui-phobic *nix users very difficult.

IMO the best alternative would be to stick your TK GUI into its own thread with a queue and tie that queue to stdin & stdout.

Now you make the decision whether the enable the GUI at start up and if you do, and of your existing output to stdout goes via the queue tied to stdout and gets displayed in a listbox on the GUI. And any requests for input (Eg.my $var = <STDIN>; get fulfilled from the queue, having been source from an edit field on the gui and placed into the queue.

The main body of your code doesn't change at all. You just add:

use My::Gui;
...

if( $opts{gui} ) {
    tie *STDOUT, 'My::Gui';
    tie *STDIN, 'My::Gui';
    async( \&My::Gui::gui )->detach;
}
[download]

at the top of your program.

Whilst you could do it that way, as you point out, it means making extensive modifications to (presumably) already working code. It also means letting your tool (Tk) dictate the architecture of your application which is never a good thing. Especially as it would make turning the gui off for those gui-phobic *nix users very difficult.

Yes, the code is already working, with a thousand or so users. Indeed, I'm not too keen on the idea of rearranging the whole script into what seems to be a contorted structure to me just to accommodate Tk, hence this thread. Keeping the GUI on/off option probably wouldn't be too difficult, though. I guess I'd have something like


if ($gui) {
    require Tk;import Tk;
    # GUI stuff calling subs that do the actual operations
    MainLoop;
} else {
    # text prompts leading to calling the same subs as above
}
# SUBS
[download]



IMO the best alternative would be to stick your TK GUI into its own thread with a queue and tie that queue to stdin & stdout.

I understand the concept, but I have no idea how I would go about doing it. How complex would this job be? Much as I hate the idea of reshuffling the main script, it seems like the simpler option at this point - at least I have a pretty good idea of what it would involve. I guess I should note that I only code as a hobby, so there's a lot about perl that I don't know, and a fair bit that I'll never know. Can you describe the idea in a bit more detail and point me towards some code samples/relevant documentation pages? That'd help me decide whether it's feasible with my (lack of) skills.

How complex would this job be?

Not complex at all.

Here is a silly script that when run with no options just gets lines from the keyboard and echos them back to the screen until the use enters '!bye':

#! perl -slw
use strict;
use threads;

our $GUI //= 0;

if( $GUI ) {
    require 'MyGui.pm';
    async( \&MyGui::gui )->detach;
}

while( 1 ) {
    my $in = <STDIN>;
    exit if $in =~ '!bye';
    print $in;
}

__END__
C:\test>MyGui-t
hello
hello

goodbye
goodbye

!bye
[download]

But if you add the option to the command line C:\test>MyGui-t -GUI, it fetches lines from a Tk gui and echos the results to that gui instead.

The MyGui.pm module looks like this:

package MyGuiStdin;
our @ISA = qw[ Thread::Queue ];

sub TIEHANDLE { bless $_[1], $_[0]; }
sub READLINE { $_[0]->dequeue(); }

package MyGuiStdout;
our @ISA = qw[ Thread::Queue ];

sub TIEHANDLE { bless $_[1], $_[0]; }
sub PRINT { $_[0]->enqueue( $_[1] ); }

package MyGui;
use strict;
use warnings;
use threads;
use Thread::Queue;

my $Qin = new Thread::Queue;
my $Qout = new Thread::Queue;

tie *STDIN, 'MyGuiStdin', $Qin;
tie *STDOUT, 'MyGuiStdout', $Qout;

sub gui {
    require Tk;

    my $mw = Tk::MainWindow->new;
    my $lb = $mw->Listbox( -width => 80, -height => 24 )->pack;
    my $ef = $mw->Entry( -width => 70, -takefocus => 1 )->pack( -side 
+=> 'left' );
    my $enter = sub {
                $Qin->enqueue( $ef->get );
                $ef->delete(0, 'end' );
                1;
    };
    my $do = $mw->Button( -text => 'go', -command => $enter)->pack( -a
+fter => $ef );
    $mw->repeat(
        100, sub {
            $lb->insert( 'end', $Qout->dequeue ) while $Qout->pending;
            $lb->see( 'end' );
        }
    );
    $mw->bind( '<Return>', $enter );
    $ef->focus( -force );

    Tk::MainLoop();
}

1;
[download]

And that's it. Add three lines to the top of your existing program and put the module somewhere it will be found and you are done.

This is what the gui looks like doing the exact same entry sequence as shown for the non-gui session above just before hitting enter to quit the program.

---

With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'

Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.

"Science is about questioning the status quo. Questioning authority".

In the absence of evidence, opinion is indistinguishable from prejudice.

The start of some sanity?

BTW. Remember that with the gui I posted, you could (for example) check for what was printed and instead of simply displaying it in the listbox, decide to convert a text prompt into a bunch of buttons or a dialog that allows the user to answer the prompt without having to type complex material, and then send the information back to the <STDIN> requests as if he had typed it out in full.

The gui I posted is just the simplest working example I could come up with.

---

With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'

Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.

"Science is about questioning the status quo. Questioning authority".

In the absence of evidence, opinion is indistinguishable from prejudice.

The start of some sanity?

Here is an updated version that looks for two specific prompts coming from STDOUT and popping up a dialog to deal with them. The implementations of those dialogs is crude --no validation; minimalistic gui; my Tk is pretty simplistic -- but they are a demonstration only. You can enhance to your hearts desire.

Again, the simplistic command line app:

#! perl -slw
use strict;
use threads;

our $GUI //= 0;

if( $GUI ) {
    require 'MyGui.pm';
    async( \&MyGui::gui )->detach;
}

while( 1 ) {
    printf 'Enter three, 2-digit numbers: ';
    my $in = scalar <STDIN>;
    exit if $in =~ '!bye';
    print 'You entered: ', $in;

    printf 'Enter a date and time: ';
    $in = scalar <STDIN>;
    exit if $in =~ '!bye';
    print 'You entered: ', $in;
}
[download]

Updated: Improved the code below a little.

And the gui module to service it it when the -GUI command line option is supplied:

package MyGuiStdin;
our @ISA = qw[ Thread::Queue ];

sub TIEHANDLE { bless $_[1], $_[0]; }
sub READLINE { $_[0]->dequeue(); }

package MyGuiStdout;
our @ISA = qw[ Thread::Queue ];

sub TIEHANDLE { bless $_[1], $_[0]; }
sub PRINT  { $_[0]->enqueue( join ' ', @_[ 1 .. $#_ ] ); }
sub PRINTF { $_[0]->enqueue( sprintf $_[1], @_[ 2 .. $#_ ] ); }

package MyGui;
use strict;
use warnings;
use threads;
use Thread::Queue;

my $Qin  = new Thread::Queue;
my $Qout = new Thread::Queue;

tie *STDIN,  'MyGuiStdin',  $Qin;
tie *STDOUT, 'MyGuiStdout', $Qout;


sub gui {
    require Tk;
    require Tk::DialogBox;

    my $mw = Tk::MainWindow->new;
    my $lb = $mw->Listbox( -width => 80, -height => 24 )->pack;
    my $ef = $mw->Entry( -width => 70, -takefocus => 1 )->pack( -side 
+=> 'left' );

    my $enter = sub {
        $Qin->enqueue( $ef->get );
        $ef->delete(0, 'end' );
        1;
    };

    my $do = $mw->Button( -text => 'go', -command => $enter)->pack( -a
+fter => $ef );
    $mw->bind( '<Return>', $enter );
    $ef->focus( -force );

    my $doStdout = sub {
        if( $Qout->pending ) {
            my $output = $Qout->dequeue;
            $lb->insert( 'end', $output ) ;
            $lb->see( 'end' );

            if( $output eq 'Enter three, 2-digit numbers: ' ) {
                my $db = $mw->DialogBox( -title => 'Three 2 digit numb
+ers', -buttons => [ 'Ok' ] );

                my $e1 = $db->add( 'Entry', -width => 3 )->pack( -side
+ => 'left' );
                my $e2 = $db->add( 'Entry', -width => 3 )->pack( -side
+ => 'left', -after => $e1 );
                my $e3 = $db->add( 'Entry', -width => 3 )->pack( -side
+ => 'left', -after => $e2 );

                $e1->focus( -force );
                $db->Show;
                my $input = sprintf "%2d %2d %2d", $e1->get, $e2->get,
+ $e3->get;

                $Qin->enqueue( $input );
            }
            elsif( $output eq 'Enter a date and time: ' ) {
                my $db = $mw->DialogBox( -title => 'Date&time', -butto
+ns => [ 'Ok' ] );

                my $day = $db->add( 'Entry', -width => 2 )->pack( -sid
+e => 'left' );
                my $mon = $db->add( 'Entry', -width => 2 )->pack( -sid
+e => 'left', -after => $day );
                my $year= $db->add( 'Entry', -width => 4 )->pack( -sid
+e => 'left', -after => $mon );

                my $hours = $db->add( 'Entry', -width => 3 )->pack( -s
+ide => 'left' );
                my $mins  = $db->add( 'Entry', -width => 3 )->pack( -s
+ide => 'left', -after => $hours );
                my $secs  = $db->add( 'Entry', -width => 3 )->pack( -s
+ide => 'left', -after => $mins );

                $day->focus( -force );
                $db->Show;
                my $input = sprintf "%2d/%02d/%02d %2d:%02d:%02d",
                    $day->get, $mon->get, $year->get, $hours->get, $mi
+ns->get, $secs->get;

                $Qin->enqueue( $input );
            }
        }
    };

    $mw->repeat( 500, $doStdout );

    Tk::MainLoop();
}

1;
[download]

---

With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'

Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.

"Science is about questioning the status quo. Questioning authority".

In the absence of evidence, opinion is indistinguishable from prejudice.

The start of some sanity?

What you are looking for is packForget and it's associate methods. You can pack a window with widgets, packforget all or some of the widgets so they are removed from the screen, reconfigure the widgets, then repack them. A simple example:

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

my $top = new MainWindow;

my @counts = ('a'..'z');
my %cbuttons;

my $frame = $top->Frame()->pack();

setup_page();


$top->Button(-text => "packForget",
          -command => sub{
               my @w = $frame->packSlaves;
              foreach (@w) { $_->packForget; }
         })->pack();


$top->Button(-text => "repack",
          -command => sub{ &setup_page  })->pack();

$top->Button(-text => "Exit",
         -command => sub {exit})->pack;

MainLoop;
             

sub setup_page{
for (1..4){

 my $text = shift @counts;
  $cbuttons{$_}{'cb'} = $frame->Checkbutton(
    -text     => $text,
    -variable => \$cbuttons{$_}{'val'},
    -command  => \&SetState,
   )->pack;
  }
}
[download]

Thanks.
O'Reilly writes that "packForget makes it look like the widget disappears. The widget is not destroyed, but it is no longer managed by pack. The widget is removed from the packing order, so if it were repacked later, it would appear at the end of the packing order."
Based on that, I assume that packForget comes into play when one wants to "hide" a widget that may be needed later on. When you want to get rid of a widget, frame or window once and for all on a buttonpress, you'd add $thingie-> 'destroy' to the command sub of the button... Right?

"packForget makes it look like the widget disappears. The widget is not destroyed, but it is no longer managed by pack. The widget is removed from the packing order, so if it were repacked later, it would appear at the end of the packing order."

Yes, but you are missing the point as to how to use packForget. The widgets are NOT destroyed, that is true, but what you want to do is reconfigure your widgets in the withdrawn state, then reuse the same widget. Destroying and creating/destroying alot of widgets MAY give your program what looks like a memory leak, as widgets with positive ref counts, don't get destroyed. Its an often discussed problem. So reuse your widgets. The widgets are unmapped with packForget, then you use configure on them to reconfigure them with new data, then repack them. Widgets can be reused/recycled.

---

I'm not really a human, but I play one on earth.
Old Perl Programmer Haiku ................... flash japh

Agreeing fully with BrowserUK’s previous comments on this (I think...), I would definitely suggest first of all that you leave the existing application completely alone, and that you build-out a graphic interface that knows how to talk to it. In particular, I would design the system with three fundamental working parts:

1. The existing (“legacy”) application, now running as a child process, entirely untouched.
2. An application or thread whose job it is to monitor the state of the existing-application process, to receive prompts from its STDOUT, and to supply inputs to its STDIN.   This “shepherd process” always knows the present “state” of that application, and can generate notifications when that application moves from one “state” to another.   A typical design for the shepherd process is a Finite-State Machine (FSM), or more likely, two FSMs.
3. A GUI front-end process, which receives notifications from the “shepherd” and which sends information and instructions to it (to be subsequently relayed by the shepherd to the legacy application in some appropriate fashion and at some appropriate near-future time).   Build this in Perl/TK or in whatever else may suit you.   (Could it, for example, be a web/CGI application, thereby shoving the user-interface issues off to a web browser?   Sure, it could, if you wanted.)

• Tk::Wizard - GUI for step-by-step interactive logical process
• Tk::ProgressBar - A graphical progress bar
• Tk::ProgressBarPlus - A graphical progress bar
• Tk::ProgressIndicator - Another, simpler ProgressBar

A progress bar widget would do little to help solve my code structure problem.
Tk::Wizard sounds interesting, but it's difficult to tell if it would allow me to use a code structure I'm more comfortable with. I can't tell much about how it works from the CPAN page, to be honest.

I posted a similar question way back in 2005 and got some great answers.

Update:

Fixed Link D'Oh!I had a typo in my node link. I had [id:/1234] instead of [id://1234].

Your link points to a super search with zero hits, and I can't find your thread either. Can you post the correct direct link to the thread?
Edit: Thanks. (BTW, I eventually found the thread anyway.)