view release on metacpan or  search on metacpan

t/14-yaml-tainted-input.t  view on Meta::CPAN

#!perl -T

use 5.008;

use strict;
use warnings;

use utf8;

our $VERSION='0.31';

use Test::More;
use Test::Taint;
use Test2::Plugin::UTF8;

use Data::Roundtrip qw/yaml2perl perl2yaml/;

my ($perl, $newperl, $yamlstr);

$perl = [
	{
		"\"aaa'bbb" => "aaa",
		"bbb" => 1,
	}
];

$yamlstr = perl2yaml($perl);
ok(defined($yamlstr), 'perl2yaml()'." : called and got defined result");
ok($yamlstr =~ /^\-\-\-/, 'perl2yaml()'." : called and looks like a yaml string");
taint($yamlstr);
$newperl = yaml2perl($yamlstr);
ok(defined($newperl), 'yaml2perl()'." : called and got good result with tainted yaml string as input");
is_deeply($perl, $newperl, 'yaml2perl()'." : result is exactly the same as the data structure we started with");

# with unicode
$perl = [
	{
		"\"ααα'βββ" => "ααα",
		"βββ" => 1,
	}
];

my $yamlstr2 = perl2yaml($perl);
ok(defined($yamlstr2), 'perl2yaml()'." : called and got defined result");
ok($yamlstr2 =~ /^\-\-\-/, 'perl2yaml()'." : called and looks like a yaml string");

taint($yamlstr2);
$newperl = yaml2perl($yamlstr2);
ok(defined($newperl), 'yaml2perl()'." : called and got good result with tainted yaml string as input");

is_deeply($perl, $newperl, 'yaml2perl()'." : result is exactly the same as the data structure we started with");

done_testing;

1;
__END__