Return to OpenBSDTorrents.pm CVS log

Up to [local] / openbsd / OpenBSDTorrents / lib

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

1.1       andrew      1: package OpenBSDTorrents;
1.2     ! andrew      2: #$Id$
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:
        !            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: $!";
        !            50:        my @contents = grep { ! /^\.\.$/ } grep { ! /^\.$/ } readdir DIR;
        !            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