package Gtk2::Ex::Entry::SSN;
use strict;
use warnings;
use Carp;
our $VERSION = 0.02;
our $AUTHORITY = 'cpan:JHALLOCK';
use Gtk2;
use Glib qw(TRUE FALSE);
use Glib::Object::Subclass
Gtk2::Entry::,
interfaces => [ 'Gtk2::CellEditable' ],
properties => [
Glib::ParamSpec->string(
'value' ,
'value' ,
'ISO format time string like 13:00' ,
'' , #default value
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->get('value');
}
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) {
$newval = $self->_parse_input($newval);
}
my $oldval = $self->get_value;
if (! defined $oldval && ! defined $newval) {
$self->_display_output;
}
elsif (! defined $oldval && defined $newval ||
! defined $newval && defined $oldval ||
$oldval ne $newval) {
$self->{value} = $newval;
$self->signal_emit('value-changed');
}
else {
$self->_display_output;
}
}
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;
# enter pressed, parse input
if ($key_val == 65293) {
$self->set_value($self->get_text);
return FALSE;
}
# arrow key pressed
elsif ($key_val == 65361 || $key_val == 65363) {
$self->set_value($self->get_text);
return $self->_do_key_left if $key_val == 65361;
return $self->_do_key_right if $key_val == 65363;
}
# pass everything else on
else {
return FALSE;
}
}
sub _do_key_left {
my $self = shift;
my $selected = $self->get_selected_component;
if (! $selected) {
my $pos = $self->get_position;
if ($pos == 4) {
$self->set_selected_component(0);
}
elsif ($pos == 7) {
$self->set_selected_component(1);
}
else {
return FALSE;
}
}
else {
if ($selected eq 'all' ) { $self->set_selected_component(2) }
elsif ($selected == 0 ) { return FALSE; }
elsif ($selected == 1 ) { $self->set_selected_component(0) }
elsif ($selected == 2 ) { $self->set_selected_component(1) }
}
return TRUE;
}
sub _do_key_right {
my $self = shift;
my $selected = $self->get_selected_component;
if (! $selected) {
my $pos = $self->get_position;
if ($pos == 3) {
$self->set_selected_component(1);
}
elsif ($pos == 6) {
$self->set_selected_component(2);
}
else {
return FALSE;
}
}
else {
if ($selected eq 'all' ) { $self->set_selected_component(0) }
elsif ($selected == 0 ) { $self->set_selected_component(1) }
elsif ($selected == 1 ) { $self->set_selected_component(2) }
elsif ($selected == 2 ) { return FALSE; }
}
return TRUE;
}
{
my %pos = (
0 => [0,3],
1 => [4,6],
2 => [7,11],
all => [0,11],
);
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 _parse_input {
my $self = shift;
my $value = shift || '';
$value =~ s/\D//g;
return undef if ! defined $value || $value eq '';
return $value;
}
sub _display_output {
my $self = shift;
my $value = $self->get_value;
no warnings;
my @parts = (
substr($value,0,3),
substr($value,3,2),
substr($value,5,4)
);
use warnings;
my $output = $value ? sprintf ('%03d-%02d-%04d', @parts) : '';
$self->set_text($output);
}
1;
__END__
=head1 NAME
Gtk2::Ex::Entry::SSN -- Gtk2 widget for entering social security numbers
=head1 SYNOPSIS
use Gtk2::Ex::Entry::SSN;
$w = Gtk2::Ex::DateEntry->new(value => '012-345-6789');
$w->get_value;
=head1 WIDGET HIERARCHY
Gtk2::Widget
Gtk2::Entry
Gtk2::Ex::Entry::SSN
=head1 DESCRIPTION
C<Gtk2::Ex::Entry::SSN> displays and edits a social security number.
Navigate between the three components of a social security number using the
left and right arrow keys. The value of the widget will be stored internally
as a 9 character string consisting only of digits (i.e. "0123456789"). However,
the text that is displayed in the widget will be displayed with hyphens between
the components (i.e. "012-345-6789").
=head1 FUNCTIONS
=over 4
=item C<< $te = Gtk2::Ex::Entry::SSN->new () >>
Create and return a new SSN Entry widget.
=item C<< $te->get_selected_component >>
Returns the currently selected component - any of 0, 1, or 2;
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.
You can pass the values 0, 1, 2, 'all', 'none', undef, or an emptry string.
=item C<< $te->get_value >>
Return the internal value of the widget.
=item C<< $te->set_value ($value) >>
Set the internal value of the widget.
=back
=head1 SIGNALS
=over 4
=item C<value-changed>
Emitted after a succesful value change.
=back
=head1 SEE ALSO
L<Gtk2::Ex::FormFactory::Entry::SSN>
=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-Entry-SSN is Copyright 2009 Jeffrey Ray Hallock
Gtk2-Ex-Entry-SSN 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-Entry-SSN 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-Entry-SSN. If not, see L<http://www.gnu.org/licenses/>.
=cut