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