common/scripts/xmlize.pl

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