Return to MakeTorrents.pl CVS log

Up to [local] / openbsd / OpenBSDTorrents

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

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