File Coverage

lib/HTML/Object.pm

Criterion	Covered	Total	%
statement	344	712	48.3
branch	84	546	15.3
condition	55	269	20.4
subroutine	56	68	82.3
pod	30	30	100.0
total	569	1625	35.0

line	stmt	bran	cond	sub	pod	time	code
1							##----------------------------------------------------------------------------
2							## HTML Object - ~/lib/HTML/Object.pm
3							## Version v0.2.8
4							## Copyright(c) 2023 DEGUEST Pte. Ltd.
5							## Author: Jacques Deguest <jack@deguest.jp>
6							## Created 2021/04/20
7							## Modified 2023/10/05
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;
15							BEGIN
16							{
17	29			29		326567	use strict;
	29					93
	29					860
18	29			29		169	use warnings;
	29					60
	29					743
19	29			29		172	use warnings::register;
	29					50
	29					3483
20	29			29		1477	use parent qw( Module::Generic );
	29					947
	29					209
21	29			29		3238167	use vars qw( $DICT $LINK_ELEMENTS $FATAL_ERROR $GLOBAL_DOM $VERSION );
	29					82
	29					1947
22	29			29		18607	use curry;
	29					9760
	29					989
23	29			29		17676	use Devel::Confess;
	29					221851
	29					156
24	29			29		2044	use Encode ();
	29					83
	29					578
25	29			29		14466	use Filter::Util::Call;
	29					22367
	29					1936
26	29			29		12741	use HTML::Object::Closing;
	29					169
	29					515
27	29			29		28489	use HTML::Object::Comment;
	29					77
	29					350
28	29			29		18015	use HTML::Object::Declaration;
	29					104
	29					383
29	29			29		18278	use HTML::Object::Document;
	29					90
	29					322
30	29			29		7430	use HTML::Object::Element;
	29					59
	29					207
31	29			29		17082	use HTML::Object::Space;
	29					68
	29					317
32	29			29		17244	use HTML::Object::Text;
	29					76
	29					324
33	29			29		23788	use HTML::Parser;
	29					154531
	29					1248
34	29			29		18790	use JSON;
	29					267640
	29					173
35	29			29		40701	use Module::Generic::File qw( file );
	29					1866713
	29					447
36	29			29		11319	use Nice::Try;
	29					60
	29					320
37	29			29		44360595	use Scalar::Util ();
	29					73
	29					2172
38	29			29		104	our $VERSION = 'v0.2.8';
39	29					91	our $DICT = {};
40	29					72	our $LINK_ELEMENTS = {};
41	29					666	our $FATAL_ERROR = 0;
42							};
43
44	29			29		186	use strict;
	29					82
	29					895
45	29			29		189	use warnings;
	29					50
	29					37029
