1#!/usr/bin/perl -wT 2 3use strict; 4use lib 't/lib'; 5 6use Test::More tests => 9; 7 8use TAP::Parser::YAMLish::Writer; 9 10my $out = [ 11 "---", 12 "bill-to:", 13 " address:", 14 " city: \"Royal Oak\"", 15 " lines: \"458 Walkman Dr.\\nSuite #292\\n\"", 16 " postal: 48046", 17 " state: MI", 18 " family: Dumars", 19 " given: Chris", 20 "comments: \"Late afternoon is best. Backup contact is Nancy Billsmer \@ 338-4338\\n\"", 21 "date: 2001-01-23", 22 "invoice: 34843", 23 "product:", 24 " -", 25 " description: Basketball", 26 " price: 450.00", 27 " quantity: 4", 28 " sku: BL394D", 29 " -", 30 " description: \"Super Hoop\"", 31 " price: 2392.00", 32 " quantity: 1", 33 " sku: BL4438H", 34 "tax: 251.42", 35 "total: 4443.52", 36 "...", 37]; 38 39my $in = { 40 'bill-to' => { 41 'given' => 'Chris', 42 'address' => { 43 'city' => 'Royal Oak', 44 'postal' => '48046', 45 'lines' => "458 Walkman Dr.\nSuite #292\n", 46 'state' => 'MI' 47 }, 48 'family' => 'Dumars' 49 }, 50 'invoice' => '34843', 51 'date' => '2001-01-23', 52 'tax' => '251.42', 53 'product' => [ 54 { 'sku' => 'BL394D', 55 'quantity' => '4', 56 'price' => '450.00', 57 'description' => 'Basketball' 58 }, 59 { 'sku' => 'BL4438H', 60 'quantity' => '1', 61 'price' => '2392.00', 62 'description' => 'Super Hoop' 63 } 64 ], 65 'comments' => 66 "Late afternoon is best. Backup contact is Nancy Billsmer @ 338-4338\n", 67 'total' => '4443.52' 68}; 69 70my @buf1 = (); 71my @buf2 = (); 72my $buf3 = ''; 73 74my @destination = ( 75 { name => 'Array reference', 76 destination => \@buf1, 77 normalise => sub { return \@buf1 }, 78 }, 79 { name => 'Closure', 80 destination => sub { push @buf2, shift }, 81 normalise => sub { return \@buf2 }, 82 }, 83 { name => 'Scalar', 84 destination => \$buf3, 85 normalise => sub { 86 my @ar = split( /\n/, $buf3 ); 87 return \@ar; 88 }, 89 }, 90); 91 92for my $dest (@destination) { 93 my $name = $dest->{name}; 94 ok my $yaml = TAP::Parser::YAMLish::Writer->new, "$name: Created"; 95 isa_ok $yaml, 'TAP::Parser::YAMLish::Writer'; 96 97 $yaml->write( $in, $dest->{destination} ); 98 my $got = $dest->{normalise}->(); 99 is_deeply $got, $out, "$name: Result matches"; 100} 101