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.3 $ =~ /\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;
for (0xA0..0xFF) {
  my $c = chr $_;
  $TABLE{isoiec8859_1_to_ucs}->{$c} = $c;
  $TABLE{ucs_to_isoiec8859_1}->{$c} = $c;
}
$Encode::Table::isoiec8859_1::VERSION = $VERSION;

my %_Cache;
sub convert ($@%) {
  return $_[0] unless @{$_[1]} > 0;
  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; 1} 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/05 05:01:24 $
### $RCSfile: Table.pm,v $ ends here
1	wakaba	1.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	wakaba	1.4	$VERSION = do {my @r =(q$Revision: 1.3 $ =~ /\d+/g);sprintf "%d."."%02d" x $#r, @r};
12	wakaba	1.1
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	wakaba	1.2	$Encode::Table::ascii::VERSION = $VERSION;
20	wakaba	1.3	for (0xA0..0xFF) {
21			my $c = chr $_;
22			$TABLE{isoiec8859_1_to_ucs}->{$c} = $c;
23			$TABLE{ucs_to_isoiec8859_1}->{$c} = $c;
24			}
25			$Encode::Table::isoiec8859_1::VERSION = $VERSION;
26	wakaba	1.1
27			my %_Cache;
28	wakaba	1.2	sub convert ($@%) {
29	wakaba	1.3	return $_[0] unless @{$_[1]} > 0;
30	wakaba	1.1	my @s = split //, shift;
31			my $tbl = shift;
32			my $tbls = join ' ', @$tbl;
33	wakaba	1.2	my %option = @_;
34			load_table (@$tbl) if $option{-autoload};
35	wakaba	1.1	for my $c (@s) {
36			unless (defined $_Cache{$tbls}->{$c}) {
37			for (@$tbl) {
38			if (defined $TABLE{$_}->{$c}) {
39			$_Cache{$tbls}->{$c} = $TABLE{$_}->{$c}; last;
40			}
41			}
42			$_Cache{$tbls}->{$c} = $c unless defined $_Cache{$tbls}->{$c}; ## Not found
43			}
44			$c = $_Cache{$tbls}->{$c};
45			}
46			join '', @s;
47			}
48
49	wakaba	1.2	sub load_table (@) {
50			no strict 'refs';
51			for (@_) {
52			my $name = $_;
53			if ($name =~ /^ucs_to_(.+)$/) { $name = $1 }
54			elsif ($name =~ /^(.+)_to_ucs$/) { $name = $1 }
55			unless (${ 'Encode::Table::' . $name . '::VERSION' }) {
56	wakaba	1.4	eval qq{require Encode::Table::$name; Encode::Table::$name->import; 1} or warn $@;
57	wakaba	1.2	}
58			}
59			}
60
61	wakaba	1.1	1;
62			__END__
63
64			=head1 AUTHORS
65
66			Nanashi-san
67
68			=head1 LICENSE
69
70			Copyright 2002 AUTHORS
71
72			This library is free software; you can redistribute it
73			and/or modify it under the same terms as Perl itself.
74
75			=cut
76
77	wakaba	1.4	# $Date: 2002/10/05 05:01:24 $
78	wakaba	1.3	### $RCSfile: Table.pm,v $ ends here