File Coverage

blib/lib/Mojo/Transmission.pm

Criterion	Covered	Total	%
statement	80	92	86.9
branch	41	52	78.8
condition	17	27	62.9
subroutine	21	22	95.4
pod	9	9	100.0
total	168	202	83.1

package Mojo::Transmission;
use Mojo::Base -base;

use Exporter 'import';
use Mojo::JSON;
use Mojo::UserAgent;
use Mojo::Util qw(dumper url_escape);

use constant DEBUG          => $ENV{TRANSMISSION_DEBUG} || 0;
use constant RETURN_PROMISE => sub { };

our $VERSION = '0.03';
our @EXPORT_OK = qw(tr_status);

has default_trackers => sub { [split /,/, ($ENV{TRANSMISSION_DEFAULT_TRACKERS} || '')] };
has ua               => sub { Mojo::UserAgent->new; };
has url =>
  sub { Mojo::URL->new($ENV{TRANSMISSION_RPC_URL} || 'http://localhost:9091/transmission/rpc'); };

sub add {
  my $cb = ref $_[-1] eq 'CODE' ? pop : undef;
  my ($self, $args) = @_;
  my $url = $args->{url} || '';

  if ($args->{xt}) {
    $url = sprintf 'magnet:?xt=%s&dn=%s', map { $_ // '' } @$args{qw(xt dn)};
    $url .= sprintf '&tr=%s', url_escape $_ for @{$args->{tr} || $self->default_trackers};
  }

  unless ($url) {
    $url = sprintf 'magnet:?xt=urn:btih:%s', $args->{hash} // '';
    $url .= sprintf '&dn=%s', url_escape($args->{dn} // '');
    $url .= sprintf '&tr=%s', url_escape $_ for @{$args->{tr} || $self->default_trackers};
  }

  $self->_post('torrent-add', {filename => "$url"}, $cb);
}

sub add_p { shift->add(shift, RETURN_PROMISE) }

sub session {
  my $cb   = ref $_[-1] eq 'CODE' ? pop : undef;
  my $self = shift;

  return $self->_post('session-get', $_[0], $cb) if ref $_[0] eq 'ARRAY';
  return $self->_post('session-set', $_[0], $cb) if ref $_[0] eq 'HASH';
  return $self->tap($cb, {error => 'Invalid input.'}) if $cb;
  die 'Invalid input.';
}

sub session_p { shift->session(shift, RETURN_PROMISE) }

sub stats {
  my $cb = ref $_[-1] eq 'CODE' ? pop : undef;
  return shift->_post('session-stats', {}, $cb);
}

sub stats_p { shift->_post('session-stats', {}, RETURN_PROMISE) }

sub torrent {
  my $cb = ref $_[-1] eq 'CODE' ? pop : undef;
  my ($self, $args, $id) = @_;

  if (defined $id) {
    $id = ref $id ? $id : [$id];
  }

  if (ref $args eq 'ARRAY') {
    $args = {fields => $args};
    $args->{ids} = $id if defined $id;
    return $self->_post('torrent-get', $args, $cb);
  }
  elsif (ref $args eq 'HASH') {
    $args->{ids} = $id if defined $id;
    return $self->_post('torrent-set', $args, $cb);
  }
  elsif ($args eq 'purge') {
    return $self->_post('torrent-remove', {ids => $id, 'delete-local-data' => Mojo::JSON->true},
      $cb);
  }
  else {
    return $self->_post("torrent-$args", {ids => $id}, $cb);
  }
}

sub torrent_p { shift->torrent(@_, RETURN_PROMISE) }

sub _done {
  my ($self, $cb, $res) = @_;
  $self->$cb($res) unless $cb eq RETURN_PROMISE;
  return $res;
}

sub _post {
  my ($self, $method, $req, $cb) = @_;
  $req = {arguments => $req, method => $method};

  # Non-Blocking
  if ($cb) {
    warn '[TRANSMISSION] <<< ', dumper($req), "\n" if DEBUG;
    my $p = $self->ua->post_p($self->url, $self->_headers, json => $req)->then(sub {
      my $tx = shift;
      warn '[TRANSMISSION] >>> ', dumper($tx->res->json || $tx->res->error), "\n" if DEBUG;
      return $self->_done($cb, _res($tx)) unless ($tx->res->code // 0) == 409;
      $self->{session_id} = $tx->res->headers->header('X-Transmission-Session-Id');
      return $self->ua->post_p($self->url, $self->_headers, json => $req);
    })->then(sub {
      return $_[0] if ref $_[0] eq 'HASH';    # _done() is already called
      my $tx = shift;
      warn '[TRANSMISSION] >>> ', dumper($tx->res->json || $tx->res->error), "\n" if DEBUG;
      return $self->_done($cb, _res($tx));
    });

    return $cb eq RETURN_PROMISE ? $p : $self;
  }

  # Blocking
  else {
    warn '[TRANSMISSION] <<< ', dumper($req), "\n" if DEBUG;
    my $tx = $self->ua->post($self->url, $self->_headers, json => $req);
    warn '[TRANSMISSION] >>> ', dumper($tx->res->json || $tx->res->error), "\n" if DEBUG;
    return _res($tx) unless ($tx->res->code // 0) == 409;
    $self->{session_id} = $tx->res->headers->header('X-Transmission-Session-Id');
    $tx = $self->ua->post($self->url, $self->_headers, json => $req);
    warn '[TRANSMISSION] >>> ', dumper($tx->res->json || $tx->res->error), "\n" if DEBUG;
    return _res($tx);
  }
}

sub _headers {
  my $self = shift;
  return {'X-Transmission-Session-Id' => $self->{session_id} || ''};
}

sub _res {
  my $res = $_[0]->res->json || {error => $_[0]->res->error};
  $res->{error} ||= $res->{result};
  return $res if !$res->{result} or $res->{result} ne 'success';
  return $res->{arguments};
}

my @TR_STATUS = qw(stopped check_wait check download_wait download seed_wait seed);
sub tr_status { defined $_[0] && $_[0] >= 0 && $_[0] <= @TR_STATUS ? $TR_STATUS[$_[0]] : '' }

1;

=encoding utf8

=head1 NAME

Mojo::Transmission - Client for talking with Transmission BitTorrent daemon

=head1 DESCRIPTION

L is a very lightweight client for exchanging data with
the Transmission BitTorrent daemon using RPC.

The documentation in this module might seem sparse, but that is because the API
is completely transparent regarding the data-structure received from the
L.

=head1 SYNOPSIS

  my $transmission = Mojo::Transmission->new;
  $transmission->add(url => "http://releases.ubuntu.com/17.10/ubuntu-17.10.1-desktop-amd64.iso.torrent");

  my $torrents = $transmission->torrent([]);
  $transmission->torrent(remove => $torrents[0]->{id}) if @$torrents;

=head1 ATTRIBUTES

=head2 default_trackers

  $array_ref    = $transmission->default_trackers;
  $transmission = $transmission->default_trackers([$url, ...]);

Holds a list of default trackers that can be used by L.

=head2 ua

  $ua           = $transmission->ua;
  $transmission = $transmission->ua(Mojo::UserAgent->new);

Holds a L used to issue requests to backend.

=head2 url

  $url          = $transmission->url;
  $transmission = $transmission->url(Mojo::URL->new);

L object holding the URL to the transmission daemon.
Default to the C environment variable or
"http://localhost:9091/transmission/rpc".

=head1 METHODS

=head2 add

  # Generic call
  $res          = $transmission->add(\%args);
  $transmission = $transmission->add(\%args, sub { my ($transmission, $res) = @_ });

  # magnet:?xt=${xt}&dn=${dn}&tr=${tr}
  $transmission->add({xt => "...", dn => "...", tr => [...]});

  # magnet:?xt=urn:btih:${hash}&dn=${dn}&tr=${tr}
  $transmission->add({hash => "...", dn => "...", tr => [...]});

  # Custom URL or file
  $transmission->add({url => "...", tr => [...]});

This method can be used to add a torrent. C

See also L.

=head2 add_p

  $promise = $transmission->add_p(\%args);

Same as L, but returns a promise.

=head2 session

  # session-get
  $transmission = $transmission->session([], sub { my ($transmission, $res) = @_; });
  $res          = $transmission->session([]);

  # session-set
  $transmission = $transmission->session(\%attrs, sub { my ($transmission, $res) = @_; });
  $res          = $transmission->session(\%attrs);

Used to get or set Transmission session arguments.

See also L.

=head2 session_p

  $promise = $transmission->session_p([]);
  $promise = $transmission->session_p(\%args);

Same as L, but returns a promise.

=head2 stats

  # session-stats
  $transmission = $transmission->stats(sub { my ($transmission, $res) = @_; });
  $res          = $transmission->stats;

Used to retrieve Transmission statistics.

=head2 stats_p

  $promise = $transmission->stats_p;

Same as L, but returns a promise.

See also L.

=head2 torrent

  # torrent-get
  $transmission = $transmission->torrent(\@attrs, $id, sub { my ($transmission, $res) = @_; });
  $res          = $transmission->torrent(\@attrs, $id);

  # torrent-set
  $transmission = $transmission->torrent(\%attrs, $id, sub { my ($transmission, $res) = @_; });
  $res          = $transmission->torrent(\%attrs, $id);

  # torrent-$action
  $transmission = $transmission->torrent(remove  => $id, sub { my ($transmission, $res) = @_; });
  $transmission = $transmission->torrent(start   => $id, sub { my ($transmission, $res) = @_; });
  $transmission = $transmission->torrent(stop    => $id, sub { my ($transmission, $res) = @_; });
  $res          = $transmission->torrent($action => $id);

  # torrent-remove + delete-local-data
  $transmission = $transmission->torrent(purge => $id, sub { my ($transmission, $res) = @_; });

Used to get or set torrent related attributes or execute an action on a torrent.

C<$id> can either be a scalar or an array-ref, referring to which torrents to
use.

See also:

=over 4

=item * Get torrent attributes

L.

=item * Set torrent attributes

L

=item * Torrent actions

L.

=back

=head2 torrent_p

  $promise = $transmission->torrent_p(\@attrs, ...);
  $promise = $transmission->torrent_p(\%attrs, ...);
  $promise = $transmission->torrent_p($action => ...);

Same as L, but returns a promise.

=head1 FUNCTIONS

=head2 tr_status

  use Mojo::Transmission "tr_status";
  $str = tr_status $int;

Returns a description for the C<$int> status:

  0 = stopped
  1 = check_wait
  2 = check
  3 = download_wait
  4 = download
  5 = seed_wait
  6 = seed

Returns empty string on invalid input.

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2016, Jan Henning Thorsen

This program is free software, you can redistribute it and/or modify it under
the terms of the Artistic License version 2.0.

=head1 AUTHOR

Jan Henning Thorsen - C

=cut