=================================================================== RCS file: /cvs/openbsd/OpenBSDTorrents/lib/OpenBSDTorrents.pm,v retrieving revision 1.1 retrieving revision 1.10 diff -u -r1.1 -r1.10 --- openbsd/OpenBSDTorrents/lib/OpenBSDTorrents.pm 2005/03/22 23:14:40 1.1 +++ openbsd/OpenBSDTorrents/lib/OpenBSDTorrents.pm 2007/11/02 03:36:01 1.10 @@ -1,15 +1,134 @@ package OpenBSDTorrents; - +#$RedRiver: OpenBSDTorrents.pm,v 1.9 2006/05/15 18:47:04 andrew Exp $ use 5.008005; use strict; use warnings; -our @ISA = qw(); +require Exporter; +our @ISA = qw(Exporter); + our $VERSION = '0.01'; +our @EXPORT = qw( + $OBT + $INSTALL_ISO_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/install\d+\.iso/; + +sub Config +{ + my %config; + open FILE, $config_file or die "Couldn't open FILE $config_file: $!"; + while () { + 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; + } + } + 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; + opendir DIR, $basedir or die "Couldn't opendir $basedir: $!"; + my @contents = sort grep { ! /^\.\.$/ } grep { ! /^\.$/ } readdir DIR; + closedir DIR; + my @dirs = grep { -d "$basedir/$_" } @contents; + + my %dirs; # lookup table + my @files;# answer + + # build lookup table + @dirs{@dirs} = (); + + foreach my $item (@contents) { + push(@files, $item) unless exists $dirs{$item}; + } + + @dirs = grep { ! /$OBT->{SKIP_DIRS}/ } @dirs + if $OBT->{SKIPDIRS}; + @files = grep { ! /$OBT->{SKIP_FILES}/ } @files + if $OBT->{SKIP_FILES}; + + 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 = ; + 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; __END__