Tex2fb2

   1 #!/usr/bin/perl
   2 # char-level modes
   3 my $poetry = 0;
   4 my $verbatim = 0;
   5 my @sections;
   6 my $buffer;
   7 #
   8 # TODO italic paragaphs
   9 # footnotes
  10 # epigraphs
  11 #
  12 # print fictionbook header
  13 print "<?xml version=\"1.0\" encoding=\"UTF-8\">\n";
  14 print "<FictionBook xmlns=\"http://www.gribuser.ru/xml/fictionbook/2.0\"
  15 xmlns:l=\"http://www.w3.org/1999/xlink\">\n";
  16 my $metadata = shift @ARGV;
  17 open F,"<",$metadata;
  18 while (<F>) {
  19         print $_;
  20 }
  21 close F;
  22
  23 my $header =1;
  24 while (<>) {
  25 $environ = undef;
  26 if (/\\(begin|end){(\w+)}/) {
  27         $environ = $2;
  28         $begin=$1 eq "begin";
  29         if ($environ eq 'verbatim') {
  30                 $verbatim=$begin;
  31         } elsif ($environ eq 'verse') {
  32                 if ($begin) {
  33                 pushsection("poem",undef);
  34                 } else {
  35                 flushsection('poem');
  36                 }
  37                 $poetry = $begin;
  38         } elsif($environ = 'document' && $begin) {
  39                 $header=0;
  40         }
  41 }
  42 next LINE if $header;
  43 if (/^$/ && $environ && $buffer) {
  44 #output on empty line (p or stanza) depending on poetry mode
  45         add_to_section(tag($buffer,$poetry?"stanza":"p"));
  46         $buffer="";
  47 }
  48 next LINE if $environ;
  49 # Section headings
  50 if (/\\(part|chapter|section|subsection|subsubsection){(.*)}/) {
  51         pushsection($1,$2);
  52 }
  53 #normal mode:
  54 if (!$verbatim) {
  55 #strip TeX comments
  56 s/([^\\])%.*$/$1/;
  57 #replace TeX ligatures ~ --- << >> \% with appropriate unicode symbols
  58 s/~/\xA0/g;
  59 s/---/-/g;
  60 s/<</«/g;
  61 s/>>/»/g;
  62 }
  63 #replace ' and " with entities
  64 s/&/&amp;/g;
  65 s/'/&apos;/g;
  66 s/"/&quot;/g;
  67 s/</&lt;/g;
  68 s/>/&gt;/g;
  69
  70 if ($poetry) {
  71         chomp;
  72   $buffer.=tag($_,'v');
  73 } elsif ($verbatim) {
  74         add_to_section(tag(tag($_,"code"),"p"));
  75 } else {
  76   $buffer.=$_;
  77 }
  78 }
  79 if ($buffer) {
  80         add_to_section(tag($buffer,"p"));
  81 }
  82
  83 while (@sections) {
  84         flushsection();
  85 }
  86 print "</body>\n";
  87 ## FIXME print footnotes
  88 print "</FictionBook>";
  89
  90 sub add_to_section {
  91         my $data = shift;
  92         return if ($#sections<0) ;
  93         $sections[$#sections]->{data}.=$data;
  94 }
  95
  96 sub flushsection {
  97         my $tag= shift || 'section';
  98         my $str = pop @sections;
  99         my $content="";
 100         if ($str->{title}) {
 101                 $content = tag($str->{title},"title");
 102         }
 103         $content .=  $str->{data};
 104         if ($#sections >=0) {
 105                 add_to_section(tag($content,$tag));
 106         } else {
 107                 print tag($content,$tag);
 108         }
 109 }
 110
 111 sub pushsection {
 112         my ($level,$title)=@_;
 113         # Find section of $level in the current stack
 114         my $found=scalar(@sections);
 115         LEVEL:
 116         for (my $i=0;$i<=$#sections;$i++) {
 117                 if ($sections[$i]->{level} eq $level) {
 118                         $found=$i;
 119                         last LEVEL;
 120                 }
 121         }
 122         # if found, flush everything below
 123         while (scalar(@sections) > $found) {
 124                 flushsection;
 125         }
 126         push @sections,{level=>$level,title=>$title,data=>""};
 127 }
 128
 129 sub tag {
 130         my ($content,$name) = @_;
 131         return "<$name>$content</$name>";
 132 }