#!/usr/bin/perl -T
# This program is free software. You can redistribute it and/or modify it under
# the same terms as perl itself.
# Copyright © 2008-2011 M. Kristall

# Reads from stdin, converts single char to multi char admin flags or vice versa
# prints to stdout
use common::sense;
my @FLAGS = (
	# built-in commands - dups are for going backwards
	['b', 'ban'],
	['a', 'admintest'],
	['d', 'denybuild'],
	['y', 'allready'],
	['c', 'cancelvote'],
	['h', 'adminhelp'],
	['h', 'help'],
	['k', 'kick'],
	['D', 'listadmins'],
	['L', 'listlayouts'],
	['i', 'listplayers'],
	['K', 'lock'],
	['M', 'changemap'],
	['M', 'map'],
	['m', 'mute'],
	['e', 'namelog'],
	['n', 'nextmap'],
	['V', 'passvote'],
	['p', 'putteam'],
	['G', 'readconfig'],
	['N', 'rename'],
	['r', 'restart'],
	['s', 'setlevel'],
	['B', 'showbans'],
	['P', 'spec999'],
	['C', 'time'],

	# special flags
	['1', 'IMMUNITY'],
	['2', 'NOCENSORFLOOD'],
	['3', ''],
	['3', 'TEAMCHANGEFREE'],
	['4', 'SPECALLCHAT'],
	['5', 'FORCETEAMCHANGE'],
	['6', 'UNACCOUNTABLE'],
	['7', 'NOVOTELIMIT'],
	['8', 'CANPERMBAN'],
	['9', ''],
	['9', 'TEAMCHATCMD'],
	['0', 'ACTIVITY'],
	['!', 'IMMUTABLE'],
	['@', 'INCOGNITO'],
	['$', ''],
	['$', 'FULLLISTPLAYERS'],
	['?', 'ADMINCHAT'],

	# really special flags
	['*', 'ALLFLAGS -INCOGNITO -IMMUTABLE'],
	['*', 'ALLFLAGS']
);

sub flag ($$) {
	my ($single, $flag) = @_;
	$flag =~ /^([+-]?)(.+)$/;
	foreach (@FLAGS) {
		return $1 . $_->[$single] if ($_->[!$single] eq $2);
	}
	return;
}

