]> iEval git - www-backpacktf.git/commitdiff
Add IGetPrices and IGetCurrencies calls
authorMarius Gavrilescu <marius@ieval.ro>
Sat, 21 Jun 2014 23:14:11 +0000 (02:14 +0300)
committerMarius Gavrilescu <marius@ieval.ro>
Sat, 21 Jun 2014 23:14:11 +0000 (02:14 +0300)
lib/WWW/BackpackTF.pm
lib/WWW/BackpackTF/Currency.pm [new file with mode: 0644]
lib/WWW/BackpackTF/Item.pm [new file with mode: 0644]
lib/WWW/BackpackTF/User.pm

index 49e6b3a513bd86c5fec2d5da3d475ac85b4de743..448ebbb10b6ed0e61c79c23dcffa3904114ea7e4 100644 (file)
@@ -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<IGetUsers>.
-
 =head2 METHODS
 
 =over
@@ -58,9 +95,17 @@ The only call implemented so far is I<IGetUsers>.
 
 Create a new WWW::BackpackTF object. Takes a single optional parameter, the API key.
 
+=item B<get_prices>([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<WWW::BackpackTF::Item> objects.
+
 =item B<get_users>(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<WWW::BackpackTF::User> objects. This method does not require an API key. Dies with an error message if the operation is unsuccessful.
+
+=item B<get_currencies>([I<$appid>])
+
+Get currency information. Takes one optional parameter, the appid, which defaults to WWW::BackpackTF::TF2. Returns a list of L<WWW::BackpackTF::Currency> objects.
 
 =back
 
@@ -78,6 +123,66 @@ Constant (440) representing Team Fortress 2.
 
 Constant (570) representing Dota 2.
 
+=item B<NORMAL>
+
+The Normal item quality (0).
+
+=item B<GENUINE>
+
+The Genuine item quality (1).
+
+=item B<RARITY2>
+
+The unused rarity2 item quality (2).
+
+=item B<VINTAGE>
+
+The Vintage item quality (3).
+
+=item B<RARITY3>
+
+The unused rarity3 item quality (4).
+
+=item B<UNUSUAL>
+
+The Unusual item quality (5).
+
+=item B<UNIQUE>
+
+The Unique item quality (6).
+
+=item B<COMMUNITY>
+
+The Community item quality (7).
+
+=item B<VALVE>
+
+The Valve item quality (8).
+
+=item B<SELFMADE>
+
+The Self-Made item quality (9).
+
+=item B<CUSTOMIZED>
+
+The unused Customized item quality (10).
+
+=item B<STRANGE>
+
+The Strange item quality (11).
+
+=item B<COMPLETED>
+
+The Completed item quality (12).
+
+=item B<HAUNTED>
+
+The Haunted item quality (13).
+
+=item B<COLLECTORS>
+
+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 (file)
index 0000000..2b731c9
--- /dev/null
@@ -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<name>
+
+The name of the currency.
+
+=item B<quality>
+
+The quality integer of the currency. Usually 6 (corresponding to the Unique quality).
+
+=item B<quality_name>
+
+The quality of the currency as a human-readable string. Usually 'Unique'.
+
+=item B<priceindex>
+
+The priceindex of a currency. Indicates a crate series or unusual effect. Usually 0.
+
+=item B<craftable>
+
+True if the currency is craftable, false otherwise. Usually true.
+
+=item B<tradable>
+
+True if the currency is tradable, false otherwise. Usually true.
+
+=item B<single>
+
+The singular form of the currency.
+
+=item B<plural>
+
+The plural form of the currency.
+
+=item B<round>
+
+The number of decimal places this currency should be rounded to.
+
+=item B<defindex>
+
+The definition index of the currency.
+
+=item B<stringify>(I<$count>)
+
+Rounds I<$count> to the number of decimal places returned by B<round>, then appends a space and the correct singular/plural form of the currency.
+
+=back
+
+=head1 SEE ALSO
+
+L<http://backpack.tf/api/currencies>
+
+=head1 AUTHOR
+
+Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
+
+=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 (file)
index 0000000..885c333
--- /dev/null
@@ -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<name>
+
+The name of the item.
+
+=item B<defindex>
+
+In list context, a list of defindexes linked to the item. In scalar context, the first such defindex.
+
+=item B<price>([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<currency>
+
+The currency the item's price is in.
+
+=item B<value>
+
+The price.
+
+=item B<value_high>
+
+If present, the upper range of the price range.
+
+=item B<value_raw>
+
+The price in the lowest currency, without rounding. Only present if get_prices was called with a true value for $raw.
+
+=item B<last_update>
+
+Timestamp of last price update.
+
+=item B<difference>
+
+The difference bitween the former price and the current price. 0 if the current price is new.
+
+=back
+
+=back
+
+=head1 SEE ALSO
+
+L<http://backpack.tf/api/prices>
+
+=head1 AUTHOR
+
+Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
+
+=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
index 6120ba406ec8298b823ffe1ff425148bedf10cf9..fb943a8bb343c62432705f4d8eee141249d72124 100644 (file)
@@ -131,6 +131,10 @@ Returns the UNIX timestamp of this user's last backpack update for the specified
 
 =back
 
+=head1 SEE ALSO
+
+L<http://backpack.tf/api/users>
+
 =head1 AUTHOR
 
 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
This page took 0.041738 seconds and 4 git commands to generate.