perl - 我可以将带参数的子例程存储在哈希中吗？

Question

我正在 perl/tk 中构建一个项目，该项目将允许启动计时器来跟踪项目工作。我已经停止了如何将按钮的命令存储为子例程但带有参数。由于带参数的子程序正在执行，因此结果将存储为命令。

如何将带有参数的子例程存储在哈希中，以便仅在按下按钮时才执行它。

#create buttons but dont pack them on the frame yet
my $info    = $mw->Button( -text => "Good",   -command => \&info_popup );
my $warning = $mw->Button( -text => "Caution", -command => \&warning_popup );
my $error   = $mw->Button( -text => "Bad",   -command => \&error_popup );
my $close   = $mw->Button( -text => "Close",   -command => \&close );
my $project1 = $mw->Button( -text => "project1", -command => \&start_timer("project1"));
my $project2 = $mw->Button( -text => "project2", -command => \&start_timer("project2"));

sub start_timer {
    my $project = shift;
    print "starting the timer for: $project\n";
}

我怀疑我正在尝试的事情是不可能的，因此希望获得有关如何实现符合此标准的解决方案的帮助，即按下按钮将调用具有该按钮的特定参数的子例程。

Answer 1

使用 TK 时，oreilly pocket 指南显示

Perl/Tk Callbacks A callback is a scalar, either a code reference or a method name as a string. Either of these styles can take parameters by passing an array reference, with the first element the code reference or method name, and subsequent elements subroutine parameters. \&subroutine [\&subroutine ?, args?] sub {...} [sub {...} ?, args?] ’methodName’ [’methodName’ ?, args?] Note that bind callbacks are implicitly passed the bound widget reference as the first argument of the parameter list. Refer to the section Bindings and Virtual Events for related information.

我使用下面的代码对此进行了测试，它按预期工作

#create buttons but dont pack them on the frame yet
my $info    = $mw->Button( -text => "Good",   -command => \&info_popup );
my $warning = $mw->Button( -text => "Caution", -command => \&warning_popup );
my $error   = $mw->Button( -text => "Bad",   -command => \&error_popup );
my $close   = $mw->Button( -text => "Close",   -command => \&close );
my $project1 = $mw->Button( -text => "project1", -command => [\&start_timer,"project1"]);
my $project2 = $mw->Button( -text => "project2", -command => [\&start_timer,"project2"]);

sub start_timer {
    my $project = shift;
    print "starting the timer for: $project\n";
}