File Coverage

lib/HTML/Object/DOM/Text.pm
Criterion Covered Total %
statement 82 116 70.6
branch 11 34 32.3
condition 4 20 20.0
subroutine 20 39 51.2
pod 26 26 100.0
total 143 235 60.8


line stmt bran cond sub pod time code
1             ##----------------------------------------------------------------------------
2             ## HTML Object - ~/lib/HTML/Object/DOM/Text.pm
3             ## Version v0.2.0
4             ## Copyright(c) 2021 DEGUEST Pte. Ltd.
5             ## Author: Jacques Deguest <jack@deguest.jp>
6             ## Created 2021/12/13
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::Text;
15             BEGIN
16             {
17 29     29   1222 use strict;
  29         71  
  29         960  
18 29     29   185 use warnings;
  29         522  
  29         891  
19 29     29   205 use parent qw( HTML::Object::Text HTML::Object::DOM::CharacterData );
  29         95  
  29         195  
20 29     29   2670 use vars qw( $VERSION );
  29         85  
  29         1297  
21 29     29   608 our $VERSION = 'v0.2.0';
22             };
23              
24 29     29   154 use strict;
  29         78  
  29         618  
25 29     29   167 use warnings;
  29         61  
  29         32037  
26              
27             sub init
28             {
29 123     123 1 11500 my $self = shift( @_ );
30 123         3036 $self->{_init_strict_use_sub} = 1;
31 123 50       1143 $self->HTML::Object::Text::init( @_ ) || return( $self->pass_error );
32 123         545 return( $self );
33             }
34              
35 0     0 1 0 sub assignedSlot { return( shift->_set_get_object_without_init( 'assignedslot', 'HTML::Object::DOM::Element::Slot', @_ ) ); }
36              
37 0 0   0 1 0 sub getAttributes { return( wantarray() ? () : [] ); }
38              
39 145 100   145 1 449 sub getChildNodes { return( wantarray() ? () : [] ); }
40              
41 0     0 1 0 sub getElementById { return; }
42              
43 0     0 1 0 sub getFirstChild { return; }
44              
45 0     0 1 0 sub getLastChild { return; }
46              
47 0     0 1 0 sub getParentNode { return( shift->parent ); }
48              
49             # Inherited
50             # sub getNextSibling;
51              
52             # Inherited
53             # sub getPreviousSibling;
54              
55 0     0 1 0 sub getRootNode { return( shift->parent->getRootNode ); }
56              
57 0     0 1 0 sub getValue { return( shift->value ); }
58              
59             sub is_inside
60             {
61 0     0 1 0 my( $text, $node ) = @_;
62 0         0 return( $text->parent->is_inside( $node ) );
63             }
64              
65             sub isEqualNode
66             {
67 0     0 1 0 my $self = shift( @_ );
68 0   0     0 my $e = shift( @_ ) || return( $self->error( "No html element was provided to insert." ) );
69 0 0       0 return( $self->error( "Element provided (", overload::StrVal( $e ), ") is not an HTML::Object::Element." ) ) if( !$self->_is_a( $e => 'HTML::Object::Element' ) );
70 0 0       0 return(0) if( !$self->_is_a( $e => 'HTML::Object::Text' ) );
71 0         0 return( $self->value eq $e->value );
72             }
73              
74 0     0 1 0 sub isAttributeNode { return(0); }
75              
76 0     0 1 0 sub isCommentNode { return(0); }
77              
78 105     105 1 446 sub isElementNode { return(0); }
79              
80 0     0 1 0 sub isNamespaceNode { return(0); }
81              
82 0     0 1 0 sub isPINode { return(0); }
83              
84 0     0 1 0 sub isProcessingInstructionNode { return(0); }
85              
86 0     0 1 0 sub isTextNode { return(1); }
87              
88             # Note: Property
89 1     1 1 295 sub nodeValue : lvalue { return( shift->_set_get_lvalue( 'value', @_ ) ); }
90              
91 326     326 1 2521329 sub parent { return( shift->_set_get_object_without_init( 'parent', 'HTML::Object::DOM::Node', @_ ) ); }
92              
93             sub replaceWholeText
94             {
95 1     1 1 8 my $self = shift( @_ );
96 1         2 my $content = shift( @_ );
97 1 50 33     18 return( $self->error({
98             message => "Content provided is a reference that cannot be stringified.",
99             class => 'HTML::Object::TypeError',
100             }) ) if( ref( $content ) && !overload::Method( $content, '""' ) );
101 1         14 my $prev = $self->left;
102 1         162 my $next = $self->right;
103 1         59235 my $parent = $self->parent;
104 1 50       164 if( !$parent )
105             {
106 0         0 $self->value( "$content" );
107 0         0 return( $self );
108             }
109 1         7 my $siblings = $parent->children;
110 1         94 my $pos = $siblings->pos( $self );
111 1 50       123 return( $self->error({
112             message => "I could not find this text node among its parent's children.",
113             class => 'HTML::Object::HierarchyRequestError',
114             }) ) if( !defined( $pos ) );
115 1         4 my $start = $pos;
116             $prev->reverse->foreach(sub
117             {
118 1 0 33 1   44 if( !$self->_is_a( $_ => 'HTML::Object::DOM::Text' ) &&
119             !$self->_is_a( $_ => 'HTML::Object::DOM::Space' ) )
120             {
121 0         0 return;
122             }
123 1         42 $start--;
124 1         6 });
125 1         39 my $last = $pos;
126             $next->foreach(sub
127             {
128 1 0 33 1   13 if( !$self->_is_a( $_ => 'HTML::Object::DOM::Text' ) &&
129             !$self->_is_a( $_ => 'HTML::Object::DOM::Space' ) )
130             {
131 0         0 return;
132             }
133 1         31 $last++;
134 1         15 });
135 1         26 my $removed = $siblings->splice( $start, ( ( $last - $start ) + 1 ), $self );
136 1         30 $_->parent( undef ) for( @$removed );
137 1         29 $self->parent( $parent );
138 1         43 $self->value( "$content" );
139 1         1057 $self->reset(1);
140 1         8 return( $self );
141             }
142              
143             sub splitText
144             {
145 1     1 1 1231 my $self = shift( @_ );
146 1         4 my $offset = shift( @_ );
147 1 50       12 return( $self->error({
148             message => "Offset value provided ($offset) is not an integer.",
149             class => 'HTML::Object::TypeError',
150             }) ) if( !$self->_is_integer( $offset ) );
151 1         25 my $value = $self->value;
152 1         958 my $size = $value->length;
153 1 50       40638 return( $self->error({
154             message => "Offset value provided ($offset) is higher than the size of the string (" . $value->length . ")",
155             class => 'HTML::Object::IndexSizeError',
156             }) ) if( $offset > $size );
157 1 50       210 if( $offset < 0 )
158             {
159 0         0 $offset = ( $offset + $size );
160             # For example, in the unlikely scenario where the negative offset is nth time the size of the text
161 0   0     0 while( $offset < 0 && abs( $offset ) > $size )
162             {
163 0         0 $offset = ( $offset + $size );
164             }
165             }
166 1         9 my $part1 = $value->substr( 0, $offset );
167 1         50 my $part2 = $value->substr( $offset );
168 1         42 my $new = $self->new( value => $part2 );
169 1         10 my $parent = $self->parent;
170 1 50       22 if( $parent )
171             {
172 1         5 $new->parent( $parent );
173 1         80 my $siblings = $parent->children;
174 1         80 my $pos = $siblings->pos( $self );
175 1 50       30 return( $self->error({
176             message => "Unable to find our text element among our parent's children.",
177             class => 'HTML::Object::HierarchyRequestError',
178             }) ) if( !defined( $pos ) );
179 1         9 $siblings->splice( $pos + 1, 0, $new );
180 1         55 $self->reset(1);
181             }
182 1         6 $self->value( $part1 );
183 1         999 return( $new );
184             }
185              
186 0     0 1 0 sub string_value { return( shift->value ); }
187              
188 0     0 1 0 sub toString { return( shift->value ); }
189              
190 2     2 1 562 sub wholeText { return( shift->_get_adjacent_nodes->map(sub{ $_->value })->join( '' )->scalar ); }
  1     1   162  
