File Coverage

blib/lib/WWW/Jawbone/Up.pm

Criterion	Covered	Total	%
statement	82	99	82.8
branch	8	20	40.0
condition	3	9	33.3
subroutine	21	25	84.0
pod	6	6	100.0
total	120	159	75.4

package WWW::Jawbone::Up;

use 5.010;
use strict;
use warnings;

our $VERSION = '1.32.4';

=encoding utf-8

=head1 NAME

WWW::Jawbone::Up - Unofficial Jawbone UP API

=head1 SYNOPSIS

  use WWW::Jawbone::Up;

  my $up = WWW::Jawbone::Up->connect('[e-mail]', 's3kr3t');

  my $user = $up->user;
  my $score = $up->score;

  say $user->name . ' walked ' . $score->move->distance . 'km today';

  my $hours = int($score->sleep->asleep / 3600);
  my $minutes = int($score->sleep->asleep / 60); % 60;

  say $user->name . " slept for ${hours}h${minutes}m last night";

=head1 DESCRIPTION

WWW::Jawbone::Up is a perl binding to the unofficial Jawbone UP API.  After
authenticating you can find interesting bits of data.  The version number of
this library should reflect the associated version of the Jawbone API but I
have no way of knowing if they will be sane with their version numbers so we'll
see how that pans out.

=head1 METHODS

=cut

use Carp;
use DateTime;
use JSON 2.0;
use LWP::UserAgent;
use URI::Escape;

use WWW::Jawbone::Up::Feed;
use WWW::Jawbone::Up::Score;
use WWW::Jawbone::Up::Tick;
use WWW::Jawbone::Up::User;
use WWW::Jawbone::Up::Workout;

use constant URI_BASE => 'https://jawbone.com';
use constant URI_API  => URI_BASE . '/nudge/api/v.1.32';

sub _request {
  my ($self, $method, $uri, $data) = @_;

  $self->{ua} ||= LWP::UserAgent->new();

  my $request = HTTP::Request->new($method, $uri);
  $request->header('x-nudge-token', $self->{token}) if $self->{token};
  $request->content($data);

  my $response = $self->{ua}->request($request);

  croak $response->status_line if $response->is_error;

  return decode_json($response->decoded_content);
}

sub __encode {
  my ($hash) = @_;

  return join '&',
    map sprintf('%s=%s', uri_escape($_), uri_escape($hash->{$_})),
    keys %$hash;
}

sub _get {
  my ($self, $uri, $data) = @_;

  my $query_string = __encode($data);
  $uri .= ($uri =~ /\?/ ? '&' : '?') . $query_string;

  return $self->_request(GET => $uri);
}

sub _post {
  my ($self, $uri, $data) = @_;

  my $body = __encode($data);

  return $self->_request(POST => $uri, $body);
}

=head2 connect($email, $password)

Authenticates with the API.  Will return undef if there are any errors,
possibly also dying or warning about them.

=cut

sub connect {
  my ($class, $email, $password) = @_;

  my $self = bless {}, $class;

  my $json = $self->_post(
    URI_BASE . '/user/signin/login', {
      service => 'nudge',
      email   => $email,
      pwd     => $password,
    });

  if ($json->{error}) {
    carp $json->{error}{msg};
    return undef;
  }

  $self->{token} = $json->{token};

  return $self;
}

=head2 user()

Returns a L object representing the currently
authenticated user.

=cut

sub user {
  my ($self) = @_;

  unless ($self->{user}) {
    my $json = $self->_get(URI_API . '/users/@me');
    $self->{user} = WWW::Jawbone::Up::User->new($json->{data});
  }

  return $self->{user};
}

=head2 feed($date)

Returns an array of L objects for the given C<$date>.
If no date is given, the current date is used.

=cut

sub feed {
  my ($self, $date, $options) = @_;

  $options ||= {};
  $options->{date} = $date if defined $date;

  my $json = $self->_get(URI_API . '/users/@me/social', $options);

  return map WWW::Jawbone::Up::Feed->new($_), @{ $json->{data}{feed} };
}

=head2 score($date)

Returns a L object for the given C<$date>.  If no date
is given, the current date is used.

=cut

sub score {
  my ($self, $date, $options) = @_;

  $options = {};
  $options->{date} = $date if defined $date;

  my $json = $self->_get(URI_API . '/users/@me/score', $options);

  return WWW::Jawbone::Up::Score->new($json->{data});
}

=head2 band($start, $end)

Returns an array of L objects for the given time range.
Both C<$start> and C<$end> should be epoch times (seconds since epoch).  If no
range is given, I think the current day is used, but I haven't really
researched that fact too much.

=cut

sub band {
  my ($self, $start, $end, $options) = @_;

  $options ||= {};
  $options->{start_time} = $start if defined $start;
  $options->{end_time}   = $end   if defined $end;

  my $json = $self->_get(URI_API . '/users/@me/band', $options);

  return map WWW::Jawbone::Up::Tick->new($_->{value}),
    @{ $json->{data}{ticks} };
}

=head2 workouts($date)

Returns an array of L objects for the give C<$date>.
If no $date is given, I think some number of recent workouts are given, but I
haven't really researched that fact too much.

=cut

sub workouts {
  my ($self, $date, $options) = @_;

  $options ||= {};
  $options->{date} = $date if defined $date;

  my $json = $self->_get(URI_API . '/users/@me/workouts', $options);

  return map WWW::Jawbone::Up::Workout->new($_), @{ $json->{data}{items} };
}

1;

=head1 TODO

The documentation for this distribution is utterly lacking.  I will fix that
sometime soon.

=head1 AUTHOR

Alan Berndt [e-mail]

=head1 COPYRIGHT

Copyright 2013 Alan Berndt

=head1 LICENSE

Permission is hereby granted, free of charge, to any person obtaining a copy of
this software and associated documentation files (the "Software"), to deal in
the Software without restriction, including without limitation the rights to
use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
of the Software, and to permit persons to whom the Software is furnished to do
so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.

=head1 SEE ALSO

L
L
L
L
L

=cut