File Coverage

lib/HTML/Object/DOM/Element/Label.pm
Criterion Covered Total %
statement 25 49 51.0
branch 0 12 0.0
condition 0 14 0.0
subroutine 9 14 64.2
pod 3 3 100.0
total 37 92 40.2


line stmt bran cond sub pod time code
1             ##----------------------------------------------------------------------------
2             ## HTML Object - ~/lib/HTML/Object/DOM/Element/Label.pm
3             ## Version v0.2.0
4             ## Copyright(c) 2021 DEGUEST Pte. Ltd.
5             ## Author: Jacques Deguest <jack@deguest.jp>
6             ## Created 2021/12/23
7             ## Modified 2022/09/18
8             ## All rights reserved
9             ##
10             ##
11             ## This program is free software; you can redistribute it and/or modify it
12             ## under the same terms as Perl itself.
13             ##----------------------------------------------------------------------------
14             package HTML::Object::DOM::Element::Label;
15             BEGIN
16             {
17 1     1   1090 use strict;
  1         8  
  1         42  
18 1     1   9 use warnings;
  1         2  
  1         41  
19 1     1   14 use parent qw( HTML::Object::DOM::Element );
  1         3  
  1         5  
20 1     1   83 use vars qw( $VERSION );
  1         3  
  1         49  
21 1     1   6 use HTML::Object::DOM::Element::Shared qw( :label );
  1         8  
  1         109  
22 1     1   34 our $VERSION = 'v0.2.0';
23             };
24              
25 1     1   10 use strict;
  1         3  
  1         28  
26 1     1   7 use warnings;
  1         5  
  1         319  
27              
28             sub init
29             {
30 0     0 1   my $self = shift( @_ );
31 0           $self->{_init_strict_use_sub} = 1;
32 0 0         $self->SUPER::init( @_ ) || return( $self->pass_error );
33 0 0         $self->{tag} = 'label' if( !CORE::length( "$self->{tag}" ) );
34 0           return( $self );
35             }
36              
37             # Note: property read-only
38             sub control
39             {
40 0     0 1   my $self = shift( @_ );
41 0           my $id = $self->htmlFor;
42             # return if( !defined( $id ) || !CORE::length( "$id" ) );
43 0 0 0       if( defined( $id ) && CORE::length( "$id" ) )
44             {
45 0           my $root = $self->root;
46 0           my $elem = $root->look_down( id => $id )->first;
47 0 0 0       return if( !defined( $elem ) || !ref( $elem ) );
48 0           return( $elem );
49             }
50             # "If the for attribute is not specified, but the label element has a labelable element descendant, then the first such descendant in tree order is the label element's labeled control."
51             # <https://html.spec.whatwg.org/multipage/forms.html#htmllabelelement>
52             else
53             {
54 0           my $elems = $self->look_down( _tag => qr/(?:button|input|meter|output|progress|select|textarea)/ );
55 0           my $elem;
56             $elems->foreach(sub
57             {
58 0     0     my $tag = $_->tag;
59 0 0 0       if( $tag ne 'input' ||
      0        
      0        
60             ( $tag eq 'input' && lc( $_->attr( 'type' ) // '' ) ne 'hidden' ) )
61             {
62 0           $elem = $_, return;
63             }
64 0           });
65 0           return( $elem );
66             }
67             }
68              
69             # Note: property form is NOT inherited, because this is the 'form' value of the associated control, if any.
70             {
71 1     1   13 no warnings 'redefine';
  1         6  
  1         156  
72             sub form
73             {
74 0     0     my $self = shift( @_ );
75 0           my $elem = $self->control;
76 0 0         return if( !$self->_is_a( $elem => 'HTML::Object::DOM::Element' ) );
77 0           return( $elem->form );
78             }
79             }
80              
81             # Note: property
82             # labelable elements:
83             # "button, input (if the type attribute is not in the Hidden state) meter, output, progress, select, textarea, form-associated custom elements"
84             # <https://html.spec.whatwg.org/multipage/forms.html#category-label>
85 0     0 1   sub htmlFor : lvalue { return( shift->_set_get_property( 'for', @_ ) ); }
86              
87             1;
88             # NOTE: POD
89             __END__
90              
91             =encoding utf-8
92              
93             =head1 NAME
94              
95             HTML::Object::DOM::Element::Label - HTML Object DOM Label Class
96              
97             =head1 SYNOPSIS
98              
99             use HTML::Object::DOM::Element::Label;
100             my $label = HTML::Object::DOM::Element::Label->new ||
101             die( HTML::Object::DOM::Element::Label->error, "\n" );
102              
103             =head1 VERSION
104              
105             v0.2.0
106              
107             =head1 DESCRIPTION
108              
109             This interface gives access to properties specific to <label> elements. It inherits methods and properties from the base L<HTML::Object::Element> interface.
110              
111             =head1 INHERITANCE
112              
113             +-----------------------+ +---------------------------+ +-------------------------+ +----------------------------+ +-----------------------------------+
114             | HTML::Object::Element | --> | HTML::Object::EventTarget | --> | HTML::Object::DOM::Node | --> | HTML::Object::DOM::Element | --> | HTML::Object::DOM::Element::Label |
115             +-----------------------+ +---------------------------+ +-------------------------+ +----------------------------+ +-----------------------------------+
116              
117             =head1 PROPERTIES
118              
119             Inherits properties from its parent L<HTML::Object::DOM::Element>
120              
121             =head2 control
122              
123             Read-only.
124              
125             Is a L<HTML::Object::Element> representing the control with which the label is associated. It returns C<undef> if the C<for> attribute has no id set, or no associated element could be found in the DOM.
126              
127             See also L<Mozilla documentation|https://developer.mozilla.org/en-US/docs/Web/API/HTMLLabelElement/control>
128              
129             =head2 form
130              
131             Read-only.
132              
133             Is a L<HTML::Object::DOM::Element::Form> object representing the form with which the labeled control is associated, or C<undef> if there is no associated control, or if that control is not associated with a form. In other words, this is just a shortcut for:
134              
135             $e->control->form
136              
137             See also L<Mozilla documentation|https://developer.mozilla.org/en-US/docs/Web/API/HTMLLabelElement/form>
138              
139             =head2 htmlFor
140              
141             Is a string containing the ID of the labeled control. This reflects the for attribute.
142              
143             Example:
144              
145             <label for="inputId">Enter your name</label>
146             my $label = $doc->getElementsByTagName( 'label' )->first;
147             say( "ID is: ", $label->htmlFor );
148              
149             See also L<Mozilla documentation|https://developer.mozilla.org/en-US/docs/Web/API/HTMLLabelElement/htmlFor>
150              
151             =head1 METHODS
152              
153             Inherits methods from its parent L<HTML::Object::DOM::Element>
154              
155             =head1 AUTHOR
156              
157             Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>
158              
159             =head1 SEE ALSO
160              
161             L<Mozilla documentation|https://developer.mozilla.org/en-US/docs/Web/API/HTMLLabelElement>, L<Mozilla documentation on label element|https://developer.mozilla.org/en-US/docs/Web/HTML/Element/label>, L<W3C specificatins|https://html.spec.whatwg.org/multipage/forms.html#htmllabelelement>
162              
163             =head1 COPYRIGHT & LICENSE
164              
165             Copyright(c) 2021 DEGUEST Pte. Ltd.
166              
167             All rights reserved
168              
169             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
170              
171             =cut