view release on metacpan or  search on metacpan

t/999-data.t  view on Meta::CPAN

#!/usr/bin/perl
#

use strict; use warnings;

use Test::More tests => 20;

BEGIN {
    use_ok('Data::Dumper');
    use_ok('UNIVERSAL::require');

    use_ok('Business::EDI');
    use_ok('Business::EDI::Spec');
    use_ok('JSON::XS');
}

use vars qw/%code_hash $parser $slurp $json $perl/;

ok($parser = JSON::XS->new, 'JSON::XS->new');
$parser->ascii(1);        # output \u escaped strings for any char with a value over 127
$parser->allow_nonref(1); # allows non-reference values to equate to themselves (see perldoc)

#my $debug = $Business::EDI::debug = $Business::EDI::Spec::debug = @ARGV ? shift : 0;
my $debug = $Business::EDI::Spec::debug = @ARGV ? shift : 0;

my $edi = Business::EDI->new('d08a') or die "Business::EDI->new('d08a') failed";

sub JSONObject2Perl {
    my $obj = shift;
    if ( ref $obj eq 'HASH' ) {
        if ( defined $obj->{'__c'} ) {
            die "We somehow got a special (Evergreen) object in our data";
        }
        # is a hash w/o class marker; simply revivify innards
        for my $k (keys %$obj) {
            $obj->{$k} = JSONObject2Perl($obj->{$k}) unless ref $obj->{$k} eq 'JSON::XS::Boolean';
        }
    } elsif ( ref $obj eq 'ARRAY' ) {
        for my $i (0..scalar(@$obj) - 1) {
            $obj->[$i] = JSONObject2Perl($obj->[$i]) unless ref $obj->[$i] eq 'JSON::XS::Boolean';
        }
    } 
    # ELSE: return vivified non-class hashes, all arrays, and anything that isn't a hash or array ref
    return $obj;
}

ok($slurp = join('', <DATA>),     "Slurped data from DATA handle");
my $foo = ($parser->decode($slurp));
ok($foo, "decode slurp");
ok($perl = JSONObject2Perl($foo), "DATA handle read and decode" );

$perl or die "DATA handle not decoded successfully";
# note("ref(\$obj): " . ref($perl));
# note("    \$obj : " .     $perl );

$Data::Dumper::Indent = 1;

ok(($perl->{body} and $perl->{body}->[0]), "EDI interchange body is a populated arrayref!");
is(scalar(@{$perl->{body}}), 3, "EDI interchange body has 3 messages");

my $i = 0;
foreach my $part (@{$perl->{body}}) {
    $i++;
    next unless ok((ref $part and scalar keys %$part), "EDI interchange message $i has structure.");
    foreach my $key (keys %$part) {
        next unless ok($key eq 'ORDRSP', "EDI interchange message $i type == ORDRSP");
        my $ordrsp;
        ok($ordrsp = $edi->message($key, $part->{$key}), "EDI $key object via \$edi->message($key, ...)");
    }
}

print Dumper($perl->{body}->[0]);
note("done");

__DATA__
{
"trailer": ["UNZ", {
    "0020": "2045",
    "0036": 1
}],
"body": [{
    "ORDRSP": [["UNH", {
        "S009": {
            "0052": "D",
            "0054": "96A",
            "0065": "ORDRSP",
            "0051": "UN"
        },
        "0062": "723"
    }], ["BGM", {
        "4343": "AC",
        "1225": "29",
        "C002": {
            "1001": "231"
        },
        "1004": "582822"
    }], ["DTM", {
        "C507": {
            "2379": "102",
            "2380": "20070618",
            "2005": "137"
        }
    }], ["RFF", {
        "C506": {
            "1153": "ON",
            "1154": "E07158FIC"
        }
    }], ["NAD", {
        "C082": {
            "3039": "8888888",
            "3055": "31B"
        },