package Gapp::Gtk2::DateEntry; use strict; use warnings; use Carp; our $VERSION = 0.02; our $AUTHORITY = 'cpan:JHALLOCK'; use Gtk2; use DateTime; use Glib qw(TRUE FALSE); use Glib::Object::Subclass Gtk2::Entry::, interfaces => [ 'Gtk2::CellEditable' ], properties => [ Glib::ParamSpec->scalar( 'value' , 'value' , 'DateTime object' , Glib::G_PARAM_READWRITE ), ], signals => { value_changed => { class_closure => \&_do_value_changed, flags => ['run-first'] , return_type => undef , param_types => [] , }, } ; sub INIT_INSTANCE { my $self = shift; $self->signal_connect('key-press-event' => \&_do_key_press_event); $self->signal_connect('focus-out-event' => \&_do_focus_out_event); } sub SET_PROPERTY { my ($self, $pspec, $newval) = @_; my $pname = $pspec->get_name; # handle changes to the value parameter (emit a signal on change) if ($pname eq 'value') { $self->set_value($newval); } else { $self->{$pname} = $newval; } } sub get_value { my $self = shift; $self->{datetime} ? $self->{datetime}->clone : undef; } sub set_value { carp 'usage $date_entry->set_value($new_value)' unless @_ == 2; my $self = shift; my $newval = shift; # parse the new value if defined if ( defined $newval && ! ref $newval ) { $newval = $self->_parse_input($newval); } my $oldval = $self->{datetime}; if (! defined $oldval && ! defined $newval) { $self->_display_output; } elsif (! defined $oldval && defined $newval || ! defined $newval && defined $oldval || $oldval ne $newval) { $self->{datetime} = $newval; $self->signal_emit('value-changed'); } else { $self->_display_output; } } sub set_today { my $self = shift; my ($hour, $minute) = (localtime time)[2,1]; my $obj = $self->{datetime}; my $today = DateTime->now; if ($obj && $obj->ymd eq $today->ymd) { return; } else { $self->{datetime} = $today; $self->signal_emit('value-changed'); } } sub _do_value_changed { my $self = shift; my $value = $self->get_value; $self->_display_output; } sub _do_focus_out_event { my $self = shift; $self->set_value($self->get_text); return FALSE; } sub _do_key_press_event { my $self = shift; my $key = shift; my $key_val = $key->keyval; # entry pressed, parse input if ($key_val == 65293) { $self->set_value($self->get_text); return FALSE; } # laft arrow key pressed elsif ($key_val >= 65361 && $key_val <= 65364) { $self->set_value($self->get_text); return $self->_do_key_left if $key_val == 65361; return $self->_do_key_right if $key_val == 65363; return $self->_do_key_up if $key_val == 65362; return $self->_do_key_down if $key_val == 65364; } # pass everything else on else { return FALSE; } } sub _do_key_left { my $self = shift; my $selected = $self->get_selected_component; if (! $selected) { return FALSE if $self->get_position == 0; $self->_select_closest_component('left'); return TRUE; } else { if ($selected eq 'all' ) { $self->set_selected_component('year') } elsif ($selected eq 'month') { return FALSE; } elsif ($selected eq 'day' ) { $self->set_selected_component('month') } elsif ($selected eq 'year' ) { $self->set_selected_component('day') } } return TRUE; } sub _do_key_right { my $self = shift; my $selected = $self->get_selected_component; if (! $selected) { return FALSE if $self->get_position == length $self->get_text; $self->_select_closest_component('right'); return TRUE; } else { if ($selected eq 'all' ) { $self->set_selected_component('month') } elsif ($selected eq 'month') { $self->set_selected_component('day') } elsif ($selected eq 'day' ) { $self->set_selected_component('year') } elsif ($selected eq 'year' ) { return FALSE; } } return TRUE; } sub _do_key_up { my $self = shift; my $selected = $self->get_selected_component; $self->_select_closest_component('up') and return TRUE unless $selected; my $obj = $self->{datetime}; for ($selected) { if ($_ eq 'all' ) { $obj->add(days => 7) } elsif ($_ eq 'month') { $obj->add(months => 1) } elsif ($_ eq 'day' ) { $obj->add(days => 1) } elsif ($_ eq 'year' ) { $obj->add(years => 1) } } $self->signal_emit('value-changed'); $self->set_selected_component($selected); return TRUE; } sub _do_key_down { my $self = shift; my $selected = $self->get_selected_component; $self->_select_closest_component('down') and return TRUE unless $selected; my $obj = $self->{datetime}; for ($selected) { if ($_ eq 'all' ) { $obj->subtract(days => 7) } elsif ($_ eq 'month') { $obj->subtract(months => 1) } elsif ($_ eq 'day' ) { $obj->subtract(days => 1) } elsif ($_ eq 'year' ) { $obj->subtract(years => 1) } } $self->signal_emit('value-changed'); $self->set_selected_component($selected); return TRUE; } sub _display_output { my $self = shift; my $obj = $self->{datetime}; my $output = $obj ? sprintf ('%02d/%02d/%04d', $obj->month, $obj->day, $obj->year) : ''; $self->set_text($output); } { my %pos = ( month => [0,2], day => [3,5], year => [6,10], all => [0,10] ); sub get_selected_component { my $self = shift; my ($start, $end) = $self->get_selection_bounds; $start = 0 unless $start; $end = 0 unless $end; return undef if $start == $end; for my $name (keys %pos) { my $coords = $pos{$name}; if ($start == $coords->[0] && $end == $coords->[1]) { return $name; } } # no componenet selected if we got here return undef; } sub set_selected_component { confess q[usage is $date_entry->set_selected_component($field)] unless @_ == 2; my $self = shift; my $field = shift; if (! defined $field || $field eq 'none' || $field eq '') { $self->select_region(0,0); } else { # throw exception if not a valid component name confess q[$field must be one of undef, none, year, month, day] if ! exists $pos{$field}; $self->select_region(@{$pos{$field}}); } } } # end encapsulated %pos variable sub _select_closest_component { my $self = shift; my $direction = shift; my $cursor = $self->get_position; if ($cursor == 0 || $cursor == 1) { $self->set_selected_component('month'); } elsif ($cursor == 2 && $direction ne 'right') { $self->set_selected_component('month'); } elsif ($cursor == 2 && $direction eq 'right') { $self->set_selected_component('day'); } elsif ($cursor == 3 && $direction eq 'left') { $self->set_selected_component('month'); } elsif ($cursor == 3 && $direction ne 'left') { $self->set_selected_component('day'); } elsif ($cursor == 4) { $self->set_selected_component('day'); } elsif ($cursor == 5 && $direction ne 'right') { $self->set_selected_component('day'); } elsif ($cursor == 5 && $direction eq 'right') { $self->set_selected_component('year'); } elsif ($cursor == 6 && $direction eq 'left') { $self->set_selected_component('day'); } elsif ($cursor == 6 && $direction ne 'left') { $self->set_selected_component('year'); } elsif ($cursor >= 7) { $self->set_selected_component('year'); } return TRUE; } sub _parse_input { my $self = shift; my $value = shift || ''; $value =~ s/\s//g; return undef if ! defined $value || $value eq ''; my ($d, $m, $y); # when the user is just changing the day of the month if ($value =~ /^(\d{1,2})$/) { $d = $1; $m = 0; $y = 0; } # when the user is just changing the year elsif ($value =~ /^\d{4}$/ && int ($value) > 1231) { $m = 0; $d = 0; $y = $value; } # for parsing mm-dd-yyyy style objects (or mmddyy mmdd etc) elsif ($value =~ /^([01]?[0-9])([ \.\-\/\\])?([0-3][0-9])([ \.\-\/\\])?(([0-9]{2})|([0-9]{4}))?$/) { $m = $1 || 0; $d = $3 || 0; $y = $5 || 0; if ($y) { if ($y <= 20) { $y += 2000 } elsif ($y <= 99) { $y += 1900 } } } # for parsing yyyy-mm-dd style dates - year must be 4 digits in this scenario elsif ($value =~ /^(\d{4})([ \.\-\/\\])?([01]?[0-9])([ \.\-\/\\])?([0-3][0-9])$/) { $y = $1; $m = $3; $d = $5; } else { return $self->{datetime}; } # fill in missing values using the currently set date, or the current date my $obj = $self->{datetime}; $obj = $obj ? $obj : DateTime->now; my ($cd, $cm, $cy); $cd = $obj->day; $cm = $obj->month; $cy = $obj->year; $m = $m ? $m : $cm; $d = $d ? $d : $cd; $y = $y ? $y : $cy; return DateTime->new(day => $d, month => $m, year => $y); } 1; __END__ =head1 NAME Gtk2::Ex::DateEntry -- Widget for entering dates =head1 SYNOPSIS use Gtk2::Ex::DateEntry; $de = Gtk2::Ex::DateEntry->new; $de->set_value('10132009'); $de->get_value; =head1 WIDGET HIERARCHY Gtk2::Widget Gtk2::Entry Gtk2::Ex::DateEntry =head1 DESCRIPTION C<Gtk2::Ex::DateEntry> displays and edits a date in MM/DD/YYYY format with some convienence functions. Use the up and down keys to modify the invidual components of the value, and the left and right keys to navigate between them. Pressing up or down while the entire contents of the entry is selected (such as when you focus-in) modifies the value in 7 day increments. The date is displayed in the widget in MM/DD/YYYY format, but the results from C<get_value> are in the format YYYY-MM-DD. The reason being that dates are most commonly (in the west) displayed as MM/DD/YYYY, however when programming it is much more common to encounter dates in the format YYYY-MM-DD. You can also type a date into the entry into various formats, which will be parsed and then displayed in the entry in MM/DD/YYYY format. Below are some examples of things you can enter into the widget and the resulting internal and display values. Also note that whitespace is ignored during parsing. =over 4 INPUT VALUE DISPLAY 08/11/1986 1986-08-11 08/11/1986 08-11-1986 1986-08-11 08/11/1986 08.11.1986 1986-08-11 08/11/1986 08111986 1986-08-11 08/11/1986 081186 1986-08-11 08/11/1986 =back Entering a partial date (just year, month, day) will result in the remaining components being filled in for you. If the widget is currently set to a date, the current values will be used. If the widget is not set to a date, the current system date will be used to fill in the missing values. =over 4 STARTING INPUT RESULT 1986-08-11 10 1986-08-10 # 1-2 digits, setsday of month 1986-08-11 1231 1986-12-31 # 3-4 digits sets month, day 1986-08-11 2009 2009-12-31 # 4 digits (> 1231) sets year =back This may all seem confusing, just try playing around with the widget. It should generally just do what you would expect. =head1 FUNCTIONS =over 4 =item C<< $te = Gtk2::Ex::DateEntry->new () >> Create and return a new DateEntry widget. =item C<< $te->get_selected_component >> Returns the currently selected component - any of 'month', 'day', 'year'. An emptry string will be returned if the selection bounds contains more or less than 1 individual component, and will return 'all' if all componentes are selected. =item C<< $te->set_selected_component($component) >> Highlights the given component, which can then be edited by typing over it or pressing the arrow keys up or down. You can pass the values 'month', 'day', 'year', 'all', 'none', undef, or an emptry string; =item C<< $te->set_today >> Set the widget to the current date. =item C<< $te->get_value >> Return the current date in YYYY-MM-DD format. =item C<< $te->set_value ($value) >> Parses the content of $value then sets the widget to the resulting date. =back =head1 SIGNALS =over 4 =item C<value-changed> Emitted after a succesful value change. =back =head1 SEE ALSO L<Gtk2::Ex::DateEntry::CellRenderer>, L<Gtk2::Ex::FormFactory::DateEntry> =head1 AUTHOR Jeffrey Hallock <jeffrey.ray at ragingpony com> =head1 BUGS None known. Please send bugs to <jeffrey.ray at ragingpony dot com>. Patches and suggestions welcome. =head1 LICENSE Gtk2-Ex-DateEntry is Copyright 2009 Jeffrey Ray Hallock Gtk2-Ex-DateEntry is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 3, or (at your option) any later version. Gtk2-Ex-DateEntry is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with Gtk2-Ex-DateEntry. If not, see L<http://www.gnu.org/licenses/>. =cut