Error Handling Using Perl Tkx - perl

I am working on a Perl Tkx application and I am having trouble getting useful/correct error messages. I am attempting to use croak so it will tell me exactly where it fails, but every time it croaks it just says the error is located "at C:/Perl64/lib/Tkx.pm line 347."
I have written a very simple script to demonstrate what is happening:
#!/usr/bin/perl
use strict;
use warnings;
use Carp;
use Tkx;
my $mw = Tkx::widget->new(".");
my $b = $mw->new_button(
-text => "Hello, world",
-command => sub { croak; },
);
$b->g_pack;
Tkx::MainLoop();
When I run this script and click the button I get the following popup box:
How can I make Tkx handle errors similar to using croak in a regular Perl script? is there a way to force croak to print to STDOUT or STDERR?
EDIT:
Michael Carman brings up a good point that generally with a GUI the console will be suppressed and the user will never see an error sent to STDOUT or STDERR, but what about finding a way to modify the text in the "Application Error" dialogue box to say something useful? Is that possible?
The text doesn't necessarily have to be useful to the end user, but should at least be understandable by the programmer so they know where to look for the issue when it is reported by the end user.
EDIT2:
Okay it appears that using die or confess instead of croak prints a more useful error message to the "Application Error" window, but once I click "OK" the program just continues and doesn't actually die. How can I "kill it until it's dead" and make sure it stays dead?
POSSIBLE SOLUTION:
Here is a possible solution built off of Michael Carman's response. I modified it slightly because I think a messageBox looks a little bit nicer :)
#!/usr/bin/perl
use strict;
use warnings;
use Tkx;
use Carp;
my $mw = Tkx::widget->new(".");
my $b = $mw->new_button(
-text => "Hello, world",
-command => sub { die "uh-oh"; },
);
$b->g_pack;
Tkx::eval(<<'EOT');
proc bgerror {message} {
tk_messageBox -title "Application Error" -message $message -icon error -type ok
destroy .
}
EOT
Tkx::MainLoop();
So far this is the best solution but 5 days still remain in the bounty so keep those answers coming!

croak reports errors from the perspective of the caller. Use die to report errors from the perspective of your code.
croak is typically used when writing modules so that you can report problems in the way your code is used. (e.g. for argument validation) GUI programming is sort of a mirror image of this. Instead of writing a library for someone else to use, you're injecting your code into a library that was written by someone else. When you pass a code reference to -command the caller becomes Tkx, so it's better to report any errors from the perspective of your code.
Tkx catches fatal errors in callbacks and reports them via the "Application Error" dialog you're seeing. It's not uncommon for GUI applications to be disconnected from the console, meaning that STDOUT and STDERR are closed and any messages written to them are lost. Without the dialog your application would simply vanish and the user would have no clue as to why.
e.g.
use Tkx;
my $mw = Tkx::widget->new(".");
my $b = $mw->new_button(
-text => "Hello, world",
-command => sub { die "uh-oh" },
);
$b->g_pack;
Tkx::MainLoop();
When I run this (and press the button) the dialog message is
uh-oh at c:\temp\foo.pl line 9.
If you need full control over how Tk handles errors you can override the default handler. The catch is that you have to do it in Tcl. Here's a minimal version to create a dialog with the error message and exit the application when it's closed.
Tkx::eval(<<'EOT');
proc bgerror {message} {
tk_dialog .error "Error" $message [] 0 Close
destroy .
}
EOT

The following scripts prints the error message to STDOUT:
use strict;
use warnings;
use Carp;
use Tkx;
my $mw = Tkx::widget->new(".");
my $b = $mw->new_button(
-text => "Hello, world",
-command => \&error_test,
);
$b->g_pack;
Tkx::MainLoop();
sub error_test {
eval {
confess;
};
print "$#\n";
}
Output:
at ./p.pl line 20.
eval {...} called at ./p.pl line 19
main::error_test() called at /home/hakon/perl5/lib/perl5/Tkx.pm line 347
eval {...} called at /home/hakon/perl5/lib/perl5/Tkx.pm line 347
Tkx::i::DoOneEvent(0) called at /home/hakon/perl5/lib/perl5/Tkx.pm line 56
Tkx::MainLoop() called at ./p.pl line 16
Edit
The following could be used to print the error message to a text field of the Tk GUI:
use strict;
use warnings;
use Carp;
use Tkx;
my $mw = Tkx::widget->new(".");
my $b = $mw->new_button(
-text => "Hello, world",
-command => \&error_test,
);
$b->g_grid(-column => 0, -row => 0);
my $text = $mw->new_tk__text(-width => 100, -height => 30);
$text->g_grid(-column => 0, -row => 1);
Tkx::MainLoop();
sub error_test {
eval {
confess;
};
print "$#\n";
$text->insert("end", "$#\n");
}
Edit
To destroy the window after error message has been shown, you could use:
use strict;
use warnings;
use Carp;
use Tkx;
my $mw = Tkx::widget->new(".");
my $b = $mw->new_button(
-text => "Hello, world",
-command => \&error_test,
);
$b->g_pack;
Tkx::MainLoop();
sub error_test {
eval {
confess;
};
Tkx::tk___messageBox(-message => "$#");
$mw->g_destroy;
}

