version 1.12, 2005/05/02 22:49:54 |
version 1.21, 2006/11/06 23:17:59 |
|
|
#!/usr/bin/perl -T |
#!/usr/bin/perl |
#$Id$ |
# -T |
|
#$RedRiver: MakeTorrents.pl,v 1.20 2006/07/24 18:03:53 andrew Exp $ |
use strict; |
use strict; |
use warnings; |
use warnings; |
use diagnostics; |
use diagnostics; |
|
|
use lib 'lib'; |
use lib 'lib'; |
use BT::OBTMetaInfo; |
use BT::MetaInfo::Cached; |
use OpenBSDTorrents; |
use OpenBSDTorrents; |
|
|
%ENV = (); |
%ENV = (); |
|
|
{ |
{ |
my $basedir = shift; |
my $basedir = shift; |
|
|
return undef if $basedir =~ /packages/; |
#return undef if $basedir =~ /packages/; |
|
|
my ($dirs, $files) = Get_Files_and_Dirs($basedir); |
my ($dirs, $files) = Get_Files_and_Dirs($basedir); |
if (@$files) { |
if (@$files) { |
|
|
return 1 if $StartDir ne $OBT->{BASENAME}; |
return 1 if $StartDir ne $OBT->{BASENAME}; |
|
|
foreach my $subdir (@$dirs) { |
foreach my $subdir (@$dirs) { |
next if $subdir eq '.'; |
next if $subdir =~ /^\./; |
next if $subdir eq '..'; |
|
Process_Dir("$basedir/$subdir") |
Process_Dir("$basedir/$subdir") |
} |
} |
} |
} |
|
|
|
|
my $torrent_with_path = $OBT->{DIR_NEW_TORRENT} . "/$torrent"; |
my $torrent_with_path = $OBT->{DIR_NEW_TORRENT} . "/$torrent"; |
|
|
my $t = BT::OBTMetaInfo->new(); |
my $t = BT::MetaInfo::Cached->new( |
|
{ |
|
cache_root => '/tmp/OBTFileCache' |
|
} |
|
); |
|
|
$t->name($name); |
$t->name($name); |
$t->announce($announce); |
$t->announce($announce); |
unless ($announce =~ m!^http://[^/]+/!i) { |
unless ($announce =~ m!^http://[^/]+/!i) { |
|
|
return 0; |
return 0; |
} |
} |
|
|
my $hash = $t->info_hash_cached($torrent_with_path); |
my $hash = $t->info_hash; |
$hash = unpack("H*", $hash); |
$hash = unpack("H*", $hash); |
|
|
$t->save($torrent_with_path); |
$t->save($torrent_with_path); |