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