comment on

This tutorial presents a cool Perl/Tk mini-application that you can use and modify to fit your needs. It is simple and versatile! Consider the "sigeval.pl" script your very own "Perl Sig/OBFU Decoder Ring" and don't just read through this tutorial, download the code, run it, change it, run it again, and make it your own.

Update: Check out this code for an example of drag and drop (DND). --hiseldl

The Perl/Tk FAQ is a great source of answers for most of your questions about where to get it, how to install it, what is Tk, what widgets are available, some simple "Hello, World" scripts, answers to some common problems, some OS specific topics, and much more than I can mention here.

Download this Tutorial

The Basics
The Perl Eval-uator, Your Very Own "Perl Sig/OBFU Decoder Ring"

Why Should I Use Tk?
Acknowledgements
Further Reading

The Basics

Copy and paste this script to a file "hello.pl" and run it. This little application will give you a feel for how Tk will look and give you a taste of the structure for a Tk application.

#!/usr/local/bin/perl -w

use strict;
use Tk;

my $mw = new MainWindow;
$mw->Label(-text => 'Hello World!')->pack;
$mw->Button(-text => 'Quit',
        -command => sub{exit} )->pack;
MainLoop;
[download]

use strict; and the -w switch ensure the program is working without common errors.

use Tk; imports the Tk module, and sets up your script to use the Tk widgets.

All Tk applications start by creating the Tk main window. You then create items inside the main window, or create new windows, before starting the main loop; You can also create more items and windows while you're running. The items will be shown on the display after you pack them. Then you will start the GUI with MainLoop; which handles all events.

The basic steps:

use Tk; # this is mandatory
my $mw = new MainWindow; # create a main window
# add frames, buttons, labels, etc. and pack them.
MainLoop; # or &Tk::MainLoop();
# add your sub's for the buttons, menus, etc. to call.

Now, on to something more useful...

The Perl Eval-uator

Your Very Own "Perl Sig/OBFU Decoder Ring"

Have you ever wanted to see the output of a JAPH from someone's sig? Well, this script not only shows the basics of Perl/Tk, it is actually fun to use! I like to copy/paste the OBFU from the PerlMonks Obfuscation section, or whenever I run accross an interesting signature in a post, and I want to see what it prints out, I run my sigeval.pl script.

Update: The crux of this section is in the comments of the following code, so please read through the comments. --hiseldl

#!perl -w

# sigeval.pl

# This application demonstrates how to put a basic Perl/Tk application
# together.

use strict;
use Tk 800.000;

# These are all the modules that we are using in this script.
use Tk::Frame;
use Tk::TextUndo;
use Tk::Text;
use Tk::Scrollbar;
use Tk::Menu;
use Tk::Menubutton;
use Tk::Adjuster;
use Tk::DialogBox;

# Main Window
my $mw = new MainWindow;
$mw->geometry('400x300');

# We need to split our application into three frames:
# 1.  A widget to contain a list of files from the current directory
# 2.  A widget that we can load a text file into, or copy/paste text i
+nto
# 3.  A widget to display the output of our Perl code created by
#     'eval'ing the Perl code in the top text widget.

# Frames

# The Adjuster provides a splitter between the frames on the left and
# the right so we can resize the frames vertically
my $lf = $mw->Frame; # Left Frame;
my $aj = $mw->Adjuster(-widget => $lf, -side => 'left');
my $rf = $mw->Frame; # Right Frame;


# Menu Bar 

# This is the Tk 800.00 way to create a menu bar.  The
# menubar_menuitems() method returns an anonymous array containing all
# the information that is needed to create a menu.

my $mb = $mw->Menu(-menuitems => &menubar_menuitems() );

# The configure command tells the main window to use this menubar;
# several menubars could be created and swapped in and out, if you
# wanted to.
$mw->configure(-menu => $mb);


# Use the "Scrolled" Method to create widgets with scrollbars.

# The listbox is our filename container.
my($ListBox) = $lf->Scrolled('Listbox',
                 -height => '0',
                 -width => '0',
                 -scrollbars => 'e',
                 );

# The default key-bindings for the Text widgets and its derivatives
# TextUndo, and ROText are emacs-ish, e.g. ctrl-a cursor to beginning
# of line, ctrl-e, cursor to end of line, etc.

# The 'o' in 'osoe' means optionally, so when the widget fills up, the
# scrollbar will appear, otherwise we are binding the scrollbars to
# the 'south' side and to the 'east' side of the frame.

