[BACK]Return to OpenBSDTorrents.pm CVS log [TXT][DIR] Up to [local] / openbsd / OpenBSDTorrents / lib

Diff for /openbsd/OpenBSDTorrents/lib/OpenBSDTorrents.pm between version 1.1 and 1.14

version 1.1, 2005/03/22 23:14:40 version 1.14, 2010/05/19 23:19:43
Line 1 
Line 1 
 package OpenBSDTorrents;  package OpenBSDTorrents;
   #$RedRiver: OpenBSDTorrents.pm,v 1.13 2010/03/22 20:13:53 andrew Exp $
 use 5.008005;  use 5.008005;
 use strict;  use strict;
 use warnings;  use warnings;
   
 our @ISA = qw();  require Exporter;
   
   our @ISA = qw(Exporter);
   
 our $VERSION = '0.01';  our $VERSION = '0.01';
   
   our @EXPORT = qw(
           $OBT
           $INSTALL_ISO_REGEX
           $SONG_REGEX
           &Name_Torrent
           &Get_Files_and_Dirs
           &justme
   );
   
 # Preloaded methods go here.  my $config_file = '/etc/OpenBSDTorrents.conf';
   our $OBT = Config();
   our $INSTALL_ISO_REGEX = qr/install\d+\.iso/xms;
   our $SONG_REGEX        = qr/^song.*\.([^\.]+)$/xms;
   
   sub Config
   {
           my %config;
           open FILE, $config_file or die "Couldn't open FILE $config_file: $!";
           while (<FILE>) {
                   chomp;
                   s/#.*$//;
                   s/\s+$//;
                   next unless $_;
                   my ($name, $val) = split /=/, $_, 2;
                   $name =~ s/^OBT_//;
                   # This should really look for contents that are a
                   # bit safer, but I can't think of what would work here.
                   if ($val =~ /^(.*)$/) {
                           $config{$name} = $1;
                           $config{$name} =~ s/^['"]|["']$//gxms;
                   }
           }
           close FILE;
           return \%config;
   }
   
   sub Name_Torrent
   {
           my $torrent = shift;
   
           my $date = Torrent_Date();
   
           $torrent =~ s/\W/_/g;
           $torrent .= '-' . $date;
           $torrent .= '.torrent';
   
           return $torrent;
   }
   
   
   sub Get_Files_and_Dirs
   {
           my $basedir = shift;
   
           if ( -f $basedir ) {
                   $basedir =~ s{^.*/}{}xms;
                   return [], [ $basedir ];
           }
   
           opendir DIR, $basedir or die "Couldn't opendir $basedir: $!";
           my @contents = sort grep { ! /^\.\.$/ } grep { ! /^\.$/ } readdir DIR;
           closedir DIR;
   
           my @dirs;
           my @files;
           ITEM: foreach my $item (@contents) {
                   if ( -d "$basedir/$item" ) {
                           if ( $OBT->{SKIP_DIRS}
                             && $item =~ /$OBT->{SKIP_DIRS}/) {
                                   next ITEM;
                           }
                           push @dirs, $item;
                   }
                   else {
                           if ( $OBT->{SKIP_FILES}
                            && $item =~ /$OBT->{SKIP_FILES}/) {
                                   next ITEM;
                           }
                           push @files, $item;
                   }
           }
   
           return \@dirs, \@files;
   }
   
   sub Torrent_Date
   {
           my ($min, $hour, $mday, $mon, $year) = (gmtime)[1..5];
           $mon++;
           $year += 1900;
           foreach ($min, $hour, $mday, $mon) {
                   if (length $_ == 1) {
                           $_ = '0' . $_;
                   }
           }
           return join '-', ($year, $mon, $mday, $hour . $min);
   }
   
   # "There can be only one."  --the Highlander
   sub justme {
   
           my $myname;
   
           if ($0 =~ m#([^/]+$)#) {
                   $myname = $1;
           } else {
                   die "Couldn't figure out myname";
           }
   
           my $SEMA = $OBT->{DIR_HOME} . "/run/$myname.pid";
           if (open SEMA, "<", $SEMA) {
                   my $pid = <SEMA>;
                   if (defined $pid) {
                           chomp $pid;
                           if ($pid =~ /^(\d+)$/) {
                                   $pid = $1;
                           } else {
                                   die "invalid pid read '$pid'";
                           }
                           if (kill(0, $pid)) {
                                 print "$0 already running (pid $pid), bailing out\n";
                                 exit 253;
                           }
                   }
                   close SEMA;
           }
           open (SEMA, ">", $SEMA)      or die "can't write $SEMA: $!";
           print SEMA "$$\n";
           close(SEMA)                    or die "can't close $SEMA: $!";
   }
   
   
 1;  1;
 __END__  __END__
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.14
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>