Sophie

Sophie

distrib > Mandriva > 2010.1 > x86_64 > media > contrib-release > by-pkgid > dccc315cd5d3495e8d0a4540449ec84d > files > 11

apache-mod_bt-0.0.19-17mdv2010.1.x86_64.rpm

#!/usr/bin/perl

use strict;
use warnings FATAL => qw(all);
use diagnostics;
use vars qw(@ARGV);
use LWP::Simple qw(get);
use URI;

my $btmetainfo = "btshowmetainfo";

die "Usage: $0 torrent_file [torrent_file...]\n"
    unless(@ARGV);
    
if(my(@no_r) = grep(! -r $_, @ARGV)) {
    die "Can't read @no_r\n";
}

my @to_reg;

foreach my $torrent (@ARGV) {
    my $cmd=qq{$btmetainfo "$torrent"};
    my $metainfo = `$cmd`;
    if($metainfo =~ m{
        info\ hash\.{5}:\ (.{40}).*?
        (file\ name\.{5}|directory\ name):\ ([^\n]+)\n.*?
        (file\ size\.{5}|archive\ size\.\.):\ (\d+).*?
        announce\ url\.\.:\ ([^\n]+)
    }xs) {
        push(@to_reg, {
            torrent => $torrent,
            info_hash_str => $1, 
            filename => $3,
            filesize => $5, 
            announce => $6
        });
    } else {
        die "Got a bad response from `$cmd`\n";
    }
}

foreach my $info (@to_reg) {
    my $reg_url = $info->{announce};
    $reg_url =~ s/announce/register/
        or die qq{Can't transform url "$reg_url" for "$info->{torrent}"\n};
    
    my $uri = URI->new($reg_url);
    $uri->query_form(
        map { $_ => $info->{$_} }
        qw(filename filesize info_hash_str)
    );
    
    if(get($uri)) {
        print "$info->{torrent}: $uri\n";
    } else {
        print qq{Failed to register "$info->{torrent}".\n};
    }
}