diff --git a/perl/.gitignore b/perl/.gitignore index f060908..b806d2b 100644 --- a/perl/.gitignore +++ b/perl/.gitignore @@ -11,3 +11,4 @@ pm_to_blib unpack.o MANIFEST ppport.h +.testenv/ diff --git a/perl/Changes b/perl/Changes index 189990a..9b061cf 100644 --- a/perl/Changes +++ b/perl/Changes @@ -1,3 +1,16 @@ +0.16_01 + + - added PP version (used in cases PERL_DATA_MESSAGEPACK=pp or fail to load XS). + - made Makefile.PL PP configurable. + - test_pp in author's test + - modified t/05_preferred_int.t for Win32 + (makamaka) + +0.16 + + - tests on 64bit machines with -Duselongdouble + (reported by andk) + 0.15 - better argument validation. diff --git a/perl/Makefile.PL b/perl/Makefile.PL index e9f9618..783e658 100644 --- a/perl/Makefile.PL +++ b/perl/Makefile.PL @@ -5,15 +5,38 @@ name 'Data-MessagePack'; all_from 'lib/Data/MessagePack.pm'; readme_from('lib/Data/MessagePack.pm'); -perl_version '5.008005'; +perl_version '5.008000'; license 'perl'; -can_cc or die "This module requires a C compiler"; tests 't/*.t'; recursive_author_tests('xt'); -use_ppport 3.19; -requires_c99(); # msgpack C library requires C99. + +if ( $] >= 5.008005 and want_xs() ) { + can_cc or die "This module requires a C compiler. Please retry with --pp"; + + my $has_c99 = c99_available(); # msgpack C library requires C99. + + if ( $has_c99 ) { + use_ppport 3.19; + cc_src_paths('xs-src'); + if ($ENV{DEBUG}) { + cc_append_to_ccflags '-g'; + } + } + else { + print <catfile('..', 'msgpack')) { mkdir 'msgpack' unless -d 'msgpack'; @@ -39,7 +58,50 @@ if ($Module::Install::AUTHOR && -d File::Spec->catfile('..', 'msgpack')) { requires 'Test::More' => 0.94; # done_testing test_requires('Test::Requires'); +test_with_env( test_pp => PERL_DATA_MESSAGEPACK => 'pp' ); + +if($Module::Install::AUTHOR) { + postamble qq{test :: test_pp\n\n}; +} + auto_set_repository(); auto_include; WriteAll; +# copied from Makefile.PL in Text::Xslate. +sub test_with_env { + my($name, %env) = @_; + + my $dir = '.testenv'; + if(not -e $dir) { + mkdir $dir or die "Cannot mkdir '.testenv': $!"; + } + clean_files($dir); + + { + open my $out, '>', "$dir/$name.pl" + or die "Cannot open '$dir/$name.pl' for writing: $!"; + print $out "# This file sets the env for 'make $name', \n"; + print $out "# generated by $0 at ", scalar(localtime), ".\n"; + print $out "# DO NOT EDIT THIS FILE DIRECTLY.\n"; + print $out "\n"; + + while(my($name, $value) = each %env) { + printf $out '$ENV{q{%s}} = q{%s};'."\n", $name, $value; + } + } + + # repeat testing for pure Perl mode + # see also ExtUtils::MM_Any::test_via_harness() + + my $t = q{$(FULLPERLRUN) -MExtUtils::Command::MM -e} + .q{ "do q[%s]; test_harness($(TEST_VERBOSE), '$(INST_LIB)', '$(INST_ARCHLIB)')"} + .q{ $(TEST_FILES)}; + + postamble qq{$name :: pure_all\n} + . qq{\t} . q{$(NOECHO) $(ECHO) TESTING: } . $name . qq{\n} + . qq{\t} . sprintf($t, "$dir/$name.pl") . qq{\n\n} + + . qq{testall :: $name\n\n}; + return; +} diff --git a/perl/lib/Data/MessagePack.pm b/perl/lib/Data/MessagePack.pm index 276353a..d53ff22 100644 --- a/perl/lib/Data/MessagePack.pm +++ b/perl/lib/Data/MessagePack.pm @@ -1,10 +1,9 @@ package Data::MessagePack; use strict; use warnings; -use XSLoader; use 5.008001; -our $VERSION = '0.15'; +our $VERSION = '0.16'; our $PreferInteger = 0; our $true = do { bless \(my $dummy = 1), "Data::MessagePack::Boolean" }; @@ -12,7 +11,19 @@ our $false = do { bless \(my $dummy = 0), "Data::MessagePack::Boolean" }; sub true () { $true } sub false () { $false } -XSLoader::load(__PACKAGE__, $VERSION); +if ( !__PACKAGE__->can('pack') ) { # this idea comes from Text::Xslate + my $backend = $ENV{ PERL_DATA_MESSAGEPACK } || ''; + if ( $backend !~ /\b pp \b/xms ) { + eval { + require XSLoader; + XSLoader::load(__PACKAGE__, $VERSION); + }; + die $@ if $@ && $backend =~ /\b xs \b/xms; # force XS + } + if ( !__PACKAGE__->can('pack') ) { + require 'Data/MessagePack/PP.pm'; + } +} 1; __END__ diff --git a/perl/lib/Data/MessagePack/PP.pm b/perl/lib/Data/MessagePack/PP.pm new file mode 100644 index 0000000..9e32299 --- /dev/null +++ b/perl/lib/Data/MessagePack/PP.pm @@ -0,0 +1,546 @@ +package Data::MessagePack::PP; + +use 5.008000; +use strict; +use Carp (); + +our $VERSION = '0.15'; + +# See also +# http://redmine.msgpack.org/projects/msgpack/wiki/FormatSpec +# http://cpansearch.perl.org/src/YAPPO/Data-Model-0.00006/lib/Data/Model/Driver/Memcached.pm +# http://frox25.no-ip.org/~mtve/wiki/MessagePack.html : reference to using CORE::pack, CORE::unpack + + +package + Data::MessagePack; + +use Scalar::Util qw( blessed ); +use strict; +use B (); + +BEGIN { + # for pack and unpack compatibility + if ( $] < 5.010 ) { + # require $Config{byteorder}; my $bo_is_le = ( $Config{byteorder} =~ /^1234/ ); + # which better? + my $bo_is_le = unpack ( 'd', "\x00\x00\x00\x00\x00\x00\xf0\x3f") == 1; # 1.0LE + # In really, since 5.9.2 '>' is introduced. but 'n!' and 'N!'? + *pack_uint64 = $bo_is_le ? sub { + my @v = unpack( 'V2', pack( 'Q', $_[0] ) ); + return pack 'CN2', 0xcf, @v[1,0]; + } : sub { pack 'CQ', 0xcf, $_[0]; }; + *pack_int64 = $bo_is_le ? sub { + my @v = unpack( 'V2', pack( 'q', $_[0] ) ); + return pack 'CN2', 0xd3, @v[1,0]; + } : sub { pack 'Cq', 0xd3, $_[0]; }; + *pack_double = $bo_is_le ? sub { + my @v = unpack( 'V2', pack( 'd', $_[0] ) ); + return pack 'CN2', 0xcb, @v[1,0]; + } : sub { pack 'Cd', 0xcb, $_[0]; }; + *unpack_float = $bo_is_le ? sub { + my @v = unpack( 'v2', substr( $_[0], $_[1], 4 ) ); + return unpack( 'f', pack( 'n2', @v[1,0] ) ); + } : sub { return unpack( 'f', substr( $_[0], $_[1], 4 ) ); }; + *unpack_double = $bo_is_le ? sub { + my @v = unpack( 'V2', substr( $_[0], $_[1], 8 ) ); + return unpack( 'd', pack( 'N2', @v[1,0] ) ); + } : sub { return unpack( 'd', substr( $_[0], $_[1], 8 ) ); }; + *unpack_int16 = sub { + my $v = unpack 'n', substr( $_[0], $_[1], 2 ); + return $v ? $v - 0x10000 : 0; + }; + *unpack_int32 = sub { + no warnings; # avoid for warning about Hexadecimal number + my $v = unpack 'N', substr( $_[0], $_[1], 4 ); + return $v ? $v - 0x100000000 : 0; + }; + *unpack_int64 = $bo_is_le ? sub { + my @v = unpack( 'V*', substr( $_[0], $_[1], 8 ) ); + return unpack( 'q', pack( 'N2', @v[1,0] ) ); + } : sub { pack 'q', substr( $_[0], $_[1], 8 ); }; + *unpack_uint64 = $bo_is_le ? sub { + my @v = unpack( 'V*', substr( $_[0], $_[1], 8 ) ); + return unpack( 'Q', pack( 'N2', @v[1,0] ) ); + } : sub { pack 'Q', substr( $_[0], $_[1], 8 ); }; + } + else { + *pack_uint64 = sub { return pack 'CQ>', 0xcf, $_[0]; }; + *pack_int64 = sub { return pack 'Cq>', 0xd3, $_[0]; }; + *pack_double = sub { return pack 'Cd>', 0xcb, $_[0]; }; + *unpack_float = sub { return unpack( 'f>', substr( $_[0], $_[1], 4 ) ); }; + *unpack_double = sub { return unpack( 'd>', substr( $_[0], $_[1], 8 ) ); }; + *unpack_int16 = sub { return unpack( 'n!', substr( $_[0], $_[1], 2 ) ); }; + *unpack_int32 = sub { return unpack( 'N!', substr( $_[0], $_[1], 4 ) ); }; + *unpack_int64 = sub { return unpack( 'q>', substr( $_[0], $_[1], 8 ) ); }; + *unpack_uint64 = sub { return unpack( 'Q>', substr( $_[0], $_[1], 8 ) ); }; + } + # for 5.8 etc. + unless ( defined &utf8::is_utf8 ) { + require Encode; + *utf8::is_utf8 = *Encode::is_utf8; + } +} + + +# +# PACK +# + +{ + no warnings 'recursion'; + + my $max_depth; + +sub pack { + Carp::croak('Usage: Data::MessagePack->pack($dat [,$max_depth])') if @_ < 2; + $max_depth = defined $_[2] ? $_[2] : 512; # init + return _pack( $_[1] ); +} + + +sub _pack { + my ( $value ) = @_; + + return CORE::pack( 'C', 0xc0 ) if ( not defined $value ); + + my $b_obj = B::svref_2object( ref $value ? $value : \$value ); + + if ( $b_obj->isa('B::AV') ) { + my $num = @$value; + my $header = + $num < 16 ? CORE::pack( 'C', 0x90 + $num ) + : $num < 2 ** 16 - 1 ? CORE::pack( 'Cn', 0xdc, $num ) + : $num < 2 ** 32 - 1 ? CORE::pack( 'CN', 0xdd, $num ) + : die "" # don't arrivie here + ; + if ( --$max_depth <= 0 ) { + Carp::croak("perl structure exceeds maximum nesting level (max_depth set too low?)"); + } + return join( '', $header, map { _pack( $_ ) } @$value ); + } + + elsif ( $b_obj->isa('B::HV') ) { + my $num = keys %$value; + my $header = + $num < 16 ? CORE::pack( 'C', 0x80 + $num ) + : $num < 2 ** 16 - 1 ? CORE::pack( 'Cn', 0xde, $num ) + : $num < 2 ** 32 - 1 ? CORE::pack( 'CN', 0xdf, $num ) + : die "" # don't arrivie here + ; + if ( --$max_depth <= 0 ) { + Carp::croak("perl structure exceeds maximum nesting level (max_depth set too low?)"); + } + return join( '', $header, map { _pack( $_ ) } %$value ); + } + + elsif ( blessed( $value ) and blessed( $value ) eq 'Data::MessagePack::Boolean' ) { + return CORE::pack( 'C', $$value ? 0xc3 : 0xc2 ); + } + + my $flags = $b_obj->FLAGS; + + if ( $flags & ( B::SVf_IOK | B::SVp_IOK ) ) { + + if ($value >= 0) { + return $value <= 127 ? CORE::pack 'C', $value + : $value < 2 ** 8 ? CORE::pack 'CC', 0xcc, $value + : $value < 2 ** 16 ? CORE::pack 'Cn', 0xcd, $value + : $value < 2 ** 32 ? CORE::pack 'CN', 0xce, $value + : pack_uint64( $value ); + } + else { + return -$value <= 32 ? CORE::pack 'C', ($value & 255) + : -$value <= 2 ** 7 ? CORE::pack 'Cc', 0xd0, $value + : -$value <= 2 ** 15 ? CORE::pack 'Cn', 0xd1, $value + : -$value <= 2 ** 31 ? CORE::pack 'CN', 0xd2, $value + : pack_int64( $value ); + } + + } + + elsif ( $flags & B::SVf_POK ) { # raw / check needs before dboule + + if ( $Data::MessagePack::PreferInteger ) { + if ( $value =~ /^-?[0-9]+$/ ) { # ok? + my $value2 = 0 + $value; + if ( $value > 0xFFFFFFFF or $value < '-'.0x80000000 or # <- needless but for XS compat + 0 + $value != B::svref_2object( \$value2 )->int_value + ) { + local $Data::MessagePack::PreferInteger; # avoid for PV => NV + return _pack( "$value" ); + } + return _pack( $value + 0 ); + } + } + + utf8::encode( $value ) if utf8::is_utf8( $value ); + + my $num = length $value; + my $header = + $num < 32 ? CORE::pack( 'C', 0xa0 + $num ) + : $num < 2 ** 16 - 1 ? CORE::pack( 'Cn', 0xda, $num ) + : $num < 2 ** 32 - 1 ? CORE::pack( 'CN', 0xdb, $num ) + : die "" # don't arrivie here + ; + + return $header . $value; + + } + + elsif ( $flags & ( B::SVf_NOK | B::SVp_NOK ) ) { # double only + return pack_double( $value ); + } + + else { + die "???"; + } + +} + +} # PACK + + +# +# UNPACK +# + +{ + + my $p; # position variables for speed. + +sub unpack { + $p = 0; # init + _unpack( $_[1] ); +} + + +sub _unpack { + my ( $value ) = @_; + my $byte = CORE::unpack( 'C', substr( $value, $p++, 1 ) ); # get header + + die "invalid data" unless defined $byte; + + if ( ( $byte >= 0x90 and $byte <= 0x9f ) or $byte == 0xdc or $byte == 0xdd ) { + my $num; + if ( $byte == 0xdc ) { # array 16 + $num = CORE::unpack 'n', substr( $value, $p, 2 ); + $p += 2; + } + elsif ( $byte == 0xdd ) { # array 32 + $num = CORE::unpack 'N', substr( $value, $p, 4 ); + $p += 4; + } + else { # fix array + $num = $byte & ~0x90; + } + my @array; + push @array, _unpack( $value ) while $num-- > 0; + return \@array; + } + + elsif ( ( $byte >= 0x80 and $byte <= 0x8f ) or $byte == 0xde or $byte == 0xdf ) { + my $num; + if ( $byte == 0xde ) { # map 16 + $num = CORE::unpack 'n', substr( $value, $p, 2 ); + $p += 2; + } + elsif ( $byte == 0xdf ) { # map 32 + $num = CORE::unpack 'N', substr( $value, $p, 4 ); + $p += 4; + } + else { # fix map + $num = $byte & ~0x80; + } + my %map; + for ( 0 .. $num - 1 ) { + no warnings; # for undef key case + my $key = _unpack( $value ); + my $val = _unpack( $value ); + $map{ $key } = $val; + } + return \%map; + } + + elsif ( $byte >= 0x00 and $byte <= 0x7f ) { # positive fixnum + return $byte; + } + elsif ( $byte == 0xcc ) { # uint8 + CORE::unpack( 'C', substr( $value, $p++, 1 ) ); + } + elsif ( $byte == 0xcd ) { # uint16 + $p += 2; + return CORE::unpack 'n', substr( $value, $p - 2, 2 ); + } + elsif ( $byte == 0xce ) { # unit32 + $p += 4; + return CORE::unpack 'N', substr( $value, $p - 4, 4 ); + } + elsif ( $byte == 0xcf ) { # unit64 + $p += 8; + return unpack_uint64( $value, $p - 8 ); + } + elsif ( $byte == 0xd3 ) { # int64 + $p += 8; + return unpack_int64( $value, $p - 8 ); + } + elsif ( $byte == 0xd2 ) { # int32 + $p += 4; + return unpack_int32( $value, $p - 4 ); + } + elsif ( $byte == 0xd1 ) { # int16 + $p += 2; + return unpack_int16( $value, $p - 2 ); + } + elsif ( $byte == 0xd0 ) { # int8 + return CORE::unpack 'c', substr( $value, $p++, 1 ); # c / C + } + elsif ( $byte >= 0xe0 and $byte <= 0xff ) { # negative fixnum + return $byte - 256; + } + + elsif ( ( $byte >= 0xa0 and $byte <= 0xbf ) or $byte == 0xda or $byte == 0xdb ) { # raw + my $num; + if ( $byte == 0xda ) { + $num = CORE::unpack 'n', substr( $value, $p, 2 ); + $p += 2 + $num; + } + elsif ( $byte == 0xdb ) { + $num = CORE::unpack 'N', substr( $value, $p, 4 ); + $p += 4 + $num; + } + else { # fix raw + $num = $byte & ~0xa0; + $p += $num; + } + return substr( $value, $p - $num, $num ); + } + + elsif ( $byte == 0xc0 ) { # nil + return undef; + } + elsif ( $byte == 0xc2 ) { # boolean + return false; + } + elsif ( $byte == 0xc3 ) { # boolean + return true; + } + + elsif ( $byte == 0xcb ) { # double + $p += 8; + return unpack_double( $value, $p - 8 ); + } + + elsif ( $byte == 0xca ) { # float + $p += 4; + return unpack_float( $value, $p - 4 ); + } + + else { + die "???"; + } + +} + + +} # UNPACK + + +# +# Data::MessagePack::Unpacker +# + +package + Data::MessagePack::Unpacker; + +use strict; + +sub new { + bless { stack => [] }, shift; +} + + +sub execute_limit { + execute( @_ ); +} + + +{ + my $p; + +sub execute { + my ( $self, $data, $offset, $limit ) = @_; + my $value = substr( $data, $offset, $limit ? $limit : length $data ); + my $len = length $value; + + $p = 0; + + while ( $len > $p ) { + _count( $self, $value ) or last; + + if ( @{ $self->{stack} } > 0 ) { + pop @{ $self->{stack} } if --$self->{stack}->[-1] == 0; + } + } + + if ( $len == $p ) { + $self->{ data } .= substr( $value, 0, $p ); + $self->{ remain } = undef; + } + + return $p; +} + + +sub _count { + my ( $self, $value ) = @_; + my $byte = unpack( 'C', substr( $value, $p++, 1 ) ); # get header + + if ( ( $byte >= 0x90 and $byte <= 0x9f ) or $byte == 0xdc or $byte == 0xdd ) { + my $num; + if ( $byte == 0xdc ) { # array 16 + $num = unpack 'n', substr( $value, $p, 2 ); + $p += 2; + } + elsif ( $byte == 0xdd ) { # array 32 + $num = unpack 'N', substr( $value, $p, 4 ); + $p += 4; + } + else { # fix array + $num = $byte & ~0x90; + } + + push @{ $self->{stack} }, $num + 1; + + return 1; + } + + elsif ( ( $byte >= 0x80 and $byte <= 0x8f ) or $byte == 0xde or $byte == 0xdf ) { + my $num; + if ( $byte == 0xde ) { # map 16 + $num = unpack 'n', substr( $value, $p, 2 ); + $p += 2; + } + elsif ( $byte == 0xdf ) { # map 32 + $num = unpack 'N', substr( $value, $p, 4 ); + $p += 4; + } + else { # fix map + $num = $byte & ~0x80; + } + + push @{ $self->{stack} }, $num * 2 + 1; # a pair + + return 1; + } + + elsif ( $byte == 0xc0 or $byte == 0xc2 or $byte == 0xc3 ) { # nil, false, true + return 1; + } + + elsif ( $byte >= 0x00 and $byte <= 0x7f ) { # positive fixnum + return 1; + } + + elsif ( $byte >= 0xcc and $byte <= 0xcf ) { # uint + $p += $byte == 0xcc ? 1 + : $byte == 0xcd ? 2 + : $byte == 0xce ? 4 + : $byte == 0xcf ? 8 + : die; + return 1; + } + + elsif ( $byte >= 0xd0 and $byte <= 0xd3 ) { # int + $p += $byte == 0xd0 ? 1 + : $byte == 0xd1 ? 2 + : $byte == 0xd2 ? 4 + : $byte == 0xd3 ? 8 + : die; + return 1; + } + + elsif ( $byte >= 0xe0 and $byte <= 0xff ) { # negative fixnum + return 1; + } + + elsif ( $byte >= 0xca and $byte <= 0xcb ) { # float, double + $p += $byte == 0xca ? 4 : 8; + return 1; + } + + elsif ( ( $byte >= 0xa0 and $byte <= 0xbf ) or $byte == 0xda or $byte == 0xdb ) { + my $num; + if ( $byte == 0xda ) { + $num = unpack 'n', substr( $value, $p, 2 ); + $p += 2; + } + elsif ( $byte == 0xdb ) { + $num = unpack 'N', substr( $value, $p, 4 ); + $p += 4; + } + else { # fix raw + $num = $byte & ~0xa0; + } + $p += $num; + return 1; + } + + else { + die "???"; + } + + return 0; +} + +} # execute + + +sub data { + my $data = Data::MessagePack->unpack( $_[0]->{ data } ); + $_[0]->reset; + return $data; +} + + +sub is_finished { + my ( $self ) = @_; + ( scalar( @{ $self->{stack} } ) or defined $self->{ remain } ) ? 0 : 1; +} + + +sub reset { + $_[0]->{ stack } = []; + $_[0]->{ data } = undef; + $_[0]->{ remain } = undef; +} + +1; +__END__ + +=pod + +=head1 NAME + +Data::MessagePack::PP - Pure Perl implementation of Data::MessagePack + +=head1 DESCRIPTION + +This module is used by L internally. + +=head1 SEE ALSO + +L, +L, +L, + +=head1 AUTHOR + +makamaka + +=head1 COPYRIGHT AND LICENSE + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/perl/t/00_compile.t b/perl/t/00_compile.t index 66fe8f0..f91b29e 100644 --- a/perl/t/00_compile.t +++ b/perl/t/00_compile.t @@ -3,4 +3,4 @@ use warnings; use Test::More tests => 1; use_ok 'Data::MessagePack'; - +diag ( $INC{'Data/MessagePack/PP.pm'} ? 'PP' : 'XS' ); diff --git a/perl/t/05_preferred_int.t b/perl/t/05_preferred_int.t index 9860711..084df31 100644 --- a/perl/t/05_preferred_int.t +++ b/perl/t/05_preferred_int.t @@ -12,10 +12,15 @@ sub packit { } sub pis ($$) { - is packit($_[0]), $_[1], 'dump ' . $_[1]; + if (ref $_[1]) { + like packit($_[0]), $_[1], 'dump ' . $_[1]; + } else { + is packit($_[0]), $_[1], 'dump ' . $_[1]; + } # is(Dumper(Data::MessagePack->unpack(Data::MessagePack->pack($_[0]))), Dumper($_[0])); } +my $is_win = $^O eq 'MSWin32'; my @dat = ( '', 'a0', '0', '00', @@ -29,12 +34,16 @@ my @dat = ( ''.0xFFFFFF => 'ce 00 ff ff ff', ''.0xFFFFFFFF => 'ce ff ff ff ff', ''.0xFFFFFFFFF => 'ab 36 38 37 31 39 34 37 36 37 33 35', - ''.0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFF => 'b4 38 2e 33 30 37 36 37 34 39 37 33 36 35 35 37 32 65 2b 33 34', + ''.0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFF => $is_win ? + qr{^(b5 38 2e 33 30 37 36 37 34 39 37 33 36 35 35 37 32 65 2b 30 33 34|b8 38 2e 33 30 37 36 37 34 39 37 33 36 35 35 37 32 34 32 31 65 2b 30 33 34)$} + : qr{^(b4 38 2e 33 30 37 36 37 34 39 37 33 36 35 35 37 32 65 2b 33 34|b7 38 2e 33 30 37 36 37 34 39 37 33 36 35 35 37 32 34 32 31 65 2b 33 34)$}, '-'.0x8000000 => 'd2 f8 00 00 00', '-'.0x80000000 => 'd2 80 00 00 00', '-'.0x800000000 => 'ac 2d 33 34 33 35 39 37 33 38 33 36 38', '-'.0x8000000000 => 'ad 2d 35 34 39 37 35 35 38 31 33 38 38 38', - '-'.0x800000000000000000000000000000 => 'b5 2d 36 2e 36 34 36 31 33 39 39 37 38 39 32 34 35 38 65 2b 33 35', + '-'.0x800000000000000000000000000000 => $is_win ? + qr{^(b6 2d 36 2e 36 34 36 31 33 39 39 37 38 39 32 34 35 38 65 2b 30 33 35|b9 2d 36 2e 36 34 36 31 33 39 39 37 38 39 32 34 35 37 39 33 36 65 2b 30 33 35)} + : qr{^(b5 2d 36 2e 36 34 36 31 33 39 39 37 38 39 32 34 35 38 65 2b 33 35|b8 2d 36 2e 36 34 36 31 33 39 39 37 38 39 32 34 35 37 39 33 36 65 2b 33 35)}, {'0' => '1'}, '81 00 01', {'abc' => '1'}, '81 a3 61 62 63 01', ); diff --git a/perl/MessagePack.c b/perl/xs-src/MessagePack.c similarity index 100% rename from perl/MessagePack.c rename to perl/xs-src/MessagePack.c diff --git a/perl/pack.c b/perl/xs-src/pack.c similarity index 100% rename from perl/pack.c rename to perl/xs-src/pack.c diff --git a/perl/unpack.c b/perl/xs-src/unpack.c similarity index 100% rename from perl/unpack.c rename to perl/xs-src/unpack.c