cyla

#!/usr/bin/perl -w
#
# Configurable variables
#
#       src             "socket" when using scgi_socket, or anything else when using scgi_port
#       socket          rTorrent's rpc socket (scgi_local)      - using scgi_local      - needed, when "src" is set to "socket"
#       ip              rTorrent's ip address                   - using scgi_port       - needed, when "src" is NOT set to "socket"
#       port            rTorrent's scgi port (scgi_port)        - using scgi_port       - needed, when "src" is NOT set to "socket"
#

my $src         = "socket";
my $ip          = "127.0.0.1";
my $port        = "5000";
my $socket      = "torrent/.socket/rpc.socket";

use IO::Socket;

if ( @ARGV == 0 ) {
    exit;
} else {
    print "${ARGV[0]}\n\n";
}

my $pattern     = qr/<value><string>(.*?)<\/string><\/value>/;
my $tpattern    = qr/<value><string>(.*?${ARGV[0]}.*?)<\/string><\/value>/;
my $openarray   = qr/<value><array><data>/;
my $closearray  = qr/<\/data><\/array><\/value>/;

my $line        = "<?xml version=\"1.0\" encoding=\"utf-8\"?><methodCall><methodName>d.multicall</methodName><params><param><value><string>name</string></value></param><param><value><string>d.get_name=</string></value></param><param><value><string>t.multicall=,t.get_url=</string></value></param></params></methodCall>";

my $llen        = length $line;
my $header      = "CONTENT_LENGTH\000${llen}\000SCGI\001\000";
my $hlen        = length $header;
$line           = "${hlen}:${header},${line}";

if ( ( defined $src ) && ( $src eq "socket" ) ) {
        socket( SOCK, PF_UNIX, SOCK_STREAM, 0 ) or die;
        connect( SOCK, sockaddr_un( $socket ) ) or die $!;
} else {
        socket( SOCK, PF_INET, SOCK_STREAM, getprotobyname( "tcp" ) );
        connect( SOCK, sockaddr_in( $port, inet_aton( $ip ) ) );
}

print SOCK $line;
flush SOCK;

my $depth = 0;
my @torrents = ();
my $torrent;
while ( $line = <SOCK> ) {
        if ( $line =~ /$openarray/ ) {
        $depth++
        }
        if ( $line =~ /$closearray/ ) {
        $depth--
        }
        if ( ( $depth == 2 ) && ( $line =~ /$pattern/ ) ) {
        $torrent = $1;
        }
        if ( ( $depth == 4 ) && ( $line =~ /$tpattern/ ) ) {
        push( @torrents, "${torrent}" );
        }
}
close (SOCK);

foreach ( @torrents ) {
    print "${_}\n";
}
print "\n";