common/scripts/gbfixquotes.pl

   1 #!/usr/bin/perl -Tw
   2 #
   3 # Uses ANSI color escapes to highlight text and for cursor movement
   4 #
   5
   6 use strict;
   7
   8 my $usage = "Usage:\n  gbfixquotes.pl [options] INFILE OUTFILE\n\t-f      \tforce attempted fixes in malformed places\n\t-s LINES\tskip lines\n";
   9
  10 my $lineNumber = 1;
  11 my $skipLines = 1;
  12
  13 my $tags = qr{(p)|(choice)};
  14 my $quoteMarks = qr{['`\221-\224]};
  15 my $notQuoteMarks = qr{[^'`\221-\224]};
  16 my $terminalPunctuation = qr{[.?!,]};
  17 my $notTerminalPunctuation = qr{[^.?!,]};
  18
  19 my $spellNames = qr{(lightning[[:space:]]+hand)|(splinter)|(flameshaft)|(halt[[:space:]]+missile)|(strength)|(penetrate)|(energy[[:space:]]+grasp)|(slow[[:space:]]+fall)|(breathe[[:space:]]+water)|(power[[:space:]]+glyph)|(hold[[:space:]]+enemy)|(teleport)|(see[[:space:]]+illusion)|(mind[[:space:]]+charm)|(net)|(counterspell)|(sense[[:space:]]+evil)|(invisible[[:space:]]+fist)|(levitation)}i;
  20
  21 my ($infile, $outfile);
  22
  23 my $optsProcessed = 0;
  24 my $forced = 0;
  25
  26 while( $#ARGV > -1 && not $optsProcessed ) {
  27   my $commandLineItem = shift @ARGV;
  28   if( $commandLineItem eq "-f" ) {
  29     $forced = 1;
  30   }
  31   elsif( $commandLineItem eq "-s" ) {
  32     $skipLines = shift @ARGV or die $usage;
  33   }
  34   else {
  35     unshift @ARGV, $commandLineItem;
  36     $optsProcessed = 1;
  37   }
  38 }
  39
  40 if( $#ARGV == 1 ) {
  41   $infile = shift @ARGV;
  42   $outfile = shift @ARGV;
  43 }
  44 else {
  45   die $usage;
  46 }
  47
  48 if( $infile =~ m{(^.*$)} && -f $1 ) {
  49   open( INFILE, "<$1" ) or die "Error: unable to read from \"$infile\": $!\n";
  50 }
  51 else {
  52   die "Error: bad input file\n";
  53 }
  54
  55 if( $outfile =~ m{(^.*$)} ) {
  56   open( OUTFILE, ">$1" ) or die "Error: unable to write to \"$outfile\": $!\n";
  57 }
  58 else {
  59   die "Error: bad output file\n";
  60 }
  61
  62 while( my $line = <INFILE> ) {
  63   if( $skipLines > $lineNumber ) { }
  64   elsif( $line =~ m{<($tags)[[:space:]>]} ) {
  65     my $tagName = $1;
  66     unless( $line =~ m{</$tagName>} ) {
  67       printWarning( "Warning ($lineNumber): <$tagName> found without </$tagName>, skipping tests for current line\n", $line );
  68     }
  69     elsif( $line =~ m{${quoteMarks}} ) {
  70       $line = &quotify( $line );
  71     }
  72   }
  73   elsif( $forced && $line =~ m{${quoteMarks}} ) {
  74       $line = &quotify( $line );
  75   }
  76   elsif( $line =~ m{</($tags)>} ) {
  77     printWarning( "Warning ($lineNumber): </$1> found without <$1>\n", $line );
  78   }
  79   elsif( $line =~ m{($quoteMarks)}x ) {
  80     printWarning( "Warning ($lineNumber): unescaped quotation character \"$1\" found outside tested context\n", $line );
  81   }
  82
  83   print OUTFILE $line;
  84   ++$lineNumber;
  85 }
  86
  87 close OUTFILE;
  88 close INFILE;
  89
  90 ################################################################################
  91
  92 sub quotify {
  93   my ($line) = @_;
  94   my $modified = $line;
  95   $modified =~ s{
  96                  $quoteMarks
  97                  ($spellNames)
  98                  $quoteMarks
  99                 }
 100                 {<spell>$1</spell>}xg;
 101   $modified =~ s{
 102                  ([[:space:]])
 103                  $quoteMarks
 104                  ([[:alpha:]]+)
 105                  $quoteMarks
 106                  ([[:space:]])
 107                 }
 108                 {$1<quote>$2</quote>$3}xg;
 109   $modified =~ s{
 110                  ([[:alpha:]][[:space:]]*)
 111                  $quoteMarks
 112                  ([[:space:]]*[[:alpha:]])
 113                 }
 114                 {$1<ch.apos/>$2}xg;
 115   $modified =~ s{
 116                  ${quoteMarks}
 117                  (${notTerminalPunctuation}+?
 118                  ${terminalPunctuation})
 119                  ${quoteMarks}
 120                 }
 121                 {<quote>$1</quote>}xg;
 122   $modified =~ s{
 123                  ${quoteMarks}
 124                  (${notQuoteMarks}+?)
 125                  ${quoteMarks}
 126                 }
 127                 {<quote>$1</quote>}xg;
 128   print "\033[2J";
 129   print &highlight( $line ) . "\n";
 130   print &highlight( $modified );
 131   print "\033[7m    (a)ccept, (r)eject, (q)uit: [accept]\033[0m >> ";
 132   my $response = <STDIN>;
 133   chomp $response;
 134   if( $response =~ m/^[aA]$/ || $response eq "" ) { $line = $modified; }
 135   elsif( $response =~ m/^[qQ]$/ ) {
 136     print OUTFILE $line;
 137     while( $line = <INFILE> ) {
 138       print OUTFILE $line;
 139     }
 140     exit( 0 );
 141   }
 142   return $line;
 143 }
 144
 145 sub highlight {
 146   my ($text) = @_;
 147
 148   $text =~ s{^[[:space:]]+}{};
 149   $text =~ s{(<quote>)}{\033[1;36m$1\033[0m}g;
 150   $text =~ s{(</quote>)}{\033[1;34m$1\033[0m}g;
 151   $text =~ s{(</?spell>)}{\033[1;35m$1\033[0m}g;
 152   $text =~ s{(<ch.apos/>)}{\033[1;32m$1\033[0m}g;
 153   $text =~ s{($quoteMarks)}{\033[1m\033[43m$1\033[0m}g;
 154
 155   return $text;
 156 }
 157
 158 sub printWarning {
 159     my ($message, $line) = @_;
 160     print "\033[2J";
 161     print "$message\n";
 162     print &highlight( $line ) . "\n";
 163     print "\033[7m    [continue]\033[0m >> ";
 164     my $response = <STDIN>;
 165 }