Return to MakeTorrents.pl CVS log

Up to [local] / openbsd / OpenBSDTorrents

Annotation of openbsd/OpenBSDTorrents/MakeTorrents.pl, Revision 1.2

1.1       andrew      1: #!/usr/bin/perl -T
1.2     ! andrew      2: #$Id$
1.1       andrew      3: use strict;
                      4: use warnings;
                      5: use diagnostics;
                      6:
                      7: %ENV = ();
                      8:
                      9: use YAML;
                     10:
                     11: my $BaseDir  = '/home/ftp/pub';
                     12: my $BaseName = 'OpenBSD';
1.2     ! andrew     13: my $OutDir   = '/home/andrew/torrents';
1.1       andrew     14: my $BTMake   = '/usr/local/bin/btmake';
                     15: my $Tracker  = 'http://OpenBSD.somedomain.net/announce.php';
                     16:
                     17: # These are regexes that tell what files to skip;
                     18: my $SkipDirs;
                     19: my $SkipFiles = qr/^\./;
                     20:
                     21: my $StartDir = shift || $BaseName;
                     22: $StartDir =~ s#/$##;
                     23:
                     24: chdir($BaseDir) || die "Couldn't change dir to $BaseDir";
                     25:
                     26: Process_Dir($StartDir);
                     27:
                     28: sub Process_Dir
                     29: {
                     30:        my $basedir = shift;
                     31:
                     32:        my ($dirs, $files) = Get_Files_and_Dirs($basedir);
                     33:        if (@$files) {
                     34:                Make_Torrent($basedir, $files);
                     35:        }
                     36:        foreach my $subdir (@$dirs) {
                     37:                #next if $subdir eq '.';
                     38:                #next if $subdir eq '..';
                     39:                Process_Dir("$basedir/$subdir")
                     40:        }
                     41: }
                     42:
                     43: sub Make_Torrent
                     44: {
                     45:        my $basedir = shift;
                     46:        my $files   = shift;
                     47:
                     48:        if ($basedir =~ /^([\w\/\.-]+)$/) {
                     49:                $basedir = $1;
                     50:        } else {
                     51:                die "Invalid characters in dir '$basedir'";
                     52:        }
                     53:
                     54:        foreach (@$files) {
1.2     ! andrew     55:                if (/^([^\/]+)$/) {
1.1       andrew     56:                        $_ = "$basedir/$1";
                     57:                } else {
                     58:                        die "Invalid characters in file '$_' in '$basedir'";
                     59:                }
                     60:        }
                     61:
                     62:        my $torrent = $basedir;
                     63:        $torrent =~ s/\W/_/g;
                     64:        $torrent .= '-' . Torrent_Date();
                     65:        $torrent .= '.torrent';
                     66:
                     67:        print Dump $torrent, $basedir, $files;
                     68:        print "Creating $torrent\n";
                     69:
                     70:        system($BTMake,
1.2     ! andrew     71:               '-C',
        !            72:               '-c', "Created by andrew fresh <andrew\@mad-techies.org>\n" .
        !            73:                     "See http://OpenBSD.somedomain.net/",
1.1       andrew     74:               '-n', $BaseName,
                     75:               '-o', "$OutDir/$torrent",
                     76:               '-a', $Tracker,
                     77:               @$files
                     78:        );# || die "Couldn't system $BTMake $torrent: $!";
                     79: }
                     80:
                     81: sub Get_Files_and_Dirs
                     82: {
                     83:        my $basedir = shift;
                     84:        opendir DIR, $basedir or die "Couldn't opendir $basedir: $!";
                     85:        my @contents = grep { ! /^\.\.$/ } grep { ! /^\.$/ } readdir DIR;
                     86:        closedir DIR;
                     87:        my @dirs  = grep { -d "$basedir/$_" } @contents;
                     88:
                     89:        my %dirs; # lookup table
                     90:        my @files;# answer
                     91:
                     92:        # build lookup table
                     93:        @dirs{@dirs} = ();
                     94:
                     95:        foreach my $item (@contents) {
                     96:                push(@files, $item) unless exists $dirs{$item};
                     97:        }
                     98:
                     99:        @dirs  = grep { ! /$SkipDirs/  } @dirs  if $SkipDirs;
                    100:        @files = grep { ! /$SkipFiles/ } @files if $SkipFiles;
                    101:
                    102:        return \@dirs, \@files;
                    103: }
                    104:
                    105: sub Torrent_Date
                    106: {
                    107:        my ($min, $hour, $mday, $mon, $year) = (gmtime)[1..5];
                    108:        $mon++;
                    109:        $year += 1900;
                    110:        foreach ($min, $hour, $mday, $mon) {
                    111:                if (length $_ == 1) {
                    112:                        $_ = '0' . $_;
                    113:                }
                    114:        }
                    115:        return join '-', ($year, $mon, $mday, $hour . $min);
                    116: }