#!/usr/bin/perl
use strict;
use 5.7.3;

=head1 NAME

tbl2pm --- Perl module generator from (completed) PETBL
table file

=head1 DESCRIPTION

This script generates dumped perl module file of convertion
table used with Encode::Table module.

=head1 USAGE

 $ ./tbl2pm.pl table.tbl > table.pm

=cut

require Encode;
my %T;
my %option;
while (<>) {
if (/^((?:0x|[0-9A-Za-z]+[+-])[0-9A-F]+)\tU\+([0-9A-F]+)\t/) {
  $T{ $1 } = hex $2;
} elsif (/^#\?o ([A-Za-z0-9-]+)="((?:[^"\\]|\\.)+)"/) {
  my ($n,$v) = ($1,$2); $n =~ tr/-/_/; $v =~ s/\\(.)/$1/g; $option{$n} = $v;
}
}

require 'internal.pl';
$option{offset} ||= &internal::cp_start (%option) || $internal::cp_start{ $option{charset_name} || $option{table_name} };
if ($option{map_internal}) {
  eval qq{\$option{map_internal} = sub { $option{map_internal} }} or die $@;
} else {
  $option{map_internal} = sub {
    my $c = shift;  $c =~ s/0x//;  $c = hex $c;
    ($option{charset_dimension} > 1 ?
        (int ($c / 0x100) - $option{_start}) * $option{charset_chars} : 0)
      + (($c % 0x100) - $option{_start}) + $option{offset};
  };
}

my (@T, @U);
$option{_start} = $option{charset_chars} == 94 ? 0x21 : 0x20;
@U = sort { $a->[0] <=> $b->[0] }
     map { [ &{$option{map_internal}} ($_), $T{ $_ } ] } keys %T;

my $tbl = '';
my $pack = '';
for (@U) {
  for ($_->[0], $_->[1]) {
    $_ = chr $_;
    Encode::_utf8_off ($_);
    $tbl .= $_;
    $pack .= 'a' . length ($_);
  }
}

print <<EOH;
## This file is auto-generated (at @{[ sprintf '%04d-%02d-%02dT%02d:%02d:%02dZ', (gmtime)[5]+1900, (gmtime)[4]+1, (gmtime)[3,2,1,0] ]}).
## Do not edit by hand!

=head1 NAME

Encode::Table::$option{table_name} --- Convertion tables
used with Encode::Table, C<$option{table_name}_to_ucs>
and C<ucs_to_$option{table_name}>

=head1 TABLES

=over 4

=item $option{table_name}_to_ucs

Convertion table of $option{table_name} -> ucs

=item ucs_to_$option{table_name}

Convertion table of ucs -> $option{table_name}

=back

=head1 SEE ALSO

Encode::Table

=head1 LICENSE

See source table of this module.  (It may be named as
C<$option{table_name}.tbr>.)

=cut

package Encode::Table::$option{table_name};
use strict;
our \$VERSION = q(@{[sprintf '%04d.%02d%02d', (gmtime)[5]+1900, (gmtime)[4]+1, (gmtime)[3]]});

## These tables are embeded in binary, so that your editor
## might break the data or might hang up.









#

our %L2U = map {Encode::_utf8_on (\$_) if length \$_ > 1; \$_} unpack
(q{$pack}, <<'END');
EOH

print $tbl,"\nEND\n";

print <<EOH;
our %U2L = reverse %L2U;
sub import {
  \$Encode::Table::TABLE{$option{table_name}_to_ucs} = \\%L2U;
  \$Encode::Table::TABLE{ucs_to_$option{table_name}} = \\%U2L;
}
1;
### $option{table_name}.pm ends here
EOH


=head1 SEE ALSO

Encode::Table, internal.pl

=head1 AUTHOR

Nanashi-san

=head1 LICENSE

Copyright 2002 AUTHOR

This library is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.

AUTHOR does NOT claim any right to the data generated by
this script.  License of generated data fully depends
author of source data.

=cut

1; ## $Date: 2002/12/18 10:21:09 $
### tbl2pm.pl ends here