Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Lh596 mt5 serialize changes #153

Merged
2 commits merged into from
Dec 7, 2010
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
26 changes: 22 additions & 4 deletions lib/MT/Serialize.pm
Original file line number Diff line number Diff line change
Expand Up @@ -7,13 +7,13 @@
package MT::Serialize;

use strict;
our $VERSION = 4;
our $VERSION = 5;

{
my %Types = (
Storable => [ \&_freeze_storable, \&_thaw_storable ],
JSON => [ \&_freeze_json, \&_thaw_json ],
MT => [ \&_freeze_mt_2, \&_thaw_mt ],
MT => [ \&_freeze_mt_5, \&_thaw_mt ],
MT2 => [ \&_freeze_mt_2, \&_thaw_mt ],
MTS => [ \&_freeze_mt_storable, \&_thaw_mt ],
MTJ => [ \&_freeze_mt_json, \&_thaw_mt ],
Expand Down Expand Up @@ -74,6 +74,7 @@ sub _freeze_mt_1 {
}

sub _macrofreeze {
use bytes;
my $value = shift;
my $ref_cnt = 1; # for compatibility with the existing algorithm
my %refs;
Expand Down Expand Up @@ -124,8 +125,7 @@ sub _macrofreeze {
}
elsif ( $ref eq 'HASH' ) {
$frozen .= 'H' . pack( 'N', scalar( keys %$value ) );
push( @stack, [ 'HASH' => %$value ] )
if scalar keys %$value;
push( @stack, [ 'HASH' => %$value ] ) if keys %$value;
}
else {
die "Unexpected type '$ref' in _macrofreeze\n";
Expand Down Expand Up @@ -176,6 +176,18 @@ sub no_utf8 {
}
}

sub _freeze_mt_5 {
my $enc = MT->config('PublishCharset') || 'UTF-8';
no warnings 'redefine';
local *no_utf8 = sub {
for (@_) {
next if ref;
$_ = Encode::encode( $enc, $_ ) if Encode::is_utf8($_);
}
};
_freeze_mt_2(@_);
}

sub _thaw_mt {
my ($frozen) = @_;
return \{} unless $frozen && substr( $frozen, 0, 4 ) eq 'SERG';
Expand Down Expand Up @@ -216,11 +228,13 @@ sub _thaw_mt_1 {
}

sub _macrowave {
use bytes;
@_ == 2 or die "_macrowave expects: \$frozen, \$pos\n";
my ( $frozen, $pos ) = @_;
my $refs = [undef];
my $len = length $frozen;
my ( @stack, $value );
my $enc = MT->app->config('PublishCharset') || 'UTF-8';
while ( $pos < $len ) {
my $type = substr( $frozen, $pos, 1 );
$pos++;
Expand All @@ -246,6 +260,8 @@ sub _macrowave {
: $type eq 'S' ? do { # scalarref
my $slen = unpack 'N', substr( $frozen, $pos, 4 );
my $col_val = substr( $frozen, $pos + 4, $slen );
$col_val = Encode::decode( $enc, $col_val )
if !( Encode::is_utf8($col_val) );
$pos += 4 + $slen;
push @$refs, \$col_val;
\$col_val;
Expand All @@ -259,6 +275,8 @@ sub _macrowave {
: $type eq '-' ? do { # scalar value
my $slen = unpack 'N', substr( $frozen, $pos, 4 );
my $col_val = substr( $frozen, $pos + 4, $slen );
$col_val = Encode::decode( $enc, $col_val )
if !( Encode::is_utf8($col_val) );
$pos += 4 + $slen;
$col_val;
}
Expand Down
137 changes: 53 additions & 84 deletions t/80-serialize.t
Original file line number Diff line number Diff line change
Expand Up @@ -3,9 +3,7 @@
use strict;
use warnings;

use lib 'extlib';
use lib 'lib';
use lib 't/lib';
use lib qw( t/lib lib extlib ../lib ../extlib );

use MT;
use MT::Test;
Expand All @@ -15,14 +13,14 @@ use Data::Dumper;
require MT::Serialize;

if ( $MT::Serialize::VERSION <= 2 ) {
plan skip_all => "This test is for MT::Serialize v3 and higher; "
. "the current version is $MT::Serialize::VERSION";
plan skip_all =>
"This test is for MT::Serialize v3 and higher; the current version is $MT::Serialize::VERSION";
}
else {
plan tests => 112;
plan tests => 100;
}

is( $MT::Serialize::VERSION, 4, 'Default version is v4' );
is( $MT::Serialize::VERSION, 5, 'Default version is v5' );

my %sers
= map { $_ => MT::Serialize->new($_) } qw(MTJ JSON MT MT2 MTS Storable);
Expand Down Expand Up @@ -51,65 +49,24 @@ my $data2 = [
];
$data2->[1]->{z} = $data2;

SKIP: {
skip "Missing Test::LeakTrace", 6 unless eval { require Test::LeakTrace };

for my $label ( keys %sers ) {
my $ser = $sers{$label};

print "# Checking leaks for $label\n";

$ser->serialize( \$data1 )
; # call it once outside of leak check to make sure we load the serialization backend

TODO: {
local $TODO
= ( $label eq 'MTJ' || $label eq 'MTS' )
? "MTJ and MTS are leaking..."
: undef;

is(
Test::LeakTrace::leaked_count(
sub {
my $frozen = $ser->serialize( \$data1 );
my $thawed = ${ $ser->unserialize($frozen) };
}
),
0,
"No leaks with no circular data"
);
}

SKIP: {
skip "JSON format doesn't support circular references" => 1
if $label eq 'MTJ' || $label eq 'JSON';
like(
Test::LeakTrace::leaked_count(
sub {
my $frozen = $ser->serialize( \$data2 );
my $thawed = ${ $ser->unserialize($frozen) };
}
),
qr/^(17|18|19)$/,
"17-19 leaks with circular data"
);
}
} ## end for my $label ( keys %sers)
} ## end SKIP:

use Data::Dumper;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Indent = 0;

my $dj = q![1,{'a'=>'value-a','b'=>[1],'c'=>['array',[1],3,2],'d'=>1},undef]!
; # to use with JSON
# to use with JSON
my $dj = q![1,{'a'=>'value-a','b'=>[1],'c'=>['array',[1],3,2],'d'=>1},undef]!;

# to use for non-recursive structure
my $dn
= q![1,{'a'=>'value-a','b'=>[1],'c'=>['array',$VAR1->[1]{'b'},3,2],'d'=>1},undef]!
; # to use for non-recursive structure
my $dd
= q![1,{'a'=>'value-a','b'=>[1],'c'=>['array',$VAR1->[1]{'b'},\'3',2],'d'=>1,'z'=>$VAR1},undef]!
; # to use for recursive structure
= q![1,{'a'=>'value-a','b'=>[1],'c'=>['array',$VAR1->[1]{'b'},3,2],'d'=>1},undef]!;

# to use for recursive structure
my $dd = sub {
$_[0] eq
q![1,{'a'=>'value-a','b'=>[1],'c'=>['array',$VAR1->[1]{'b'},\'3',2],'d'=>1,'z'=>$VAR1},undef]!
|| $_[0] eq
q![1,{'a'=>'value-a','b'=>[1],'c'=>['array',$VAR1->[1]{'b'},\3,2],'d'=>1,'z'=>$VAR1},undef]!;
};

# serialize and deserialize, check the results
# compare structures with Data::Dumper
Expand All @@ -119,23 +76,23 @@ for my $label ( keys %sers ) {
print "# Checking serialization for $label\n";
my $json = ( $label eq 'JSON' || $label eq 'MTJ' );

my $data_to_freeze = $json ? \$data1 : \$data2;
my $frozen = $ser->serialize($data_to_freeze);
my $thawed = ${ $ser->unserialize($frozen) };
my $frozen = $ser->serialize( $json ? \$data1 : \$data2 );
my $thawed = ${ $ser->unserialize($frozen) };

is( ref $thawed, 'ARRAY', 'Correct type ARRAYREF' );
is( scalar @$thawed, 3, 'Array with 3 elements' );
is( $thawed->[0], 1, 'Correct value in the array' );
is( ref $thawed, 'ARRAY', 'Returns correct type ARRAYREF' );
is( scalar @$thawed, 3, 'Returns array with 3 elements' );
is( $thawed->[0], 1, 'Returns correct value in the array' );
ok( !defined $thawed->[-1], 'Last element is undef' );
is( ref $thawed->[1], 'HASH', 'Correct type HASHREF' );
is( $thawed->[1]{a}, 'value-a', 'Correct value for HASH{a}' );
is( ref $thawed->[1]{b}, 'ARRAY', 'Correct value for HASH{b} 1/3' );
is( $thawed->[1]{b}[0], 1, 'Correct value for HASH{b} 2/3' );
is( @{ $thawed->[1]{b} }, 1, 'Correct value for HASH{b} 3/3' );
is( ref $thawed->[1]{c}, 'ARRAY', 'Correct value for HASH{c} 1/3' );
is( @{ $thawed->[1]{c} }, 4, 'Correct value for HASH{c} 2/3' );
is( $thawed->[1]{d}, 1, 'Correct value for HASH{d}' );

is( ref $thawed->[1], 'HASH', 'Returns correct type HASHREF' );
is( $thawed->[1]{a}, 'value-a', 'Returns correct value for HASH{a}' );
is( ref $thawed->[1]{b},
'ARRAY', 'Returns correct value for HASH{b} 1/3' );
is( $thawed->[1]{b}[0], 1, 'Returns correct value for HASH{b} 2/3' );
is( @{ $thawed->[1]{b} }, 1, 'Returns correct value for HASH{b} 3/3' );
is( ref $thawed->[1]{c},
'ARRAY', 'Returns correct value for HASH{c} 1/3' );
is( @{ $thawed->[1]{c} }, 4, 'Returns correct value for HASH{c} 2/3' );
is( $thawed->[1]{d}, 1, 'Returns correct value for HASH{d}' );
SKIP: {
skip "JSON format doesn't support scalar and circular references" => 3
if $label eq 'MTJ' || $label eq 'JSON';
Expand All @@ -150,18 +107,31 @@ for my $label ( keys %sers ) {

# fix stringified numbers for MT2
if ( $label eq 'MT2' || $label eq 'MT' ) {

# $_ += 0 for $thawed->[0], $thawed->[1]{b}[0], ${$thawed->[1]{c}[2]}, $thawed->[1]{c}[3], $thawed->[1]{d};
$_ += 0
for $thawed->[0], $thawed->[1]{b}[0], $thawed->[1]{c}[3],
$thawed->[1]{d};
}

my $dump = Dumper($thawed);
$dump =~ s/^\$VAR1\s*=\s*|\s|;$//g; # remove spaces, $VAR and ; if any
is( $dump,
( $json ? $dj : $dd ),
"Data dumped by Data::Dumper, frozen by $label" );
my $expected_dump_map = {
MTJ => $dj,
JSON => $dj,
MT => $dd,
MT2 => $dd,
MTS => $dd,
Storable => $dd,
};

( my $dump = Dumper($thawed) )
=~ s/^\$VAR1\s*=\s*|\s|;$//g; # remove spaces, $VAR and ; if any
my $expect = $expected_dump_map->{$label};
if ( ref $expect ) {
ok( $expect->($dump),
'Returns the structure that matches Data::Dumper\'s' );
}
else {
is( $dump, $expect,
'Returns the structure that matches Data::Dumper\'s' );
}
} ## end for my $label ( keys %sers)

for my $label (qw(MT2 MTJ MTS)) {
Expand All @@ -183,8 +153,7 @@ for my $label (qw(MT2 MTJ MTS)) {
is(
$dump,
( $label eq 'MTJ' ? $dj : $dn ),
"Serialize with $label, deserialize with MT, "
. "which provides backward compatibility"
"Serialize with $label, deserialize with MT, which provides backward compatibility"
);
} ## end for my $label (qw(MT2 MTJ MTS))