File Coverage

blib/lib/WebService/Minecraft/Fishbans.pm
Criterion Covered Total %
statement 15 32 46.8
branch 0 10 0.0
condition n/a
subroutine 5 6 83.3
pod 1 1 100.0
total 21 49 42.8


line stmt bran cond sub pod time code
1             package WebService::Minecraft::Fishbans;
2              
3 1     1   15283 use 5.006;
  1         3  
  1         63  
4 1     1   6 use strict;
  1         2  
  1         35  
5 1     1   1314 use Moo;
  1         11958  
  1         4  
6 1     1   1675 use LWP::UserAgent;
  1         56350  
  1         25  
7 1     1   542 use JSON;
  1         12807  
  1         4  
8              
9             our $VERSION = '0.01';
10              
11             =head1 NAME
12              
13             WebService::Minecraft::Fishbans - look for bans for a Minecraft user
14              
15             =head1 DESCRIPTION
16              
17             L is a service that lets you query various
18             Minecraft "global ban" systems (e.g. MCBouncer, MCBans, Minebans, etc) in one
19             API call.
20              
21             This module is a simple wrapper to query the Fishbans API. It collates the
22             bans reported by the Fishbans API, flattening the response to present simply an
23             array/arrayref of hashrefs, one per recorded ban.
24              
25              
26             =head1 SYNOPSIS
27              
28             use WebService::Minecraft::Fishbans;
29              
30             my $fishbans = WebService::Minecraft::Fishbans->new();
31             if (my @bans = $fishbans->lookup_user($username)) {
32             for my $ban (@bans) {
33             printf "%s was banned from %s for reason %s (via %s)\n",
34             $user, @$ban{ qw(server reason service) };
35             }
36             }
37              
38             =cut
39              
40             # Sensible default for our User-Agent object, but allowing it to be replaced
41             # or modified at runtime if the user requires, or if we want to mock it for
42             # testing.
43             has user_agent => (
44             is => 'rw',
45             isa => sub { my $val = shift; ref $val && $val->isa('LWP::UserAgent') },
46             default => sub {
47             LWP::UserAgent->new( agent => __PACKAGE__ . "/$VERSION" );
48             },
49             );
50              
51             =head1 METHODS
52              
53             =head2 lookup_user
54              
55             Given a Minecraft username, queries the Fishbans API and returns a list or
56             arrayref (depending on context) of hashrefs, each describing a ban.
57              
58             Each ban hashref will contain:
59              
60             =over
61              
62             =item C
63              
64             The server the user was banned from
65              
66             =item C
67              
68             The reason for the ban, provided by the op who banned them
69              
70             =item C
71              
72             The service the ban was found from - e.g. C, C, etc.
73              
74             =back
75              
76             =cut
77              
78             sub lookup_user {
79 0     0 1   my ($self, $username) = @_;
80              
81 0           my $response = $self->user_agent->get(
82             "http://api.fishbans.com/bans/$username"
83             );
84 0 0         if (!$response->is_success) {
85 0           die "Failed to query Fishbans - " . $response->status_line;
86             }
87 0 0         my $result = JSON::from_json($response->decoded_content)
88             or die "Failed to parse Fishbans response";
89 0 0         if (!$result->{success}) {
90 0           die "Fishbans API response indicated failure";
91             }
92              
93 0           my @return;
94 0           service:
95 0           for my $service (keys %{ $result->{bans}{service} }) {
96 0           my $service_data = $result->{bans}{service}{$service};
97 0 0         next service unless $service_data->{bans};
98 0           while (my ($server, $reason) = each %{ $service_data->{ban_info} }) {
  0            
99 0           warn "Found ban via $service from $server - [$reason]";
100 0           push @return, {
101             service => $service,
102             server => $server,
103             reason => $reason,
104             };
105             }
106             }
107              
108 0 0         return wantarray ? @return : \@return;
109             }
110              
111              
112             =head1 AUTHOR
113              
114             David Precious, C<< >>
115              
116             =head1 BUGS / DEVELOPMENT
117            
118             Bug reports and pull requests are welcomed on GitHub:
119            
120             L
121              
122              
123              
124             =head1 LICENSE AND COPYRIGHT
125              
126             Copyright 2015 David Precious.
127              
128             This program is free software; you can redistribute it and/or modify it
129             under the terms of the the Artistic License (2.0). You may obtain a
130             copy of the full license at:
131              
132             L
133              
134             Any use, modification, and distribution of the Standard or Modified
135             Versions is governed by this Artistic License. By using, modifying or
136             distributing the Package, you accept this license. Do not use, modify,
137             or distribute the Package, if you do not accept this license.
138              
139             If your Modified Version has been derived from a Modified Version made
140             by someone other than you, you are nevertheless required to ensure that
141             your Modified Version complies with the requirements of this license.
142              
143             This license does not grant you the right to use any trademark, service
144             mark, tradename, or logo of the Copyright Holder.
145              
146             This license includes the non-exclusive, worldwide, free-of-charge
147             patent license to make, have made, use, offer to sell, sell, import and
148             otherwise transfer the Package with respect to any patent claims
149             licensable by the Copyright Holder that are necessarily infringed by the
150             Package. If you institute patent litigation (including a cross-claim or
151             counterclaim) against any party alleging that the Package constitutes
152             direct or contributory patent infringement, then this Artistic License
153             to you shall terminate on the date that such litigation is filed.
154              
155             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
156             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
157             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
158             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
159             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
160             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
161             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
162             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
163              
164              
165             =cut
166              
167             1; # End of WebService::Minecraft::Fishbans