package Rose::HTMLx::Form::Field::PopUpMenuNumeric; use warnings; use strict; use Carp; use base qw( Rose::HTML::Form::Field::PopUpMenu ); our $VERSION = '0.001'; =head1 NAME Rose::HTMLx::Form::Field::PopUpMenuNumeric - popup menu for numeric values =head1 SYNOPSIS use Rose::HTMLx::Form::Field::PopUpMenuNumeric; my $menu = Rose::HTMLx::Form::Field::PopUpMenuNumeric->new( id => 'mynum', name => 'mynum', type => 'menu', class => 'numeric-popup', label => 'My Number', options => [qw( 1 2 3 )], labels => { 1 => 'one', 2 => 'two', 3 => 'three' }, ); $menu->input_value('1'); $menu->internal_value; # returns 1 $menu->input_value(''); $menu->internal_value; # returns undef =head1 DESCRIPTION Rose::HTMLx::Form::Field::PopUpMenuNumeric is like a normal RHTMLO PopUpMenu but it returns an internal_value() like Rose::HTML::Form::Field::Numeric does. This module exists mostly to ensure that popup menus representing numeric values properly return undef instead of an empty string -- an important distinction when you *really* want a numeric value and not a string. =head1 METHODS Only new or overridden method are documented here. =cut =head2 internal_value Cribbed verbatim from Rose::HTML::Form::Field::Numeric. =cut sub internal_value { my ($self) = shift; my $value = $self->SUPER::internal_value(@_); if ( defined $value ) { for ($value) { s/-\s+/-/ || s/\+\s+//; } } return ( defined $value && $value =~ /\S/ ) ? $value : undef; } # This is $RE{num}{dec} from Regexp::Common::number my $Match = qr{^(?:(?i)(?:[+-]?)(?:(?=[0123456789]|[.])(?:[0123456789]*)(?:(?:[.])(?:[0123456789]{0,}))?)(?:(?:[E])(?:(?:[+-]?)(?:[0123456789]+))|))$}; =head2 validate Cribbed nearly verbatim from Rose::HTML::Form::Field::Numeric. =cut sub validate { my ($self) = shift; my $ok = $self->SUPER::validate(@_); return $ok unless ($ok); my $value = $self->internal_value; return 1 unless ( defined $value && length $value ); return $value =~ $Match; } 1; __END__ =head1 AUTHOR Peter Karman, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 ACKNOWLEDGEMENTS The Minnesota Supercomputing Institute C<< http://www.msi.umn.edu/ >> sponsored the development of this software. =head1 COPYRIGHT & LICENSE Copyright 2009 by the Regents of the University of Minnesota. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut