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

package injector;

use strict;
use English;
use GameConfig;
use Getopt::Long;

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


sub usage {
  die "Syntax:
     gmX injector <field> <inputfile> --replace|--add
   will take input from inputfile and stick it into the character sheets
   listed therein.  <inputfile> is expected to be in the extractor's .forw
   format, mapping from charfile names to entries.
   --replace (or -r) puts the new entries in place of the old ones.
   --add (or -a) adds the new entries to the end of the old ones.
   In either case, the insertion is at the extractable field <field>.
   Note that suites are TOTALLY IGNORED.\n";
}
  

my @arg;
my $replace = undef;
Getopt::Long::config("default");
Getopt::Long::config(qw( auto_abbrev bundling permute ));
Getopt::Long::GetOptions(
			 "help|h" => \&usage,
			 "replace|r" => sub { $replace = 1 },
			 "add|a" => sub { $replace = 0 },
			 "<>" => sub { push @arg, shift }
			)
  or &usage;

defined $replace 
  or warn("Must specify --replace (-r) or --add (-a).\n") and &usage;
@arg == 2 or &usage;
my ($field, $infile) = @arg;

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

print "Note that this TOTALLY IGNORES suites.\n";

# before any chdirs...
my $data = GM::open "$infile";
$_ = <$data>;
close $data;

my %content = ();
for (split /\n\s*\n/) {
  next unless $_;
  my ($char, $content) = split /\n/, $_, 2;
  # put comments aside for now, put them back later
  $content =~ 
    s/(^|[^\\])((?:\\\\)*)(%.*?(?:\n|\Z))/$1$2\n%DISPLACED COMMENT:$3/gmx;
  $content{$char} = "$content\n";
}

my $pattern = <<'EOP';
   (^(?!%)[^\n]*?                               # not commented
    \\begin\s*{extractable}\s*{FIELDNAME}\s*    # begin
    (?:\s*%[^\n]*\n)*)                          # initial unaffiliated comments
   (.*?^(?!%)[^\n]*?)                           # contents, then non-commented
   (\\end\s*{extractable})                      # end 
EOP
$pattern =~ s/FIELDNAME/quotemeta $field/e;

GAME::chdir "Charsheets";
for my $char (sort keys %content) {
  print "\t$char ";
  my $in = GM::open "$char.tex";
  $_ = <$in>;
  close $in;
 
  # put comments aside for now, put them back later
  s/(^|[^\\])((?:\\\\)*)(%.*?(?:\n|\Z))/$1$2\n%DISPLACED COMMENT:$3/gmx;
  my $success;
  my $was = "";
  if ($replace) {
    $success = s/$pattern/$1$content{$char}$3/smox;
    $was = $2 if $success;
  }
  else {  # --add
    $success = s/$pattern/$1$2$content{$char}$3/smox;
    $was = $2 if $success;
  }
  $was =~ s/(^|[^\\])((\\\\)*)%.*?(\n|\Z)/$1$2/gm;
  if ($success and $was !~ /\\begin\s*{extractable}/) {
    s/\n%DISPLACED COMMENT:(.*)/$1/g;
    # since perl's rename() doesn't work across filesystem boundaries,
    # don't use the /tmp area
    my $oldfile = "Charsheets/$char.tex";
    my $newfile = "$char.injecting-$compress";
    my $out = GAME::open ">$newfile";
    print $out $_;
    close $out;
    if (GAME::rename($oldfile, "Charsheets/$char.old") and
	GAME::rename($newfile, $oldfile)) {
      print "modified\n";
      next;
    }
  }
  print "failed attempting to modify\n";
}