lib/Encode/Table.pm


=head1 NAME

Encode::Table --- Inter-coding-space table convertion

=cut

package Encode::Table;
use strict;
use vars qw(%TABLE $VERSION);
$VERSION = do {my @r =(q$Revision: 1.1 $ =~ /\d+/g);sprintf "%d."."%02d" x $#r, @r};

## Builtin tables
for (0x00..0x7F) {
  my $c = chr $_;
  $TABLE{ascii_to_ucs}->{$c} = $c;
  $TABLE{ucs_to_ascii}->{$c} = $c;
}
$Encode::Table::ascii::VERSION = $VERSION;

my %_Cache;
sub convert ($@%) {
  my @s = split //, shift;
  my $tbl = shift;
  my $tbls = join ' ', @$tbl;
  my %option = @_;
  load_table (@$tbl) if $option{-autoload};
  for my $c (@s) {
    unless (defined $_Cache{$tbls}->{$c}) {
      for (@$tbl) {
        if (defined $TABLE{$_}->{$c}) {
          $_Cache{$tbls}->{$c} = $TABLE{$_}->{$c}; last;
        }
      }
      $_Cache{$tbls}->{$c} = $c unless defined $_Cache{$tbls}->{$c};    ## Not found
    }
    $c = $_Cache{$tbls}->{$c};
  }
  join '', @s;
}

sub load_table (@) {
  no strict 'refs';
  for (@_) {
    my $name = $_;
    if ($name =~ /^ucs_to_(.+)$/) { $name = $1 }
    elsif ($name =~ /^(.+)_to_ucs$/) { $name = $1 }
    unless (${ 'Encode::Table::' . $name . '::VERSION' }) {
      eval qq{require Encode::Table::$name; Encode::Table::$name->import} or warn $@;
    }
  }
}

1;
__END__

=head1 AUTHORS

Nanashi-san

=head1 LICENSE

Copyright 2002 AUTHORS

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

=cut

# $Date: 2002/10/04 23:58:04 $
### $RCSfile: /home/cvs/perl/lib/Encode/Table.pm,v $ ends here
1
2	=head1 NAME
3
4	Encode::Table --- Inter-coding-space table convertion
5
6	=cut
7
8	package Encode::Table;
9	use strict;
10	use vars qw(%TABLE $VERSION);
11	$VERSION = do {my @r =(q$Revision: 1.1 $ =~ /\d+/g);sprintf "%d."."%02d" x $#r, @r};
12
13	## Builtin tables
14	for (0x00..0x7F) {
15	my $c = chr $_;
16	$TABLE{ascii_to_ucs}->{$c} = $c;
17	$TABLE{ucs_to_ascii}->{$c} = $c;
18	}
19	$Encode::Table::ascii::VERSION = $VERSION;
20
21	my %_Cache;
22	sub convert ($@%) {
23	my @s = split //, shift;
24	my $tbl = shift;
25	my $tbls = join ' ', @$tbl;
26	my %option = @_;
27	load_table (@$tbl) if $option{-autoload};
28	for my $c (@s) {
29	unless (defined $_Cache{$tbls}->{$c}) {
30	for (@$tbl) {
31	if (defined $TABLE{$_}->{$c}) {
32	$_Cache{$tbls}->{$c} = $TABLE{$_}->{$c}; last;
33	}
34	}
35	$_Cache{$tbls}->{$c} = $c unless defined $_Cache{$tbls}->{$c}; ## Not found
36	}
37	$c = $_Cache{$tbls}->{$c};
38	}
39	join '', @s;
40	}
41
42	sub load_table (@) {
43	no strict 'refs';
44	for (@_) {
45	my $name = $_;
46	if ($name =~ /^ucs_to_(.+)$/) { $name = $1 }
47	elsif ($name =~ /^(.+)_to_ucs$/) { $name = $1 }
48	unless (${ 'Encode::Table::' . $name . '::VERSION' }) {
49	eval qq{require Encode::Table::$name; Encode::Table::$name->import} or warn $@;
50	}
51	}
52	}
53
54	1;
55	__END__
56
57	=head1 AUTHORS
58
59	Nanashi-san
60
61	=head1 LICENSE
62
63	Copyright 2002 AUTHORS
64
65	This library is free software; you can redistribute it
66	and/or modify it under the same terms as Perl itself.
67
68	=cut
69
70	# $Date: 2002/10/04 23:58:04 $
71	### $RCSfile: /home/cvs/perl/lib/Encode/Table.pm,v $ ends here