@@ -1,5 +1,11 @@
Revision history for Transmission-Client
+0.07 Sat Jul 20 00:40:58 2013
+ - Fix test failures due to hash randomization (RT #81561)
+ Merge pull request #3 from afresh1/master
+ - Make fields parameter to read_torrents overrideable
+ Merge pull request #5 from olof/topic/override_fields
+
0.0603 Mon May 7 19:29:53 2012
- Use correct var when adding torrent
Reference: https://rt.cpan.org/Ticket/Display.html?id=76859
@@ -1,32 +0,0 @@
-bin/transmission-client.pl
-Changes
-inc/Module/AutoInstall.pm
-inc/Module/Install.pm
-inc/Module/Install/AutoInstall.pm
-inc/Module/Install/Base.pm
-inc/Module/Install/Can.pm
-inc/Module/Install/Fetch.pm
-inc/Module/Install/Include.pm
-inc/Module/Install/Makefile.pm
-inc/Module/Install/Metadata.pm
-inc/Module/Install/Win32.pm
-inc/Module/Install/WriteAll.pm
-lib/Transmission/AttributeRole.pm
-lib/Transmission/Client.pm
-lib/Transmission/Session.pm
-lib/Transmission/Stats.pm
-lib/Transmission/Torrent.pm
-lib/Transmission/Torrent/File.pm
-lib/Transmission/Types.pm
-lib/Transmission/Utils.pm
-Makefile.PL
-MANIFEST This list of files
-MANIFEST.skip
-META.yml
-README
-t/00-load.t
-t/00-pod-coverage.t
-t/00-pod.t
-t/05-utils.t
-t/10-client.t
-t/20-real.t
@@ -1,9 +0,0 @@
-^mypp.yml
-.git
-\.old
-\.swp
-~$
-^blib/
-^Makefile$
-^MANIFEST.*
-^Transmission-Client
@@ -1,7 +1,7 @@
---
abstract: 'Interface to Transmission'
author:
- - 'Jan Henning Thorsen'
+ - 'Jan Henning Thorsen - C<jhthorsen@cpan.org>'
build_requires:
ExtUtils::MakeMaker: 6.36
Test::More: 0
@@ -24,10 +24,11 @@ requires:
JSON: 2.02
JSON::Any: 1.2
LWP::UserAgent: 5.8
+ List::MoreUtils: 0
MIME::Base64: 3
Moose: 0.8
MooseX::Types: 0.2
Sub::Exporter: 0.95
resources:
license: http://dev.perl.org/licenses/
-version: 0.0603
+version: 0.07
@@ -0,0 +1,55 @@
+{
+ "abstract" : "Interface to Transmission",
+ "author" : [
+ "Jan Henning Thorsen - C<jhthorsen@cpan.org>"
+ ],
+ "dynamic_config" : 0,
+ "generated_by" : "Module::Install version 1.06, CPAN::Meta::Converter version 2.131560",
+ "license" : [
+ "perl_5"
+ ],
+ "meta-spec" : {
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+ "version" : "2"
+ },
+ "name" : "Transmission-Client",
+ "no_index" : {
+ "directory" : [
+ "inc",
+ "t"
+ ]
+ },
+ "prereqs" : {
+ "build" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "6.36",
+ "Test::More" : "0"
+ }
+ },
+ "configure" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "6.36"
+ }
+ },
+ "runtime" : {
+ "requires" : {
+ "DateTime" : "0.5",
+ "JSON" : "2.02",
+ "JSON::Any" : "1.2",
+ "LWP::UserAgent" : "5.8",
+ "List::MoreUtils" : "0",
+ "MIME::Base64" : "3",
+ "Moose" : "0.8",
+ "MooseX::Types" : "0.2",
+ "Sub::Exporter" : "0.95"
+ }
+ }
+ },
+ "release_status" : "stable",
+ "resources" : {
+ "license" : [
+ "http://dev.perl.org/licenses/"
+ ]
+ },
+ "version" : "0.0603"
+}
@@ -0,0 +1,33 @@
+---
+abstract: 'Interface to Transmission'
+author:
+ - 'Jan Henning Thorsen - C<jhthorsen@cpan.org>'
+build_requires:
+ ExtUtils::MakeMaker: 6.36
+ Test::More: 0
+configure_requires:
+ ExtUtils::MakeMaker: 6.36
+dynamic_config: 0
+generated_by: 'Module::Install version 1.06, CPAN::Meta::Converter version 2.131560'
+license: perl
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
+name: Transmission-Client
+no_index:
+ directory:
+ - inc
+ - t
+requires:
+ DateTime: 0.5
+ JSON: 2.02
+ JSON::Any: 1.2
+ LWP::UserAgent: 5.8
+ List::MoreUtils: 0
+ MIME::Base64: 3
+ Moose: 0.8
+ MooseX::Types: 0.2
+ Sub::Exporter: 0.95
+resources:
+ license: http://dev.perl.org/licenses/
+version: 0.0603
@@ -28,6 +28,7 @@ requires q(MIME::Base64) => 3.00;
requires q(Moose) => 0.80;
requires q(MooseX::Types) => 0.20;
requires q(Sub::Exporter) => 0.95;
+requires q(List::MoreUtils) => 0;
test_requires q(Test::More) => 0;
@@ -2,7 +2,7 @@ NAME
Transmission::Client - Interface to Transmission
VERSION
- 0.0603
+ 0.07
DESCRIPTION
Transmission::Client is the main module in a collection of modules to
@@ -72,7 +72,7 @@ ATTRIBUTES
$str = $self->error;
Returns the last error known to the object. All methods can return empty
- list in addtion to what spesified. Check this attribute if so happens.
+ list in addition to what specified. Check this attribute if so happens.
Like "autodie"? Create your object with "autodie" set to true and this
module will throw exceptions in addition to setting this variable.
@@ -218,5 +218,5 @@ LICENSE
under the same terms as Perl itself.
AUTHOR
- Jan Henning Thorsen
+ Jan Henning Thorsen - "jhthorsen@cpan.org"
@@ -63,31 +63,38 @@ has eager_read => (
);
# this method name exists to prove a point - not to be readable...
-sub _camel2Normal {
+sub _convert {
if(ref $_[1] eq 'HASH') {
for my $camel (keys %{ $_[1] }) {
- my $key = __PACKAGE__->_camel2Normal($camel);
+ my $key = $_[2]->($camel);
if(ref $_[1]->{$camel} eq 'HASH') {
- __PACKAGE__->_camel2Normal($_[1]->{$camel});
+ __PACKAGE__->_convert($_[1]->{$camel}, $_[2]);
}
$_[1]->{$key} = delete $_[1]->{$camel};
}
}
else {
- local $_ = $_[1];
+ return $_[2]->($_[1]);
+ }
+}
+
+sub _camel2Normal {
+ $_[0]->_convert( $_[1], sub {
+ local $_ = $_[0];
tr/-/_/;
s/([A-Z]+)/{ "_" .lc($1) }/ge;
return $_;
- }
+ } );
}
-
sub _normal2Camel {
- local $_ = $_[1];
- tr/_/-/;
- s/_(\w)/{ uc($1) }/ge; # wild guess...
- return $_;
+ $_[0]->_convert( $_[1], sub {
+ local $_ = $_[0];
+ tr/_/-/;
+ s/_(\w)/{ uc($1) }/ge; # wild guess...
+ return $_;
+ } );
}
=head1 LICENSE
@@ -6,7 +6,7 @@ Transmission::Client - Interface to Transmission
=head1 VERSION
-0.0603
+0.07
=head1 DESCRIPTION
@@ -83,7 +83,7 @@ use Transmission::Torrent;
use Transmission::Session;
use constant RPC_DEBUG => $ENV{'TC_RPC_DEBUG'};
-our $VERSION = eval '0.0603';
+our $VERSION = '0.07';
our $SESSION_ID_HEADER_NAME = 'X-Transmission-Session-Id';
my $JSON = JSON::Any->new;
@@ -130,7 +130,7 @@ sub _build__url {
$str = $self->error;
Returns the last error known to the object. All methods can return
-empty list in addtion to what spesified. Check this attribute if so happens.
+empty list in addition to what specified. Check this attribute if so happens.
Like L</autodie>? Create your object with C<autodie> set to true and this
module will throw exceptions in addition to setting this variable.
@@ -476,11 +476,16 @@ sub read_torrents {
my %args = @_ == 1 ? (ids => $_[0]) : @_;
my $list;
- # set fields
- if($args{'lazy_read'}) {
+ # set fields...
+ if(exists $args{'fields'}) { # ... based on user input
+ # We should always request id
+ push @{$args{'fields'}}, 'id' unless
+ grep {'id' eq $_} @{$args{'fields'}};
+ }
+ elsif($args{'lazy_read'}) { # ... as few fields as possible
$args{'fields'} = ['id'];
}
- else {
+ else { # ... all fields
$args{'fields'} = [
keys %Transmission::Torrent::READ,
keys %Transmission::Torrent::BOTH,
@@ -538,6 +543,10 @@ sub rpc {
$method = $self->_normal2Camel($method);
+ # The keys need to be dashes as well
+ # _normal2Camel modifies a hashref in places
+ $self->_normal2Camel( \%args );
+
# make sure ids are numeric
if(ref $args{'ids'} eq 'ARRAY') {
for my $id (@{ $args{'ids'} }) {
@@ -618,10 +627,12 @@ the same terms as Perl itself.
=head1 AUTHOR
-Jan Henning Thorsen
+Jan Henning Thorsen - C<jhthorsen@cpan.org>
=cut
no MIME::Base64;
no Moose;
1;
+oose;
+1;
@@ -18,6 +18,7 @@ L<Transmission::AttributeRole>
=cut
use Moose;
+use List::MoreUtils qw(uniq);
use Transmission::Torrent::File;
use Transmission::Types ':all';
@@ -465,14 +466,15 @@ BEGIN {
);
}
- __PACKAGE__->meta->add_method(read_all => sub {
+ __PACKAGE__->meta->add_method(read => sub {
my $self = shift;
+ my @fields = uniq(@_, 'id'); # id should always be requested
my $lazy = $self->lazy_write;
my $data;
$data = $self->client->rpc('torrent-get' =>
ids => [ $self->id ],
- fields => [ keys %BOTH, keys %READ ],
+ fields => [ @fields ],
) or return;
$data = $data->{'torrents'}[0] or return;
@@ -493,6 +495,11 @@ BEGIN {
return 1;
});
+ __PACKAGE__->meta->add_method(read_all => sub {
+ my $self = shift;
+ return $self->read(keys %BOTH, keys %READ);
+ });
+
$READ{'id'} = 'Int'; # this is required to be read
}
@@ -561,12 +568,18 @@ sub BUILDARGS {
return $args;
}
+=head2 read
+
+ $bool = $self->read('id', 'name', 'eta');
+
+This method will refresh all requested attributes in one RPC request, while
+calling one and one attribute, results in one-and-one request.
+
=head2 read_all
$bool = $self->read_all;
-This method will refresh all attributes in one RPC request, while calling one
-and one attribute, results in one-and-one request.
+Similar to L</read>, but requests all attributes.
=head2 start
@@ -632,6 +645,9 @@ sub write_wanted {
}
for my $key (qw/wanted unwanted/) {
+ # Transmission interpret an empty list to mean all files
+ next unless @{$wanted{$key}};
+
$self->client->rpc('torrent-set' =>
ids => [ $self->id ], "files-$key" => $wanted{$key}
) or return;
@@ -3,11 +3,10 @@ use strict;
use lib qw(lib);
use Test::More;
use Transmission::Client;
+use JSON;
$SIG{'__DIE__'} = \&Carp::confess;
-plan tests => 42;
-
my($client, $rpc_response, $rpc_request, @torrents);
my $rpc_response_code = 409;
@@ -62,10 +61,22 @@ my $rpc_response_code = 409;
$rpc_response = '{ "tag": TAG, "result": "success", "arguments": 1 }';
ok($client->add(filename => 'foo.torrent'), 'add() torrent by filename');
- request_has(filename => "foo.torrent", method => "torrent-add", 'add() with filename');
-
+ request_has(
+ arguments => {
+ filename => "foo.torrent",
+ },
+ method => "torrent-add",
+
+ 'add() with filename');
+
ok($client->add(metainfo => {}), 'add() torrent with metainfo');
- request_has(metainfo => undef, method => "torrent-add", 'add() with metainfo');
+ request_has(
+ arguments => {
+ metainfo => undef,
+ },
+ method => "torrent-add",
+
+ 'add() with metainfo');
}
{ # remove, move, start, stop, verify / _do_ids_action()
@@ -86,16 +97,41 @@ my $rpc_response_code = 409;
like($@, qr{location argument is required}, 'move() require "location"');
ok($client->move(location => '/some/path', ids => 42), 'move() with location and ids');
- request_has(method => "torrent-set-location", location => '/some/path', ids => '\[42\]', 'move() does rpc method torrent-set-location');
+ request_has(
+ method => "torrent-set-location",
+ arguments => {
+ location => '/some/path',
+ ids => [42],
+ },
+
+ 'move() does rpc method torrent-set-location');
ok($client->start(ids => 42), 'start() with location and ids');
- request_has(method => "torrent-start", ids => '\[42\]', 'start() does rpc method torrent-start');
+ request_has(
+ method => "torrent-start",
+ arguments => {
+ ids => [42],
+ },
+
+ 'start() does rpc method torrent-start');
ok($client->stop(ids => 42), 'stop() with location and ids');
- request_has(method => "torrent-stop", ids => '\[42\]', 'stop() does rpc method torrent-stop');
+ request_has(
+ method => "torrent-stop",
+ arguments => {
+ ids => [42],
+ },
+
+ 'stop() does rpc method torrent-stop');
ok($client->verify(ids => 42), 'verify() with location and ids');
- request_has(method => "torrent-verify", ids => '\[42\]', 'verify() does rpc method torrent-verify');
+ request_has(
+ method => "torrent-verify",
+ arguments => {
+ ids => [42],
+ },
+
+ 'verify() does rpc method torrent-verify');
}
{
@@ -108,21 +144,51 @@ my $rpc_response_code = 409;
$client->read_torrents;
request_has(
method => 'torrent-get',
- fields => '\["creator","uploadRatio","leechers","sizeWhenDone","recheckProgress","maxConnectedPeers","activityDate","id","swarmSpeed","peersConnected","pieceCount","torrentFile","name","isPrivate","webseedsSendingToUs","timesCompleted","addedDate","downloadedEver","downloaders","peersKnown","seeders","downloadDir","startDate","desiredAvailable","status","peersSendingToUs","peersGettingFromUs","rateDownload","corruptEver","leftUntilDone","uploadedEver","error","rateUpload","manualAnnounceTime","doneDate","totalSize","dateCreated","pieceSize","percentDone","errorString","haveValid","hashString","eta","haveUnchecked","comment","uploadLimit","downloadLimit","seedRatioMode","bandwidthPriority","downloadLimited","seedRatioLimit","uploadLimited","honorsSessionLimits"\]',
+ arguments => {
+ fields => [qw(
+ creator uploadRatio leechers sizeWhenDone recheckProgress
+ maxConnectedPeers activityDate id swarmSpeed peersConnected
+ pieceCount torrentFile name isPrivate webseedsSendingToUs
+ timesCompleted addedDate downloadedEver downloaders peersKnown
+ seeders downloadDir startDate desiredAvailable status
+ peersSendingToUs peersGettingFromUs rateDownload corruptEver
+ leftUntilDone uploadedEver error rateUpload manualAnnounceTime
+ doneDate totalSize dateCreated pieceSize percentDone errorString
+ haveValid hashString eta haveUnchecked comment uploadLimit
+ downloadLimit seedRatioMode bandwidthPriority downloadLimited
+ seedRatioLimit uploadLimited honorsSessionLimits)]
+ },
+
'read_torrents() with all fields',
);
+ $client->read_torrents(fields => [qw(name eta)]);
+ request_has(
+ method => 'torrent-get',
+ arguments => {
+ fields => [qw(id name eta)],
+ },
+
+ 'read_torrents() with only specific fields',
+ );
+
$client->read_torrents(lazy_read => 1);
request_has(
method => 'torrent-get',
- fields => '\["id"\]',
+ arguments => {
+ fields => ["id"],
+ },
+
'read_torrents() with lazy_read',
);
$client->read_torrents(ids => 42);
request_has(
method => 'torrent-get',
- ids => '\[42\]',
+ arguments => {
+ ids => [42],
+ },
+
'read_torrents() with ids',
);
}
@@ -141,27 +207,62 @@ TODO: {
sub request_has {
my $description = pop;
- my @args = @_;
+ my %args = @_;
my @failed;
- unless($rpc_request =~ /"arguments":{/) {
- push @failed, '"arguments" missing';
- }
-
- while(@args) {
- my $key = shift @args;
- my $value = shift @args or last;
-
- unless($rpc_request =~ /"arguments":{.*?"$key":/) {
- push @failed, qq["$key" missing];
+ note $description;
+
+ # $rpc_request is set to the latest post request the test would have done
+ my $rpc_req = decode_json($rpc_request);
+
+ # All requests must have a method parameter
+ ok exists $rpc_req->{method}, 'Existance of methods key';
+
+ for my $top (keys %args) {
+ if (ref $args{$top}) {
+ for my $key (keys %{$args{$top}}) {
+ if (not defined $args{$top}->{$key}) {
+ ok exists $rpc_req->{$top}->{$key},
+ "Existance of $top\->{$key}";
+ next;
+ }
+
+ if (not ref $rpc_req->{$top}->{$key} and
+ not ref $args{$top}->{$key}) {
+ is $rpc_req->{$top}->{$key}, $args{$top}->{$key},
+ "Comparing value for $top\->{$key}";
+ next;
+ }
+
+ is ref $rpc_req->{$top}->{$key}, 'ARRAY',
+ "$top\->{$key} should be an array";
+
+ SKIP: {
+ skip "See previous test failure",
+ @{$args{$top}->{$key}} + 1 unless
+ ref $rpc_req->{$top}->{$key} eq 'ARRAY';
+
+ # Make sure all expected values exist
+ my %seen;
+ for my $elm (@{$args{$top}->{$key}}) {
+ ok(
+ grep({$elm eq $_} @{$rpc_req->{$top}->{$key}}),
+ "$top\->{$key} should have expected values ($elm)");
+ $seen{$elm} = 1;
+ }
+
+ # Make sure no unexpected values exist
+ is_deeply [
+ grep {! exists $seen{$_}} @{$rpc_req->{$top}->{$key}},
+ ], [], "No unexpected elements found in $top\->{$key}";
+
+ }
+ }
}
- unless(defined $value) {
- next;
+ else {
+ is $rpc_req->{$top}, $args{$top}, "Comparing value for $top";
}
- unless($rpc_request =~ /"arguments":{.*?"$key":"?$value/) {
- push @failed, qq["$key:$value" is missing or incorrect];
- }
- }
-
- is_deeply(\@failed, [], $description) or diag $rpc_request;
+ }
}
+
+done_testing();