Return to OpenBSDTorrents.pm CVS log

Up to [local] / openbsd / OpenBSDTorrents / lib

Annotation of openbsd/OpenBSDTorrents/lib/OpenBSDTorrents.pm, Revision 1.4

1.1       andrew      1: package OpenBSDTorrents;
1.4     ! andrew      2: #$Id: OpenBSDTorrents.pm,v 1.3 2005/03/23 01:32:30 andrew Exp andrew $
1.1       andrew      3: use 5.008005;
                      4: use strict;
                      5: use warnings;
                      6:
1.2       andrew      7: require Exporter;
1.1       andrew      8:
1.2       andrew      9: our @ISA = qw(Exporter);
                     10:
1.1       andrew     11: our $VERSION = '0.01';
                     12:
1.2       andrew     13: our @EXPORT = qw(
                     14:        $BaseDir
                     15:        $TorrentDir
                     16:        $BaseName
                     17:        $Tracker
                     18:        &Name_Torrent
                     19:        &Get_Files_and_Dirs
                     20: );
                     21:
1.3       andrew     22: our $BaseDir    = '/home/ftp/pub';
                     23: our $TorrentDir = '/home/andrew/torrents';
                     24: our $BaseName   = 'OpenBSD';
                     25: our $Tracker    = 'http://OpenBSD.somedomain.net/announce.php';
1.1       andrew     26:
1.2       andrew     27: # These are regexes that tell what files to skip;
                     28: our $SkipDirs  = qr/\/patches$/;
                     29: our $SkipFiles = qr/^\./;
                     30:
                     31:
                     32: sub Name_Torrent
                     33: {
                     34:        my $torrent = shift;
                     35:
                     36:        my $date = Torrent_Date();
                     37:
                     38:        $torrent =~ s/\W/_/g;
                     39:        $torrent .= '-' . $date;
                     40:        $torrent .= '.torrent';
                     41:
                     42:        return $torrent;
                     43: }
                     44:
                     45:
                     46: sub Get_Files_and_Dirs
                     47: {
                     48:        my $basedir = shift;
                     49:        opendir DIR, $basedir or die "Couldn't opendir $basedir: $!";
1.4     ! andrew     50:        my @contents = sort grep { ! /^\.\.$/ } grep { ! /^\.$/ } readdir DIR;
1.2       andrew     51:        closedir DIR;
                     52:        my @dirs  = grep { -d "$basedir/$_" } @contents;
                     53:
                     54:        my %dirs; # lookup table
                     55:        my @files;# answer
                     56:
                     57:        # build lookup table
                     58:        @dirs{@dirs} = ();
                     59:
                     60:        foreach my $item (@contents) {
                     61:                push(@files, $item) unless exists $dirs{$item};
                     62:        }
                     63:
                     64:        @dirs  = grep { ! /$SkipDirs/  } @dirs  if $SkipDirs;
                     65:        @files = grep { ! /$SkipFiles/ } @files if $SkipFiles;
                     66:
                     67:        return \@dirs, \@files;
                     68: }
                     69:
                     70: sub Torrent_Date
                     71: {
                     72:        my ($min, $hour, $mday, $mon, $year) = (gmtime)[1..5];
                     73:        $mon++;
                     74:        $year += 1900;
                     75:        foreach ($min, $hour, $mday, $mon) {
                     76:                if (length $_ == 1) {
                     77:                        $_ = '0' . $_;
                     78:                }
                     79:        }
                     80:        return join '-', ($year, $mon, $mday, $hour . $min);
                     81: }
1.1       andrew     82:
                     83: 1;
                     84: __END__
                     85: # Below is stub documentation for your module. You'd better edit it!
                     86:
                     87: =head1 NAME
                     88:
                     89: OpenBSDTorrents - Perl extension for blah blah blah
                     90:
                     91: =head1 SYNOPSIS
                     92:
                     93:   use OpenBSDTorrents;
                     94:   blah blah blah
                     95:
                     96: =head1 DESCRIPTION
                     97:
                     98: Stub documentation for OpenBSDTorrents, created by h2xs. It looks like the
                     99: author of the extension was negligent enough to leave the stub
                    100: unedited.
                    101:
                    102: Blah blah blah.
                    103:
                    104:
                    105: =head1 SEE ALSO
                    106:
                    107: Mention other useful documentation such as the documentation of
                    108: related modules or operating system documentation (such as man pages
                    109: in UNIX), or any relevant external documentation such as RFCs or
                    110: standards.
                    111:
                    112: If you have a mailing list set up for your module, mention it here.
                    113:
                    114: If you have a web site set up for your module, mention it here.
                    115:
                    116: =head1 AUTHOR
                    117:
                    118: Andrew Fresh, E<lt>andrew@E<gt>
                    119:
                    120: =head1 COPYRIGHT AND LICENSE
                    121:
                    122: Copyright (C) 2005 by Andrew Fresh
                    123:
                    124: This library is free software; you can redistribute it and/or modify
                    125: it under the same terms as Perl itself, either Perl version 5.8.5 or,
                    126: at your option, any later version of Perl 5 you may have available.
                    127:
                    128:
                    129: =cut