4 die "Encode::JP not supported on EBCDIC\n";
8 our $VERSION = do {my @r=(q$Revision: 1.1 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r};
9 use Encode qw(find_encoding);
10 use base 'Encode::Encoding';
15 Encode::Tcl - Tcl encodings
21 foreach my $dir (@INC)
23 if (opendir(my $dh,"$dir/Encode"))
25 while (defined(my $name = readdir($dh)))
27 if ($name =~ /^(.*)\.enc$/)
30 my $obj = find_encoding($canon);
33 my $obj = bless { Name => $canon, File => "$dir/Encode/$name"},__PACKAGE__;
34 $obj->Define( $canon );
35 # warn "$canon => $obj\n";
49 sub no_map_in_encode ($$)
50 # codepoint, enc-name;
52 carp sprintf "\"\\N{U+%x}\" does not map to %s", @_;
53 # /* FIXME: Skip over the character, copy in replacement and continue
54 # * but that is messy so for now just fail.
59 sub no_map_in_decode ($$)
60 # enc-name, string beginning the malform char;
62 # /* UTF-8 is supposed to be "Universal" so should not happen */
63 croak sprintf "%s '%s' does not map to UTF-8", @_;
69 my $new = $obj->loadEncoding;
70 return undef unless (defined $new);
71 return $new->encode(@_);
77 my $new = $obj->loadEncoding;
78 return undef unless (defined $new);
79 return $new->new_sequence(@_);
85 my $new = $obj->loadEncoding;
86 return undef unless (defined $new);
87 return $new->decode(@_);
93 my $file = $obj->{'File'};
94 my $name = $obj->name;
95 if (open(my $fh,$file))
101 $type = substr($line,0,1);
102 last unless $type eq '#';
105 ($type eq 'X') ? 'Extended' :
106 ($type eq 'H') ? 'HanZi' :
107 ($type eq 'E') ? 'Escape' : 'Table';
108 my $class = ref($obj) . '::' . $subclass;
109 # carp "Loading $file";
111 return $obj if $obj->read($fh,$obj->name,$type);
115 croak("Cannot open $file for ".$obj->name);
117 $obj->Undefine($name);
123 my ($class,$name) = @_;
125 foreach my $dir (@INC)
127 last if ($enc = $class->loadEncoding($name,"$dir/Encode/$name.enc"));
132 require Encode::Tcl::Table;
133 require Encode::Tcl::Escape;
134 require Encode::Tcl::Extended;
135 require Encode::Tcl::HanZi;