#!/usr/bin/perl
# OpenArena Friends Finder
# Author Simone Sclavi 'Ito' <darkhado@gmail.com>
use strict;
use warnings;
use feature qw(say switch);
use autodie;
use URI;
use LWP;
use HTML::TokeParser::Simple;
use Getopt::Std;

my $COPYLEFT = q{Copyright 2010 Simone Sclavi 'Ito'};
my $GPL3 = << 'LICENSE';
    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    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.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.
LICENSE
my $dpm_browser;
sub get_url {
    my $url = shift;
    $dpm_browser = LWP::UserAgent->new unless $dpm_browser;
    $dpm_browser->timeout(30);
    $dpm_browser->env_proxy();
    my $resp = $dpm_browser->get($url);
    return ($resp->content, $resp->status_line, $resp->is_success);
}
sub print_stats {
    my ($c) = @_;
    my $parser = HTML::TokeParser::Simple->new($c) or die (":: Oh, no! $!\n");
    my $token;
    say  "\t# SERVER STATS #";
    while ( $token = $parser->get_token)
    {
    	next unless $token->is_start_tag;
    	my $attr = $token->get_attr('id');
    	next unless $attr;
    	my $text;
    	given ($attr)
    	{
        	when ('address'){$text = $parser->get_text; say "\taddress: $text" if $text}
        	when ('players'){$text = $parser->get_text; say "\tplayers: $text" if  $text}
        	when ('map'){$text = $parser->get_text; say "\tmap: $text" if $text}
        	when ('gametype'){$text = $parser->get_text; say "\tgametype: $text" if $text}
        	when ('name'){$text = $parser->get_text; say "\tname: $text\n" if $text}
        	when ('ping'){$text = $parser->get_text; print "\t$text\t"}
        	when ('frags'){$text = $parser->get_text; print "$text\t" if defined($text)}
        	when ('handle'){$text = $parser->get_text; say  $text}
    	}
    
	}

}
sub get_players{
    my ($c,@list) = @_;
    my $parser = HTML::TokeParser::Simple->new($c) or die (":: Oh, no! $!\n");
    my ($token, $player, $server, $slots, $map, $gametype, $servername);
    my @ff = ();
    while ($token = $parser->get_token)
    {
        next unless $token->is_start_tag('div');
        my $attr = $token->get_attr('id');
        next unless $attr;
        given($attr)
        {
            when('handle')
            {
                $player = $parser->get_text;
                if ($player ne 'NAME')
                {
                    for (@list)
                    {
                        my $qmlist = quotemeta;
                        do{push @ff, {name => $player, server => $server, 
                            slots => $slots, map => $map, gametype => $gametype,
                            servername => $servername };last} if $player =~ /^$qmlist/i;
                    }
                }
            }
        when ('address'){$server = $parser->get_text}
        when ('players'){$slots = $parser->get_text}
        when ('map'){$map = $parser->get_text}
        when ('gametype'){$gametype = $parser->get_text}
        when ('name'){$servername = $parser->get_text}
            }
        }
    return @ff;
        
}
sub is_running{
    my $bin = shift;
    given (lc $^O)
    {
        when('linux')
        {
            #Needed when oa is launched via ./openarena{i386,x86_64} to find
            #right pid
            $bin =~ /\.\/(?<oabin>.+)/;
            $bin = $+{oabin} if $+{oabin};
            my $pid = `pidof -x $bin`;
            ($pid)? return 1 : return 0;
        }
        when(/^mswin/)
        {
            eval 'use Win32::Process::Info';
            die ":: $@\n" if ($@);
            my $pi = Win32::Process::Info->new ();
            foreach my $proc ($pi->GetProcInfo)
                {
                    return 1 if ($proc->{Name} eq $bin )
                }
                return 0;
            }
        }

}
sub clear_screen{
    (lc $^O eq 'linux')? system 'clear' : system 'cls';
}
sub print_players{
    my ($pl) = @_;
    my $n = scalar @$pl;
    say ":: found $n player/s\n::";
    foreach my $i ( 0 .. $#{$pl} ) 
    {
        say "\t\[" . ($i + 1) . "\] $pl->[$i]{name} $pl->[$i]{servername}
        \t\t$pl->[$i]{slots} \t$pl->[$i]{gametype} \t$pl->[$i]{map}";
    }
    return $n;
    }


#<---START HERE--->
my $VERSION = 'OPENARENA FRIENDS FINDER v0.4';
my $OPENARENA_BIN;
my $OPENARENA_PATH;
my %opt;
getopts('ht',\%opt);
do{say qq{:: usage: $0 [options]
::   -h\t show this usage and exit
::   -t\t terminate program when OA is launched}; exit 0} if $opt{h}; 


given(lc $^O)
{
    when ('linux')
    {
        $OPENARENA_BIN =  q{openarena};
        #uncomment the following lines if you didn't install oa from repository
        #and change q{openarena} with q{./openarena.i386} or
        #q{./openarena.x86_64} according to your system
        #
        #$OPENARENA_PATH = q{/home/simone/Desktop/openarena-0.8.5};
        #chdir $OPENARENA_PATH;

    }
    when (/^mswin/)
    {
        $OPENARENA_BIN = q{openarena.exe};
        #IMPORTANT! change with full path of your oa installation! 
        $OPENARENA_PATH = q{C:\Documents and Settings\Simone\Desktop\openarena-0.8.1};
        chdir $OPENARENA_PATH;
    }
    default {die "wrong operating system!\n"}
}


# @friends is the array where you can put clan tags and players to look for.
# you can edit it freely, but remember to obey perl syntax!!
my @friends = ( 
                'Evil|',
                'supeR,', 
                '*SoS*', 
                '=SC=', 
                '[CZ]', 
                'GoD', 
                'betA,',
                'Fu$!oN', 
                'LoL',
                '/GaNja/',
                '(sos)',
                'RN|',
                '(alPha)',
                '/NIN/',
                'Fu$!0n',
                'CreW/',
                'Var',
             );
my $dpm_url = URI->new('http://dpmaster.deathmask.net/');
$dpm_url->query_form(
    game => 'openarena' ,
    showplayers => '1',
    nocolors => '1'
);
#say $dpm_url;
say qq{:: Starting $VERSION
:: $COPYLEFT
:: This is free software with ABSOLUTELY NO WARRANTY
:: For details type 'v' in the menu below
::};
say q{:: option 'terminate' ON} if $opt{t};
say ':: getting players...';
my ($content, $status, $success) = get_url($dpm_url);
my @players = ();
my $n_pl;
if (!$success)
{
     say ":: ehm...got error ${status}!";
}
else{
    @players = get_players(\$content,@friends);
    if(!@players)
    {
        say ':: sorry, none of your friends is playing';
    }else{
    $n_pl = print_players(\@players);}
}

my $j = 0;

while ($j < 1)
{
    say q{::
:: # AVAILABLE COMMANDS #
:: [number] choose friend from 'friends list'(if present) 
:: [s:number] show stats of the server your friend is playing in
:: [r] refresh friends list
:: [l] launch OA without connecting to any server
:: [v] print version and license information
:: [q] quit program
::};
    print " >";
    my $choice = <STDIN>;
    chomp $choice; $choice =~ s/^\s+//; $choice =~ s/\s+$//;
    given ($choice)
            {
            	when (/^\d+$/)
            	{
            		if (@players)
            		{
            			if ($choice ~~ [ 1 .. $n_pl ])
            			{
            				if (is_running($OPENARENA_BIN))
                    			{
                        			say ':: hey, openarena already running!';
                    			}else
                    			{
                        			say ":: preparing to reach $players[$choice -1]{name}";
                        			$players[$choice -1]{slots} =~/^(?<players>\d+)\/(?<slots>\d+)/;
                        			if ($+{players} eq $+{slots})
                        			{
                            				say ":: WARNING! server $players[$choice-1]{servername} seems to be FULL!";
                            				sleep 2;
                        			}
						            my $launcher = $OPENARENA_BIN . " +connect $players[$choice -1]{server}";
                                    if ($opt{t}){ exec $launcher}
                                    else{clear_screen unless system $launcher}
                        		}
                        	} else { say ':: your choice is out of range!'}
                        } else { say ':: nonsensical input, retry!'}
		        }
                when (/^s:(?<ch>\d+)$/){
                    if(@players)
                    {
                        if ($+{ch} ~~ [1 .. $n_pl ])
                        {
                            my $server_url = $dpm_url->clone();
                	        my @qparms = $server_url->query_form();
                	        push @qparms,( hideheader => '1', server => $players[$+{ch}-1]{server});  
                	        $server_url->query_form(@qparms);
                	        $server_url->canonical();
                            #say $server_url;
                            ($content, $status, $success) = get_url($server_url);
                            if (!$success)
                	        {
                    	        say ":: ehm...got error ${status}!";
                	        }
                            else {print_stats(\$content)};
                        }
                        else { say ':: your choice is out of range!'}
                    } else { say ':: nonsensical input, retry!'}

            	}
            	when ('v'){print ":: $VERSION\n:: $COPYLEFT\n$GPL3"}
            	when ('r'){
                	say ':: getting players...';
                	($content, $status, $success) = get_url($dpm_url);
                	if (!$success)
                	{
                    	say ":: ehm...got error ${status}!";
                	}
                	else {
                    	@players = get_players(\$content,@friends);
                    	if(!@players)
                    	{
                        	say ':: sorry, none of your friends is playing';
                    	}else
                    	{
                        	$n_pl = print_players(\@players);
                    	}
                	}


            	}
            	when ('q'){$j++}
            	when ('l'){
                	if (is_running($OPENARENA_BIN))
                	{
                    	say ':: hey, openarena already running!';
                	}else
                	{ 
                    	say ':: Ok, happy fragging!';
                       if ($opt{t}){ exec $OPENARENA_BIN}
                       else{clear_screen unless system $OPENARENA_BIN}
                	}
            	}
            	default { say ':: nonsensical input, retry!'}
        }
    }

say  ':: Bye!';