WWW::GameMonitor - Fetch information about game servers from Game-Monitor.com

  # example 1
  use WWW::GameMonitor;
  my $gm1 = WWW::GameMonitor->new;
  my $serv1 = $gm1->getServerInfo( Host => '216.237.126.132', Port => '16567' ); # ACE Battlefield2 Server
  print qq(On $serv1->{name}, $serv1->{count}->{current} players ($serv1->{count}->{max} limit) are playing $serv1->{game}->{longname}, map $serv1->{map}.\n);

  # example 2
  use WWW::GameMonitor;
  my $gm2 = WWW::GameMonitor->new( Host => '216.237.126.132', Port => '16567' ); # default to a certain server
  my $serv2 = $gm2->getServerInfo; # uses the defaults specified in the constructor

  my $gm = WWW::GameMonitor->new; # no options or defaults specified

  my $gm = WWW::GameMonitor->new( Host => '216.237.126.132', Port => '16567' ); # default to a certain server

  my $gm = WWW::GameMonitor->new(
      Expires => 300,
      Host => '216.237.126.132',
      Port => '16567',
      CacheFile => 'my_gm_cache.xml',
      DebugLog => 'my_debug_log.txt',
      DebugLevel => 3,
      UID => 12345,
      List => 0,
  );

  my $serv = $gm->getServerInfo; # uses the defaults specified in the constructor
  print qq(On $serv1->{name}, $serv1->{count}->{current} players ($serv1->{count}->{max} limit) are playing $serv1->{game}->{longname}, map $serv1->{map}.\n);

  my $serv = $gm->getServerInfo( Host => '216.237.126.132', Port => '16567' ); # ask about a certain server
  print qq(On $serv1->{name}, $serv1->{count}->{current} players ($serv1->{count}->{max} limit) are playing $serv1->{game}->{longname}, map $serv1->{map}.\n);

  $list = $gm->getBuddyList; # uses defaults set in the constructor
  $list = $gm->getBuddyList( List => 1 ); # sets a different list than the default
  $list = $gm->getBuddyList( UID => 12345, List => 2 ); # also sets a different UID along with a different list

package WWW::GameMonitor;

our $VERSION = '0.03';

use XML::Simple;
use Data::Dumper;
use LWP::Simple;
use Hey::Common;
use Hey::Cache;

sub new {
  my $class = shift;
  my %options = @_;
  my $self = {};
  bless($self, $class); # class-ify it.

  $self->{fxn} = Hey::Common->new;

  $self->{debugLog} = $options{DebugLog} || 'gmDebug.log';
  $self->{debugLevel} = $options{DebugLevel} || 0;

  $self->{cache} = Hey::Cache->new(
				Namespace => $options{Namespace} || $options{NameSpace} || 'WWW::GameMonitor',
				CacheFile => $options{CacheFile} || $options{StoreFile} || 'gameServerInfoCache.xml',
				Expires => $options{Expires} || $options{Fresh} || 600,
			 );

  $self->{host} = $options{Host} || undef;
  $self->{port} = $options{Port} || undef;

  $self->{uid} = (defined($options{UID}) ? $options{UID} : 0);
  $self->{buddyList} = (defined($options{List}) ? $options{List} : 0);

  $self->__debug(7, 'Object Attributes:', Dumper($self));

  return $self;
}

sub __debug {
  my $self = shift || return undef;
  return undef unless $self->{debugLog}; # skip unless log file is defined
  my $level = int(shift);
  return undef unless $self->{debugLevel} >= $level; # skip unless log level is as high as this item
  if (open(GAMEMONDEBUG, ">>$self->{debugLog}")) {
    my $time = localtime();
    foreach my $group (@_) { # roll through many items if they are passed in as an array
      foreach my $line (split(/\r?\n/, $group)) { # roll through items that are multiline, converting to multiple separate lines
        print GAMEMONDEBUG "[$time] $line\n";
      }
    }
    close(GAMEMONDEBUG);
  }
  return undef;
}

