- perltidy
authorheiko
Fri, 18 Jan 2008 21:59:55 +0000
changeset 48 61a2dc11f50b
parent 47 1c2ae71d226b
child 49 3e57c577c01e
- perltidy
- locking
.perltidyrc
debian/changelog
exigrey.pl
exim-exigrey.pl
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/.perltidyrc	Fri Jan 18 21:59:55 2008 +0000
@@ -0,0 +1,1 @@
+/home/is/heiko/.perltidyrc
\ No newline at end of file
--- a/debian/changelog	Wed Jun 13 06:57:49 2007 +0000
+++ b/debian/changelog	Fri Jan 18 21:59:55 2008 +0000
@@ -2,8 +2,9 @@
 
   * new upstream
     - Locking
+  * perltidy 
 
- -- Heiko Schlittermann <hs@schlittermann.de>  Thu, 25 Jan 2007 15:20:59 +0100
+ -- Heiko Schlittermann <heiko@schlittermann.de>  Fri, 18 Jan 2008 22:59:36 +0100
 
 exigrey (0.18-1) stable; urgency=low
 
--- a/exigrey.pl	Wed Jun 13 06:57:49 2007 +0000
+++ b/exigrey.pl	Fri Jan 18 21:59:55 2008 +0000
@@ -30,8 +30,9 @@
 use FindBin qw/$Bin/;
 use POSIX qw/strftime mktime/;
 
-do "@LIBDIR@/exim-exigrey.pl" 
-    or do "./exim-exigrey.pl" or die $!;
+do "@LIBDIR@/exim-exigrey.pl"
+  or do "./exim-exigrey.pl"
+  or die $!;
 
 my $VERSION = '$Id$';
 