my($InputText) = $rf->Scrolled('TextUndo',
                   -height => '1',
                   -width => '1',
                   -scrollbars => 'osoe',
                   );

# We use the 'Text' widget here because we do not need to edit
# anything in the widget.  We could have used 'ROText' here as well
# (Read Only Text Widget).

my($OutputText) = $rf->Scrolled('Text',
                -height => '1',
                -width => '1',
                -scrollbars => 'osoe',
                );

# Load filenames into the listbox. 
opendir DIR, ".";
$ListBox->insert('end', grep { -f $_ } readdir DIR);
close DIR;

# Binding subs to events

# Every widget that is created in the Perl/Tk application either
# creates events or reacts to events.  

# Callbacks are subs that are used to react to events.  A callback is
# nothing more than a sub that is bound to a widget.

# The most common ways to bind a sub to an event are by using an
# anonymous sub with a call to your method inside it, such as in the
# following 'Key' bindings, or with a reference to the callback sub,
# as in the 'ButtonRelease' binding.

# Left mouse button loads file and eval's if .pl suffix.  See the
# OnLoad sub for more details.
$ListBox->bind('<ButtonRelease-1>', [\&OnLoad] );

# CTRL-L, eval text widget contents 
$mw->bind('Tk::TextUndo', '<Control-Key-l>',
      sub { OnEval(); } 
      );

# CTRL-O, load a text file into the text widget 
$mw->bind('Tk::TextUndo', '<Control-Key-o>',
      sub { OnFileOpen(); } 
      );

# CTRL-S, save text as with file dialog
$mw->bind('Tk::TextUndo', '<Control-Key-s>',
      sub { OnFileSave(); } 
      );

# CTRL-Q, quit this application
$mw->bind('Tk::TextUndo', '<Control-Key-q>',
      sub { OnExit(); } 
      );


# Pack everything

# IMPORTANT: if you don't pack it, it probably won't show the way you
# want it to, or even not show up at all!

# some things to try:
# 1. change the order of $lf, $aj, and $rf
# 2. add -expand 1 to ListBox
# 3. comment out this section so widgets are not packed
$lf->pack(qw/-side left -fill y/);
$aj->pack(qw/-side left -fill y/);
$rf->pack(qw/-side right -fill both -expand 1/);

$ListBox   ->pack(qw/-side left -fill both -expand 1/);
$InputText ->pack(qw/-side top -fill both -expand 1/);
$OutputText->pack(qw/-side bottom -fill both -expand 1/);

# Start the main event loop
MainLoop;

exit 0;

# return an anonymous list of lists describing the menubar menu items
sub menubar_menuitems
{
    return 
    [ map 
      ['cascade', $_->[0], -tearoff=> 0,
       -menuitems => $_->[1]],

      # make sure you put the parens here because we want to
      # evaluate and not just store a reference
      ['~File', &file_menuitems()],
      ['~Help', &help_menuitems()],
    ];
}

sub file_menuitems
{

# 'command', tells the menubar that this is not a label for a sub
# menu, but a binding to a callback; the alternate here is 'cascade'
# Try uncommenting the following code to create an 'Operations' sub
# menu in the main 'File' menu.

    return
    [
#      [qw/cascade Operations -tearoff 0 -menuitems/ =>
#       [
#        [qw/command ~Open  -accelerator Ctrl-o/,
#         -command=>[\&OnFileOpen]],
#        [qw/command ~Save  -accelerator Ctrl-s/,
#         -command=>[\&OnFileSave]],
#        ]
#      ],
     [qw/command ~Open  -accelerator Ctrl-o/,
      -command=>[\&OnFileOpen]],
     [qw/command ~Save  -accelerator Ctrl-s/,
      -command=>[\&OnFileSave]],
     '',
     [qw/command E~xit  -accelerator Ctrl-q/,
      -command=>[\&OnExit]],
     ];
}

sub help_menuitems
{
    return
    [
     ['command', 'About', -command => [\&OnAbout]]
    ];
}

# Here is our "Exit The Application" callback method. :-)
sub OnExit { 
    exit 0; 
}

# The TextUndo widget has a file load dialog box method built-in!
sub OnFileOpen {
    $InputText->FileLoadPopup(); 
}

# The TextUndo widget has a file save dialog box method built-in!
sub OnFileSave {
    $InputText->FileSaveAsPopup();
    # refresh the list box
    &LoadListBox();
}

