Perl Tk::Date - toggle by week

Question

I am in the process of writing a GUI which will monitor if various measurements have been made on a weekly basis. I have written various other GUIs for updating measurements results each day onto a database. These GUIs use Tk::Date datewidget that allows me to toggle by days

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');

This lets me use the up and down arrows to increment/decrement days, change months and year.

What I desire to do in the weekly GUI is have an up and down arrow that will toggle by week only. Eg this week would be 'Mon Nov 4 - Fri Nov 8', next week 'Mon Nov 11 to Fri Nov 15'

I would like to be able to go forwards and backwards several years.

Is there a simple way to do this in perl-Tk::Date or Date::Entry?

Answer 1

Tk::Date and Tk::DateEntry cannot do this out of the box. With Tk::Date, I can propose the following approach:

• use -varfmt => 'unixtime' instead of datehash, because the latter does not work well with the ->configure(-value => ...) call used later
• set -editable=>0 to remove all arrow buttons created by Tk::Date
• create the inc/dec buttons yourself
• and make the date calculations using DateTime (see the incweek subroutine here)

Something like the following could work:

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__

Note that $datewidget->get returrns now the epoch time, but using DateTime you can easily convert this into y/m/d values.