1#!perl
2use 5.14.1;
3use warnings;
4use Ref::Util qw/is_hashref/;
5use Test::Spec;
6use HTTP::Response;
7use Test::Fatal;
8
9use Twitter::API;
10
11BEGIN {
12    eval { require Net::Twitter };
13    plan skip_all => 'Net::Twitter >= 4.01041 not installed'
14        if $@ || Net::Twitter->VERSION lt '4.01041';
15}
16
17my %skip = map +($_ => 1), (
18    'contributees',           # deprecated
19    'contributors',           # deprecated
20    'create_media_metadata',  # described incorrectly in Net::Twitter
21    'destroy_direct_message', # deprecated
22    'direct_messages',        # deprecated
23    'new_direct_message',     # deprecated
24    'sent_direct_messages',   # deprecated
25    'show_direct_message',    # deprecated
26    'similar_places',         # no longer documented
27    'update_delivery_device', # no longer documented
28    'update_profile_colors',  # no longer documented
29    'update_with_media',      # deprecated
30    'upload_status',          # no longer documented
31);
32
33# These methods are either modified with an "around" or defined incorrectly in
34# Net::Twitter, override what we expect for required parameters.
35my %override_required = (
36    show_user          => [ ':ID' ],
37    create_friend      => [ ':ID' ],
38    destroy_friend     => [ ':ID' ],
39    friends_ids        => [ ':ID' ],
40    followers_ids      => [ ':ID' ],
41    create_block       => [ ':ID' ],
42    destroy_block      => [ ':ID' ],
43    report_spam        => [ ':ID' ],
44    update_friendship  => [ ':ID' ],
45    create_mute        => [ ':ID' ],
46    destroy_mute       => [ ':ID' ],
47);
48# aliases
49for ( \%override_required ) { # damned name is too long!
50    $_->{follow} = $_->{follow_new} = $_->{create_friendship}
51        = $_->{create_friend};
52    $_->{destroy_friendship} = $_->{unfollow} = $_->{destroy_friend};
53    $_->{following_ids} = $_->{friends_ids};
54}
55
56sub new_client {
57    my $client = Twitter::API->new_with_traits(
58        traits          => 'ApiMethods',
59        consumer_key    => 'key',
60        consumer_secret => 'secret',
61    );
62    $client->stubs(request => sub {
63        my ( $self, $method, $path, $args ) = @_;
64        die 'too many args' if @_ > 4;
65        die 'too few args'  if @_ < 3;
66        die 'final arg must be HASH' if @_ > 3 && !is_hashref($args);
67
68        return ( uc $method, $args );
69    });
70
71    return $client;
72}
73
74sub http_response_ok {
75    HTTP::Response->new(
76        200, 'OK',
77        [
78            content_type   => 'application/json;charset=utf-8',
79            contest_length => 4,
80        ],
81        '{}'
82    );
83}
84
85my $nt = Net::Twitter->new(traits => [ qw/API::RESTv1_1/ ]);
86my @nt_methods =
87    # We'll test all methods through their aliases, too
88    map {
89        my $meta = $_;
90        my @names = ($_->name, @{ $_->aliases });
91        map [ $_, $meta ], @names;
92    }
93    sort { $a->name cmp $b->name }
94    grep !$_->deprecated,
95    grep $_->isa('Net::Twitter::Meta::Method'),
96    map $_->original_method // $_, # may be wrapped
97    $nt->meta->get_all_methods;
98
99for my $pair ( @nt_methods ) {
100    my ( $name, $nt_method ) = @$pair;
101    next if $skip{$nt_method->name};
102
103    describe $name => sub {
104        my ( $client, @required );
105        before each => sub {
106            $client = new_client;
107            @required = @{ $override_required{$name} // $nt_method->required };
108        };
109
110        it 'method exists' => sub {
111            ok $client->can($name);
112        };
113        it 'has correct HTTP method' => sub {
114            # path-part arguments must be passed
115            my %must_have_args;
116            @must_have_args{
117                ( $nt_method->path =~ /:(\w+)/g ),
118                map $_ eq ':ID' ? 'screen_name' : $_,
119                @required
120            } = 'a' .. 'z';
121            my ( $http_method, undef ) = $client->$name(
122                keys %must_have_args ? \%must_have_args : ()
123            );
124            is $http_method, $nt_method->method;
125        };
126
127        it "handles ${ \(0+@required) }  positional args" => sub {
128            my @args; @args[0 .. $#required] = 'a' .. 'z';
129            my %expected; @expected{
130                map $_ eq ':ID' ? 'screen_name' : '$_', @required
131            } = 'a' .. 'z';
132            my ( undef, $args ) = $client->$name(@args);
133            is_deeply $args, \%expected;
134        } if @required > 0;
135
136        it "handles mixed positional and named args" => sub {
137            my %args; @args{@required[1..$#required]} = 'a' .. 'z';
138            my %expected; @expected{
139                map $_ eq ':ID' ? 'screen_name' : '$_', @required
140            } = ( 'foo', 'a' .. 'z' );
141            my ( undef, $args ) = $client->$name('foo', \%args);
142            is_deeply $args, \%expected;
143        } if @required > 1;
144    };
145}
146
147runtests;
148