package GameConfig;

=head1 NAME

  GameConfig - read, parse, deal with game's bin/ config files

=head1 SYNOPSIS

  use GameConfig;  # gm has put $GAME/bin in @INC already

  my $configfile = "bin/packets.config";
  my (%config, %extract);
  GameConfig::packets_config($configfile, \%config, \%extract);
  print "$configfile misc settings:\n", 
        map { "\t$_ is set to $config{$_}\n" } keys %config;
  print "$configfile extractables:\n",
        map { "\t$_ is type $extract{$_}{'type'}\n" } keys %extract;
  my $arg = shift;
  my $field = GameConfig::match_extractable(\%extract, $arg);

=head1 DESCRIPTION

Config files for the Template perl scripts are kept in bin/ along with
the scripts themselves.  (We exclude the optional $GAME/.structure here;
that is dealt with by the gm script and may reset where bin/ itself is.)
For each type of Template config file, GameConfig provides functions
for reading and parsing it and stashing the information, and possibly
additional functions for common uses of that information.

=cut

use strict;
use English '-no_match_vars';

$WARNING = 1;     # same as usual -w option
$OUTPUT_AUTOFLUSH = 1;


=head2 F<packets.config>

bin/packets.config is the usual location for the information desired
by the packets script, including extractable field definitions and
settings and miscellaneous configuration.  The field defns are often
needed by other scripts.

=over

=item B<packets_config> (I<filename>, I<configref>, I<extractref>)

The given I<filename> is game-relative (or gm-tmp-relative) and is 
taken to be of the form of bin/packets.config and read in.  
Everything from a % to end of line is considered a comment and cut.
The arguments I<configref> and I<extractref> must be references to 
hashes; these will be filled in with information from the file.

Lines of the form

foo = bar baz quux

are miscellaneous configuration options; "foo" may not contain
whitespace but is otherwise arbitrary.  Leading/trailing whitespace
is cut from "bar baz quux".  This line causes the equivalent of

$configref->{foo} = "bar baz quux"

It is perfectly reasonable for a new script to define some new options of 
this form, but these should be documented in packets.config to avoid naming 
collisions.  Callers of this subroutine must ignore any I<configref> keys
they do not recognize; they should not consider their presence a problem.

Lines of the form

Foo Bar Baz :  I<type> I<printer> I<option1 option2 ...>

define extractable field "Foo Bar Baz" (which lives in
the $GAME/FooBarBaz directory unless $GAME/.structure redirects).
The I<type> must be "list", "tex", or "char".  "char" denotes the
charsheet type itself (not really an extractable in most ways);
exactly one field of this type must be present.

I<printer> declares what printer this type should be sent to.
Anything further on the line is taken as options to pass lpr, 
usually -Zsomething.

This line causes the equivalent of

$extractref->{"Foo Bar Baz"} = { 
    "type" => "I<type>",      
    "printer" => "I<printer>",
    "lpropt" => "I<option1 option2 option>",
    "compress" => "FooBarBaz",
 };

Thus keys %$extractref will be a list of the fields.

If any problems are encountered, packets_config will warn() about them
and will die() when done; otherwise it simply returns.

=cut

sub packets_config {
  my ($file, $configref, $extractref) = @_;

  my $fh = GAME::open $file or die "can't read packets config $file\n";
  my $configerr = 0;
  my $ncharfields = 0;
  local $INPUT_RECORD_SEPARATOR = "\n";
  while (<$fh>) {
    chomp;
    s/%.*//;
    next unless /\S/;
    if (/^\s*(\S+?)\s*=\s*(.*?)\s*$/) {
      $configref->{$1} = $2;
      next;
    }
    my ($field, $data);
    unless (($field, $data) = /^\s*(\S.*?)\s*:\s*(\S.*?)\s*$/) {
      warn "Bad line in $file (doesn't parse):\n\t$_\n";
      $configerr = 1;
      next;
    }
    unless (@{$extractref->{$field}}{qw( type printer lpropt )} =
	    $data =~ /^\s*(\S+)\s+(\S+)\s*(.*?)\s*$/) {
      warn "Bad line in $file (need type and printer):\n\t$_\n";
      $configerr = 1;
      next;
    }
    if ((my $type = $extractref->{$field}{type}) eq "char") {
      ++$ncharfields;
    }
    elsif ($type ne "tex" and $type ne "list") {
      warn "Bad line in $file (type $type not tex/list/char):\n\t$_\n";
      $configerr = 1;
      next;
    }
    ($extractref->{$field}{"compress"} = $field) =~ tr/ \t//d; 
  }
  close $fh or die "Unable to close packets config $file\n";
  
  if ($ncharfields > 1) {
    warn "Multiple type-char entries (charsheets) in $file\n";
    $configerr = 1;
  }
  elsif ($ncharfields < 1) {
    warn "No type-char entry (charsheets) defined in $file\n";
    $configerr = 1;
  }
  $configerr and die "Bad packets configuration file $file\n";
}


=item (string) B<match_extractable> (I<extractref>, string I<seek>)

I<extractref> should be a reference to a hash that was initialized
by use in B<GameConfig::packets_config> (or constructed by hand to
have the resulting form).  The I<seek> string is a partial field name.

If I<seek> case-insensitively matches exactly one extractable field
name's compressed form (i.e. whitespace removed) of those in I<extractref>,
that field name (uncompressed) is returned.

Otherwise, it die()s complaining about either the lack of matching
fields or the ambiguity of multiple matches (including the list).

=back

=cut

sub match_extractable {
  my $extref = shift;
  my $seek = shift;
  my @match = grep { $extref->{$_}{compress} =~ /^\Q$seek\E/i } keys %$extref;
  @match > 1 and die "'$seek' ambiguous: ", (join ' or ', @match), "\n";
  @match < 1 and die "no extractable field '$seek' defined\n";
  return $match[0];
}


# If there were more bin/ config files, we'd do them here,
# =head2 usual_file_name file
# (description)
# =over
# for each sub for that file,
#   =item subroutine prototype
#   (description)
# =back


1;