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