@@ -49,53 +50,60 @@
 MAIN: {
 
     GetOptions(
-	"list!" => \$opt_list,
-	"insert!" => \$opt_insert,
-	"stats!" => \$opt_stats,
-	"clean!" => \$opt_clean,
-	"purge!" => \$opt_purge,
-	"dbs!" => \$opt_dbs,
-	"help!" => \$opt_help,
-    ) or die ME.": Bad usage, try ".ME." --help.\n";
+        "list!"   => \$opt_list,
+        "insert!" => \$opt_insert,
+        "stats!"  => \$opt_stats,
+        "clean!"  => \$opt_clean,
+        "purge!"  => \$opt_purge,
+        "dbs!"    => \$opt_dbs,
+        "help!"   => \$opt_help,
+    ) or die ME . ": Bad usage, try " . ME . " --help.\n";
 
     if ($opt_help) {
-	($_ = USAGE) =~ s/!(.*?)!/eval $1/eg;
-	print; exit 0;
-    };
+        ($_ = USAGE) =~ s/!(.*?)!/eval $1/eg;
+        print;
+        exit 0;
+    }
 
     if ($opt_list) {
-	foreach (@ARGV = getDBs(@ARGV)) {
-	    my %h;
-	    my $db = connectDB(\%h, $_);
-	    print "# $db\n";
-	    iterate(%h, sub {
-		my ($item, $v0, $v1, $c) = @_;
-		printf "$item: $v0 $v1 $c (%s %s)\n", 
-			strftime("%FT%T", localtime($v0)), 
-			strftime("%FT%T", localtime($v1));
-	    });
-	    print "\n" if @ARGV;
-	}
-	exit 0;
+        foreach (@ARGV = getDBs(@ARGV)) {
+            my %h;
+            my $db = connectDB(\%h, $_);
+            print "# $db\n";
+            iterate(
+                %h,
+                sub {
+                    my ($item, $v0, $v1, $c) = @_;
+                    printf "$item: $v0 $v1 $c (%s %s)\n",
+                      strftime("%FT%T", localtime($v0)),
+                      strftime("%FT%T", localtime($v1));
+                }
+            );
+            print "\n" if @ARGV;
+        }
+        exit 0;
     }
 
     if ($opt_stats) {
-	foreach (@ARGV = getDBs(@ARGV)) {
-	    my %h;
-	    my $db = connectDB(\%h, $_);
+        foreach (@ARGV = getDBs(@ARGV)) {
+            my %h;
+            my $db = connectDB(\%h, $_);
 
-	    my ($seen, $returned, $oldest_c, $oldest_u);
-	    $seen = $returned = 0;
-	    $oldest_c = $oldest_u = time();
-	    iterate(%h, sub {
-		my ($item, $v0, $v1, $c) = @_;
-		++$seen;
-		++$returned if $v0 != $v1;  # soon it can be $c
-		$oldest_c = $v0 if $v0 < $oldest_c;
-		$oldest_u = $v1 if $v1 < $oldest_u;
-	    });
+            my ($seen, $returned, $oldest_c, $oldest_u);
+            $seen     = $returned = 0;
+            $oldest_c = $oldest_u = time();
+            iterate(
+                %h,
+                sub {
+                    my ($item, $v0, $v1, $c) = @_;
+                    ++$seen;
+                    ++$returned if $v0 != $v1;    # soon it can be $c
+                    $oldest_c = $v0 if $v0 < $oldest_c;
+                    $oldest_u = $v1 if $v1 < $oldest_u;
+                }
+            );
 
-	    $_ = <<__;
+            $_ = <<__;
 	    date: %s
 	      db: $db (ls: %.1f MB / du: %.1f MB)
 	   total: $seen (100%%)
@@ -104,59 +112,60 @@
 oldest (created): %.1f days (%s)
    oldest (used): %.1f days (%s)
 __
-	    printf $_, 
-		    scalar(localtime), 
-		    (-s $db) / (1024*1024),
-		    ((stat $db)[12]*512)/(1024*1024),
-		    length($seen), $returned, int(0.5 + 100 * ($returned/$seen)),
-		    length($seen), $seen - $returned, int(0.5 + 100 * ($seen-$returned)/$seen), 
-		    ((time - $oldest_c) / 86400), scalar(localtime $oldest_c),
-		    ((time - $oldest_u) / 86400), scalar(localtime $oldest_u);
-	    print "\n" if @ARGV;
+            printf $_, scalar(localtime), (-s $db) / (1024 * 1024),
+              ((stat $db)[12] * 512) / (1024 * 1024), length($seen), $returned,
+              int(0.5 + 100 * ($returned / $seen)), length($seen),
+              $seen - $returned, int(0.5 + 100 * ($seen - $returned) / $seen),
+              ((time - $oldest_c) / 86400), scalar(localtime $oldest_c),
+              ((time - $oldest_u) / 86400), scalar(localtime $oldest_u);
+            print "\n" if @ARGV;
 
-	}
-	exit 0;
+        }
+        exit 0;
     }
 
     if ($opt_clean or $opt_purge) {
 
-	my $cut = time() - (86400 * (@ARGV ? shift : 7));
-	foreach (getDBs(@ARGV)) {
-	    my %h;
-	    my $tmp = tmpfile();
-	    my $db = connectDB(\%h, $_);
-	    iterate(%h, sub {
-		my ($item, $v0, $v1, $c) = @_;
-		my $rv = defined $opt_purge ? \$v0 : \$v1;
-		print $tmp "$item\0" if $$rv <= $cut;
-	    });
+        my $cut = time() - (86400 * (@ARGV ? shift: 7));
+        foreach (getDBs(@ARGV)) {
+            my %h;
+            my $tmp = tmpfile();
+            my $db = connectDB(\%h, $_);
+            iterate(
+                %h,
+                sub {
+                    my ($item, $v0, $v1, $c) = @_;
+                    my $rv = defined $opt_purge ? \$v0 : \$v1;
+                    print $tmp "$item\0" if $$rv <= $cut;
+                }
+            );
 
-	    seek($tmp, 0, 0) or die "Can't seek tmpfile";
+            seek($tmp, 0, 0) or die "Can't seek tmpfile";
 
-	    $/ = "\0";
-	    delete $h{$_} while <$tmp>;
-	    printf "$. items %s from $db\n",
-		$opt_purge ? "purged" : "deleted";
+            $/ = "\0";
+            delete $h{$_} while <$tmp>;
+            printf "$. items %s from $db\n", $opt_purge ? "purged" : "deleted";
 
-	    close($tmp);
+            close($tmp);
 
-	}
-	exit 0;
+        }
+        exit 0;
     }
 
     if ($opt_dbs) {
-	print join("\n", getDBs(@ARGV)), "\n";
-	exit 0;
+        print join("\n", getDBs(@ARGV)), "\n";
+        exit 0;
     }
 
     if ($opt_insert) {
-	print unseen(@ARGV);
-	exit 0;
+        print unseen(@ARGV);
+        exit 0;
     }
 }
 
 sub getDBs(@) {
-    grep { -f } map { m(^\.?/) ? glob($_) : glob(getDBDir() . "/$_") } @_ ? @_ : "*";
+    grep { -f }
+      map { m(^\.?/) ? glob($_) : glob(getDBDir() . "/$_") } @_ ? @_ : "*";
 }
 
 # Helper to iterate over our hash and call the passed
