view release on metacpan or  search on metacpan

t/002-Spec-analysis.t  view on Meta::CPAN

   $spec = $edi->spec->get_spec('message');
ok($spec,"\$edi->spec->get_spec('message')");
ok($spec->{$msgcode}, "\$edi->spec->get_spec('message')->{$msgcode}");
#print "Dump of ORDRSP spec: ", Dumper($spec->{ORDRSP});

my $sg_spec = $edi->spec->get_spec('segment_group');
ok($sg_spec,"\$edi->spec->get_spec('segment_group')");
ok($sg_spec->{$msgcode}, "\$edi->spec->get_spec('segment_group')->{$msgcode}");

is_deeply($sg_spec->{$msgcode}->{SG26}, $spec->{"$msgcode/SG26"}, "SG_SPECS->{$msgcode}->{SG26} === MSG_SPECS->{'$msgcode/SG26'}");

sub sg_expander {
    my ($countsref, $mapref, $msgcode, $parts, $depth) = @_;
    $depth ||= 1;
    $debug and note("\$edi->spec->get_spec('message')->xpath('$msgcode')");
    foreach my $part (@$parts) {
        my $code = $part->{code};
        $countsref->{$depth}->{$code}++;
        $mapref->{$depth}->{$code} = "$msgcode/$code";
        $debug and note("\$edi->spec->get_spec('message')->xpath('$msgcode/$code') " . $countsref->{$depth}->{$code});
    }
    my $i = scalar @$parts;
    my $spec_key = $msgcode;
    $spec_key =~ s#/.+##; # and print "SPEC_KEY stripped: $spec_key\n";
    foreach (grep {/^SG\d+$/} map {$_->{code}} @$parts) {
        $debug and note("Depth=" . ($depth+1) . " check $msgcode/$_ ($spec_key)");
        $i += sg_expander($countsref, $mapref, "$msgcode/$_", $spec->{"$spec_key/$_"}->{parts}, $depth+1);
        # recursion for depth!
    }
    return $i;
}

my %scratch  = ();
my %deep_map = ();
my %counts   = ();

my @keys = sort {&sg_sort($a,$b)} map {$_->{code}} @{$spec->{$msgcode}->{parts}};
foreach my $key (@keys) {
    $key =~ /SG\d+$/ or next;
    $sg_spec->{$msgcode}->{$key} and
        is_deeply($sg_spec->{$msgcode}->{$key},     $spec->{"$msgcode/$key"},
                "\$sg_spec->{$msgcode}->{$key} vs. \$spec->{'$msgcode/$key'}");
    my @parts = @{$spec->{"$msgcode/$key"}->{parts}};
    sg_expander(\%counts, \%scratch, "$msgcode/$key", \@parts);
}

my @single_keys = grep {$counts{1}->{$_} == 1} keys %{$counts{1}};
my @mutli_keys  = grep {$counts{1}->{$_}  > 1} keys %{$counts{1}};
is(scalar @single_keys, 56, "Depth 1 Deeploadable keys: 56");
is(scalar @mutli_keys, 10, "Depth 1 NOT Deeploadable keys: 10");

if ($debug) {
    my @depths = sort keys %counts;
    DEPTH: foreach my $d (@depths) {
        my @single = sort {&sg_sort($a,$b)} grep {$counts{$d}->{$_} == 1} keys %{$counts{$d}};
        my @mutli  = sort {&sg_sort($a,$b)} grep {$counts{$d}->{$_}  > 1} keys %{$counts{$d}};

        KEY: foreach my $key (@single) {
            foreach my $other (grep {$_ < $d} @depths) {    # check shallower depths (we go in order, so we haven't seen deeper ones yet)
                if ($counts{$other}->{$key}) {
                    printf "Blocked %-4s %2d hits (already at depth=$other)\n", $key, $counts{$other}->{$key};
                    next KEY;
                }
            }
            $deep_map{$key} and warn "Internal ERROR: $key is already deepmapped??";
            $deep_map{$key} = $scratch{$d}->{$key};
            printf "        %-4s => %-25s (depth=$d)\n", $key, $deep_map{$key};
        }
        foreach my $key (@mutli) {
            printf "MUTLI   %-4s %2d hits   %s\n", $key, $counts{$d}->{$key},
                join(", ",
                    map {sprintf "%2d\@depth=$_", $counts{$_}->{$key}}
                    grep {$_ != $d and $counts{$_}->{$key}}
                    @depths
                );
        }
    }
}

$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, ...)");
    }
}

my $specs = {};
my $sgs = {};
my @versions = qw/
 1901   1902   1911   1921   2932
 d93a   s93a   d94a   d94b   d95a   d95b   d96a   d96b
 d97a   d97b   d98a   d98b   d99a   d99b
 d00a   d00b   d01a   d01b   d01c
 d02a   d02b   d03a   d03b   d04a
 d04b   d05a   d05b   d06a   d06b   d07a   d07b   d08a
/;

my @sorted_vers = sort {spec_version_sort($a,$b)} qw/
 d04b   d05a   d05b   d06a   d06b   d07a   d07b   d08a
 1901   1902   2932   1921   1911
 d00a   d00b   d01c   d01a   d01b
 d95a   d95b   d96a   d96b   s93a   d93a   d94a   d94b
 d97a   d97b   d98a   d98b   d99a   d99b
 d02b   d02a   d03a   d03b   d04a
/;
# We check whether the arrays match later

foreach (@versions) {
    ok($specs->{$_} = Business::EDI->new(version => $_)->spec, "Business::EDI->new(version => '$_')->spec()") or next;
    ok($specs->{$_}->spec_page('message'),                     "Business::EDI->new(version => '$_')->spec->spec_page('message')") or next;;
}


my @msgs = qw/ ORDERS ORDRSP INVOIC OSTRPT /;

note "Analyzing " . scalar(@versions) . " spec versions";