version 1.1, 2005/03/22 23:14:40 |
version 1.4, 2005/03/24 19:51:50 |
|
|
package OpenBSDTorrents; |
package OpenBSDTorrents; |
|
#$Id$ |
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( |
|
$BaseDir |
|
$TorrentDir |
|
$BaseName |
|
$Tracker |
|
&Name_Torrent |
|
&Get_Files_and_Dirs |
|
); |
|
|
|
our $BaseDir = '/home/ftp/pub'; |
|
our $TorrentDir = '/home/andrew/torrents'; |
|
our $BaseName = 'OpenBSD'; |
|
our $Tracker = 'http://OpenBSD.somedomain.net/announce.php'; |
|
|
# Preloaded methods go here. |
# These are regexes that tell what files to skip; |
|
our $SkipDirs = qr/\/patches$/; |
|
our $SkipFiles = qr/^\./; |
|
|
|
|
|
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 { ! /$SkipDirs/ } @dirs if $SkipDirs; |
|
@files = grep { ! /$SkipFiles/ } @files if $SkipFiles; |
|
|
|
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); |
|
} |
|
|
1; |
1; |
__END__ |
__END__ |