Tex2fb2

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