#!/usr/bin/perl

#    Copyright Peter Oliver <et-teamspeak@mavit.org.uk>, 2005.
#
#    This program is free software; you can redistribute it and/or
#    modify it under the terms of the GNU General Public License,
#    version 2, as published by the Free Software Foundation.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#    http://www.opensource.org/licenses/gpl-license.html
#
#    History:
#    1.0.0, 2005-04-07: Initial release.
#    1.1.0, 2005-04-16: ETF support.
#                       Better support for nested channels.
#                       Better channel guessing.
#                       More documentation.
#    1.1.1, 2005-04-16: Removed spurious debug output.
#    1.1.2, 2005-04-17: Look for tsControl in the default places.
#    1.1.3, 2005-04-17: Added Green and Yellow teams in ETF.
#                       Better nick guessing.
#    1.2.0, 2005-05-23: Microsoft Windows support.
#    1.2.1, 2005-05-28: Allow the Allied channel to instead be called "Allies".
#    1.3.0, 2005-11-29: Limited support for Quake 3 Arena on Linux.
#    1.3.1, 2006-06-27: Tremulous support on Linux.
#                       Handle channel names on server ts.online-spielen.de.
#                       Better game identification.

use strict;
use warnings;
use Getopt::Long qw(:config posix_default);
use Pod::Usage;
use File::Spec;
use IPC::Open3;
use POSIX qw(:sys_wait_h);

my $Registry;
BEGIN {
    if ( $^O eq 'MSWin32' or $^O eq 'cygwin' ) {
	require Win32::TieRegistry;
	import Win32::TieRegistry ( TiedRef => \$Registry );
    }
}

my $password = ''; # Channel password
my ( $tscontrol, $nick, $hint, $parent_regexp, $help, $man, $game,
     $changed_team_regexp );
my %channel_name = ( '-1' => '' );

GetOptions(
	   'tscontrol=s' => \$tscontrol,
	   'nick=s' => \$nick,
	   'hint=s' => \$hint,
	   'password=s' => \$password,
	   'help|h' => \$help,
	   'man' => \$man,
	   ) or pod2usage(2);
pod2usage(1) if $help;
pod2usage(-verbose => 2) if $man;

if ( grep m/\bet-?f\b/, @ARGV ) {
    $game = 'etf';
}
elsif ( grep m/\bquake3\b/, @ARGV ) {
    $game = 'q3a';
}
elsif ( grep m/\btremulous\b/, @ARGV ) {
    $game = 'tremulous';
}
else {
    $game = 'et';
}

my $et_base_dir;
if ( $game =~ m/^et/ ) {
    if ( $^O eq 'MSWin32' or $^O eq 'cygwin' ) {
	$et_base_dir = $Registry->{'HKEY_LOCAL_MACHINE\\SOFTWARE\\Activision\\Wolfenstein - Enemy Territory\\\\InstallPath'} ||
	    'c:\Program Files\Wolfenstein - Enemy Territory';
    }
    else {
	$et_base_dir = ( $ENV{'HOME'} || (getpwuid $>)[7] ). '/.etwolf';
    }
}
elsif ( $game eq 'q3a' ) {
    $et_base_dir = ( $ENV{'HOME'} || (getpwuid $>)[7] ). '/.q3a';
}    
elsif ( $game eq 'tremulous' ) {
    if ( $^O eq 'MSWin32' or $^O eq 'cygwin' ) {
	$et_base_dir = $Registry->{'HKEY_LOCAL_MACHINE\\SOFTWARE\\Tremulous\\\\InstallDir'} ||
	    'c:\Program Files\Tremulous';
    }
    else {
	$et_base_dir = ( $ENV{'HOME'} || (getpwuid $>)[7] ). '/.tremulous';
    }
}

unless ( @ARGV ) {
    if ( $^O eq 'MSWin32' or $^O eq 'cygwin' ) {
	push @ARGV, File::Spec->catfile( $et_base_dir, 'ET.exe' );
    }
    else {
	push @ARGV, 'et';
    }
}

$tscontrol = guess_tscontrol() unless $tscontrol;
$nick = guess_nick() unless $nick;
($hint, $parent_regexp) = guess_hint() unless $hint;

my %changed_team_regexp = (
			   et => qr/^(?:\^\d)?$nick\^7 (?:has )?joined the (?:\^\d)?(Allied|Axis|Red|Blue|Green|Yellow) team\^7[!\.]$/i,
			   etf => qr/^(?:\^\d)?$nick\^7 (?:has )?joined the (?:\^\d)?(Allied|Axis|Red|Blue|Green|Yellow) team\^7[!\.]$/i,
			   tremulous => qr/^(?:\^\d)?$nick\^7 (?:re)?joined the (?:\^\d)?(alien|human)s\.?$/i,
			   q3a => qr/^(?:\^\d)?$nick\^7 entered the game \(\^\d(RED|BLUE|GREEN|YELLOW)\^7\)$/i,
			   );

