#---------------------------------------------------------- -*-perl-*-
# Code common to both XS and pure Perl versions:
#---------------------------------------------------------------------
# Validate mapping table (and 'pack' it if necessary):
sub prepare_mapping {
return unless defined $_[0];
return if length $_[0] == 256;
unless ($_[0] =~ /[^0-9A-Fa-f\s]/) {
$_[0] =~ s/\s+//g; # Delete whitespace
unless (length($_[0]) % 2) {
$_[0] = pack('H*', $_[0]);
return if length $_[0] == 256;
} # end unless we have an odd number of digits
} # end unless string doesn't look like hexadecimal
croak("$_[1] is not valid");
} # end prepare_mapping
#---------------------------------------------------------------------
# Find the inverse of a mapping table (must be 1-to-1):
sub invert_mapping {
my @orig = unpack('C256', $_[0]);
my @new = (undef) x 256;
foreach my $i (0 .. 255) {
$new[$orig[$i]] = $i;
}
if (grep { not defined $_ } @new) {
croak("Translation is not 1-to-1;" .
" you must supply both ASCII->EBCDIC and EBCDIC->ASCII mappings");
}
pack('C256', @new);
} # end invert_mapping
#---------------------------------------------------------------------
# Set a user-specified translation table:
sub set_translation {
my ($a2e_table, $e2a_table, $e2ap_table) = @_;
prepare_mapping($a2e_table, 'ASCII->EBCDIC mapping');
prepare_mapping($e2a_table, 'EBCDIC->ASCII mapping');
prepare_mapping($e2ap_table, 'EBCDIC->printable ASCII mapping');
if (not defined $a2e_table) {
croak("Neither ASCII->EBCDIC nor EBCDIC->ASCII mapping was defined")
unless defined $e2a_table;
$a2e_table = invert_mapping($e2a_table);
} elsif (not defined $e2a_table) {
$e2a_table = invert_mapping($a2e_table);
}
if (not defined $e2ap_table) {
$e2ap_table = $e2a_table;
$e2ap_table =~ s/[^\w.<(+|&!\$*)\\;\-\/,\%>\?\`:#\@\'=\"~\[\]\{\}]/ /g;
}
_set_translation($a2e_table, $e2a_table, $e2ap_table);
} # end set_translation
#---------------------------------------------------------------------
sub set_codepage {
my $codepage = $_[0];
eval "use Convert::IBM390::$codepage;";
croak "Unable to set code page $codepage: $@" if $@;
}
#=====================================================================
1;
__END__