Return to MakeTorrents.pl CVS log

Up to [local] / openbsd / OpenBSDTorrents

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

1.1       andrew      1: #!/usr/bin/perl -T
1.4     ! andrew      2: #$Id: MakeTorrents.pl,v 1.3 2005/03/22 23:07:23 andrew Exp andrew $
1.1       andrew      3: use strict;
                      4: use warnings;
                      5: use diagnostics;
                      6:
1.4     ! andrew      7: use lib 'lib';
        !             8: use OpenBSDTorrents;
        !             9:
1.1       andrew     10: %ENV = ();
                     11:
                     12: use YAML;
                     13:
                     14: my $BTMake   = '/usr/local/bin/btmake';
1.3       andrew     15: my $MinFiles = 5;
                     16:
1.1       andrew     17: my $StartDir = shift || $BaseName;
                     18: $StartDir =~ s#/$##;
                     19:
                     20: chdir($BaseDir) || die "Couldn't change dir to $BaseDir";
                     21:
                     22: Process_Dir($StartDir);
                     23:
                     24: sub Process_Dir
                     25: {
                     26:        my $basedir = shift;
                     27:
                     28:        my ($dirs, $files) = Get_Files_and_Dirs($basedir);
                     29:        if (@$files) {
1.4     ! andrew     30:                my $torrent = Make_Torrent($basedir, $files);
1.1       andrew     31:        }
1.3       andrew     32:
                     33:        # don't recurse if we were called on a specific directory
                     34:        return 1 if $StartDir ne $BaseName;
                     35:
1.1       andrew     36:        foreach my $subdir (@$dirs) {
1.4     ! andrew     37:                next if $subdir eq '.';
        !            38:                next if $subdir eq '..';
1.1       andrew     39:                Process_Dir("$basedir/$subdir")
                     40:        }
                     41: }
                     42:
                     43: sub Make_Torrent
                     44: {
1.4     ! andrew     45:         my $basedir = shift;
        !            46:         my $files   = shift;
1.1       andrew     47:
1.4     ! andrew     48:         if ($#{ $files } < $MinFiles) {
        !            49:                 print "Too few files in $basedir, skipping . . .\n";
        !            50:                 return undef;
        !            51:         }
1.3       andrew     52:
1.4     ! andrew     53:         if ($basedir !~ /\.\./ && $basedir =~ /^([\w\/\.-]+)$/) {
        !            54:                 $basedir = $1;
        !            55:         } else {
        !            56:                 die "Invalid characters in dir '$basedir'";
        !            57:         }
1.1       andrew     58:
1.4     ! andrew     59:         foreach (@$files) {
        !            60:                 if (/^([^\/]+)$/) {
        !            61:                         $_ = "$basedir/$1";
        !            62:                 } else {
        !            63:                         die "Invalid characters in file '$_' in '$basedir'";
        !            64:                 }
        !            65:         }
1.1       andrew     66:
1.4     ! andrew     67:         my $torrent = Name_Torrent($basedir);
1.3       andrew     68:
1.4     ! andrew     69:         print "Creating $torrent\n";
1.1       andrew     70:
1.4     ! andrew     71:         my $comment = "Files from $basedir\n" .
        !            72:                       "Created by andrew fresh (andrew\@mad-techies.org)\n" .
        !            73:                       "http://OpenBSD.somedomain.net/";
1.1       andrew     74:
1.4     ! andrew     75:         system($BTMake,
        !            76:                '-C',
        !            77:                '-c', $comment,
        !            78:                '-n', $BaseName,
        !            79:                '-o', "$TorrentDir/$torrent",
        !            80:                '-a', $Tracker,
        !            81:                @$files
        !            82:         );# || die "Couldn't system $BTMake $torrent: $!";
1.3       andrew     83:
1.4     ! andrew     84:         return $torrent;
1.1       andrew     85: }
1.3       andrew     86: