| … | |
… | |
| 966 | |
966 | |
| 967 | =cut |
967 | =cut |
| 968 | |
968 | |
| 969 | ############################################################################# |
969 | ############################################################################# |
| 970 | # object support |
970 | # object support |
| 971 | # |
|
|
| 972 | |
971 | |
|
|
972 | sub _object_equal($$); |
|
|
973 | sub _object_equal($$) { |
|
|
974 | my ($a, $b) = @_; |
|
|
975 | |
|
|
976 | return 0 unless (ref $a) eq (ref $b); |
|
|
977 | |
|
|
978 | if ("HASH" eq ref $a) { |
|
|
979 | my @ka = keys %$a; |
|
|
980 | my @kb = keys %$b; |
|
|
981 | |
|
|
982 | return 0 if @ka != @kb; |
|
|
983 | |
|
|
984 | for (0 .. $#ka) { |
|
|
985 | return 0 unless $ka[$_] eq $kb[$_]; |
|
|
986 | return 0 unless _object_equal $a->{$ka[$_]}, $b->{$kb[$_]}; |
|
|
987 | } |
|
|
988 | |
|
|
989 | } elsif ("ARRAY" eq ref $a) { |
|
|
990 | |
|
|
991 | return 0 if @$a != @$b; |
|
|
992 | |
|
|
993 | for (0 .. $#$a) { |
|
|
994 | return 0 unless _object_equal $a->[$_], $b->[$_]; |
|
|
995 | } |
|
|
996 | |
|
|
997 | } elsif ($a ne $b) { |
|
|
998 | return 0; |
|
|
999 | } |
|
|
1000 | |
|
|
1001 | 1 |
|
|
1002 | } |
|
|
1003 | |
|
|
1004 | our $SLOW_MERGES;#d# |
| 973 | sub _can_merge { |
1005 | sub _can_merge { |
| 974 | my ($ob1, $ob2) = @_; |
1006 | my ($ob1, $ob2) = @_; |
| 975 | |
1007 | |
| 976 | return 1;#d# |
1008 | ++$SLOW_MERGES;#d# |
| 977 | |
1009 | |
| 978 | #todo#d# kill yourself and do some recursive checking manually without storable |
1010 | # we do the slow way here |
| 979 | sync_job { |
1011 | return _object_equal $ob1, $ob2 |
| 980 | my $guard = Coro::Storable::guard; |
|
|
| 981 | local $Storable::canonical = 1; |
|
|
| 982 | my $fob1 = Storable::freeze $ob1; |
|
|
| 983 | my $fob2 = Storable::freeze $ob2; |
|
|
| 984 | $fob1 eq $fob2 |
|
|
| 985 | } |
|
|
| 986 | } |
1012 | } |
| 987 | |
1013 | |
| 988 | sub reattach { |
1014 | sub reattach { |
| 989 | # basically do the same as instantiate, without calling instantiate |
1015 | # basically do the same as instantiate, without calling instantiate |
| 990 | my ($obj) = @_; |
1016 | my ($obj) = @_; |
