lib/WWW/BackpackTF.pm

   1 package WWW::BackpackTF;
   2
   3 use 5.014000;
   4 use strict;
   5 use warnings;
   6 use parent qw/Exporter/;
   7 our $VERSION = '0.000_003';
   8 our @EXPORT_OK = qw/TF2 DOTA2/;
   9
  10 use constant +{
  11         TF2 => 440,
  12         DOTA2 => 570,
  13         QUALITIES => [qw/Normal Genuine rarity2 Vintage rarity3 Unusual Unique Community Valve Self-Made Customized Strange Completed Haunted Collector's/],
  14 };
  15
  16 BEGIN {
  17         my @qualities = @{QUALITIES()};
  18         for (0 .. $#qualities) {
  19                 my $name = uc $qualities[$_];
  20                 $name =~ y/A-Z0-9//cd;
  21                 constant->import($name, $_)
  22         }
  23 }
  24
  25 use JSON::MaybeXS qw/decode_json/;
  26 use HTTP::Tiny;
  27 use PerlX::Maybe;
  28 use WWW::BackpackTF::Currency;
  29 use WWW::BackpackTF::Item;
  30 use WWW::BackpackTF::User;
  31
  32 my $ht = HTTP::Tiny->new(agent => "WWW-BackpackTF/$VERSION");
  33
  34 sub request {
  35         my ($self, $url, %params) = @_;
  36         $params{key} = $self->{key} if $self->{key};
  37         $url = $self->{base} . $url;
  38         $url .= "&$_=$params{$_}" for keys %params;
  39         my $htr = $ht->get($url);
  40         die $htr->{reason} unless $htr->{success};
  41         my $response = decode_json($htr->{content})->{response};
  42         die $response->{message} unless $response->{success};
  43         $response
  44 }
  45
  46 sub new{
  47         my ($class, %args) = @_;
  48         $args{base} //= 'http://backpack.tf/api/';
  49         bless \%args, $class
  50 }
  51
  52 sub get_prices {
  53         my ($self, $appid, $raw) = @_;
  54         my $response = $self->request('IGetPrices/v4/?compress=1', maybe appid => $appid, maybe raw => $raw);
  55         map { WWW::BackpackTF::Item->new($_, $response->{items}{$_}) } keys %{$response->{items}}
  56 }
  57
  58 sub get_users {
  59         my ($self, @users) = @_;
  60         my $response = $self->request('IGetUsers/v3/?compress=1', steamids => join ',', @users);
  61         @users = map { WWW::BackpackTF::User->new($_) } values %{$response->{players}};
  62         wantarray ? @users : $users[0]
  63 }
  64
  65 sub get_currencies {
  66         my ($self, $appid) = @_;
  67         my $response = $self->request('IGetCurrencies/v1/?compress=1', maybe appid => $appid);
  68         map { WWW::BackpackTF::Currency->new($_, $response->{currencies}{$_}) } keys %{$response->{currencies}};
  69 }
  70
  71 1;
  72 __END__
  73
  74 =head1 NAME
  75
  76 WWW::BackpackTF - interface to the backpack.tf trading service
  77
  78 =head1 SYNOPSIS
  79
  80   use WWW::BackpackTF;
  81   my $api_key = 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx';
  82   my $user_id = <STDIN>;
  83   my $bp = WWW::BackpackTF->new($api_key);
  84   my $user = $bp->get_users($user_id);
  85   print 'This user is named ', $user->name, ' and has ', $user->notifications, ' unread notification(s)';
  86   my @all_items_in_dota2 = $bp->get_prices(WWW::BackpackTF::DOTA2);
  87   my @currencies = $bp->get_currencies;
  88   print 'The first currency is ', $currencies[0]->name;
  89
  90 =head1 DESCRIPTION
  91
  92 WWW::BackpackTF is an interface to the backpack.tf Team Fortress 2/Dota 2 trading service.
  93
  94 =head2 METHODS
  95
  96 =over
  97
  98 =item B<new>([key => I<$api_key>], [base => I<$base_url>])
  99
 100 Create a new WWW::BackpackTF object. Takes a hash of parameters. Possible parameters:
 101
 102 =over
 103
 104 =item B<key>
 105
 106 The API key. Defaults to nothing. Most methods require an API key.
 107
 108 =item B<base>
 109
 110 The base URL. Defaults to http://backpack.tf/api/.
 111
 112 =back
 113
 114 =item B<get_prices>([I<$appid>, [I<$raw>]])
 115
 116 Get price information for all items. Takes two optional parameters. The first parameter is the appid and defaults to WWW::BackpackTF::TF2. The second (if true) adds a value_raw property to prices and defaults to false. Returns a list of L<WWW::BackpackTF::Item> objects.
 117
 118 =item B<get_users>(I<@users>)
 119
 120 Get profile information for a list of users. Takes any number of 64-bit Steam IDs as arguments and returns a list of L<WWW::BackpackTF::User> objects. This method does not require an API key. Dies with an error message if the operation is unsuccessful.
 121
 122 =item B<get_currencies>([I<$appid>])
 123
 124 Get currency information. Takes one optional parameter, the appid, which defaults to WWW::BackpackTF::TF2. Returns a list of L<WWW::BackpackTF::Currency> objects.
 125
 126 =back
 127
 128 =head2 EXPORTS
 129
 130 None by default.
 131
 132 =over
 133
 134 =item B<TF2>
 135
 136 Constant (440) representing Team Fortress 2.
 137
 138 =item B<DOTA2>
 139
 140 Constant (570) representing Dota 2.
 141
 142 =item B<NORMAL>
 143
 144 The Normal item quality (0).
 145
 146 =item B<GENUINE>
 147
 148 The Genuine item quality (1).
 149
 150 =item B<RARITY2>
 151
 152 The unused rarity2 item quality (2).
 153
 154 =item B<VINTAGE>
 155
 156 The Vintage item quality (3).
 157
 158 =item B<RARITY3>
 159
 160 The unused rarity3 item quality (4).
 161
 162 =item B<UNUSUAL>
 163
 164 The Unusual item quality (5).
 165
 166 =item B<UNIQUE>
 167
 168 The Unique item quality (6).
 169
 170 =item B<COMMUNITY>
 171
 172 The Community item quality (7).
 173
 174 =item B<VALVE>
 175
 176 The Valve item quality (8).
 177
 178 =item B<SELFMADE>
 179
 180 The Self-Made item quality (9).
 181
 182 =item B<CUSTOMIZED>
 183
 184 The unused Customized item quality (10).
 185
 186 =item B<STRANGE>
 187
 188 The Strange item quality (11).
 189
 190 =item B<COMPLETED>
 191
 192 The Completed item quality (12).
 193
 194 =item B<HAUNTED>
 195
 196 The Haunted item quality (13).
 197
 198 =item B<COLLECTORS>
 199
 200 The Collector's item quality (14).
 201
 202 =back
 203
 204 =head1 SEE ALSO
 205
 206 L<http://backpack.tf/>, L<http://backpack.tf/api>
 207
 208 =head1 AUTHOR
 209
 210 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
 211
 212 =head1 COPYRIGHT AND LICENSE
 213
 214 Copyright (C) 2014 by Marius Gavrilescu
 215
 216 This library is free software; you can redistribute it and/or modify
 217 it under the same terms as Perl itself, either Perl version 5.18.2 or,
 218 at your option, any later version of Perl 5 you may have available.
 219
 220
 221 =cut