#!/usr/bin/perl -CDS
use utf8;
use POSIX qw(strftime);
use MIME::Base64;
# char-level modes
my $poetry = 0;
my $verbatim = 0;
my @sections;
my $buffer;
my $idseq = 0; # sequentual number of footnotes
my $footnotes="";
#
# TODO italic paragaphs
# footnotes
# epigraphs
#
# print fictionbook header
print "\n";
print "\n";
my $metadata = shift @ARGV;
open F,"<",$metadata;
my $pics = "";
while () {
# Replace empty date with current date
if (// || /\s*<\/date>/) {
$_ = "".
strftime("%d/%m/%Y",localtime())."\n";
}
# Add current to date as fractional part to version
if (/(\d*)(.\d*)?<\/version>/) {
my $ver = $1+time()/1E10;
$_=tag(sprintf("%g",$ver),"version")."\n";
}
# Если существует cover.png, добавляем coverpage
if (//) {
$_="";
COVER:
for $file ("cover.jpg","cover.png") {
if (-f $file) {
my $id = $file;
$id=~tr/./_/;
$_ = "\n\n\n";
$pics .= mkbinary($file,$id);
last COVER;
}
}
}
print $_;
}
close F;
print "\n";
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(flushbuffer($buffer),$poetry?"stanza":"p")."\n");
$buffer="";
}
next LINE if $environ;
# Section headings
if (/\\(part|chapter|section|subsection|subsubsection)\*?\{(.*)\}/) {
if ($buffer) {
add_to_section(tag(flushbuffer($buffer),$poetry?"stanza":"p"));
$buffer="";
}
pushsection($1,tag($2,"p"));
next LINE;
}
if (/\\vspace\{/) {
add_to_section("");
next LINE;
}
next LINE if /\\pagebreak\b/;
#replace ' and " with entities
s/&/&/g;
s/'/'/g;
s/"/"/g;
s//>/g;
#normal mode:
if (!$verbatim) {
#strip TeX comments
s/([^\\])%.*$/$1/;
s/^%.*$//;
# strip \sloppy
s/\\(\w+)\\sloppy/\\$1/g;
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
$_ = fix_ligatures($_);
}
if ($poetry) {
chomp;
if ($poetic_buffer) {
$_ = $poetic_buffer." ".$_;
$poetic_buffer = undef;
}
if (/{[^}]+$/) {
$poetic_buffer=$_;
next LINE;
}
s/\s*\\\\$//;
$buffer.=tag(flushbuffer($_),'v')."\n";
} elsif ($verbatim) {
add_to_section(tag(tag($_,"code"),"p"));
} else {
$buffer.=" ".$_;
}
}
if ($buffer) {
add_to_section(tag(flushbuffer($buffer),"p"));
$buffer="";
}
while (@sections) {
flushsection();
}
print "\n";
## print footnotes
print "\n$footnotes\n" if $footnotes;
print $pics;
print "";
sub add_to_section {
my $data = shift;
return if ($#sections<0) ;
if ($data =~ /^\s*/ && $sections[$#sections]->{data} !~ /^\s*/) {
$sections[$#sections]->{data} = tag($sections[$#sections]->{data},"section")."\n";
}
$sections[$#sections]->{data}.=$data;
}
sub flushsection {
my $tag= shift || 'section';
my $str = pop @sections;
my $content="";
if ($str->{title}) {
$content = tag($str->{title},"title");
}
if ($str->{data} =~ /^\s*$/s) {
$content .= "\n
";
} else {
$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=>fix_ligatures($title),data=>""};
}
sub fix_ligatures {
local $_=shift;
s/~/\xA0/g;
s/\\-/\xAD/g;
s/---/—/g;
s/<>/»/g;
s/\\%/%/g;
s/\\dots/\x{2026}/g;
s/\\verb(.)(.*)\1/$2<\/code>/;
return $_;
}
sub tag {
my ($content,$name) = @_;
$content =~s/^\s+//s;
return "" unless $content;
return "<$name>$content";
}
sub flushbuffer {
local $_ = shift;
s/\\footnote\{(.*)\}/push_footnote($1)/e;
$_.="}" if (/^\s*\{.*?[^}]$/) ;
s/\{\\(em|it|bf)(?:\s+| \{\})([^{}]+)}/$2<\/emphasis>/g;
s/\{\\(tt)(?:\s+|\{\})([^{}]+)}/$2<\/code>/g;
s/\\(emph|textit|textbf)\{([^{}]+)\}/$2<\/emphasis>/g;
s/[{}]//g;
return $_;
}
sub push_footnote {
my $id = "note_".(++$idseq);
$footnotes.="".tag(flushbuffer(shift),'p')."\n";
return "$idseq";
}
sub mkbinary {
my ($filename,$id) = @_;
my $f;
open $f,"<",$filename;
binmode $f;
local $/;
my $data = encode_base64(<$f>);
return "$data\n";
close $f;
}