Toby Inkster avatar Toby Inkster committed 89d2867

initial work

Comments (0)

Files changed (11)

+use inc::Module::Package 'RDF 0.009';
+

lib/HTML/Inject.pm

+package HTML::Inject;
+
+use 5.010;
+use constant {
+	true       => !!1,
+	false      => !!0,
+	read_only  => 'ro',
+	read_write => 'rw',
+};
+use strict;
+use warnings;
+use utf8;
+use Moo;
+use namespace::sweep;
+
+BEGIN {
+	$HTML::Inject::AUTHORITY = 'cpan:TOBYINK';
+	$HTML::Inject::VERSION   = '0.001';
+}
+
+use HTML::HTML5::Parser;
+use IO::Detect qw(is_filehandle is_filename);
+use overload ();
+use Scalar::Util qw(blessed reftype);
+use XML::LibXML 1.94;
+
+has target => (
+	is         => read_only,
+	isa        => sub { $_[0]->isa('XML::LibXML::Document') },
+	coerce     => \&_coerce_dom,
+	required   => true,
+);
+
+has missing_nodes => (
+	is         => read_write,
+	isa        => sub { ref $_[0] eq 'ARRAY' },
+	default    => sub { [] },
+);
+
+has head_element_test => (
+	is         => read_only,
+	isa        => sub { reftype($_[0]) eq 'CODE' or overload::Method($_[0], '&{}') },
+	default    => sub { sub { $_[0]->nodeName ~~ [qw(title link meta style)] } },
+);
+
+has body_element_test => (
+	is         => read_only,
+	isa        => sub { reftype($_[0]) eq 'CODE' or overload::Method($_[0], '&{}') },
+	default    => sub { sub { $_[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 (ref $content eq '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 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__
+
+=head1 NAME
+
+HTML::Inject - inject content from one HTML file into another
+
+=head1 SYNOPSIS
+
+ use HTML::Inject;
+ 
+ my $template = HTML::Inject::->new(dom => <<'TARGET');
+ <!doctype html>
+ <html>
+    <head></head>
+    <body>
+       <div id="content"></div>
+       <p class="copyright">&copy; 2012 Acme Inc</p>
+    </body>
+ </html>
+ TARGET
+ 
+ my $result = $template->inject(<<'SOURCE');
+ <!doctype html>
+ <html>
+    <head>
+       <title>Hello World</title>
+    </head>
+    <body>
+       <div id="content">A greeting to the planet!</div>
+    </body>
+ </html>
+ SOURCE
+ 
+ print $result->toString;
+ # <!doctype html>
+ # <html>
+ #    <head>
+ #       <title>Hello World</title>
+ #    </head>
+ #    <body>
+ #       <div id="content">A greeting to the planet!</div>
+ #       <p class="copyright">&copy; 2012 Acme Inc</p>
+ #    </body>
+ # </html>
+
+=head1 DESCRIPTION
+
+C<HTML::Inject> is a "template system lite". It allows you to inject content
+from one HTML file (the "source") into another HTML file (the "target") that
+has placeholders for that content.
+
+=head2 Constructor
+
+=over
+
+=item C<< new(%attr) >>
+
+Moose-style constructor, accepting a hash of attributes. (Actually this
+package uses L<Moo>.)
+
+=back
+
+=head2 Attributes
+
+=over
+
+=item C<< target >>
+
+The target HTML to inject. May be provided as an L<XML::LibXML::Document>
+object, a file handle, a URL, a filename or a plain string of HTML. (To
+disambiguate between a string of HTML, and a filename/URL which is also a
+string, strings of HTML must contain at least one line break character!!)
+Whatever is provided, it will be coerced into an L<XML::LibXML::Document>.
+
+=item C<< head_element_test >>
+
+A coderef which takes an L<XML::LibXML::Element> object and returns a
+boolean. The default is probably fairly sane, matching all C<< <title> >>,
+C<< <link> >>, C<< <meta> >> and C<< <style> >> elements.
+
+See L</"Injection Technique"> for an explanation of the head element test.
+
+=item C<< body_element_test >>
+
+A coderef which takes an L<XML::LibXML::Element> object and returns a
+boolean. The default is probably fairly sane, matching all C<< <script> >>
+and C<< <map> >> elements.
+
+See L</"Injection Technique"> for an explanation of the body element test.
+
+=item C<< missing_nodes >>
+
+An arrayref of XML::LibXML::Node objects. You should probably not set
+this attribute in the constructor, or indeed at all. It's intended as
+a place for HTML::Inject to pass back problem nodes to the caller.
+
+=back
+
+=head2 Methods
+
+=over
+
+=item C<< inject($source) >>
+
+Injects content from the source into the target returning an
+L<XML::LibXML::Document> as the result. The result is generated
+by deep cloning the target, thus the same target can be reused
+again and again with different source data.
+
+Like the target passed to the constructor, the source data can be
+provided as an L<XML::LibXML::Document> object, a file handle, a URL, a
+filename or a plain string of HTML. It may also be an arrayref of any
+of the above.
+
+See L</"Injection Technique"> for more details.
+
+=item C<< inject_and_new($source) >>
+
+As per C<inject>, but returns the result as a new HTML::Inject target.
+That is, this:
+
+ my $template2 = $template->inject_and_new($content);
+
+is equivlent to:
+
+ my $template2 = HTML::Inject::->new(
+    $template->inject($content),
+ );
+
+This is vaguely useful for some chanined operations.
+
+=back
+
+=head2 Injection Technique
+
+Before beginning the injection, the C<missing_nodes> list is cleared.
+
+As a first step, HTML::Inject finds a list of potentially injectable nodes
+in the source document. Potentially injectable things are any nodes which
+are direct children of the HTML C<< <head> >> and C<< <body> >> elements.
+
+It then loops through the potentially injectable nodes.
+
+For elements which have an C<< @id >> attribute, the injection technique
+is to find the element with the corresponding C<< @id >> in the target
+document, and then clone the source element's contents and attributes
+onto the target element. If the target element already has contents, these
+will not be removed, and the new content is added after the existing content.
+
+Nodes without an C<< @id >> attribute are handled differently: they are
+added to the I<end> of the target document's HTML C<< <head> >> or
+C<< <body> >> element, but only if the element passes the C<head_element_test>
+or C<body_element_test>. (Elements which pass both tests will be added to
+the C<< <head> >>.) This allows certain elements from the source document
+like C<< <meta> >>, C<< <title> >> and C<< <script> >> to be injected to the
+target document without having to worry too much about exactly where they're
+injected. They won't be injected in any especially predictable order.
+
+Any potentially injectable nodes which have not been injected will be
+pushed onto the C<missing_nodes> list. You may wish to loop through
+this list yourself, adding them to the result document using some sort
+of logic of your choice.
+
+=head2 HTML Parsing
+
+HTML parsing is via L<HTML::HTML5::Parser> which supports some nicely
+idiomatic HTML. The example in the L</"SYNOPSIS"> could have used:
+
+ my $result = $template->inject(<<'SOURCE');
+ <title>Hello World</title>
+ <div id="content">A greeting to the planet!</div>
+ SOURCE
+
+That is, for the source content, you only really need to include the
+actual elements that you wish to inject. You can ignore the "skeletal
+parts" of the HTML.
+
+=head2 HTML Output
+
+The result of C<inject> is an XML::LibXML::Document element. This can
+be stringified using its C<toString> method. See L<XML::LibXML::Node> for
+details.
+
+If serving the output as C<< text/html >>, then you may be better off
+stringifying it using L<HTML::HTML5::Writer> which makes special effort
+to stringify documents in a way browsers can actually cope with.
+
+If you want your HTML nicely indented, try L<XML::LibXML::PrettyPrint>.
+(Indenting is nice when you're debugging, but you may wish to switch it
+off for deployment, as it imposes a performance penalty.)
+
+=head1 BUGS
+
+Please report any bugs to
+L<http://rt.cpan.org/Dist/Display.html?Queue=HTML-Inject>.
+
+=head1 SEE ALSO
+
+L<Cindy>, L<Apache2::Layout>, L<Template::Semantic>.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is copyright (c) 2012 by Toby Inkster.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=head1 DISCLAIMER OF WARRANTIES
+
+THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
+WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+

meta/changes.pret

+# This file acts as the project's changelog.
+
+`HTML-Inject 0.001 cpan:TOBYINK`
+	issued  2012-08-05;
+	label   "Initial release".
+
+# This file contains general metadata about the project.
+
+@prefix : <http://usefulinc.com/ns/doap#>.
+
+`HTML-Inject`
+	:programming-language "Perl" ;
+	:shortdesc            "inject content from one HTML file into another";
+	:homepage             <https://metacpan.org/release/HTML-Inject>;
+	:download-page        <https://metacpan.org/release/HTML-Inject>;
+	:bug-database         <http://rt.cpan.org/Dist/Display.html?Queue=HTML-Inject>;
+	:created              2012-08-05;
+	:license              <http://dev.perl.org/licenses/>;
+	:maintainer           cpan:TOBYINK;
+	:developer            cpan:TOBYINK.
+
+<http://dev.perl.org/licenses/>
+	dc:title  "the same terms as the perl 5 programming language system itself".
+
+cpan:TOBYINK
+	foaf:name  "Toby Inkster";
+	foaf:mbox  <mailto:tobyink@cpan.org>.
+

meta/makefile.pret

+# This file provides instructions for packaging.
+
+`HTML-Inject`
+	perl_version_from m`HTML::Inject`;
+	version_from      m`HTML::Inject`;
+	readme_from       m`HTML::Inject`;
+	requires          p`Moo`;
+	requires          p`namespace::sweep`;
+	requires          p`HTML::HTML5::Parser 0.200`;
+	requires          p`IO::Detect`;
+	requires          p`XML::LibXML 1.94`;
+	test_requires     p`Test::More 0.61`;
+	test_requires     p`XML::LibXML::PrettyPrint`;
+	recommends        p`XML::LibXML::PrettyPrint`;
+	recommends        p`HTML::HTML5::Writer`;
+	.
+use Test::More tests => 1;
+BEGIN { use_ok('HTML::Inject') };
+
+use Test::More tests => 1;
+use HTML::Inject;
+use XML::LibXML::PrettyPrint;
+
+my $template = HTML::Inject::->new(target => <<'TEMPLATE');
+<!doctype html>
+<html>
+	<head></head>
+	<body>
+		<div id="content"></div>
+	</body>
+</html>
+TEMPLATE
+
+my $pp = XML::LibXML::PrettyPrint::->new_for_html;
+my $output = $pp->pretty_print($template->inject(<<'CONTENT'));
+<title>Hello World</title>
+<div id="content" class="main">A greeting to the planet!</div>
+CONTENT
+
+is($output->toString, <<'OUTPUT');
+<?xml version="1.0" encoding="utf-8"?>
+<html xmlns="http://www.w3.org/1999/xhtml">
+	<head>
+		<title>Hello World</title>
+	</head>
+	<body>
+		<div id="content" class="main">
+			A greeting to the planet!
+		</div>
+	</body>
+</html>
+OUTPUT
+
+use Test::More;
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();
+

xt/02pod_coverage.t

+use Test::More;
+use Test::Pod::Coverage;
+
+my @modules = qw(HTML::Inject);
+pod_coverage_ok($_, "$_ is covered") for @modules;
+done_testing(scalar @modules);
+

xt/03meta_uptodate.t

+use Test::More tests => 1;
+use Test::RDF::DOAP::Version;
+doap_version_ok('HTML-Inject', 'HTML::Inject');
+
+use Test::EOL;
+all_perl_files_ok();
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.