| blib/lib/Mojo/DOM.pm | |||
|---|---|---|---|
| Criterion | Covered | Total | % |
| statement | 226 | 226 | 100.0 |
| branch | 119 | 122 | 97.5 |
| condition | 63 | 71 | 88.7 |
| subroutine | 75 | 75 | 100.0 |
| pod | 43 | 43 | 100.0 |
| total | 526 | 537 | 97.9 |
| line | stmt | bran | cond | sub | pod | time | code |
|---|---|---|---|---|---|---|---|
| 1 | package Mojo::DOM; | ||||||
| 2 | 65 | 65 | 83865 | use Mojo::Base -strict; | |||
| 65 | 145 | ||||||
| 65 | 991 | ||||||
| 3 | use overload | ||||||
| 4 | 4 | 4 | 51 | '@{}' => sub { shift->child_nodes }, | |||
| 5 | 100 | 100 | 373 | '%{}' => sub { shift->attr }, | |||
| 6 | 392 | 392 | 11944 | bool => sub {1}, | |||
| 7 | 142 | 142 | 35354 | '""' => sub { shift->to_string }, | |||
| 8 | 65 | 65 | 1065 | fallback => 1; | |||
| 65 | 3897 | ||||||
| 65 | 1596 | ||||||
| 9 | |||||||
| 10 | # "Fry: This snow is beautiful. I'm glad global warming never happened. | ||||||
| 11 | # Leela: Actually, it did. But thank God nuclear winter canceled it out." | ||||||
| 12 | 65 | 65 | 11213 | use Mojo::Collection; | |||
| 65 | 160 | ||||||
| 65 | 3915 | ||||||
| 13 | 65 | 65 | 41782 | use Mojo::DOM::CSS; | |||
| 65 | 318 | ||||||
| 65 | 635 | ||||||
| 14 | 65 | 65 | 40809 | use Mojo::DOM::HTML; | |||
| 65 | 423 | ||||||
| 65 | 7779 | ||||||
| 15 | 65 | 65 | 822 | use Scalar::Util qw(blessed weaken); | |||
| 65 | 156 | ||||||
| 65 | 4675 | ||||||
| 16 | 65 | 65 | 746 | use Storable qw(dclone); | |||
| 65 | 151 | ||||||
| 65 | 428959 | ||||||
| 17 | |||||||
| 18 | 28 | 28 | 1 | 91 | sub all_text { _text(_nodes($_[0]->tree), $_[0]->xml, 1) } | ||
| 19 | |||||||
| 20 | 15 | 15 | 1 | 58 | sub ancestors { _select($_[0]->_collect([_ancestors($_[0]->tree)]), $_[1]) } | ||
| 21 | |||||||
| 22 | 9 | 9 | 1 | 45 | sub append { shift->_add(1, @_) } | ||
| 23 | 13 | 13 | 1 | 57 | sub append_content { shift->_content(1, 0, @_) } | ||
| 24 | |||||||
| 25 | sub at { | ||||||
| 26 | 764 | 764 | 1 | 3017 | my $self = shift; | ||
| 27 | 764 | 100 | 2803 | return undef unless my $result = $self->_css->select_one(@_); | |||
| 28 | 694 | 5823 | return $self->_build($result, $self->xml); | ||||
| 29 | } | ||||||
| 30 | |||||||
| 31 | sub attr { | ||||||
| 32 | 181 | 181 | 1 | 407 | my $self = shift; | ||
| 33 | |||||||
| 34 | # Hash | ||||||
| 35 | 181 | 371 | my $tree = $self->tree; | ||||
| 36 | 181 | 100 | 643 | my $attrs = $tree->[0] ne 'tag' ? {} : $tree->[2]; | |||
| 37 | 181 | 100 | 1073 | return $attrs unless @_; | |||
| 38 | |||||||
| 39 | # Get | ||||||
| 40 | 48 | 100 | 100 | 430 | return $attrs->{$_[0]} unless @_ > 1 || ref $_[0]; | ||
| 41 | |||||||
| 42 | # Set | ||||||
| 43 | 4 | 100 | 18 | my $values = ref $_[0] ? $_[0] : {@_}; | |||
| 44 | 4 | 15 | @$attrs{keys %$values} = values %$values; | ||||
| 45 | |||||||
| 46 | 4 | 19 | return $self; | ||||
| 47 | } | ||||||
| 48 | |||||||
| 49 | 59 | 59 | 1 | 196 | sub child_nodes { $_[0]->_collect(_nodes($_[0]->tree)) } | ||
| 50 | |||||||
| 51 | 13 | 13 | 1 | 69 | sub children { _select($_[0]->_collect(_nodes($_[0]->tree, 1)), $_[1]) } | ||
| 52 | |||||||
| 53 | sub content { | ||||||
| 54 | 59 | 59 | 1 | 122 | my $self = shift; | ||
| 55 | |||||||
| 56 | 59 | 168 | my $type = $self->type; | ||||
| 57 | 59 | 100 | 100 | 292 | if ($type eq 'root' || $type eq 'tag') { | ||
| 58 | 28 | 100 | 126 | return $self->_content(0, 1, @_) if @_; | |||
| 59 | 7 | 24 | my $html = Mojo::DOM::HTML->new(xml => $self->xml); | ||||
| 60 | 7 | 15 | return join '', map { $html->tree($_)->render } @{_nodes($self->tree)}; | ||||
| 12 | 34 | ||||||
| 7 | 21 | ||||||
| 61 | } | ||||||
| 62 | |||||||
| 63 | 31 | 100 | 109 | return $self->tree->[1] unless @_; | |||
| 64 | 3 | 12 | $self->tree->[1] = shift; | ||||
| 65 | 3 | 43 | return $self; | ||||
| 66 | } | ||||||
| 67 | |||||||
| 68 | 13 | 13 | 1 | 40 | sub descendant_nodes { $_[0]->_collect(_all(_nodes($_[0]->tree))) } | ||
| 69 | |||||||
| 70 | sub find { | ||||||
| 71 | 444 | 444 | 1 | 3222 | my $self = shift; | ||
| 72 | 444 | 1425 | return $self->_collect($self->_css->select(@_)); | ||||
| 73 | } | ||||||
| 74 | |||||||
| 75 | 8 | 8 | 1 | 25 | sub following { _select($_[0]->_collect(_siblings($_[0]->tree, 1, 1)), $_[1]) } | ||
| 76 | 7 | 7 | 1 | 24 | sub following_nodes { $_[0]->_collect(_siblings($_[0]->tree, 0, 1)) } | ||
| 77 | |||||||
| 78 | 44 | 44 | 1 | 117 | sub matches { shift->_css->matches(@_) } | ||
| 79 | |||||||
| 80 | sub namespace { | ||||||
| 81 | 18 | 18 | 1 | 44 | my $self = shift; | ||
| 82 | |||||||
| 83 | 18 | 100 | 41 | return undef if (my $tree = $self->tree)->[0] ne 'tag'; | |||
| 84 | |||||||
| 85 | # Extract namespace prefix and search parents | ||||||
| 86 | 16 | 100 | 82 | my $ns = $tree->[1] =~ /^(.*?):/ ? "xmlns:$1" : undef; | |||
| 87 | 16 | 39 | for my $node ($tree, _ancestors($tree)) { | ||||
| 88 | |||||||
| 89 | # Namespace for prefix | ||||||
| 90 | 35 | 44 | my $attrs = $node->[2]; | ||||
| 91 | 35 | 100 | 100 | 84 | if ($ns) { $_ eq $ns and return $attrs->{$_} for keys %$attrs } | ||
| 13 | 100 | 65 | |||||
| 92 | |||||||
| 93 | # Namespace attribute | ||||||
| 94 | 10 | 55 | elsif (defined $attrs->{xmlns}) { return $attrs->{xmlns} } | ||||
| 95 | } | ||||||
| 96 | |||||||
| 97 | 1 | 6 | return undef; | ||||
| 98 | } | ||||||
| 99 | |||||||
| 100 | sub new { | ||||||
| 101 | 2397 | 2397 | 1 | 817529 | my $class = shift; | ||
| 102 | 2397 | 66 | 7237 | my $self = bless \Mojo::DOM::HTML->new, ref $class || $class; | |||
| 103 | 2397 | 100 | 7356 | return @_ ? $self->parse(@_) : $self; | |||
| 104 | } | ||||||
| 105 | |||||||
| 106 | sub new_tag { | ||||||
| 107 | 11 | 11 | 1 | 6056 | my $self = shift; | ||
| 108 | 11 | 40 | my $new = $self->new; | ||||
| 109 | 11 | 66 | $$new->tag(@_); | ||||
| 110 | 11 | 100 | 40 | $$new->xml($$self->xml) if ref $self; | |||
| 111 | 11 | 71 | return $new; | ||||
| 112 | } | ||||||
| 113 | |||||||
| 114 | 13 | 13 | 1 | 32 | sub next { $_[0]->_maybe(_siblings($_[0]->tree, 1, 1, 0)) } | ||
| 115 | 5 | 5 | 1 | 8 | sub next_node { $_[0]->_maybe(_siblings($_[0]->tree, 0, 1, 0)) } | ||
| 116 | |||||||
| 117 | sub parent { | ||||||
| 118 | 48 | 48 | 1 | 106 | my $self = shift; | ||
| 119 | 48 | 50 | 119 | return undef if (my $tree = $self->tree)->[0] eq 'root'; | |||
| 120 | 48 | 132 | return $self->_build(_parent($tree), $self->xml); | ||||
| 121 | } | ||||||
| 122 | |||||||
| 123 | 261 | 50 | 261 | 1 | 514 | sub parse { ${$_[0]}->parse($_[1]) and return $_[0] } | |
| 261 | 2332 | ||||||
| 124 | |||||||
| 125 | 5 | 5 | 1 | 13 | sub preceding { _select($_[0]->_collect(_siblings($_[0]->tree, 1, 0)), $_[1]) } | ||
| 126 | 7 | 7 | 1 | 24 | sub preceding_nodes { $_[0]->_collect(_siblings($_[0]->tree, 0)) } | ||
| 127 | |||||||
| 128 | 11 | 11 | 1 | 55 | sub prepend { shift->_add(0, @_) } | ||
| 129 | 6 | 6 | 1 | 23 | sub prepend_content { shift->_content(0, 0, @_) } | ||
| 130 | |||||||
| 131 | 7 | 7 | 1 | 23 | sub previous { $_[0]->_maybe(_siblings($_[0]->tree, 1, 0, -1)) } | ||
| 132 | 5 | 5 | 1 | 10 | sub previous_node { $_[0]->_maybe(_siblings($_[0]->tree, 0, 0, -1)) } | ||
| 133 | |||||||
| 134 | 6 | 6 | 1 | 19 | sub remove { shift->replace('') } | ||
| 135 | |||||||
| 136 | sub replace { | ||||||
| 137 | 24 | 24 | 1 | 83 | my ($self, $new) = @_; | ||
| 138 | 24 | 100 | 57 | return $self->parse($new) if (my $tree = $self->tree)->[0] eq 'root'; | |||
| 139 | 16 | 51 | return $self->_replace(_parent($tree), $tree, _nodes($self->_parse($new))); | ||||
| 140 | } | ||||||
| 141 | |||||||
| 142 | sub root { | ||||||
| 143 | 14 | 14 | 1 | 50 | my $self = shift; | ||
| 144 | 14 | 100 | 33 | return $self unless my $tree = _ancestors($self->tree, 1); | |||
| 145 | 11 | 36 | return $self->_build($tree, $self->xml); | ||||
| 146 | } | ||||||
| 147 | |||||||
| 148 | sub selector { | ||||||
| 149 | 13 | 100 | 13 | 1 | 48 | return undef unless (my $tree = shift->tree)->[0] eq 'tag'; | |
| 150 | 11 | 40 | return join ' > ', reverse map { $_->[1] . ':nth-child(' . (@{_siblings($_, 1)} + 1) . ')' } $tree, _ancestors($tree); | ||||
| 31 | 61 | ||||||
| 31 | 92 | ||||||
| 151 | } | ||||||
| 152 | |||||||
| 153 | sub strip { | ||||||
| 154 | 9 | 9 | 1 | 18 | my $self = shift; | ||
| 155 | 9 | 100 | 25 | return $self if (my $tree = $self->tree)->[0] ne 'tag'; | |||
| 156 | 7 | 26 | return $self->_replace($tree->[3], $tree, _nodes($tree)); | ||||
| 157 | } | ||||||
| 158 | |||||||
| 159 | sub tag { | ||||||
| 160 | 101 | 101 | 1 | 263 | my ($self, $tag) = @_; | ||
| 161 | 101 | 100 | 314 | return undef if (my $tree = $self->tree)->[0] ne 'tag'; | |||
| 162 | 99 | 100 | 619 | return $tree->[1] unless $tag; | |||
| 163 | 1 | 4 | $tree->[1] = $tag; | ||||
| 164 | 1 | 5 | return $self; | ||||
| 165 | } | ||||||
| 166 | |||||||
| 167 | 1 | 1 | 1 | 6 | sub tap { shift->Mojo::Base::tap(@_) } | ||
| 168 | |||||||
| 169 | 838 | 838 | 1 | 8136 | sub text { _text(_nodes(shift->tree), 0, 0) } | ||
| 170 | |||||||
| 171 | 152 | 152 | 1 | 266 | sub to_string { ${shift()}->render } | ||
| 152 | 864 | ||||||
| 172 | |||||||
| 173 | 5086 | 100 | 50 | 5086 | 1 | 16675 | sub tree { @_ > 1 ? (${$_[0]}->tree($_[1]) and return $_[0]) : ${$_[0]}->tree } |
| 2957 | 9385 | ||||||
| 174 | |||||||
| 175 | 82 | 82 | 1 | 213 | sub type { shift->tree->[0] } | ||
| 176 | |||||||
| 177 | sub val { | ||||||
| 178 | 32 | 32 | 1 | 68 | my $self = shift; | ||
| 179 | |||||||
| 180 | # "option" | ||||||
| 181 | 32 | 100 | 66 | 103 | return $self->{value} // $self->text if (my $tag = $self->tag) eq 'option'; | ||
| 182 | |||||||
| 183 | # "input" ("type=checkbox" and "type=radio") | ||||||
| 184 | 22 | 100 | 86 | my $type = $self->{type} // ''; | |||
| 185 | 22 | 100 | 100 | 139 | return $self->{value} // 'on' if $tag eq 'input' && ($type eq 'radio' || $type eq 'checkbox'); | ||
| 100 | |||||||
| 100 | |||||||
| 186 | |||||||
| 187 | # "textarea", "input" or "button" | ||||||
| 188 | 17 | 100 | 73 | return $tag eq 'textarea' ? $self->text : $self->{value} if $tag ne 'select'; | |||
| 100 | |||||||
| 189 | |||||||
| 190 | # "select" | ||||||
| 191 | 6 | 6 | 26 | my $v = $self->find('option:checked:not([disabled])')->grep(sub { !$_->ancestors('optgroup[disabled]')->size }) | |||
| 192 | 5 | 20 | ->map('val'); | ||||
| 193 | 5 | 100 | 53 | return exists $self->{multiple} ? $v->size ? $v->to_array : undef : $v->last; | |||
| 100 | |||||||
| 194 | } | ||||||
| 195 | |||||||
| 196 | 1 | 1 | 1 | 822 | sub with_roles { shift->Mojo::Base::with_roles(@_) } | ||
| 197 | |||||||
| 198 | 9 | 9 | 1 | 43 | sub wrap { shift->_wrap(0, @_) } | ||
| 199 | 7 | 7 | 1 | 34 | sub wrap_content { shift->_wrap(1, @_) } | ||
| 200 | |||||||
| 201 | 3613 | 100 | 50 | 3613 | 1 | 6837 | sub xml { @_ > 1 ? (${$_[0]}->xml($_[1]) and return $_[0]) : ${$_[0]}->xml } |
| 1465 | 6158 | ||||||
| 202 | |||||||
| 203 | sub _add { | ||||||
| 204 | 20 | 20 | 50 | my ($self, $offset, $new) = @_; | |||
| 205 | |||||||
| 206 | 20 | 100 | 46 | return $self if (my $tree = $self->tree)->[0] eq 'root'; | |||
| 207 | |||||||
| 208 | 16 | 62 | my $parent = _parent($tree); | ||||
| 209 | 16 | 53 | splice @$parent, _offset($parent, $tree) + $offset, 0, @{_link($parent, _nodes($self->_parse($new)))}; | ||||
| 16 | 78 | ||||||
| 210 | |||||||
| 211 | 16 | 113 | return $self; | ||||
| 212 | } | ||||||
| 213 | |||||||
| 214 | sub _all { | ||||||
| 215 | 21 | 21 | 26 | my $nodes = shift; | |||
| 216 | 21 | 100 | 34 | @$nodes = map { $_->[0] eq 'tag' ? ($_, @{_all(_nodes($_))}) : ($_) } @$nodes; | |||
| 60 | 115 | ||||||
| 8 | 14 | ||||||
| 217 | 21 | 46 | return $nodes; | ||||
| 218 | } | ||||||
| 219 | |||||||
| 220 | sub _ancestors { | ||||||
| 221 | 56 | 56 | 184 | my ($tree, $root) = @_; | |||
| 222 | |||||||
| 223 | 56 | 100 | 147 | return () unless $tree = _parent($tree); | |||
| 224 | 53 | 90 | my @ancestors; | ||||
| 225 | 53 | 66 | 79 | do { push @ancestors, $tree } while ($tree->[0] eq 'tag') && ($tree = $tree->[3]); | |||
| 141 | 557 | ||||||
| 226 | 53 | 100 | 328 | return $root ? $ancestors[-1] : @ancestors[0 .. $#ancestors - 1]; | |||
| 227 | } | ||||||
| 228 | |||||||
| 229 | 2129 | 2129 | 5433 | sub _build { shift->new->tree(shift)->xml(shift) } | |||
| 230 | |||||||
| 231 | sub _collect { | ||||||
| 232 | 570 | 50 | 570 | 1732 | my ($self, $nodes) = (shift, shift // []); | ||
| 233 | 570 | 1408 | my $xml = $self->xml; | ||||
| 234 | 570 | 1323 | return Mojo::Collection->new(map { $self->_build($_, $xml) } @$nodes); | ||||
| 1356 | 2499 | ||||||
| 235 | } | ||||||
| 236 | |||||||
| 237 | sub _content { | ||||||
| 238 | 40 | 40 | 95 | my ($self, $start, $offset, $new) = @_; | |||
| 239 | |||||||
| 240 | 40 | 87 | my $tree = $self->tree; | ||||
| 241 | 40 | 100 | 100 | 171 | unless ($tree->[0] eq 'root' || $tree->[0] eq 'tag') { | ||
| 242 | 2 | 8 | my $old = $self->content; | ||||
| 243 | 2 | 100 | 14 | return $self->content($start ? $old . $new : $new . $old); | |||
| 244 | } | ||||||
| 245 | |||||||
| 246 | 38 | 100 | 133 | $start = $start ? ($#$tree + 1) : _start($tree); | |||
| 247 | 38 | 100 | 99 | $offset = $offset ? $#$tree : 0; | |||
| 248 | 38 | 60 | splice @$tree, $start, $offset, @{_link($tree, _nodes($self->_parse($new)))}; | ||||
| 38 | 111 | ||||||
| 249 | |||||||
| 250 | 38 | 194 | return $self; | ||||
| 251 | } | ||||||
| 252 | |||||||
| 253 | 1252 | 1252 | 3786 | sub _css { Mojo::DOM::CSS->new(tree => shift->tree) } | |||
| 254 | |||||||
| 255 | 1 | 1 | 8 | sub _fragment { _link(my $r = ['root', @_], [@_]); $r } | |||
| 1 | 5 | ||||||
| 256 | |||||||
| 257 | sub _link { | ||||||
| 258 | 102 | 102 | 208 | my ($parent, $children) = @_; | |||
| 259 | |||||||
| 260 | # Link parent to children | ||||||
| 261 | 102 | 200 | for my $node (@$children) { | ||||
| 262 | 106 | 100 | 316 | my $offset = $node->[0] eq 'tag' ? 3 : 2; | |||
| 263 | 106 | 232 | $node->[$offset] = $parent; | ||||
| 264 | 106 | 278 | weaken $node->[$offset]; | ||||
| 265 | } | ||||||
| 266 | |||||||
| 267 | 102 | 411 | return $children; | ||||
| 268 | } | ||||||
| 269 | |||||||
| 270 | 30 | 100 | 30 | 104 | sub _maybe { $_[1] ? $_[0]->_build($_[1], $_[0]->xml) : undef } | ||
| 271 | |||||||
| 272 | sub _nodes { | ||||||
| 273 | 1317 | 50 | 1317 | 2926 | return () unless my $tree = shift; | ||
| 274 | 1317 | 3196 | my @nodes = @$tree[_start($tree) .. $#$tree]; | ||||
| 275 | 1317 | 100 | 5064 | return shift() ? [grep { $_->[0] eq 'tag' } @nodes] : \@nodes; | |||
| 84 | 352 | ||||||
| 276 | } | ||||||
| 277 | |||||||
| 278 | sub _offset { | ||||||
| 279 | 46 | 46 | 95 | my ($parent, $child) = @_; | |||
| 280 | 46 | 118 | my $i = _start($parent); | ||||
| 281 | 46 | 100 | 305 | $_ eq $child ? last : $i++ for @$parent[$i .. $#$parent]; | |||
| 282 | 46 | 104 | return $i; | ||||
| 283 | } | ||||||
| 284 | |||||||
| 285 | 225 | 100 | 225 | 894 | sub _parent { $_[0]->[$_[0][0] eq 'tag' ? 3 : 2] } | ||
| 286 | |||||||
| 287 | sub _parse { | ||||||
| 288 | 84 | 84 | 188 | my ($self, $input) = @_; | |||
| 289 | 84 | 100 | 66 | 417 | return Mojo::DOM::HTML->new(xml => $self->xml)->parse($input)->tree unless blessed $input && $input->isa('Mojo::DOM'); | ||
| 290 | 21 | 58 | my $tree = dclone $input->tree; | ||||
| 291 | 21 | 100 | 177 | return $tree->[0] eq 'root' ? $tree : _fragment($tree); | |||
| 292 | } | ||||||
| 293 | |||||||
| 294 | sub _replace { | ||||||
| 295 | 30 | 30 | 85 | my ($self, $parent, $child, $nodes) = @_; | |||
| 296 | 30 | 102 | splice @$parent, _offset($parent, $child), 1, @{_link($parent, $nodes)}; | ||||
| 30 | 85 | ||||||
| 297 | 30 | 111 | return $self->parent; | ||||
| 298 | } | ||||||
| 299 | |||||||
| 300 | 41 | 100 | 41 | 266 | sub _select { $_[1] ? $_[0]->grep(matches => $_[1]) : $_[0] } | ||
| 301 | |||||||
| 302 | sub _siblings { | ||||||
| 303 | 88 | 88 | 223 | my ($tree, $tags, $tail, $i) = @_; | |||
| 304 | |||||||
| 305 | 88 | 100 | 240 | return defined $i ? undef : [] if $tree->[0] eq 'root'; | |||
| 100 | |||||||
| 306 | |||||||
| 307 | 82 | 170 | my $nodes = _nodes(_parent($tree)); | ||||
| 308 | 82 | 147 | my $match = -1; | ||||
| 309 | 82 | 66 | 787 | defined($match++) and $_ eq $tree and last for @$nodes; | |||
| 100 | |||||||
| 310 | |||||||
| 311 | 82 | 100 | 180 | if ($tail) { splice @$nodes, 0, $match + 1 } | |||
| 30 | 65 | ||||||
| 312 | 52 | 146 | else { splice @$nodes, $match, ($#$nodes + 1) - $match } | ||||
| 313 | |||||||
| 314 | 82 | 100 | 275 | @$nodes = grep { $_->[0] eq 'tag' } @$nodes if $tags; | |||
| 171 | 347 | ||||||
| 315 | |||||||
| 316 | 82 | 100 | 100 | 458 | return defined $i ? $i == -1 && !@$nodes ? undef : $nodes->[$i] : $nodes; | ||
| 100 | |||||||
| 317 | } | ||||||
| 318 | |||||||
| 319 | 1394 | 100 | 1394 | 5414 | sub _start { $_[0][0] eq 'root' ? 1 : 4 } | ||
| 320 | |||||||
| 321 | sub _text { | ||||||
| 322 | 866 | 866 | 1738 | my ($nodes, $xml, $all) = @_; | |||
| 323 | |||||||
| 324 | 866 | 1439 | my $text = ''; | ||||
| 325 | 866 | 2120 | while (my $node = shift @$nodes) { | ||||
| 326 | 1225 | 2304 | my $type = $node->[0]; | ||||
| 327 | |||||||
| 328 | # Text | ||||||
| 329 | 1225 | 100 | 100 | 4666 | if ($type eq 'text' || $type eq 'cdata' || $type eq 'raw') { $text .= $node->[1] } | ||
| 1007 | 100 | 100 | 2948 | ||||
| 100 | |||||||
| 330 | |||||||
| 331 | # Nested tag | ||||||
| 332 | elsif ($type eq 'tag' && $all) { | ||||||
| 333 | 155 | 100 | 100 | 776 | unshift @$nodes, @{_nodes($node)} if $xml || ($node->[1] ne 'script' && $node->[1] ne 'style'); | ||
| 143 | 100 | 293 | |||||
| 334 | } | ||||||
| 335 | } | ||||||
| 336 | |||||||
| 337 | 866 | 4474 | return $text; | ||||
| 338 | } | ||||||
| 339 | |||||||
| 340 | sub _wrap { | ||||||
| 341 | 16 | 16 | 59 | my ($self, $content, $new) = @_; | |||
| 342 | |||||||
| 343 | 16 | 100 | 100 | 46 | return $self if (my $tree = $self->tree)->[0] eq 'root' && !$content; | ||
| 344 | 15 | 100 | 100 | 148 | return $self if $tree->[0] ne 'root' && $tree->[0] ne 'tag' && $content; | ||
| 100 | |||||||
| 345 | |||||||
| 346 | # Find innermost tag | ||||||
| 347 | 14 | 29 | my $current; | ||||
| 348 | 14 | 54 | my $first = $new = $self->_parse($new); | ||||
| 349 | 14 | 67 | $current = $first while $first = _nodes($first, 1)->[0]; | ||||
| 350 | 14 | 100 | 54 | return $self unless $current; | |||
| 351 | |||||||
| 352 | # Wrap content | ||||||
| 353 | 12 | 100 | 57 | if ($content) { | |||
| 354 | 5 | 12 | push @$current, @{_link($current, _nodes($tree))}; | ||||
| 5 | 14 | ||||||
| 355 | 5 | 19 | splice @$tree, _start($tree), $#$tree, @{_link($tree, _nodes($new))}; | ||||
| 5 | 15 | ||||||
| 356 | 5 | 38 | return $self; | ||||
| 357 | } | ||||||
| 358 | |||||||
| 359 | # Wrap element | ||||||
| 360 | 7 | 28 | $self->_replace(_parent($tree), $tree, _nodes($new)); | ||||
| 361 | 7 | 36 | push @$current, @{_link($current, [$tree])}; | ||||
| 7 | 26 | ||||||
| 362 | 7 | 45 | return $self; | ||||
| 363 | } | ||||||
| 364 | |||||||
| 365 | 1; | ||||||
| 366 | |||||||
| 367 | =encoding utf8 | ||||||
| 368 | |||||||
| 369 | =head1 NAME | ||||||
| 370 | |||||||
| 371 | Mojo::DOM - Minimalistic HTML/XML DOM parser with CSS selectors | ||||||
| 372 | |||||||
| 373 | =head1 SYNOPSIS | ||||||
| 374 | |||||||
| 375 | use Mojo::DOM; | ||||||
| 376 | |||||||
| 377 | # Parse | ||||||
| 378 | my $dom = Mojo::DOM->new(' Test 123 |
||||||
| 379 | |||||||
| 380 | # Find | ||||||
| 381 | say $dom->at('#b')->text; | ||||||
| 382 | say $dom->find('p')->map('text')->join("\n"); | ||||||
| 383 | say $dom->find('[id]')->map(attr => 'id')->join("\n"); | ||||||
| 384 | |||||||
| 385 | # Iterate | ||||||
| 386 | $dom->find('p[id]')->reverse->each(sub { say $_->{id} }); | ||||||
| 387 | |||||||
| 388 | # Loop | ||||||
| 389 | for my $e ($dom->find('p[id]')->each) { | ||||||
| 390 | say $e->{id}, ':', $e->text; | ||||||
| 391 | } | ||||||
| 392 | |||||||
| 393 | # Modify | ||||||
| 394 | $dom->find('div p')->last->append(' 456 '); |
||||||
| 395 | $dom->at('#c')->prepend($dom->new_tag('p', id => 'd', '789')); | ||||||
| 396 | $dom->find(':not(p)')->map('strip'); | ||||||
| 397 | |||||||
| 398 | # Render | ||||||
| 399 | say "$dom"; | ||||||
| 400 | |||||||
| 401 | =head1 DESCRIPTION | ||||||
| 402 | |||||||
| 403 | L |
||||||
| 404 | broken HTML and XML, so you should not use it for validation. | ||||||
| 405 | |||||||
| 406 | =head1 NODES AND ELEMENTS | ||||||
| 407 | |||||||
| 408 | When we parse an HTML/XML fragment, it gets turned into a tree of nodes. | ||||||
| 409 | |||||||
| 410 | |||||||
| 411 | |||||||
| 412 | |
||||||
| 413 | World! | ||||||
| 414 | |||||||
| 415 | |||||||
| 416 | There are currently eight different kinds of nodes, C |
||||||
| 417 | and C |
||||||
| 418 | |||||||
| 419 | root | ||||||
| 420 | |- doctype (html) | ||||||
| 421 | +- tag (html) | ||||||
| 422 | |- tag (head) | ||||||
| 423 | | +- tag (title) | ||||||
| 424 | | +- raw (Hello) | ||||||
| 425 | +- tag (body) | ||||||
| 426 | +- text (World!) | ||||||
| 427 | |||||||
| 428 | While all node types are represented as L |
||||||
| 429 | apply to elements. | ||||||
| 430 | |||||||
| 431 | =head1 HTML AND XML | ||||||
| 432 | |||||||
| 433 | L |
||||||
| 434 | be lowercase as well. | ||||||
| 435 | |||||||
| 436 | # HTML semantics | ||||||
| 437 | my $dom = Mojo::DOM->new(' Hi! '); |
||||||
| 438 | say $dom->at('p[id]')->text; | ||||||
| 439 | |||||||
| 440 | If an XML declaration is found, the parser will automatically switch into XML mode and everything becomes | ||||||
| 441 | case-sensitive. | ||||||
| 442 | |||||||
| 443 | # XML semantics | ||||||
| 444 | my $dom = Mojo::DOM->new(' Hi! '); |
||||||
| 445 | say $dom->at('P[ID]')->text; | ||||||
| 446 | |||||||
| 447 | HTML or XML semantics can also be forced with the L method. | ||||||
| 448 | |||||||
| 449 | # Force HTML semantics | ||||||
| 450 | my $dom = Mojo::DOM->new->xml(0)->parse(' Hi! '); |
||||||
| 451 | say $dom->at('p[id]')->text; | ||||||
| 452 | |||||||
| 453 | # Force XML semantics | ||||||
| 454 | my $dom = Mojo::DOM->new->xml(1)->parse(' Hi! '); |
||||||
| 455 | say $dom->at('P[ID]')->text; | ||||||
| 456 | |||||||
| 457 | =head1 METHODS | ||||||
| 458 | |||||||
| 459 | L |
||||||
| 460 | |||||||
| 461 | =head2 all_text | ||||||
| 462 | |||||||
| 463 | my $text = $dom->all_text; | ||||||
| 464 | |||||||
| 465 | Extract text content from all descendant nodes of this element. For HTML documents C |