--- /dev/null
+From 3bccbfe57c350b8db2a3f9d0812f6fa5548c7f2e Mon Sep 17 00:00:00 2001
+From: Niko Tyni <ntyni@debian.org>
+Date: Sun, 26 Apr 2009 23:07:03 +0300
+Subject: [PATCH] Wrap IPC::ShareLite->new() calls inside eval{} blocks.
+
+As of IPC::ShareLite 0.14, its constructor croaks on error where it used
+to return an empty value. This breaks the IPC::SharedCache test suite.
+
+http://bugs.debian.org/525711
+http://rt.cpan.org/Public/Bug/Display.html?id=45450
+---
+ SharedCache.pm | 36 +++++++++++++++++++++++++++---------
+ 1 files changed, 27 insertions(+), 9 deletions(-)
+
+diff --git a/SharedCache.pm b/SharedCache.pm
+index 30bca21..51eabcf 100644
+--- a/SharedCache.pm
++++ b/SharedCache.pm
+@@ -580,11 +580,13 @@ sub STORE {
+ my $share;
+ if (exists $root_record->{'map'}{$key}) {
+ # we've got a key, get the share and cache it
+- $share = IPC::ShareLite->new('-key' => $root_record->{'map'}{$key},
++ $share = eval {
++ IPC::ShareLite->new('-key' => $root_record->{'map'}{$key},
+ '-mode' => $options->{ipc_mode},
+ '-size' => $options->{ipc_segment_size},
+ '-create' => 0,
+ '-destroy' => 0);
++ };
+ confess("IPC::SharedCache: Unable to get shared cache block $root_record->{'map'}{$key} : $!") unless defined $share;
+
+ $root_record->{'size'} -= $root_record->{'length_map'}{$key};
+@@ -596,13 +598,15 @@ sub STORE {
+ for ( my $end = $obj_ipc_key + 10000 ;
+ $obj_ipc_key != $end ;
+ $obj_ipc_key++ ) {
+- $share = IPC::ShareLite->new('-key' => $obj_ipc_key,
++ $share = eval {
++ IPC::ShareLite->new('-key' => $obj_ipc_key,
+ '-mode' => $options->{ipc_mode},
+ '-size' => $options->{ipc_segment_size},
+ '-create' => 1,
+ '-exclusive' => 1,
+ '-destroy' => 0,
+ );
++ };
+ last if defined $share;
+ }
+ croak("IPC::SharedCache : searched through 10,000 consecutive locations for a free shared memory segment, giving up : $!")
+@@ -625,11 +629,13 @@ sub STORE {
+ my $delete_key = shift @{$root_record->{'queue'}};
+ # delete the segment for this object
+ {
+- my $share = IPC::ShareLite->new('-key' => $root_record->{map}{$delete_key},
++ my $share = eval {
++ IPC::ShareLite->new('-key' => $root_record->{map}{$delete_key},
+ '-mode' => $options->{ipc_mode},
+ '-size' => $options->{ipc_segment_size},
+ '-create' => 0,
+ '-destroy' => 1);
++ };
+ confess("IPC::SharedCache: Unable to get shared cache block $root_record->{'map'}{$key} : $!") unless defined $share;
+ # share is now deleted since destroy == 1 and $share goes out of scope
+ }
+@@ -684,11 +690,13 @@ sub DELETE {
+
+ # delete the segment for this object
+ {
+- my $share = IPC::ShareLite->new('-key' => $obj_ipc_key,
++ my $share = eval {
++ IPC::ShareLite->new('-key' => $obj_ipc_key,
+ '-mode' => $options->{ipc_mode},
+ '-size' => $options->{ipc_segment_size},
+ '-create' => 0,
+ '-destroy' => 1);
++ };
+ confess("IPC::SharedCache: Unable to get shared cache block $root_record->{'map'}{$key} : $!") unless defined $share;
+ # share is now deleted since destroy == 1 and $share goes out of scope
+ }
+@@ -830,11 +838,13 @@ sub walk {
+ require "Data/Dumper.pm";
+
+ # make sure the cache actually exists here
+- my $test = IPC::ShareLite->new('-key' => $key,
++ my $test = eval {
++ IPC::ShareLite->new('-key' => $key,
+ '-mode' => 0666,
+ '-size' => $segment_size,
+ '-create' => 0,
+ '-destroy' => 0);
++ };
+ die "Unable to find a cache at key $key : $!" unless defined $test;
+
+ my %self;
+@@ -911,10 +921,12 @@ sub remove {
+
+ # delete the root segment
+ {
+- my $share = IPC::ShareLite->new('-key' => $key,
++ my $share = eval {
++ IPC::ShareLite->new('-key' => $key,
+ '-size' => $segment_size,
+ '-create' => 0,
+ '-destroy' => 1);
++ };
+ confess("IPC::SharedCache: Unable to get shared cache block $key : $!") unless defined $share;
+ # share is now deleted since destroy == 1 and $share goes out of scope
+ }
+@@ -938,11 +950,13 @@ sub _init_root {
+ return if defined $root;
+
+ # try to get a handle on an existing root for this key
+- $root = IPC::ShareLite->new('-key' => $ipc_key,
++ $root = eval {
++ IPC::ShareLite->new('-key' => $ipc_key,
+ '-mode' => $options->{ipc_mode},
+ '-size' => $options->{ipc_segment_size},
+ '-create' => 0,
+ '-destroy' => 0);
++ };
+ if (defined $root) {
+ $ROOT_SHARE_CACHE{$ipc_key} = $root;
+ return;
+@@ -961,12 +975,14 @@ sub _init_root {
+ # if $options->{debug};
+
+ # try to create it if that didn't work (and do initialization)
+- $root = IPC::ShareLite->new('-key' => $options->{ipc_key},
++ $root = eval {
++ IPC::ShareLite->new('-key' => $options->{ipc_key},
+ '-mode' => $options->{ipc_mode},
+ '-size' => $options->{ipc_segment_size},
+ '-create' => 1,
+ '-exclusive' => 1,
+ '-destroy' => 0);
++ };
+ confess("IPC::SharedCache object initialization : Unable to initialize root ipc shared memory segment : $!")
+ unless defined($root);
+
+@@ -1032,11 +1048,13 @@ sub _get_share_object {
+ my $options = $self->{options};
+
+ # we've got a key, get the share and cache it
+- my $share = IPC::ShareLite->new('-key' => $obj_ipc_key,
++ my $share = eval {
++ IPC::ShareLite->new('-key' => $obj_ipc_key,
+ '-mode' => $options->{ipc_mode},
+ '-size' => $options->{ipc_segment_size},
+ '-create' => 0,
+ '-destroy' => 0);
++ };
+ confess("IPC::SharedCache: Unable to get shared cache block $obj_ipc_key : $!") unless defined $share;
+
+ # get the cache block
+--
+1.6.2.4
+
projects / packages / perl-IPC-SharedCache.git / blobdiff