common/scripts/xmlize.pl

   1 #!/usr/bin/env perl
   2 #
   3 # xmlize.pl
   4 #
   5 ######################################################################
   6
   7 use strict;
   8 use warnings;
   9 use utf8;
  10 use open ':encoding(UTF-8)';
  11
  12 my $FILE_EXTENSION = 'txt';
  13
  14 #### Main Routine
  15
  16 die "xmlize.pl maxSectionNumber [minSectionNumber]\n" if $#ARGV < 0;
  17 my $minSectionNumber = 1;
  18 my $numberOfSections = shift @ARGV;
  19 $minSectionNumber = shift @ARGV if $#ARGV > -1;
  20
  21 print << "(End of XML Header)";
  22 <?xml version="1.0" encoding="ISO-8859-1"?>
  23 <!DOCTYPE gamebook SYSTEM "gamebook.dtd" [
  24  <!ENTITY % general.links SYSTEM "genlink.mod">
  25  %general.links;
  26  <!ENTITY % xhtml.links   SYSTEM "htmllink.mod">
  27  %xhtml.links;
  28
  29  <!ENTITY % general.inclusions SYSTEM "geninc.mod">
  30  %general.inclusions;
  31 ]>
  32
  33 <gamebook xml:lang="en-UK" version="0.12">
  34
  35  <meta>
  36   <title>[Insert Title]</title>
  37  </meta>
  38
  39  <section id="toc">
  40   <meta />
  41   <data />
  42  </section>
  43
  44  <section id="title">
  45   <meta>
  46    <title>Title Page</title>
  47    <link class="next" idref="dedicate" />
  48   </meta>
  49
  50   <data>
  51
  52    <!-- Frontmatter -->
  53
  54    <section class="numbered" id="numbered">
  55     <meta><title>Numbered Sections</title></meta>
  56
  57     <data>
  58 (End of XML Header)
  59
  60 for( my $sectionNumber = $minSectionNumber; $sectionNumber <= $numberOfSections; ++$sectionNumber ) {
  61
  62     my $infile = "${sectionNumber}.${FILE_EXTENSION}";
  63
  64     open( INFILE, "<$infile" ) or die "Input file \"$infile\" is not readable.\n";
  65
  66     my @oldlines = ( );
  67     @oldlines = <INFILE>;
  68
  69     close INFILE;
  70
  71     my $title = shift @oldlines;
  72     my $section = shift @oldlines;
  73     my $illustration = shift @oldlines;
  74     chomp $illustration;
  75     $illustration =~ s/^Illustration\s+(\d+)\s+/$1/;
  76     $illustration =~ s/\r//g;
  77     shift @oldlines if( $illustration ne "" );
  78
  79     my @newlines = ( "" );
  80     my $newline;
  81
  82     # Parsing waits for an empty line to XMLize and store
  83     # the preceding lines.
  84     push( @oldlines, "" ) if( $oldlines[ $#oldlines ] ne "" );
  85
  86     foreach my $oldline (@oldlines) {
  87         $oldline =~ s/\r|\n/ /g;
  88         $oldline =~ s/^\s*(\S*)\s*$/$1/;
  89         $oldline =~ s/\s{2,}/ /;
  90         if( $oldline ne "" ) {
  91             $newline .= (" " . $oldline);
  92         }
  93         else {
  94                 $newline = &xmlize($newline, $infile);
  95                 $newline .= "\n" if($newline ne "");
  96                 push( @newlines, $newline );
  97                 $newline = "";
  98         }
  99     }
 100
 101     print "\n\n    <section class=\"numbered\" id=\"sect$sectionNumber\">\n     <meta><title>$sectionNumber</title></meta>\n\n     <data>\n";
 102     print @newlines;
 103     print "     </data>\n    </section>";
 104 }
 105
 106 print << "(End of XML footer)";
 107
 108     </data>
 109    </section>
 110
 111    <!-- Backmatter -->
 112
 113   </data>
 114  </section>
 115 </gamebook>
 116 (End of XML footer)
 117
 118 #### Subroutines
 119
 120 sub xmlize {
 121     my( $inline, $infile ) = @_;
 122
 123     $inline =~ tr/\t/ /;
 124     $inline =~ s/[[:space:]]{2,}/ /g;
 125     $inline =~ s/[[:space:]]+$//;
 126     $inline =~ s/^[[:space:]]+//;
 127     $inline =~ s/[[:space:]]*(\.\.\.|\.\s\.\s\.)[[:space:]]*/<ch.ellips\/>/g;
 128
 129     $inline =~ s/\&(?=[[:space:]])/<ch.ampersand\/>/g;
 130     $inline =~ tr/\"\`/\'/;
 131     $inline =~ s/[\N{U+2018}\N{U+201C}]/<quote>/g;
 132     $inline =~ s/[\N{U+2019}\N{U+201D}]/<\/quote>/g;
 133     $inline =~ s/[\N{U+2014}]/<ch.endash\/>/g;
 134     $inline =~ s/[\N{U+2014}]/<ch.emdash\/>/g;
 135
 136     $inline =~ s/(Random\sNumber\sTable)/<a idref=\"random\">$1<\/a>/gi;
 137     $inline =~ s/(Action\sCharts?)/<a idref=\"action\">$1<\/a>/gi;
 138
 139     if( $inline =~ /^\*/ ) {
 140         # unordered lists
 141         $inline =~ s/^\*\s*/       <ul>\n        <li>/;
 142         $inline =~ s/\s*\*\s*/<\/li>\n        <li>/g;
 143         $inline .= "</li>\n       </ul>";
 144     }
 145     elsif( $inline =~ /^\d+\)\s/ ) {
 146         # ordered lists
 147         $inline =~ s/^\d+\)\s+/       <ol>\n        <li>/;
 148         $inline =~ s/\s*\d+\)\s+/<\/li>\n        <li>/g;
 149         $inline .= "</li>\n       </ol>";
 150     }
 151     elsif( $inline =~ /^\<\!\-\-\spre\s\-\-\>/ ) {
 152         # pre-formatted text
 153         $inline =~ s/^\<\!\-\-\spre\s\-\-\>//;
 154         warn( "Warning: pre-formatted text in \"$infile\"\n" );
 155     }
 156     elsif( $inline =~ /^.+:\s+CLOSE\sCOMBAT\sSKILL/ ) {
 157         # Freeway Warrior combat
 158         $inline =~ s/^(.+):\s+CLOSE\sCOMBAT\sSKILL\s+([0-9]+)\s+ENDURANCE\s+([0-9]+)/       <combat><enemy>$1<\/enemy><enemy-attribute class=\"closecombatskill\">$2<\/enemy-attribute><enemy-attribute class=\"endurance\">$3<\/enemy-attribute><\/combat>/g;
 159     }
 160     elsif( $inline =~ /^.+:\s+COMBAT\sSKILL/ ) {
 161         # combat
 162         $inline =~ s/^(.+):\s+COMBAT\sSKILL\s+([0-9]+)\s+ENDURANCE\s+([0-9]+)/       <combat><enemy>$1<\/enemy><enemy-attribute class=\"combatskill\">$2<\/enemy-attribute><enemy-attribute class=\"endurance\">$3<\/enemy-attribute><\/combat>/;
 163     }
 164     elsif( $inline =~ /^(.*)\b(return|turn|go)([a-zA-Z\s]+?to )(\d{1,3})/i ) {
 165         # links
 166         $inline =~ s/^(.*)\b(return|turn|go)([a-zA-Z\s]+?to )(\d{1,3})(.*)/       <choice idref=\"sect$4\">$1<link-text>$2$3$4<\/link-text>$5<\/choice>/i;
 167         $inline =~ s/\s+<\/choice>/<\/choice>/;
 168     }
 169     elsif( $inline =~ /^\[/ ) {
 170         # signposts
 171         $inline =~ s/\[(.*)\]/$1/;
 172         $inline = "       <signpost>$inline</signpost>";
 173         $inline =~ s/\s+<\/signpost>/<\/signpost>/;
 174     }
 175     elsif( $inline =~ /^<!--(.*)-->/ ) {
 176         # comments
 177         warn( "Warning: unknown comment \"$1\" in \"$infile\"\n" );
 178     }
 179     elsif( $inline eq "" ) {
 180         # do nothing
 181     }
 182     else {
 183         $inline = "       <p>$inline</p>";
 184     }
 185
 186     # Interferes with selecting a combat paragraph if done earlier
 187     $inline =~ s/(COMBAT\sSKILL|CLOSE\sCOMBAT\sSKILL|ENDURANCE|WILLPOWER|\bCS\b|\bEP\b)([^<])/<typ class="attribute">$1<\/typ>$2/g;
 188
 189     return $inline;
 190 }