File Coverage

blib/lib/WWW/Lovefilm/API.pm

Criterion	Covered	Total	%
statement	95	165	57.5
branch	21	52	40.3
condition	6	15	40.0
subroutine	19	26	73.0
pod	11	11	100.0
total	152	269	56.5

package WWW::Lovefilm::API;

use warnings;
use strict;

our $VERSION = '0.13';

use base qw(Class::Accessor);

use Net::OAuth;
use HTTP::Request::Common;
use LWP::UserAgent;
use URI::Escape;

__PACKAGE__->mk_accessors(qw/
	consumer_key
	consumer_secret
	content_filter
	ua
	access_token
	access_secret
	user_id
	_levels
	rest_url
	_url
	_params
	privateapi

	content_ref
	_filtered_content
	content_error
/);

sub new {
  my $self = shift;
  my $fields = shift || {};
  $fields->{ua} ||= LWP::UserAgent->new();
  return $self->SUPER::new( $fields, @_ );
}

sub content {
  my $self = shift;
  return $self->_filtered_content if $self->_filtered_content;
  return unless $self->content_ref;
  return ${$self->content_ref} unless $self->content_filter && ref($self->content_filter);
  return $self->_filtered_content(
	&{$self->content_filter}( ${$self->content_ref}, @_ )
  );
}

sub original_content {
  my $self = shift;
  return $self->content_ref ? ${$self->content_ref} : undef;
}

sub _set_content {
  my $self = shift;
  my $content_ref = shift;
  $self->content_error( undef );
  $self->_filtered_content( undef );
  return $self->content_ref( $content_ref );
}

sub REST {
  my $self = shift;
  my $url = shift;
  $self->_levels([]);
  $self->_set_content(undef);
  if( $url ){
    my ($url, $querystring) = split '\?', $url, 2;
    $self->_url($url);
    $self->_params({
	map {
	  my ($k,$v) = split /=/, $_, 2;
	  $k !~ /^oauth_/
	    ? ( $k => uri_unescape($v) )
	    : ()
	}
	split /&/, $querystring||''
    });
    return $self->url;
  }
  $self->_url(undef);
  $self->_params({});
  return WWW::Lovefilm::API::_UrlAppender->new( stack => $self->_levels, append => {users=>$self->user_id} );
}

sub _base_url {
    my $self = shift;
    return $self->privateapi ? 'http://api.lovefilm.com' : 'http://openapi.lovefilm.com';
}

sub url {
  my $self = shift;
  return $self->_url if $self->_url;
  my $api_url = $self->_base_url;

  return join '/', $api_url, @{ $self->_levels || [] };
}

sub _submit {
  my $self = shift;
  my $method = shift;
  my %options = ( %{$self->_params || {}}, @_ );
  my $which = $self->access_token ? 'protected resource' : 'consumer';
  my $res = $self->__OAuth_Request(
	$which,
	request_url    => $self->url,
	request_method => $method,
	token => $self->access_token,
	token_secret => $self->access_secret,
	extra_params => \%options,
  ) or do {
	warn $self->content_error;
	return;
  };

  return 1;
}
sub Get {
  my $self = shift;
  return $self->_submit('GET', @_);
}
sub Post {
  my $self = shift;
  return $self->_submit('POST', @_);
}
sub Delete {
  my $self = shift;
  return $self->_submit('DELETE', @_);
}

sub rest2sugar {
  my $self = shift;
  my $url = shift;
  my @stack = ( '$lovefilm', 'REST' );
  my @params;

  $url =~ s#^http://openapi.lovefilm.com##;
  $url =~ s#^http://api.lovefilm.com##;
  $url =~ s#(/users/)(\w|-){30,}/#$1#i;
  $url =~ s#/(\d+)(?=/|$)#('$1')#;

  if( $url =~ s#\?(.+)## ){
    my $querystring = $1;
    @params = map {
	  my ($k,$v) = split /=/, $_, 2;
	  [ $k, uri_unescape($v) ]
	}
	split /&/, $querystring;
  }
  push @stack, map {
		join '_', map { ucfirst } split '_', lc $_
	}
	grep { length($_) }
	split '/', $url
  ;
  return (
	join('->', @stack),
	sprintf('$lovefilm->Get(%s)',
		join( ', ', map { sprintf "'%s' => '%s'", @$_ } @params ),
	),
  );

}

