Return to MakeTorrents.pl CVS log

Up to [local] / openbsd / OpenBSDTorrents

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

1.1       andrew      1: #!/usr/bin/perl -T
1.3     ! andrew      2: #$Id: MakeTorrents.pl,v 1.2 2005/03/22 04:19:03 andrew Exp andrew $
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:
1.3     ! andrew     17: my $MinFiles = 5;
        !            18:
1.1       andrew     19: # These are regexes that tell what files to skip;
1.3     ! andrew     20: my $SkipDirs  = qr/\/patches$/;
1.1       andrew     21: my $SkipFiles = qr/^\./;
                     22:
1.3     ! andrew     23:
1.1       andrew     24: my $StartDir = shift || $BaseName;
                     25: $StartDir =~ s#/$##;
                     26:
                     27: chdir($BaseDir) || die "Couldn't change dir to $BaseDir";
                     28:
                     29: Process_Dir($StartDir);
                     30:
                     31: sub Process_Dir
                     32: {
                     33:        my $basedir = shift;
                     34:
                     35:        my ($dirs, $files) = Get_Files_and_Dirs($basedir);
                     36:        if (@$files) {
                     37:                Make_Torrent($basedir, $files);
                     38:        }
1.3     ! andrew     39:
        !            40:        # don't recurse if we were called on a specific directory
        !            41:        return 1 if $StartDir ne $BaseName;
        !            42:
1.1       andrew     43:        foreach my $subdir (@$dirs) {
                     44:                #next if $subdir eq '.';
                     45:                #next if $subdir eq '..';
                     46:                Process_Dir("$basedir/$subdir")
                     47:        }
                     48: }
                     49:
                     50: sub Make_Torrent
                     51: {
                     52:        my $basedir = shift;
                     53:        my $files   = shift;
                     54:
1.3     ! andrew     55:        if ($#files < $MinFiles) {
        !            56:                print "Too few files in $basedir, skipping . . .\n";
        !            57:                return undef;
        !            58:        }
        !            59:
        !            60:        if ($basedir !~ /\.\./ && $basedir =~ /^([\w\/\.-]+)$/) {
1.1       andrew     61:                $basedir = $1;
                     62:        } else {
                     63:                die "Invalid characters in dir '$basedir'";
                     64:        }
                     65:
                     66:        foreach (@$files) {
1.2       andrew     67:                if (/^([^\/]+)$/) {
1.1       andrew     68:                        $_ = "$basedir/$1";
                     69:                } else {
                     70:                        die "Invalid characters in file '$_' in '$basedir'";
                     71:                }
                     72:        }
                     73:
1.3     ! andrew     74:        my $date = Torrent_Date();
        !            75:
1.1       andrew     76:        my $torrent = $basedir;
                     77:        $torrent =~ s/\W/_/g;
1.3     ! andrew     78:        $torrent .= '-' . $date;
1.1       andrew     79:        $torrent .= '.torrent';
                     80:
1.3     ! andrew     81:        #print Dump $torrent, $basedir, $files;
1.1       andrew     82:        print "Creating $torrent\n";
                     83:
1.3     ! andrew     84:        my $comment = "Files from $basedir\n" .
        !            85:                      "Created by andrew fresh (andrew\@mad-techies.org)\n" .
        !            86:                      "http://OpenBSD.somedomain.net/",
        !            87:
1.1       andrew     88:        system($BTMake,
1.2       andrew     89:               '-C',
1.3     ! andrew     90:               '-c', $comment,
1.1       andrew     91:               '-n', $BaseName,
                     92:               '-o', "$OutDir/$torrent",
                     93:               '-a', $Tracker,
                     94:               @$files
                     95:        );# || die "Couldn't system $BTMake $torrent: $!";
                     96: }
1.3     ! andrew     97:
1.1       andrew     98:
                     99: sub Get_Files_and_Dirs
                    100: {
                    101:        my $basedir = shift;
                    102:        opendir DIR, $basedir or die "Couldn't opendir $basedir: $!";
                    103:        my @contents = grep { ! /^\.\.$/ } grep { ! /^\.$/ } readdir DIR;
                    104:        closedir DIR;
                    105:        my @dirs  = grep { -d "$basedir/$_" } @contents;
                    106:
                    107:        my %dirs; # lookup table
                    108:        my @files;# answer
                    109:
                    110:        # build lookup table
                    111:        @dirs{@dirs} = ();
                    112:
                    113:        foreach my $item (@contents) {
                    114:                push(@files, $item) unless exists $dirs{$item};
                    115:        }
                    116:
                    117:        @dirs  = grep { ! /$SkipDirs/  } @dirs  if $SkipDirs;
                    118:        @files = grep { ! /$SkipFiles/ } @files if $SkipFiles;
                    119:
                    120:        return \@dirs, \@files;
                    121: }
                    122:
                    123: sub Torrent_Date
                    124: {
                    125:        my ($min, $hour, $mday, $mon, $year) = (gmtime)[1..5];
                    126:        $mon++;
                    127:        $year += 1900;
                    128:        foreach ($min, $hour, $mday, $mon) {
                    129:                if (length $_ == 1) {
                    130:                        $_ = '0' . $_;
                    131:                }
                    132:        }
                    133:        return join '-', ($year, $mon, $mday, $hour . $min);
                    134: }