do not freeze complex objects, and use FreezeThaw instead of Storable
authorMike Rylander <mrylander@gmail.com>
Fri, 25 Jul 2014 21:13:46 +0000 (17:13 -0400)
committerBill Erickson <berick@esilibrary.com>
Fri, 8 Aug 2014 14:08:37 +0000 (10:08 -0400)
Signed-off-by: Mike Rylander <mrylander@gmail.com>
SIPServer.pm

index 272e27d..4b6c77c 100644 (file)
@@ -42,7 +42,7 @@ use Sip::Checksum qw(checksum verify_cksum);
 use Sip::MsgType;
 
 use File::Queue;
-use Storable qw(freeze thaw);
+use FreezeThaw qw(freeze thaw);
 
 my $mp_fifo = File::Queue->new( File => "/tmp/SIPServer.mulitplex-fifo.$$" );
 END { $mp_fifo->delete };
@@ -192,7 +192,7 @@ sub REAPER {
 my %active_connections;
 sub PERMAFROST {
     while (my $login = $mp_fifo->deq) {
-        $login = thaw($login);
+        ($login) = thaw($login);
 
         my $c = $$login{id};
         if ($$login{success}) {
@@ -201,13 +201,10 @@ sub PERMAFROST {
             $active_connections{$c}{id} = $$login{id};
             $active_connections{$c}{transport} = $$login{transport};
 
-            $active_connections{$c}{net_server} = bless(
-                { # Last wins
-                    %{ $active_connections{$c}{net_server} },
-                    %{ $$login{net_server_parts} }
-                },
-                ref($active_connections{$c}{net_server})
-            );
+            for my $p (keys %{ $$login{net_server_parts} }) {
+                $active_connections{$c}{net_server}{$p} = 
+                    $$login{net_server_parts}{$p};
+            }
         } else {
             delete $active_connections{$c};
         }
@@ -274,7 +271,7 @@ sub mux_input {
         }
 
         # We stick this here, assuming success. Cleanup comes later via PERMAFROST().
-        $active_connections{$conn_id} = { id => $conn_id, transport => $transport };
+        $active_connections{$conn_id} = { id => $conn_id, transport => $transport, net_server => $self };
  
         my $pid = fork();
         if (!defined($pid) or $pid < 0) {
@@ -307,7 +304,7 @@ sub mux_input {
                     success => $success,
                     transport  => $transport,
                     net_server_parts => {
-                        %$self{ wq/service ils state institution account/ }
+                        %$self{ qw/ils state institution account/ }
                     }
                 })
             );