sub RequestToken {
    my $self = shift;
    my ($request, $response);

    $request = $self->__OAuth_Request(
	'request token',
	request_url  => $self->_base_url . '/oauth/request_token',
	request_method => 'POST',
    ) or do {
	warn $self->content_error;
	return;
    };
    $response = Net::OAuth->response('request token')->from_post_body( $self->original_content );
    my $request_token    = $response->token
        or return;

    return (
        token        => $request_token,
        login_url    => $response->extra_params->{login_url},
        token_secret => $response->token_secret
    );
}

sub RequestAccessToken {
    my $self   = shift;
    my (%args) = @_;
    my ($request_token, $request_secret) = @_;

    my $request = $self->__OAuth_Request(
	'access token',
	request_url    => $self->_base_url . '/oauth/access_token',
	request_method => 'POST',
	token          => $args{oauth_token},
	token_secret   => $args{token_secret},
    ) or do {
	warn $self->content_error;
	return;
    };

    my $response = Net::OAuth->response('access token')->from_post_body( $self->original_content );

    $self->access_token(  $response->token );
    $self->access_secret( $response->token_secret );

    # Get the uses ID. See POD for this routine as to why
    #
    $self->REST->Users();
    $self->Get();

    if ($self->content) {
        my $href      = $self->content->{link}->{href};
        my ($user_id) = ($href =~ m!([^/]+)$!);
        $self->user_id($user_id);
    }

    return (access_token => $self->access_token, access_secret => $self->access_secret, user_id => $self->user_id);
}


sub __OAuth_Request {
  my $self = shift;
  my $request_type = shift;
  my $params = {   # Options to pass-through to Net::OAuth::*Request constructor
	# Static:
        consumer_key      => $self->consumer_key,
        consumer_secret   => $self->consumer_secret,
        signature_method  => 'HMAC-SHA1',
        timestamp         => time,
        nonce             => join('::', $0, $$),
        version           => '1.0',

	# Defaults:
	request_url       => $self->url,
	request_method    => 'POST',

	# User overrides/additions:
	@_

	# Most common user-provided params will be:
	#   request_url
	#   request_method
	#   token
	#   token_secret
	#   extra_params
  };
  $self->_set_content(undef);

  my $request = Net::OAuth->request( $request_type )->new( %$params );
  $request->sign;

  my $url = $request->to_url;
  $self->rest_url( "$url" );

  my $method = $params->{request_method};
  my $req;
  if( $method eq 'GET' ){
        $req = GET $url;
  }elsif(  $method eq 'POST' ){
        $req = POST $url;
  }elsif(  $method eq 'DELETE' ){
        $req = HTTP::Request->new( 'DELETE', $url );
  }else{
        $self->content_error( "Unknown method '$method'" );
        return;
  }
  # if content_filter exists and is a scalar, then use it as the filename to write to instead of content being in memory.
  my $response = $self->ua->request( $req, ($self->content_filter && !ref($self->content_filter) ? $self->content_filter : ()) );

   if ( ! $response->is_success ) {
        $self->content_error( sprintf '%s Request to "%s" failed (%s): "%s"', $method, $url, $response->status_line, $response->content );
       return;
  }elsif( ! length ${$response->content_ref} ){
        $self->content_error( sprintf '%s Request to "%s" failed (%s) (__EMPTY_CONTENT__): "%s"', $method, $url, $response->status_line, $response->content );
        return;
  }
  $self->_set_content( $response->content_ref );

  return $response;
}

########################################

package WWW::Lovefilm::API::_UrlAppender;

use strict;
use warnings;
our $AUTOLOAD;

sub new {
  my $self = shift;
  my $params = { @_ };
  return bless { stack => $params->{stack}, append => $params->{append}||{} }, $self;
}

sub AUTOLOAD {
  my $self = shift;
  my $dir = lc $AUTOLOAD;
  $dir =~ s/.*:://;
  if( $dir ne 'destroy' ){
    push @{ $self->{stack} }, $dir;
    push @{ $self->{stack} }, @_ if scalar @_;
    push @{ $self->{stack} }, $self->{append}->{$dir} if exists $self->{append}->{$dir};
  }
  return $self;
}

########################################

1; # End of WWW::Lovefilm::API

__END__