#!/usr/bin/perl -CDS
use utf8;
# char-level modes
my $poetry = 0;
my $verbatim = 0;
my @sections;
my $buffer;
#
# TODO italic paragaphs
# footnotes
# epigraphs
#
# print fictionbook header
print "<?xml version=\"1.0\" encoding=\"UTF-8\">\n";
print "<FictionBook xmlns=\"http://www.gribuser.ru/xml/fictionbook/2.0\"
xmlns:l=\"http://www.w3.org/1999/xlink\">\n";
my $metadata = shift @ARGV;
open F,"<",$metadata;
while (<F>) {
	print $_;
}
close F;

my $header =1;
LINE:
while (<>) {
$environ = undef;
if (/\\(begin|end){(\w+)}/) {
	$environ=$2;
	$begin=$1 eq "begin";
	if ($environ eq 'verbatim') {
		$verbatim=$begin;
	} elsif ($environ eq 'verse') {
		if ($begin) {
		pushsection("poem",undef);
		} else {
			add_to_section(tag($buffer,'stanza')."\n") if $buffer;
			$buffer="";
			flushsection('poem');
		}
		$poetry = $begin;
	} elsif($environ eq 'document' && $begin) {
		$header=0;
	}
}
next LINE if $header;
if ((/^$/ || $environ) && $buffer) {
#output on empty line (p or stanza) depending on poetry mode
	add_to_section(tag($buffer,$poetry?"stanza":"p")."\n");
	$buffer="";
}
next LINE if $environ;
# Section headings
if (/\\(part|chapter|section|subsection|subsubsection)\*?{(.*)}/) {
	if ($buffer) {
		add_to_section(tag($buffer,$poetry?"stanza":"p"));
		$buffer="";
	}
	pushsection($1,$2);
	next LINE;
}
if (/\\vspace{/) {
	add_to_section("<empty-line />");
	next LINE;
}
next LINE if /\\pagebreak\b/;
#normal mode: 
if (!$verbatim) {
#strip TeX comments 
s/([^\\])%.*$/$1/;
s/^%.*$//;
# strip \sloppy
s/\\sloppy\s+//g;
s/\\sloppy{}//g;
s/\\sloppy([^\w])/$1/g;
# strip extra space
s/^\s+//;
s/\s+$//;
s/(\s)\s+/$1/g;
#replace TeX ligatures ~ --- << >> \% with appropriate unicode symbols
s/~/\xA0/g;
s/---/-/g;
s/<</«/g;
s/>>/»/g;
s/\\%/%/g;
s/\\dots/\x{2026}/g;
}
#replace ' and " with entities
s/&/&amp;/g;
s/'/&apos;/g;
s/"/&quot;/g;
s/</&lt;/g;
s/>/&gt;/g;

if ($poetry) {
	chomp;
	s/\s*\\\\$//;
  $buffer.=tag($_,'v')."\n";
} elsif ($verbatim) {
	add_to_section(tag(tag($_,"code"),"p"));
} else {
  $buffer.=" ".$_;
}
}
if ($buffer) {
	add_to_section(tag($buffer,"p"));
	$buffer="";
}

while (@sections) {
	flushsection();
}
print "</body>\n";
## FIXME print footnotes
print "</FictionBook>";

sub add_to_section {
	my $data = shift;
	return if ($#sections<0) ;
	$sections[$#sections]->{data}.=$data;
}

sub flushsection {
	my $tag= shift || 'section';
	my $str = pop @sections;
	my $content="";
	if ($str->{title}) {
		$content = tag($str->{title},"title");
	}
	$content .=  $str->{data};
	if ($#sections >=0) {
		add_to_section(tag($content,$tag)."\n");
	} else {
		print tag($content,$tag);
	}
}

sub pushsection {
	my ($level,$title)=@_;
	# Find section of $level in the current stack
	my $found=scalar(@sections);
	LEVEL:
	for (my $i=0;$i<=$#sections;$i++) {
		if ($sections[$i]->{level} eq $level) {
			$found=$i;
			last LEVEL;
		}
	}
	# if found, flush everything below
	while (scalar(@sections) > $found) {
		flushsection;
	}
	push @sections,{level=>$level,title=>$title,data=>""};
}

sub tag {
	my ($content,$name) = @_;
	return "" if $content =~ /^\s*$/s;
	return "<$name>$content</$name>";
}