Return to OpenBSDTorrents.pm CVS log

Up to [local] / openbsd / OpenBSDTorrents / lib

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

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