list torrent in transmission

[cloudstore.git] / gearman / transmission.pl

diff --git a/gearman/transmission.pl b/gearman/transmission.pl
new file mode 100755 (executable)
index 0000000..bf6bce3
--- /dev/null
+++ b/gearman/transmission.pl
@@ -0,0 +1,45 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+use Transmission::Client;
+use JSON::XS;
+use Data::Dump qw(dump);
+
+sub home_dir {
+       my $login = shift;
+       my ( undef, undef, $uid, $gid, undef, undef, $email, $dir, $shell ) = getpwnam $login;
+       return $dir;
+}
+
+use Gearman::Worker;
+my $worker = Gearman::Worker->new;
+$worker->job_servers('127.0.0.1:4730');
+
+my $tc = Transmission::Client->new( autodie => 1 );
+
+my $j = JSON::XS->new;
+$j->allow_blessed(1);
+$j->convert_blessed(0);
+
+my $name = $ENV{ZSLICE} || die "need ZSLICE";
+$name =~ s/\W+/_/g;
+
+$worker->register_function( $name . '_torrent_list' => sub {
+       my ($job) = @_;
+       my @cols = split(/\s+/,$job->arg);
+       @cols = qw( id name seeders leechers ) unless @cols;
+       my @list;       
+       for my $torrent ($tc->read_torrents) {
+               warn "## torrent = ",dump($torrent);
+               my $hash;
+               $hash->{$_} = $torrent->$_ foreach @cols;
+               push @list, $hash;
+       }
+       warn "# torrent_list = ",dump( \@list );
+       return $j->encode( \@list );
+} );
+
+warn "$0 $name pid $$ waitng for jobs\n";
+$worker->work while 1;
+