File Coverage

blib/lib/Error/Pure/Output/Tags/HTMLCustomPage.pm

Criterion	Covered	Total	%
statement	15	35	42.8
branch	0	4	0.0
condition			n/a
subroutine	5	6	83.3
pod	1	1	100.0
total	21	46	45.6

package Error::Pure::Output::Tags::HTMLCustomPage;

use base qw(Exporter);
use strict;
use warnings;

use HTTP::Headers::Fast;
use Readonly;

# Constants.
Readonly::Array our @EXPORT_OK => qw(err_pretty);
Readonly::Scalar my $EMPTY_STR => q{};
Readonly::Scalar my $SPACE => q{ };

our $VERSION = 0.04;

# Pretty print.
sub err_pretty {
	my ($tags_obj, $encoding, $content_type, $xml_version,
		$tags_structure_ar) = @_;

	# Reset.
	$tags_obj->reset;

	my $header = HTTP::Headers::Fast->new;
	$header->header(
		'Cache-Control' => 'no-cache',
		'Content-Type' => $content_type,
	);
	$header->date(time);
	$tags_obj->put(['r', $header->as_string."\n"]);

	# Debug from Tags object.
	my $debug = $tags_obj->{'set_indent'};

	# XML tag.
	$tags_obj->put(
		['i', 'xml', 'version="'.$xml_version.'" encoding="'.$encoding.
			'" standalone="no"'],
	);
	if ($debug) {
		$tags_obj->put(['r', "\n"]);
	}

	# DTD.
	my @dtd = (
		'
		'PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"',
		'"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">',
	);
	my ($separator, $linebreak) = ($SPACE, $EMPTY_STR);
	if ($debug) {
		$separator = "\n".$tags_obj->{'next_indent'};
		$linebreak = "\n";
	}
	$tags_obj->put(['r', (join $separator, @dtd).$linebreak]);

	# Main page.
	my @tmp = @{$tags_structure_ar};
	$tags_obj->put(@tmp);

	# Ok.
	return 1;
}

1;

__END__