my problem is that the subroutine from "-browsecmd" is called twice, when a user clicks on an entry. It activates when the left mouse button is pressed and when it is released. Is it possible to tell "-browsecmd" to only activate once?
Here is an example script that demonstrates my problem. Whenever a user clicks on an entry the print function is called twice.
#!/usr/bin/perl
use strict;
use warnings;
use English qw( -no_match_vars );
use Tk;
use Tk::Tree;
my $mw = MainWindow->new();
my $tree = $mw->Tree(
-width => '25',
-browsecmd => \sub {
my ($numbers) = #ARG;
print $numbers. "\n";
}
);
foreach (qw(one two three four five six )) {
$tree->add( $ARG, -text => $ARG ); #populates the tree
}
$tree->pack();
MainLoop();
Thanks for reading my message.
EDIT1: Forgot to post the link to the Tk::Tree Documentation
There's way to get rid of that behavior:
my $tree = $mw->Tree(
-width => '25',
-selectmode => "single", # <= this makes it work
-browsecmd => \sub {
my ($numbers) = #ARG;
print $numbers. "\n";
}
);
Found this by browsing the doc for the parent widget: Tk::HList (the BINDINGS section is interesting).
I've poked around and found that the Tk::Tree is really a Tix Tree under the hood. Digging around further finds a tutorial with the following snippet (adapted very slightly):
Example: “my browsecmd gets called twice”
tixScrolledListBox .list -browsecmd Browse
proc Browse args {
if {[tixEvent type] ne "<ButtonRelease-1>"} {
puts "browsing [tixEvent value]"
}
}
That looks highly relevant, but I don't see how tixEvent has been mapped into Perl. You might need to ask the Perl/Tk maintainer directly (or file a bug report).
Related
I have a perl script utilizing cgi where I have 2 radio buttons "uptime" and "localtime". When the submit button is selected I am looking to display the unix command uptime if the uptime radio button is selected and the perl function localtime if the "localtime" radio button is selected.
Below is what I have:
#!/usr/bin/env perl
use strict;
use warnings;
use CGI qw/:standard/;
my $loctime = localtime;
my $utime = qx( /usr/bin/uptime );
my $q = new CGI;
print $q->header;
print $q->start_html(-title => 'A time select');
print $q->radio_group(
-name => 'timeselect',
-values => ['uptime', 'localtime'],
-default => 'uptime',
-columns => 2,
-rows => 1,
);
print $q->submit(
-name => 'submit_form',
-value => 'Submit',
);
I am assuming I need a subroutine or something along those lines that executes when the Submit button is clicked. Something like below
sub time_select {
if (radio_button = uptime)
{
print $utime
}
else
{
print $loctime
}
I am not sure how to pass in what radio button is selected into my subroutine. Still new to perl and CGI so any help is appreciated
You should read up on CGI and fetching params, it has a few different methods for fetching params you will be interested in from very simple to advanced, also a few things you need to be aware of if this is going to be used in any production type environment. https://metacpan.org/pod/CGI
When you create a new CGI object ( my $q = new CGI; ) it will build a list of parameters passed to it. To access the parameters you can call the param method on your CGI object.
Something simple like:
if ($q->param('timeselect')) {
my $value = $q->param('timeselect');
if ( $value eq 'localtime' ) {
print localtime;
} elsif ( $value eq 'uptime' ) {
print `/usr/bin/uptime`;
}
}
Will work fine for you, personally I would get rid of your uptime and localtime variables at the top to avoid them being called when there is no params passed.
Also another quick note on comparisons. When comparing strings you want to use eq and when comparing numbers you want to use ==.
Take care.
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;
}
If you read about cmpthese in the Perl Benchmark module's documentation, it states that cmpthese or timethese can be used with code in either text or subroutine references. The documentation seems to imply these forms are completely interchangeable:
# Use Perl code in strings...
timethese($count, {
'Name1' => '...code1...',
'Name2' => '...code2...',
});
# ... or use subroutine references.
timethese($count, {
'Name1' => sub { ...code1... },
'Name2' => sub { ...code2... },
});
I am having difficulties with passed parameters with the string form versus subroutine references form with cmpthese. Either the values in #array do not get passed or I have a run-time error.
I have the following code:
#!/usr/bin/perl
use strict; use warnings;
use Benchmark qw(:all);
my #array = qw( first second third );
sub target {
my $str = $_[0];
print "str=$str\n";
}
sub control {
print "control: array[0]=$array[0]\n";
}
my $sub_ref=\⌖
my $control_ref=\&control;
print "\n\n\n";
# ERROR: array does not get passed...
cmpthese(1, {
'target text' => 'target(#array)',
'control 1' => 'control()',
});
# This is OK...
cmpthese(1, {
'sub code ref' => sub { target(#array) },
'control 2' => sub { control() },
});
# This is OK too...
cmpthese(1, {
'target sub' => sub { $sub_ref->(#array) },
'control 3' => sub { $control_ref->() },
});
# fixed paramenters work:
cmpthese(1, {
'target text fixed' => 'target("one", "two", "three")',
'control 4' => 'control()',
});
# Run time error...
cmpthese(1, {
'text code ref' => '$sub_ref->(#array)',
'control 5' => '$control_ref->()',
});
All the forms I have work correctly with eval so I think this may be an issue with Benchmark? I have used all my google foo to try and find some documented difference between the two forms but I cannot.
Does anyone know the reason that my simple examples above do not seem to work as expected? The comments in the code indicate the problems I am having on OS X, Perl 5.10.0.
The text passed to cmpthese and timethese gets propogated to an eval statement deep in the bowels of Benchmark. Unless the arguments in the text are literals or global variables, they won't be in scope by the time they are evaluated, and you get a run-time error.
Use the anonymous sub version of the arguments to provide lexical closure for your arguments and all will be well.
I haven't looked in too much detail at this, but my guess is that when Benchmark evals the strings into code, the lexical variable #array is not in scope. Things would probably work if you made #array an our variable.
But in general, I find it is easier just to use code refs.
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;
Let's say I have a Perl file in which there are parts I need to run only when I'm called as a script. I remember reading sometime back about including those parts in a main() method and doing a
main() unless(<some condition which tests if I'm being used as a module>);
But I forgot what the condition was. Searching Google hasn't turned out anything fruitful. Can someone point out the right place to look for this?
If the file is invoked as a script, there will be no caller so you can use:
main() unless caller;
See brian d foy's explanation.
#!/usr/bin/perl
use strict;
use warnings;
main() unless caller;
sub main {
my $obj = MyClass->new;
$obj->hello;
}
package MyClass;
use strict;
use warnings;
sub new { bless {} => shift };
sub hello { print "Hello World\n" }
no warnings 'void';
"MyClass"
Output:
C:\Temp> perl MyClass.pm
Hello World
Using from another script:
C:\Temp\> cat mytest.pl
#!/usr/bin/perl
use strict;
use warnings;
use MyClass;
my $obj = MyClass->new;
$obj->hello;
Output:
C:\Temp> mytest.pl
Hello World
I call these things "modulinos" originally in my Scripts as Modules article for The Perl Journal (now Dr. Dobbs). Google that term and you get the right resources. Sinan already linked to my development sources for one of my books where I talk about it. You might also like How a Script Becomes a Module.
Better to not do this, and instead take a structured approach like MooseX::Runnable.
Your class will look like:
class Get::Me::Data with (MooseX::Runnable, MooseX::Getopt) {
has 'dsn' => (
is => 'ro',
isa => 'Str',
documentation => 'Database to connect to',
);
has 'database' => (
is => 'ro',
traits => ['NoGetopt'],
lazy_build => 1,
);
method _build_database {
Database->connect($self->dsn);
}
method get_data(Str $for_person){
return $database->search({ person => $for_person });
}
method run(Str $for_person?) {
if(!$defined $for_person){
print "Type the person you are looking for: ";
$for_person = <>;
chomp $for_person;
}
my #data = $self->get_data($for_person);
if(!#data){
say "No data found for $for_person";
return 1;
}
for my $data (#data){
say $data->format;
}
return 0;
}
}
Now you have a class that can be used inside your program easily:
my $finder = Get::Me::Data->new( database => $dbh );
$finder->get_data('jrockway');
Inside an interactive script that is bigger than just the "run" method above:
...
my $finder = Get::Me::Data->new( dsn => 'person_database' );
$finder->run('jrockway') and die 'Failure'; # and because "0" is success
say "All done with Get::Me::Data.";
...
If you just want to do this standalone, you can say:
$ mx-run Get::Me::Data --help
Usage: mx-run ... [arguments]
--dsn Database to connect to
$ mx-run Get::Me::Data --dsn person_database
Type the person you are looking for: jrockway
<data>
$ mx-run Get::Me::Data --dsn person_database jrockway
<data>
Notice how little code you wrote, and how flexible the resulting class is. "main if !caller" is nice, but why bother when you can do better?
(BTW, MX::Runnable has plugins; so you can easily increase the amount of debugging output you see, restart your app when the code changes, make the app persistent, run it in the profiler, etc.)