#!/usr/bin/perl
# vim: ts=2 sw=2 expandtab
use warnings;
use strict;
use POE::Filter::Reference;
use Test::More;
BEGIN {
eval 'use YAML';
if ($@) {
plan skip_all => 'YAML module not available';
}
else {
plan tests => 5;
}
}
# Create a YAML stream a la Perl.
# Baseline. Verify the basic YAML is liked.
my $test_data = {
test => 1,
foo => [1, 2],
bar => int(rand(999)),
};
my $basic_yaml = YAML::Dump($test_data);
# Baseline test. Make sure the Perl YAML can be decoded.
ok(
doesnt_die($basic_yaml),
"basic yaml doesn't die"
);
# Some YAML producers don't include newlines.
# This reportedly causes problems for Perl's YAML parser.
{
my $no_newline_yaml = $basic_yaml;
chomp $no_newline_yaml;
ok(
dies_when_allowed($no_newline_yaml),
"yaml without newlines dies when allowed"
);
ok(
exception_caught($no_newline_yaml),
"yaml without newlines returns error when caught"
);
}
# YAML supports a "...\n" record terminator.
# Perl's YAML is reported to dislike this.
{
my $terminated_yaml = $basic_yaml . "...\n";
ok(
dies_when_allowed($terminated_yaml),
"terminated_yaml dies when allowed"
);
ok(
exception_caught($terminated_yaml),
"terminated_yaml returns error when caught"
);
}
exit;
sub doesnt_die {
my $yaml = shift();
my $pfr = POE::Filter::Reference->new('YAML', 0, 0);
my $encoded = length($yaml) . "\0" . $yaml;
my $decoded = $pfr->get([ $encoded ]);
return(
defined($decoded) &&
(ref($decoded) eq 'ARRAY') &&
(@$decoded == 1) &&
(ref($decoded->[0]) eq 'HASH')
);
}
sub dies_when_allowed {
my $yaml = shift();
my $pfr = POE::Filter::Reference->new('YAML', 0, 0);
my $encoded = length($yaml) . "\0" . $yaml;
$@ = undef;
my $decoded = eval { $pfr->get([ $encoded ]); };
return !!$@;
}
sub exception_caught {
my $yaml = shift();
my $pfr = POE::Filter::Reference->new('YAML', 0, 1);
my $encoded = length($yaml) . "\0" . $yaml;
my $decoded = eval { $pfr->get([ $encoded ]); };
return(
defined($decoded) &&
(ref($decoded) eq 'ARRAY') &&
(@$decoded == 1) &&
(ref($decoded->[0]) eq '')
);
}