File Coverage

lib/HTML/Object/Document.pm
Criterion Covered Total %
statement 39 70 55.7
branch 1 18 5.5
condition 0 17 0.0
subroutine 13 18 72.2
pod 6 6 100.0
total 59 129 45.7


line stmt bran cond sub pod time code
1             ##----------------------------------------------------------------------------
2             ## HTML Object - ~/lib/HTML/Object/Document.pm
3             ## Version v0.2.0
4             ## Copyright(c) 2021 DEGUEST Pte. Ltd.
5             ## Author: Jacques Deguest <jack@deguest.jp>
6             ## Created 2021/04/19
7             ## Modified 2022/09/18
8             ## All rights reserved
9             ##
10             ##
11             ## This program is free software; you can redistribute it and/or modify it
12             ## under the same terms as Perl itself.
13             ##----------------------------------------------------------------------------
14             package HTML::Object::Document;
15             BEGIN
16             {
17 30     30   559 use strict;
  30         64  
  30         906  
18 30     30   169 use warnings;
  30         67  
  30         755  
19 30     30   214 use warnings::register;
  30         77  
  30         2931  
20 30     30   161 use parent qw( HTML::Object::Element );
  30         79  
  30         159  
21 30     30   1792 use vars qw( $VERSION );
  30         60  
  30         1116  
22 30     30   169 use Scalar::Util ();
  30         54  
  30         644  
23 30     30   469 our $VERSION = 'v0.2.0';
24             };
25              
26 30     30   749 use strict;
  30         54  
  30         572  
27 30     30   502 use warnings;
  30         55  
  30         15957  
