Perl Tk:：日期-按周切换

我正在编写一个GUI，它将监视每周是否进行了各种测量。我已经编写了各种其他GUI，用于每天将测量结果更新到数据库中。这些GUI使用Tk:：Date datewidget，允许我按天切换

my $datewidget = $f_filter->Date(-choices=>'today', -datefmt=>'%2d %2m %4y', 
                 -fields=>'date', -varfmt=>'datehash',
                 -monthmenu=>1, -allarrows=>1,
                 -value=>'now', -command=>\&populate)->pack(-side=>'left');

这使我可以使用上下箭头来增加/减少天数，更改月份和年份

我希望在每周GUI中有一个向上和向下的箭头，它只按周切换。例如，本周为“11月4日星期一至11月8日星期五”，下周为“11月11日星期一至11月15日星期五”

我希望能够向前倒退几年

---

在perl Tk:：Date或Date:：Entry中是否有一种简单的方法可以做到这一点？

Tk:：Date

和

Tk:：DateEntry

无法做到这一点。通过

Tk:：Date

，我可以提出以下方法：

• 使用

  -varfmt=>'unixtime'

  而不是

  datehash

  ，因为后者不适合以后使用的

  ->configure（-value=>…）

  调用
• 设置

  -editable=>0

  以删除由

  Tk:：Date创建的所有箭头按钮

• 自己创建inc/dec按钮
• 并使用

  DateTime

  进行日期计算（请参阅此处的

  incweek

  子例程）

类似以下的方法可能会起作用：

use strict;
use Tk;
use Tk::Date;
my $mw = tkinit;
my $datewidget = $mw->Date(-choices=>'today', -datefmt=>'%2d %2m %4y', 
                           -fields=>'date', -varfmt=>'unixtime',
                           -editable=>0,
                           -monthmenu=>1,
                           -value=>'now',
                           -command=>sub { warn "populate @_" })->pack(-side=>'left');
my $arrowframe = $mw->Frame->pack(-side => 'left');
{
    no warnings 'once'; # because of INCBITMAP/DECBITMAP
    $arrowframe->FireButton(-bitmap => $Tk::FireButton::INCBITMAP, -command => sub { incweek(+1) })->pack(-side => 'top');
    $arrowframe->FireButton(-bitmap => $Tk::FireButton::DECBITMAP, -command => sub { incweek(-1) })->pack(-side => 'top');
}
MainLoop;

sub incweek {
    my($inc) = @_;
    use DateTime;
    my $epoch = $datewidget->get;
    my $dt = DateTime->from_epoch(epoch => $epoch);
    $dt = $dt->add(weeks => $inc);
    $datewidget->configure(-value => $dt->epoch);
}

__END__

请注意，

$datewidget->get

现在重新计算纪元时间，但是使用

DateTime

可以轻松地将其转换为y/m/d值