—package
CGI::Test::Form::Widget::Box;
use
strict;
##################################################################
# $Id: Box.pm 411 2011-09-26 11:19:30Z nohuhu@nohuhu.org $
# $Name: cgi-test_0-104_t1 $
##################################################################
# Copyright (c) 2001, Raphael Manfredi
#
# You may redistribute only under the terms of the Artistic License,
# as specified in the README file that comes with the distribution.
#
#
# This class models a FORM box, either a radio button or a checkbox.
#
use
Log::Agent;
############################################################
#
# %attr
#
# Defines which HTML attributes we should look at within the node, and how
# to translate that into class attributes.
#
############################################################
my
%attr
= (
'name'
=>
'name'
,
'value'
=>
'value'
,
'checked'
=>
'is_checked'
,
'disabled'
=>
'is_disabled'
,
);
############################################################
#
# ->_init
#
# Per-widget initialization routine.
# Parse HTML node to determine our specific parameters.
#
############################################################
sub
_init
{
my
$this
=
shift
;
my
(
$node
) =
shift
;
$this
->_parse_attr(
$node
, \
%attr
);
return
;
}
############################################################
#
# ->_is_successful -- defined
#
# Is the enabled widget "successful", according to W3C's specs?
# Any ticked checkbox and radio button is.
#
############################################################
sub
_is_successful
{
my
$this
=
shift
;
return
$this
->is_checked();
}
############################################################
#
# ->group_list
#
# Returns list of widgets belonging to the same group as we do.
#
############################################################
sub
group_list
{
my
$this
=
shift
;
return
$this
->group->widgets_in(
$this
->name);
}
#
# Local attribute access
#
############################################################
sub
group
{
my
$this
=
shift
;
return
$this
->{group};
}
############################################################
sub
is_checked
{
my
$this
=
shift
;
return
$this
->{is_checked};
}
############################################################
sub
old_is_checked
{
my
$this
=
shift
;
$this
->{old_is_checked};
}
#
# Checking shortcuts
#
############################################################
sub
check
{
my
$this
=
shift
;
$this
->set_is_checked(1);
}
############################################################
sub
uncheck
{
my
$this
=
shift
;
$this
->set_is_checked(0);
}
############################################################
sub
check_tagged
{
my
$this
=
shift
;
my
$tag
=
shift
;
$this
->_mark_by_tag(
$tag
, 1);
}
############################################################
sub
uncheck_tagged
{
my
$this
=
shift
;
my
$tag
=
shift
;
$this
->_mark_by_tag(
$tag
, 0);
}
#
# Attribute setting
#
############################################################
sub
set_group
{
my
$this
=
shift
;
my
$group
=
shift
;
$this
->{group} =
$group
;
}
############################################################
#
# ->set_is_checked
#
# Select or unselect box.
#
############################################################
sub
set_is_checked
{
my
$this
=
shift
;
my
(
$checked
) =
@_
;
return
if
!
$checked
== !
$this
->is_checked();
# No change
#
# To ease redefinition, let this call _frozen_set_is_checked, which is
# not redefinable and performs the common operation.
#
$this
->_frozen_set_is_checked(
$checked
);
return
;
}
############################################################
#
# ->reset_state -- redefined
#
# Called when a "Reset" button is pressed to restore the value the widget
# had upon form entry.
#
############################################################
sub
reset_state
{
my
$this
=
shift
;
$this
->{is_checked} =
delete
$this
->{old_is_checked}
if
exists
$this
->{old_is_checked};
return
;
}
#
# Global widget predicates
#
############################################################
sub
is_read_only
{
return
1;
}
#
# High-level classification predicates
#
############################################################
sub
is_box
{
return
1;
}
#
# Predicates for the Box hierarchy
#
############################################################
sub
is_radio
{
logconfess
"deferred"
;
}
############################################################
sub
is_standalone
{
my
$this
=
shift
;
1 ==
$this
->group->widget_count(
$this
->name());
}
#
# ->delete
#
# Break circular refs.
#
sub
delete
{
my
$this
=
shift
;
delete
$this
->{group};
$this
->SUPER::
delete
;
return
;
}
#
# ->_frozen_set_is_checked
#
# Frozen implementation of set_is_checked().
#
sub
_frozen_set_is_checked
{
my
$this
=
shift
;
my
(
$checked
) =
@_
;
#
# The first time we do this, save current status in `old_is_checked'.
#
$this
->{old_is_checked} =
$this
->{is_checked}
unless
exists
$this
->{old_is_checked};
$this
->{is_checked} =
$checked
;
return
;
}
############################################################
#
# ->_mark_by_tag
#
# Lookup the box in the group whose name is the given tag, and mark it
# as specified.
#
############################################################
sub
_mark_by_tag
{
my
$this
=
shift
;
my
(
$tag
,
$checked
) =
@_
;
my
@boxes
=
grep
{
$_
->value eq
$tag
}
$this
->group_list();
if
(
@boxes
== 0)
{
logcarp
"no %s within the group '%s' bears the tag \"$tag\""
,
$this
->gui_type(),
$this
->name();
}
else
{
logcarp
"found %d %ss within the group '%s' bearing the tag \"$tag\""
,
scalar
(
@boxes
),
$this
->gui_type(),
$this
->name()
if
@boxes
> 1;
$boxes
[ 0 ]->set_is_checked(
$checked
);
}
return
;
}
1;
=head1 NAME
CGI::Test::Form::Widget::Box - Abstract representation of a tickable box
=head1 SYNOPSIS
# Inherits from CGI::Test::Form::Widget
=head1 DESCRIPTION
This class is the abstract representation of a tickable box, i.e. a radio
button or a checkbox.
To simulate user checking or un-checking on a box,
use the C<check()> and C<uncheck()> routines, as described below.
=head1 INTERFACE
The interface is the same as the one described in L<CGI::Test::Form::Widget>,
with the following additions:
=head2 Attributes
=over 4
=item C<group>
The C<CGI::Test::Form::Group> object which holds all the groups of the same
widget type.
=item C<group_list>
The list of widgets belonging to the same group as we do.
=item C<is_checked>
True when the box is checked, i.e. marked with a tick.
=back
=head2 Attribute Setting
=over 4
=item C<check>
Check the box, by ticking it.
=item C<check_tagged> I<tag>
This may be called on any box, and it will locate the box whose value
attribute is I<tag> within the C<group_list>, and then check it.
If the specified I<tag> is not found, the caller will get a warning
via C<logcarp>.
=item C<uncheck>
Uncheck the box, by removing its ticking mark.
It is not possible to do this on a radio button: you must I<check> another
radio button of the same group instead.
=item C<uncheck_tagged> I<tag>
This may be called on any box, and it will locate the box whose value
attribute is I<tag> within the C<group_list>, and then remove its ticking mark.
It is not possible to do this on a radio button, as explained in C<uncheck>
above.
If the specified I<tag> is not found, the caller will get a warning
via C<logcarp>.
=back
=head2 Widget Classification Predicates
There is an additional predicate to distinguish between a checkbox and
a radio button:
=over 4
=item C<is_radio>
Returns I<true> for a radio button.
=item C<is_standalone>
Returns I<true> if the box is the sole member of its group.
Normally only useful for checkboxes: a standalone radio button,
although perfectly legal, would always remain in the checked state, and
therefore not be especially interesting...
=back
=head2 Miscellaneous Features
Although documented, those features are more targetted for
internal use...
=over 4
=item C<set_is_checked> I<flag>
Change the checked status. Radio buttons can only be checked, i.e. the
I<flag> must be true: all other radio buttons in the same group are
immediately unchecked.
You should use the C<check> and C<uncheck> convenience routines instead
of calling this feature.
=back
=head1 WEBSITE
You can find information about CGI::Test and other related modules at:
=head1 PUBLIC CVS SERVER
CGI::Test now has a publicly accessible CVS server provided by
SourceForge (www.sourceforge.net). You can access it by going to:
=head1 AUTHORS
The original author is Raphael Manfredi F<E<lt>Raphael_Manfredi@pobox.comE<gt>>.
Send bug reports, hints, tips, suggestions to Steven Hilton at <mshiltonj@mshiltonj.com>
=head1 SEE ALSO
CGI::Test::Form::Widget(3),
CGI::Test::Form::Widget::Box::Radio(3),
CGI::Test::Form::Widget::Box::Check(3).
=cut