28              
29             sub init
30             {
31 54     54 1 511 my $self = shift( @_ );
32 54         432 $self->{is_empty} = 0;
33 54         242 $self->{tag} = '_document';
34 54         190 $self->{declaration} = undef;
35 54         155 $self->{referrer} = undef;
36 54         166 $self->{uri} = undef;
37 54         146 $self->{_init_strict_use_sub} = 1;
38 54         203 $self->{_exception_class} = 'HTML::Object::Exception';
39 54         232 $self->{_last_modified} = undef;
40 54 50       456 $self->SUPER::init( @_ ) || return( $self->pass_error );
41 54         379 return( $self );
42             }
43              
44             sub append
45             {
46 0     0 1 0 my $self = shift( @_ );
47 0         0 my $this = shift( @_ );
48 0 0 0     0 return( $self->error( "Nothing to append was provided." ) ) if( !defined( $this ) || !CORE::length( $this ) );
49 0 0 0     0 if( !ref( $this ) || overload::Method( $this, '""' ) )
50             {
51 0         0 my $p = HTML::Object->new;
52 0   0     0 my $doc = $p->parse( "$this" ) || return( $self->pass_error( $p->error ) );
53 0 0       0 return( $self->error( "No element could be found from parsing html text provided." ) ) if( !$doc->children->length );
54 0         0 $this = $doc->children->first;
55             }
56 0 0 0     0 if( !$self->_is_a( $this, 'HTML::Object::Element' ) || $self->_is_a( $this, 'HTML::Object::Collection' ) )
57             {
58 0         0 return( $self->error( "Element object provided is not an HTML::Object::Element object." ) );
59             }
60 0 0 0     0 if( $this->tag eq 'html' && $self->children->length && $self->children->first->tag eq 'html' )
      0        
61             {
62 0         0 require HTML::Object::Exception;
63 0         0 return( $self->error({
64             class => 'HTML::Object::HierarchyRequestError',
65             code => 403,
66             message => "You are atttempting to add an html tag, but there is already one.",
67             }) );
68             }
69 0         0 $this->parent( $self );
70 0         0 $this->children->push( $this );
71 0         0 return( $this );
72             }
73              
74             sub as_string
75             {
76 0     0 1 0 my $self = shift( @_ );
77             # if( $self->isa( 'HTML::Object::Collection' ) )
78             # {
79             # return( '' ) if( !$self->children->length );
80             # my $first = $self->children->first;
81             # return( '' ) if( !$self->_is_a( $first, 'HTML::Object::Element' ) );
82             # return( $self->error( "as_string() called on a Collection object, but its first children element is also a collection. Stopping before starting an infinite recursion." ) ) if( $self->_is_a( $first, 'HTML::Object::Collection' ) );
83             # return( $first->as_string );
84             # }
85 0         0 my $a = $self->new_array;
86 0 0       0 $a->push( $self->declaration->as_string ) if( $self->declaration );
87             $self->children->foreach(sub
88             {
89 0     0   0 my $e = shift( @_ );
90 0         0 my $v = $e->as_string;
91 0 0       0 $a->push( defined( $v ) ? $v->scalar : $v );
92 0         0 });
93 0         0 return( $a->join( '' ) );
94             }
95              
96             sub as_xml
97             {
98 0     0 1 0 my $self = shift( @_ );
99 0         0 my $a = $self->new_array;
100             $self->children->foreach(sub
101             {
102 0     0   0 my $e = shift( @_ );
103 0         0 my $v = $e->as_xml;
104 0 0       0 $a->push( defined( $v ) ? $v->scalar : $v );
105 0         0 });
106 0         0 return( $a->join( '' ) );
107             }
108              
109 21     21 1 1006 sub declaration { return( shift->_set_get_object_without_init( 'declaration', 'HTML::Object::Declaration', @_ ) ); }
110              
111 1     1 1 8 sub uri { return( shift->_set_get_uri( 'uri', @_ ) ); }
112              
113 5     5   778 sub _last_modified { return( shift->_set_get_datetime( '_last_modified', @_ ) ); }
114              
115             1;
116             # NOTE: POD
117             __END__
118              
119             =encoding utf-8
120              
121             =head1 NAME
122              
123             HTML::Object::Document - HTML Object Document Class
124              
125             =head1 SYNOPSIS
126              
127             use HTML::Object::Document;
128             my $doc = HTML::Object::Document->new ||
129             die( HTML::Object::Document->error, "\n" );
130              
131             =head1 VERSION
132              
133             v0.2.0
134              
135             =head1 DESCRIPTION
136              
137             This module represents an HTML document and is instantiated by L<HTML::Object>. It is the top of the objects hierarchy.
138              
139             =head1 INHERITANCE
140              
141             +-----------------------+ +------------------------+
142             | HTML::Object::Element | --> | HTML::Object::Document |
143             +-----------------------+ +------------------------+
144              
145             =head1 METHODS
146              
147             =head2 append
148              
149             L</append> inserts a set of element objects or HTML string after the last child of the document.
150              
151             This method appends a child to a L<Document|HTML::Object::Document>. To append to an arbitrary element in the tree, see L<HTML::Object::XQuery/append>.
152              
153             An L<HTML::Object::HierarchyRequestError> exception is thrown when the element cannot be inserted at the specified point in the hierarchy.
154              
155             See also L<Mozilla documentation|https://developer.mozilla.org/en-US/docs/Web/API/Document/append>
156              
157             =head2 as_string
158              
159             Returns the html document as a string, and in its original format except for the parts you modified.
160              
161             =head2 as_xml
162              
163             Returns the document as an xml document, which is kind of an old way to present html document.
164              
165             =head2 declaration
166              
167             Sets or gets the document L<DTD object|HTML::Object::Declaration>
168              
169             =head2 uri
170              
171             Because this is a perl framework, there is no URI associated with this object by default, but you can set L<one|URI> yourself, or it will be set automatically for you when you use L<HTML::Object/parse_url>
172              
173             =head1 EVENT & EVENT HANDLERS
174              
175             No event or event handlers are implemented for L<HTML::Object::Document>. If you want event handlers, use L<HTML::Object::DOM> objects instead.
176              
177             =head1 AUTHOR
178              
179             Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>
180              
181             =head1 SEE ALSO
182              
183             L<https://html.spec.whatwg.org/multipage/syntax.html#the-doctype>
184              
185             L<https://developer.mozilla.org/en-US/docs/Web/HTML/Quirks_Mode_and_Standards_Mode>
186              
187             L<HTML::Object>, L<HTML::Object::Attribute>, L<HTML::Object::Boolean>, L<HTML::Object::Closing>, L<HTML::Object::Collection>, L<HTML::Object::Comment>, L<HTML::Object::Declaration>, L<HTML::Object::Document>, L<HTML::Object::Element>, L<HTML::Object::Exception>, L<HTML::Object::Literal>, L<HTML::Object::Number>, L<HTML::Object::Root>, L<HTML::Object::Space>, L<HTML::Object::Text>, L<HTML::Object::XQuery>
188              
189             =head1 COPYRIGHT & LICENSE
190              
191             Copyright (c) 2021 DEGUEST Pte. Ltd.
192              
193             All rights reserved
194              
195             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
196              
197             =cut