1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
use strict;
use warnings;
use Test::More tests => 9;
use Data::Dumper;
use Data::YAML::Writer;
my $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",
"...",
];
my $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'
};
my @buf1 = ();
my @buf2 = ();
my $buf3 = '';
my @destination = (
{
name => 'Array reference',
destination => \@buf1,
normalise => sub { return \@buf1 },
},
{
name => 'Closure',
destination => sub { push @buf2, shift },
normalise => sub { return \@buf2 },
},
{
name => 'Scalar',
destination => \$buf3,
normalise => sub {
my @ar = split( /\n/, $buf3 );
return \@ar;
},
},
);
for my $dest ( @destination ) {
my $name = $dest->{name};
ok my $yaml = Data::YAML::Writer->new, "$name: Created";
isa_ok $yaml, 'Data::YAML::Writer';
$yaml->write( $in, $dest->{destination} );
my $got = $dest->{normalise}->();
unless ( is_deeply $got, $out, "$name: Result matches" ) {
local $Data::Dumper::Useqq = $Data::Dumper::Useqq = 1;
diag( Data::Dumper->Dump( [$got], ['$got'] ) );
diag( Data::Dumper->Dump( [$out], ['$expected'] ) );
}
}
|