191              
192             sub _get_adjacent_nodes
193             {
194 1     1   4 my $self = shift( @_ );
195 1         9 my $prev = $self->left;
196 1         187 my $next = $self->right;
197 1         1520 my $res = $self->new_array( $self );
198             $prev->reverse->foreach(sub
199             {
200 0 0 0 0   0 if( !$self->_is_a( $_ => 'HTML::Object::DOM::Text' ) &&
201             !$self->_is_a( $_ => 'HTML::Object::DOM::Space' ) )
202             {
203 0         0 return;
204             }
205 0         0 $res->unshift( $_ );
206 1         139 });
207             $next->foreach(sub
208             {
209 1 0 33 1   26 if( !$self->_is_a( $_ => 'HTML::Object::DOM::Text' ) &&
210             !$self->_is_a( $_ => 'HTML::Object::DOM::Space' ) )
211             {
212 0         0 return;
213             }
214 1         51 $res->push( $_ );
215 1         55 });
216 1         177 return( $res );
217             }
218              
219             1;
220             # NOTE: POD
221             __END__
222              
223             =encoding utf-8
224              
225             =head1 NAME
226              
227             HTML::Object::DOM::Text - HTML Object DOM Text Class
228              
229             =head1 SYNOPSIS
230              
231             use HTML::Object::DOM::Text;
232             my $text = HTML::Object::DOM::Text->new( value => $some_text ) ||
233             die( HTML::Object::DOM::Text->error, "\n" );
234              
235             =head1 VERSION
236              
237             v0.2.0
238              
239             =head1 DESCRIPTION
240              
241             It inherits from L<HTML::Object::Text> and L<HTML::Object::DOM::CharacterData>
242              
243             =head1 INHERITANCE
244              
245             +-----------------------+ +---------------------------+ +-------------------------+ +----------------------------------+ +-------------------------+
246             | HTML::Object::Element | --> | HTML::Object::EventTarget | --> | HTML::Object::DOM::Node | --> | HTML::Object::DOM::CharacterData | --> | HTML::Object::DOM::Text |
247             +-----------------------+ +---------------------------+ +-------------------------+ +----------------------------------+ +-------------------------+
248             | ^
249             | |
250             v |
251             +-----------------------+ |
252             | HTML::Object::Text | -----------------------------------------------------------------------------------------------------------------+
253             +-----------------------+
254              
255             =head1 PROPERTIES
256              
257             =head2 assignedSlot
258              
259             Normally this is a read-only property, but under perl, you can set or get a L<HTML::Object::DOM::Element::Slot> object associated with the element.
260              
261             See also L<Mozilla documentation|https://developer.mozilla.org/en-US/docs/Web/API/Text/assignedSlot>
262              
263             =head2 nodeValue
264              
265             Sets or gets the text value for this element.
266              
267             =head2 wholeText
268              
269             The read-only C<wholeText> property of the L<HTML::Object::DOM::Text> interface returns the full text of all L<Text|HTML::Object::DOM::Text> nodes logically adjacent to the node. The text is concatenated in document order. This allows specifying any text node and obtaining all adjacent text as a single string.
270              
271             It returns a string with the concanated text.
272              
273             Example:
274              
275             <p id="favy">I like <span class="maybe-not">Shochu</span>, Dorayaki and Natto-gohan.</p>
276              
277             $doc->getElementsByTagName('span')->[0]->remove;
278             # Now paragraph contains 2 text nodes:
279             # 'I like '
280             # ', Dorayaki and Natto-gohan.'
281             say $doc->getElementById('favy')->getFirstChild->wholeText;
282             # I like , Dorayaki and Natto-gohan.
283              
284             See also L<Mozilla documentation|https://developer.mozilla.org/en-US/docs/Web/API/Text/wholeText>
285              
286             =head1 METHODS
287              
288             =head2 getAttributes
289              
290             Returns an empty list in list context, or an empty array reference in scalar context.
291              
292             =head2 getChildNodes
293              
294             Returns an empty list in list context, or an empty array reference in scalar context.
295              
296             =head2 getElementById
297              
298             Returns an empty list in list context, or C<undef> in scalar context.
299              
300             =head2 getFirstChild
301              
302             Returns an empty list in list context, or C<undef> in scalar context.
303              
304             =head2 getLastChild
305              
306             Returns an empty list in list context, or C<undef> in scalar context.
307              
308             =head2 getParentNode
309              
310             Returns the parent node, if any.
311              
312             =head2 getRootNode
313              
314             Returns the L<root node|HTML::Object::DOM::Document>
315              
316             =head2 getValue
317              
318             Returns the text value of this comment, i.e. the text between C<<!--> and C<-->>
319              
320             =head2 is_inside
321              
322             Provided with a node, this will return true if it is inside this text's parent or false otherwise.
323              
324             =head2 isAttributeNode
325              
326             Returns false.
327              
328             =head2 isCommentNode
329              
330             Returns true.
331              
332             =head2 isElementNode
333              
334             Returns false.
335              
336             =head2 isEqualNode
337              
338             Provided with another element object, and this returns true if both text element are the same, or false otherwise.
339              
340             =head2 isNamespaceNode
341              
342             Returns false.
343              
344             =head2 isPINode
345              
346             Returns false.
347              
348             =head2 isProcessingInstructionNode
349              
350             Returns false.
351              
352             =head2 isTextNode
353              
354             Returns false.
355              
356             =head2 parent
357              
358             Set or get this text's parent L<node|HTML::Object::DOM::Node>
359              
360             =head2 replaceWholeText
361              
362             This method of the L<Text|HTML::Object::DOM::Text> interface replaces the text of the node and all of its logically adjacent text nodes with the specified C<text>. The replaced nodes are removed, except the current node.
363              
364             It returns the current node with the newly C<text> set.
365              
366             Example:
367              
368             <p id="favy">I like apple,<span class="and"> and</span> orange,<span class="and"> and</span> kaki</p>
369             $doc->getElementsByTagName('span')->foreach(sub
370             {
371             $_->remove;
372             });
373             # Now text is: I like apple, orange, kaki
374             # which are 3 text nodes
375             # Take the 2nd one (for example) and set a new text for it and its adjacent siblings
376             $doc->getElementById('favy')->getChildNodes->[1]->replaceWholeText( 'I like fruits' );
377             # Now the whole chunk has become:
378             # <p id="favy">I like fruits</p>
379              
380             See also L<Mozilla documentation|https://developer.mozilla.org/en-US/docs/Web/API/Text/replaceWholeText>
381              
382             =head2 splitText
383              
384             Provided with an C<offset> position and this method breaks the L<Text|HTML::Object::DOM::Text> node into two nodes at the specified C<offset>, keeping both nodes in the tree as siblings.
385              
386             After the split, the current node contains all the content up to the specified offset point, and a newly created node of the same type contains the remaining text. The newly created node is returned to the caller. If the original node had a parent, the new node is inserted as the next sibling of the original node. If the offset is equal to the length of the original node, the newly created node has no data.
387              
388             It returns the newly created L<Text|HTML::Object::DOM::Text> node that contains the text after the specified offset point.
389              
390             It returns an C<HTML::Object::IndexSizeError> if the specified C<offset> is greater than the size of the node's text.
391              
392             Example:
393              
394             <p>foobar</p>
395              
396             my $p = $doc->getElementsByTagName('p')->first;
397             # Get contents of <p> as a text node
398             my $foobar = $p->firstChild;
399              
400             # Split 'foobar' into two text nodes, 'foo' and 'bar',
401             # and save 'bar' as a const
402             my $bar = $foobar->splitText(3);
403              
404             # Create a <u> element containing ' new content '
405             my $u = $doc->createElement('u');
406             $u->appendChild( $doc->createTextNode( ' new content ' ) );
407             # Add <u> before 'bar'
408             $p->insertBefore( $u, $bar );
409             # The result is: <p>foo<u> new content </u>bar</p>
410              
411             See also L<Mozilla documentation|https://developer.mozilla.org/en-US/docs/Web/API/Text/splitText>
412              
413             =head2 string_value
414              
415             Returns the content of the comment as a string.
416              
417             =head2 toString
418              
419             Returns the content of the comment as a string.
420              
421             =head1 AUTHOR
422              
423             Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>
424              
425             =head1 SEE ALSO
426              
427             L<Mozilla documentation|https://developer.mozilla.org/en-US/docs/Web/API/Text>
428              
429             =head1 COPYRIGHT & LICENSE
430              
431             Copyright(c) 2021 DEGUEST Pte. Ltd.
432              
433             All rights reserved
434              
435             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
436              
437             =cut