Perl/Tk menubar quirks - perl

I'm trying to add a menubar with the standard File Open, Save and New options.
However, instead of behaving as expected, the subroutine handling the open, save and new actions is launched upon creation of the frame. But, when I actually click on them, it is not.
Following is the code I'm using. (Main window contains only the menubar)
#!/usr/bin/perl
use strict;
use warnings;
use diagnostics;
use Data::Dumper;
use Tk 8.0;
use Tk::NoteBook;
use Tk::MsgBox;
my $mw=MainWindow->new;
$mw->geometry("+500+300");
# Menu Bar Buttons
my $mbar=$mw->Menu();
$mw->configure(-menu => $mbar);
my $file=$mbar->cascade(-label=>"~File", -tearoff => 0);
my $help=$mbar->cascade(-label =>"~Help", -tearoff => 0);
# File Menu
$file->command(-label =>'~New ', -command=>&menu_file('n'), -accelerator=>'Ctrl+N');
$file->command(-label =>'~Open ', -command=>&menu_file('o'), -accelerator=>'Ctrl+O');
$file->command(-label =>'~Save ', -command=>&menu_file('s'), -accelerator=>'Ctrl+S');
$file->separator();
$file->command(-label =>'~Quit ', -command=>sub{exit}, -accelerator=>'Ctrl+Q');
# Help Menu
$help->command(-label => 'Version');
$help->separator;
$help->command(-label => 'About');
# Menu Bar Accelerators
$mw->bind('<Control-n>', &menu_file('n'));
$mw->bind('<Control-o>', &menu_file('o'));
$mw->bind('<Control-s>', &menu_file('s'));
$mw->bind('<Control-q>', sub{exit});
MainLoop;
sub menu_file {
my $opt=shift;
my $filetypes = [
['Codac files', '.k'],
['All Files', '*' ],
];
if($opt eq 's'){
my $txt_ent_script = $mw->getSaveFile(-filetypes=>$filetypes, -initialfile=>'jitter', -defaultextension=>'.k');
print "Output filename: $txt_ent_script\n";
}
}

That's because &menu_file('n') is syntax for invoking a subroutine (more details). Instead, you have to do it like this:
$mw->bind('<Control-n>' => sub{menu_file('n')});
Or like this:
$mw->bind('<Control-n>' => [\&menu_file, 'n']);

Related

Perl/Curses event handling and I/O

So, I just started trying to use the perl curses module for a project I'm working on. The documentation seems to be extremely lacking, what little I can find on cpan seems to be half-finished and assumes previous curses library experience, which I don't have. I have two issues I am trying to solve, my code so far:
#!/usr/bin/perl
use strict;
use Curses::UI;
use Term::ReadKey;
my ($cols, $rows, $wp, $hp) = GetTerminalSize();
my $cui = new Curses::UI( -color_support => 1);
sub eDialog {
my $return = $cui->dialog(
-message => "Are you sure?",
-title => "Really quit?",
-buttons => ['yes', 'no']
);
exit(0) if $return;
}
sub entryUpdate {
my $mainentry = shift;
if($mainEntry->get() =~ m/.*\n$/)
{
print STDERR $mainEntry->get();
}
}
$cui->set_binding( \&eDialog , "\cQ");
my $mainWin = $cui->add(
'viewWin', 'Window',
-border => 1,
-height => ($rows - 3),
-bfg => 'green'
);
my $mainView = $mainWin->add(
"viewWid", "TextViewer",
-wrapping => 1
);
my $entryWin = $cui->add(
'entryWin', 'Window',
-border => 1,
-y => ($rows - 3),
-height => 1,
-bfg => 1
);
my $mainEntry = $entryWin->add(
"entryWid", "TextEntry",
-onchange => \&entryUpdate()
);
$mainEntry->focus();
$cui->mainloop();
I managed to get the UI set up how I want it, but actually making it work is proving problematic.
1). I want to be able to, when text is typed into the $mainEntry widget, detect when enter/return is pressed, and execute a subroutine to do stuff with the text typed into the widget, then clear it out. (I tried accomplishing this with the entryUpdate subroutine, but that isn't working at all, no matter how I've tried to do it.)
2). I want to be able to periodically (Say, every 1 second or 500ms), execute another subroutine, and have the string it returns added to the $mainView widget.
Getting either or both of these to work has proven to be a huge issue thus far, I just dont know enough about how curses works and I haven't been able to find the information I need anywhere. Any help would be much appreciated.
1) You can simply bind the return key to a subrouting using set_binding:
use Curses qw(KEY_ENTER);
$mainEntry->set_binding(sub {
$mainView->text($mainView->text . $mainEntry->get . "\n");
$mainView->draw;
$mainEntry->text("");
}, KEY_ENTER);
2) It seems that there are timer methods (found them by grepping the Curses-UI source code), but they are not documented, which is probably an issue. Here's how it's used:
$cui->set_timer('timer_name', sub {
$mainView->text($mainView->text . scalar(localtime)."\n");
$mainView->draw;
}, 1);

