===================================================================
RCS file: /cvs/openbsd/OpenBSDTorrents/MakeTorrents.pl,v
retrieving revision 1.3
retrieving revision 1.27
diff -u -r1.3 -r1.27
--- openbsd/OpenBSDTorrents/MakeTorrents.pl	2005/03/22 23:07:23	1.3
+++ openbsd/OpenBSDTorrents/MakeTorrents.pl	2010/05/19 23:19:43	1.27
@@ -1,134 +1,193 @@
-#!/usr/bin/perl -T
-#$Id: MakeTorrents.pl,v 1.3 2005/03/22 23:07:23 andrew Exp $
+#!/usr/bin/perl
+# -T
+#$RedRiver: MakeTorrents.pl,v 1.26 2010/03/22 20:16:02 andrew Exp $
 use strict;
 use warnings;
 use diagnostics;
 
+use lib 'lib';
+use BT::MetaInfo::Cached;
+use OpenBSDTorrents;
+
 %ENV = ();
 
-use YAML;
+chdir( $OBT->{DIR_FTP} )
+    || die "Couldn't change dir to " . $OBT->{DIR_FTP} . ": $!";
 
-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 $StartDir = '';
+if (@ARGV) {
+    foreach (@ARGV) {
+        s#/$##;
+        Process_Dir($_);
+    }
+}
+else {
+    $StartDir = $OBT->{BASENAME};
+    Process_Dir($StartDir);
+}
 
-my $MinFiles = 5;
+sub Process_Dir {
+    my $basedir = shift;
 
-# These are regexes that tell what files to skip;
-my $SkipDirs  = qr/\/patches$/;
-my $SkipFiles = qr/^\./;
+    #return undef if $basedir =~ /packages/;
 
+    my ( $dirs, $files ) = Get_Files_and_Dirs($basedir);
+    if ( -f $basedir) {
+        $basedir =~ s{/[^/]+$}{}xms;
+    }
+    if (@$files) {
+        Make_Torrent( $basedir, $files );
+    }
 
-my $StartDir = shift || $BaseName;
-$StartDir =~ s#/$##;
+    # don't recurse if we were started with a specific directory
+    return 1 if $StartDir ne $OBT->{BASENAME};
 
-chdir($BaseDir) || die "Couldn't change dir to $BaseDir";
+    foreach my $subdir (@$dirs) {
+        next if $subdir =~ /^\./;
+        Process_Dir("$basedir/$subdir");
+    }
+}
 
