#!/usr/bin/perl
#use 5.010;
use strict; use warnings;
no warnings qw(uninitialized);

my $FILE = '-';

my $stm_end = '';
my $del_c = '';
my $text_ob = undef;
my $var_ob = undef;
my $var_mode;

sub text_mode {
	if (defined $del_c) {
		$del_c = undef;
		emit_vars();
		$text_ob = 'ap_rputs("';
	}
}

sub emit_text {
	my $text = shift;
	return unless defined $text && $text ne '';
	$text =~ s/(["\\])/\\$1/g;
	unless (defined $del_c) {
		print $text_ob, $text;
		$text_ob = undef;
	}
	else {
		warn "no text allowed at $FILE:$.\n";
	}
}

sub code_mode {
	unless (defined $del_c) {
		if ($text_ob !~ /\("$/) {
			$text_ob .= '"'; $text_ob =~ s/""$//;
			print $text_ob, ',r); ';
		}
		$text_ob = undef;
		$del_c = shift;
	}
}

sub emit_vars {
	if ($var_mode) {
		$var_mode = undef;
		if ($var_ob =~ s/^\s*((?:\s*?"(?:[^"\\]|\\.)*"\s*?)+)\s*%/ap_rprintf(r,$1,/) {}
		elsif ($var_ob =~ s/^\s?((?:[^#]|\\#)*)\s?[#]/local$_=$1;s,(["\\]),\\$1,g;s,\n," "\\n"\n",g;'ap_rprintf(r,"'.$_.'",'/se) {}
		elsif ($var_ob =~ s/^/ap_rprintf(r,/) {}
		$var_ob =~ s/,$//; $var_ob .= '); ';

		print $var_ob;
		$var_ob = undef;
	}
	else {
		print $stm_end; $stm_end = undef;
	}
}

sub emit_code {
	my $code = shift;
	return unless defined $code && $code ne '';
	if (defined $del_c) {
		if ($var_mode) {
			$var_ob .= $code;
		}
		else {
			print $code;
			$stm_end = ($code =~ /[{;}]\s*$/) ? '' : ';';
		}
	}
	else {
		warn "no code allowed at $FILE:$.\n";
	}
}

sub emit_newline {
	if (defined $del_c) {
		if ($var_mode) {
			$var_ob .= "\n";
		}
		else {
			print "\n";
		}
	}
	else {
		my $nl = ($text_ob !~ /\("$/ ? '"\n"' : undef);
		$text_ob .= '"'; $text_ob =~ s/""$//;
		$text_ob .= $nl."\n".'"';
	}
}

$FILE = $ARGV[0];
print "#line 1 \"$FILE\"\n";
text_mode();
while (<>) {
	chomp;
	emit_newline() if $. - 1;
	while (defined) {
		if (defined $del_c) {
			my ($pre, $string, $post) = split /("(?:[^"\\]|\\.)*")/, $_, 2;
			my ($frag, $ntext) = split /\Q$del_c>/, $pre, 2;
			emit_code($frag);
			if (defined $ntext) {
				text_mode();
				$_ = $ntext.$string.$post;
			}
			else {
				emit_code($string);
				$_ = $post;
			}
		}
		else {
			my ($text, $delim, $code) = split /<(%|[?](?:c\++)?(?:\s|$)|[?]?=)/, $_, 2;
			emit_text($text);
			if (defined $delim) {
				$var_mode = ($delim =~ /=$/);
				code_mode((substr $delim, 0, 1));
				$_ = $code;
			}
			else {
				$_ = undef;
			}
		}
	}
}
code_mode('');
emit_vars();