URI::Fetch failing when par-packed

I have a program which brings in a page for a book using HTML::TagParser and the book's barcode, grabs a certain span, repeats it for a different page, and then adds it to a TK::MListbox until chosen to export it. This works perfectly fine in Eclipse. However, once made an .exe with par-packer, the program fails to work. The error when using barcode 31412007436751 is this:
Tk::Error: URI::Fetch failed: https://i-share.carli.illinois.edu/uis/cgi-bin/shelflister.cgi?search=s1&bcs=31412007436751&bce=&stpt=1&mode=1 at script/ShelfLister_Lister.pl line 32.
Carp::croak at C:/strawberry/perl/lib/Carp.pm line 100
HTML::TagParser::fetch at HTML/TagParser.pm line 261
HTML::TagParser::new at HTML/TagParser.pm line 239
main::addBook at script/ShelfLister_Lister.pl line 32
<Key-Return>
(command bound to event)
The related program code is this:
#!/user/bin/perl
use strict;
use warnings;
use Tk;
use Tk::MListbox;
use LWP::Simple;
use URI::Fetch;
use Encode::Byte;
use HTTP::Response;
use HTML::TagParser;
use Spreadsheet::WriteExcel;
my ($callNumber, $title, $html, $numItems);
my $savetypes = [['Excel Files', '.xls'], ['Comma-Separated Files', '.csv'], ['Text Files', '.txt']];
my $mw = new MainWindow;
$mw->title("Barcode Lister");
$mw->Label(-text=>'Choose Books')->grid(-row=>1, -column=>1, -columnspan=>2, -pady=>10);
my $barcode = $mw->Entry(-width=>50)->grid(-row=>2, -column=>1, -pady=>5, -padx=>[5, 10]);
my $add = $mw->Button(-text=>'Add Record', -command=>\&addBook, -width=>15)->grid(-row=>2, -column=>2, -pady=>5);
my $listFrame = $mw->Frame(-bd=>2, -relief=>"sunken")->grid(-row=>3, -column=>1, -padx=>[5, 10], -pady=>5);
my $list = $listFrame->Scrolled(qw(MListbox -background white -scrollbars oe))->pack(-expand=>1, -fill=>"both");
$list->columnInsert('end', -text=>"Call number", -width=>23);
$list->columnInsert('end', -text=>"Title", -width=>25);
my $delete = $mw->Button(-text=>'Delete Record', -command=>\&removeBook, -width=>15)->grid(-row=>3, -column=>2, -pady=>5);
my $export = $mw->Button(-text=>'Export List', -command=>\&exportList, -width=>15)->grid(-row=>4, -column=>1, -columnspan=>2, -pady=>5);
$barcode->bind('<Return>'=>\&addBook);
$barcode->focus;
MainLoop;
sub addBook{
$html = HTML::TagParser->new('https://i-share.carli.illinois.edu/uis/cgi-bin/shelflister.cgi?search=s1&bcs=' . $barcode->get() . '&bce=&stpt=1&mode=1');
$title = $html->getElementsByClassName('listLine');
if (ref $title){
$html = HTML::TagParser->new('https://i-share.carli.illinois.edu/uis/cgi-bin/shelflister.cgi?search=s1&bcs=' . $barcode->get() . '&bce=&stpt=1&mode=2');
$list->insert("end", [$title->innerText(), $html->getElementsByClassName('listLine')->innerText()]);
$barcode->delete(0, 'end');
}
else{
$mw->messageBox(-title=>'Error', -message=>"Barcode not found.", -type=>'Ok', -icon=>'error', -default=>'ok');
}
}
Anyone have any ideas on how I could get this to work as an .exe?
Probably URI::Fetch->errstr would give more information on the failure. Either try to patch HTML::TagParser (see https://rt.cpan.org/Ticket/Display.html?id=86698) or maybe it's possible to wrap your HTML::TagParser-related code lines into an eval { } and call the errstr function yourself on errors.

Settings in pdf::table perl

I'm trying to create a table in PDF format using PDF::Table in perl.
However, it seem to not read my header/cols/rows settings.
Here's my code for the table:
use PDF::API2;
use PDF::Table;
my $pdftable = new PDF::Table;
my $pdf = PDF::API2->new();
my $page = $pdf->page;
#data
my $some_data =[
["1","1","1","1","1","1","1"],
["2","2","2","2","2","2","2"],
["2","2","2","2","2","2","2"],
["2","2","2","2","2","2","2"],
["2","2","2","2","2","2","2"],# x 100 time to have pages
];
#build the table layout
$pdftable->table(
$pdf,
$page,
$some_data,
x => 5,
w => 600,
start_y => 750,
next_y => 750,
start_h => 700,
next_h => 700,
# some optional params
font_size => 8,
border => 0,
background_color_odd => "white",
background_color_even => "lightblue",
header_props => $hdr_props, # see section HEADER ROW PROPERTIES
);
$hdr_props =
{
# This param could be a pdf core font or user specified TTF.
# See PDF::API2 FONT METHODS for more information
font => $pdf->corefont("Times", -encoding => "utf8"),
font_size => 10,
font_color => '#006666',
bg_color => 'yellow',
repeat => 1, # 1/0 eq On/Off if the header row should be repeated to every new page
};
print "Content-Type: application/pdf;\n\n";
binmode(STDOUT);
print $pdf->stringify;
It should make the first row as header by default but the output shows no header properties being set on the first row. And there is no header shown for all pages.
Any help will be appreciated.
I did not run your code.
You are referencing $hdr_props before the variable is filled. Perl does not work that way, you need to order definitions properly.
Add use strict; use warnings FATAL => 'all'; to the top of your programs and Perl will alert you about mistakes like this.
theres no warnings at all, and i followed daxim to put the $hdr_props to top first but it still would not read in the header settings.
The documentation says that header_props needs to be a hash reference, so:
header_props => \$hdr_props, # see section HEADER ROW PROPERTIES
I ran into a similar problem. However, daxim is right, you should also order your code as he suggested.

How can i repeatedly prompt the user with Tkx?

Using Perl Tkx, I want to get some input from the user, close the window, and maybe do it again later. For user input, I'm just displaying some buttons, and the user gets to click on one of them. Here's what I have now:
sub prompt_user {
my $answer;
my $mw = Tkx::widget->new("."); ## the main window is unavailable the second time
$mw->g_wm_title("Window Title"); ## line 40
$mw->g_wm_minsize(300, 200);
my $label = $mw->new_label( -text => "Question to the user?");
$label->g_pack( -padx => 10, -pady => 10);
my $button1 = $mw->new_button(
-text => "Option One",
-command => sub { $answer = 0; $mw->g_destroy; },
);
$button1->g_pack( -padx => 10, -pady => 10);
my $button2 = $mw->new_button(
-text => "Option Two",
-command => sub { $answer = 1; $mw->g_destroy; },
);
$button2->g_pack( -padx => 10, -pady => 10);
Tkx::MainLoop(); ## This blocks until the main window is killed
return $answer;
}
So the user clicks on one of the buttons, the window closes, prompt_user() returns 0 or 1 (depending on which button the user clicked), and execution continues. Until I try to prompt the user again. Then I get an error:
can't invoke "wm" command: application has been destroyed at MyFile.pm line 40
I just want a way to put up a bunch of buttons, let the user click one, wait to see which one is clicked, and maybe do it again later. Is there a way I can wait for a response to the button click without destroying the main window? Maybe create a subwindow?
I'm new to using Tkx, and googling shows lots of simple examples like the above code (using MainLoop/g_destroy), but I couldn't find any examples of recreating windows. I did see stuff about a Dialog Box or Message Box, but those won't suit my needs. I want to put text on the buttons, and use an arbitrary number of buttons (so I don't want to be limited to yes/no/cancel, and only have 3 options).
Update
Here's what I was able to use
# hide the main window, since I'm not using it
my $mw = Tkx::widget->new(".");
$mw->g_wm_withdraw();
# function to prompt the user to answer a question
# displays an arbitrary number of answers, each on its own button
sub prompt {
my $prompt = shift;
my $list_of_answers = shift;
# Note: the window name doesn't matter, as long as it's './something'
my $answer = Tkx::tk___dialog( "./mywindowpath", # window name
"Prompt", # window title
$prompt, # text to display
undef, # tk bmp library icon
undef, # default button
#$list_of_answers); # list of strings to use as buttons
return $answer;
}
# use the button to ask a question
my $index = prompt("Who was the best captain?",
[ "Kirk", "Picard", "Cisco", "Janeway", "Archer" ] );
I'm not really familiar with Tkx but Tk doesn't really work well that way. In general Tk applications are asynchronous. You should re-write your application in term of callbacks (kind of like javascript).
Basically, this kind of logic:
sub do_something {
perform_some_action();
my $result = prompt_user();
perform_some_other_action($result);
}
should be re-written to something like:
sub do_something {
perform_some_action();
prompt_user(perform_some_other_action);
}
Your program should basically not have a main loop. Instead the call to Tkx::MainLoop at the end of your program becomes the main loop and you should do all processing by handling events.
Having said that, there are some mechanisms available that emulates blocking. Read the documantation for vwait. Though, I think even that requires a running Tkx::MainLoop so it does not necessarily avoid refactoring your whole program.
On the question of how to create and destroy windows there are two solutions:
Use the main window (.) but don't destroy it at the end. Instead hide it and destroy all its children. You can then later reuse . by unhiding it.
Hide . and don't use it. Instead create other windows (toplevels) and use them. Since toplevels are children of . they are safe to destroy without screwing up Tk.

How can I close a window in Perl/Tk?

In my Perl/Tk script I have opened two windows. After a specific button click I want to close one of them. How can I do that? Here's what I have so far:
$main = new MainWindow;
$sidebar = $main->Frame(-relief => "raised",
-borderwidth => 2)
->pack (-side=>"left" ,
-anchor => "nw",
-fill => "y");
$Button1 = $sidebar -> Button (-text=>"Open\nNetlist",
-command=> \&GUI_OPEN_NETLIST)
->pack(-fill=>"x");
MainLoop;
sub GUI_OPEN_NETLIST
{
$component_dialog = new MainWindow;
$Button = $component_dialog -> Button (-text=>"Open\nNetlist",
-command=> **close new window**)
->pack(-fill=>"x");
MainLoop;
}
The simplist way is to call $component_dialog->destroy in the buttons -command callback. This has the disadvantage that if you want to redisplay the window later you have to recreate it.
The withdraw method will hide the window without destroying it so you can redisplay it later if you need to. This will save you some time when the button is pressed. The classes Dialog and DialogBox do this for you automatically when one of their buttons is pressed. If you need a window that behaves like a traditional dialog they can a much simpler option that building your own.
Also except in unusual cases you shouldn't need more than one call to MainLoop. When your callback GUI_OPEN_NETLIST returns the MainLoop will resume, explicitly calling MainLoop will likely lead to odd bugs later.
I think this is close to what your looking for, I haven't tested it though.
use strict;
use warnings;
my $main = new MainWindow;
my $sidebar = $main->Frame(-relief => "raised",
-borderwidth => 2)
->pack (-side=>"left" ,
-anchor => "nw",
-fill => "y");
my $Button1 = $sidebar -> Button (-text=>"Open\nNetlist",
-command=> \&GUI_OPEN_NETLIST)
->pack(-fill=>"x");
my $component_dialog = $main->Dialog( -buttons => [ 'Close' ], );
MainLoop;
sub GUI_OPEN_NETLIST
{
$component_dialog->Show();
}
If you don't want a dialog you should consider if you want to create a second MainWindow or create a Toplevel window dependant on your existing MainWindow.
A Toplevel will close automaticaly when it's MainWindow is closed, a second MainWindow will stay open after the other MainWindow is closed.