version 1.1, 2005/03/22 23:14:40 |
version 1.15, 2010/05/26 20:41:15 |
|
|
package OpenBSDTorrents; |
package OpenBSDTorrents; |
|
#$RedRiver: OpenBSDTorrents.pm,v 1.14 2010/05/19 22:19:43 andrew Exp $ |
use 5.008005; |
use 5.008005; |
use strict; |
use strict; |
use warnings; |
use warnings; |
|
|
our @ISA = qw(); |
require Exporter; |
|
|
|
our @ISA = qw(Exporter); |
|
|
our $VERSION = '0.01'; |
our $VERSION = '0.01'; |
|
|
|
our @EXPORT = qw( |
|
$OBT |
|
$INSTALL_ISO_REGEX |
|
$SONG_REGEX |
|
&Name_Torrent |
|
&Get_Files_and_Dirs |
|
&justme |
|
); |
|
|
# Preloaded methods go here. |
my $config_file = '/etc/OpenBSDTorrents.conf'; |
|
our $OBT = Config(); |
|
our $INSTALL_ISO_REGEX = qr/ \b install\d+\.iso \b /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 |
|
{ |
|
my $torrent = shift; |
|
|
|
my $date = Torrent_Date(); |
|
|
|
$torrent =~ s/\W/_/g; |
|
$torrent .= '-' . $date; |
|
$torrent .= '.torrent'; |
|
|
|
return $torrent; |
|
} |
|
|
|
|
|
sub Get_Files_and_Dirs |
|
{ |
|
my $basedir = shift; |
|
|
|
if ( -f $basedir ) { |
|
$basedir =~ s{^.*/}{}xms; |
|
return [], [ $basedir ]; |
|
} |
|
|
|
opendir DIR, $basedir or die "Couldn't opendir $basedir: $!"; |
|
my @contents = sort grep { ! /^\.\.$/ } grep { ! /^\.$/ } readdir DIR; |
|
closedir DIR; |
|
|
|
my @dirs; |
|
my @files; |
|
ITEM: foreach my $item (@contents) { |
|
if ( -d "$basedir/$item" ) { |
|
if ( $OBT->{SKIP_DIRS} |
|
&& $item =~ /$OBT->{SKIP_DIRS}/) { |
|
next ITEM; |
|
} |
|
push @dirs, $item; |
|
} |
|
else { |
|
if ( $OBT->{SKIP_FILES} |
|
&& $item =~ /$OBT->{SKIP_FILES}/) { |
|
next ITEM; |
|
} |
|
push @files, $item; |
|
} |
|
} |
|
|
|
return \@dirs, \@files; |
|
} |
|
|
|
sub Torrent_Date |
|
{ |
|
my ($min, $hour, $mday, $mon, $year) = (gmtime)[1..5]; |
|
$mon++; |
|
$year += 1900; |
|
foreach ($min, $hour, $mday, $mon) { |
|
if (length $_ == 1) { |
|
$_ = '0' . $_; |
|
} |
|
} |
|
return join '-', ($year, $mon, $mday, $hour . $min); |
|
} |
|
|
|
# "There can be only one." --the Highlander |
|
sub justme { |
|
|
|
my $myname; |
|
|
|
if ($0 =~ m#([^/]+$)#) { |
|
$myname = $1; |
|
} else { |
|
die "Couldn't figure out myname"; |
|
} |
|
|
|
my $SEMA = $OBT->{DIR_HOME} . "/run/$myname.pid"; |
|
if (open SEMA, "<", $SEMA) { |
|
my $pid = <SEMA>; |
|
if (defined $pid) { |
|
chomp $pid; |
|
if ($pid =~ /^(\d+)$/) { |
|
$pid = $1; |
|
} else { |
|
die "invalid pid read '$pid'"; |
|
} |
|
if (kill(0, $pid)) { |
|
print "$0 already running (pid $pid), bailing out\n"; |
|
exit 253; |
|
} |
|
} |
|
close SEMA; |
|
} |
|
open (SEMA, ">", $SEMA) or die "can't write $SEMA: $!"; |
|
print SEMA "$$\n"; |
|
close(SEMA) or die "can't close $SEMA: $!"; |
|
} |
|
|
|
|
1; |
1; |
__END__ |
__END__ |