#!/usr/bin/perl -w

$ruleset_header1 = 
'[datafile]
description="Nations data for Freeciv, ';

$ruleset_header2 = '"
options="1.9"

; Below: nations data in sections [nation_*] for
; all nations available. If you want to have more
; nations just add one at the end. There is a maximum
; of 63 nations however. I hope it is enough :-)
;
; Notes:
;
; name          = name of the nation
; plural        = plural form of the nation name (use "?plural:" qualifier)
; leader        = default leader names for the nation
; leader_sex    = sex of each default leader: "Male" or "Female"
; flag          = string to look for in client tilespec files for
;                 preferred flag icon
; flag_alt      = alternate flag icon string, or "-"
;
; Next are some hints for AI, as defined in struct player_race
; Ask the guy who designed this struct for more explanation :-)
; AFAIK some of them are not implemented yet.
;
; attack        = c 0 = optimize for food, 2 =  optimize for prod
;                 c0 = large amount of buildings, 2 = units
; expand        = c0 = transform first ,  2 = build cities first
; civilized     = c 0 = do not use nukes,  2 = use nukes, lots of pollution
; advisors      = some kind of advisors, not implemented anyway
; tech_goals    = technology goals, up to 10
; wonder        = primary wonder
; government    = wanted government
;
; cities        = city names, of course :-)
;
;
; section [misc] currently contains cities suggested when
; you run out of default cities for your nation
;

';

sub set_add(%%) {
  my %r;
  foreach $k(keys %{$_[0]}, keys %{$_[1]}) {
    $r{$k} = 1;
  }
  return \%r;
}

sub set_multiply(%%) {
  my %s2 = %{$_[1]};
  my %r;
  foreach my $k(keys %{$_[0]}) {
    $r{$k} = 1 if ($s2{$k});
  }
  return \%r;
}

sub set_subst(%%) {
  my %s2 = %{$_[1]};
  my %r;
  foreach my $k(keys %{$_[0]}) {
    $r{$k} = 1 unless ($s2{$k});
  }
  return \%r;
}

sub generate_ruleset (@) {
  print ";\n; File generated in answer to request ``$request''\n;\n\n";
  print $ruleset_header1, $request, $ruleset_header2;
  foreach (@_) {
    print "*include \"nation/$_.ruleset\"\n";
  }
  print "\n;\n; barbarians MUST go last\n;\n";
  foreach (sort keys %{$classification{'barbarians'}}) {
    print "*include \"nation/$_.ruleset\"\n";
  }
  print "\n";
  foreach (sort keys %{$classification{'misc_cities'}}) {
    print "*include \"nation/$_.ruleset\"\n";
  }
}

sub execute_operation ($$$) {
  my ($s1, $op, $s2) = @_;
  if ($op eq '+') {
   return set_add ($s1, $s2);
  }
  if ($op eq '&') {
   return set_multiply ($s1, $s2);
  }
  if ($op eq '-') {
   return set_subst ($s1, $s2);
  }
  return $s2 if ($s2);
  return $s1 if ($s1);
  die "Wrong operation [$s1 $op $s2]"
}

sub run_request (@) {
  my @tokens = @_;
  my (@sets_stack, @ops_stack);
  my $depth = 0;
  while (@tokens) {
      my $token = shift @tokens;
      if ($token eq '(') { $depth ++ }
      elsif ($token eq ')') {
            $depth --;
            my $set_last = pop @sets_stack;
            $sets_stack[-1] = execute_operation ($sets_stack[-1], pop @ops_stack, $set_last);
      }
      elsif ($token =~ /[+&-]/) {
            push @ops_stack, $token;
      }
      elsif (defined $sets_stack[$depth]) {
             $sets_stack[-1] = execute_operation ( $sets_stack[-1], pop @ops_stack, $classification{$token} );
      } else {
             push @sets_stack, $classification{$token};
      }
  }
  if (@ops_stack)
    { die "Syntax error somewhere in your request. Probably too many + - or &" }
  my @final_set = sort keys %{$sets_stack[0]};
  if ($sets_stack[1])
    { die "Syntax error somewhere in your request. Probably unbalanced parens" }
  return @final_set;
}

sub parse_request ($) {
  my $request = shift;
  my @tokens;
  while ($request =~ /\s*([()+&-]|[a-zA-Z0-9_]+)\s*(.*)/) {
    push @tokens, $1;
    $request = $2;
  }
  return run_request (@tokens);
}

### MAIN ()

unless ($request = "@ARGV") {
  print "Run it : $0 [request]\n";
  exit 1;
}

open CLASSES_RULESET, "classes.ruleset";

foreach $line (<CLASSES_RULESET>) {
  my ($nation, $classes_list) = ($line =~ /(\S+)\s+(.*)/);
  my @nation_in_classes = split /\s+/,$classes_list;
  push @nation_set, $nation;
  $nation_has_classes{$nation} = \@nation_in_classes;
}

close CLASSES_RULESET;

foreach $nation(@nation_set) {
  foreach $class(@{$nation_has_classes{$nation}}) {
    $classification{$class}{$nation} = 1;
  }
}

generate_ruleset (parse_request ($request));