-Process_Dir($StartDir);
+sub Make_Torrent {
+    my $basedir = shift;
+    my $files   = shift;
 
-sub Process_Dir
-{
-	my $basedir = shift;
+    if ( $basedir !~ /\.\./ && $basedir =~ /^([\w\/\.-]+)$/ ) {
+        $basedir = $1;
+    }
+    else {
+        die "Invalid characters in dir '$basedir'";
+    }
 
-	my ($dirs, $files) = Get_Files_and_Dirs($basedir);
-	if (@$files) {
-		Make_Torrent($basedir, $files);
-	}
+    if ( $#{$files} < $OBT->{MIN_FILES} 
+      && $files->[0] !~/$INSTALL_ISO_REGEX/xms ) {
+        print "Too few files in $basedir, skipping . . .\n";
+        return undef;
+    }
 
-	# don't recurse if we were called on a specific directory
-	return 1 if $StartDir ne $BaseName;
+    my $torrent = Name_Torrent($basedir);
+    my $comment = "Files from $basedir";
 
-	foreach my $subdir (@$dirs) {
-		#next if $subdir eq '.';
-		#next if $subdir eq '..';
-		Process_Dir("$basedir/$subdir")
-	}
-}
+    my %torrents;
+    foreach my $file (@$files) {
+        if ( $file =~ /^([^\/]+)$/ ) {
+            $file = $1;
 
-sub Make_Torrent
-{
-	my $basedir = shift;
-	my $files   = shift;
+            my $t = $torrent;
+            my $c = $comment;
 
-	if ($#files < $MinFiles) {
-		print "Too few files in $basedir, skipping . . .\n";
-		return undef;
-	}
+            if ( $file =~ /$INSTALL_ISO_REGEX/xms ) {
+                $t = Name_Torrent("$basedir/$file");
+                $c = "$basedir/$file";
+            }
+            elsif ( my ($ext) = $file =~ /$SONG_REGEX/xms ) {
+                $t = Name_Torrent("$basedir/$ext");
+                $c = "$ext files from $basedir";
+            }
 
-	if ($basedir !~ /\.\./ && $basedir =~ /^([\w\/\.-]+)$/) {
-		$basedir = $1;
-	} else {
-		die "Invalid characters in dir '$basedir'";
-	}
+            $torrents{$t}{comment} = $c;
+            push @{ $torrents{$t}{files} }, "$basedir/$file";
+        }
+        else {
+            die "Invalid characters in file '$file' in '$basedir'";
+        }
+    }
 
-	foreach (@$files) {
-		if (/^([^\/]+)$/) {
-			$_ = "$basedir/$1";
-		} else {
-			die "Invalid characters in file '$_' in '$basedir'";
-		}
-	}
+    foreach my $t ( keys %torrents ) {
 
-	my $date = Torrent_Date();
+        print "Creating $t ("
+            . ( scalar @{ $torrents{$t}{files} } )
+            . " files)\n";
 
-	my $torrent = $basedir;
-	$torrent =~ s/\W/_/g;
-	$torrent .= '-' . $date;
-	$torrent .= '.torrent';
+        my $c = $torrents{$t}{comment};
+        $c .= "\nCreated by andrew fresh (andrew\@afresh1.com)\n"
+            . "http://OpenBSD.somedomain.net/";
 
-	#print Dump $torrent, $basedir, $files;
-	print "Creating $torrent\n";
+        eval { btmake( $t, $c, $torrents{$t}{files} ); };
+        if ($@) {
+            print "Error creating $t\n$@\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', $OBT->{BASENAME},
+        #               '-o', $OBT->{DIR_TORRENT} . "/$t",
+        #               '-a', $Tracker,
+        #               @$files
+        #        );# || die "Couldn't system $BTMake $t: $!";
+    }
 
-	system($BTMake, 
-	       '-C',
-	       '-c', $comment,
-	       '-n', $BaseName,
-	       '-o', "$OutDir/$torrent",
-	       '-a', $Tracker,
-	       @$files
-	);# || die "Couldn't system $BTMake $torrent: $!";
+    return [ keys %torrents ];
 }
 
+# Stole and modified from btmake to work for this.
+sub btmake {
+    no locale;
 
-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 $torrent = shift;
+    my $comment = shift;
+    my $files   = shift;
 
-	my %dirs; # lookup table
-	my @files;# answer
+    my $name      = $OBT->{BASENAME};
+    my $announce  = $OBT->{URL_TRACKER};
+    my $piece_len = 2 << ( $OBT->{PIECE_LENGTH} - 1 );
 
-	# build lookup table
-	@dirs{@dirs} = ();
+    my $torrent_with_path = $OBT->{DIR_NEW_TORRENT} . "/$torrent";
 
-	foreach my $item (@contents) {
-    		push(@files, $item) unless exists $dirs{$item};
-	}
+    #if (@$files == 1) {
+    #$name = $files->[0];
+    #}
 
-	@dirs  = grep { ! /$SkipDirs/  } @dirs  if $SkipDirs;
-	@files = grep { ! /$SkipFiles/ } @files if $SkipFiles;
+    my $t
+        = BT::MetaInfo::Cached->new( { cache_root => '/tmp/OBTFileCache' } );
 
-	return \@dirs, \@files;
-}
+    $t->name($name);
+    $t->announce($announce);
+    unless ( $announce =~ m!^http://[^/]+/!i ) {
+        warn
+            "  [ WARNING: announce URL does not look like: http://hostname/ ]\n";
+    }
+    $t->comment($comment);
 
-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);
+    #foreach my $pair (split(/;/, $::opt_f)) {
+    #    if (my($key, $val) = split(/,/, $pair, 2)) {
+    #        $t->set($key, $val);
+    #    }
+    #}
+    $t->piece_length($piece_len);
+    $t->creation_date(time);
+
+    #print "Checksumming files. This may take a little while...\n";
+
+    # Can't use this,  have to do this manually because
+    # we need to have the multi-file type of torrent
+    # even when we have only one file.
+    #$t->set_files(@$files);
+
+    my @file_list;
+    foreach my $f (@$files) {
+        my $l = ( stat("$OBT->{DIR_FTP}/$f") )[7];
+        my @p = split /\//, $f;
+        shift @p;
+        push @file_list,
+            {
+            length => $l,
+            path   => \@p,
+            };
+    }
+    $t->files( \@file_list );
+    $t->make_pieces(@$files);
+
+    if ( $t->total_size < $OBT->{MIN_SIZE} ) {
+        print "Skipping smaller than minimum size\n";
+        return 0;
+    }
+
+    my $hash = $t->info_hash;
+    $hash = unpack( "H*", $hash );
+
+    $t->save($torrent_with_path);
+    print "Created: $torrent_with_path\n";
 }
+