gearman/transmission.pl

   1 #!/usr/bin/perl
   2 use warnings;
   3 use strict;
   4
   5 use Transmission::Client;
   6 use JSON::XS;
   7 use Data::Dump qw(dump);
   8
   9 sub home_dir {
  10         my $login = shift;
  11         my ( undef, undef, $uid, $gid, undef, undef, $email, $dir, $shell ) = getpwnam $login;
  12         return $dir;
  13 }
  14
  15 use Gearman::Worker;
  16 my $worker = Gearman::Worker->new;
  17 $worker->job_servers('127.0.0.1:4730');
  18
  19 my $tc = Transmission::Client->new( autodie => 1 );
  20
  21 my $j = JSON::XS->new;
  22 $j->allow_blessed(1);
  23 $j->convert_blessed(0);
  24
  25 my $name = $ENV{ZSLICE} || die "need ZSLICE";
  26 $name =~ s/\W+/_/g;
  27
  28 $worker->register_function( $name . '_torrent_list' => sub {
  29         my ($job) = @_;
  30         my @cols = split(/\s+/,$job->arg);
  31         @cols = qw( id name seeders leechers ) unless @cols;
  32         my @list;
  33         for my $torrent ($tc->read_torrents) {
  34                 warn "## torrent = ",dump($torrent);
  35                 my $hash;
  36                 $hash->{$_} = $torrent->$_ foreach @cols;
  37                 push @list, $hash;
  38         }
  39         warn "# torrent_list = ",dump( \@list );
  40         return $j->encode( \@list );
  41 } );
  42
  43 warn "$0 $name pid $$ waitng for jobs\n";
  44 $worker->work while 1;
  45