File Coverage

blib/lib/HTML/Inject.pm

Criterion	Covered	Total	%
statement	21	23	91.3
branch			n/a
condition			n/a
subroutine	8	8	100.0
pod			n/a
total	29	31	93.5

package HTML::Inject;

use 5.010;
use strict;
use warnings;
use utf8;

BEGIN {
	$HTML::Inject::AUTHORITY = 'cpan:TOBYINK';
	$HTML::Inject::VERSION   = '0.004';
}

use constant {
	true       => !!1,
	false      => !!0,
	read_only  => 'ro',
	read_write => 'rw',
};

use Carp;
use HTML::HTML5::Parser;
use IO::Detect qw( is_filehandle is_filename );
use Scalar::Does 0.002 qw( blessed reftype -constants );
use XML::LibXML 1.94;

sub must_do {
	my $role = shift;
	return sub { does($_[0], $role) or confess "Does not do role $_[0]" };
}

use Moo;
use namespace::sweep -also => [qw(
	must_do
	true false read_only read_write
)];

has target => (
	is         => read_only,
	isa        => must_do( 'XML::LibXML::Document' ),
	coerce     => \&_coerce_dom,
	required   => true,
);

has missing_nodes => (
	is         => read_write,
	isa        => must_do( ARRAY ),
	default    => sub { [] },
);

has head_element_test => (
	is         => read_only,
	isa        => must_do( CODE ),
	default    => sub { sub { no warnings; $_[0]->nodeName ~~ [qw(title link meta style)] } },
);

has body_element_test => (
	is         => read_only,
	isa        => must_do( CODE ),
	default    => sub { sub { no warnings; $_[0]->nodeName ~~ [qw(script map)] } },
);

sub inject
{
	my ($self, $content) = @_;
	my %content = $self->_find_content($content);
	my $dom     = $self->target->cloneNode(true);

	@{ $self->missing_nodes } = ();
	while (my ($id, $el) = each %content)
	{
		if ($id =~ /^-inject/)
		{
			if ($self->head_element_test->($el))
				{ $dom->getElementsByTagName('head')->get_node(1)->appendChild($el) }
			elsif ($self->body_element_test->($el))
				{ $dom->getElementsByTagName('body')->get_node(1)->appendChild($el) }
			else
				{ push @{ $self->missing_nodes }, $el }
		}
		else
		{
			my $target = $dom->findnodes(qq{//*[\@id="$id"]});
			if ($target->size)
			{
				$target->foreach(sub {
					my $t = $_;
					$t->{$_} = $el->{$_} for keys %$el;
					$t->appendChild($_->cloneNode(1)) for $el->childNodes;
				});
			}
			else
			{
				push @{ $self->missing_nodes }, $el;
			}
		}
	}

	return $dom;
}

sub inject_and_new
{
	my ($self, $content) = @_;
	my $class = ref $self;
	$class->new( target => $self->inject($content) );
}

sub _find_content
{
	my ($self, $content) = @_;
	my %rv;

	if (does($content, ARRAY))
	{
		for my $c (@$content)
		{
			my %tmp = $self->_find_content($c);
			$rv{$_} //= $tmp{$_} for keys %tmp;
		}
		return %rv;
	}

	my $i;
	_coerce_dom($content)
		-> findnodes('/*/*/*')
		-> foreach(sub {
			$rv{ $_->{id} ? $_->{id} : sprintf('-inject_%d', ++$i) } = $_;
		});
	return %rv;
}

sub _coerce_dom
{
	my ($it) = @_;

	return $it
		if does($it, 'XML::LibXML::Document');

	return HTML::HTML5::Parser::->load_html(IO => $it)
		if is_filehandle $it;

	return HTML::HTML5::Parser::->load_html(location => $it)
		if is_filename $it;

	return HTML::HTML5::Parser::->load_html(location => "$it")
		if blessed $it && $it->isa('URI');

	return HTML::HTML5::Parser::->load_html(location => "$it")
		if !blessed $it && $it =~ /^(https?|file):\S+$/i;

	return HTML::HTML5::Parser::->load_html(string => $it)
}

1;

__END__