Return to MakeTorrents.pl CVS log

Up to [local] / openbsd / OpenBSDTorrents

lots of changes,  getting good :-)

#!/usr/bin/perl -T
#$Id: MakeTorrents.pl,v 1.3 2005/03/22 23:07:23 andrew Exp $
use strict;
use warnings;
use diagnostics;

%ENV = ();

use YAML;

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

my $MinFiles = 5;

# These are regexes that tell what files to skip;
my $SkipDirs  = qr/\/patches$/;
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);
	}

	# don't recurse if we were called on a specific directory
	return 1 if $StartDir ne $BaseName;

	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 ($#files < $MinFiles) {
		print "Too few files in $basedir, skipping . . .\n";
		return undef;
	}

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

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

	my $date = Torrent_Date();

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

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

	my $comment = "Files from $basedir\n" .
	              "Created by andrew fresh (andrew\@mad-techies.org)\n" . 
	              "http://OpenBSD.somedomain.net/",

	system($BTMake, 
	       '-C',
	       '-c', $comment,
	       '-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);
}