# XlateHexcode.pm

package XlateHexcode;

use warnings
    FATAL => 'all'
    ;
use strict;


my %lookup = (
    '80' => [ 'TEST',  'TEST SYSTEM',    ],
    '81' => [ 'TOOL',  'REFERENCE TOOL', ],
    '82' => [ 'DEBUG', 'DEBUG SYSTEM',   ],
    'A0' => [ 'ARC',   'ARCADE SYSTEM',  ],
    '83' => [ 'CEX',   'Japan',          ],
    '84' => [ 'CEX',   'United States',  ],
    '85' => [ 'CEX',   'Europe',         ],
    '86' => [ 'CEX',   'Korea',          ],
    '87' => [ 'CEX',   'United Kingdom', ],
    '88' => [ 'CEX',   'Mexico',         ],
    '89' => [ 'CEX',   'Australia',      ],
    '8A' => [ 'CEX',   'South Asia',     ],
    '8B' => [ 'CEX',   'Taiwan',         ],
    '8C' => [ 'CEX',   'Russia',         ],
    '8D' => [ 'CEX',   'China',          ],
    '8E' => [ 'CEX',   'Hong Kong',      ],
    '8F' => [ 'CEX',   'Brazil',         ],
    );

my $nzhp = qr{ (?! 00) [[:xdigit:]]{2} }xms;  # non-zero hex pair


sub xlate {

    my ($data,
        ) = @_;

    $data =~ m{ \A (?: 00 ($nzhp) | ($nzhp) 00) \z }xms
        or die "'$data' does not have non-zero hex pair";
    my $hcp = $1 || $2;  # hex code pair

    $hcp = uc $hcp;

    exists $lookup{$hcp}
        or die "unknown hex code pair: '$hcp'";

    return @{ $lookup{$hcp} };

    }  # end sub xlate()


1;
[download]

# XlateHexcode.t

use warnings;
use strict;


use Test::More
  # tests => ?? + 1  # Test::NoWarnings adds 1 test
    'no_plan'
    ;
use Test::NoWarnings;
use Test::Exception;


BEGIN { use_ok 'XlateHexcode'; }


VECTOR:
for my $ar_vector (
    [ '0080' => 'TEST',  'TEST SYSTEM',    ],
    [ '8000' => 'TEST',  'TEST SYSTEM',    ],
    [ '0081' => 'TOOL',  'REFERENCE TOOL', ],
    [ '8100' => 'TOOL',  'REFERENCE TOOL', ],
    [ '0082' => 'DEBUG', 'DEBUG SYSTEM',   ],
    [ '8200' => 'DEBUG', 'DEBUG SYSTEM',   ],
    [ '00A0' => 'ARC',   'ARCADE SYSTEM',  ],
    [ 'A000' => 'ARC',   'ARCADE SYSTEM',  ],
    [ '0083' => 'CEX',   'Japan',          ],
    [ '8300' => 'CEX',   'Japan',          ],
    [ '0084' => 'CEX',   'United States',  ],
    [ '8400' => 'CEX',   'United States',  ],
    [ '0085' => 'CEX',   'Europe',         ],
    [ '8500' => 'CEX',   'Europe',         ],
    [ '0086' => 'CEX',   'Korea',          ],
    [ '8600' => 'CEX',   'Korea',          ],
    [ '0087' => 'CEX',   'United Kingdom', ],
    [ '8700' => 'CEX',   'United Kingdom', ],
    [ '0088' => 'CEX',   'Mexico',         ],
    [ '8800' => 'CEX',   'Mexico',         ],
    [ '0089' => 'CEX',   'Australia',      ],
    [ '8900' => 'CEX',   'Australia',      ],
    [ '008A' => 'CEX',   'South Asia',     ],
    [ '8A00' => 'CEX',   'South Asia',     ],
    [ '008B' => 'CEX',   'Taiwan',         ],
    [ '8B00' => 'CEX',   'Taiwan',         ],
    [ '008C' => 'CEX',   'Russia',         ],
    [ '8C00' => 'CEX',   'Russia',         ],
    [ '008D' => 'CEX',   'China',          ],
    [ '8D00' => 'CEX',   'China',          ],
    [ '008E' => 'CEX',   'Hong Kong',      ],
    [ '8E00' => 'CEX',   'Hong Kong',      ],
    [ '008F' => 'CEX',   'Brazil',         ],
    [ '8F00' => 'CEX',   'Brazil',         ],
    ) {

    if (not ref $ar_vector) {
        note $ar_vector;
        next VECTOR;
        }

    my ($data, $expected_tid, $expected_buf) = @$ar_vector;

    is_deeply [ XlateHexcode::xlate($data) ],
              [ $expected_tid, $expected_buf ],
            # qq{}
              ;

    }  # end for VECTOR

note "==== exceptions ====";

EXCEPTION:
for my $ar_vector (
    [ '0000'  => 'does not have non-zero hex pair', ],
    [ '8080'  => 'does not have non-zero hex pair', ],
    [ '80000' => 'does not have non-zero hex pair', ],
    [ '00080' => 'does not have non-zero hex pair', ],
    [ '00800' => 'does not have non-zero hex pair', ],
    [ '0x00'  => 'does not have non-zero hex pair', ],
    [ '00X0'  => 'does not have non-zero hex pair', ],
    [ 'xxxx'  => 'does not have non-zero hex pair', ],
    [ '0800'  => 'unknown hex code pair', ],
    [ '0008'  => 'unknown hex code pair', ],
    [ 'A100'  => 'unknown hex code pair', ],
    [ '00A1'  => 'unknown hex code pair', ],
    ) {

    if (not ref $ar_vector) {
        note $ar_vector;
        next EXCEPTION;
        }

    my ($data, $expected_err) = @$ar_vector;

    dies_ok { XlateHexcode::xlate($data) } $expected_err;

    }  # end for EXCEPTION
[download]