File Coverage

lib/HTML/Object.pm

Criterion	Covered	Total	%
statement	343	711	48.2
branch	84	546	15.3
condition	55	269	20.4
subroutine	56	68	82.3
pod	30	30	100.0
total	568	1624	34.9

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