File Coverage

blib/lib/WWW/BF2S.pm

Criterion	Covered	Total	%
statement	1	3	33.3
branch			n/a
condition			n/a
subroutine	1	1	100.0
pod			n/a
total	2	4	50.0

package WWW::BF2S;

our $VERSION = '0.03';

use XML::Simple;
use Data::Dumper;
use LWP::Simple;

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

  $self->{debugLog} = $options{DebugLog} || 'debug.log';
  $self->{debugLevel} = $options{DebugLevel} || 0;
  $self->{storeFile} = $options{StoreFile} || 'stats.xml';

  eval { $self->{store} = XMLin($self->{storeFile}); }; # read in store XML data (it's okay if it fails/doesn't exist, I think)

  $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(BF2SDEBUG, ">>$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 BF2SDEBUG "[$time] $line\n";
      }
    }
    close(BF2SDEBUG);
  }
  return undef;
}

sub __fetchData {
  my $self = shift || return undef;

  my $urlBase = 'http://bf2s.com/xml.php?pids=';
  my $pidList = {};
  foreach my $pid (@_) {
    next if ($pid =~ m|[^0-9]|); # check for validity
    next if ($self->{store}->{'pid'.$pid}->{updated} + 7200 > time()); # make sure the cached copy is old enough (2 hours)
    $pidList->{$pid}++; # add it to the queue
  }
  $self->__debug(6, 'PIDS REQUESTED:', keys(%{$pidList}));

  my @candidates;
  # TODO: make a list of candidates from the data store (even ones we're not asking for) in order of best to worst

  while (scalar(keys(%{$pidList})) < 64) { # if the request list is shorter than 64 pids (the max per request), we should add more from the cache that need refreshed instead of wasting the opportunity
    my $candidate = shift(@candidates) || last; # get the next candidate from the list (or exit the loop because we've run out of candidates)
    next if ($pidList->{$candidate}); # if it's already in the list, skip it
    $pidList->{$candidate}++; # seems okay, add it to the pidList
  }
  $self->__debug(6, 'PIDS WITH AUTO:', keys(%{$pidList}));
  my $pids = join(',', sort(keys(%{$pidList}))); # join the queue in a proper format

  return $response unless $pids; # only proceed if there is something to fetch

  my $response = get($urlBase.$pids); # fetch the data from the source (bf2s feed)
  #use IO::All; my $response; $response < io('test.xml'); # for testing only (an XML file that has a sample of raw returned data from the feed source)
  return undef unless $response; # if it failed, don't continue

  my $parsedResponse = XMLin($response); # parse the XML into a hashref
  $self->__debug(7, 'PARSEDRESPONSE:', Dumper($parsedResponse));

  $parsedResponse->{player} = $self->__forceArray($parsedResponse->{player});

  my $stats = {};
  foreach my $player (@{$parsedResponse->{player}}) { # store in a normalized structure
    next unless ($pidList->{$player->{pid}}); # probably not necessary, but don't parse things we didn't ask for
    $player->{updated} = time();
    $stats->{$player->{pid}} = $player;
  }
  $self->__debug(7, 'NORMALIZEDRESPONSE:', Dumper($stats));
  $self->__injectIntoDataStore($stats);

  return $stats; # return the response content
}

sub __forceArray {
  my $self = shift;
  my $input = shift;
  return $input if (ref($input) eq 'ARRAY'); # return if already an arrayref
  my $output;
  $output->[0] = $input; # force it to be an item in an arrayref
  return $output; # return the arrayref
}

sub __injectIntoDataStore {
  my $self = shift;
  my $stats = shift;

  foreach my $pid (keys(%{$stats})) {
    next if ($pid =~ m|[^0-9]|); # ensure only numerical pids (is this necessary?)
    $self->{store}->{'pid'.$pid} = $stats->{$pid}; # insert/replace into data store
  }

  my $storeOut = XMLout($self->{store}); # convert hashref data into XML structure
  if ($storeOut) { # only if storeOut is valid/existing (wouldn't want to wipe out our only cache/store with null)
    if (open(STOREFH, '>'.$self->{storeFile})) { # overwrite old store file with new store file
      print STOREFH $storeOut;
      close(STOREFH);
    }
  }

  return undef;
}

sub getStats {
  my $self = shift;
  my @pids = @_;
  my $stats = {};

  $self->__fetchData(@pids); # get fresh data when if necessary

  foreach my $pid (@pids) { # prep the requested data for return
    $stats->{$pid} = $self->{store}->{'pid'.$pid};
  }

  return $stats; # return the requested data
}

1;

__END__