sub LoadListBox {
    # Remove current contents otherwise we would just append the
    # filenames to the end, and this is not what we want.
    $ListBox->delete('0.1', 'end');

    # Just use a plain old grep readdir pipeline to create a list of
    # filenames for our listbox.
    opendir DIR, ".";
    $ListBox->insert('end', grep { -f $_ && -r $_ } readdir DIR);
    close DIR;
}

# Show the Help->About Dialog Box
sub OnAbout {
    # Construct the DialogBox
    my $about = $mw->DialogBox(
           -title=>"About Jack",
           -buttons=>["OK"]
           );

    # Now we need to add a Label widget so we can show some text.  The
    # DialogBox is essentially an empty frame with no widgets in it.
    # You can images, buttons, text widgets, listboxes, etc.
    $about->add('Label',
        -anchor => 'w',
        -justify => 'left',
        -text => qq(
Perl Eval-uator v1.0 by David Hisel

-Click on a filename to view it, and if it has  a 
 ".pl" suffix, it will be evaluated automatically, or
-Copy and paste Perl code to the top window, then
-Hit CTRL-L to evaluate the code and 
 display the output in the bottom text widget.
)
        )->pack;

    $about->Show();
}

# Load a file into the $InputText widget
sub OnLoad {
    # Getting the text of the selected item in a listbox is a two step
    # process, first you get the index and then, using the index,
    my ($index) = $ListBox->curselection();

    # fetch the contents from the listbox.
    my $filename = $ListBox->get($index);

    # TextUndo widget has a built-in Load sub!
    $InputText->Load( $filename  );

    # we need to make sure we don't eval ourself otherwise we crash
    (my $script = $0) =~ s,.*(\/|\\),,;

    # If it ends in ".pl" automatically eval the code
    &OnEval() if $filename =~ /\.pl$/ && $filename !~ /$script/;
}

#evaluates code in the entry text pane
sub OnEval{
    # The Text widget has a TIEHANDLE module implemented so that you
    # can tie the text widget to STDOUT for print and printf; note, if
    # you used the "Scrolled" method to create your text widget, you
    # will have to get a reference to it and pass that to "tie",
    # otherwise it won't work.
    my $widget = $OutputText->Subwidget("text");
    tie *STDOUT, ref $widget, $widget;

    # need "no strict;" otherwise we can't run obfu nor other japh's
    eval ("no strict;".$InputText->get(0.1, 'end'));

    # be polite and output an error if something goes wrong.
    print "ERROR:$@" if $@;
    print "\n";
}
[download]

Some Cool Exercises

After you run the script, copy and paste the following to the top text widget:

(tkinit)->Scrolled('TextUndo',-scrollbars=>'se')->pack;MainLoop;

To test it out hit CTRL-L and a new frame with a TextUndo widget should appear. Wait, there's more, right click on the Text area! You get a fully functional text editor!

Hold on, we're not done yet, now hit CTRL-S and save the snippet as tkedit.pl and don't forget the ".pl" suffix. Now click on the tkedit.pl in the listbox on the left!

Now this is really cool, go to PerlMonks Obfuscated Code copy and paste the non screen oriented obfu i.e. the rotating camel won't work; there's lot's of japh lying around at the monastery, and sigeval.pl is my secret decoder ring.

Why should I use Tk? Why not Win32::GUI or wxPerl?

Maturity, Tk has been ported to perl for quite some time and is fairly stable. Also, there are several applications that are already written using Perl/Tk such as PerlMonks Perl/Tk Chatterbox Client. I have written a few scripts using wxPerl, but I kept going back to Tk because there were more examples, and more documentation. Maybe when wxPerl matures and offers as much as Tk, I will reconsider using it. wxPerl is based on the wxWindows Cross Platform GUI Library, so it can be used on multiple platforms whereas Win32::GUI is based on the Win32 API, leading to my next reason...
Cross platform, Tk will run on Linux and Win32 platforms with no code changes, or, at least no changes in the Tk code. Note, however, that I haven't tested every detail of every widget under Tk on both platforms, but I have successfully used most of the widgets, and I did not have to change any code to get the scripts to run on Linux and Win2k.

Acknowledgements

Nick Ing-Simmons, who wrote Perl/Tk.
UserGuide.pod, see below. The Hello World example in this tutorial is based on the one in the "First Requirements" section.


Welcome to the Monastery
	PerlMonks