Return to OpenBSDTorrents.pm CVS log

Up to [local] / openbsd / OpenBSDTorrents / lib

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

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