#!perl         # just to get emacs into perl mode when editing this

package extractor;

use strict;
use English;
use GameConfig;


local $WARNING = 1;     # same as usual -w option
local $INPUT_RECORD_SEPARATOR = undef;  # always slurp whole files
local $OUTPUT_AUTOFLUSH = 1;


sub usage {
  die <<EOI;
 Syntax:
   gmX extractor <field> <outputprefix> <charfile1> [<charfile2> ...]  
 will produce files <outputprefix>.forw and .back from the given
 charsheets (the .tex suffix on each is optional).  Usually you would
 sit in Charsheets and do either
  gmX extractor <field> <outputprefix> *.tex
 or
  gmX extractor <field> <Subdir/outputprefix> *.tex
 In any case, note that the current version DOES NOT DEAL WITH SUITES;
 it looks for *literal* occurrences of \extract, \mention, and \secret
 in the charfile.  Future versions may improve on this.
EOI
}

# Currently the usage is Just Too Simple to do Getopt::Long on @ARGV

my ($field, $outname, @charfiles) = @ARGV;
@charfiles or &usage;
$field =~ /^(-h|--help)/i and &usage;

my (%config, %extract);
GameConfig::packets_config("bin/packets.config", \%config, \%extract);
$field = GameConfig::match_extractable(\%extract, $field);

print "Note that this DOES NOT DEAL with suites.\n";

for (@charfiles) { s/\.tex$// }

# before any chdirs...
my $forw = GM::open ">$outname.forw";
my $back = GM::open ">$outname.back";

my %charmap = ();  # per charfile, array of things (\extract \mention etc)
my %thingmap = (); # per thing, array of charfiles


GAME::chdir "Charsheets";
for my $char (@charfiles) {
  print "\t$char ";
  print $forw "$char\n";

  my $data = GM::open "$char.tex";
  $_ = <$data>;
  close $data;

  # disambiguate things like "\\foo" and "\\%" that aren't really \foo, \%
  # we'll get rid of the cruft we insert before printing
  s/(^|[^\\])((?:\\\\)+)([A-Z%])/$1$2&_&_&_&_&$3/gi;

  # preserve comments, but put them all on lines of their own so ^(?!%) works
  # also put \extract, \mention, etc on lines of their own
  s/(^|[^\\])(%.*?)(\n|\Z)/$1\n$2$3/gm;
  while (s/^(?!%)(.+?)(\\extract|\\mention|\\secret)/$1\n$2/gm) {}
  
  # get rid of blank lines, including the ones we just made
  s/\n\s*\n/\n/g;
  
  if (/^(?!%)[^\n]*?                           # not commented...
      \\begin\s*{extractable}\s*\{\Q$field\E\}\s*  # begin
      (?:\s*%[^\n]*\n)*                        # initial unaffiliated comments
      (.*?                                     # (most) contents
       ^(?!%)[^\n]*?)\\end\s*{extractable}     # non-commented end
      /msox) {
    my $stuff = $1;
    print "\n";
    $stuff =~ s/^\s+//gm;
    $stuff =~ s/\s+$//gm;
    $stuff =~ tr/ \t/ /s;s/[ \t]+/ /g;
    my @stuff = split /^(\\extract|\\mention|\\secret)/m, $stuff;
    shift @stuff if @stuff and $stuff[0] !~ /\S/;
    while (@stuff) {
      my $which = shift @stuff;  # \extract or \mention or etc
      my $entry = shift @stuff;
      print "\t\twarning: empty $which\n" and next
	unless defined $entry and $entry =~ /\S/;
      $entry =~ s/^\s+/ /;
      $entry =~ s/\n+\Z//;
      $entry =~ s/\n/\n\t/g;
      $entry =~ s/&_&_&_&_&//g;      # cruft inserted above for pseudo-macros
      my $thing = "$which$entry";
      print $forw "$thing\n";
      push @{$thingmap{$thing}}, $char;
    }
  }
  else {
    print "has no $field list\n";
  }
  print $forw "\n\n";
}

close $forw;
print "Produced $outname.forw\n";


for my $thing (sort keys %thingmap) {
  print $back "$thing\n";
  for my $char (@{$thingmap{$thing}}) {
    print $back "$char\n";
  }
  print $back "\n\n";
}
close $back;
print "Produced $outname.back\n";