The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

#---------------------------------------------------------- -*-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__