[Rt-commit] r6273 - in MessageBus: lib lib/MessageBus t

[audreyt at bestpractical.com]

Author: audreyt
Date: Wed Oct 25 02:42:50 2006
New Revision: 6273

Modified:
   MessageBus/Changes
   MessageBus/lib/MessageBus.pm
   MessageBus/lib/MessageBus/Cacheable.pm
   MessageBus/t/basic.t

Log:
* This be 0.04.

Modified: MessageBus/Changes
==============================================================================
--- MessageBus/Changes	(original)
+++ MessageBus/Changes	Wed Oct 25 02:42:50 2006
@@ -1,3 +1,9 @@
+[Changes for 0.04 - 2006-10-24]
+
+* Expose ->lock, ->unlock, ->fetch, ->store APIs into the MessageBus object.
+* Implement ->lock and ->unlock methods for non-Memcached backends.
+* The tests are no longer entirely skipped when memcached is not running.
+
 [Changes for 0.03 - 2006-10-24]
 
 * New backend: JiftyDBI.

Modified: MessageBus/lib/MessageBus.pm
==============================================================================
--- MessageBus/lib/MessageBus.pm	(original)
+++ MessageBus/lib/MessageBus.pm	Wed Oct 25 02:42:50 2006
@@ -1,5 +1,5 @@
 package MessageBus;
-$MessageBus::VERSION = '0.03';
+$MessageBus::VERSION = '0.04';
 
 use 5.005;
 use strict;
@@ -32,6 +32,11 @@
     MessageBus::Sub->new($self->_cache, @_ ? @_ : '');
 }
 
+sub fetch   { my $self = shift; $self->_cache->fetch(@_);   }
+sub store   { my $self = shift; $self->_cache->store(@_);   }
+sub lock    { my $self = shift; $self->_cache->lock(@_);    }
+sub unlock  { my $self = shift; $self->_cache->unlock(@_);  }
+
 1;
 
 __END__

Modified: MessageBus/lib/MessageBus/Cacheable.pm
==============================================================================
--- MessageBus/lib/MessageBus/Cacheable.pm	(original)
+++ MessageBus/lib/MessageBus/Cacheable.pm	Wed Oct 25 02:42:50 2006
@@ -1,6 +1,7 @@
 package MessageBus::Cacheable;
 use strict;
 use Time::HiRes 'time';
+use File::Spec;
 
 #method fetch                (Str *@keys --> List of Pair)                   { ... }
 #method store                (Str $key, Str $val, Num $time, Num $expiry)    { ... }
@@ -35,4 +36,26 @@
     $self->set_index($chan, $pub, $index);
 }
 
+
+use constant LOCK => File::Spec->catdir(File::Spec->tmpdir, 'MessageBus-lock-');
+
+my %locks;
+sub lock {
+    my ($self, $chan) = @_;
+    for my $i (1..10) {
+        return if mkdir((LOCK . unpack("H*", $chan)), 0777);
+        sleep 1;
+    }
+}
+
+END {
+    rmdir(LOCK . unpack("H*", $_)) for keys %locks;
+}
+
+sub unlock {
+    my ($self, $chan) = @_;
+    rmdir(LOCK . unpack("H*", $chan));
+    delete $locks{$chan};
+}
+
 1;

Modified: MessageBus/t/basic.t
==============================================================================
--- MessageBus/t/basic.t	(original)
+++ MessageBus/t/basic.t	Wed Oct 25 02:42:50 2006
@@ -8,17 +8,14 @@
 
 unshift @backends, 'DBM_Deep' if eval { require DBM::Deep };
 unshift @backends, 'JiftyDBI' if eval { require Jifty::DBI };
-unshift @backends, 'Memcached' if eval { require Cache::Memcached };
+unshift @backends, 'Memcached' if eval { require Cache::Memcached } and IO::Socket::INET->new('127.0.0.1:11211');
 
 plan tests => 6 * scalar @backends;
 
 SKIP: for my $backend (@backends) {
     my %init_args = ();
     diag('Testing backend '.$backend);
-    if ($backend eq 'Memcached') {
-        my $sock = IO::Socket::INET->new('127.0.0.1:11211')
-            or skip("Memcached not started", 6);
-    } elsif ($backend eq 'JiftyDBI') {
+    if ($backend eq 'JiftyDBI') {
         $init_args{db_init} = 1;
     }