1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
|
#!perl
use Carp;
use strict;
use Test::More;
use Test::Fatal;
use lib qw(t/lib);
{
# simple mock object for Net::Netrc
package # hide from PAUSE
Net::Netrc;
use Moose;
sub lookup { shift->new }
sub lpa { qw/fred bedrock/ }
$INC{'Net/Netrc.pm'} = __FILE__;
}
eval 'use TestUA';
plan skip_all => 'LWP::UserAgent 5.819 required for tests' if $@;
use Net::Twitter;
my $nt = Net::Twitter->new(
ssl => 0,
traits => [qw/API::REST/],
username => 'homer',
password => 'doh!',
);
my $t = TestUA->new(1, $nt->ua);
ok $nt->friends_timeline, 'friends_timeline no args';
ok $nt->create_friend('flanders'), 'create_friend scalar arg';
ok $nt->create_friend({ id => 'flanders' }), 'create_friend hashref';
ok $nt->destroy_friend('flanders'), 'destroy_friend scalar arg';
$t->response->content('true');
my $r;
# back compat: 1.23 accepts scalar args
is exception { $r = $nt->relationship_exists('homer', 'marge') }, undef, 'relationship_exists scalar args';
ok $r = $nt->relationship_exists({ user_a => 'homer', user_b => 'marge' }),
'relationship_exists hashref';
# back compat: 1.23 returns bool
ok $r, 'relationship_exists returns true';
$t->reset_response;
# Net::Twitter calls used by POE::Component::Server::Twirc
ok $nt->new_direct_message({ user => 'marge', text => 'hello, world' }), 'new_direct_message';
ok $nt->friends({page => 2}), 'friends';
cmp_ok $t->arg('page'), '==', 2, 'page argument passed';
ok $nt->followers({page => 2}), 'followers';
ok $nt->direct_messages, 'direct_messages';
ok $nt->direct_messages({ since_id => 1 }), 'direct_messages since_id';
ok $nt->friends_timeline({ since_id => 1 }), 'friends_timeline since_id';
ok $nt->replies({ since_id => 1 }), 'replies since_id';
ok $nt->user_timeline, 'user_timeline';
ok $nt->update('hello, world'), 'update';
ok $nt->create_friend('flanders'), 'create_friend';
ok $nt->relationship_exists('homer', 'flanders'), 'relationship exists scalar args';
ok $nt->relationship_exists({ user_a => 'homer', user_b => 'flanders' }), 'relationship exists hashref';
ok $nt->destroy_friend('flanders'), 'destroy_friend';
ok $nt->create_block('flanders'), 'create_block';
ok $nt->destroy_block('flanders'), 'destroy_block';
ok $nt->create_favorite({ id => 12345678 }), 'create_favorite hashref';
ok $nt->rate_limit_status, 'rate_limit_status';
### Regression: broken in 2.03
ok $nt->show_status('flanders'), 'show_status string arg';
$t->add_id_arg('flanders');
is $t->arg('id'), 'flanders', 'show_status ID set';
ok $nt->show_user('marge'), 'show_user string arg';
$t->add_id_arg('marge');
is $t->arg('id'), 'marge', 'show_user ID set';
ok $nt->show_user({ id => 'homer' }), 'show_user hashref';
$t->add_id_arg('homer');
is $t->arg('id'), 'homer', 'show_user ID set 2';
ok $nt->public_timeline, 'public_timeline blankargs';
### v3.09000 ### Role BUILD methods not called need after BUILD => sub {...}
$nt = Net::Twitter->new(ssl => 1, traits => [qw/API::REST API::Lists/]);
$t = TestUA->new(1, $nt->ua);
$r = $nt->home_timeline;
is $t->request->uri->scheme, 'https', 'ssl used for REST';
$r = $nt->list_lists('perl_api');
is $t->request->uri->scheme, 'https', 'ssl used for Lists';
### v3.10001 ### netrc used $self->apiurl, which is only available via the API::REST trait
is exception { Net::Twitter->new(ssl => 0, netrc => 1, traits => [qw/API::Lists/]) }, undef, 'netrc with API::Lists lives';
### v3.11004 ### single array ref arg to update_profile_image not proprerly handled
$r = $nt->update_profile_image([ undef, 'my_mug.jpg', Content_Type => 'image/jpeg', Content => '' ]);
is $t->request->content_type, 'multipart/form-data', 'multipart/form-data';
### v4.00007 ### unicode args in search result in 401 "Could not authenticate you"
{
use utf8;
require URI::Escape;
my $nt = Net::Twitter->new(
ssl => 0,
traits => [qw/API::RESTv1_1 OAuth/],
consumer_key => 'my-consumer-key',
consumer_secret => 'my-consumer-secret',
access_token => 'my-access-token',
access_token_secret => 'my-access-token-secret',
);
my $search_term = '作家'; # writer
$nt->ua->add_handler(request_send => sub {
my $req = shift;
my $uri = $req->uri->clone;
$uri->query(undef);
my $oauth = Net::OAuth->request('protected_resource')->from_authorization_header(
$req->header('Authorization'),
request_url => $uri,
consumer_key => 'my-consumer-key',
consumer_secret => 'my-consumer-secret',
token => 'my-access-token',
token_secret => 'my-access-token-secret',
version => '1.0',
request_method => 'GET',
signature_method => 'HMAC-SHA1',
extra_params => { map Encode::decode_utf8($_), $req->uri->query_form },
);
ok $oauth->verify, 'valid oauth signature';
my $res = HTTP::Response->new(200);
$res->header('Content-Type' => 'application/json');
$res->content('{}');
return $res;
});
$nt->search($search_term);
}
done_testing
|
