File Coverage

blib/lib/WWW/BackpackTF.pm
Criterion Covered Total %
statement 63 83 75.9
branch 4 8 50.0
condition 1 2 50.0
subroutine 17 21 80.9
pod 6 7 85.7
total 91 121 75.2


line stmt bran cond sub pod time code
1             package WWW::BackpackTF;
2              
3 2     2   58212 use 5.014000;
  2         4  
4 2     2   7 use strict;
  2         3  
  2         53  
5 2     2   8 use warnings;
  2         7  
  2         61  
6 2     2   1736 use parent qw/Exporter/;
  2         560  
  2         11  
7             our $VERSION = '0.002';
8             our @EXPORT_OK = qw/TF2 DOTA2 CSGO/;
9              
10             use constant +{ ## no critic (Capitalization)
11 2         370 TF2 => 440,
12             DOTA2 => 570,
13             CSGO => 730,
14             QUALITIES => [qw/Normal Genuine rarity2 Vintage rarity3 Unusual Unique Community Valve Self-Made Customized Strange Completed Haunted Collector's/],
15 2     2   172 };
  2         2  
16              
17             BEGIN {
18 2     2   4 my @qualities = @{QUALITIES()};
  2         7  
19 2         7 for (0 .. $#qualities) {
20 30         40 my $name = uc $qualities[$_];
21 30         32 $name =~ y/A-Z0-9//cd;
22 30         30 push @EXPORT_OK, $name;
23 30         523 constant->import($name, $_)
24             }
25             }
26              
27 2     2   1182 use JSON::MaybeXS qw/decode_json/;
  2         14465  
  2         116  
28 2     2   1434 use HTTP::Tiny;
  2         78910  
  2         111  
29 2     2   1052 use PerlX::Maybe;
  2         2808  
  2         95  
30 2     2   667 use WWW::BackpackTF::Currency;
  2         2  
  2         41  
31 2     2   613 use WWW::BackpackTF::Item;
  2         2  
  2         42  
32 2     2   608 use WWW::BackpackTF::MarketItem;
  2         4  
  2         42  
33 2     2   627 use WWW::BackpackTF::Listing;
  2         3  
  2         39  
34 2     2   640 use WWW::BackpackTF::User;
  2         2  
  2         959  
35              
36             my $ht = HTTP::Tiny->new(agent => "WWW-BackpackTF/$VERSION");
37              
38             sub request {
39 1     1 0 4 my ($self, $url, %params) = @_;
40 1 50       11 $params{key} = $self->{key} if $self->{key};
41 1         5 $url = $self->{base} . $url;
42 1         10 $url .= "&$_=$params{$_}" for keys %params;
43 1         40 my $htr = $ht->get($url);
44 1 50       383483 die $htr->{reason} unless $htr->{success}; ## no critic (RequireCarping)
45 1         38 my $response = decode_json($htr->{content})->{response};
46 1 50       4 die $response->{message} unless $response->{success}; ## no critic (RequireCarping)
47 1         7 $response
48             }
49              
50             sub new{
51 1     1 1 13 my ($class, %args) = @_;
52 1   50     8 $args{base} //= 'http://backpack.tf/api/';
53 1         4 bless \%args, $class
54             }
55              
56             sub get_prices {
57 0     0 1 0 my ($self, $appid, $raw) = @_;
58 0         0 my $response = $self->request('IGetPrices/v4/?compress=1', maybe appid => $appid, maybe raw => $raw);
59 0         0 map { WWW::BackpackTF::Item->new($_, $response->{items}{$_}) } keys %{$response->{items}}
  0         0  
  0         0  
60             }
61              
62             sub get_users {
63 1     1 1 6 my ($self, @users) = @_;
64 1         9 my $response = $self->request('IGetUsers/v3/?compress=1', steamids => join ',', @users);
65 1         3 @users = map { WWW::BackpackTF::User->new($_) } values %{$response->{players}};
  1         11  
  1         4  
66 1 50       7 wantarray ? @users : $users[0]
67             }
68              
69             sub get_currencies {
70 0     0 1   my ($self, $appid) = @_;
71 0           my $response = $self->request('IGetCurrencies/v1/?compress=1', maybe appid => $appid);
72 0           map { WWW::BackpackTF::Currency->new($_, $response->{currencies}{$_}) } keys %{$response->{currencies}};
  0            
  0            
73             }
74              
75             # get_price_history not implemented
76             # get_special_items not implemented
77              
78             sub get_market_prices {
79 0     0 1   my ($self, $appid) = @_;
80 0           my $response = $self->request('IGetMarketPrices/v1/?compress=1', maybe appid => $appid);
81 0           map { WWW::BackpackTF::MarketItem->new($_, $response->{items}{$_}) } keys %{$response->{items}}
  0            
  0            
82             }
83              
84             sub get_user_listings {
85 0     0 1   my ($self, $steamid, $appid) = @_;
86 0           my $response = $self->request('IGetUserListings/v2/?compress=1', steamid => $steamid, maybe appid => $appid);
87 0           map { WWW::BackpackTF::Listing->new($_) } @{$response->{listings}}
  0            
  0            
88             }
89              
90             1;
91             __END__