You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@avro.apache.org by cu...@apache.org on 2014/02/05 01:02:46 UTC
svn commit: r1564569 [2/2] - in /avro/trunk: ./ lang/perl/ lang/perl/bin/
lang/perl/lib/ lang/perl/lib/Avro/ lang/perl/lib/Avro/Protocol/
lang/perl/t/ lang/perl/xt/
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();