From: Marius Gavrilescu Date: Sat, 21 Jun 2014 23:14:11 +0000 (+0300) Subject: Add IGetPrices and IGetCurrencies calls X-Git-Tag: 0.000_002~4 X-Git-Url: http://git.ieval.ro/?a=commitdiff_plain;h=011cd8b54a2bac28ce3a83f8b3afcab3b93677f3;p=www-backpacktf.git Add IGetPrices and IGetCurrencies calls --- diff --git a/lib/WWW/BackpackTF.pm b/lib/WWW/BackpackTF.pm index 49e6b3a..448ebbb 100644 --- a/lib/WWW/BackpackTF.pm +++ b/lib/WWW/BackpackTF.pm @@ -7,27 +7,63 @@ use parent qw/Exporter/; our $VERSION = '0.000_001'; our @EXPORT_OK = qw/TF2 DOTA2/; -use constant TF2 => 440; -use constant DOTA2 => 570; +use constant +{ + TF2 => 440, + DOTA2 => 570, + QUALITIES => [qw/Normal Genuine rarity2 Vintage rarity3 Unusual Unique Community Valve Self-Made Customized Strange Completed Haunted Collector's/], +}; + +BEGIN { + my @qualities = @{QUALITIES()}; + for (0 .. $#qualities) { + my $name = uc $qualities[$_]; + $name =~ y/A-Z0-9//cd; + constant->import($name, $_) + } +} use JSON qw/decode_json/; use LWP::Simple qw/get/; +use PerlX::Maybe; +use WWW::BackpackTF::Currency; +use WWW::BackpackTF::Item; use WWW::BackpackTF::User; +sub request { + my ($self, $url, %params) = @_; + $params{key} = $self->{key}; + $url = $self->{base} . $url; + $url .= "&$_=$params{$_}" for keys %params; + my $response = decode_json(get $url)->{response}; + die $response->{message} unless $response->{success}; + $response +} + sub new{ - my ($class, $key) = @_; - bless {key => $key}, $class + my ($class, %args) = @_; + $args{base} //= 'http://backpack.tf/api/'; + bless \%args, $class +} + +sub get_prices { + my ($self, $appid, $raw) = @_; + my $response = $self->request('IGetPrices/v4/?compress=1', maybe appid => $appid, maybe raw => $raw); + map { WWW::BackpackTF::Item->new($_, $response->{items}{$_}) } keys $response->{items} } -sub get_users{ +sub get_users { my ($self, @users) = @_; - my $response = decode_json get "http://backpack.tf/api/IGetUsers/v3/?compress=1&format=json&steamids=" . join ',', @users; - $response = $response->{response}; - die $response->{message} unless $response->{success}; + my $response = $self->request('IGetUsers/v3/?compress=1', steamids => join ',', @users); @users = map { WWW::BackpackTF::User->new($_) } values $response->{players}; wantarray ? @users : $users[0] } +sub get_currencies { + my ($self, $appid) = @_; + my $response = $self->request('IGetCurrencies/v1/?compress=1', maybe appid => $appid); + map { WWW::BackpackTF::Currency->new($_, $response->{currencies}{$_}) } keys $response->{currencies}; +} + 1; __END__ @@ -43,13 +79,14 @@ WWW::BackpackTF - interface to the backpack.tf trading service my $bp = WWW::BackpackTF->new($api_key); my $user = $bp->get_users($user_id); print 'This user is named ', $user->name, ' and has ', $user->notifications, ' unread notification(s)'; + my @all_items_in_dota2 = $bp->get_prices(WWW::BackpackTF::DOTA2); + my @currencies = $bp->get_currencies; + print 'The first currency is ', $currencies[0]->name; =head1 DESCRIPTION WWW::BackpackTF is an interface to the backpack.tf Team Fortress 2/Dota 2 trading service. -The only call implemented so far is I. - =head2 METHODS =over @@ -58,9 +95,17 @@ The only call implemented so far is I. Create a new WWW::BackpackTF object. Takes a single optional parameter, the API key. +=item B([I<$appid>, [I<$raw>]]) + +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 objects. + =item B(I<@users>) -Get profile information for a list of users. Takes any number of 64-bit Steam IDs as arguments and returns a list of WWW::BackpackTF::User objects. This method does not require an API key. +Get profile information for a list of users. Takes any number of 64-bit Steam IDs as arguments and returns a list of L objects. This method does not require an API key. Dies with an error message if the operation is unsuccessful. + +=item B([I<$appid>]) + +Get currency information. Takes one optional parameter, the appid, which defaults to WWW::BackpackTF::TF2. Returns a list of L objects. =back @@ -78,6 +123,66 @@ Constant (440) representing Team Fortress 2. Constant (570) representing Dota 2. +=item B + +The Normal item quality (0). + +=item B + +The Genuine item quality (1). + +=item B + +The unused rarity2 item quality (2). + +=item B + +The Vintage item quality (3). + +=item B + +The unused rarity3 item quality (4). + +=item B + +The Unusual item quality (5). + +=item B + +The Unique item quality (6). + +=item B + +The Community item quality (7). + +=item B + +The Valve item quality (8). + +=item B + +The Self-Made item quality (9). + +=item B + +The unused Customized item quality (10). + +=item B + +The Strange item quality (11). + +=item B + +The Completed item quality (12). + +=item B + +The Haunted item quality (13). + +=item B + +The Collector's item quality (14). + =back =head1 SEE ALSO diff --git a/lib/WWW/BackpackTF/Currency.pm b/lib/WWW/BackpackTF/Currency.pm new file mode 100644 index 0000000..2b731c9 --- /dev/null +++ b/lib/WWW/BackpackTF/Currency.pm @@ -0,0 +1,129 @@ +package WWW::BackpackTF::Currency; + +use 5.014000; +use strict; +use warnings; +our $VERSION = '0.000_001'; + +sub new{ + my ($class, $name, $content) = @_; + $content->{name} = $name; + bless $content, $class +} + +sub name { shift->{name} } +sub quality { shift->{quality} } +sub priceindex { shift->{priceindex}} +sub single { shift->{single} } +sub plural { shift->{plural} } +sub round { shift->{round} } +sub craftable { shift->{craftable} eq 'Craftable' } +sub tradable { shift->{tradable} eq 'Tradable' } +sub defindex { shift->{defindex} } + +sub quality_name { WWW::BackpackTF::QUALITIES->[shift->{quality}] } +sub stringify { + my ($self, $nr) = @_; + my $round = $self->round; + $nr = sprintf "%.${round}f", $nr; + my $suf = $nr == 1 ? $self->single : $self->plural; + "$nr $suf"; +} + +1; +__END__ + +=encoding utf-8 + +=head1 NAME + +WWW::BackpackTF::Currency - Class representing currency information + +=head1 SYNOPSIS + + my @currencies = $bp->get_currencies; + my $currency = $currencies[0]; + say 'Name: ', $currency->name; + say 'Quality (number): ', $currency->quality; + say 'Quality (human-readable): ', $currency->quality_name; + say 'Priceindex: ', $currency->priceindex; + say 'Craftable: ', ($currency->craftable ? 'YES' : 'NO'); + say 'Tradable: ', ($currency->tradable ? 'YES' : 'NO'); + say 'Singular form: ', $currency->single; + say 'Plural form: ', $currency->plural; + say 'Round to this many decimal places: ', $currency->round; + say 'Defindex: ', $currency->defindex; + say '3.15271 units of this currency is: ', $currency->stringify(3.15271); # example return values: "3.15 keys", "3.15 ref", "3.15 buds" + +=head1 DESCRIPTION + +WWW::BackpackTF::Currency is a class representing information about a currency. + +=head2 METHODS + +=over + +=item B + +The name of the currency. + +=item B + +The quality integer of the currency. Usually 6 (corresponding to the Unique quality). + +=item B + +The quality of the currency as a human-readable string. Usually 'Unique'. + +=item B + +The priceindex of a currency. Indicates a crate series or unusual effect. Usually 0. + +=item B + +True if the currency is craftable, false otherwise. Usually true. + +=item B + +True if the currency is tradable, false otherwise. Usually true. + +=item B + +The singular form of the currency. + +=item B + +The plural form of the currency. + +=item B + +The number of decimal places this currency should be rounded to. + +=item B + +The definition index of the currency. + +=item B(I<$count>) + +Rounds I<$count> to the number of decimal places returned by B, then appends a space and the correct singular/plural form of the currency. + +=back + +=head1 SEE ALSO + +L + +=head1 AUTHOR + +Marius Gavrilescu, Emarius@ieval.roE + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2014 by Marius Gavrilescu + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself, either Perl version 5.18.2 or, +at your option, any later version of Perl 5 you may have available. + + +=cut diff --git a/lib/WWW/BackpackTF/Item.pm b/lib/WWW/BackpackTF/Item.pm new file mode 100644 index 0000000..885c333 --- /dev/null +++ b/lib/WWW/BackpackTF/Item.pm @@ -0,0 +1,117 @@ +package WWW::BackpackTF::Item; + +use 5.014000; +use strict; +use warnings; +our $VERSION = '0.000_001'; + +sub new{ + my ($class, $name, $content) = @_; + $content->{name} = $name; + bless $content, $class +} + +sub name { shift->{name} } +sub defindex { wantarray ? @{shift->{defindex}} : shift->{defindex}->[0] } +sub price { + my ($self, $quality, $tradable, $craftable, $priceindex) = (@_, 6, 1, 1); + $tradable = $tradable ? 'Tradable' : 'Non-Tradable'; + $craftable = $craftable ? 'Craftable' : 'Non-Craftable'; + my $price = shift->{prices}->{$quality}->{$tradable}->{$craftable}; + defined $priceindex ? $price->{$priceindex} : $price->[0] +} + +1; +__END__ + +=encoding utf-8 + +=head1 NAME + +WWW::BackpackTF::Item - Class representing item information + +=head1 SYNOPSIS + + use WWW::BackpackTF qw/VINTAGE GENUINE UNUSUAL/; + use Data::Dumper qw/Dumper/; + + my @items = $bp->get_prices; + my $item = $items[0]; + say 'Name: ', $item->name; + say 'Linked defindexes: ', join ' ', $item->defindex; + say 'Price of Unique, Tradable, Craftable version: ', $item->price; + say 'Price of Vintage, Tradable, Craftable version: ', Dumper $item->price(VINTAGE); + say 'Price of Vintage, Non-Tradable, Craftable version: ', Dumper $item->price(VINTAGE, 0); + say 'Price of Genuine, Non-Tradable, Non-Craftable version: ', Dumper $item->price(GENUINE, 0, 0); + say 'Price of Unusual, Tradable, Craftable version with effect 10: ', Dumper $item->price(UNUSUAL, 1, 1, 10); + +=head1 DESCRIPTION + +WWW::BackpackTF::Item is a class representing price information about an item. + +=head2 METHODS + +=over + +=item B + +The name of the item. + +=item B + +In list context, a list of defindexes linked to the item. In scalar context, the first such defindex. + +=item B([I<$quality>, [I<$tradable>, [I<$craftable>, [I<$priceindex>]]]]) + +The price of an item. Takes four optional arguments: the quality (defaults to 6, which is Unique), the tradability of the item (defaults to true), the craftability of an item (defaults to true), and the priceindex (crate series/unusual effect, defaults to none). + +Returns an hashref with the following keys/values: + +=over + +=item B + +The currency the item's price is in. + +=item B + +The price. + +=item B + +If present, the upper range of the price range. + +=item B + +The price in the lowest currency, without rounding. Only present if get_prices was called with a true value for $raw. + +=item B + +Timestamp of last price update. + +=item B + +The difference bitween the former price and the current price. 0 if the current price is new. + +=back + +=back + +=head1 SEE ALSO + +L + +=head1 AUTHOR + +Marius Gavrilescu, Emarius@ieval.roE + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2014 by Marius Gavrilescu + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself, either Perl version 5.18.2 or, +at your option, any later version of Perl 5 you may have available. + + +=cut diff --git a/lib/WWW/BackpackTF/User.pm b/lib/WWW/BackpackTF/User.pm index 6120ba4..fb943a8 100644 --- a/lib/WWW/BackpackTF/User.pm +++ b/lib/WWW/BackpackTF/User.pm @@ -131,6 +131,10 @@ Returns the UNIX timestamp of this user's last backpack update for the specified =back +=head1 SEE ALSO + +L + =head1 AUTHOR Marius Gavrilescu, Emarius@ieval.roE