sub __fetchServerInfo {
  my $self = shift || return undef;
  my %options = @_;
  my $host = $options{Host} || return undef; # if the host isn't defined, fail
  my $port = $options{Port} || return undef; # if the port isn't defined, fail

  my $name = $host.':'.$port;

  my $cache = $self->{cache}->get( Name => $name ); # get data from cache
  if ($cache) { # cache data exists for this host/port
    $self->__debug(3, 'Cache data is fresh.');
    return $cache if ($VERSION eq $cache->{client_version}); ## check the client version against the cache, in case the client (this code) has been upgraded, which might break the cache
  }
  else {
    $self->__debug(2, 'Cache is not fresh or no data.  Fetching from source.');
  }

  my $url = qq(http://www.game-monitor.com/client/server-xml.php?rules=1&ip=$host:$port); # format the url for the source
  my $response = get($url); # fetch the info from the source
  unless ($response) { # it failed (rejected, bad connection, etc)
    $self->__debug(2, 'Could not fetch data from source.');
    if ($store) {
      $self->__debug(2, 'Going to provide stale store data instead of failing.');
      return $self->{cache}->get( Name => $name, Expires => 99999999 ); # get data from cache with no expiration
    }
    else { # there is nothing to send back, fail
      $self->__debug(3, 'There is no store data to return.');
      return undef;
    }
  }
  my $data = XMLin($response, KeyAttr => undef); # parse the xml into hashref
  $data->{count} = $data->{players}; # move the player counts
  $data->{players} = $self->{fxn}->forceArray($data->{players}->{player}); # make sure players is an arrayref
  delete($data->{count}->{player}); # cleanup unnecessary stuff
  my $variables = $self->{fxn}->forceArray($data->{variables}->{variable}); # make sure variables is an arrayref
  delete($data->{variables}); # remove the messy looking and difficult to use variables structure

  foreach my $variable (@{$variables}) { # loop through the messy variables
    $data->{variables}->{$variable->{name}} = $variable->{value}; # make them pretty and easy to use
  }

  $data->{client_version} = $VERSION;

  $self->{cache}->set( Name => $name, Value => $data ); # store it, baby!

  return $data;
}

sub getServerInfo {
  my $self = shift || return undef;
  my %options = @_;
  my $host = $options{Host} || $self->{host} || return undef; # if the host isn't defined, get the default or fail
  my $port = $options{Port} || $self->{port} || return undef; # if the port isn't defined, get the default or fail
  my $data = $self->__fetchServerInfo( Host => $host, Port => $port ); # fetch it!
  return $data; # return the post-processed server info
}

sub getBuddyList {
  my $self = shift || return undef;
  my %options = @_;

  $self->__debug(4, 'getBuddyList');

  my $uid = (defined($options{UID}) ? $options{UID} : (defined($self->{uid}) ? $self->{uid} : return undef));
  my $list = (defined($options{List}) ? $options{List} : (defined($self->{buddyList}) ? $self->{buddyList} : return undef));

  my $name = "BuddyList:${uid}:${list}"; # make a pretty name

  $self->__debug(4, 'getBuddyList('.$name.')');

  my $cache = $self->{cache}->get( Name => $name ); # get data from cache
  if ($cache) { # cache is still fresh
    $self->__debug(3, 'Cache data is fresh.');
    return $cache; # return the still fresh cache
  }
  else { # cache is stale
    $self->__debug(2, 'Cache is not fresh or no data.  Fetching from source.');
    my $url = qq(http://www.game-monitor.com/client/buddyList.php?uid=$uid&listid=$list&xml=1); # format the url for the source
    my $response = get($url); # fetch the info from the source
    if ($response) { # fetching from source succeeded
      my $data = XMLin($response, KeyAttr => undef); # parse the xml into hashref

      my $buddies = $self->{fxn}->forceArray($data->{buddy}); # make sure buddies is an arrayref
      delete($data->{buddy});
      foreach my $buddy (@{$buddies}) { # loop through the returned players
        if ($buddy->{server}->{fullip} eq '0.0.0.0:') { # no valid server, remove it
          $buddy->{server} = {}; # wipe it out
        }
        $data->{player}->{$buddy->{name}} = $buddy; # add this player to the list of players
      }

      $self->{cache}->set( Name => $name, Value => $data ); # store it away into the cache
      return $data; # return the new, fresh data
    }
    else { # fetching from source failed (rejected, bad connection, etc)
      $self->__debug(2, 'Could not fetch data from source.');
      $cache = $self->{cache}->get( Name => $name, Expires => 99999999 ); # get data from cache, ignoring expiration
      if ($cache) {
        $self->__debug(2, 'Going to provide stale cache data instead of failing.');
        return $cache; # return the old, stale cache
      }
      else {
        $self->__debug(3, 'There is no cache data to return.');
        return undef; # nothing to return
      }
    }
  }
  
}

1;