[BACK]Return to MakeTorrents.pl CVS log [TXT][DIR] Up to [local] / openbsd / OpenBSDTorrents

File: [local] / openbsd / OpenBSDTorrents / MakeTorrents.pl (download)

Revision 1.1, Tue Mar 22 01:14:11 2005 UTC (19 years, 2 months ago) by andrew
Branch: MAIN

Initial revision

#!/usr/bin/perl -T
use strict;
use warnings;
use diagnostics;

%ENV = ();

use YAML;

my $BaseDir  = '/home/ftp/pub';
my $BaseName = 'OpenBSD';
my $OutDir   = '/home/andrew';
my $BTMake   = '/usr/local/bin/btmake';
my $Tracker  = 'http://OpenBSD.somedomain.net/announce.php';

# These are regexes that tell what files to skip;
my $SkipDirs;
my $SkipFiles = qr/^\./;

my $StartDir = shift || $BaseName;
$StartDir =~ s#/$##;

chdir($BaseDir) || die "Couldn't change dir to $BaseDir";

Process_Dir($StartDir);

sub Process_Dir
{
	my $basedir = shift;

	my ($dirs, $files) = Get_Files_and_Dirs($basedir);
	if (@$files) {
		Make_Torrent($basedir, $files);
	}
	foreach my $subdir (@$dirs) {
		#next if $subdir eq '.';
		#next if $subdir eq '..';
		Process_Dir("$basedir/$subdir")
	}
}

sub Make_Torrent
{
	my $basedir = shift;
	my $files   = shift;

	if ($basedir =~ /^([\w\/\.-]+)$/) {
		$basedir = $1;
	} else {
		die "Invalid characters in dir '$basedir'";
	}

	foreach (@$files) {
		if (/^([\w\.-]+)$/) {
			$_ = "$basedir/$1";
		} else {
			die "Invalid characters in file '$_' in '$basedir'";
		}
	}

	my $torrent = $basedir;
	$torrent =~ s/\W/_/g;
	$torrent .= '-' . Torrent_Date();
	$torrent .= '.torrent';

	print Dump $torrent, $basedir, $files;
	print "Creating $torrent\n";

	system($BTMake, 
	       '-n', $BaseName,
	       '-o', "$OutDir/$torrent",
	       '-a', $Tracker,
	       @$files
	);# || die "Couldn't system $BTMake $torrent: $!";
}

sub Get_Files_and_Dirs
{
	my $basedir = shift;
	opendir DIR, $basedir or die "Couldn't opendir $basedir: $!";
	my @contents = grep { ! /^\.\.$/ } grep { ! /^\.$/ } readdir DIR;
	closedir DIR;
	my @dirs  = grep { -d "$basedir/$_" } @contents;

	my %dirs; # lookup table
	my @files;# answer

	# build lookup table
	@dirs{@dirs} = ();

	foreach my $item (@contents) {
    		push(@files, $item) unless exists $dirs{$item};
	}

	@dirs  = grep { ! /$SkipDirs/  } @dirs  if $SkipDirs;
	@files = grep { ! /$SkipFiles/ } @files if $SkipFiles;

	return \@dirs, \@files;
}

sub Torrent_Date
{
	my ($min, $hour, $mday, $mon, $year) = (gmtime)[1..5];
	$mon++;
	$year += 1900;
	foreach ($min, $hour, $mday, $mon) {
		if (length $_ == 1) {
			$_ = '0' . $_;
		}
	}
	return join '-', ($year, $mon, $mday, $hour . $min);
}