Tex2fb2

   1 #!/usr/bin/perl -CDS
   2 use utf8;
   3 use POSIX qw(strftime);
   4 use MIME::Base64;
   5 # char-level modes
   6 my $poetry = 0;
   7 my $verbatim = 0;
   8 my @sections;
   9 my $buffer;
  10 my $idseq = 0; # sequentual number of footnotes
  11 my $footnotes="";
  12 #
  13 # TODO italic paragaphs
  14 # footnotes
  15 # epigraphs
  16 #
  17 # print fictionbook header
  18 print "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
  19 print "<FictionBook xmlns=\"http://www.gribuser.ru/xml/fictionbook/2.0\"
  20 xmlns:l=\"http://www.w3.org/1999/xlink\">\n";
  21 my $metadata = shift @ARGV;
  22 open F,"<",$metadata;
  23 my $pics = "";
  24 while (<F>) {
  25         # Replace empty date with current date
  26         if (/<date\s+\/>/ || /<date>\s*<\/date>/) {
  27                 $_ = "<date value=\"".strftime("%Y-%m-%d",localtime())."\">".
  28                         strftime("%d/%m/%Y",localtime())."</date>\n";
  29         }
  30         # Add current to date as fractional part to version
  31         if (/<version>(\d*)(.\d*)?<\/version>/) {
  32                 my $ver = $1+time()/1E10;
  33                 $_=tag(sprintf("%g",$ver),"version")."\n";
  34         }
  35         # Если  существует cover.png, добавляем coverpage
  36         if (/<coverpage \/>/) {
  37                 $_="";
  38                 if (-f "cover.png") {
  39                         my $id = "cover_png";
  40                         $_ = "<coverpage>\n<image l:href=\"#$id\" />\n</coverpage>\n";
  41                         $pics .= mkbinary("cover.png",$id);
  42                 }
  43         }
  44         print $_;
  45 }
  46 close F;
  47 print "<body>\n";
  48 my $header =1;
  49 LINE:
  50 while (<>) {
  51 $environ = undef;
  52 if (/\\(begin|end){(\w+)}/) {
  53         $environ=$2;
  54         $begin=$1 eq "begin";
  55         if ($environ eq 'verbatim') {
  56                 $verbatim=$begin;
  57         } elsif ($environ eq 'verse') {
  58                 if ($begin) {
  59                 pushsection("poem",undef);
  60                 } else {
  61                         add_to_section(tag($buffer,'stanza')."\n") if $buffer;
  62                         $buffer="";
  63                         flushsection('poem');
  64                 }
  65                 $poetry = $begin;
  66         } elsif($environ eq 'document' && $begin) {
  67                 $header=0;
  68         }
  69 }
  70 next LINE if $header;
  71 if ((/^$/ || $environ) && $buffer) {
  72 #output on empty line (p or stanza) depending on poetry mode
  73         add_to_section(tag(flushbuffer($buffer),$poetry?"stanza":"p")."\n");
  74         $buffer="";
  75 }
  76 next LINE if $environ;
  77 # Section headings
  78 if (/\\(part|chapter|section|subsection|subsubsection)\*?{(.*)}/) {
  79         if ($buffer) {
  80                 add_to_section(tag(flushbuffer($buffer),$poetry?"stanza":"p"));
  81                 $buffer="";
  82         }
  83         pushsection($1,tag($2,"p"));
  84         next LINE;
  85 }
  86 if (/\\vspace{/) {
  87         add_to_section("<empty-line />");
  88         next LINE;
  89 }
  90 next LINE if /\\pagebreak\b/;
  91 #replace ' and " with entities
  92 s/&/&amp;/g;
  93 s/'/&apos;/g;
  94 s/"/&quot;/g;
  95 s/</&lt;/g;
  96 s/>/&gt;/g;
  97 #normal mode:
  98 if (!$verbatim) {
  99 #strip TeX comments
 100 s/([^\\])%.*$/$1/;
 101 s/^%.*$//;
 102 # strip \sloppy
 103 s/\\sloppy\s+//g;
 104 s/\\sloppy{}//g;
 105 s/\\sloppy([^\w])/$1/g;
 106 # strip extra space
 107 s/^\s+//;
 108 s/\s+$//;
 109 s/(\s)\s+/$1/g;
 110 #replace TeX ligatures ~ --- << >> \% with appropriate unicode symbols
 111 s/~/\xA0/g;
 112 s/\\-/\xAD/g;
 113 s/---/—/g;
 114 s/<</«/g;
 115 s/>>/»/g;
 116 s/\\%/%/g;
 117 s/\\dots/\x{2026}/g;
 118 s/\\verb(.)(.*)\1/<code>$2<\/code>/;
 119 }
 120
 121 if ($poetry) {
 122         chomp;
 123         if ($poetic_buffer) {
 124                 $_ = $poetic_buffer." ".$_;
 125                 $poetic_buffer = undef;
 126         }
 127         if (/{[^}]+$/) {
 128                 $poetic_buffer=$_;
 129                 next LINE;
 130         }
 131         s/\\footnote{(.*)}/push_footnote($1)/e;
 132         s/\s*\\\\$//;
 133   $buffer.=tag($_,'v')."\n";
 134 } elsif ($verbatim) {
 135         add_to_section(tag(tag($_,"code"),"p"));
 136 } else {
 137   $buffer.=" ".$_;
 138 }
 139 }
 140 if ($buffer) {
 141         add_to_section(tag(flushbuffer($buffer),"p"));
 142         $buffer="";
 143 }
 144
 145 while (@sections) {
 146         flushsection();
 147 }
 148 print "</body>\n";
 149 ## print footnotes
 150 print "<body>\n$footnotes\n</body>" if $footnotes;
 151 print $pics;
 152 print "</FictionBook>";
 153
 154 sub add_to_section {
 155         my $data = shift;
 156         return if ($#sections<0) ;
 157         if ($data =~ /^\s*<section>/ && $sections[$#sections]->{data} !~ /^\s*<section>/) {
 158                 $sections[$#sections]->{data} = tag($sections[$#sections]->{data},"section")."\n";
 159         }
 160         $sections[$#sections]->{data}.=$data;
 161 }
 162
 163 sub flushsection {
 164         my $tag= shift || 'section';
 165         my $str = pop @sections;
 166         my $content="";
 167         if ($str->{title}) {
 168                 $content = tag($str->{title},"title");
 169         }
 170         if ($str->{data} =~ /^\s*$/s) {
 171                 $content .= "<p>\n</p>";
 172         } else {
 173                 $content .=  $str->{data};
 174         }
 175         if ($#sections >=0) {
 176                 add_to_section(tag($content,$tag)."\n");
 177         } else {
 178                 print tag($content,$tag);
 179         }
 180 }
 181
 182 sub pushsection {
 183         my ($level,$title)=@_;
 184         # Find section of $level in the current stack
 185         my $found=scalar(@sections);
 186         LEVEL:
 187         for (my $i=0;$i<=$#sections;$i++) {
 188                 if ($sections[$i]->{level} eq $level) {
 189                         $found=$i;
 190                         last LEVEL;
 191                 }
 192         }
 193         # if found, flush everything below
 194         while (scalar(@sections) > $found) {
 195                 flushsection;
 196         }
 197         push @sections,{level=>$level,title=>$title,data=>""};
 198 }
 199
 200 sub tag {
 201         my ($content,$name) = @_;
 202         $content =~s/^\s+//s;
 203         return "" unless $content;
 204         return "<$name>$content</$name>";
 205 }
 206
 207 sub flushbuffer {
 208         local $_ = shift;
 209         s/{\\(em|it|bf)(?:\s+|{})([^{}]+)}/<emphasis>$2<\/emphasis>/g;
 210         s/\\(emph|textit|textbf){([^{}]+)}/<emphasis>$2<\/emphasis>/g;
 211         s/\\footnote{(.*)}/push_footnote($1)/e;
 212         s/[{}]//g;
 213         return $_;
 214 }
 215
 216
 217 sub push_footnote {
 218         my $id = "note_".(++$idseq);
 219         $footnotes.="<section id=\"$id\">".tag(shift,'p')."</section>\n";
 220         return "<a l:href=\"#$id\" type=\"note\">$idseq</a>";
 221 }
 222
 223 sub mkbinary {
 224         my ($filename,$id) = @_;
 225         my $f;
 226         open $f,"<",$filename;
 227         binmode $f;
 228         local $/;
 229         my $data = encode_base64(<$f>);
 230         return "<binary id=\"$id\" content-type=\"image/png\">$data</binary>\n";
 231         close $f;
 232 }