3 our $VERSION = do {my @r=(q$Revision: 1.1 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r};
4 use Encode qw(find_encoding);
5 use base 'Encode::Encoding';
10 Encode::Tcl - Tcl encodings
16 foreach my $dir (@INC)
18 if (opendir(my $dh,"$dir/Encode"))
20 while (defined(my $name = readdir($dh)))
22 if ($name =~ /^(.*)\.enc$/)
25 my $obj = find_encoding($canon);
28 my $obj = bless { Name => $canon, File => "$dir/Encode/$name"},__PACKAGE__;
29 $obj->Define( $canon );
30 # warn "$canon => $obj\n";
44 sub no_map_in_encode ($$)
45 # codepoint, enc-name;
47 carp sprintf "\"\\N{U+%x}\" does not map to %s", @_;
48 # /* FIXME: Skip over the character, copy in replacement and continue
49 # * but that is messy so for now just fail.
54 sub no_map_in_decode ($$)
55 # enc-name, string beginning the malform char;
57 # /* UTF-8 is supposed to be "Universal" so should not happen */
58 croak sprintf "%s '%s' does not map to UTF-8", @_;
64 my $new = $obj->loadEncoding;
65 return undef unless (defined $new);
66 return $new->encode(@_);
72 my $new = $obj->loadEncoding;
73 return undef unless (defined $new);
74 return $new->new_sequence(@_);
80 my $new = $obj->loadEncoding;
81 return undef unless (defined $new);
82 return $new->decode(@_);
88 my $file = $obj->{'File'};
89 my $name = $obj->name;
90 if (open(my $fh,$file))
96 $type = substr($line,0,1);
97 last unless $type eq '#';
100 ($type eq 'X') ? 'Extended' :
101 ($type eq 'H') ? 'HanZi' :
102 ($type eq 'E') ? 'Escape' : 'Table';
103 my $class = ref($obj) . '::' . $subclass;
104 # carp "Loading $file";
106 return $obj if $obj->read($fh,$obj->name,$type);
110 croak("Cannot open $file for ".$obj->name);
112 $obj->Undefine($name);
118 my ($class,$name) = @_;
120 foreach my $dir (@INC)
122 last if ($enc = $class->loadEncoding($name,"$dir/Encode/$name.enc"));
127 require Encode::Tcl::Table;
128 require Encode::Tcl::Escape;
129 require Encode::Tcl::Extended;
130 require Encode::Tcl::HanZi;