File Coverage

blib/lib/WWW/TBA/API.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package WWW::TBA::API;

use Carp;

use Exporter;

use LWP::UserAgent;

use XML::Simple;

=head1 NAME

WWW::TBA::API - Perl module for handling thebluealliance.net's API

=head1 VERSION

Version 1.00

=cut

our $VERSION='1.00';
@ISA=qw/Exporter/;
@EXPORT=qw/VERSION/;

=head1 SYNOPSIS

$tba=new WWW::TBA::API($apikey);

=head1 DESCRIPTION

WWW::TBA::API implements version 1 of thebluealliance.net's API.  More
information is available here:
http://thebluealliance.net/tbatv/api/readme.php.

This implementation is deliberately similar to the other
implementations (esecially the one written in php), so that people
switching will not have trouble learning the new one.

=head1 FUNCTIONS

=over

=item new API_KEY [API_URL]

Creates an interface to the API.  If API_URL is specified, queries are
made to that URL.  With ordinary usage, it should never be specified
(the default, http://thebluealliance.net/tbatv/api.php, should not
change).

=cut

sub new {
    my $class=shift;
    my $self={};
    $self->{API_KEY}=shift;
    $self->{API_URL}=shift || "http://thebluealliance.net/tbatv/api.php";
    $self->{API_VERSION}=1;
    my $ua=new LWP::UserAgent;
    $ua->agent("TBA API Client");
    $self->{USER_AGENT}=$ua;
    bless $self,$class;
    return $self;
}

=item makearray

Not implemented.  In other implementations, makes an array out of an
XML::Simple object.  This should not be necessary, or even remotely
desirable, in Perl.

=item ->user_agent [LWP::UserAgent]

Returns the old user agent, and changes if necessary.

=cut

sub user_agent {
    my $self=shift;
    my $old=$self->{USER_AGENT};
    $self->{USER_AGENT}=shift || $self->{USER_AGENT};
    return $old;
}

=item ->api_key [API_KEY]

Returns the old api key, and changes if necessary.

=cut

sub api_key {
    my $self=shift;
    my $old=$self->{API_KEY};
    $self->{API_KEY}=shift || $self->{API_KEY};
    return $old;
}

=item ->api_url [API_URL]

Returns the old api url, and changes if necessary.

=cut

sub api_url {
    my $self=shift;
    my $old=$self->{API_URL};
    $self->{API_URL}=shift || $self->{API_URL};
    return $old;
}

=item ->api_version

Returns the version of the API being used.  This value cannot be
changed, for obvious reasons.

=cut

sub api_version {
    my $self=shift;
    return $self->{API_VERSION};
}

#a secret, undocumented method. mwahahaha
sub urlencode {
    my $str=shift;
    $str=~s/([^A-Za-z0-9])/sprintf("%%%02X", ord($1))/seg;
    return $str;
}

=item ->query METHOD ARGUMENTS

The low-level API call.  Makes a query to TBA of METHOD with
ARGUMENTS.  ARGUMENTS must be a reference to a hash.

=cut

sub query {
    my ($self,$method,$arguments)=@_;
    my $api_key=$self->{API_KEY};
    my $api_url=$self->{API_URL};
    my $api_version=$self->{API_VERSION};
    my $ua=$self->user_agent;

    my $argument_string = "version=$version&api_key=$api_key&method=$method";
    foreach my $key (keys %$arguments) {
	my $value=$arguments->{$key};
	$argument_string.="&$key=".urlencode($value);
    }
    my $url=$api_url."?".$argument_string;
    my $xmlstr=$ua->get($url)->content;

    my $xml=XMLin($xmlstr);
    return $xml;
}

=item ->raw_query METHOD ARGUMENTS

Same as query, but returns a string instead of an XML::Simple object.
Generally for debugging purposes only.

=cut

sub raw_query {
    my ($self,$method,$arguments)=@_;
    my $api_key=$self->{API_KEY};
    my $api_url=$self->{API_URL};
    my $api_version=$self->{API_VERSION};
    my $ua=$self->user_agent;

    my $argument_string = "version=$version&api_key=$api_key&method=$method";
    foreach my $key (keys %$arguments) {
	my $value=$arguments->{$key};
	$argument_string.="&$key=".urlencode($value);
    }
    my $url=$api_url."?".$argument_string;
    return $ua->get($url)->content;
}

=item ->get_teams [STATE [TEAMNUMBER]]

Gets inormation on the specified teams.

=cut

sub get_teams {
    my $self=shift;
    my $state=shift || '';
    my $teamnumber=shift || '';
    return $self->query("get_teams",{
	"teamnumber"=>$teamnumber,
	"state"=>$state
		 });
}

=item ->get_events [YEAR [WEEK [EVENTID]]]

Gets information on the specified events.

=cut

sub get_events {
    my $self=shift;
    my $year=shift || '';
    my $week=shift || '';
    my $eventid=shift || '';
    return $self->query("get_events",{
	year=>$year,week=>$week,eventid=>$eventid
			});
}

=item ->get_matches [COMPLEVEL [EVENTID [TEAMNUMBER [MATCHID]]]]

Returns information on the specified matches.

=cut

sub get_matches {
    my $self=shift;
    my $complevel=shift || '';
    my $eventid=shift || '';
    my $teamnumber=shift || '';
    my $matchid=shift || '';
    return $self->query("get_matches",{
	complevel=>$complevel,
	eventid=>$eventid,
	teamnumber=>$teamnumber,
	matchid=>$matchid
			});
}

=item ->get_attendance [EVENTID [TEAMNUMBER]]

Returns the attendance list for the specified event.

=cut

sub get_attendance {
    my $self=shift;
    my $eventid=shift || '';
    my $teamnumber=shift || '';
    return $self->query("get_attendance",{
	eventid=>$eventid,
	teamnumber=>$teamnumber
			});
}

=item ->get_official_record [TEAMNUMBER [YEAR [EVENTID]]]

Returns the official record of the team.

=cut

sub get_official_record {
    my $self=shift;
    my $eventid=shift || '';
    my $teamnumber=shift || '';
    return $self->query("get_official_record",{
	eventid=>$eventid,teamnumber=>$teamnumber
			});
}

=item ->get_elim_sets EVENTID NOUN

Undocumented.

=cut

sub get_elim_sets {
    my $self=shift;
    my $eventid=shift;
    my $noun=shift;
    return $self->query("get_elim_sets",{
	eventid=>$eventid,noun=>$noun
			});

}

sub throw_error {
    carp 'error thrown';
}

1;

__END__