Added: avro/trunk/lang/perl/t/01_schema.t URL: http://svn.apache.org/viewvc/avro/trunk/lang/perl/t/01_schema.t?rev=1564569&view=auto ============================================================================== --- avro/trunk/lang/perl/t/01_schema.t (added) +++ avro/trunk/lang/perl/t/01_schema.t Wed Feb 5 00:02:45 2014 @@ -0,0 +1,472 @@ +# Licensed to the Apache Software Foundation (ASF) under one +# or more contributor license agreements. See the NOTICE file +# distributed with this work for additional information +# regarding copyright ownership. The ASF licenses this file +# to you under the Apache License, Version 2.0 (the +# "License"); you may not use this file except in compliance +# with the License. You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, +# software distributed under the License is distributed on an +# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY +# KIND, either express or implied. See the License for the +# specific language governing permissions and limitations +# under the License. + +use strict; +use warnings; + +use Test::More; +plan tests => 130; +use Test::Exception; +use_ok 'Avro::Schema'; + +dies_ok { Avro::Schema->new } "Should use parse() or instantiate the subclass"; + +throws_ok { Avro::Schema->parse(q()) } "Avro::Schema::Error::Parse"; +throws_ok { Avro::Schema->parse(q(test)) } "Avro::Schema::Error::Parse"; +throws_ok { Avro::Schema->parse(q({"type": t})) } + "Avro::Schema::Error::Parse"; +throws_ok { Avro::Schema->parse(q({"type": t})) } + "Avro::Schema::Error::Parse"; + +my $s = Avro::Schema->parse(q("string")); +isa_ok $s, 'Avro::Schema::Base'; +isa_ok $s, 'Avro::Schema::Primitive', +is $s->type, "string", "type is string"; + +my $s2 = Avro::Schema->parse(q({"type": "string"})); +isa_ok $s2, 'Avro::Schema::Primitive'; +is $s2->type, "string", "type is string"; +is $s, $s2, "string Schematas are singletons"; + +## Records +{ + my $s3 = Avro::Schema::Record->new( + struct => { + name => 'saucisson', + fields => [ + { name => 'a', type => 'long' }, + { name => 'b', type => 'string' }, + ], + }, + ); + + isa_ok $s3, 'Avro::Schema::Record'; + is $s3->type, 'record', "this is a record type"; + is $s3->fullname, 'saucisson', "correct name"; + is $s3->fields->[0]{name}, 'a', 'a'; + is $s3->fields->[0]{type}, Avro::Schema::Primitive->new(type => 'long'), 'long'; + is $s3->fields->[1]{name}, 'b', 'b'; + is $s3->fields->[1]{type}, Avro::Schema::Primitive->new(type => 'string'), 'str'; + + ## self-reference + $s3 = Avro::Schema::Record->new( + struct => { + name => 'saucisson', + fields => [ + { name => 'a', type => 'long' }, + { name => 'b', type => 'saucisson' }, + ], + }, + ); + isa_ok $s3, 'Avro::Schema::Record'; + is $s3->fullname, 'saucisson', "correct name"; + is $s3->fields->[0]{name}, 'a', 'a'; + is $s3->fields->[0]{type}, Avro::Schema::Primitive->new(type => 'long'), 'long'; + is $s3->fields->[1]{name}, 'b', 'b'; + is $s3->fields->[1]{type}, $s3, 'self!'; + + ## serialize + my $string = $s3->to_string; + like $string, qr/saucisson/, "generated string has 'saucisson'"; + my $s3bis = Avro::Schema->parse($string); + is_deeply $s3bis->to_struct, $s3->to_struct, + 'regenerated structure matches original'; + + ## record fields can have defaults + my @good_ints = (2, -1, -(2**31 - 1), 2_147_483_647, "2147483647" ); + my @bad_ints = ("", "string", 9.22337204, 9.22337204E10, \"2"); + my @good_longs = (1, 2, -3); + my @bad_longs = (9.22337204, 9.22337204E10 + 0.1, \"2"); + + use Config; + if ($Config{use64bitint}) { + push @bad_ints, (2**32 - 1, 4_294_967_296, 9_223_372_036_854_775_807); + push @good_longs, (9_223_372_036_854_775_807, 3e10); + push @bad_longs, 9_223_372_036_854_775_808; + } + else { + require Math::BigInt; + push @bad_ints, map { Math::BigInt->new($_) } + ("0xFFFF_FFFF", "0x1_0000_0000", "0x7FFF_FFFF_FFFF_FFFF"); + push @good_longs, map { Math::BigInt->new($_) } + ("9_223_372_036_854_775_807", "3e10"); + push @bad_longs, Math::BigInt->new("9_223_372_036_854_775_808"); + } + + for (@good_ints) { + my $s4 = Avro::Schema::Record->new( + struct => { name => 'saucisson', + fields => [ + { name => 'a', type => 'int', default => $_ }, + ], + }, + ); + is $s4->fields->[0]{default}, $_, "default $_"; + } + for (@good_longs) { + my $s4 = Avro::Schema::Record->new( + struct => { name => 'saucisson', + fields => [ + { name => 'a', type => 'long', default => $_ }, + ], + }, + ); + is $s4->fields->[0]{default}, $_, "default $_"; + } + for (@bad_ints) { + throws_ok { Avro::Schema::Record->new( + struct => { name => 'saucisson', + fields => [ + { name => 'a', type => 'int', default => $_ }, + ], + }, + ) } "Avro::Schema::Error::Parse", "invalid default: $_"; + } + for (@bad_longs) { + throws_ok { Avro::Schema::Record->new( + struct => { name => 'saucisson', + fields => [ + { name => 'a', type => 'long', default => $_ }, + ], + }, + ) } "Avro::Schema::Error::Parse", "invalid default: $_"; + } + + ## default of more complex types + throws_ok { + Avro::Schema::Record->new( + struct => { name => 'saucisson', + fields => [ + { name => 'a', type => 'union', default => 1 }, + ], + }, + ) + } "Avro::Schema::Error::Parse", "union don't have default: $@"; + + my $s4 = Avro::Schema->parse_struct( + { + type => 'record', + name => 'saucisson', + fields => [ + { name => 'string', type => 'string', default => "something" }, + { name => 'map', type => { type => 'map', values => 'long' }, default => {a => 2} }, + { name => 'array', type => { type => 'array', items => 'long' }, default => [1, 2] }, + { name => 'bytes', type => 'bytes', default => "something" }, + { name => 'null', type => 'null', default => undef }, + ], + }, + ); + is $s4->fields->[0]{default}, "something", "string default"; + is_deeply $s4->fields->[1]{default}, { a => 2 }, "map default"; + is_deeply $s4->fields->[2]{default}, [1, 2], "array default"; + is $s4->fields->[3]{default}, "something", "bytes default"; + is $s4->fields->[4]{default}, undef, "null default"; + ## TODO: technically we should verify that default map/array match values + ## and items types defined + + ## ordering + for (qw(ascending descending ignore)) { + my $s4 = Avro::Schema::Record->new( + struct => { + name => 'saucisson', + fields => [ + { name => 'a', type => 'int', order => $_ }, + ], + }, + ); + is $s4->fields->[0]{order}, $_, "order set to $_"; + } + for (qw(DESCEND ascend DESCENDING ASCENDING)) { + throws_ok { Avro::Schema::Record->new( + struct => { name => 'saucisson', + fields => [ + { name => 'a', type => 'long', order => $_ }, + ], + }, + ) } "Avro::Schema::Error::Parse", "invalid order: $_"; + } +} + +## Unions +{ + my $spec_example = <<EOJ; +{ + "type": "record", + "name": "LongList", + "fields" : [ + {"name": "value", "type": "long"}, + {"name": "next", "type": ["LongList", "null"]} + ] +} +EOJ + my $schema = Avro::Schema->parse($spec_example); + is $schema->type, 'record', "type record"; + is $schema->fullname, 'LongList', "name is LongList"; + + ## Union checks + # can only contain one type + + $s = <<EOJ; +["null", "null"] +EOJ + throws_ok { Avro::Schema->parse($s) } + 'Avro::Schema::Error::Parse'; + + $s = <<EOJ; +["long", "string", "float", "string"] +EOJ + throws_ok { Avro::Schema->parse($s) } + 'Avro::Schema::Error::Parse'; + + $s = <<EOJ; +{ + "type": "record", + "name": "embed", + "fields": [ + {"name": "value", "type": + { "type": "record", "name": "rec1", "fields": [ + { "name": "str1", "type": "string"} + ] } + }, + {"name": "next", "type": ["embed", "rec1", "embed"] } + ] +} +EOJ + throws_ok { Avro::Schema->parse($s) } + 'Avro::Schema::Error::Parse', + 'two records with same name in the union'; + + $s = <<EOJ; +{ + "type": "record", + "name": "embed", + "fields": [ + {"name": "value", "type": + { "type": "record", "name": "rec1", "fields": [ + { "name": "str1", "type": "string"} + ] } + }, + {"name": "next", "type": ["embed", "rec1"] } + ] +} +EOJ + lives_ok { Avro::Schema->parse($s) } + 'two records of different names in the union'; + + # cannot directly embed another union + $s = <<EOJ; +["long", ["string", "float"], "string"] +EOJ + throws_ok { Avro::Schema->parse($s) } + 'Avro::Schema::Error::Parse', "cannot embed union in union"; +} + +## Enums! +{ + my $s = <<EOJ; +{ "type": "enum", "name": "theenum", "symbols": [ "A", "B" ]} +EOJ + my $schema = Avro::Schema->parse($s); + is $schema->type, 'enum', "enum"; + is $schema->fullname, 'theenum', "fullname"; + is $schema->symbols->[0], "A", "symbol A"; + is $schema->symbols->[1], "B", "symbol B"; + my $string = $schema->to_string; + my $s2 = Avro::Schema->parse($string)->to_struct; + is_deeply $s2, $schema->to_struct, "reserialized identically"; +} + +## Arrays +{ + my $s = <<EOJ; +{ "type": "array", "items": "string" } +EOJ + my $schema = Avro::Schema->parse($s); + is $schema->type, 'array', "array"; + isa_ok $schema->items, 'Avro::Schema::Primitive'; + is $schema->items->type, 'string', "type of items is string"; + my $string = $schema->to_string; + my $s2 = Avro::Schema->parse($string); + is_deeply $s2, $schema, "reserialized identically"; +} + +## Maps +{ + my $s = <<EOJ; +{ "type": "map", "values": "string" } +EOJ + my $schema = Avro::Schema->parse($s); + is $schema->type, 'map', "map"; + isa_ok $schema->values, 'Avro::Schema::Primitive'; + is $schema->values->type, 'string', "type of values is string"; + my $string = $schema->to_string; + my $s2 = Avro::Schema->parse($string); + is_deeply $s2, $schema, "reserialized identically"; +} + +## Fixed +{ + my $s = <<EOJ; +{ "type": "fixed", "name": "somefixed", "size": "something" } +EOJ + throws_ok { Avro::Schema->parse($s) } "Avro::Schema::Error::Parse", + "size must be an int"; + + $s = <<EOJ; +{ "type": "fixed", "name": "somefixed", "size": -100 } +EOJ + throws_ok { Avro::Schema->parse($s) } "Avro::Schema::Error::Parse", + "size must be a POSITIVE int"; + + $s = <<EOJ; +{ "type": "fixed", "name": "somefixed", "size": 0 } +EOJ + throws_ok { Avro::Schema->parse($s) } "Avro::Schema::Error::Parse", + "size must be a POSITIVE int > 0"; + + $s = <<EOJ; +{ "type": "fixed", "name": "somefixed", "size": 0.2 } +EOJ + throws_ok { Avro::Schema->parse($s) } "Avro::Schema::Error::Parse", + "size must be an int"; + + $s = <<EOJ; +{ "type": "fixed", "name": "somefixed", "size": 5e2 } +EOJ + my $schema = Avro::Schema->parse($s); + + is $schema->type, 'fixed', "fixed"; + is $schema->fullname, 'somefixed', "name"; + is $schema->size, 500, "size of fixed"; + my $string = $schema->to_string; + my $s2 = Avro::Schema->parse($string); + is_deeply $s2, $schema, "reserialized identically"; +} + +# fixed type referenced using short name without namespace +{ + my $s = <<EOJ; +{ + "type": "record", + "name": "HandshakeRequest", "namespace":"org.apache.avro.ipc", + "fields": [ + {"name": "clientHash", + "type": {"type": "fixed", "name": "MD5", "size": 16}}, + {"name": "clientProtocol", "type": ["null", "string"]}, + {"name": "serverHash", "type": "MD5"}, + {"name": "meta", "type": ["null", {"type": "map", "values": "bytes"}]} + ] +} +EOJ + my $schema = Avro::Schema->parse($s); + + is $schema->type, 'record', 'HandshakeRequest type ok'; + is $schema->namespace, 'org.apache.avro.ipc', 'HandshakeRequest namespace ok'; + is $schema->fields->[0]->{type}->{name}, 'MD5', 'HandshakeRequest clientHash type ok'; + is $schema->fields->[2]->{type}->{name}, 'MD5', 'HandshakeRequest serverHash type ok'; +} + +## Schema resolution +{ + my @s = split /\n/, <<EOJ; +{ "type": "int" } +{ "type": "long" } +{ "type": "float" } +{ "type": "double" } +{ "type": "boolean" } +{ "type": "null" } +{ "type": "string" } +{ "type": "bytes" } +{ "type": "array", "items": "string" } +{ "type": "fixed", "size": 1, "name": "fixed" } +{ "type": "enum", "name": "enum", "symbols": [ "s" ] } +{ "type": "map", "values": "long" } +{ "type": "record", "name": "r", "fields": [ { "name": "a", "type": "long" }] } +EOJ + my %s; + for (@s) { + my $schema = Avro::Schema->parse($_); + $s{ $schema->type } = $schema; + ok ( Avro::Schema->match( + reader => $schema, + writer => $schema, + ), "identical match!"); + } + + ## schema promotion + match_ok($s{int}, $s{long}); + match_ok($s{int}, $s{float}); + match_ok($s{int}, $s{double}); + match_ok($s{long}, $s{float}); + match_ok($s{double}, $s{double}); + match_ok($s{float}, $s{double}); + + ## some non promotion + match_nok($s{long}, $s{int}); + match_nok($s{float}, $s{int}); + match_nok($s{string}, $s{bytes}); + match_nok($s{bytes}, $s{string}); + match_nok($s{double}, $s{float}); + match_nok($s{null}, $s{boolean}); + match_nok($s{boolean}, $s{int}); + match_nok($s{boolean}, $s{string}); + match_nok($s{boolean}, $s{fixed}); + + ## complex type details + my @alt = split /\n/, <<EOJ; +{ "type": "array", "items": "int" } +{ "type": "fixed", "size": 2, "name": "fixed" } +{ "type": "enum", "name": "enum2", "symbols": [ "b" ] } +{ "type": "map", "values": "null" } +{ "type": "record", "name": "r2", "fields": [ { "name": "b", "type": "long" }] } +EOJ + my %alt; + for (@alt) { + my $schema = Avro::Schema->parse($_); + $alt{ $schema->type } = $schema; + match_nok($s{$schema->type}, $schema, "not same subtypes/names"); + } +} + +## union in a record.field +{ + my $s = Avro::Schema::Record->new( + struct => { + name => 'saucisson', + fields => [ + { name => 'a', type => [ 'long', 'null' ] }, + ], + }, + ); + isa_ok $s, 'Avro::Schema::Record'; + is $s->fields->[0]{name}, 'a', 'a'; + isa_ok $s->fields->[0]{type}, 'Avro::Schema::Union'; +} + +sub match_ok { + my ($w, $r, $msg) = @_; + $msg ||= "match_ok"; + ok(Avro::Schema->match(reader => $r, writer => $w), $msg); +} + +sub match_nok { + my ($w, $r, $msg) = @_; + $msg ||= "non matching"; + ok !Avro::Schema->match(reader => $r, writer => $w), $msg; +} + +done_testing;
Added: avro/trunk/lang/perl/t/02_bin_encode.t URL: http://svn.apache.org/viewvc/avro/trunk/lang/perl/t/02_bin_encode.t?rev=1564569&view=auto ============================================================================== --- avro/trunk/lang/perl/t/02_bin_encode.t (added) +++ avro/trunk/lang/perl/t/02_bin_encode.t Wed Feb 5 00:02:45 2014 @@ -0,0 +1,146 @@ +# Licensed to the Apache Software Foundation (ASF) under one +# or more contributor license agreements. See the NOTICE file +# distributed with this work for additional information +# regarding copyright ownership. The ASF licenses this file +# to you under the Apache License, Version 2.0 (the +# "License"); you may not use this file except in compliance +# with the License. You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, +# software distributed under the License is distributed on an +# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY +# KIND, either express or implied. See the License for the +# specific language governing permissions and limitations +# under the License. + +#!/usr/bin/env perl + +use strict; +use warnings; +use Avro::Schema; +use Config; +use Test::More tests => 24; +use Test::Exception; +use Math::BigInt; + +use_ok 'Avro::BinaryEncoder'; + +sub primitive_ok { + my ($primitive_type, $primitive_val, $expected_enc) = @_; + + my $data; + my $meth = "encode_$primitive_type"; + Avro::BinaryEncoder->$meth( + undef, $primitive_val, sub { $data = ${$_[0]} } + ); + is $data, $expected_enc, "primitive $primitive_type encoded correctly"; + return $data; +} + +## some primitive testing +{ + primitive_ok null => undef, ''; + primitive_ok null => 'whatev', ''; + + ## - high-bit of each byte should be set except for last one + ## - rest of bits are: + ## - little endian + ## - zigzag coded + primitive_ok long => 0, pack("C*", 0); + primitive_ok long => 1, pack("C*", 0x2); + primitive_ok long => -1, pack("C*", 0x1); + primitive_ok int => -1, pack("C*", 0x1); + primitive_ok int => -20, pack("C*", 0b0010_0111); + primitive_ok int => 20, pack("C*", 0b0010_1000); + primitive_ok int => 63, pack("C*", 0b0111_1110); + primitive_ok int => 64, pack("C*", 0b1000_0000, 0b0000_0001); + my $p = + primitive_ok int => -65, pack("C*", 0b1000_0001, 0b0000_0001); + primitive_ok int => 65, pack("C*", 0b1000_0010, 0b0000_0001); + primitive_ok int => 99, "\xc6\x01"; + + ## BigInt values still work + primitive_ok int => Math::BigInt->new(-65), $p; + + throws_ok { + my $toobig; + if ($Config{use64bitint}) { + $toobig = 1<<32; + } + else { + require Math::BigInt; + $toobig = Math::BigInt->new(1)->blsft(32); + } + primitive_ok int => $toobig, undef; + } "Avro::BinaryEncoder::Error", "33 bits"; + + throws_ok { + primitive_ok int => Math::BigInt->new(1)->blsft(63), undef; + } "Avro::BinaryEncoder::Error", "65 bits"; + + for (qw(long int)) { + dies_ok { + primitive_ok $_ => "x", undef; + } "numeric values only"; + } +} + +## spec examples +{ + my $enc = ''; + my $schema = Avro::Schema->parse(q({ "type": "string" })); + Avro::BinaryEncoder->encode( + schema => $schema, + data => "foo", + emit_cb => sub { $enc .= ${ $_[0] } }, + ); + is $enc, "\x06\x66\x6f\x6f", "Binary_Encodings.Primitive_Types"; + + $schema = Avro::Schema->parse(<<EOJ); + { + "type": "record", + "name": "test", + "fields" : [ + {"name": "a", "type": "long"}, + {"name": "b", "type": "string"} + ] + } +EOJ + $enc = ''; + Avro::BinaryEncoder->encode( + schema => $schema, + data => { a => 27, b => 'foo' }, + emit_cb => sub { $enc .= ${ $_[0] } }, + ); + is $enc, "\x36\x06\x66\x6f\x6f", "Binary_Encodings.Complex_Types.Records"; + + $enc = ''; + $schema = Avro::Schema->parse(q({"type": "array", "items": "long"})); + Avro::BinaryEncoder->encode( + schema => $schema, + data => [3, 27], + emit_cb => sub { $enc .= ${ $_[0] } }, + ); + is $enc, "\x04\x06\x36\x00", "Binary_Encodings.Complex_Types.Arrays"; + + $enc = ''; + $schema = Avro::Schema->parse(q(["string","null"])); + Avro::BinaryEncoder->encode( + schema => $schema, + data => undef, + emit_cb => sub { $enc .= ${ $_[0] } }, + ); + is $enc, "\x02", "Binary_Encodings.Complex_Types.Unions-null"; + + $enc = ''; + Avro::BinaryEncoder->encode( + schema => $schema, + data => "a", + emit_cb => sub { $enc .= ${ $_[0] } }, + ); + is $enc, "\x00\x02\x61", "Binary_Encodings.Complex_Types.Unions-a"; +} + +done_testing; Added: avro/trunk/lang/perl/t/03_bin_decode.t URL: http://svn.apache.org/viewvc/avro/trunk/lang/perl/t/03_bin_decode.t?rev=1564569&view=auto ============================================================================== --- avro/trunk/lang/perl/t/03_bin_decode.t (added) +++ avro/trunk/lang/perl/t/03_bin_decode.t Wed Feb 5 00:02:45 2014 @@ -0,0 +1,251 @@ +# Licensed to the Apache Software Foundation (ASF) under one +# or more contributor license agreements. See the NOTICE file +# distributed with this work for additional information +# regarding copyright ownership. The ASF licenses this file +# to you under the Apache License, Version 2.0 (the +# "License"); you may not use this file except in compliance +# with the License. You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, +# software distributed under the License is distributed on an +# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY +# KIND, either express or implied. See the License for the +# specific language governing permissions and limitations +# under the License. + +#!/usr/bin/env perl + +use strict; +use warnings; +use Avro::Schema; +use Avro::BinaryEncoder; +use Test::More tests => 21; +use Test::Exception; +use IO::String; + +use_ok 'Avro::BinaryDecoder'; + +## spec examples +{ + my $enc = "\x06\x66\x6f\x6f"; + my $schema = Avro::Schema->parse(q({ "type": "string" })); + my $reader = IO::String->new($enc); + my $dec = Avro::BinaryDecoder->decode( + writer_schema => $schema, + reader_schema => $schema, + reader => $reader, + ); + is $dec, "foo", "Binary_Encodings.Primitive_Types"; + + $schema = Avro::Schema->parse(<<EOJ); + { + "type": "record", + "name": "test", + "fields" : [ + {"name": "a", "type": "long"}, + {"name": "b", "type": "string"} + ] + } +EOJ + $reader = IO::String->new("\x36\x06\x66\x6f\x6f"); + $dec = Avro::BinaryDecoder->decode( + writer_schema => $schema, + reader_schema => $schema, + reader => $reader, + ); + is_deeply $dec, { a => 27, b => 'foo' }, + "Binary_Encodings.Complex_Types.Records"; + + $reader = IO::String->new("\x04\x06\x36\x00"); + $schema = Avro::Schema->parse(q({"type": "array", "items": "long"})); + $dec = Avro::BinaryDecoder->decode( + writer_schema => $schema, + reader_schema => $schema, + reader => $reader, + ); + is_deeply $dec, [3, 27], "Binary_Encodings.Complex_Types.Arrays"; + + $reader = IO::String->new("\x02"); + $schema = Avro::Schema->parse(q(["string","null"])); + $dec = Avro::BinaryDecoder->decode( + writer_schema => $schema, + reader_schema => $schema, + reader => $reader, + ); + is $dec, undef, "Binary_Encodings.Complex_Types.Unions-null"; + + $reader = IO::String->new("\x00\x02\x61"); + $dec = Avro::BinaryDecoder->decode( + writer_schema => $schema, + reader_schema => $schema, + reader => $reader, + ); + is $dec, "a", "Binary_Encodings.Complex_Types.Unions-a"; +} + +## enum schema resolution +{ + + my $w_enum = Avro::Schema->parse(<<EOP); +{ "type": "enum", "name": "enum", "symbols": [ "a", "b", "c", "\$", "z" ] } +EOP + my $r_enum = Avro::Schema->parse(<<EOP); +{ "type": "enum", "name": "enum", "symbols": [ "\$", "b", "c", "d" ] } +EOP + ok ! !Avro::Schema->match( reader => $r_enum, writer => $w_enum ), "match"; + my $enc; + for my $data (qw/b c $/) { + Avro::BinaryEncoder->encode( + schema => $w_enum, + data => $data, + emit_cb => sub { $enc = ${ $_[0] } }, + ); + my $dec = Avro::BinaryDecoder->decode( + writer_schema => $w_enum, + reader_schema => $r_enum, + reader => IO::String->new($enc), + ); + is $dec, $data, "decoded!"; + } + + for my $data (qw/a z/) { + Avro::BinaryEncoder->encode( + schema => $w_enum, + data => $data, + emit_cb => sub { $enc = ${ $_[0] } }, + ); + throws_ok { Avro::BinaryDecoder->decode( + writer_schema => $w_enum, + reader_schema => $r_enum, + reader => IO::String->new($enc), + )} "Avro::Schema::Error::Mismatch", "schema problem"; + } +} + +## record resolution +{ + my $w_schema = Avro::Schema->parse(<<EOJ); + { "type": "record", "name": "test", + "fields" : [ + {"name": "a", "type": "long"}, + {"name": "bonus", "type": "string"} ]} +EOJ + + my $r_schema = Avro::Schema->parse(<<EOJ); + { "type": "record", "name": "test", + "fields" : [ + {"name": "t", "type": "float", "default": 37.5 }, + {"name": "a", "type": "long"} ]} +EOJ + + my $data = { a => 1, bonus => "i" }; + my $enc = ''; + Avro::BinaryEncoder->encode( + schema => $w_schema, + data => $data, + emit_cb => sub { $enc .= ${ $_[0] } }, + ); + my $dec = Avro::BinaryDecoder->decode( + writer_schema => $w_schema, + reader_schema => $r_schema, + reader => IO::String->new($enc), + ); + is $dec->{a}, 1, "easy"; + ok ! exists $dec->{bonus}, "bonus extra field ignored"; + is $dec->{t}, 37.5, "default t from reader used"; + + ## delete the default for t + delete $r_schema->fields->[0]{default}; + throws_ok { + Avro::BinaryDecoder->decode( + writer_schema => $w_schema, + reader_schema => $r_schema, + reader => IO::String->new($enc), + ); + } "Avro::Schema::Error::Mismatch", "no default value!"; +} + +## union resolution +{ + my $w_schema = Avro::Schema->parse(<<EOP); +[ "string", "null", { "type": "array", "items": "long" }] +EOP + my $r_schema = Avro::Schema->parse(<<EOP); +[ "boolean", "null", { "type": "array", "items": "double" }] +EOP + my $enc = ''; + my $data = [ 1, 2, 3, 4, 5, 6 ]; + Avro::BinaryEncoder->encode( + schema => $w_schema, + data => $data, + emit_cb => sub { $enc .= ${ $_[0] } }, + ); + my $dec = Avro::BinaryDecoder->decode( + writer_schema => $w_schema, + reader_schema => $r_schema, + reader => IO::String->new($enc), + ); + + is_deeply $dec, $data, "decoded!"; +} + +## map resolution +{ + my $w_schema = Avro::Schema->parse(<<EOP); +{ "type": "map", "values": { "type": "array", "items": "string" } } +EOP + my $r_schema = Avro::Schema->parse(<<EOP); +{ "type": "map", "values": { "type": "array", "items": "int" } } +EOP + my $enc = ''; + my $data = { "one" => [ "un", "one" ], two => [ "deux", "two" ] }; + + Avro::BinaryEncoder->encode( + schema => $w_schema, + data => $data, + emit_cb => sub { $enc .= ${ $_[0] } }, + ); + throws_ok { + Avro::BinaryDecoder->decode( + writer_schema => $w_schema, + reader_schema => $r_schema, + reader => IO::String->new($enc), + ) + } "Avro::Schema::Error::Mismatch", "recursively... fails"; + + my $dec = Avro::BinaryDecoder->decode( + writer_schema => $w_schema, + reader_schema => $w_schema, + reader => IO::String->new($enc), + ); + is_deeply $dec, $data, "decoded succeeded!"; +} + +## schema upgrade +{ + my $w_schema = Avro::Schema->parse(<<EOP); +{ "type": "map", "values": { "type": "array", "items": "int" } } +EOP + my $r_schema = Avro::Schema->parse(<<EOP); +{ "type": "map", "values": { "type": "array", "items": "float" } } +EOP + my $enc = ''; + my $data = { "one" => [ 1, 2 ], two => [ 1, 30 ] }; + + Avro::BinaryEncoder->encode( + schema => $w_schema, + data => $data, + emit_cb => sub { $enc .= ${ $_[0] } }, + ); + my $dec = Avro::BinaryDecoder->decode( + writer_schema => $w_schema, + reader_schema => $w_schema, + reader => IO::String->new($enc), + ); + is_deeply $dec, $data, "decoded succeeded! +upgrade"; + is $dec->{one}[0], 1.0, "kind of dumb test"; +} + +done_testing; Added: avro/trunk/lang/perl/t/04_datafile.t URL: http://svn.apache.org/viewvc/avro/trunk/lang/perl/t/04_datafile.t?rev=1564569&view=auto ============================================================================== --- avro/trunk/lang/perl/t/04_datafile.t (added) +++ avro/trunk/lang/perl/t/04_datafile.t Wed Feb 5 00:02:45 2014 @@ -0,0 +1,122 @@ +# Licensed to the Apache Software Foundation (ASF) under one +# or more contributor license agreements. See the NOTICE file +# distributed with this work for additional information +# regarding copyright ownership. The ASF licenses this file +# to you under the Apache License, Version 2.0 (the +# "License"); you may not use this file except in compliance +# with the License. You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, +# software distributed under the License is distributed on an +# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY +# KIND, either express or implied. See the License for the +# specific language governing permissions and limitations +# under the License. + +#!/usr/bin/env perl + +use strict; +use warnings; +use Avro::DataFile; +use Avro::BinaryEncoder; +use Avro::BinaryDecoder; +use Avro::Schema; +use File::Temp; +use Test::Exception; +use Test::More tests => 12; + +use_ok 'Avro::DataFileReader'; +use_ok 'Avro::DataFileWriter'; + +my $tmpfh = File::Temp->new(UNLINK => 1); + +my $schema = Avro::Schema->parse(<<EOP); +{ "type": "map", "values": { "type": "array", "items": "string" } } +EOP + +my $write_file = Avro::DataFileWriter->new( + fh => $tmpfh, + writer_schema => $schema, + metadata => { + some => 'metadata', + }, +); + +my $data = { + a => [ "2.2", "4.4" ], + b => [ "2.4", "2", "-4", "4", "5" ], + c => [ "0" ], +}; + +$write_file->print($data); +$write_file->flush; + +## rewind +seek $tmpfh, 0, 0; +my $uncompressed_size = -s $tmpfh; + +my $read_file = Avro::DataFileReader->new( + fh => $tmpfh, + reader_schema => $schema, +); +is $read_file->metadata->{'avro.codec'}, 'null', 'avro.codec'; +is $read_file->metadata->{'some'}, 'metadata', 'custom meta'; + +my @all = $read_file->all; +is scalar @all, 1, "one object back"; +is_deeply $all[0], $data, "Our data is intact!"; + + +## codec tests +{ + throws_ok { + Avro::DataFileWriter->new( + fh => File::Temp->new, + writer_schema => $schema, + codec => 'unknown', + ); + } "Avro::DataFile::Error::InvalidCodec", "invalid codec"; + + ## rewind + seek $tmpfh, 0, 0; + local $Avro::DataFile::ValidCodec{null} = 0; + $read_file = Avro::DataFileReader->new( + fh => $tmpfh, + reader_schema => $schema, + ); + + throws_ok { + $read_file->all; + } "Avro::DataFile::Error::UnsupportedCodec", "I've removed 'null' :)"; + + ## deflate! + my $zfh = File::Temp->new(UNLINK => 0); + my $write_file = Avro::DataFileWriter->new( + fh => $zfh, + writer_schema => $schema, + codec => 'deflate', + metadata => { + some => 'metadata', + }, + ); + $write_file->print($data); + $write_file->flush; + + ## rewind + seek $zfh, 0, 0; + + my $read_file = Avro::DataFileReader->new( + fh => $zfh, + reader_schema => $schema, + ); + is $read_file->metadata->{'avro.codec'}, 'deflate', 'avro.codec'; + is $read_file->metadata->{'some'}, 'metadata', 'custom meta'; + + my @all = $read_file->all; + is scalar @all, 1, "one object back"; + is_deeply $all[0], $data, "Our data is intact!"; +} + +done_testing; Added: avro/trunk/lang/perl/t/05_protocol.t URL: http://svn.apache.org/viewvc/avro/trunk/lang/perl/t/05_protocol.t?rev=1564569&view=auto ============================================================================== --- avro/trunk/lang/perl/t/05_protocol.t (added) +++ avro/trunk/lang/perl/t/05_protocol.t Wed Feb 5 00:02:45 2014 @@ -0,0 +1,76 @@ +# Licensed to the Apache Software Foundation (ASF) under one +# or more contributor license agreements. See the NOTICE file +# distributed with this work for additional information +# regarding copyright ownership. The ASF licenses this file +# to you under the Apache License, Version 2.0 (the +# "License"); you may not use this file except in compliance +# with the License. You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, +# software distributed under the License is distributed on an +# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY +# KIND, either express or implied. See the License for the +# specific language governing permissions and limitations +# under the License. + +#!/usr/bin/env perl + +use strict; +use warnings; +use Test::Exception; +use Test::More tests => 18; + +use_ok 'Avro::Protocol'; + +{ + my $spec_proto = <<EOJ; +{ +"namespace": "com.acme", +"protocol": "HelloWorld", +"doc": "Protocol Greetings", + +"types": [ + {"name": "Greeting", "type": "record", "fields": [ + {"name": "message", "type": "string"}]}, + {"name": "Curse", "type": "error", "fields": [ + {"name": "message", "type": "string"}]} +], + +"messages": { + "hello": { + "doc": "Say hello.", + "request": [{"name": "greeting", "type": "Greeting" }], + "response": "Greeting", + "errors": ["Curse"] + } +} +} +EOJ + my $p = Avro::Protocol->parse($spec_proto); + ok $p, "proto returned"; + isa_ok $p, 'Avro::Protocol'; + is $p->fullname, "com.acme.HelloWorld", "fullname"; + is $p->name, "HelloWorld", "name"; + is $p->namespace, "com.acme", "namespace"; + + is $p->doc, "Protocol Greetings", "doc"; + + isa_ok $p->types, 'HASH'; + isa_ok $p->types->{Greeting}, 'Avro::Schema::Record'; + isa_ok $p->types->{Greeting}->fields_as_hash + ->{message}{type}, 'Avro::Schema::Primitive'; + + isa_ok $p->messages->{hello}, "Avro::Protocol::Message"; + is $p->messages->{hello}->doc, "Say hello."; + isa_ok $p->messages->{hello}->errors, "Avro::Schema::Union"; + isa_ok $p->messages->{hello}->response, "Avro::Schema::Record"; + my $req_params = $p->messages->{hello}->request; + isa_ok $req_params, "ARRAY"; + is scalar @$req_params, 1, "one parameter to hello message"; + is $req_params->[0]->{name}, "greeting", "greeting field"; + is $req_params->[0]->{type}, $p->types->{Greeting}, "same Schema type"; +} + +done_testing; Added: avro/trunk/lang/perl/xt/pod.t URL: http://svn.apache.org/viewvc/avro/trunk/lang/perl/xt/pod.t?rev=1564569&view=auto ============================================================================== --- avro/trunk/lang/perl/xt/pod.t (added) +++ avro/trunk/lang/perl/xt/pod.t Wed Feb 5 00:02:45 2014 @@ -0,0 +1,21 @@ +# Licensed to the Apache Software Foundation (ASF) under one +# or more contributor license agreements. See the NOTICE file +# distributed with this work for additional information +# regarding copyright ownership. The ASF licenses this file +# to you under the Apache License, Version 2.0 (the +# "License"); you may not use this file except in compliance +# with the License. You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, +# software distributed under the License is distributed on an +# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY +# KIND, either express or implied. See the License for the +# specific language governing permissions and limitations +# under the License. + +use Test::More; +eval "use Test::Pod 1.00"; +plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; +all_pod_files_ok();