46
47							{
48							my $me = file( __FILE__ );
49							my $path = $me->parent;
50							my $dict_json = 'html_tags_dict.json';
51							my $tags_repo = $path->child( $dict_json );
52							if( $tags_repo->exists )
53							{
54							try
55							{
56							my $json = $tags_repo->load_utf8 \|\|
57							die( "Unable to open html tags json dictionary \"$tags_repo\": ", $tags_repo->error, "\n" );
58							my $j = JSON->new->relaxed->utf8;
59							my $hash = $j->decode( $json );
60							die( "No html tags found inside dictionary file \"$tags_repo\"\n" ) if( !scalar( keys( %{$hash->{dict}} ) ) );
61							$DICT = $hash->{dict};
62							for( keys( %$DICT ) )
63							{
64							if( exists( $DICT->{ $_ }->{link_in} ) )
65							{
66							$LINK_ELEMENTS->{ $_ } = $DICT->{ $_ }->{link_in};
67							}
68							}
69							}
70							catch( $e )
71							{
72							die( "Fatal error occurred while trying to load html tags json dictionary \"$tags_repo\": $e\n" );
73	29			29		268	}
	29					76
	29					99879
74							}
75							else
76							{
77							die( "Missing core file \"$dict_json\"\n" );
78							}
79							}
80
81							sub import
82							{
83	42			42		4488	my $class = shift( @_ );
84	42					162	my $hash = {};
85	42					272	for( my $i = 0; $i < scalar( @_ ); $i++ )
86							{
87	6	100	33			163	if( $_[$i] eq 'debug' \|\|
			33
			33
			66
			66
88							$_[$i] eq 'debug_code' \|\|
89							$_[$i] eq 'debug_file' \|\|
90							$_[$i] eq 'fatal_error' \|\|
91							$_[$i] eq 'global_dom' \|\|
92							$_[$i] eq 'try_catch' )
93							{
94	2					24	$hash->{ $_[$i] } = $_[$i+1];
95	2					11	CORE::splice( @_, $i, 2 );
96	2					11	$i--;
97							}
98							}
99
100							{
101	42					100	local $Exporter::ExportLevel = 1;
	42					136
102	42					2644	Exporter::import( $class, @_ );
103							}
104	42	50				371	$hash->{debug} = 0 if( !CORE::exists( $hash->{debug} ) );
105	42	100				298	$hash->{global_dom} = 0 if( !CORE::exists( $hash->{global_dom} ) );
106	42	50				233	$hash->{debug_code} = 0 if( !CORE::exists( $hash->{debug_code} ) );
107	42	50				250	$hash->{fatal_error} = 0 if( !CORE::exists( $hash->{fatal_error} ) );
108	42	50				247	$hash->{try_catch} = 0 if( !CORE::exists( $hash->{try_catch} ) );
109	42	50				187	if( $hash->{fatal_error} )
110							{
111	0					0	$FATAL_ERROR = 1;
112							}
113
114	42	50				186	if( $hash->{try_catch} )
115							{
116							# Nice::Try is among our dependency, so we can load it safely
117	0					0	require Nice::Try;
118	0					0	Nice::Try->export_to_level( 1, @_ );
119							}
120
121	42	100				1271	if( $hash->{global_dom} )
122							{
123	2		33			59	Filter::Util::Call::filter_add( bless( $hash => ( ref( $class ) \|\| $class ) ) );
124	2					2330	require HTML::Object::XQuery;
125	2					444	HTML::Object::XQuery->export_to_level( 1, @_ );
126							# Same as Firefox, Chrome or Safari do: default dom for blank page
127	2					212	our $GLOBAL_DOM = __PACKAGE__->new( debug => $hash->{debug} )->parse( <<EOT );
128							<html><head></head><body></body></html>
129							EOT
130							}
131							}
132
133							sub filter
134							{
135	2			2	1	711	my( $self ) = @_ ;
136	2					6	my( $status, $last_line );
137	2					3	my $line = 0;
138	2					6	my $code = '';
139	2	50				12	if( !$self->{global_dom} )
140							{
141	0					0	Filter::Util::Call::filter_del();
142	0					0	$status = 1;
143	0					0	return( $status );
144							}
145	2					63	while( $status = Filter::Util::Call::filter_read() )
146							{
147	281	50				390	return( $status ) if( $status < 0 );
148	281					244	$line++;
149	281	50				396	if( /^__(?:DATA\|END)__/ )
150							{
151	0					0	last;
152							}
153
154							s{
155							(?<!\\)\$\(
156							}
157	15					96	{
158	281					942	"xq("
159							}gexs;
160	2	50				16	}
161							if( $self->{debug_file} )
162	0	0				0	{
163							if( open( my $fh, ">$self->{debug_file}" ) )
164	0					0	{
165	0					0	binmode( $fh, ':utf8' );
166	0					0	print( $fh $_ );
167							close( $fh );
168							}
169	2					66	}
170							return( $line );
171							}
172
173							sub init
174	72			72	1	29822	{
175	72					351	my $self = shift( @_ );
176	72	50				508	$self->{_init_strict_use_sub} = 1;
177	72	50				605	$self->{_exception_class} = 'HTML::Object::Exception' unless( CORE::exists( $self->{_exception_class} ) );
178	72					8731	$self->SUPER::init( @_ ) \|\| return( $self->pass_error );
179							my $p = HTML::Parser->new(
180							api_version => 3,
181							start_h => [ $self->curry::add_start, 'self, tagname, attr, attrseq, text, column, line, offset, offset_end'],
182							end_h => [ $self->curry::add_end, 'self, tagname, attr, attrseq, text, column, line, offset, offset_end' ],
183							marked_sections => 1,
184							comment_h => [ $self->curry::add_comment, 'self, text, column, line, offset, offset_end'],
185							declaration_h => [ $self->curry::add_declaration, 'self, text, column, line, offset, offset_end'],
186							default_h => [ $self->curry::add_default, 'self, tagname, attr, attrseq, text, column, line, offset, offset_end'],
187							text_h => [ $self->curry::add_text, 'self, text, column, line, offset, offset_end'],
188							# This is not activated, because as per the documentation, this will call an 'end tag' caller, and this could imply <br></br> for other unknown tags, whereas with <br /> we know for sure this is an empty tag
189							# empty_element_tags => 1,
190							unbroken_text => 1,
191	72					17708	);
192	72					454	$self->{document} = '';
193	72					268	$self->{current_parent} = '';
194	72					390	$self->{_parser} = $p;
195	72					442	$self->{_elems} = [];
196							return( $self );
197							}
198
199							sub add_comment
200	7			7	1	114	{
201	7					34	my $self = shift( @_ );
202	7					20	my @args = @_;
203	7					113	my $opts = {};
204	7					60	my @p = qw( p raw col line offset offset_end );
205	7					44	@$opts{ @p } = @args;
206	7					207	my $parent = $self->current_parent;
207	7					94	my $val = $opts->{raw};
208							$val =~ s,^\<\!\-\-\|\-\-\>$,,gs;
209							my $e = $self->new_comment({
210							column => $opts->{col},
211							line => $opts->{line},
212							offset => $opts->{offset},
213	7		50			78	original => $opts->{raw},
214							parent => $parent,
215							value => $val,
216							debug => $self->debug,
217	7					60	}) \|\| return;
218	7					879	$parent->children->push( $e );
219							return( $e );
220							}
221
222							sub add_declaration
223	19			19	1	238	{
224	19					83	my $self = shift( @_ );
225	19					51	my @args = @_;
226	19					167	my $opts = {};
227	19					105	my @p = qw( p raw col line offset offset_end );
228	19					129	@$opts{ @p } = @args;
229	19	100				643	my $parent = $self->current_parent;
230							return if( !$self->_is_a( $parent => 'HTML::Object::DOM::Document' ) );
231							my $e = $self->new_declaration({
232							column => $opts->{col},
233							line => $opts->{line},
234							offset => $opts->{offset},
235	18					1006	original => $opts->{raw},
236							parent => $parent,
237							debug => $self->debug,
238							});
239	18					240	# $parent->children->push( $e );
240	18					1081	$self->document->declaration( $e );
241	18					2398	$parent->children->push( $e );
242							return( $e );
243							}
244
245							sub add_default
246	98			98	1	1773	{
247	98					458	my $self = shift( @_ );
248	98					252	my @args = @_;
249	98					727	my $opts = {};
250	98					1012	my @p = qw( p tag attr seq raw col line offset offset_end );
251	98	50	33			1811	@$opts{ @p } = @args;
252							return if( !CORE::length( $opts->{raw} ) && !defined( $opts->{tag} ) );
253	0					0	# Unknown tag, so we check if there is a "/>" to determine if this is an empty (void) tag or not
254	0					0	my $attr = $opts->{attr};
255	0	0				0	my $def = {};
256	0					0	$def->{is_empty} = exists( $attr->{'/'} ) ? 1 : 0;
257	0	0				0	my $parent = $self->current_parent;
258							if( !length( $opts->{tag} ) )
259	0					0	{
260							return( $self->add_text( @args ) );
261							}
262							# Check the current parent and see if we need to close it.
263							# If this new tag is a non-empty tag (i.e. non-void) and the current parent has not been closed,
264							# implicitly close it now, by setting that tag's parent as the current parent
265							# This is what Mozilla does:
266							# Ref: <https://bugzilla.mozilla.org/show_bug.cgi?id=820926>
267							# NOTE This needs to be done in post processing not during initial parsing, because at this point in the process we have not yet seen the closing tag, and we might see it later, so making guesses here is ill-advised.
268							# if( !$parent->is_closed &&
269							# !$def->{is_empty} &&
270							# $parent &&
271							# !$parent->isa( 'HTML::Object::Document' ) &&
272							# $parent->tag ne 'html' )
273							# {
274							# $parent = $parent->parent;
275							# }
276							my $e = $self->new_element({
277							attributes => $opts->{attr},
278							attributes_sequence => $opts->{seq},
279							column => $opts->{col},
280							is_empty => $def->{is_empty},
281							line => $opts->{line},
282							offset => $opts->{offset},
283							original => $opts->{raw},
284							parent => $parent,
285	0		0			0	tag => $opts->{tag},
286							debug => $self->debug,
287	0					0	}) \|\| return;
288	0	0				0	$parent->children->push( $e );
289							if( !$def->{is_empty} )
290	0					0	{
291							$self->current_parent( $e );
292	0					0	}
293							return( $e );
294							}
295
296							sub add_end
297	217			217	1	3143	{
298	217					939	my $self = shift( @_ );
299	217					603	my @args = @_;
300	217					1548	my $opts = {};
301	217					2102	my @p = qw( p tag attr seq raw col line offset offset_end );
302	217					1263	@$opts{ @p } = @args;
303	217					7181	my $me = $self->current_parent;
304	217	50				5859	my $parent = $me->parent;
305							if( $opts->{tag} ne $me->tag )
306	0	0				0	{
307							warn( "Oops, something is wrong in the parsing. I was expecting a closing tag for \"", $me->tag, "\" that started at line \"", $me->line, "\" but instead found a closing tag for \"$opts->{tag}\" at line \"$opts->{line}\" and column \"$opts->{col}\": $opts->{raw}\n" ) if( $self->_warnings_is_enabled );
308							}
309							else
310							{
311							my $e = $self->new_closing({
312							attributes => $opts->{attr},
313							attributes_sequence => $opts->{seq},
314							column => $opts->{col},
315							line => $opts->{line},
316							offset => $opts->{offset},
317							original => $opts->{raw},
318	217		50			186895	tag => $opts->{tag},
319							debug => $self->debug,
320	217					3535	}) \|\| return;
321	217					212352	$me->is_closed(1);
322							$me->close_tag( $e );
323	217					14331	# $parent->children->push( $e );
324							$self->current_parent( $parent );
325							}
326							}
327
328							sub add_space
329	369			369	1	10852	{
330	369					2076	my $self = shift( @_ );
331	369					68319	my $opts = $self->_get_args_as_hash( @_ );
332	369		50			11412	my $parent = $self->current_parent;
333	369					2577	my $e = $self->new_space( $opts ) \|\| return;
334	369					50956	$parent->children->push( $e );
335							return( $e );
336							}
337
338							sub add_start
339	321			321	1	4156	{
340	321					1389	my $self = shift( @_ );
341	321					864	my @args = @_;
342	321					2290	my $opts = {};
343	321					2868	my @p = qw( p tag attr seq raw col line offset offset_end );
344	321					1729	@$opts{ @p } = @args;
345	321	100				11239	my $parent = $self->current_parent;
346							if( $opts->{tag} =~ s,/,, )
347	1					4	{
348							$opts->{attr}->{'/'} = '/';
349	321					1778	}
350							my $def = $self->get_definition( $opts->{tag} );
351	321	50				1676	# Make some easy guess
352							if( !scalar( keys( %$def ) ) )
353	0	0				0	{
354							$def->{is_empty} = 1 if( CORE::exists( $opts->{attr}->{'/'} ) );
355							# "Return HTMLUnknownElement"
356	0					0	# <https://html.spec.whatwg.org/multipage/dom.html#htmlunknownelement>
357							$def->{class} = 'HTML::Object::DOM::Unknown';
358	321	50				1305	}
359							$def->{is_empty} = 0 unless( CORE::exists( $def->{is_empty} ) );
360							# Check the current parent and see if we need to close it.
361							# If this new tag is a non-empty tag (i.e. non-void) and the current parent has not been closed,
362							# implicitly close it now, by setting that tag's parent as the current parent
363							# This is what Mozilla does:
364							# Ref: <https://bugzilla.mozilla.org/show_bug.cgi?id=820926>
365							# NOTE This needs to be done in post processing not during initial parsing, because at this point in the process we have not yet seen the closing tag, and we might see it later, so making guesses here is ill-advised.
366							# if( !$parent->is_closed &&
367							# !$def->{is_empty} &&
368							# $parent &&
369							# !$parent->isa( 'HTML::Object::Document' ) &&
370							# $parent->tag ne 'html' )
371							# {
372							# $parent = $parent->parent;
373	321		100			1429	# }
374	321					681	$def->{class} //= '';
375							my $e;
376							my $params =
377							{
378							attributes => $opts->{attr},
379							attributes_sequence => $opts->{seq},
380							column => $opts->{col},
381							is_empty => $def->{is_empty},
382							line => $opts->{line},
383							offset => $opts->{offset},
384							original => $opts->{raw},
385							parent => $parent,
386							tag => $opts->{tag},
387	321					2721	# and
388							debug => $self->debug,
389							};
390
391	321	100				11241	# If this tag is handled by a special class, instantiate the object by this class
392							if( $def->{class} )
393	278		50			1911	{
394							$e = $self->new_special( $def->{class} => $params ) \|\| return;
395							}
396							else
397	43		50			204	{
398							$e = $self->new_element( $params ) \|\| return;
399	321					1850	}
400							$parent->children->push( $e );
401	321	100				33702	# If this element is an element that, by nature, can contain other elements we mark it as the last element seen so it can be used as a parent. When we close it, we switch the parent to its parent .
402							if( !$def->{is_empty} )
403	221					3209	{
404							$self->current_parent( $e );
405	321					20485	}
406							return( $e );
407							}
408
409							sub add_text
410	484			484	1	17147	{
411	484					1995	my $self = shift( @_ );
412	484					1311	my @args = @_;
413	484					2622	my $opts = {};
414	484					3197	my @p = qw( p raw col line offset offset_end );
415	484		50			2145	@$opts{ @p } = @args;
416							my $parent = $self->current_parent \|\|
417	484					14515	return( $self->error( "You must create a document first using the new_document() method first before adding text." ) );
418							my $e;
419							# Text can be either some space or letters, digits (non-space characters)
420	484	100				4822	# HTML::Parser does not make the difference, but we do
421							if( $opts->{raw} =~ /^[[:blank:]\h\v]*$/ )
422							{
423							$e = $self->add_space(
424							original => $opts->{raw},
425							column => $opts->{col},
426							line => $opts->{line},
427							offset => $opts->{offset},
428							parent => $parent,
429	369		50			3366	value => $opts->{raw},
430							debug => $self->debug,
431							# No 'value' set on purpose, because if none, then 'original' will be used by
432							# as_string
433							) \|\| return;
434							}
435							else
436							{
437							$e = $self->new_text({
438							column => $opts->{col},
439							line => $opts->{line},
440							offset => $opts->{offset},
441							original => $opts->{raw},
442							parent => $parent,
443	115		50			1148	value => $opts->{raw},
444							debug => $self->debug,
445	115					1430	}) \|\| return;
446							$parent->children->push( $e );
447	484					34833	}
448							return( $e );
449							}
450	179			179	1	625
451							sub current_parent { return( shift->_set_get_object_without_init( 'current_parent', 'HTML::Object::Element', @_ ) ); }
452	0			0	1	0
453							sub dictionary { return( $DICT ); }
454	5			5	1	64
455							sub document { return( shift->_set_get_object( 'document', 'HTML::Object::Document', @_ ) ); }
456
457							sub get_definition
458	340			340	1	910	{
459	340					978	my $self = shift( @_ );
460	340	50				1282	my $tag = shift( @_ );
461							return( $self->error( "No tag was provided to get its definition." ) ) if( !length( $tag ) );
462	340					979	# Just to be sure
463	340	50				1867	$tag = lc( $tag );
464	340					1705	return( {} ) if( !exists( $DICT->{ $tag } ) );
465							return( $DICT->{ $tag } );
466							}
467
468							sub new_closing
469	19			19	1	668	{
470	19		50			139	my $self = shift( @_ );
471							my $e = HTML::Object::Closing->new( @_ ) \|\|
472	19					290	return( $self->pass_error( HTML::Object::Closing->error ) );
473							return( $e );
474							}
475
476							sub new_comment
477	1			1	1	33	{
478	1		50			27	my $self = shift( @_ );
479							my $e = HTML::Object::Comment->new( @_ ) \|\|
480	1					16	return( $self->pass_error( HTML::Object::Comment->error ) );
481							return( $e );
482							}
483
484							sub new_declaration
485	0			0	1	0	{
486	0		0			0	my $self = shift( @_ );
487							my $e = HTML::Object::Declaration->new( @_ ) \|\|
488	0					0	return( $self->pass_error( HTML::Object::Declaration->error ) );
489							return( $e );
490							}
491
492							sub new_document
493	3			3	1	736319	{
494	3		50			57	my $self = shift( @_ );
495							my $e = HTML::Object::Document->new( @_ ) \|\|
496	3					36	return( $self->pass_error( HTML::Object::Document->error ) );
497							return( $e );
498							}
499
500							sub new_element
501	35			35	1	66	{
502	35		50			182	my $self = shift( @_ );
503							my $e = HTML::Object::Element->new( @_ ) \|\|
504	35					564	return( $self->pass_error( HTML::Object::Element->error ) );
505							return( $e );
506							}
507
508							sub new_space
509	37			37	1	74	{
510	37		50			226	my $self = shift( @_ );
511							my $e = HTML::Object::Space->new( @_ ) \|\|
512	37					471	return( $self->pass_error( HTML::Object::Space->error ) );
513							return( $e );
514							}
515
516							sub new_special
517	292			292	1	875	{
518	292					749	my $self = shift( @_ );
519	292	50				1836	my $class = shift( @_ );
520	292		50			62266	$self->_load_class( $class ) \|\| return( $self->pass_error );
521	292					4598	my $e = $class->new( @_ ) \|\| return( $self->pass_error( $class->error ) );
522							return( $e );
523							}
524
525							sub new_text
526	8			8	1	258	{
527	8		50			66	my $self = shift( @_ );
528							my $e = HTML::Object::Text->new( @_ ) \|\|
529	8					120	return( $self->pass_error( HTML::Object::Text->error ) );
530							return( $e );
531							}
532
533							sub parse
534	12			12	1	3045	{
535	12					39	my $self = shift( @_ );
536	12					100	my $this = shift( @_ );
537	12	100	33			347	my $opts = $self->_get_args_as_hash( @_ );
		50	66
			66
538							if( ref( $this ) eq 'CODE' \|\| ref( $this ) eq 'GLOB' \|\| "$this" =~ /<\w+/ \|\| CORE::length( "$this" ) > 1024 )
539	11					80	{
540							return( $self->parse_data( $this, $opts ) );
541							}
542							elsif( ref( $this ) )
543	0					0	{
544							return( $self->error( "I was provided a reference (", overload::StrVal( $this ), ") to parse html data, but I do not know what to do with it." ) );
545							}
546							else
547	1					8	{
548							return( $self->parse_file( $this, $opts ) );
549							}
550							}
551
552							sub parse_data
553	44			44	1	428	{
554	44					139	my $self = shift( @_ );
555	44					217	my $html = shift( @_ );
556	44	50	33			2104	my $opts = $self->_get_args_as_hash( @_ );
	44					111
	44					105
	44					295
	0					0
	44					101
	44					228
	44					127
557	44			44		97	try
558	44	50				236	{
559							if( $opts->{utf8} )
560	0					0	{
561							$html = Encode::decode( 'utf8', $html, Encode::FB_CROAK );
562							}
563	44	0	50			469	}
	44	0	33			206
	44	0				193
	44	0				229
	44	0				422
	44	0				95
	44	0				101
	44	0				301
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	50				0
	0	50				0
	0	50				0
	0	50				0
	0	50				0
	0	0				0
	0	50				0
	0					0
	0					0
	0					0
	44					272
	0					0
	44					653
	0					0
	0					0
	44					370
	44					262
	44					135
	44					163
	0					0
	0					0
	0					0
	0					0
564	0			0		0	catch( $e )
565	0					0	{
566	29	0	0	29		286	return( $self->error( "Error found while utf8 decoding ", length( $html ), " bytes of html data provided." ) );
	29	0	0			74
	29	0	33			45157
	0	0	33			0
	0	0	33			0
	0	0	0			0
	0	0	0			0
	0	0	0			0
	0	0	0			0
	0	0	0			0
	0	0	0			0
	0	0	33			0
	0	0	33			0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	50				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	44	0				176
	0	0				0
	44	0				1999
	0	0				0
	0	0				0
	0	0				0
	0	50				0
	0	50				0
	0	0				0
	0	0				0
	0	0				0
	0	50				0
	0	50				0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	44					272
	0					0
	0					0
	0					0
	0					0
	44					214
567							}
568	44					97
569	44	50	33			267	my $e;
570							if( length( $self->{current_parent} ) && $self->_is_object( $self->{current_parent} ) )
571	0					0	{
572							$e = $self->current_parent;
573							}
574							else
575	44					219	{
576	44					342	$e = $self->new_document( debug => $self->debug );
577	44					2133	$self->document( $e );
578	44	100				2036	$self->current_parent( $e );
579							if( $self->isa( 'HTML::Object::DOM' ) )
580	42	100				222	{
581							if( my $code = $self->onload )
582	2					2041	{
583							$e->onload( $code );
584	42	100				33181	}
585							if( my $code = $self->onreadystatechange )
586	1					1288	{
587							$e->onreadystatechange( $code );
588							}
589							}
590	44					30660	}
591	44					1518	my $doc = $self->document;
592	44					1475	my $p = $self->parser;
593	44					663	$self->_set_state( 'loading' => $doc );
594	44					2200	$p->parse( $html );
595	44					521	$self->_set_state( 'interactive' => $doc );
596	44					287	$self->post_process( $e );
597	44					883	$self->_set_state( 'complete' => $doc );
598	44					507	$p->eof;
599							return( $e );
600							}
601
602							sub parse_file
603	5			5	1	114	{
604	5		50			37	my $self = shift( @_ );
605	5					41	my $file = shift( @_ ) \|\| return( $self->error( "No file to parse was provided." ) );
606	5					483	my $opts = $self->_get_args_as_hash( @_ );
607	5	50				674135	my $f = $self->new_file( $file );
		50
608							if( !$f->exists )
609	0					0	{
610							return( $self->error( "File to parse \"$file\" does not exist." ) );
611							}
612							elsif( $f->is_empty )
613	0					0	{
614							return( $self->error( "File to parse \"$file\" is empty." ) );
615	5					188061	}
616	5	50				113	my $params = {};
617	5		50			119	$params->{binmode} = 'utf8' if( $opts->{utf8} );
618							my $io = $f->open( '<', $params ) \|\|
619	5					26914	return( $self->error( "Unable to open file to parse \"$file\": ", $f->error ) );
620	5					67	my $e = $self->new_document( _last_modified => $f->mtime );
621	5	100				394	$self->document( $e );
622							if( $self->isa( 'HTML::Object::DOM' ) )
623	4	50				43	{
624							if( my $code = $self->onload )
625	0					0	{
626							$e->onload( $code );
627	4	50				3657	}
628							if( my $code = $self->onreadystatechange )
629	0					0	{
630							$e->onreadystatechange( $code );
631							}
632	5					3374	}
633	5					460	$self->current_parent( $e );
634	5					79	$self->_set_state( 'loading' => $e );
635	5					279	my $p = $self->parser;
636	5					67	$p->parse_file( $io );
637	5					1098	$io->close;
638	5					113	$self->_set_state( 'interactive' => $e );
639	5					40	$self->post_process( $e );
640	5					111	$self->_set_state( 'complete' => $e );
641							return( $e );
642							}
643
644							sub parse_url
645	0			0	1	0	{
646	0					0	my $self = shift( @_ );
647	0	0	0			0	my $uri;
			0
			0
			0
648							if( ( scalar( @_ ) == 1 && ref( $_[0] ) ne 'HASH' ) \|\|
649							( scalar( @_ ) > 1 &&
650							(
651							( @_ % 2 ) \|\|
652							( scalar( @_ ) == 2 && ref( $_[1] ) eq 'HASH' )
653							)
654							) )
655	0					0	{
656							$uri = shift( @_ );
657	0					0	}
658	0	0	0			0	my $opts = $self->_get_args_as_hash( @_ );
659	0	0				0	$uri = CORE::delete( $opts->{uri} ) if( defined( $opts->{uri} ) && CORE::length( $opts->{uri} ) );
660							if( !$self->_load_class( 'LWP::UserAgent', { version => '6.49' } ) )
661	0					0	{
662							return( $self->error( "LWP::UserAgent version 6.49 or higher is required to use load()" ) );
663	0	0				0	}
664							if( !$self->_load_class( 'URI', { version => '1.74' } ) )
665	0					0	{
666							return( $self->error( "URI version 1.74 or higher is required to use load()" ) );
667	0		0			0	}
668	0	0	0			0	$opts->{timeout} //= 10;
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
669	0			0		0	try
670	0					0	{
671							$uri = URI->new( "$uri" );
672	0	0	0			0	}
	0	0	0			0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
673	0			0		0	catch( $e )
674	0					0	{
675	29	0	0	29		280	return( $self->error( "Bad url provided \"$uri\": $e" ) );
	29	0	0			93
	29	0	0			32750
	0	0	0			0
	0	0	0			0
	0	0	0			0
	0	0	0			0
	0	0	0			0
	0	0	0			0
	0	0	0			0
	0	0	0			0
	0	0	0			0
	0	0	0			0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
676							}
677	0					0
678	0	0	0			0	my $content;
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
679	0			0		0	try
680							{
681							my $ua = LWP::UserAgent->new(
682							agent => "HTML::Object/$VERSION",
683	0					0	timeout => $opts->{timeout},
684	0	0	0			0	);
	0					0
685	0	0	0			0	my $resp = $ua->get( $uri, ( CORE::exists( $opts->{headers} ) && defined( $opts->{headers} ) && ref( $opts->{headers} ) eq 'HASH' && scalar( keys( %{$opts->{headers}} ) ) ) ? %{$opts->{headers}} : () );
686							if( $resp->header( 'Client-Warning' ) \|\| !$resp->is_success )
687	0					0	{
688							return( $self->error({
689							code => $resp->code,
690							message => $resp->message,
691							}) );
692	0					0	}
693	0					0	$content = $resp->decoded_content;
694							$self->response( $resp );
695	0	0	0			0	}
	0	0	0			0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
696	0			0		0	catch( $e )
697	0					0	{
698	29	0	0	29		282	return( $self->error( "Error making a GET request to $uri: $e" ) );
	29	0	0			71
	29	0	0			31634
	0	0	0			0
	0	0	0			0
	0	0	0			0
	0	0	0			0
	0	0	0			0
	0	0	0			0
	0	0	0			0
	0	0	0			0
	0	0	0			0
	0	0	0			0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0	0				0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
	0					0
699	0					0	}
700	0					0	my $doc = $self->parse_data( $content );
701	0					0	$doc->uri( $uri );
702							return( $doc );
703							}
704	49			49	1	235
705							sub parser { return( shift->_set_get_object_without_init( '_parser', 'HTML::Parser', @_ ) ); }
706
707							sub post_process
708	266			266	1	147007	{
709	266					486	my $self = shift( @_ );
710	266	50				863	my $elem = shift( @_ );
711	266	50				3046	return if( !$self->_is_object( $elem ) );
712							return if( !$elem->isa( 'HTML::Object::Element' ) );
713							# Crawl through the tree and look for unclosed tags
714							$elem->children->foreach(sub
715	807			807		273658	{
716	807	100	66			8350	my $e = shift( @_ );
717	321	50	66			189815	return(1) if( $e->isa( 'HTML::Object::Closing' ) \|\| $e->tag->substr( 0, 1 ) eq '_' );
		100	100
		50	66
718							if( $e->is_empty && $e->children->length )
719							{
720							}
721							elsif( $e->is_empty && !$e->attributes->exists( '/' ) )
722							{
723							}
724							elsif( !$e->is_empty && !$e->is_closed )
725	0					0	{
726	0	0				0	my $def = $self->get_definition( $e->tag );
727							if( !$def->{is_empty} )
728							{
729							}
730							else
731							{
732							}
733	321	100				222760	}
734	266					1303	$self->post_process( $e ) if( !$e->is_empty );
735	266					128217	});
736							return( $self );
737							}
738	0			0	1	0
739							sub response { return( shift->_set_get_object_without_init( 'response', 'HTTP::Response', @_ ) ); }
740
741							sub sanity_check
742	0			0	1	0	{
743	0					0	my $self = shift( @_ );
744	0	0				0	my $elem = shift( @_ );
745	0	0				0	return if( !$self->_is_object( $elem ) );
746							return if( !$elem->isa( 'HTML::Object::Element' ) );
747							# Crawl through the tree and look for unclosed tags
748							$elem->children->foreach(sub
749	0			0		0	{
750	0	0	0			0	my $e = shift( @_ );
751	0	0	0			0	return(1) if( $e->isa( 'HTML::Object::Closing' ) \|\| $e->tag->substr( 0, 1 ) eq '_' );
		0	0
		0	0
		0	0
752							if( $e->is_empty && $e->children->length )
753	0					0	{
754							printf( STDOUT "Tag \"%s\" should be empty (void), but it has %d children.\n", $e->tag, $e->children->length );
755							}
756							elsif( $e->is_empty && !$e->attributes->exists( '/' ) )
757	0					0	{
758							printf( STDOUT "Tag \"%s\" at line %d at row %d is an empty (void) tag, but it did not end with />\n", $e->tag, $e->line, $e->column );
759							}
760							elsif( !$e->is_empty && $e->attributes->exists( '/' ) )
761	0					0	{
762							printf( STDOUT "Tag \"%s\" at line %d at row %d is marked as non-empty (non-void), but it ends with />\n", $e->tag, $e->line, $e->column );
763							}
764							elsif( !$e->is_empty && !$e->is_closed )
765	0					0	{
766	0	0				0	my $def = $self->get_definition( $e->tag );
767							if( !$def->{is_empty} )
768	0					0	{
769							printf( STDOUT "Tag \"%s\" at line %d at row %d is an enclosing tag, but it has not been closed.\n", $e->tag, $e->line, $e->column );
770							}
771							else
772	0					0	{
773							printf( STDOUT "Tag \"%s\" at line %d at row %d is an empty (void) tag, but it did not end with />\n", $e->tag, $e->line, $e->column );
774							}
775	0	0				0	}
776	0					0	$self->sanity_check( $e ) if( !$e->is_empty );
777	0					0	});
778							return( $self );
779							}
780
781							sub set_dom
782	0			0	1	0	{
783	0	0				0	my( $this, $html ) = @_;
784							if( defined( $html ) )
785	0	0	0			0	{
		0
786							if( Scalar::Util::blessed( $html ) && $html->isa( 'HTML::Object::Document' ) )
787	0					0	{
788							$GLOBAL_DOM = $html;
789							}
790							elsif( CORE::length( $html ) )
791	0					0	{
792							$GLOBAL_DOM = $this->new->parse( $html );
793							}
794	0					0	}
795							return( $this );
796							}
797
798							sub _set_state
799	147			147		467	{
800	147					556	my $self = shift( @_ );
801							my( $state, $elem ) = @_;
802	147	100				1227	# This feature is only applicable for HTML::Object::DOM
803							return( $self ) unless( $self->isa( 'HTML::Object::DOM' ) );
804	138	50	33			1150	# ... and only for documents
805	138					6770	return if( !defined( $elem ) \|\| !$self->_is_a( $elem => 'HTML::Object::DOM::Document' ) );
806	138					126272	$elem->readyState( $state );
807	138					1702	require HTML::Object::Event;
808							my $event = HTML::Object::Event->new( 'readystate',
809							bubbles => 0,
810							cancelable => 0,
811							detail => { 'state' => $state, document => $elem },
812							target => $elem,
813							);
814	138	100				1582	# $elem->dispatchEvent( $event );
815							if( my $eh = $elem->onreadystatechange )
816	3					433	{
817	3					19	local $_ = $elem;
818	3	50				2300	my $code = $eh->code;
819	3	50				28	warn( "Value for event handler '$code' is not a code reference.\n" ) if( ref( $code ) ne 'CODE' );
820							$code->( $event ) if( ref( $code ) eq 'CODE' );
821	138	100	100			9712	}
822							if( $state eq 'complete' && ( my $code = $elem->onload ) )
823	2					1543	{
824	2					12	local $_ = $elem;
825							$code->( $event );
826	138					36653	}
827							return( $self );
828							}
829
830							1;
831							# NOTE: POD
832							__END__
833
834							=encoding utf-8
835
836							=head1 NAME
837
838							HTML::Object - HTML Parser, Modifier and Query Interface
839
840							=head1 SYNOPSIS
841
842							use HTML::Object;
843							my $p = HTML::Object->new( debug => 5 );
844							my $doc = $p->parse( $file, { utf8 => 1 } ) \|\| die( $p->error, "\n" );
845							print $doc->as_string;
846
847							or, using the HTML DOM implementation same as the Web API:
848
849							use HTML::Object::DOM global_dom => 1;
850							# then you can also use HTML::Object::XQuery for jQuery like DOM manipulation
851							my $p = HTML::Object::DOM->new;
852							my $doc = $p->parse_data( $some_html ) \|\| die( $p->error, "\n" );
853							$('div.inner')->after( "<p>Test</p>" );
854
855							# returns an HTML::Object::DOM::Collection
856							my $divs = $doc->getElementsByTagName( 'div' );
857							my $new = $doc->createElement( 'div' );
858							$new->setAttribute( id => 'newDiv' );
859							$divs->[0]->parent->replaceChild( $new, $divs->[0] );
860							# etc.
861
862							To enable fatal error and also implement try-catch (using L<Nice::Try>) :
863
864							use HTML::Object fatal_error => 1, try_catch => 1;
865
866							=head1 VERSION
867
868							v0.2.8
869
870							=head1 DESCRIPTION
871
872							This module is yet another HTML parser, manipulation and query interface, but probably the most comprehensive one. It uses the C parser from L<HTML::Parser> and has the unique particularity that it does not try to decode the entire html document tree only to re-encode it when printing out its data as string like so many other html parsers out there do. Instead, it modifies only the parts required. The rest is returned exactly as it was found in the HTML. This is faster and safer.
873
874							This module contains 144 modules to closely implement the HTML standard as documented on L<Mozilla documentation\|https://developer.mozilla.org/en-US/docs/Web/API/HTML_DOM_API>.
875
876							It uses an external json data dictionary file of html tags (C<html_tags_dict.json>).
877
878							There are 3 ways to manipulate and query the html data:
879
880							=over 4
881
882							=item 1. L<HTML::Object::Element>
883
884							This is lightweight and simple
885
886							=item 2. L<HTML::Object::DOM>
887
888							This is an alternative HTML parser also based on L<HTML::Parser>, and that implements fully the Web API with DOM (Data Object Model), so you can query the HTML with perl equivalent to JavaScript methods of the Web API. It has been designed to be strictly identical to the Web API.
889
890							=item 3. L<HTML::Object::XQuery>
891
892							This interface provides a jQuery like API and requires the use of L<HTML::Object::DOM>. However, this is not designed to be a perl implementation of JavaScript, but rather a perl implementation of DOM manipulation methods found in jQuery.
893
894							=back
895
896							Note that this interface does not enforce HTML standard. It is up to you the developer to decide what value to use and where the HTML elements should go in the HTML tree and what to do with it.
897
898							=head1 METHODS
899
900							=head2 new
901
902							Instantiate a new L<HTML::Object> object.
903
904							You need to instantiate a new object prior to parse any new document. It cannot be re-used to parse another document, or if you really wanted to, you would first need to unset L</document> and unset L</current_parent>:
905
906							$p->document( undef );
907							$p->current_parent( undef );
908
909							But, it is just as fast to do:
910
911							$p = HTML::Object->new;
912
913							=head2 add_comment
914
915							This is a parser method called that will add a comment to the stack of html elements.
916
917							=head2 add_declaration
918
919							This is a parser method called that will add a declaration to the stack of html elements.
920
921							=head2 add_default
922
923							This is a parser method called that will add a default html tag to the stack of html elements.
924
925							=head2 add_end
926
927							This is a parser method called that will add a closing html tag to the stack of html elements.
928
929							=head2 add_space
930
931							This is a parser method called that will add a space to the stack of html elements.
932
933							=head2 add_start
934
935							This is a parser method called that will add a starting html tag to the stack of html elements.
936
937							=head2 add_text
938
939							This is a parser method called that will add a text to the stack of html elements.
940
941							=head2 current_parent
942
943							Sets or gets the current parent, which must be an L<HTML::Object::Element> object or an inheriting class.
944
945							=head2 dictionary
946
947							Returns an hash reference containing the HTML tags dictionary. Its structure is:
948
949							=over 4
950
951							=item * dict
952
953							This property reflects an hash containing all the known tags. Each tag has the following possible properties:
954
955							=over 8
956
957							=item * description
958
959							String
960
961							=item * is_deprecated
962
963							Boolean value
964
965							=item * is_empty
966
967							Boolean value
968
969							=item * is_inline
970
971							Boolean value
972
973							=item * is_svg
974
975							Boolean value that describes whether this is a tag dedicated to svg.
976
977							=item * link_in
978
979							Array reference of HTML attributes containing links
980
981							=item * ref
982
983							The reference URL to the online web documentation for this tag.
984
985							=back
986
987							=item * meta
988
989							This property holds an hash reference containing the following meta information:
990
991							=over 8
992
993							=item * author
994
995							String
996
997							=item * updated
998
999							ISO 8601 datetime
1000
1001							=item * version
1002
1003							Version number
1004
1005							=back
1006
1007							=back
1008
1009							=head2 document
1010
1011							Sets or gets the document L<HTML::Object::Document> object.
1012
1013							=head2 get_definition
1014
1015							Get the hash definition for a given tag (case does not matter).
1016
1017							The tags definition is taken from the external file C<html_tags_dict.json> that is provided with this package.
1018
1019							=head2 new_closing
1020
1021							Creates and returns a new closing html element L<HTML::Object::Closing>, passing it any arguments provided.
1022
1023							=head2 new_comment
1024
1025							Creates and returns a new closing html element L<HTML::Object::Comment>, passing it any arguments provided.
1026
1027							=head2 new_declaration
1028
1029							Creates and returns a new closing html element L<HTML::Object::Declaration>, passing it any arguments provided.
1030
1031							=head2 new_document
1032
1033							Creates and returns a new closing html element L<HTML::Object::Document>, passing it any arguments provided.
1034
1035							=head2 new_element
1036
1037							Creates and returns a new closing html element L<HTML::Object::Element>, passing it any arguments provided.
1038
1039							=head2 new_space
1040
1041							Creates and returns a new closing html element L<HTML::Object::Space>, passing it any arguments provided.
1042
1043							=head2 new_special
1044
1045							Provided with an HTML tag class name and hash or hash reference of options and this will load that class and instantiate an object passing it the options provided. It returns the object thus Instantiated.
1046
1047							This is used to instantiate object for special class to handle certain HTML tag, such as C<a>
1048
1049							=head2 new_text
1050
1051							Creates and returns a new closing html element L<HTML::Object::Text>, passing it any arguments provided.
1052
1053							=head2 parse
1054
1055							Provided with some C<data> (see below), and some options as hash or hash reference and this will parse it and return a new L<HTML::Object::Document> object.
1056
1057							Possible accepted data are:
1058
1059							=over 4
1060
1061							=item I<code>
1062
1063							L</parse_data> will be called with it.
1064
1065							=item I<glob>
1066
1067							L</parse_data> will be called with it.
1068
1069							=item I<string>
1070
1071							L</parse_file> will be called with it.
1072
1073							=back
1074
1075							Other reference will return an error.
1076
1077							=head2 parse_data
1078
1079							Provided with some C<data> and some options as hash or hash reference and this will parse the given data and return a L<HTML::Object::Document> object.
1080
1081							If the option I<utf8> is provided, the C<data> received will be converted to utf8 using L<Encode/decode>. If an error occurs decoding the data into utf8, the error will be set as an L<Module::Generic::Exception> object and undef will be returned.
1082
1083							=head2 parse_file
1084
1085							Provided with a file path and some options as hash or hash reference and this will parse the file.
1086
1087							If the option I<utf8> is provided, the file will be opened with L<perlfunc/binmode> set to C<utf8>
1088
1089							It returns a new L<HTML::Object::Document>
1090
1091							=head2 parse_url
1092
1093							Provided with an URI supported by L<LWP::UserAgent> and this will issue a GET query and parse the resulting HTML data, and return a new L<HTML::Object::Document> or L<HTML::Object::DOM::Document> depending on which interface you use (either L<HTML::Object> or L<HTML::Object::DOM>.
1094
1095							If an error occurred, this will set an L<error\|Module::Generic/error> and return C<undef>.
1096
1097							You can get the L<response\|HTTP::Response> object with L</response>
1098
1099							=head2 parser
1100
1101							Sets or gets a L<HTML::Parser> object.
1102
1103							=head2 post_process
1104
1105							Provided with an L<HTML::Object::Element> and this will post process its parsing.
1106
1107							=head2 response
1108
1109							Get the latest L<HTTP::Response> object from the HTTP query made using L</parse_url>
1110
1111							=head2 sanity_check
1112
1113							Provided with an L<HTML::Object::Element> and this will perform some sanity checks and report the result on C<STDOUT>.
1114
1115							=head2 set_dom
1116
1117							Provided with a L<HTML::Object::Document> object and this sets the global variable C<$GLOBAL_DOM>. This is particularly useful when using L<HTML::Object::XQuery> to do things like:
1118
1119							my $collection = $('div');
1120
1121							=head1 CREDITS
1122
1123							Throughout the documentation of this distribution, a lot of descriptions, references and examples have been borrowed from Mozilla. I have also contributed to improving their documentation by fixing bugs and typos on their site.
1124
1125							=head1 AUTHOR
1126
1127							Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>
1128
1129							=head1 SEE ALSO
1130
1131							L<HTML::Object::DOM>, L<HTML::Object::Element>, L<HTML::Object::XQuery>
1132
1133							=head1 COPYRIGHT & LICENSE
1134
1135							Copyright (c) 2021 DEGUEST Pte. Ltd.
1136
1137							You can use, copy, modify and redistribute this package and associated files under the same terms as Perl itself.
1138
1139							=cut