sub splitsingle ($) {
	my $flags = $_[0];
	my $c;
	my @flags;
	while ($flags ne '') {
		$c = substr ($flags, 0, 1, '');
		if ($c eq '-') {
			while ($flags ne '') {
				$c = substr ($flags, 0, 1, '');
				last if ($c eq '+');
				push (@flags, "-$c");
			}
			next;
		}
		push (@flags, $c);
		if ($c eq '*') {
			push (@flags, map { "-$_" } split (//, $flags));
			last;
		}
	}
	return @flags;
}

sub splitmulti ($) { return split (' ', $_[0]); }

sub find ($@) {
	for (my $i = 1; $i < @_; $i++) {
		return 1 if ($_[$i] eq $_[0]);
	}
	return;
}

# joinsingle and joinmulti take (already converted) flags and return an
# approximately equivalent version
sub joinsingle (@) {
	my (@p, @n);
	my $all;
	foreach (@_) {
		if ($_ eq '*') {
			$all = 1;
			for (my $i = 0; $i < @p; $i++) {
				next if ($p[$i] eq '!' || $p[$i] eq '@');
				# better than splice
				$p[$i] = '';
			}
		} elsif (s/^-// || $all) {
			next if ($all && ($_ eq '!' || $_ eq '@'));
			push (@n, $_) unless (find ($_, @n) || find ($_, @p));
		} else {
			s/\+// if (length > 1);
			push (@p, $_) unless (find ($_, @n) || find ($_, @p));
		}
	}
	return join ('', @p, $all ? '*' : '', @n && !$all ? '-' : '', @n);
}

sub joinmulti (@) {
	my (@p, @n);
	my $all = '';
	# hack to make the * hack work
	my @flags = map { split (' ') } @_;
	foreach (@flags) {
		if (/^([+-]?)ALLFLAGS$/) {
			my $x;
			$all = $1 || '+';
			$x = $all eq '-' ? \@n : \@p;
			for (my $i = 0; $i < @$x; $i++) {
				next if ($$x[$i] eq 'INCOGNITO' ||
					$$x[$i] eq 'IMMUTABLE');
				splice (@$x, $i--, 1);
			}
			push (@{$all eq '+' ? \@p : \@n}, 'ALLFLAGS');
		} elsif (s/^-//) {
			next if ($all eq '-' &&
				$all ne 'INCOGNITO' &&
				$all ne 'IMMUTABLE');
			push (@n, $_) unless (find ($_, @n) || find ($_, @p));
		} else {
			s/^\+//;
			next if ($all eq '+' &&
				$all ne 'INCOGNITO' &&
				$all ne 'IMMUTABLE');
			push (@p, $_) unless (find ($_, @n) || find ($_, @p));
		}
	}
	return join (' ', @p, map { "-$_" } @n);
}

sub convertflags ($$) {
	my ($single, $flags) = @_;
	my @flags = $single ? splitsingle ($flags) : splitmulti ($flags);
	my (@out, $i, $o);
	my @unmatched;
	foreach $i (@flags) {
		$o = flag ($single, $i);
		if (defined ($o)) {
			push (@out, $o);
		} else {
			push (@unmatched, $i);
		}
	}
	return (\@out, \@unmatched);
}

sub in (*) {
	my $in = $_[0];
	my $vars = {
		admin	=> {
			name	=> '',
			guid	=> '',
			level	=> 0,
			flags	=> ''
		},
		command	=> {
			command	=> '',
			exec	=> '',
			desc	=> '',
			levels	=> '',
			flag	=> ''
		},
		level	=> {
			level	=> 0,
			name	=> '',
			flags	=> ''
		},
		ban	=> {
			name	=> '',
			guid	=> '',
			ip	=> '',
			reason	=> '',
			made	=> '',
			expires	=> 1,
			banner	=> ''
		}
	};
	my %out = map { $_ => [] } keys (%$vars);
	my $ref;
	my $sec;
	while (<$in>) {
		if (/^\s*\[(\w+)\]\s*/i) {
			$sec = lc ($1);
			unless ($out{$sec}) {
				warn ("ignoring section $sec, line $.\n");
				# don't let it muck up anything else
				$ref = {};
				next;
			}
			push (@{$out{$sec}}, $ref = {%{$vars->{$sec}}});
		} elsif ($ref && /^\s*(\w+)\s+(?:=\s+)?(.*)\s*$/) {
			unless (exists ($vars->{$sec}{lc ($1)})) {
				warn ("ignoring invalid var $1, line $.\n");
				next;
			}
			$ref->{lc ($1)} = $2;
		} elsif (!/^\s*$/) {
			warn ("line $. unexpected: $_");
		}
	}
	return \%out;
}

sub out ($) {
	my $out = $_[0];
	my ($sec, $var, $val);
	while (($sec, $var) = each (%$out)) {
		foreach $val (@$var) {
			print "[$sec]\n";
			printf "%-7s = %s\n", $_, $val->{$_}
				foreach (keys (%$val));
			print "\n";
		}
	}
}

###
sub level ($$) {
	my ($dat, $level) = @_;
	foreach (@{$dat->{level}}) {
		return $_ if ($_->{level} == $level);
	}
	return;
}

sub commandflag ($$) {
	my ($dat, $flag) = @_;
	my @commands;
	foreach (@{$dat->{command}}) {
		next unless (exists ($_->{flag}));
		push (@commands, $_) if ($_->{flag} eq $flag);
	}
	return @commands;
}

sub levelcommands ($$) {
	my ($dat, $level) = @_;
	my @commands;
	foreach my $command (@{$dat->{command}}) {
		foreach (split (' ', $command->{levels})) {
			if ($_ == $level) {
				push (@commands, $command);
				last;
			}
		}
	}
	return @commands;
}

my $stom;
if (@ARGV == 1 && $ARGV[0] eq 'single') {
	$stom = 1;
} elsif (@ARGV != 1 || $ARGV[0] ne 'multi') {
	die ("$0 single|multi\n");
}
die ("$0 will not touch your files\nhint: try $0 $ARGV[0] < $ARGV[1]\n")
	if (@ARGV > 1);

my $dat = in (STDIN);
my ($flags, $unmatched);
if ($stom) {
	foreach (@{$dat->{command}}) {
		#define MAX_ADMIN_CMD_LEN       20
		$flags = lc (substr ($_->{command}, 0, 19));
		while (flag ($stom, $flags) || commandflag ($dat, $flags)) {
			$flags++;
		}
		$_->{flag} = $flags;
		warn ("command !$_->{command}: flag = $_->{flag}\n");
	}
}
my $level;
foreach $level (@{$dat->{level}}) {
	($flags, $unmatched) = convertflags ($stom, $level->{flags});
	if ($stom) {
		warn ("level $level->{level}: unrecognised flag \"$_\"\n")
			foreach (@$unmatched);
		foreach (levelcommands ($dat, $level->{level})) {
			push (@$flags, $_->{flag});
		}
		$level->{flags} = joinmulti (@$flags);
	} else {
		foreach my $f (@$unmatched) {
			if (($_) = commandflag ($dat, $f)) {
				$_->{levels} .= " $level->{level}";
			} else {
				warn ("level $level->{level}: unrecognised " .
					"flag \"$f\"\n");
			}
		}
		$level->{flags} = joinsingle (@$flags);
	}
}
foreach my $admin (@{$dat->{admin}}) {
	($flags, $unmatched) = convertflags ($stom, $admin->{flags});
	if ($stom) {
		warn ("admin $admin->{name}: unrecognised flag \"$_\"\n")
			foreach (@$unmatched);
		$admin->{flags} = joinmulti (@$flags);
	} else {
		$level = $admin->{level};
		foreach my $f (@$unmatched) {
			if (($_) = commandflag ($dat, $f)) {
				warn ("command !$_->{command}: won't apply " .
					"to admin $admin->{name}\n")
					unless ($_->{levels} =~ /\b$level\b/);
			} else {
				warn ("admin $admin->{name}: unrecognised " .
					"flag \"$f\"\n");
			}
		}
		$admin->{flags} = joinsingle (@$flags);
	}
}
delete ($_->{$stom ? 'levels' : 'flag'}) foreach (@{$dat->{command}});
# now fix up the command levels
unless ($stom) {
	my @levels;
	foreach my $c (@{$dat->{command}}) {
		foreach (split (' ', $c->{levels})) {
			push (@levels, $_) unless (find ($_, @levels));
		}
		@levels = sort { $a <=> $b } @levels;
		if (@levels > 32) {
			warn ("command !$c->{command}: this command applies " .
				'to more than 32 levels, which is too many. ' .
				"some will be skipped\n");
			@levels = @levels[$#levels - 32 .. $#levels];
		}
		$c->{levels} = join (' ', @levels);
	}
}
out ($dat);

__END__

=pod

=head1 NAME

B<conv-admindat> - update your Tremulous admin.dat file

=head1 SYNOPSIS

	# convert from old single to newer multi character flags
	conv-admindat single < admin.dat.old > admin.dat
	# and the opposite
	conv-admindat multi < admin.dat > admin.dat.old

=head1 DESCRIPTION

B<conv-admindat> updates Tremulous admin.dat file with single character admin
flags (old style) for newer games that use multiple character admin flags. The
opposite is also permitted, but you wouldn't want to do that.

You must specify how B<conv-admindat> will be run on the command line. To
convert your admin.dat file I<from> using multiple character flags I<to> using
single character flags, use C<multi> (but don't do that).
To convert your admin.dat file I<from> using single character flags I<to> using
multiple character flags, use C<single> (e.g., from 1.1 to 1.2).

B<conv-admindat> takes your admin.dat on C<stdin> and writes the converted
version on C<stdout>, so it is up to you to do what you want. The best way to
use B<conv-admindat> is as follows:

	mv admin.dat admin.dat.old
	conv-admindat single < admin.dat.old > admin.dat

A bunch of warnings like

	level 0: ignoring unrecognised flag "hiC"
	level 1: ignoring unrecognised flag "ahiC3"
	level 2: ignoring unrecognised flag "adhipPC13579"

means you used C<multi> when you should have used C<single>. Similarly, a bunch
of warnings like

	level 3: ignoring unrecognised flag F
	level 3: ignoring unrecognised flag U
	level 3: ignoring unrecognised flag I
	level 3: ignoring unrecognised flag S
	level 3: ignoring unrecognised flag T
	level 3: ignoring unrecognised flag A
	level 3: ignoring unrecognised flag Y
	level 3: ignoring unrecognised flag E
	level 3: ignoring unrecognised flag R
	level 3: ignoring unrecognised flag S

means you used C<single> when you should have used C<multi>.

=head1 CAVEATS

C<*> and C<ALLFLAGS> are not exactly identical.

B<conv-admindat> does not check total flags length, which can result in some
flags being ignored.

Do not do this as your admin.dat will be lost forever:

	conv-admindat single < admin.dat > admin.dat


B<conv-admindat> may do a bad job when updating custom commands. You may have to
manually fix those.

=head1 AUTHOR

Written by M. Kristall

=head1 COPYRIGHT

Copyright 2008-2011. This program is free software. You can redistribute it
and/or modify it under the same terms as perl itself.

=cut