File Coverage

blib/lib/Weewar.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

package Weewar;
use strict;
use warnings;

use Carp;
use LWP::UserAgent;
use XML::LibXML;

use Weewar::User;
use Weewar::Game;
use Weewar::HQ;

our $VERSION = '0.01';

use Readonly;
Readonly my $server => $ENV{WEEWAR_SERVER} || 'weewar.com';
Readonly my $base   => $ENV{WEEWAR_BASE} || 'api1';

=head1 NAME

Weewar - get data from the weewar.com XML API

=head1 SYNOPSIS

   use Weewar;

   # get all users
   my @users = Weewar->all_users;     # all active players on weewar

   # get a single user
   my $me = Weewar->user('jrockway'); # one user only (as a Weewar::User)
   my $me = Weewar::User->new({ name => 'jrockway }); # lazy-loaded

   # get a game
   my $game = Weewar->game('27056');  # get game (as a Weewar::Game)
   my $game = Weewar::Game->new({ id => '27056' });

   # access headquarters
   my $hq = Weewar->hq('jrockway' => $jrockways_api_key);
   my $hq = Weewar::HQ->new({ user => 'jrockway',
                              key  => $jrockways_api_key,
                            });

=head1 DESCRIPTION

This module lets you interact with the
(L) API.  See
L, L, and L for details about
what data you can get from the API.

=head1 METHODS

Right now, everything is a class method since the weewar API is public
for everything except the HQ (and no state needs to be kept between
requests).  If this changes, then this API will change a bit.

=cut

{ package Weewar::UA;
  use base 'LWP::UserAgent';
  sub new {
      my ($class, $args) = @_;
      $args ||= {};
      bless $args => $class;
  }
  sub get_basic_credentials {
      my $self = shift;
      return unless $self->{username};
      return (map {$self->{$_}} qw/username password/);
  }
}

# separate method so that WeewarTest can override the HTTP part
sub _get {
    my ($class, $path, $args) = @_;

    my $ua = Weewar::UA->new($args);
    my $res = $ua->get("http://$server/$base/$path");

    croak 'request error: '. $res->status_line if !$res->is_success;
    return $res->decoded_content;
}

sub _request {
    my ($class, $path, $args) = @_;
    my $content = $class->_get($path, $args);
    my $parser = XML::LibXML->new;
    return $parser->parse_string($content);
}

=head2 all_users

Return a list of all active Weewar users as L objects.
The objects are loaded lazily, so this method only causes one request
to be sent to the server.  When you start accessing the returned
children, they will be populated on-demand from the server.

An exception will be thrown if something goes wrong.

=cut

sub all_users {
    my $class = shift;
    my $doc = $class->_request('users/all');
    my @raw_users = $doc->getElementsByTagName('user');

    my @users;
    foreach my $user (@raw_users){
        my $def;
        $def->{$_} = $user->getAttributeNode($_)->value for qw/name id rating/;
        $def->{points} = $def->{rating}; # API uses 2 names for the same thing
        push @users, Weewar::User->new($def);
    }
    return @users;
}

=head2 user($username)

Returns a C object representing C<$username>.  If there is
no user by that name, and exception is thrown.

=cut

sub user {
    my $class     = shift;
    my $username  = shift;
    my $user = Weewar::User->new({ name => $username });
    $user->draws; # force the object to be populated
    return $user;
}

=head2 game($id)

Returns a C object representing the game with id C<$id>.  If
there is no game with that id, an exception is thrown.

=cut

sub game {
    my $class   = shift;
    my $gameid  = shift;
    my $game    = Weewar::Game->new({ id => $gameid });
    $game->name; # force the object to be populated
    return $game;
}

=head2 hq($username => $apikey)

Returns a C object representing C<$username>'s
"headquarters".  If there is an error getting the data (bad API key,
etc.), an exception is thrown.

=cut

sub hq {
    my $class = shift;
    my ($user, $key) = @_;
    my $hq = Weewar::HQ->new({ key => $key, user => $user });
    return $hq;
}

=head1 ENVIRONMENT

You can use different weewar servers by changing these environment
variables.  I doubt there are other weewar servers that speak this
API, though.

=over 4

=item WEEWAR_SERVER

The hostname of the Weewar server, defaulting to C

=item WEEWAR_BASE

The base URL of the API, defaulting to C.

=back

=head1 BUGS

If the Weewar API changes, this module will need an update.  Let me
know if something is broken so I can fix it.

The combination of Weewar's odd XML, C, and the fact that
I had very little sleep before writing this makes for some very ugly
code.  Feel free to clean it up and send me a patch.

Bugs should be reported through RT, but you can email me directly too.

=head1 AUTHOR

Jonathan Rockway C<<  >>

=head1 COPYRIGHT

This module is copyright (c) 2007 Jonathan Rockway.

You can distribute, modify, and use this module under the same terms
as Perl itself.

=cut

1;