=================================================================== RCS file: /cvs/openbsd/OpenBSDTorrents/MakeTorrents.pl,v retrieving revision 1.3 retrieving revision 1.4 diff -u -r1.3 -r1.4 --- openbsd/OpenBSDTorrents/MakeTorrents.pl 2005/03/22 23:07:23 1.3 +++ openbsd/OpenBSDTorrents/MakeTorrents.pl 2005/03/22 23:45:10 1.4 @@ -1,26 +1,19 @@ #!/usr/bin/perl -T -#$Id: MakeTorrents.pl,v 1.3 2005/03/22 23:07:23 andrew Exp $ +#$Id: MakeTorrents.pl,v 1.4 2005/03/22 23:45:10 andrew Exp $ use strict; use warnings; use diagnostics; +use lib 'lib'; +use OpenBSDTorrents; + %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#/$##; @@ -34,101 +27,60 @@ my ($dirs, $files) = Get_Files_and_Dirs($basedir); if (@$files) { - Make_Torrent($basedir, $files); + my $torrent = 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 '..'; + next if $subdir eq '.'; + next if $subdir eq '..'; Process_Dir("$basedir/$subdir") } } sub Make_Torrent { - my $basedir = shift; - my $files = shift; + my $basedir = shift; + my $files = shift; - if ($#files < $MinFiles) { - print "Too few files in $basedir, skipping . . .\n"; - return undef; - } + 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'"; - } + 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'"; - } - } + foreach (@$files) { + if (/^([^\/]+)$/) { + $_ = "$basedir/$1"; + } else { + die "Invalid characters in file '$_' in '$basedir'"; + } + } - my $date = Torrent_Date(); + my $torrent = Name_Torrent($basedir); - my $torrent = $basedir; - $torrent =~ s/\W/_/g; - $torrent .= '-' . $date; - $torrent .= '.torrent'; + print "Creating $torrent\n"; - #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/"; - 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', "$TorrentDir/$torrent", + '-a', $Tracker, + @$files + );# || die "Couldn't system $BTMake $torrent: $!"; - system($BTMake, - '-C', - '-c', $comment, - '-n', $BaseName, - '-o', "$OutDir/$torrent", - '-a', $Tracker, - @$files - );# || die "Couldn't system $BTMake $torrent: $!"; + return $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); -}