Related

log4perl run from within another package not firing messages sent through email

I'm seeing behavior that I can't explain when using log4perl to send a message by email.
So the following test script works just fine and an email is sent without problems:
#!/usr/bin/perl
use strict;
use warnings;
use Log::Log4perl qw(:easy);
use Log::Dispatch;
my $appender_email = Log::Log4perl::Appender->new(
"Log::Dispatch::Email::SSMTP",
threshold => "INFO",
to => 'myemail#mail.com',
subject => 'Perl script message'
);
my $email_logger = get_logger();
$email_logger->level($INFO);
$email_logger->add_appender($appender_email);
$email_logger->info('hi');
The Log::Dispatch::Email::SSMTP is a module I wrote to send emails using the ssmtp command.
The weirdness begins when this same exact code is moved to another package in another file in the same directory as my original script. When I do that and use that package from within my original script, no email gets sent and there are no errors thrown.
However, if I change:
Log::Dispatch::Email::SSMTP
to
Log::Log4perl::Appender::Screen
It prints out "hi" to the screen just fine when I run my script.
So if log4perl works when sending the message to the screen, why doesn't it work when trying to send an email? And why does the same code fire an email from within the original script and not from a package? Again, there are no errors getting thrown or any kind of indication that something went wrong. And I have verified that my module gets loaded with print statements. So my module's code is definitely getting loaded but the email is still not firing.
UPDATE
Here is the code when it's not working per request in comments.
maillog.pl
#!/usr/bin/perl
BEGIN { unshift #INC, "/home/steve/perl/perl-lib" }
use strict;
use warnings;
use Testy;
print 'start' . "\n";
Here is the Testy.pm package:
package Testy;
BEGIN { unshift #INC, "/home/steve/perl/perl-lib" }
use strict;
use warnings;
use Log::Log4perl qw(:easy);
use Log::Dispatch;
print 'end' . "\n";
my $appender_email = Log::Log4perl::Appender->new(
"Log::Dispatch::Email::SSMTP",
#"Log::Log4perl::Appender::Screen",
threshold => "INFO",
to => 'myemail#mail.com',
subject => 'Perl script message'
);
my $email_logger = get_logger();
$email_logger->level($INFO);
$email_logger->add_appender($appender_email);
$email_logger->info('hi');
1;
And here is my SSMTP module located in /home/steve/perl/perl-lib/Log/Dispatch/Email/SSMTP:
package Log::Dispatch::Email::SSMTP;
use strict;
use warnings;
use Log::Dispatch::Email;
use Data::Dumper;
use base qw( Log::Dispatch::Email );
print "hi, i'm here!\n";
sub send_email {
my $self = shift;
my %p = #_;
my $to = escape ( join ',', #{$self->{to}} );
my $subject = $self->{subject};
my $message = $p{message};
$message =~ s/'/'\\''/g;
print $to . "\n";
print $subject . "\n";
print $message . "\n";
print "I'm working!";
system("echo 'To: $to\nFrom: \'Me\' <myemail\#gmail.com>\nSubject:$subject\n\n$message' | /usr/sbin/ssmtp $to");
}
sub escape {
my $address = shift;
$address =~ s/#/\\#/g;
return $address;
}
1;
When I run ./maillog.pl no email is sent when using the code in the Testy package (the same code works when in maillog.pl file. However, if I uncomment Log::Dispatch::Email::SSMTP and replace with Log::Log4perl::Appender::Screen it works.
UPDATE #2
If I change Log::Log4perl::Appender::Screen to Log::Dispatch::Screen it works as well. So maybe come kind of bug in Log::Dispatch::Email?
Found the problem with some help from the FAQ at click here
Apparently, there is some buffering going on so emails do not get sent out immediately until some threshold for the number of messages generated is reached. Though it's still a mystery to me as to why emails are sent immediately when the code is in the main package.
So here is the code that works with the buffered property set to 0:
my $appender_email = Log::Log4perl::Appender->new(
"Log::Dispatch::Email::SSMTP",
threshold => "INFO",
to => 'me#mymail.com',
buffered => 0,
subject => 'Perl script message'
);

Perl Devel::StackTrace reverse order of frames

I am trying to use the Perl module Devel::StackTrace to display errors with stack trace, the frames are showed bottom to top of the source of the error, is there a way to reverse this order to display the error source frame at the top because this is the first thing you need to know then follow tracing if needed to the bottom.
Below is the test code to reproduce the issue.
#!/usr/bin/perl
#!C:\perl\bin\perl.exe
BEGIN {
$|=1;
use CGI::Carp qw(fatalsToBrowser set_message);
use Devel::StackTrace;
use Devel::StackTrace::AsHTML;
use PadWalker;
use Devel::StackTrace::WithLexicals;
sub handle_errors {
my $msg = shift;
#my $trace = Devel::StackTrace->new(indent => 1, message => $msg);
my $trace = Devel::StackTrace::WithLexicals->new(indent => 1, message => $msg);
#print $trace->as_html;
print $trace->as_string;
}
set_message(\&handle_errors);
}
show_error();
exit;
Below is the text format error message:
Undefined subroutine &main::show_error called at C:/apache/htdocs/tests/test.cgi line 24.
at C:\apache\htdocs\tests\test.cgi line 17
main::handle_errors('Undefined subroutine &main::show_error called at C:/apache/htdocs/tests/test.cgi line 24.^J') called at C:\perl\site\lib\CGI\Carp.pm line 525
eval {...} at C:\perl\site\lib\CGI\Carp.pm line 524
CGI::Carp::fatalsToBrowser('Undefined subroutine &main::show_error called at C:/apache/htdocs/tests/test.cgi line 24.^J') called at C:\perl\site\lib\CGI\Carp.pm line 444
CGI::Carp::die('Undefined subroutine &main::show_error called at C:/apache/htdocs/tests/test.cgi line 24.^J') called at C:\apache\htdocs\tests\test.cgi line 24
After looking at the module Devel::StackTrace source code, I was able to answer my question.
The module has the method frames where it returns or sets the frames. So I reversed the order simply by this line before calling the as_string or as_html methods:
$trace->frames(reverse $trace->frames);
Here is the modified code with the solution:
#!/usr/bin/perl
#!C:\perl\bin\perl.exe
BEGIN {
$|=1;
use CGI::Carp qw(fatalsToBrowser set_message);
use Devel::StackTrace;
use Devel::StackTrace::AsHTML;
use PadWalker;
use Devel::StackTrace::WithLexicals;
sub handle_errors {
my $msg = shift;
my $trace = Devel::StackTrace->new(indent => 1, message => "$msg\n");
#my $trace = Devel::StackTrace::WithLexicals->new(indent => 1, message => $msg);
$trace->frames(reverse $trace->frames);
#print $trace->as_html;
print $trace->as_string;
}
set_message(\&handle_errors);
}
show_error();
exit;
It does exactly what I want.

Handling unicode directory and filenames in Perl on Windows

I have an encoding problem with Perl and Windows. On a Windows 7 running Perl (strawberry 5.16) and a simple TK GUI I need to open files and/or access directories with non-english characters in their name/path. For opening files I've come out with this solution which seems to work fine:
#!/usr/bin/perl -w
use strict;
use warnings;
use Win32::Unicode::File;
use Encode;
use Tk;
my $mw = Tk::MainWindow->new;
my $tissue_but = $mw->Button(
-text => 'Open file',
-command => [ \&select_unicode_file ],
);
$tissue_but->grid( -row => 3, -column => 1 );
Tk::MainLoop();
sub select_unicode_file{
my $types = [ ['Txt', '.txt'],
['All Files', '*'],];
my $input_file= $mw->getOpenFile(-filetypes => $types);
my $fh = Win32::Unicode::File->new;
if ($fh->open('<', $input_file)){
while (my $line = $fh->readline()){
print "\n$line\n";
}
close $fh;
}
else{
print "Couldn't open file: $!\n";
}
}
This correctly opens files such as Поиск/Поиск.txt
What I CANNOT do is to simply get a directory path and than process it. I think I should use use Win32::Unicode::Dir but I really can't understand the documentation.
It should be something like this:
#!/usr/bin/perl -w
use strict;
use warnings;
use Win32::Unicode::Dir;
use Encode;
use Tk;
my $mw = Tk::MainWindow->new;
my $tissue_but = $mw->Button(
-text => 'Open file',
-command => [ \&select_unicode_directory ],
);
$tissue_but->grid( -row => 3, -column => 1 );
Tk::MainLoop();
sub select_unicode_directory{
my $dir = $mw->chooseDirectory( );
my $wdir = Win32::Unicode::Dir->new;
my $dir = $wdir->open($dir) || die $wdir->error;
my $dir_complete = "$dir/a.txt";
open (MYFILE, $dir_complete );
while (<MYFILE>) {
chomp;
print "$_\n";
}
close (MYFILE);
}
There is a logical error in:
my $dir = $wdir->open($dir) || die $wdir->error;
my $dir_complete = "$dir/a.txt";
$wdir->open('path') returns an object, not a string. You can't use it like a path. But that is not the worst of it. Sadly, it seems like the Tk implementation does not yet have support for Unicode file names (including chooseDirectory). I guess you will have to write a custom dir selector, but I'm not sure it's even possible.
This is capable of listing files in an ascii-chars folder (and ->fetch can list utf-8 files), and crashes when opening a folder with utf-8 chars. Well, to be fair it crashes when opening ??????.
use strict;
use warnings;
use Win32::Unicode::Dir;
use Win32::Unicode::Console;
use Encode;
use Tk;
my $mw = Tk::MainWindow->new;
my $tissue_but = $mw->Button(
-text => 'Select dir',
-command => [ \&select_unicode_directory ],
);
$tissue_but->grid( -row => 3, -column => 1 );
Tk::MainLoop();
sub select_unicode_directory {
my $wdir = Win32::Unicode::Dir->new;
my $selected = $mw->chooseDirectory(-parent =>$mw);
# http://search.cpan.org/dist/Tk/pod/chooseDirectory.pod#CAVEATS
$selected = encode("utf-8", $selected);
print "selected: $selected\n";
$wdir->open($selected) || die $wdir->error;
print "\$mw->chooseDirectory: $selected\n";
print "\$wdir->open(\$selected): $wdir\n";
# CRASH HERE, presumably because winders can't handle '?' in a file (dir) name
for ($wdir->fetch) {
# http://search.cpan.org/~xaicron/Win32-Unicode-0.38/lib/Win32/Unicode/Dir.pm
next if /^\.{1,2}$/;
my $path = "$selected/$_";
if (file_type('f', $path)) { print "file: $path\n"; }
elsif (file_type('d', $path)) { print " dir: $path\n"; }
}
print "closing \n";
$wdir->close || die $wdir->error;
}
Sample out (opening Поиск/):
Both samples below were run using: Strawberry Perl 5.12.3 built for MSWin32-x64-multi-thread
selected: C:/cygwin/home/jaroslav/tmp/so/perl/open-file-tk/?????
$mw->chooseDirectory: C:/cygwin/home/jaroslav/tmp/so/perl/open-file-tk/?????
$wdir->open($selected): Win32::Unicode::Dir=HASH(0x2e38158)
>>> perl crash <<<
Sample out (opening parent of Поиск):
selected: C:/cygwin/home/jaroslav/tmp/so/perl/open-file-tk
$mw->chooseDirectory: C:/cygwin/home/jaroslav/tmp/so/perl/open-file-tk
$wdir->open($selected): Win32::Unicode::Dir=HASH(0x2b92c10)
file: C:/cygwin/home/jaroslav/tmp/so/perl/open-file-tk/.select_uni_dir.pl.swp
file: C:/cygwin/home/jaroslav/tmp/so/perl/open-file-tk/o
file: C:/cygwin/home/jaroslav/tmp/so/perl/open-file-tk/o.dir
file: C:/cygwin/home/jaroslav/tmp/so/perl/open-file-tk/select_uni_dir.pl
file: C:/cygwin/home/jaroslav/tmp/so/perl/open-file-tk/select_uni_file.pl
dir: C:/cygwin/home/jaroslav/tmp/so/perl/open-file-tk/Поиск
Conclusion
The Tk dir selector returns ????? instead of Поиск. While looking for a way to enable Unicode in Tk, I found this:
http://search.cpan.org/dist/Tk/pod/UserGuide.pod#Perl/Tk_and_Unicode :
(...) Unfortunately, there are still places in Perl ignorant of
Unicode. One of these places are filenames. Consequently, the file selectors
in Perl/Tk do not handle encoding of filenames properly. Currently they
suppose that filenames are in iso-8859-1 encoding, at least on Unix systems.
As soon as Perl has a concept of filename encodings, then Perl/Tk will also
implement such schemes.
So at first glance it seems what you're trying to do is impossible (unless you
write or find a custom dir-selector). Actually, it may not be a bad idea to
submit this bug, because the GUI did show "Поиск" so the error is in the return value.

Can I get a handle to - source?

It looks like there is a symbol in main called '_<-' (without the quotes) in the same fashion as the other things that look like they could be handles: '_</usr/perl/lib/Carp.pm', for example.
Is there some way to use it?
Or would I have to use a source filter if I hope to read the input source?
In reply to mob: I don't know where Debug would be getting turned on. After I dump out the base table, a dump of %INC shows:
$VAR1 = {
'warnings/register.pm' => 'C:/strawberry/perl/lib/warnings/register.pm',
'XSLoader.pm' => 'C:/strawberry/perl/lib/XSLoader.pm',
'English.pm' => 'C:/strawberry/perl/lib/English.pm',
'Tie/Hash/NamedCapture.pm' => 'C:/strawberry/perl/lib/Tie/Hash/NamedCapture.pm',
'unicore/lib/Perl/_PerlIDS.pl' => 'C:/strawberry/perl/lib/unicore/lib/Perl/_PerlIDS.pl',
'unicore/Heavy.pl' => 'C:/strawberry/perl/lib/unicore/Heavy.pl',
'warnings.pm' => 'C:/strawberry/perl/lib/warnings.pm',
'utf8.pm' => 'C:/strawberry/perl/lib/utf8.pm',
'Config.pm' => 'C:/strawberry/perl/lib/Config.pm',
'overloading.pm' => 'C:/strawberry/perl/lib/overloading.pm',
'Symbol.pm' => 'C:/strawberry/perl/lib/Symbol.pm',
'Carp.pm' => 'C:/strawberry/perl/lib/Carp.pm',
'bytes.pm' => 'C:/strawberry/perl/lib/bytes.pm',
'Exporter/Heavy.pm' => 'C:/strawberry/perl/lib/Exporter/Heavy.pm',
'utf8_heavy.pl' => 'C:/strawberry/perl/lib/utf8_heavy.pl',
'strict.pm' => 'C:/strawberry/perl/lib/strict.pm',
'Exporter.pm' => 'C:/strawberry/perl/lib/Exporter.pm',
'vars.pm' => 'C:/strawberry/perl/lib/vars.pm',
'constant.pm' => 'C:/strawberry/perl/lib/constant.pm',
'Errno.pm' => 'C:/strawberry/perl/lib/Errno.pm',
'overload.pm' => 'C:/strawberry/perl/lib/overload.pm',
'Data/Dumper.pm' => 'C:/strawberry/perl/lib/Data/Dumper.pm'
};
Or would I have to use a source filter if I hope to read the input source?
If the source file has an __END__ or __DATA__ tag, then the DATA filehandle is available. ...that in and of itself is boring. What's interesting is that you can seek to position 0, and that will take you to the top of the source file:
use Carp;
print "Just another Perl hacker,\n";
eval {
no warnings qw/unopened/;
seek DATA, 0, 0
or croak "Script lacking __END__ or __DATA__ tag has no DATA filehandle.";
};
if( !$# ) {
while(<DATA>){
print;
}
}
else {
carp $#;
}
__END__
This script will execute (printing 'Just another Perl hacker,'), and then will finish up by printing its own source.
In the code above, if the eval block does trap an exception, the fallback could be to use FindBin and $0, open the source file, and then read it. Putting it all together, here's how it looks:
BEGIN {
use Carp;
sub read_source {
my $source;
local $/ = undef;
eval {
no warnings qw( unopened );
my $DATA_position = tell DATA;
croak "'tell DATA' failed: Probably no __END__ or __DATA__ segment."
if $DATA_position < 0;
seek DATA, 0, 0
or croak
"'seek DATA' failed: Probably no __END__ or __DATA__ segment.";
$source = <DATA>;
seek DATA, $DATA_position, 0 or croak # Must leave *DATA usable.
"seek to reset DATA filehandle failed after read.";
};
if ($#) {
croak $# if $# =~ /reset/; # Unstable state: Shouldn't be possible.
eval {
require FindBin;
no warnings 'once';
open my $source_fh, $FindBin::Bin . '/' . $0 or croak $!;
$source = <$source_fh>;
};
croak "Couldn't read source file from *DATA or \$0: $#" if $#;
}
return $source;
}
};
print read_source(), "\n";
This snippet first tries to read from DATA, which eliminates the need to load FindBin and open a new file handle. If that fails, then it tries the FindBin approach. If both fail, it throws an exception. The final successful state slurps the entire source file into $source_code. The DATA handle will also be restored to the same state it was in before calling this snippet.
That should robustly handle the question of how to read the source file without resorting to a source filter.
You are seeing this in the perl debugger? That is likely where those symbol table entries come from: see the DATA STRUCTURES MAINTAINED BY CORE section of the perldoc in your perl5db.pl file.
The only way I can see to get the _<- entry in the symbol table is to start perl with just the -d switch and then enter a Perl program into standard input, e.g.:
$ perl -d
Loading DB routines from perl5db.pl version 1.32
Editor support available.
Enter h or `h h' for help, or `man perldebug' for more help.
print "Hello world\n";
<Ctrl-D>
main::(-:1): print "Hello world\n";
DB<1>
From here, #{"_<-"} (or #{$main::{"_<-"}}) contains your input, ${"_<-"} or ${$main::{"_<-"}} contains the "name" of your file (just -), and %{"_<-"}/%{$main::{"_<-"}} holds information about breakpoints and actions for stepping through code from the standard input.
Without strict refs, you could also view this data with something like
DB<6> $name="_<-"
DB<7> p ${$name}
-
DB<8> p #{$name}
BEGIN { require 'perl5db.pl' };
print "Hello world\n";
DB<9> p %{$name}
There is no filehandle associated with the symbol table entry for _<- (or for any other _<... symbols).

Print raw data when using the Curses development kit (Cdk)

My perl program needs to jump between ncurses and a raw console as it executes a system call in a loop, like this (simplified for problem emphasis):
init Cdk
present menu
deinit Cdk
run system call
Unfortunately Cdk appears to initialize ncurses at the use Cdk import and not instantiation
(Cdk::init()) and so I don't know how to disable it. This behavior seems completely absurd to me; apart from the loop described above, my program also has a special mode where a database is initialized - this part does not present any kind of menu (only raw console output) yet it would seem that I now have to format all my output with menus - whilst not even using a menu! And again, just to print the program help output now seems to require me to generate a Cdk widget - insane.
Is there a way to easily jump in and out of ncurses when using Cdk or am I screwed?
Some example code:
#!/usr/bin/perl
use Cdk;
eval {popupLabel(["popup before init"]);}; # will fail as init() isn't called
print "Test after use\n"; # won't be printed (which is a problem!)
Cdk::init();
print "Test after init\n"; # won't be printed
popupLabel(["popup after init"]);
Cdk::end();
print "Test after end\n"; # won't be printed
The following (which uses the newer Curses module) seems to do what you want: bits of Curses, and bits of non-Curses intermingled:
use strict;
use warnings;
use Curses;
# Non-Curses
print "Press a key...\n";
<STDIN>;
# Curses
initscr();
addstr(14, 0, "hit a key: ");
refresh();
my $ch = getch();
endwin();
# Non-Curses
print "Hi again, press a key...\n";
<STDIN>;
# Curses again
initscr();
addstr(14, 0, "hit another key: ");
refresh();
my $ch2 = getch();
endwin();
# Non-Curses
print "bye!\n";
At least this module was released this January and not (like Cdk, released 1998) last century...
Well, I got what I wanted, scrapping Cdk for Curses::UI. Thanks mfontani for posting an answer!
Here's my example solution which uses Curses::UI and Curses::UI::Listbox:
#!/usr/bin/perl
use Curses::UI;
use Curses::UI::Listbox;
my $cui = Curses::UI->new(-color_support => 1,
-clear_on_exit => 0);
my $win = $cui->add('window_id', 'Window');
sub user_select {
my ($cui, $obj) = #_;
my $item = $obj->get_active_value();
$cui->leave_curses();
print "You selected $item!\n";
sleep(1);
}
my $listbox = $win->add(
'mylistbox', 'Listbox',
-onchange => sub{ user_select($cui, #_) },
-border => 1,
-values => [1, 2, 3],
-labels => { 1 => 'One',
2 => 'Two',
3 => 'Three' },
);
$listbox->focus();
$cui->mainloop;