[libnet-twitter-lite-perl] 01/04: Imported Upstream version 0.12006

gregor herrmann gregoa at debian.org
Sun Feb 23 17:41:48 UTC 2014


This is an automated email from the git hooks/post-receive script.

gregoa pushed a commit to branch master
in repository libnet-twitter-lite-perl.

commit 4bd60d014d0e77ce29858dd8baaf67fbe48174d5
Author: gregor herrmann <gregoa at debian.org>
Date:   Sun Feb 23 18:37:38 2014 +0100

    Imported Upstream version 0.12006
---
 Build.PL                             |   4 +-
 Changes                              |   3 +
 MANIFEST                             |   2 +
 META.yml                             |   3 +-
 lib/Net/Twitter/Lite.pm              |  12 +-
 lib/Net/Twitter/Lite.pod             |  15 ++-
 lib/Net/Twitter/Lite/API/V1.pm       |   4 +-
 lib/Net/Twitter/Lite/API/V1_1.pm     |   4 +-
 lib/Net/Twitter/Lite/Error.pm        |   4 +-
 lib/Net/Twitter/Lite/WithAPIv1_1.pm  |   4 +-
 lib/Net/Twitter/Lite/WithAPIv1_1.pod |   9 +-
 lib/Net/Twitter/Lite/WrapResult.pm   | 126 +++++++++++++++++++++
 t/04-wrapresult.t                    | 207 +++++++++++++++++++++++++++++++++++
 13 files changed, 381 insertions(+), 16 deletions(-)

diff --git a/Build.PL b/Build.PL
index 746cf90..d134b9a 100644
--- a/Build.PL
+++ b/Build.PL
@@ -18,7 +18,7 @@ my %module_build_args = (
     "Marc Mims <mmims\@cpan.org>"
   ],
   "dist_name" => "Net-Twitter-Lite",
