File Coverage

blib/lib/Mojo/DOM/HTML.pm

Criterion	Covered	Total	%
statement	130	132	98.4
branch	114	118	96.6
condition	48	52	92.3
subroutine	15	15	100.0
pod	4	4	100.0
total	311	321	96.8

package Mojo::DOM::HTML;
use Mojo::Base -base;

use Exporter     qw(import);
use Mojo::Util   qw(html_attr_unescape html_unescape xml_escape);
use Scalar::Util qw(weaken);

our @EXPORT_OK = ('tag_to_html');

has tree => sub { ['root'] };
has 'xml';

my $ATTR_RE = qr/
  ([^<>=\s\/0-9.\-][^<>=\s\/]*|\/)     # Key
  (?:
    \s*=\s*
    (?s:(["'])(.*?)\g{-2}|([^>\s]*))   # Value
  )?
  \s*
/x;
my $TOKEN_RE = qr/
  ([^<]+)?                                                                     # Text
  (?:
    <(?:
      !(?:
        DOCTYPE(
        \s+\w+                                                                 # Doctype
        (?:(?:\s+\w+)?(?:\s+(?:"[^"]*"|'[^']*'))+)?                            # External ID
        (?:\s+\[.+?\])?                                                        # Int Subset
        \s*)
      |
        --(.*?)(?:--!?|(?<=' if $type eq 'comment';

  # CDATA
  return '[1] . ']]>' if $type eq 'cdata';

  # Processing instruction
  return '[1] . '?>' if $type eq 'pi';

  # Everything else
  return '';
}

sub _script_content {
  my $html  = shift;
  my $start = pos $$html;

  my $state = 0;

  while (1) {
    if   ($state == 0) { $$html =~ /\G[^<]*/gcs }
    else               { $$html =~ /\G[^<\-]*/gcs }

    my $p = pos $$html;
    return (substr($$html, $start), 0) if $p >= length $$html;

    if ($state == 0) {
      if    ($$html =~ m!\G)!gcsi) { return (substr($$html, $start, $p - $start), 1) }
      elsif ($$html =~ /\G/gcs)                    { $state = 0 }
      elsif ($$html =~ m!\G])!gcsi)    { $state = 2 }
      else                                            { pos($$html) = $p + 1 }
    }
    else {
      if    ($$html =~ m!\G)!gcsi) { $state      = 1 }
      elsif ($$html =~ /\G-->/gcs)                    { $state      = 0 }
      else                                            { pos($$html) = $p + 1 }
    }
  }
}

sub _start {
  my ($start, $attrs, $xml, $current) = @_;

  # Autoclose optional HTML elements
  if (!$xml && $$current->[0] ne 'root') {
    if (my $end = $END{$start}) { _end($end, 0, $current) }

    elsif (my $close = $CLOSE{$start}) {
      my ($allowed, $scope) = @$close;

      # Close allowed parent elements in scope
      my $parent = $$current;
      while ($parent->[0] ne 'root' && !$scope->{$parent->[1]}) {
        _end($parent->[1], 0, $current) if $allowed->{$parent->[1]};
        $parent = $parent->[3];
      }
    }
  }

  # New tag
  push @$$current, my $new = ['tag', $start, $attrs, $$current];
  weaken $new->[3];
  $$current = $new;
}

sub _tag {
  my $tree = ['tag', shift, undef, undef];

  # Content
  push @$tree, ref $_[-1] eq 'CODE' ? ['raw', pop->()] : ['text', pop] if @_ % 2;

  # Attributes
  my $attrs = $tree->[2] = {@_};
  return $tree unless exists $attrs->{data} && ref $attrs->{data} eq 'HASH';
  my $data = delete $attrs->{data};
  @$attrs{map { y/_/-/; lc "data-$_" } keys %$data} = values %$data;
  return $tree;
}

1;

=encoding utf8

=head1 NAME

Mojo::DOM::HTML - HTML/XML engine

=head1 SYNOPSIS

  use Mojo::DOM::HTML;

  # Turn HTML into DOM tree
  my $html = Mojo::DOM::HTML->new;
  $html->parse('Test123');
  my $tree = $html->tree;

=head1 DESCRIPTION

L is the HTML/XML engine used by L, based on the L
Standard|https://html.spec.whatwg.org> and the L.

=head1 FUNCTIONS

L implements the following functions, which can be imported individually.

=head2 tag_to_html

  my $str = tag_to_html 'div', id => 'foo', 'safe content';

Generate HTML/XML tag and render it right away. This is a significantly faster alternative to L for template
systems that have to generate a lot of tags.

=head1 ATTRIBUTES

L implements the following attributes.

=head2 tree

  my $tree = $html->tree;
  $html    = $html->tree(['root']);

Document Object Model. Note that this structure should only be used very carefully since it is very dynamic.

=head2 xml

  my $bool = $html->xml;
  $html    = $html->xml($bool);

Disable HTML semantics in parser and activate case-sensitivity, defaults to auto-detection based on XML declarations.

=head1 METHODS

L inherits all methods from L and implements the following new ones.

=head2 parse

  $html = $html->parse('I ♥ Mojolicious!');

Parse HTML/XML fragment.

=head2 render

  my $str = $html->render;

Render DOM to HTML/XML.

=head2 tag

  $html = $html->tag('div', id => 'foo', 'safe content');

Generate HTML/XML tag.

=head1 SEE ALSO

L, L, L.

=cut