| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | # $Id: Message.pm,v 1.9 2014-01-28 15:40:10 joern Exp $ | 
| 2 |  |  |  |  |  |  |  | 
| 3 |  |  |  |  |  |  | #----------------------------------------------------------------------- | 
| 4 |  |  |  |  |  |  | # Copyright (C) 2005-2015 by Jörn Reder . | 
| 5 |  |  |  |  |  |  | # All Rights Reserved. See file COPYRIGHT for details. | 
| 6 |  |  |  |  |  |  | # | 
| 7 |  |  |  |  |  |  | # This module is part of Event::RPC, which is free software; you can | 
| 8 |  |  |  |  |  |  | # redistribute it and/or modify it under the same terms as Perl itself. | 
| 9 |  |  |  |  |  |  | #----------------------------------------------------------------------- | 
| 10 |  |  |  |  |  |  |  | 
| 11 |  |  |  |  |  |  | package Event::RPC::Message::SerialiserBase; | 
| 12 |  |  |  |  |  |  |  | 
| 13 | 21 |  |  | 21 |  | 141 | use base Event::RPC::Message; | 
|  | 21 |  |  |  |  | 41 |  | 
|  | 21 |  |  |  |  | 1767 |  | 
| 14 |  |  |  |  |  |  |  | 
| 15 | 21 |  |  | 21 |  | 133 | use strict; | 
|  | 21 |  |  |  |  | 43 |  | 
|  | 21 |  |  |  |  | 452 |  | 
| 16 | 21 |  |  | 21 |  | 87 | use utf8; | 
|  | 21 |  |  |  |  | 40 |  | 
|  | 21 |  |  |  |  | 116 |  | 
| 17 |  |  |  |  |  |  |  | 
| 18 |  |  |  |  |  |  | sub UNIVERSAL::FREEZE { | 
| 19 | 1 |  |  | 1 | 0 | 3 | my ($object, $serialiser) = @_; | 
| 20 | 1 |  |  |  |  | 7 | my ($ref_type) = "$object" =~ /=(\w+)\(/; | 
| 21 | 1 |  |  |  |  | 9 | return $ref_type eq 'HASH'   ? [ $ref_type, [%{$object}] ] : | 
| 22 | 0 |  |  |  |  | 0 | $ref_type eq 'ARRAY'  ? [ $ref_type, [@{$object}] ] : | 
| 23 | 1 | 0 |  |  |  | 5 | $ref_type eq 'SCALAR' ? [ $ref_type,  ${$object}  ] : | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  |  | 50 |  |  |  |  |  | 
| 24 |  |  |  |  |  |  | die "Unsupported reference type '$ref_type'"; | 
| 25 |  |  |  |  |  |  | } | 
| 26 |  |  |  |  |  |  |  | 
| 27 |  |  |  |  |  |  | sub UNIVERSAL::THAW { | 
| 28 | 11 |  |  | 11 | 0 | 66 | my ($class, $serialiser, $obj) = @_; | 
| 29 | 11 |  |  |  |  | 187 | return $obj->[0] eq 'HASH'   ? bless { @{$obj->[1]} }, $class : | 
| 30 | 11 | 0 |  |  |  | 99 | $obj->[0] eq 'ARRAY'  ? bless [ @{$obj->[1]} ], $class : | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 31 |  |  |  |  |  |  | $obj->[0] eq 'SCALAR' ? bless \   $obj->[1],    $class : | 
| 32 |  |  |  |  |  |  | die "Unsupported reference type '$obj->[0]'"; | 
| 33 |  |  |  |  |  |  | } | 
| 34 |  |  |  |  |  |  |  | 
| 35 |  |  |  |  |  |  | 1; | 
| 36 |  |  |  |  |  |  |  | 
| 37 |  |  |  |  |  |  | __END__ |