-  "dist_version" => "0.12005",
+  "dist_version" => "0.12006",
   "license" => "perl",
   "module_name" => "Net::Twitter::Lite",
   "recommends" => {
@@ -45,6 +45,7 @@ my %module_build_args = (
   },
   "script_files" => [],
   "test_requires" => {
+    "Data::Dumper" => 0,
     "File::Find" => 0,
     "File::Temp" => 0,
     "Test::Fatal" => 0,
@@ -55,6 +56,7 @@ my %module_build_args = (
 
 
 my %fallback_build_requires = (
+  "Data::Dumper" => 0,
   "File::Find" => 0,
   "File::Temp" => 0,
   "Module::Build" => "0.3601",
diff --git a/Changes b/Changes
index f73b2dd..3d546a9 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,6 @@
+0.12006 2014-01-24
+    - Added WrapResult: return both the Twitter result and HTTP::Response
+
 0.12005 2014-01-17
     - Twitter now requires SSL connections
 
diff --git a/MANIFEST b/MANIFEST
index 200ae28..cfe1201 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -14,11 +14,13 @@ lib/Net/Twitter/Lite/API/V1_1.pm
 lib/Net/Twitter/Lite/Error.pm
 lib/Net/Twitter/Lite/WithAPIv1_1.pm
 lib/Net/Twitter/Lite/WithAPIv1_1.pod
+lib/Net/Twitter/Lite/WrapResult.pm
 t/00-compile.t
 t/00_load.t
 t/01_basic.t
 t/02_regression.t
 t/03-v1_1.t
+t/04-wrapresult.t
 t/99-pod_spelling.t
 t/legacy_lists_api.t
 t/new-lists.t
diff --git a/META.yml b/META.yml
index 136a659..c6719e2 100644
--- a/META.yml
+++ b/META.yml
@@ -3,6 +3,7 @@ abstract: 'A perl API library for the Twitter API'
 author:
   - 'Marc Mims <mmims at cpan.org>'
 build_requires:
+  Data::Dumper: 0
   File::Find: 0
   File::Temp: 0
   Module::Build: 0.3601
@@ -45,4 +46,4 @@ resources:
   bugtracker: http://rt.cpan.org/Public/Dist/Display.html?Name=Net-Twitter-Lite
   homepage: https://github.com/semifor/net-twitter-lite
   repository: https://github.com/semifor/net-twitter-lite.git
-version: 0.12005
+version: 0.12006
diff --git a/lib/Net/Twitter/Lite.pm b/lib/Net/Twitter/Lite.pm
index 25cdfd7..55c9e7b 100644
--- a/lib/Net/Twitter/Lite.pm
+++ b/lib/Net/Twitter/Lite.pm
@@ -1,5 +1,5 @@
 package Net::Twitter::Lite;
-our $VERSION = '0.12005';
+our $VERSION = '0.12006';
 use 5.005;
 use warnings;
 use strict;
@@ -10,7 +10,7 @@ Net::Twitter::Lite - A perl library for Twitter's API v1
 
 =head1 VERSION
 
-version 0.12005
+version 0.12006
 
 =cut
 
@@ -20,6 +20,7 @@ use JSON;
 use HTTP::Request::Common;
 use Net::Twitter::Lite::Error;
 use Encode qw/encode_utf8/;
+use Net::Twitter::Lite::WrapResult;
 
 sub twitter_api_def_from           () { 'Net::Twitter::Lite::API::V1' }
 sub _default_api_url               () { 'http://api.twitter.com/1'    }
@@ -576,7 +577,12 @@ sub _parse_result {
         die Net::Twitter::Lite::Error->new(twitter_error => $obj, http_response => $res);
     }
 
-    return $obj if $res->is_success && defined $obj;
+    if ( $res->is_success && defined $obj ) {
+        if ( $self->{wrap_result} ) {
+            $obj = Net::Twitter::Lite::WrapResult->new($obj, $res);
+        }
+        return $obj;
+    }
 
     my $error = Net::Twitter::Lite::Error->new(http_response => $res);
     $error->twitter_error($obj) if ref $obj;
diff --git a/lib/Net/Twitter/Lite.pod b/lib/Net/Twitter/Lite.pod
index 3de770f..c3515e1 100644
--- a/lib/Net/Twitter/Lite.pod
+++ b/lib/Net/Twitter/Lite.pod
@@ -4,7 +4,7 @@ Net::Twitter::Lite - A perl interface to the Twitter API
 
 =head1 VERSION
 
-version 0.12005
+version 0.12006
 
 =head1 STOP!
 
@@ -374,6 +374,13 @@ semantics will be used. Only the new lists API methods are documented here.
 If you do not provide this option to C<new> a warning is issued. Support for
 this option and the legacy lists API methods will be removed in a future version.
 
+=item wrap_result
+
+(Optional) If set to 1, this option will return an
+L<Net::Twitter::Lite::WrapResult> object, which provides both the Twitter API
+result and the L<HTTP::Response> object for the API call. See
+L<Net::Twitter::Lite::WrapResult> for details.
+
 =back
 
 =back
@@ -2652,7 +2659,7 @@ C<undef> as the first array value.
 The Tweet text will be rewritten to include the media URL(s), which will reduce
 the number of characters allowed in the Tweet text. If the URL(s) cannot be
 appended without text truncation, the tweet will be rejected and this method
-will return an HTTP 403 error. 
+will return an HTTP 403 error.
 
 
 Returns: Status
@@ -2978,6 +2985,10 @@ Track Net::Twitter::Lite development at L<http://github.com/semifor/net-twitter-
 
 Marc Mims <marc at questright.com>
 
+=head1 CONTRIBUTORS
+
+Chris Page <chris at starforge.co.uk>
+
 =head1 LICENSE
 
 Copyright (c) 2013 Marc Mims
diff --git a/lib/Net/Twitter/Lite/API/V1.pm b/lib/Net/Twitter/Lite/API/V1.pm
index 5b80ed2..bc0d49b 100644
--- a/lib/Net/Twitter/Lite/API/V1.pm
+++ b/lib/Net/Twitter/Lite/API/V1.pm
@@ -1,5 +1,5 @@
 package Net::Twitter::Lite::API::V1;
-$Net::Twitter::Lite::API::V1::VERSION = '0.12005';
+$Net::Twitter::Lite::API::V1::VERSION = '0.12006';
 use warnings;
 use strict;
 
@@ -9,7 +9,7 @@ Net::Twitter::Lite::API::V1 - Method definitions for Twitter's deprecated API v1
 
 =head1 VERSION
 
-version 0.12005
+version 0.12006
 
 =cut
 
diff --git a/lib/Net/Twitter/Lite/API/V1_1.pm b/lib/Net/Twitter/Lite/API/V1_1.pm
index cdb51d2..df3b41a 100644
--- a/lib/Net/Twitter/Lite/API/V1_1.pm
+++ b/lib/Net/Twitter/Lite/API/V1_1.pm
@@ -1,5 +1,5 @@
 package Net::Twitter::Lite::API::V1_1;
-$Net::Twitter::Lite::API::V1_1::VERSION = '0.12005';
+$Net::Twitter::Lite::API::V1_1::VERSION = '0.12006';
 use warnings;
 use strict;
 
@@ -9,7 +9,7 @@ Net::Twitter::Lite::API::V1_1 - Twitter API v1.1 method definitions
 
 =head1 VERSION
 
-version 0.12005
+version 0.12006
 
 =cut
 
diff --git a/lib/Net/Twitter/Lite/Error.pm b/lib/Net/Twitter/Lite/Error.pm
index 6c2618c..0dc813a 100644
--- a/lib/Net/Twitter/Lite/Error.pm
+++ b/lib/Net/Twitter/Lite/Error.pm
@@ -1,5 +1,5 @@
 package Net::Twitter::Lite::Error;
-$Net::Twitter::Lite::Error::VERSION = '0.12005';
+$Net::Twitter::Lite::Error::VERSION = '0.12006';
 use warnings;
 use strict;
 
@@ -18,7 +18,7 @@ Net::Twitter::Lite::Error - Encapsulates errors thrown by Net::Twitter::Lite
 
 =head1 VERSION
 
-version 0.12005
+version 0.12006
 
 =head1 SYNOPSIS
 
diff --git a/lib/Net/Twitter/Lite/WithAPIv1_1.pm b/lib/Net/Twitter/Lite/WithAPIv1_1.pm
index d077315..77c5592 100644
--- a/lib/Net/Twitter/Lite/WithAPIv1_1.pm
+++ b/lib/Net/Twitter/Lite/WithAPIv1_1.pm
@@ -1,5 +1,5 @@
 package Net::Twitter::Lite::WithAPIv1_1;
-$Net::Twitter::Lite::WithAPIv1_1::VERSION = '0.12005';
+$Net::Twitter::Lite::WithAPIv1_1::VERSION = '0.12006';
 use warnings;
 use strict;
 use parent 'Net::Twitter::Lite';
@@ -10,7 +10,7 @@ Net::Twitter::Lite::WithAPIv1_1 - A perl API library for Twitter's API v1.1
 
 =head1 VERSION
 
-version 0.12005
+version 0.12006
 
 =cut
 
diff --git a/lib/Net/Twitter/Lite/WithAPIv1_1.pod b/lib/Net/Twitter/Lite/WithAPIv1_1.pod
index c12c5c3..4a0e36c 100644
--- a/lib/Net/Twitter/Lite/WithAPIv1_1.pod
+++ b/lib/Net/Twitter/Lite/WithAPIv1_1.pod
@@ -6,7 +6,7 @@ Net::Twitter::Lite::WithAPIv1_1 - A perl interface to the Twitter API
 
 =head1 VERSION
 
-version 0.12005
+version 0.12006
 
 =head1 SYNOPSIS
 
@@ -200,6 +200,13 @@ credentials. If set to 1, will use the value of the C<netrc_machine> option
 (Optional) Sets the C<machine> entry to look up in C<.netrc> when C<<netrc => 1>>
 is used.  Defaults to C<api.twitter.com>.
 
+=item wrap_result
+
+(Optional) If set to 1, this option will return an
+L<Net::Twitter::Lite::WrapResult> object, which provides both the Twitter API
+result and the L<HTTP::Response> object for the API call. See
+L<Net::Twitter::Lite::WrapResult> for details.
+
 =back
 
 =item credentials($username, $password)
diff --git a/lib/Net/Twitter/Lite/WrapResult.pm b/lib/Net/Twitter/Lite/WrapResult.pm
new file mode 100644
index 0000000..769d5c1
--- /dev/null
+++ b/lib/Net/Twitter/Lite/WrapResult.pm
@@ -0,0 +1,126 @@
+package Net::Twitter::Lite::WrapResult;
+$Net::Twitter::Lite::WrapResult::VERSION = '0.12006';
+use strict;
+
+=head1 NAME
+
+Net::Twitter::Lite::WrapResult - Wrap the HTTP response and Twitter result
+
+=head1 VERSION
+
+version 0.12006
+
+=head1 SYNOPSIS
+
+    use Net::Twitter::Lite::WithAPIv1_1;
+
+    my $nt = Net::Twitter::Lite::WithAPIv1_1->new(
+        consumer_key        => $consumer_key,
+        consumer_secret     => $consumer_secret,
+        access_token        => $access_token,
+        access_token_secret => $access_token_secret,
+        wrap_result         => 1,
+    );
+
+    my $r = $nt->verify_credentials;
+
+    my $http_response        = $r->http_response;
+    my $twitter_result       = $r->result;
+    my $rate_limit_remaining = $r->rate_limit_remaining;
+
+=head1 DESCRIPTION
+
+Often, the result of a Twitter API call, inflated from the JSON body of the
+HTTP response does not contain all the information you need. Twitter includes
+meta data, such as rate limiting information, in HTTP response headers. This
+object wraps both the inflated Twitter result and the HTTP response giving the
+caller full access to all the meta data. It also provides accessors for the
+rate limit information.
+
+=head1 METHODS
+
+=over 4
+
+=item new($twitter_result, $http_response)
+
+Constructs an object wrapping the Twitter result and HTTP response.
+
+=cut
+
+sub new {
+    my ( $class, $twitter_result, $http_response ) = @_;
+
+    return bless {
+        result => $twitter_result,
+        http_response => $http_response,
+    }, ref $class || $class;
+}
+
+=item result
+
+Returns the inflated Twitter API result.
+
+=cut
+
+sub result { shift->{result} }
+
+=item http_response
+
+Returns the L<HTTP::Response> object for the API call.
+
+=cut
+
+sub http_response { shift->{http_response} }
+
+# private method
+my $limit = sub {
+    my ( $self, $which ) = @_;
+    
+    my $res = $self->http_response;
+    $res->header("X-Rate-Limit-$which") || $res->header("X-FeatureRateLimit-$which");
+};
+
+=item rate_limit
+
+Returns the rate limit, per 15 minute window, for the API endpoint called.
+Returns undef if no suitable rate limit header is available.
+
+=cut
+
+sub rate_limit           { shift->$limit('Limit') }
+
+=item rate_limit_remaining
+
+Returns the calls remaining in the current 15 minute window for the API
+endpoint called.  Returns undef if no suitable header is available.
+
+=cut
+
+sub rate_limit_remaining { shift->$limit('Remaining') }
+
+=item rate_limit_reset
+
+Returns the unix epoch time time of the next 15 minute window, i.e., when the
+rate limit will be reset, for the API endpoint called.  Returns undef if no
+suitable header is available.
+
+=cut
+
+sub rate_limit_reset     { shift->$limit('Reset') }
+
+1;
+
+__END__
+
+=back
+
+=head1 AUTHOR
+
+Marc Mims <marc at questright.com>
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright (c) 2014 Marc Mims <marc at questright.com>
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as perl itself.
diff --git a/t/04-wrapresult.t b/t/04-wrapresult.t
new file mode 100644
index 0000000..1214c53
--- /dev/null
+++ b/t/04-wrapresult.t
@@ -0,0 +1,207 @@
+#!perl
+use warnings;
+use strict;
+use Test::More;
+
+eval 'use LWP::UserAgent 5.819';
+plan skip_all => 'LWP::UserAgent 5.819 required' if $@;
+
+my $screen_name = 'net_twitter';
+my $message_id  = 1234;
+my $status      = 'Hello, world!';
+my $now = time();
+
+my @tests = (
+    # api call              args                                 method  path                     lim  rem  reset
+    [ create_block =>       [ { screen_name => $screen_name } ], POST => "/blocks/create.json" ],
+    [ direct_messages =>    [ ]                                , GET  => "/direct_messages.json",  15,  14,  $now ],
+    [ direct_messages =>    [ ]                                , GET  => "/direct_messages.json",  15,  13,  $now ],
+    [ direct_messages =>    [ ]                                , GET  => "/direct_messages.json",  15,  12,  $now ],
+    [ favorites =>          [ { screen_name => $screen_name } ], GET  => "/favorites/list.json" ,  15,  14,  $now ],
+    [ favorites =>          [ { screen_name => $screen_name } ], GET  => "/favorites/list.json" ,  15,  13,  $now ],
+    [ favorites =>          [ { screen_name => $screen_name } ], GET  => "/favorites/list.json" ,  15,  12,  $now ],
+    [ followers_list =>     [ { screen_name => $screen_name } ], GET  => "/followers/list.json" ,  15,  14,  $now ],
+    [ followers_list =>     [ { screen_name => $screen_name } ], GET  => "/followers/list.json" ,  15,  13,  $now ],
+    [ followers_list =>     [ { screen_name => $screen_name } ], GET  => "/followers/list.json" ,  15,  12,  $now ],
+    [ friends_list =>       [ { screen_name => $screen_name } ], GET  => "/friends/list.json"   ,  15,  14,  $now ],
+    [ friends_list =>       [ { screen_name => $screen_name } ], GET  => "/friends/list.json"   ,  15,  13,  $now ],
+    [ friends_list =>       [ { screen_name => $screen_name } ], GET  => "/friends/list.json"   ,  15,  12,  $now ],
+    [ new_direct_message => [ { screen_name => $screen_name, text => $status } ], POST => "/direct_messages/new.json" ],
+    [ users_search =>       [ { q => $screen_name }           ], GET  => "/users/search.json"   , 180, 179,  $now ],
+    [ users_search =>       [ { q => $screen_name }           ], GET  => "/users/search.json"   , 180, 178,  $now ],
+    [ users_search =>       [ { q => $screen_name }           ], GET  => "/users/search.json"   , 180, 177,  $now ],
+);
+
+plan tests => @tests * 14 + 3;
+
+use_ok 'Net::Twitter::Lite::WithAPIv1_1';
+
+my $nt = Net::Twitter::Lite::WithAPIv1_1->new(ssl => 1,
+                                              wrap_result => 1);
+isa_ok $nt, 'Net::Twitter::Lite::WithAPIv1_1';
+
+my $limits = {
+#   Resource                                  lim  rem  reset
+    "/account/settings.json"              => [ 15,  15, $now],
+    "/account/verify_credentials.json"    => [ 15,  15, $now],
+    "/application/rate_limit_status.json" => [180, 180, $now],
+    "/blocks/ids.json"                    => [ 15,  15, $now],
+    "/blocks/list.json"                   => [ 15,  15, $now],
+    "/direct_messages.json"               => [ 15,  15, $now],
+    "/direct_messages/sent.json"          => [ 15,  15, $now],
+    "/direct_messages/show.json"          => [ 15,  15, $now],
+    "/favorites/list.json"                => [ 15,  15, $now],
+    "/followers/ids.json"                 => [ 15,  15, $now],
+    "/followers/list.json"                => [ 15,  15, $now],
+    "/friends/ids.json"                   => [ 15,  15, $now],
+    "/friends/list.json"                  => [ 15,  15, $now],
+    "/friendships/incoming.json"          => [ 15,  15, $now],
+    "/friendships/lookup.json"            => [ 15,  15, $now],
+    "/friendships/no_retweets/ids.json"   => [ 15,  15, $now],
+    "/friendships/outgoing.json"          => [ 15,  15, $now],
+    "/friendships/show.json"              => [180, 180, $now],
+    "/geo/reverse_geocode.json"           => [ 15,  15, $now],
+    "/geo/search.json"                    => [ 15,  15, $now],
+    "/geo/similar_places.json"            => [ 15,  15, $now],
+    "/help/configuration.json"            => [ 15,  15, $now],
+    "/help/languages.json"                => [ 15,  15, $now],
+    "/help/privacy.json"                  => [ 15,  15, $now],
+    "/help/tos.json"                      => [ 15,  15, $now],
+    "/lists.json"                         => [ 15,  15, $now],
+    "/lists/list.json"                    => [ 15,  15, $now],
+    "/lists/members.json"                 => [180, 180, $now],
+    "/lists/members/show.json"            => [ 15,  15, $now],
+    "/lists/memberships.json"             => [ 15,  15, $now],
+    "/lists/ownerships.json"              => [ 15,  15, $now],
+    "/lists/show.json"                    => [ 15,  15, $now],
+    "/lists/statuses.json"                => [180, 180, $now],
+    "/lists/subscribers.json"             => [180, 180, $now],
+    "/lists/subscribers/show.json"        => [ 15,  15, $now],
+    "/lists/subscriptions.json"           => [ 15,  15, $now],
+    "/saved_searches/list.json"           => [ 15,  15, $now],
+    "/search/tweets.json"                 => [180, 180, $now],
+    "/statuses/home_timeline.json"        => [ 15,  15, $now],
+    "/statuses/mentions_timeline.json"    => [ 15,  15, $now],
+    "/statuses/oembed.json"               => [180, 180, $now],
+    "/statuses/retweeters/ids.json"       => [ 15,  15, $now],
+    "/statuses/retweets_of_me.json"       => [ 15,  15, $now],
+    "/statuses/user_timeline.json"        => [180, 180, $now],
+    "/trends/available.json"              => [ 15,  15, $now],
+    "/trends/closest.json"                => [ 15,  15, $now],
+    "/trends/place.json"                  => [ 15,  15, $now],
+    "/users/contributees.json"            => [ 15,  15, $now],
+    "/users/contributors.json"            => [ 15,  15, $now],
+    "/users/lookup.json"                  => [180, 180, $now],
+    "/users/profile_banner.json"          => [180, 180, $now],
+    "/users/search.json"                  => [180, 180, $now],
+    "/users/show.json"                    => [180, 180, $now],
+    "/users/suggestions.json"             => [ 15,  15, $now],
+};
+
+my $ua = $nt->{ua};
+my $http_response;
+
+$ua->add_handler(request_send => sub {
+    my ($request, $ua, $h) = @_;
+
+    $http_response = HTTP::Response->new(200, 'OK');
+    $http_response->request($request);
+    $http_response->content('{"test":"success"}');
+
+    my ($resource) = $request->uri =~ m|^https?://api.twitter.com/1.1(.*?)(?:\?.*)?$|;
+    if($resource && $limits -> {$resource}) {
+        $http_response->header('x-rate-limit-limit' => $limits->{$resource}->[0]);
+        $http_response->header('x-rate-limit-remaining' => --$limits->{$resource}->[1]);
+        $http_response->header('x-rate-limit-reset' => $limits->{$resource}->[2]);
+    }
+
+    return $http_response;
+});
+use Data::Dumper;
+my ($resp, $result, $http_resp);
+for my $test ( @tests ) {
+    my ($api_call, $args, $method, $path, $limit, $remain, $reset) = @$test;
+
+    my %args;
+    if ( $api_call eq 'update' ) {
+        %args = ( source => 'twitterpm', status => @$args );
+    }
+    elsif ( $api_call eq 'relationship_exists' ) {
+        @{args}{qw/user_a user_b/} = @$args;
+    }
+    elsif ( $api_call eq 'update_delivery_device' ) {
+        %args = ( device => @$args );
+    }
+    elsif ( @$args ) {
+        %args = ref $args->[0] ? %{$args->[0]} : ( id => $args->[0] );
+    }
+
+    ok $resp = $nt->$api_call(@$args), "$api_call call";
+    isa_ok $resp, 'Net::Twitter::Lite::WrapResult';
+    ok $resp->http_response, "http response available";
+    isa_ok $resp->http_response, 'HTTP::Response';
+
+    ok $result = $resp->result, "result is available";
+    isa_ok $result, "HASH";
+    ok $result->{"test"} eq "success", "test request success";
+
+    if(defined($limit)) {
+        ok $limit  == $resp->rate_limit, "$api_call limit = $limit";
+        ok $remain == $resp->rate_limit_remaining, "$api_call limit remaining = $remain";
+        ok $reset  == $resp->rate_limit_reset, "$api_call limit reset = $reset";
+    } else {
+        ok !defined($resp->rate_limit), "$api_call no limit";
+        ok !defined($resp->rate_limit_remaining), "$api_call no limit remaining";
+        ok !defined($resp->rate_limit_reset), "$api_call no reset";
+    }
+
+}
+
+$nt = Net::Twitter::Lite::WithAPIv1_1->new(ssl => 1);
+isa_ok $nt, 'Net::Twitter::Lite::WithAPIv1_1';
+
+$ua = $nt->{ua};
+
+$ua->add_handler(request_send => sub {
+    my ($request, $ua, $h) = @_;
+
+    $http_response = HTTP::Response->new(200, 'OK');
+    $http_response->request($request);
+    $http_response->content('{"test":"success"}');
+
+    my ($resource) = $request->uri =~ m|^https?://api.twitter.com/1.1(.*?)(?:\?.*)?$|;
+    if($resource && $limits -> {$resource}) {
+        $http_response->header('x-rate-limit-limit' => $limits->{$resource}->[0]);
+        $http_response->header('x-rate-limit-remaining' => --$limits->{$resource}->[1]);
+        $http_response->header('x-rate-limit-reset' => $limits->{$resource}->[2]);
+    }
+
+    return $http_response;
+});
+
+
+for my $test ( @tests ) {
+    my ($api_call, $args, $method, $path, $limit, $remain, $reset) = @$test;
+
+    my %args;
+    if ( $api_call eq 'update' ) {
+        %args = ( source => 'twitterpm', status => @$args );
+    }
+    elsif ( $api_call eq 'relationship_exists' ) {
+        @{args}{qw/user_a user_b/} = @$args;
+    }
+    elsif ( $api_call eq 'update_delivery_device' ) {
+        %args = ( device => @$args );
+    }
+    elsif ( @$args ) {
+        %args = ref $args->[0] ? %{$args->[0]} : ( id => $args->[0] );
+    }
+
+    ok $resp = $nt->$api_call(@$args), "$api_call call";
+    isa_ok $resp, "HASH";
+    ok(defined $resp && !UNIVERSAL::isa($resp, 'Net::Twitter::Lite::WrapResult'), "$api_call response not wrapped");
+    ok $result->{"test"} eq "success", "test request success";
+}
+
+
+exit 0;

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libnet-twitter-lite-perl.git



More information about the Pkg-perl-cvs-commits mailing list