#!/usr/bin/perl

use v5.12;
use warnings;

use Encode qw/decode_utf8/;
use HTML::Entities qw/encode_entities/;
use Text::ParseWords qw/quotewords/;


# 1  Definitions


# 1.1  Global program state

my $empty = ''; # currently buffered empty lines
my $close = ''; # buffered closing tag for currently opened block element
my $postclose = ''; # buffered extra closing tag for opened contiguous element
my $opel = ''; # currently opened block element


# 1.2  Elements

# 1.2.1  Contiguous elements
my %ctels = (
	Li => '<ul>{<li>%</li>}</ul>',
	Qp => '<blockquote>{<p>%</p>}</blockquote>',
);

# 1.2.2  Block elements
my %blels = (
	Hh => '<h\\$1>%</h\\$1>',
	Pp => '<p>%</p>',
	Pr => '<pre>%</pre>',
	Sh => '<h3>%</h3>',
	Ti => '<title>%</title>',
);

# 1.2.3  Inline elements
my %inels = (
	Au => '<meta name="author" content="\\$1"/>',
	Bd => '\\$3<b>\\$1</b>\\$2',
	br => '<br/>',
	Cd => '\\$3<code>\\$1</code>\\$2',
	Cs => '<meta http-equiv="Content-Type" content="text/html; charset=\\$1"/>',
	Da => '<meta name="created" content="\\$1"/>',
	Em => '\\$3<em>\\$1</em>\\$2',
	Hy => '\\$4<a href="\\$2">\\$1</a>\\$3',
	Im => '<img src="\\$1" alt="\\$2"/>',
	It => '\\$3<i>\\$1</i>\\$2',
	Mo => '<meta http-equiv="Last-Modified" content="\\$1"/>',
	St => '\\$3<strong>\\$1</strong>\\$2',
	Tt => '\\$3<tt>\\$1</tt>\\$2',
	Ul => '\\$3<u>\\$1</u>\\$2',
);


# 1.3  Subroutines

# 1.3.1  Handle element request
sub request {
	my ($el, $args) = @_;
	my @argv = quotewords('\s+', 0, $args);
	my $n = @argv;

	if (exists $blels{$el} or exists $ctels{$el}) {
		# Clear empty line buffer
		$empty = '';

		# Close currently open block element, open new
		my ($base, $prestart, $newpostclose) = ('', '', '');
		if (exists $ctels{$el}) {
			$base = $ctels{$el};
			$prestart = prestart($base);
			$newpostclose = postclose($base);
			$base = inner($base);
		} else {
			$base = $blels{$el};
		}
		my $start = start($base);
		my $newclose = interpol(_close($base), @argv) . "\n";

		print $close;
		$close = $newclose;

		print $postclose if $el ne $opel;
		$postclose = $newpostclose;

		print $prestart if $el ne $opel;
		print interpol($start, @argv) . "\n";

		$opel = $el;
	} elsif (exists $inels{$el}) {
		print interpol($inels{$el}, @argv) . "\n";
	} else {
		print STDERR "Error: $el/$n not implemented\n";
		exit 1;
	}
}

# 1.3.2  Interpolate \$n parameters
sub interpol {
	my $s = shift;
	no warnings qw/uninitialized/;
	$s =~ s/\\\$(\d+)/$_[$1-1]/g;
	return $s;
}

# 1.3.3  Retrieve opening tag of block element string
sub start {
	return (split '%', shift)[0];
}

# 1.3.4  Retrieve closing tag of block element string
sub _close {
	return (split '%', shift)[1];
}

# 1.3.5  Retrieve extra opening tag of block element string
sub prestart {
	return (split '{', shift)[0];
}

# 1.3.6  Retrieve extra closing tag of block element string
sub postclose {
	return (split '}', shift)[-1];
}

# 1.3.7  Retrieve inner block of contiguous tag
sub inner {
	my $s = shift;
	$s =~ s/^.*?\{//;
	$s =~ s/}.*?$//;
	return $s
}


# 2  Program


# 2.1  Translate source text to HTML
while (<>) {
	chomp;
	if (/^\.([A-Za-z][a-z])\s*(.*)/) {
		request($1, $2);
	} elsif ($_ eq '') {
		$empty .= "\n";
	} else {
		print $empty; $empty = '';
		print encode_entities(decode_utf8($_)) . "\n";
	}
}

# 2.2  Close currently open block element
print $close;