Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?

Tk Tutorial, Featuring Your Very Own "Perl Sig/OBFU Decoder Ring"

by hiseldl (Priest)
on Jul 16, 2002 at 01:34 UTC ( [id://181977]=perltutorial: print w/replies, xml ) Need Help??

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 "" 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.

Table of Contents

The Basics

Copy and paste this script to a file "" 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;
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:

  1. use Tk; # this is mandatory
  2. my $mw = new MainWindow; # create a main window
  3. # add frames, buttons, labels, etc. and pack them.
  4. MainLoop; # or &Tk::MainLoop();
  5. # 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 script.

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

#!perl -w # # 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"; }

Some Cool Exercises

After you run the script, copy and paste the following to the top text widget:
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 and don't forget the ".pl" suffix. Now click on the 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 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.


  • 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.

Further Reading

  • Perl/Tk FAQ
  • UserGuide.pod is a good starting place.
  • Here are a couple books to consider looking through too:
    • "Mastering Perl/Tk" by Steve Lidie & Nancy Walsh.
    • "Advanced Perl Programming" by Sriram Srinivasan

Replies are listed 'Best First'.
Re: Tk Tutorial, Featuring Your Very Own "Perl Sig/OBFU Decoder Ring"
by atcroft (Abbot) on Jul 23, 2002 at 17:35 UTC

    I had only one concern with regards to this the tutorial.

    When I first started to read it, I read around the code (saving it for later, because of its apparent size), and my first thought was that the content I had read was rather weak (and slightly disappointing, for it is a topic I have wanted to learn more about for some time), jumping from the basics to further exercises with little in-between. Then, I noticed the abundance of comments that appeared in the code listing, and began to wonder, and started to read the code, finding there the meat of your tutorial.

    I applaude the commenting and explanations there, but would suggest that perhaps either a quick mention of what functionality is used within the code, or simply that each section of the code contains comments regarding the functions used there, so others do not dismiss it for the same reason.

    My thanks for your time in preparing this tutorial.

      atcroft, I added a note right before the code telling everyone to read the comments; thank you for pointing this out.

      I had a couple goals in mind when I wrote this:

      • Get a Tk Tutorial out there as soon as possible for my fellow monks to look at that would be useful, and
      • Add to/update the body over time as I received feedback, such as yours.
      Also, I am thinking about writing another tutorial about the layout managers pack, place, grid, and form because the layout manager is the foundation of most Tk applications, and a deeper understanding of these methods will help everyone developing Tk scripts tremendously. For instance, I didn't even know that there were 4 layout managers until recently, and after learning about them, I realized that I could have taken a different approach in laying out my widgets that would have saved me a couple hours of head-scratching. :)

      In any case, thank you again for your feedback. I will make changes over the next few weeks/months to improve the readability and the flow of this Tk Tutorial.


Re: Tk Tutorial, Featuring Your Very Own "Perl Sig/OBFU Decoder Ring"
by coec (Chaplain) on Feb 03, 2004 at 08:03 UTC
(shockme) Re: Tk Tutorial, Featuring Your Very Own "Perl Sig/OBFU Decoder Ring"
by shockme (Chaplain) on Jul 24, 2002 at 02:14 UTC
    ++. Very accurate, and for my purposes, very timely. I'm just starting to test the ptk waters, and this cleared up more than a few questions.

    Excellent stuff. Thanks!

    If things get any worse, I'll have to ask you to stop helping me.

Re: Tk Tutorial, Featuring Your Very Own "Perl Sig/OBFU Decoder Ring"
by DaWolf (Curate) on Dec 14, 2003 at 02:42 UTC
    Hi there.

    I hope you can help me. There's an extremely simple thing I just can't understand: How can I get the value typed by a user in an Entry widget???

    I've tried a very simple program that should take the user entry and put it into a file, so the code snippets would look like this:
    #This creates the widget and place it: my $Entry2 = $mw->Entry( -relief => "sunken" ); $Entry2->place( -x => 88, -y => 33, -height => 16, -width => 120); # And I have a button that calls the sub that does the trick: my $Button3 = $mw->Button( -text => "Cadastrar", -relief => "raised", -command => \&add ); $Button3->place( -x => 218, -y => 33, -height => 16, -width => 56); # The above parts works as expected, my problem lies below (notice tha +t the snippet below is, obviously, after the MainLoop): sub add { my $name = $Entry2->get(0.1, 'end'); my $file = "data.dat"; open(CLIST, "+>>$file"); flock(CLIST,2); print CLIST $name."\n"; flock(CLIST,8); close($file); }

    I just can't capture the Entry value. Please help me.

    Thanks in advance,

    my ($author_nickname, $author_email) = ("DaWolf","erabbott\") if ($author_name eq "Er Galvão Abbott");
      This should be a separate node, but here is the modifed code:
      use Tk; use strict; use warnings; my $mw = MainWindow->new(); #This creates the widget and place it: my $Entry2 = $mw->Entry( -relief => "sunken" ); #$Entry2->place( -x => 88, -y => 33, -height => 16, -width => 120); $Entry2->pack(-side=>'left'); $Entry2->focus(); # And I have a button that calls the sub that does the trick: my $Button3 = $mw->Button( -text => "Cadastrar", -relief => "raised", -command => \&add ); #$Button3->place( -x => 218, -y => 33, -height => 16, -width => 56); $Button3->pack(-side=>'right'); # The above parts works as expected, my problem lies below #(notice that the snippet below is, obviously, after the MainLoop): MainLoop(); sub add { my $name = $Entry2->get(); print "name=$name\n"; #my $file = "data.dat"; # #open(CLIST, "+>>$file"); #flock(CLIST,2); #print CLIST $name."\n"; #flock(CLIST,8); #close($file); }
Re: Tk Tutorial, Featuring Your Very Own "Perl Sig/OBFU Decoder Ring"
by Anonymous Monk on Aug 03, 2007 at 03:44 UTC
    $==$';$;||$.|$|;$_='*$(^@(%_+&~~;#~~/.~~;_);;.);;#);~~~~;_,.~~,.*+,./| +~~;_);@-,.;.);~~,./@@-__);;.);;#,.;.~~@-);;#);;;);~~,.*+,.;#);;;;#-(@ +-__);;.);;#,.;.~~@-););,./.);~~,./|,.*+,./|,.););;#;#-(@-__);;.);;#,. +;.~~@-;;,.,.*+,./@,.;.;#__;#__;;,.,.*+,./|,.;;;#-(@-__@-__,.;_);@-,.; +.,./|~~();.;#;.;;;;;;;;;.;.~~;.~~~~/@~~@-~~~~;#/|;#/|~~~~~~/@~~@-~~~~ +~~;_,.;;,.;.);,.~~;_,./|);;.,./@,./@~~~~~~*+;#-(@-__,.,.,.*+,./|,.;;~ +~()~~@-);;#);;.,.~~~~@-);-(@-__@-*+);~~,..%,.;;,.*+);~~~~@-,.*+,.,.~~ +@-~~.%,.;;~~@-,./.,./|,.;;~~@-~~.%););;#-(@-__@-*+);;.,./|,./@,.*+,./ +|,.-(~~@-,.*+,.,.~~@-~~.%,.,.~~@-,./.,./|,.;;~~@-~~.%););;#-(@-__);.% +~~/@~~@-~~~~~~;_,.(),.;_,..%,.;.~~;_~~;;;#/|~~~~~~*+;#-(@-__);@-);~~, +.*+,./|);;;~~@-~~~~;;__;;/.;.@-;;();./@,./|~~~~;#-(@-__&$#%^';$__='`' +&'&';$___="````"|"$[`$["|'`%",';$~=("$___$__-$[``$__"|"$___"|("$___$_ +_-$[.%")).("'`"|"'$["|"'#").'/.*?&([^&]*)&.*/$'.++$=.("/``"|"/$[`"|"/ +#'").(";`/[\\`\\`$__]//`;"|";$[/[\\$[\\`$__]//`;"|";#/[\\\$\\.$__]//' +").'@:=("@-","/.","~~",";#",";;",";.",",.",");","()","*+","__","-("," +/@",".%","/|",";_");@:{@:}=$%..$#:;'.('`'|"$["|'#')."/(..)(..)/".("`` +`"|"``$["|'#("').'(($:{$'.$=.'}<<'.(++$=+$=).')|($:{$'.$=.'}))/'.("`` +`;"|"``$[;"|"%'#;").("````'$__"|"%$[``"|"%&!,").${$[};`$~$__>&$=`;
    :-) (Don't run this if you have /any/ sort of brain.) -- why you should use to run JAPHs.

Log In?

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perltutorial [id://181977]
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (4)
As of 2024-07-23 14:13 GMT
Find Nodes?
    Voting Booth?

    No recent polls found

    erzuuli‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.