@@ -164,10 +173,9 @@
 sub iterate(\%$) {
     my ($hash, $sub) = @_;
     while (my ($k, $v) = each %$hash) {
-	chop($k, $v);
-	&$sub($k, (split(" ", $v), 0)[0..2]);	# 0 for filling
+        chop($k, $v);
+        &$sub($k, (split(" ", $v), 0)[ 0 .. 2 ]);    # 0 for filling
     }
 }
 
-
 # vim:ft=perl aw sts=4 sw=4:
--- a/exim-exigrey.pl	Wed Jun 13 06:57:49 2007 +0000
+++ b/exim-exigrey.pl	Fri Jan 18 21:59:55 2008 +0000
@@ -14,9 +14,10 @@
 # use BerkeleyDB;
 use DB_File;
 
-my %DEFAULT = (delay => 600,
-               db    => "seen",
-               white => "white",
+my %DEFAULT = (
+    delay => 600,
+    db    => "seen",
+    white => "white",
 );
 
 sub unseen($;$$);
@@ -42,125 +43,125 @@
 # starts with "./" or "/".
 #
 sub unseen($;$$) {
-   my ($item, $delay, $db) = @_;
-   $item .= "\0";
-   $delay = $DEFAULT{delay} unless defined $delay;
-   $db    = $DEFAULT{db}    unless defined $db;
-
-   my $now = time();
-   my $rc;
-
-   my %h;
-   $db = connectDB(\%h, $db);
+    my ($item, $delay, $db) = @_;
+    $item .= "\0";
+    $delay = $DEFAULT{delay} unless defined $delay;
+    $db    = $DEFAULT{db}    unless defined $db;
 
-   if (not exists $h{$item}) {
-      $h{$item} = "$now $now 0\0";
-      $rc = "yes";
-   }
-   else {
-      ($_ = $h{$item}) =~ s/\0*$//;    # we're \0 terminated
-      my ($created, $used, $count) = split;
-      if ($now - $created < $delay) { $rc = "yes" }
-      else {
-         $rc = "no";
-         ++$count;
-         $h{$item} = "$created $now $count\0";
-      }
-   }
-   untie %h;
-   disconnectDB();
-   return $rc;
+    my $now = time();
+    my $rc;
+
+    my %h;
+    $db = connectDB(\%h, $db);
+
+    if (not exists $h{$item}) {
+        $h{$item} = "$now $now 0\0";
+        $rc = "yes";
+    }
+    else {
+        ($_ = $h{$item}) =~ s/\0*$//;    # we're \0 terminated
+        my ($created, $used, $count) = split;
+        if ($now - $created < $delay) { $rc = "yes" }
+        else {
+            $rc = "no";
+            ++$count;
+            $h{$item} = "$created $now $count\0";
+        }
+    }
+    untie %h;
+    disconnectDB();
+    return $rc;
 }
 
 sub white($;$) {
-   unseen($_[0], 0, defined $_[1] ? $_[1] : $DEFAULT{white});
-   return "yes";
+    unseen($_[0], 0, defined $_[1] ? $_[1] : $DEFAULT{white});
+    return "yes";
 }
 
 # Get the directory where we could store the database file(s)
 # If we're running under exim it's easy, otherwise we've to find exim
 # and then ask...
 sub getDBDir() {
-   my ($spooldir, $dbdir);
-   eval { $spooldir = Exim::expand_string('$spool_directory') };
-   if (not defined $spooldir) {
-      my $exim = findExim();
-      chomp($spooldir = `$exim -be '\$spool_directory'`);
-      die "Can't find spooldir" if not defined $spooldir;
-   }
-   -d ($dbdir = "$spooldir/grey") and return $dbdir;
+    my ($spooldir, $dbdir);
+    eval { $spooldir = Exim::expand_string('$spool_directory') };
+    if (not defined $spooldir) {
+        my $exim = findExim();
+        chomp($spooldir = `$exim -be '\$spool_directory'`);
+        die "Can't find spooldir" if not defined $spooldir;
+    }
+    -d ($dbdir = "$spooldir/grey") and return $dbdir;
 
-   my ($mode, $owner, $group) = (stat $spooldir)[ 2, 4, 5 ];
-   {
-      local $) = $group;
-      local $> = $owner;
-      $mode &= 0777;
-      mkdir $dbdir, $mode or die "Can't create $dbdir: $!";
-   }
-   return $dbdir;
+    my ($mode, $owner, $group) = (stat $spooldir)[ 2, 4, 5 ];
+    {
+        local $) = $group;
+        local $> = $owner;
+        $mode &= 0777;
+        mkdir $dbdir, $mode or die "Can't create $dbdir: $!";
+    }
+    return $dbdir;
 }
 
 sub findExim(;$) {
-   my $path = shift || $ENV{PATH};
-   my $exim;
-   foreach (split /:/, $ENV{PATH}) {
-      -x ($exim = "$_/exim")  and return $exim;
-      -x ($exim = "$_/exim4") and return $exim;
-   }
-   die "Can't find exim binary (missing .../sbin dirs in PATH?";
+    my $path = shift || $ENV{PATH};
+    my $exim;
+    foreach (split /:/, $ENV{PATH}) {
+        -x ($exim = "$_/exim")  and return $exim;
+        -x ($exim = "$_/exim4") and return $exim;
+    }
+    die "Can't find exim binary (missing .../sbin dirs in PATH?";
 }
 
 {
-   my $fh;
-
-   sub connectDB($$) {
-      my ($h, $db) = @_;
-      $db = getDBDir() . "/$db" unless $db =~ m(^\.?/);
-
-      # Creation of DB-File if it doesn't exist
-      # to avoid races we change our own uid/gid for creation of
-      # this file.
-      if (!-f $db) {
-         (my $dir = $db) =~ s/^(.*)\/.*?$/$1/;
-
-         # copy mode, uid, gid from the directory
-         my ($mode, $user, $group) = (stat $dir)[ 2, 4, 5 ]
-            or die "Can't stat $dir: $!";
-         my $umask = umask(($mode & 0777) ^ 0777);
-         local $) = $group;
-         local $> = $user;
-         open(X, ">>$db") or die "Can't create $db: $!";
-         close(X);
-         umask $umask;
-      }
+    my $fh;
 
-      # We try to open and lock the database file to avoid
-      # a race.
-      open($fh, $db) or die "Can't open $db: $!";
-      flock($fh, LOCK_EX) or die "Can't lock $db: $!";
-
-      # now test which of the DB-Modules has been loaded
+    sub connectDB($$) {
+        my ($h, $db) = @_;
+        $db = getDBDir() . "/$db" unless $db =~ m(^\.?/);
 
-      if (exists &BerkeleyDB::Hash::TIEHASH) {
-         no strict;
-         my $umask = umask 077;
-         tie %$h, "BerkeleyDB::Hash", -Filename => $db
-            or die "$0: $db: $!";
-         return $db;
-      }
+        # Creation of DB-File if it doesn't exist
+        # to avoid races we change our own uid/gid for creation of
+        # this file.
+        if (!-f $db) {
+            (my $dir = $db) =~ s/^(.*)\/.*?$/$1/;
 
-      if (exists &DB_File::TIEHASH) {
-         tie %$h, "DB_File", $db
-            or die "$0: $db: $!";
-         return $db;
-      }
+            # copy mode, uid, gid from the directory
+            my ($mode, $user, $group) = (stat $dir)[ 2, 4, 5 ]
+              or die "Can't stat $dir: $!";
+            my $umask = umask(($mode & 0777) ^ 0777);
+            local $) = $group;
+            local $> = $user;
+            open(X, ">>$db") or die "Can't create $db: $!";
+            close(X);
+            umask $umask;
+        }
 
-      die "Can't connect to database driver";
-   }
+        # We try to open and lock the database file to avoid
+        # a race.
+        open($fh, $db) or die "Can't open $db: $!";
+        flock($fh, LOCK_EX) or die "Can't lock $db: $!";
 
-   sub disconnectDB() {
-      close($fh);
-   }
+        # now test which of the DB-Modules has been loaded
+
+        if (exists &BerkeleyDB::Hash::TIEHASH) {
+            no strict;
+            my $umask = umask 077;
+            tie %$h, "BerkeleyDB::Hash", -Filename => $db
+              or die "$0: $db: $!";
+            return $db;
+        }
+
+        if (exists &DB_File::TIEHASH) {
+            tie %$h, "DB_File", $db
+              or die "$0: $db: $!";
+            return $db;
+        }
+
+        die "Can't connect to database driver";
+    }
+
+    sub disconnectDB() {
+        close($fh);
+    }
 }
 0;