#!/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}; } }