Perl Tk :: Date - переключается на неделю

Question

Я нахожусь в процессе написания графического интерфейса, который будет контролировать, если бы различные измерения проводились еженедельно. Я написал несколько других графических интерфейсов для ежедневного обновления результатов измерений в базе данных. Эти ГПИ использовать Tk :: Дата 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'); 

Это позволяет мне использовать стрелки вверх и вниз для увеличения/уменьшения дней, изменения месяца и года.

Что я хочу делать в еженедельном графическом интерфейсе, есть стрелка вверх и вниз, которая будет переключаться только по неделям. Например, на этой неделе будет «Пн 4 ноября - пятница 8 ноября», на следующей неделе «Пн с 11 ноября по 15 ноября»

Я хотел бы иметь возможность идти вперед и назад несколько лет.

Есть ли простой способ сделать это в perl-Tk :: Date или Date :: Entry?

Answer 1

Tk::Date и Tk::DateEntry не может этого сделать из коробки. С Tk::Date, я могу предложить следующий подход:

• использование -varfmt => 'unixtime' вместо datehash, потому что последний не очень хорошо работает с ->configure(-value => ...) вызова используется позже
• набор -editable=>0 удалить все кнопки со стрелками, созданные Tk::Date
• создать ИНК кнопке/дец себе
• и производить расчеты с использованием датой 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 returrns теперь время эпохи, но с помощью DateTime вы можете легко преобразовать это в г/м/д значений.