diff options
Diffstat (limited to 'cpan/lib/Jcode/Tr.pm')
| -rw-r--r-- | cpan/lib/Jcode/Tr.pm | 47 |
1 files changed, 25 insertions, 22 deletions
diff --git a/cpan/lib/Jcode/Tr.pm b/cpan/lib/Jcode/Tr.pm index 4d8ee1ff..e29e29bb 100644 --- a/cpan/lib/Jcode/Tr.pm +++ b/cpan/lib/Jcode/Tr.pm @@ -1,5 +1,5 @@ # -# $Id: Tr.pm,v 0.63 2000/11/22 09:05:01 dankogai Exp dankogai $ +# $Id: Tr.pm,v 0.70 2001/05/15 19:35:59 dankogai Exp $ # package Jcode::Tr; @@ -7,8 +7,8 @@ package Jcode::Tr; use strict; use vars qw($VERSION $RCSID); -$RCSID = q$Id: Tr.pm,v 0.63 2000/11/22 09:05:01 dankogai Exp dankogai $; -$VERSION = do { my @r = (q$Revision: 0.63 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +$RCSID = q$Id: Tr.pm,v 0.70 2001/05/15 19:35:59 dankogai Exp $; +$VERSION = do { my @r = (q$Revision: 0.70 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; use Carp; @@ -33,26 +33,29 @@ sub tr { return $n; } -sub _maketable { - my ($from, $to, $opt) = @_; - - grep(s/([\x8e\x8f]$RE{EUC_C}-[\x8e\x8f]$RE{EUC_C})/&_expnd3($1)/geo, - $from,$to); - grep(s/($RE{EUC_C}-$RE{EUC_C})/&_expnd2($1)/geo, - $from,$to); - grep(s/($RE{ASCII}-$RE{ASCII})/&_expnd1($1)/geo, - $from,$to); - - my @to = $to =~ /[\x8e\x8f]$RE{EUC_C}|$RE{EUC_C}|[\x00-\xff]/go; - my @from = $from =~ /[\x8e\x8f]$RE{EUC_C}|$RE{EUC_C}|[\x00-\xff]/go; - - push(@to, ($opt =~ /d/ ? '' : $to[$#to]) x (@from - @to)) if @to < @from; +sub _maketable{ + my( $from, $to, $opt ) = @_; + + $from =~ s/($RE{EUC_0212}-$RE{EUC_0212})/&_expnd3($1)/geo; + $from =~ s/($RE{EUC_KANA}-$RE{EUC_KANA})/&_expnd2($1)/geo; + $from =~ s/($RE{EUC_C }-$RE{EUC_C })/&_expnd2($1)/geo; + $from =~ s/($RE{ASCII }-$RE{ASCII })/&_expnd1($1)/geo; + $to =~ s/($RE{EUC_0212}-$RE{EUC_0212})/&_expnd3($1)/geo; + $to =~ s/($RE{EUC_KANA}-$RE{EUC_KANA})/&_expnd2($1)/geo; + $to =~ s/($RE{EUC_C }-$RE{EUC_C })/&_expnd2($1)/geo; + $to =~ s/($RE{ASCII }-$RE{ASCII })/&_expnd1($1)/geo; + + my @from = $from =~ /$RE{EUC_0212}|$RE{EUC_KANA}|$RE{EUC_C}|[\x00-\xff]/go; + my @to = $to =~ /$RE{EUC_0212}|$RE{EUC_KANA}|$RE{EUC_C}|[\x00-\xff]/go; + + push @to, $to[-1] x $#from - $#to if $#to < $#from && $opt !~ /d/; @_TABLE{@from} = @to; + } sub _expnd1 { my ($str) = @_; - s/\\(.)/$1/og; + # s/\\(.)/$1/og; # I dunno what this was doing!? my($c1, $c2) = unpack('CxC', $str); if ($c1 <= $c2) { for ($str = ''; $c1 <= $c2; $c1++) { @@ -75,10 +78,10 @@ sub _expnd2 { sub _expnd3 { my ($str) = @_; - my ($c1, $c2, $c3, $c4) = unpack('CCCxCCC', $str); - if ($c1 == $c3 && $c2 <= $c4) { - for ($str = ''; $c2 <= $c4; $c2++) { - $str .= pack('CCC', $c1, $c2); + my ($c1, $c2, $c3, $c4, $c5, $c6) = unpack('CCCxCCC', $str); + if ($c1 == $c4 && $c2 == $c5 && $c3 <= $c6) { + for ($str = ''; $c3 <= $c6; $c3++) { + $str .= pack('CCC', $c1, $c2, $c3); } } return $str; |