version 1.7, 2005/03/28 23:04:42 |
version 1.13, 2010/03/22 21:13:53 |
|
|
package OpenBSDTorrents; |
package OpenBSDTorrents; |
#$Id$ |
#$RedRiver: OpenBSDTorrents.pm,v 1.12 2010/03/22 19:08:48 andrew Exp $ |
use 5.008005; |
use 5.008005; |
use strict; |
use strict; |
use warnings; |
use warnings; |
|
|
our $VERSION = '0.01'; |
our $VERSION = '0.01'; |
|
|
our @EXPORT = qw( |
our @EXPORT = qw( |
$BaseDir |
$OBT |
$HomeDir |
$INSTALL_ISO_REGEX |
$TorrentDir |
$SONG_REGEX |
$BaseName |
|
$Tracker |
|
&Name_Torrent |
&Name_Torrent |
&Get_Files_and_Dirs |
&Get_Files_and_Dirs |
&justme |
&justme |
); |
); |
|
|
our $BaseDir = '/home/ftp/pub'; |
|
our $HomeDir = '/home/OpenBSDTorrents'; |
|
our $TorrentDir = '/home/torrentsync/torrents'; |
|
our $BaseName = 'OpenBSD'; |
|
our $Tracker = 'http://OpenBSD.somedomain.net/announce.php'; |
|
|
|
# These are regexes that tell what files to skip; |
my $config_file = '/etc/OpenBSDTorrents.conf'; |
our $SkipDirs = qr/\/patches$/; |
our $OBT = Config(); |
our $SkipFiles = qr/^\./; |
our $INSTALL_ISO_REGEX = qr/install\d+\.iso/xms; |
|
our $SONG_REGEX = qr/^song.*\.([^\.]+)$/xms; |
|
|
|
sub Config |
|
{ |
|
my %config; |
|
open FILE, $config_file or die "Couldn't open FILE $config_file: $!"; |
|
while (<FILE>) { |
|
chomp; |
|
s/#.*$//; |
|
s/\s+$//; |
|
next unless $_; |
|
my ($name, $val) = split /=/, $_, 2; |
|
$name =~ s/^OBT_//; |
|
# This should really look for contents that are a |
|
# bit safer, but I can't think of what would work here. |
|
if ($val =~ /^(.*)$/) { |
|
$config{$name} = $1; |
|
$config{$name} =~ s/^['"]|["']$//gxms; |
|
} |
|
} |
|
close FILE; |
|
return \%config; |
|
} |
|
|
sub Name_Torrent |
sub Name_Torrent |
{ |
{ |
|
|
opendir DIR, $basedir or die "Couldn't opendir $basedir: $!"; |
opendir DIR, $basedir or die "Couldn't opendir $basedir: $!"; |
my @contents = sort grep { ! /^\.\.$/ } grep { ! /^\.$/ } readdir DIR; |
my @contents = sort grep { ! /^\.\.$/ } grep { ! /^\.$/ } readdir DIR; |
closedir DIR; |
closedir DIR; |
my @dirs = grep { -d "$basedir/$_" } @contents; |
|
|
|
my %dirs; # lookup table |
my @dirs; |
my @files;# answer |
my @files; |
|
ITEM: foreach my $item (@contents) { |
# build lookup table |
if ( -d "$basedir/$item" ) { |
@dirs{@dirs} = (); |
if ( $OBT->{SKIP_DIRS} |
|
&& $item =~ /$OBT->{SKIP_DIRS}/) { |
foreach my $item (@contents) { |
next ITEM; |
push(@files, $item) unless exists $dirs{$item}; |
} |
|
push @dirs, $item; |
|
} |
|
else { |
|
if ( $OBT->{SKIP_FILES} |
|
&& $item =~ /$OBT->{SKIP_FILES}/) { |
|
next ITEM; |
|
} |
|
push @files, $item; |
|
} |
} |
} |
|
|
@dirs = grep { ! /$SkipDirs/ } @dirs if $SkipDirs; |
|
@files = grep { ! /$SkipFiles/ } @files if $SkipFiles; |
|
|
|
return \@dirs, \@files; |
return \@dirs, \@files; |
} |
} |
|
|
|
|
die "Couldn't figure out myname"; |
die "Couldn't figure out myname"; |
} |
} |
|
|
my $SEMA = "$HomeDir/run/$myname.pid"; |
my $SEMA = $OBT->{DIR_HOME} . "/run/$myname.pid"; |
if (open SEMA, "<", $SEMA) { |
if (open SEMA, "<", $SEMA) { |
my $pid = <SEMA>; |
my $pid = <SEMA>; |
if (defined $pid) { |
if (defined $pid) { |