my $fork;
if ( $^O eq 'MSWin32' or $^O eq 'cygwin' ) {
    $fork = fork;
    unless ( defined $fork ) {
	die "Cannot fork: $!";
    }
    elsif ( $fork == 0 ) {
	chdir $et_base_dir;
	my $cmd = shift @ARGV;
	exec "\"$cmd\" @ARGV +logfile 2";
    }
    sleep 5; # Make sure ET has time to open the log file before we do

    my $logfile;
    if ( $game eq 'et' ) {
	$logfile = File::Spec->catfile( $et_base_dir,
					'etmain', 'etconsole.log' );
    }
    elsif ( $game eq 'etf' ) {
	$logfile = File::Spec->catfile( $et_base_dir,
					'etf', 'etconsole.log' );
    }
    elsif ( $game eq 'tremulous' ) {
	$logfile = File::Spec->catfile( $et_base_dir,
					'base', 'qconsole.log' );
    }
    else {
	die "I don't know where to find the logfile for this game on Windows.  Please let me know.";
    }
    open LOG, $logfile or die "Couldn't open '$logfile': $!";
    seek LOG, -s LOG, 0 # Start from the end of the log file
}
else {
#     open LOG, '-|', @ARGV or die "Couldn't open '@ARGV': $!";
    open3( undef, \*LOG, \*LOG, @ARGV );
    my $error = <LOG>;
    die $error if $error =~ m/^open3/;
}

my $line;
while ( 1 ) {
    while ( defined( $line = <LOG> ) ) {
	print $line;
	if ( $line =~ m/$changed_team_regexp{$game}/ ) {
	    my $team = $1;
	    $team =~ s/Allied/Allie[ds]/;
	    my $channel_regexp = "$parent_regexp($hint.*$team|$team.*$hint)";
	    warn $channel_regexp;
	    my $id = find_channel( $channel_regexp );
	    if ( $id ) {
		print STDERR "Switching to channel $channel_name{$id} ($id):\n";
		system $tscontrol, 'SWITCH_CHANNEL', $id, $password;
	    }
	    else {
		print STDERR "Can't find channel matching /$channel_regexp/.  Staying put.\n";
	    }
	}
    }
    if ( $fork and waitpid $fork, WNOHANG ) {
	exit;
    }
    elsif ( -f LOG ) {
	seek(LOG, 0, 1); # Reset the end-of-file condition
	sleep 10;
    }
    else {
	exit;
    }
}

sub guess_tscontrol {
    unless ( $^O eq 'MSWin32' or $^O eq 'cygwin' ) {
	my $on_path;
	{
	    no warnings;
	    $on_path = open TSCONTROL, 'tsControl |';
	}
	close TSCONTROL;
	return 'tsControl' if $on_path;
    }
    
    my ( @locations, $ext );
    if ( $^O eq 'MSWin32' or $^O eq 'cygwin' ) {
	@locations = (
		      'c:\Program Files\teamspeak2_RC2',
		      );
	$ext = '.exe';
    }
    else {
	my $home = $ENV{'HOME'} || (getpwuid $>)[7];
	@locations = (
		      "$home/TeamSpeak2RC2",
		      '/opt/TeamSpeak2RC2',
		      );
	$ext = '';
    }
   
    foreach my $try ( @locations ) {
	my $file = File::Spec->catfile( $try, 'client_sdk', "tsControl$ext" );
	return $file if -x $file;
    }

    die "Can't find tsControl.  Specify its location with the --tscontrol option.\nIt should be in the client_sdk directory that comes with Teamspeak.\n"
}

sub guess_nick {
    my $config;

    if ( $game eq 'et' ) {
	my $profile_dir = File::Spec->catfile($et_base_dir, 'etmain',
					      'profiles');
	my $default_profile = File::Spec->catfile( $profile_dir, 
						   'defaultprofile.dat' );
	open DEFAULT, $default_profile
	    or die "Couldn't open $default_profile: $!";
	my $profile = <DEFAULT>;
	close DEFAULT;
	$profile =~ s/^\"//;
	$profile =~ s/\"$//;
	
	$config = File::Spec->catfile($profile_dir, $profile, 'etconfig.cfg');
    }
    elsif ( $game eq 'etf' ) {
	$config = File::Spec->catfile($et_base_dir, 'etf', 'etconfig.cfg');
    }
    elsif ( $game eq 'q3a' ) {
	$config = File::Spec->catfile($et_base_dir, 'baseq3', 'q3config.cfg');
    }
    elsif ( $game eq 'tremulous' ) {
	$config = File::Spec->catfile($et_base_dir, 'base', 'autogen.cfg');
    }
   
    return get_name( $config )
	or die "I couldn't figure out what name you play ET with.  Specify it with\nthe --nick option.\n"
}

sub get_name {
    my $file = shift;
    open CONFIG, $file or die "Couldn't open $file: $!";
    while ( defined( $line = <CONFIG> ) ) {
	if ( $line =~ m/^\s*seta\s+name\s+"(.+)"\s*$/ ) {
	    close CONFIG;
	    return $1;
	}
    }
    close CONFIG;
    return undef;
}

sub guess_hint {
    find_channel( '\$^' );
#     open INFO, '-|', $tscontrol, 'GET_USER_INFO'
# 	or die "Couldn't open $tscontrol: $!";
    open INFO, "\"$tscontrol\" GET_USER_INFO |"
	or die "Couldn't open $tscontrol: $!";
    while ( defined( $line = <INFO> ) ) {
	next unless $line =~ m/^ID: (\d+)  Parent: (-?\d+)  Name: (.+)  Playercount: \d+  Flags: 0x[[:xdigit:]]{2}  Codec: \d+\s*$/i;
	my $id = $1;
	my $parent = $2;
	my $name = $3;

	my $parent_regexp = '';
	if ( $parent != -1 ) {
	    $parent_regexp = $channel_name{$parent};
	    $parent_regexp =~ s|^.*/||;
	    $parent_regexp =~ s/[^\w ]/./g;
	    $parent_regexp .= '/';
	}

	if ( $name =~ m/\s*(.*?)\s*(?:Allie[ds]|Axis|Red|Blue|Green|Yellow|Humans?|Aliens?)\s*(.*?)\s*/i ) {
	    my $before = $1;
	    my $after = $2;
	    if ( length $before > length $after ) {
		$before =~ s/[^\w ]/./g;
		return $before, $parent_regexp;
	    }
	    else {
		$after =~ s/[^\w ]/./g;
		return $after, $parent_regexp;
		}
	}
	elsif ( $id == 1 ) {
	    return '', $parent_regexp;
	}
	else {
	    $name =~ s/[^\w ]/./g;
	    return $name, $parent_regexp;
	}
    }
    if ( not close INFO and $? != 11 ) {
	die "Error on closing $tscontrol: $! $?";
    }
    return undef;
}

sub find_channel {
    my $channel_regexp = shift;
#     open CHANNELS, '-|', $tscontrol, 'GET_CHANNELS'
# 	or die "Couldn't open $tscontrol: $!";
    open CHANNELS, "\"$tscontrol\" GET_CHANNELS |"
	or die "Couldn't open $tscontrol: $!";
     my $line;
    while ( defined( $line = <CHANNELS> ) ) {
#  	print STDERR $line;
# $line =~ m/^ID: (\d+)  Parent: -?\d+  Name: $name  Playercount: \d+  Flags: 0x[[:xdigit:]]{2}  Codec: \d+$/i;
	if ( $line =~ m/^ID: (\d+)  Parent: (-?\d+)  Name: (.+)  Playercount: \d+  Flags: 0x[[:xdigit:]]{2}  Codec: \d+\s*$/i ) {
	    my $id = $1;
	    my $parent = $2;
	    my $name = $3;
	    $channel_name{$id} = $channel_name{$parent}. '/'. $name;
	    return $id if $channel_name{$id} =~ m/$channel_regexp/i;
#  	    print STDERR $channel_name{$id}, "\n";
	}
    }
    if ( not close CHANNELS and $? != 11 ) {
	die "Error on closing $tscontrol: $! $?";
    }
    return undef;
}

__END__

=head1 NAME

et-teamspeak - Change Teamspeak channels when playing Enemy Territory

=head1 SYNOPSIS

B<et-teamspeak.pl> [ --tscontrol I</path/to/tsControl> ] [ --nick I<et-name> ] [ --hint I<partial-channel-name> ] [ --password I<channel-password> ] [ B<et> I<args> ... ]

B<et-teamspeak.pl> --help

=head1 OPTIONS

=over 8

=item B<--tscontrol> I</path/to/tsControl>

This is the full location of the tsControl program that is supplied with
Teamspeak.  You need to specify this if it isn't already on your path or
in one of the default locations.

=item B<--nick> I<et-name>

This is the name you use in-game.  You'll need use this if you play with
different names in ET and ETF.

=item B<--hint> I<partial-channel-name>

A phrase that will exactly match part of the channel names you wish to
switch between.

=item B<--password> I<channel-password>

If your Teamspeak channels require a password, you can specify it here.

=item B<--help>

Print a brief help message and exits.

=item B<--man>

Prints the manual page and exits.

=back

=head1 DESCRIPTION

FIXME: This needs filling in.

=head1 SEE ALSO

L<http://www.mavit.org.uk/et-teamspeak/>

=head1 VERSION

1.3.1

=head1 AUTHOR

Peter Oliver <et-teamspeak@mavit.org.uk>

=cut