Return to OpenBSDTorrents.pm CVS log

Up to [local] / openbsd / OpenBSDTorrents / lib

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

1.1       andrew      1: package OpenBSDTorrents;
1.7     ! andrew      2: #$Id: OpenBSDTorrents.pm,v 1.6 2005/03/28 22:59:42 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
1.5       andrew     15:        $HomeDir
1.2       andrew     16:        $TorrentDir
                     17:        $BaseName
                     18:        $Tracker
                     19:        &Name_Torrent
                     20:        &Get_Files_and_Dirs
1.5       andrew     21:        &justme
1.2       andrew     22: );
                     23:
1.3       andrew     24: our $BaseDir    = '/home/ftp/pub';
1.6       andrew     25: our $HomeDir    = '/home/OpenBSDTorrents';
                     26: our $TorrentDir = '/home/torrentsync/torrents';
1.3       andrew     27: our $BaseName   = 'OpenBSD';
                     28: our $Tracker    = 'http://OpenBSD.somedomain.net/announce.php';
1.1       andrew     29:
1.2       andrew     30: # These are regexes that tell what files to skip;
                     31: our $SkipDirs  = qr/\/patches$/;
                     32: our $SkipFiles = qr/^\./;
                     33:
                     34:
                     35: sub Name_Torrent
                     36: {
                     37:        my $torrent = shift;
                     38:
                     39:        my $date = Torrent_Date();
                     40:
                     41:        $torrent =~ s/\W/_/g;
                     42:        $torrent .= '-' . $date;
                     43:        $torrent .= '.torrent';
                     44:
                     45:        return $torrent;
                     46: }
                     47:
                     48:
                     49: sub Get_Files_and_Dirs
                     50: {
                     51:        my $basedir = shift;
                     52:        opendir DIR, $basedir or die "Couldn't opendir $basedir: $!";
1.4       andrew     53:        my @contents = sort grep { ! /^\.\.$/ } grep { ! /^\.$/ } readdir DIR;
1.2       andrew     54:        closedir DIR;
                     55:        my @dirs  = grep { -d "$basedir/$_" } @contents;
                     56:
                     57:        my %dirs; # lookup table
                     58:        my @files;# answer
                     59:
                     60:        # build lookup table
                     61:        @dirs{@dirs} = ();
                     62:
                     63:        foreach my $item (@contents) {
                     64:                push(@files, $item) unless exists $dirs{$item};
                     65:        }
                     66:
                     67:        @dirs  = grep { ! /$SkipDirs/  } @dirs  if $SkipDirs;
                     68:        @files = grep { ! /$SkipFiles/ } @files if $SkipFiles;
                     69:
                     70:        return \@dirs, \@files;
                     71: }
                     72:
                     73: sub Torrent_Date
                     74: {
                     75:        my ($min, $hour, $mday, $mon, $year) = (gmtime)[1..5];
                     76:        $mon++;
                     77:        $year += 1900;
                     78:        foreach ($min, $hour, $mday, $mon) {
                     79:                if (length $_ == 1) {
                     80:                        $_ = '0' . $_;
                     81:                }
                     82:        }
                     83:        return join '-', ($year, $mon, $mday, $hour . $min);
                     84: }
1.5       andrew     85:
                     86: # "There can be only one."  --the Highlander
                     87: sub justme {
                     88:
                     89:        my $myname;
                     90:
                     91:        if ($0 =~ m#([^/]+$)#) {
                     92:                $myname = $1;
                     93:        } else {
                     94:                die "Couldn't figure out myname";
                     95:        }
                     96:
1.7     ! andrew     97:        my $SEMA = "$HomeDir/run/$myname.pid";
1.5       andrew     98:         if (open SEMA, "<", $SEMA) {
                     99:                 my $pid = <SEMA>;
                    100:                 if (defined $pid) {
                    101:                         chomp $pid;
                    102:                        if ($pid =~ /^(\d+)$/) {
                    103:                                $pid = $1;
                    104:                        } else {
                    105:                                die "invalid pid read '$pid'";
                    106:                        }
                    107:                         if (kill(0, $pid)) {
                    108:                               print "$0 already running (pid $pid), bailing out\n";
                    109:                               exit 253;
                    110:                         }
                    111:                 }
                    112:                 close SEMA;
                    113:         }
                    114:         open (SEMA, ">", $SEMA)      or die "can't write $SEMA: $!";
                    115:         print SEMA "$$\n";
                    116:         close(SEMA)                    or die "can't close $SEMA: $!";
                    117: }
                    118:
1.1       andrew    119:
                    120: 1;
                    121: __END__
                    122: # Below is stub documentation for your module. You'd better edit it!
                    123:
                    124: =head1 NAME
                    125:
                    126: OpenBSDTorrents - Perl extension for blah blah blah
                    127:
                    128: =head1 SYNOPSIS
                    129:
                    130:   use OpenBSDTorrents;
                    131:   blah blah blah
                    132:
                    133: =head1 DESCRIPTION
                    134:
                    135: Stub documentation for OpenBSDTorrents, created by h2xs. It looks like the
                    136: author of the extension was negligent enough to leave the stub
                    137: unedited.
                    138:
                    139: Blah blah blah.
                    140:
                    141:
                    142: =head1 SEE ALSO
                    143:
                    144: Mention other useful documentation such as the documentation of
                    145: related modules or operating system documentation (such as man pages
                    146: in UNIX), or any relevant external documentation such as RFCs or
                    147: standards.
                    148:
                    149: If you have a mailing list set up for your module, mention it here.
                    150:
                    151: If you have a web site set up for your module, mention it here.
                    152:
                    153: =head1 AUTHOR
                    154:
                    155: Andrew Fresh, E<lt>andrew@E<gt>
                    156:
                    157: =head1 COPYRIGHT AND LICENSE
                    158:
                    159: Copyright (C) 2005 by Andrew Fresh
                    160:
                    161: This library is free software; you can redistribute it and/or modify
                    162: it under the same terms as Perl itself, either Perl version 5.8.5 or,
                    163: at your option, any later version of Perl 5 you may have available.
                    164:
                    165:
                    166: =cut