#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
use Data::Dumper;
use Data::YAML::Reader;
use Data::YAML::Writer;
my @SCHEDULE;
BEGIN {
@SCHEDULE = (
{
name => 'Simple scalar',
in => 1,
out => [ '--- 1', '...', ],
},
{
name => 'Undef',
in => undef,
out => [ '--- ~', '...', ],
},
{
name => 'Unprintable',
in => "\x01\n\t",
out => [ '--- "\x01\n\t"', '...', ],
},
{
name => 'Simple array',
in => [ 1, 2, 3 ],
out => [ '---', '- 1', '- 2', '- 3', '...', ],
},
{
name => 'Array, two elements, undef',
in => [ undef, undef ],
out => [ '---', '- ~', '- ~', '...', ],
},
{
name => 'Nested array',
in => [ 1, 2, [ 3, 4 ], 5 ],
out =>
[ '---', '- 1', '- 2', '-', ' - 3', ' - 4', '- 5', '...', ],
},
{
name => 'Simple hash',
in => { one => '1', two => '2', three => '3' },
out => [ '---', 'one: 1', 'three: 3', 'two: 2', '...', ],
},
{
name => 'Nested hash',
in => {
one => '1',
two => '2',
more => { three => '3', four => '4' }
},
out => [
'---',
'more:',
' four: 4',
' three: 3',
'one: 1',
'two: 2',
'...',
],
},
{
name => 'Unprintable key',
in => { one => '1', "\x02" => '2', three => '3' },
out => [ '---', '"\x02": 2', 'one: 1', 'three: 3', '...', ],
},
{
name => 'Empty key',
in => { '' => 'empty' },
out => [ '---', "'': empty", '...', ],
},
{
name => 'Empty value',
in => { '' => '' },
out => [ '---', "'': ''", '...', ],
},
{
name => 'Complex',
in => {
'bill-to' => {
'given' => 'Chris',
'address' => {
'city' => 'Royal Oak',
'postal' => '48046',
'lines' => "458 Walkman Dr.\nSuite #292\n",
'state' => 'MI'
},
'family' => 'Dumars'
},
'invoice' => '34843',
'date' => '2001-01-23',
'tax' => '251.42',
'product' => [
{
'sku' => 'BL394D',
'quantity' => '4',
'price' => '450.00',
'description' => 'Basketball'
},
{
'sku' => 'BL4438H',
'quantity' => '1',
'price' => '2392.00',
'description' => 'Super Hoop'
}
],
'comments' =>
"Late afternoon is best. Backup contact is Nancy Billsmer @ 338-4338\n",
'total' => '4443.52'
},
out => [
"---",
"bill-to:",
" address:",
" city: 'Royal Oak'",
" lines: \"458 Walkman Dr.\\nSuite #292\\n\"",
" postal: 48046",
" state: MI",
" family: Dumars",
" given: Chris",
"comments: \"Late afternoon is best. Backup contact is Nancy Billsmer \@ 338-4338\\n\"",
"date: 2001-01-23",
"invoice: 34843",
"product:",
" -",
" description: Basketball",
" price: 450.00",
" quantity: 4",
" sku: BL394D",
" -",
" description: 'Super Hoop'",
" price: 2392.00",
" quantity: 1",
" sku: BL4438H",
"tax: 251.42",
"total: 4443.52",
"...",
],
},
);
plan tests => @SCHEDULE * 5;
}
sub iter {
my $ar = shift;
return sub {
return shift @$ar;
};
}
for my $test ( @SCHEDULE ) {
my $name = $test->{name};
ok my $yaml = Data::YAML::Writer->new, "$name: Created";
isa_ok $yaml, 'Data::YAML::Writer';
my $got = [];
my $writer = sub { push @$got, shift };
my $data = $test->{in};
eval { $yaml->write( $data, $writer ) };
if ( my $err = $test->{error} ) {
unless ( like $@, $err, "$name: Error message" ) {
diag "Error: $@\n";
}
is_deeply $got, [], "$name: No result";
pass;
}
else {
my $want = $test->{out};
unless ( ok !$@, "$name: No error" ) {
diag "Error: $@\n";
}
unless ( is_deeply $got, $want, "$name: Result matches" ) {
local $Data::Dumper::Useqq = $Data::Dumper::Useqq = 1;
diag( Data::Dumper->Dump( [$got], ['$got'] ) );
diag( Data::Dumper->Dump( [$want], ['$expected'] ) );
}
my $yr = Data::YAML::Reader->new;
# Now try parsing it
my $reader = sub { shift @$got };
my $parsed = $yr->read( $reader );
unless ( is_deeply $parsed, $data, "$name: Reparse OK" ) {
local $Data::Dumper::Useqq = $Data::Dumper::Useqq = 1;
diag( Data::Dumper->Dump( [$parsed], ['$parsed'] ) );
diag( Data::Dumper->Dump( [$data], ['$data'] ) );
}
}
}
