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