Tex2fb2

   1 #!/usr/bin/perl -CDS
   2 use utf8;
   3 # char-level modes
   4 my $poetry = 0;
   5 my $verbatim = 0;
   6 my @sections;
   7 my $buffer;
   8 my $idseq = 0; # sequentual number of footnotes
   9 my $footnotes="";
  10 #
  11 # TODO italic paragaphs
  12 # footnotes
  13 # epigraphs
  14 #
  15 # print fictionbook header
  16 print "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
  17 print "<FictionBook xmlns=\"http://www.gribuser.ru/xml/fictionbook/2.0\"
  18 xmlns:l=\"http://www.w3.org/1999/xlink\">\n";
  19 my $metadata = shift @ARGV;
  20 open F,"<",$metadata;
  21 while (<F>) {
  22         print $_;
  23 }
  24 close F;
  25 print "<body>\n";
  26 my $header =1;
  27 LINE:
  28 while (<>) {
  29 $environ = undef;
  30 if (/\\(begin|end){(\w+)}/) {
  31         $environ=$2;
  32         $begin=$1 eq "begin";
  33         if ($environ eq 'verbatim') {
  34                 $verbatim=$begin;
  35         } elsif ($environ eq 'verse') {
  36                 if ($begin) {
  37                 pushsection("poem",undef);
  38                 } else {
  39                         add_to_section(tag($buffer,'stanza')."\n") if $buffer;
  40                         $buffer="";
  41                         flushsection('poem');
  42                 }
  43                 $poetry = $begin;
  44         } elsif($environ eq 'document' && $begin) {
  45                 $header=0;
  46         }
  47 }
  48 next LINE if $header;
  49 if ((/^$/ || $environ) && $buffer) {
  50 #output on empty line (p or stanza) depending on poetry mode
  51         add_to_section(tag(flushbuffer($buffer),$poetry?"stanza":"p")."\n");
  52         $buffer="";
  53 }
  54 next LINE if $environ;
  55 # Section headings
  56 if (/\\(part|chapter|section|subsection|subsubsection)\*?{(.*)}/) {
  57         if ($buffer) {
  58                 add_to_section(tag(flushbuffer($buffer),$poetry?"stanza":"p"));
  59                 $buffer="";
  60         }
  61         pushsection($1,tag($2,"p"));
  62         next LINE;
  63 }
  64 if (/\\vspace{/) {
  65         add_to_section("<empty-line />");
  66         next LINE;
  67 }
  68 next LINE if /\\pagebreak\b/;
  69 #normal mode:
  70 if (!$verbatim) {
  71 #strip TeX comments
  72 s/([^\\])%.*$/$1/;
  73 s/^%.*$//;
  74 # strip \sloppy
  75 s/\\sloppy\s+//g;
  76 s/\\sloppy{}//g;
  77 s/\\sloppy([^\w])/$1/g;
  78 # strip extra space
  79 s/^\s+//;
  80 s/\s+$//;
  81 s/(\s)\s+/$1/g;
  82 #replace TeX ligatures ~ --- << >> \% with appropriate unicode symbols
  83 s/~/\xA0/g;
  84 s/---/-/g;
  85 s/<</«/g;
  86 s/>>/»/g;
  87 s/\\%/%/g;
  88 s/\\dots/\x{2026}/g;
  89 }
  90 #replace ' and " with entities
  91 s/&/&amp;/g;
  92 s/'/&apos;/g;
  93 s/"/&quot;/g;
  94 s/</&lt;/g;
  95 s/>/&gt;/g;
  96
  97 if ($poetry) {
  98         chomp;
  99         s/\s*\\\\$//;
 100   $buffer.=tag($_,'v')."\n";
 101 } elsif ($verbatim) {
 102         add_to_section(tag(tag($_,"code"),"p"));
 103 } else {
 104   $buffer.=" ".$_;
 105 }
 106 }
 107 if ($buffer) {
 108         add_to_section(tag(flushbuffer($buffer),"p"));
 109         $buffer="";
 110 }
 111
 112 while (@sections) {
 113         flushsection();
 114 }
 115 print "</body>\n";
 116 ## print footnotes
 117 print "<body id=\"notes\">\n$footnotes\n</body>" if $footnotes;
 118 print "</FictionBook>";
 119
 120 sub add_to_section {
 121         my $data = shift;
 122         return if ($#sections<0) ;
 123         $sections[$#sections]->{data}.=$data;
 124 }
 125
 126 sub flushsection {
 127         my $tag= shift || 'section';
 128         my $str = pop @sections;
 129         my $content="";
 130         if ($str->{title}) {
 131                 $content = tag($str->{title},"title");
 132         }
 133         $content .=  $str->{data};
 134         if ($#sections >=0) {
 135                 add_to_section(tag($content,$tag)."\n");
 136         } else {
 137                 print tag($content,$tag);
 138         }
 139 }
 140
 141 sub pushsection {
 142         my ($level,$title)=@_;
 143         # Find section of $level in the current stack
 144         my $found=scalar(@sections);
 145         LEVEL:
 146         for (my $i=0;$i<=$#sections;$i++) {
 147                 if ($sections[$i]->{level} eq $level) {
 148                         $found=$i;
 149                         last LEVEL;
 150                 }
 151         }
 152         # if found, flush everything below
 153         while (scalar(@sections) > $found) {
 154                 flushsection;
 155         }
 156         push @sections,{level=>$level,title=>$title,data=>""};
 157 }
 158
 159 sub tag {
 160         my ($content,$name) = @_;
 161         return "" if $content =~ /^\s*$/s;
 162         return "<$name>$content</$name>";
 163 }
 164
 165 sub flushbuffer {
 166         local $_ = shift;
 167         s/{\\(em|it|bf)(?:\s+|{})([^{}]+)}/<emphasis>$2<\/emphasis>/g;
 168         s/\\(emph|textit|textbf){([^{}]+)}/<emphasis>$2<\/emphasis>/g;
 169         s/\\footnote{(.*)}/push_footnote($1)/e;
 170         s/[{}]//g;
 171         return $_;
 172 }
 173
 174
 175 sub push_footnote {
 176         my $id = "note_".(++$idseq);
 177         $footnotes.="<section id=\"$id\">".tag(shift,'p')."</section>\n";
 178         return "<a l:href=\"#$id\" type=\"note\">$idseq</a>";
 179 }