diff options
| -rw-r--r-- | cpan/dist/Jcode/INSTALL | 2 | ||||
| -rw-r--r-- | cpan/dist/Jcode/Jcode.pm | 293 | ||||
| -rw-r--r-- | cpan/dist/Jcode/Jcode/Constants.pm | 33 | ||||
| -rw-r--r-- | cpan/dist/Jcode/Jcode/H2Z.pm | 18 | ||||
| -rw-r--r-- | cpan/dist/Jcode/Jcode/Tr.pm | 47 | ||||
| -rw-r--r-- | cpan/dist/Jcode/Jcode/Unicode/Constants.pm | 69 | ||||
| -rw-r--r-- | cpan/dist/Jcode/Jcode/Unicode/NoXS.pm | 34 | ||||
| -rw-r--r-- | cpan/dist/Jcode/Makefile.PL | 2 | ||||
| -rw-r--r-- | cpan/dist/Jcode/README | 2 | ||||
| -rw-r--r-- | cpan/dist/Jcode/Unicode/Unicode.pm | 39 | ||||
| -rw-r--r-- | cpan/dist/Jcode/Unicode/table.h | 2 | ||||
| -rw-r--r-- | cpan/dist/Jcode/Unicode/uni.c | 2 | ||||
| -rw-r--r-- | cpan/dist/Jcode/t/mime.t | 28 | ||||
| -rw-r--r-- | cpan/dist/Jcode/t/unibench.pl | 19 | ||||
| -rw-r--r-- | cpan/lib/Jcode/Constants.pm | 33 | ||||
| -rw-r--r-- | cpan/lib/Jcode/H2Z.pm | 18 | ||||
| -rw-r--r-- | cpan/lib/Jcode/Tr.pm | 47 | ||||
| -rw-r--r-- | cpan/lib/Jcode/Unicode/Constants.pm | 69 | ||||
| -rw-r--r-- | cpan/lib/Jcode/Unicode/NoXS.pm | 34 |
19 files changed, 419 insertions, 372 deletions
diff --git a/cpan/dist/Jcode/INSTALL b/cpan/dist/Jcode/INSTALL index 70b2a17b..0e30cf4d 100644 --- a/cpan/dist/Jcode/INSTALL +++ b/cpan/dist/Jcode/INSTALL @@ -1,5 +1,5 @@ # -# $Id: INSTALL,v 0.61 2000/11/15 05:45:25 dankogai Exp $ +# $Id: INSTALL,v 0.70 2001/05/15 19:35:59 dankogai Exp $ # To install diff --git a/cpan/dist/Jcode/Jcode.pm b/cpan/dist/Jcode/Jcode.pm index 317bb34a..b61ace7b 100644 --- a/cpan/dist/Jcode/Jcode.pm +++ b/cpan/dist/Jcode/Jcode.pm @@ -1,5 +1,5 @@ # -# $Id: Jcode.pm,v 0.66 2000/12/21 12:04:40 dankogai Exp dankogai $ +# $Id: Jcode.pm,v 0.71 2001/05/18 05:14:38 dankogai Exp dankogai $ # =head1 NAME @@ -9,7 +9,7 @@ Jcode - Japanese Charset Handler =head1 SYNOPSIS use Jcode; - + # # traditional Jcode::convert(\$str, $ocode, $icode, "z"); # or OOP! @@ -39,8 +39,8 @@ require 5.004; use strict; use vars qw($RCSID $VERSION); -$RCSID = q$Id: Jcode.pm,v 0.66 2000/12/21 12:04:40 dankogai Exp dankogai $; -$VERSION = do { my @r = (q$Revision: 0.66 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +$RCSID = q$Id: Jcode.pm,v 0.71 2001/05/18 05:14:38 dankogai Exp dankogai $; +$VERSION = do { my @r = (q$Revision: 0.71 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; use Carp; @@ -49,7 +49,7 @@ BEGIN { use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); @ISA = qw(Exporter); @EXPORT = qw(jcode getcode); - @EXPORT_OK = qw($RCSID $VERSION $DEBUG $USE_CACHE); + @EXPORT_OK = qw($RCSID $VERSION $DEBUG $USE_CACHE $NOXS); %EXPORT_TAGS = ( all => [ @EXPORT_OK, @EXPORT ] ); } @@ -57,29 +57,31 @@ use vars @EXPORT_OK; $DEBUG = 0; $USE_CACHE = 1; +$NOXS = 0; print $RCSID, "\n" if $DEBUG; use Jcode::Constants qw(:all); -=head1 Methods - -Methods mentioned here all return Jcode object unless otherwise mentioned. - -=over 4 - -=cut - use overload '""' => sub { ${$_[0]->[0]} }, '==' => sub {overload::StrVal($_[0]) eq overload::StrVal($_[1])}, + '=' => sub{ $_[0]->set( $_[1] ) }, + '.=' => sub{ $_[0]->append( $_[1] ) }, fallback => 1, ; + +=head1 Methods + +Methods mentioned here all return Jcode object unless otherwise mentioned. + +=over 4 + =item $j = Jcode->new($str [, $icode]); Creates Jcode object $j from $str. Input code is automatically checked -unless you explicitly set $icode. For available charset, see L<getcode()> +unless you explicitly set $icode. For available charset, see L<getcode> below. The object keeps the string in EUC format enternaly. When the object @@ -96,12 +98,30 @@ Jcode->new(\$str); This saves time a little bit. In exchange of the value of $str being converted. (In a way, $str is now "tied" to jcode object). +=item $j->set($str [, $icode]); + +Sets $j's internal string to $str. Handy when you use Jcode object repeatedly +(saves time and memory to create object). + + # converts mailbox to SJIS format + my $jconv = new Jcode; + $/ = 00; + while(<>){ + print $jconv->set(\$_)->mime_decode->sjis; + } + +=item $j->append($str [, $icode]); + +Appends $str to $j's internal string. + +=back + =cut sub new { my $class = shift; my ($thingy, $icode) = @_; - my $r_str = _mkbuf($thingy); + my $r_str = ref $thingy ? $thingy : \$thingy; my $nmatch; ($icode, $nmatch) = getcode($r_str) unless $icode; convert($r_str, 'euc', $icode); @@ -118,23 +138,10 @@ sub r_str { $_[0]->[0] } sub icode { $_[0]->[1] } sub nmatch { $_[0]->[2] } -=item $j->set($str [, $icode]); - -Sets $j's internal string to $str. Handy when you use Jcode object repeatedly -(saves time and memory to create object). - - # converts mailbox to SJIS format - my $jconv = new Jcode; - while(<>){ - print $jconv->set(\$_)->mime_decode->sjis; - } - -=cut - sub set { my $self = shift; my ($thingy, $icode) = @_; - my $r_str = _mkbuf($thingy); + my $r_str = ref $thingy ? $thingy : \$thingy; my $nmatch; ($icode, $nmatch) = getcode($r_str) unless $icode; convert($r_str, 'euc', $icode); @@ -144,16 +151,10 @@ sub set { return $self; } -=item $j->append($str [, $icode]); - -Appends $str to $j's internal string. - -=cut - sub append { my $self = shift; my ($thingy, $icode) = @_; - my $r_str = _mkbuf($thingy); + my $r_str = ref $thingy ? $thingy : \$thingy; my $nmatch; ($icode, $nmatch) = getcode($r_str) unless $icode; convert($r_str, 'euc', $icode); @@ -163,6 +164,7 @@ sub append { return $self; } +=over 4 =item $j = jcode($str [, $icode]); @@ -178,22 +180,23 @@ $sjis = jcode($str)->sjis; What you code is what you get :) -=cut - -sub jcode { return Jcode->new(@_) } -sub euc { return ${$_[0]->[0]} } -sub jis { return &euc_jis(${$_[0]->[0]})} -sub sjis { return &euc_sjis(${$_[0]->[0]})} - =item $iso_2022_jp = $j->iso_2022_jp Same as $j->z2h->jis. Hankaku Kanas are forcibly converted to Zenkaku. +=back + =cut +sub jcode { return Jcode->new(@_) } +sub euc { return ${$_[0]->[0]} } +sub jis { return &euc_jis(${$_[0]->[0]})} +sub sjis { return &euc_sjis(${$_[0]->[0]})} sub iso_2022_jp{return $_[0]->h2z->jis} +=over 4 + =item [@lines =] $jcode->jfold([$bytes_per_line, $newline_str]); folds lines in jcode string every $bytes_per_line (default: 72) @@ -201,6 +204,8 @@ in a way that does not clobber the multibyte string. (Sorry, no Kinsoku done!) with a newline string spified by $newline_str (default: \n). +=back + =cut sub jfold{ @@ -210,7 +215,9 @@ sub jfold{ $nl ||= "\n"; my $r_str = $self->[0]; my (@lines, $len, $i); - while ($$r_str =~ m/([\x8f\x8e]$RE{EUC_C}|$RE{EUC_C}|[\x00-\xff])/sgo){ + while ($$r_str =~ + m/($RE{EUC_0212}|$RE{EUC_KANA}|$RE{EUC_C}|[\x00-\xff])/sgo) + { if ($len + length($1) > $bpl){ # fold! $i++; $len = 0; @@ -223,18 +230,28 @@ sub jfold{ return wantarray ? @lines : $self; } - =head2 Methods that use MIME::Base64 To use methods below, you need MIME::Base64. To install, simply perl -MCPAN -e 'CPAN::Shell->install("MIME::Base64")' +=over 4 + =item $mime_header = $j->mime_encode([$lf, $bpl]); Converts $str to MIME-Header documented in RFC1522. -When $lf is specified, it uses $lf to fold line (default: \n); -When $bpl is specified, it uses $bpl for the number of bytes (default: 76); +When $lf is specified, it uses $lf to fold line (default: \n). +When $bpl is specified, it uses $bpl for the number of bytes (default: 76; +this number must be smaller than 76). + +=item $j->mime_decode; + +Decodes MIME-Header in Jcode object. + +You can retrieve the number of matches via $j->nmatch; + +=back =cut @@ -257,24 +274,25 @@ sub mime_encode{ sub _add_encoded_word { require MIME::Base64; - my($str, $line) = @_; + my($str, $line, $bpl) = @_; my $result = ''; while (length($str)) { my $target = $str; $str = ''; if (length($line) + 22 + - ($target =~ /^(?:$RE{EUC_0212}|$RE{EUC_C})/o) * 8 > 76) { + ($target =~ /^(?:$RE{EUC_0212}|$RE{EUC_C})/o) * 8 > $bpl) { $line =~ s/[ \t\n\r]*$/\n/; $result .= $line; $line = ' '; } while (1) { my $encoded = '=?ISO-2022-JP?B?' . - MIME::Base64::encode_base64( + MIME::Base64::encode_base64( jcode($target, 'euc')->iso_2022_jp, '') - . '?='; - if (length($encoded) + length($line) > 76) { - $target =~ s/(RE{EUC_0212}|$RE{EUC_C}|$RE{ASCII})$//o; + . '?='; + if (length($encoded) + length($line) > $bpl) { + $target =~ + s/($RE{EUC_0212}|$RE{EUC_KANA}|$RE{EUC_C}|$RE{ASCII})$//o; $str = $1 . $str; } else { $line .= $encoded; @@ -310,7 +328,7 @@ sub _mime_unstructured_header { $header .= $word; } } else { - $header = _add_encoded_word($word, $header); + $header = _add_encoded_word($word, $header, $bpl); } $header =~ /(?:.*\n)?(.*)/; if (length($1) == $bpl) { @@ -323,14 +341,6 @@ sub _mime_unstructured_header { $header; } -=item $j->mime_decode; - -Decodes MIME-Header in Jcode object. - -You can retrieve the number of matches via $j->nmatch; - -=cut - # see http://www.din.or.jp/~ohzaki/perl.htm#JP_Base64 #$lws = '(?:(?:\x0d\x0a)?[ \t])+'; #$ew_regex = '=\?ISO-2022-JP\?B\?([A-Za-z0-9+/]+=*)\?='; @@ -342,7 +352,7 @@ sub mime_decode{ my $self = shift; my $r_str = $self->[0]; my $re_lws = '(?:(?:\r|\n|\x0d\x0a)?[ \t])+'; - my $re_ew = '(?i:=\?ISO-2022-JP\?B\?)([A-Za-z0-9+/]+=*)\?='; + my $re_ew = '=\?[Ii][Ss][Oo]-2022-[Jj][Pp]\?[Bb]\?([A-Za-z0-9+/]+=*)\?='; $$r_str =~ s/($re_ew)$re_lws(?=$re_ew)/$1/sgo; $$r_str =~ s/$re_lws/ /go; $self->[2] = @@ -352,10 +362,13 @@ sub mime_decode{ $self; } + =head2 Methods implemented by Jcode::H2Z Methods below are actually implemented in Jcode::H2Z. +=over 4 + =item $j->h2z([$keep_dakuten]); Converts X201 kana (Hankaku) to X208 kana (Zenkaku). @@ -365,6 +378,14 @@ being converted to "ga") You can retrieve the number of matches via $j->nmatch; +=item $j->z2h; + +Converts X208 kana (Zenkaku) to X201 kana (Hankazu). + +You can retrieve the number of matches via $j->nmatch; + +=back + =cut sub h2z { @@ -374,13 +395,6 @@ sub h2z { return $self; } -=item $j->z2h; - -Converts X208 kana (Zenkaku) to X201 kana (Hankazu). - -You can retrieve the number of matches via $j->nmatch; - -=cut sub z2h { require Jcode::H2Z; # not use @@ -389,16 +403,21 @@ sub z2h { return $self; } + =head2 Methods implemented in Jcode::Tr Methods here are actually implemented in Jcode::Tr. +=over 4 + =item $j->tr($from, $to); Applies tr on Jcode object. $from and $to can contain EUC Japanese. You can retrieve the number of matches via $j->nmatch; +=back + =cut sub tr{ @@ -416,18 +435,20 @@ use vars qw(%PKG_LOADED); sub load_module{ my $pkg = shift; return $pkg if $PKG_LOADED{$pkg}++; - eval qq( require $pkg; ); - unless ($@){ - carp "$pkg loaded." if $DEBUG; - }else{ - $pkg .= "::NoXS"; + unless ($NOXS){ eval qq( require $pkg; ); unless ($@){ - carp "$pkg loaded" if $DEBUG; - }else{ - croak "Loading $pkg failed!"; + carp "$pkg loaded." if $DEBUG; + return $pkg; } } + $pkg .= "::NoXS"; + eval qq( require $pkg; ); + unless ($@){ + carp "$pkg loaded" if $DEBUG; + }else{ + croak "Loading $pkg failed!"; + } $pkg; } @@ -438,10 +459,18 @@ Jcode::Unicode::NoXS will be used. See L<Jcode::Unicode> and L<Jcode::Unicode::NoXS> for details +=over 4 + =item $ucs2 = $j->ucs2; Returns UCS2 (Raw Unicode) string. +=item $ucs2 = $j->utf8; + +Returns utf8 String. + +=back + =cut sub ucs2{ @@ -449,17 +478,12 @@ sub ucs2{ euc_ucs2(${$_[0]->[0]}); } -=item $ucs2 = $j->utf8; - -Returns utf8 String. - -=cut - sub utf8{ load_module("Jcode::Unicode"); euc_utf8(${$_[0]->[0]}); } + =head2 Instance Variables If you need to access instance variables of Jcode object, use access @@ -470,6 +494,8 @@ FYI, Jcode uses a ref to array instead of ref to hash (common way) to optimize speed (Actually you don't have to know as long as you use access methods instead; Once again, that's OOP) +=over 4 + =item $j->r_str Reference to the EUC-coded String. @@ -482,10 +508,14 @@ Input charcode in recent operation. Number of matches (Used in $j->tr, etc.) +=back + =cut =head1 Subroutines +=over 4 + =item ($code, [$nmatch]) = getcode($str); Returns char code of $str. Return codes are as follows @@ -502,24 +532,34 @@ When array context is used instead of scaler, it also returns how many character codes are found. As mentioned above, $str can be \$str instead. -=item jcode.pl Users: - -This function is 100% upper-conpatible with jcode::getcode() -- well, almost; +B<jcode.pl Users:> This function is 100% upper-conpatible with +jcode::getcode() -- well, almost; * When its return value is an array, the order is the opposite; jcode::getcode() returns $nmatch first. * jcode::getcode() returns 'undef' when the number of EUC characters is equal to that of SJIS. Jcode::getcode() returns EUC. for - Jcode.pm is no in-betweens. + Jcode.pm there is no in-betweens. + +=item Jcode::convert($str, [$ocode, $icode, $opt]); + +Converts $str to char code specified by $ocode. When $icode is specified +also, it assumes $icode for input string instead of the one checked by +getcode(). As mentioned above, $str can be \$str instead. + +B<jcode.pl Users:> This function is 100% upper-conpatible with +jcode::convert() ! + +=back =cut sub getcode { my $thingy = shift; - my $r_str = _mkbuf($thingy); + my $r_str = ref $thingy ? $thingy : \$thingy; + my ($code, $nmatch, $sjis, $euc, $utf8) = ("", 0, 0, 0, 0); - if ($$r_str =~ /$RE{BIN}/o) { # 'binary' my $ucs2; $ucs2 += length($1) @@ -558,21 +598,9 @@ sub getcode { return wantarray ? ($code, $nmatch) : $code; } -=item Jcode::convert($str, [$ocode, $icode, $opt]); - -Converts $str to char code specified by $ocode. When $icode is specified -also, it assumes $icode for input string instead of the one checked by -getcode(). As mentioned above, $str can be \$str instead. - -=item jcode.pl Users: - -This function is 100% upper-conpatible with jcode::convert() ! - -=cut - sub convert{ my $thingy = shift; - my $r_str = _mkbuf($thingy); + my $r_str = ref $thingy ? $thingy : \$thingy; my ($ocode, $icode, $opt) = @_; my $nmatch; @@ -600,7 +628,7 @@ sub convert{ &{'Jcode::H2Z::' . $cmd}($r_str); } } - + # convert to $ocode load_module("Jcode::Unicode") if $ocode =~ /ucs2|utf8/o; @@ -615,7 +643,7 @@ sub convert{ sub jis_euc { my $thingy = shift; - my $r_str = _mkbuf($thingy); + my $r_str = ref $thingy ? $thingy : \$thingy; $$r_str =~ s( ($RE{JIS_0212}|$RE{JIS_0208}|$RE{JIS_ASC}|$RE{JIS_KANA}) ([^\e]*) @@ -637,19 +665,29 @@ sub jis_euc { } # -sub euc_jis { +# euc_jis +# +# Based upon the contribution of +# Kazuto Ichimura <ichimura@shimada.nuee.nagoya-u.ac.jp> +# + +sub euc_jis{ my $thingy = shift; - my $r_str = _mkbuf($thingy); + my $r_str = ref $thingy ? $thingy : \$thingy; $$r_str =~ s{ - (($RE{EUC_C}|$RE{EUC_KANA}|$RE{EUC_0212})+) - } - { - my $str = $1; - my $esc = ($str =~ tr/\x8e//d) ? $ESC{KANA} : - ($str =~ tr/\x8f//d) ? $ESC{JIS_0212} : $ESC{JIS_0208}; - $str =~ tr/\xa1-\xfe/\x21-\x7e/; - $esc . $str . $ESC{ASC} - }geox; + ($RE{EUC_C}+|$RE{EUC_KANA}+|$RE{EUC_0212}+) + }{ + my $str = $1; + my $esc = + ( $str =~ tr/\x8E//d ) ? $ESC{KANA} : + ( $str =~ tr/\x8F//d ) ? $ESC{JIS_0212} : + $ESC{JIS_0208}; + $str =~ tr/\xA1-\xFE/\x21-\x7E/; + $esc . $str . $ESC{ASC}; + }geox; + $$r_str =~ + s/\Q$ESC{ASC}\E + (\Q$ESC{KANA}\E|\Q$ESC{JIS_0212}\E|\Q$ESC{JIS_0208}\E)/$1/gox; $$r_str; } @@ -660,7 +698,7 @@ my %_E2S = (); sub sjis_euc { my $thingy = shift; - my $r_str = _mkbuf($thingy); + my $r_str = ref $thingy ? $thingy : \$thingy; $$r_str =~ s( ($RE{SJIS_C}|$RE{SJIS_KANA}) ) @@ -689,7 +727,7 @@ sub sjis_euc { sub euc_sjis { my $thingy = shift; - my $r_str = _mkbuf($thingy); + my $r_str = ref $thingy ? $thingy : \$thingy; $$r_str =~ s( ($RE{EUC_C}|$RE{EUC_KANA}|$RE{EUC_0212}) ) @@ -718,6 +756,16 @@ sub euc_sjis { } # +# Util. Functions +# + +sub _max { + my $result = shift; + for my $n (@_){ + $result = $n if $n > $result; + } + return $result; +} 1; @@ -725,7 +773,7 @@ __END__ =head1 BUGS -=item Unicode support by Jcode is far from efficient! +Unicode support by Jcode is far from efficient! =head1 ACKNOWLEDGEMENTS @@ -738,12 +786,19 @@ very first stage of development. And folks at Jcode Mailing list <jcode5@ring.gr.jp>. Without them, I couldn't have coded this far. + =head1 SEE ALSO +=over 4 + =item L<Jcode::Unicode> =item L<Jcode::Unicode::NoXS> +=back + +=cut + =head1 COPYRIGHT Copyright 1999 Dan Kogai <dankogai@dan.co.jp> diff --git a/cpan/dist/Jcode/Jcode/Constants.pm b/cpan/dist/Jcode/Jcode/Constants.pm index 7bce2ea0..57a4b88e 100644 --- a/cpan/dist/Jcode/Jcode/Constants.pm +++ b/cpan/dist/Jcode/Jcode/Constants.pm @@ -1,5 +1,5 @@ # -# $Id: Constants.pm,v 1.1 2000/11/15 05:44:53 dankogai Exp $ +# $Id: Constants.pm,v 1.2 2001/05/18 05:14:38 dankogai Exp dankogai $ # package Jcode::Constants; @@ -7,8 +7,8 @@ package Jcode::Constants; use strict; use vars qw($RCSID $VERSION); -$RCSID = q$Id: Constants.pm,v 1.1 2000/11/15 05:44:53 dankogai Exp $; -$VERSION = do { my @r = (q$Revision: 1.1 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +$RCSID = q$Id: Constants.pm,v 1.2 2001/05/18 05:14:38 dankogai Exp dankogai $; +$VERSION = do { my @r = (q$Revision: 1.2 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; use Carp; @@ -17,7 +17,7 @@ BEGIN { use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); @ISA = qw(Exporter); @EXPORT = qw(); - @EXPORT_OK = qw(&_max &_mkbuf %CHARCODE %ESC %RE); + @EXPORT_OK = qw(%CHARCODE %ESC %RE); %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK, @EXPORT ] ); } @@ -59,30 +59,5 @@ my %_0208 = ( UTF8 => '[\xc0-\xdf][\x80-\xbf]|[\xe0-\xef][\x80-\xbf][\x80-\xbf]' ); -# -# Util. Functions -# - -# Make buffer when and only when necessary - -sub _mkbuf { - my $thingy = shift; - if (ref $thingy){ - return $thingy; - } - else{ - my $buf = $thingy; - return \$buf; - } -} - -sub _max { - my $result = shift; - for my $n (@_){ - $result = $n if $n > $result; - } - return $result; -} - 1; diff --git a/cpan/dist/Jcode/Jcode/H2Z.pm b/cpan/dist/Jcode/Jcode/H2Z.pm index 79aa3794..53c81201 100644 --- a/cpan/dist/Jcode/Jcode/H2Z.pm +++ b/cpan/dist/Jcode/Jcode/H2Z.pm @@ -1,5 +1,5 @@ # -# $Id: H2Z.pm,v 0.61 2000/11/15 05:45:25 dankogai Exp $ +# $Id: H2Z.pm,v 0.70 2001/05/15 19:35:59 dankogai Exp $ # package Jcode::H2Z; @@ -7,8 +7,8 @@ package Jcode::H2Z; use strict; use vars qw($RCSID $VERSION); -$RCSID = q$Id: H2Z.pm,v 0.61 2000/11/15 05:45:25 dankogai Exp $; -$VERSION = do { my @r = (q$Revision: 0.61 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +$RCSID = q$Id: H2Z.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; @@ -116,14 +116,14 @@ use vars qw(%_D2Z $_PAT_D2Z # init only once; -$_PAT_D2Z = join("|", keys %_D2Z); -$_PAT_H2Z = join("|", keys %_H2Z); +#$_PAT_D2Z = join("|", keys %_D2Z); +#$_PAT_H2Z = join("|", keys %_H2Z); %_Z2H = reverse %_H2Z; %_Z2D = reverse %_D2Z; -$_PAT_Z2H = join("|", keys %_Z2H); -$_PAT_Z2D = join("|", keys %_Z2D); +#$_PAT_Z2H = join("|", keys %_Z2H); +#$_PAT_Z2D = join("|", keys %_Z2D); sub h2z { my $r_str = shift; @@ -133,7 +133,7 @@ sub h2z { $n = ( $$r_str =~ s( ($RE{EUC_KANA} - (:?\x8e[\xde\xdf])?) + (?:\x8e[\xde\xdf])?) ){ my $str = $1; $_D2Z{$str} || $_H2Z{$str} || @@ -157,7 +157,7 @@ sub z2h { my $r_str = shift; my $n = ( $$r_str =~ s( - ($RE{EUC_C}|$RE{EUC_KANA}) + ($RE{EUC_C}) ){ $_Z2D{$1} || $_Z2H{$1} || $1; }eogx diff --git a/cpan/dist/Jcode/Jcode/Tr.pm b/cpan/dist/Jcode/Jcode/Tr.pm index 4d8ee1ff..e29e29bb 100644 --- a/cpan/dist/Jcode/Jcode/Tr.pm +++ b/cpan/dist/Jcode/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; diff --git a/cpan/dist/Jcode/Jcode/Unicode/Constants.pm b/cpan/dist/Jcode/Jcode/Unicode/Constants.pm index 4538da03..f3769683 100644 --- a/cpan/dist/Jcode/Jcode/Unicode/Constants.pm +++ b/cpan/dist/Jcode/Jcode/Unicode/Constants.pm @@ -1,14 +1,45 @@ # -# $Id: Constants.pm,v 1.1 2000/11/15 05:44:53 dankogai Exp $ +# $Id: Constants.pm,v 1.2 2001/05/18 05:14:38 dankogai Exp dankogai $ # package Jcode::Unicode::Constants; +=head1 NAME + +Jcode::Unicode::Constants -- UCS2-EUC conversion table + +=head1 SYNOPSIS + +NONE + +=head1 DESCRIPTION + +This module just contains a huge hash that converts UCS2 from/to EUC. + +=head1 SEE ALSO + +ftp://ftp.unicode.org/Public/MAPPINGS/EASTASIA/JIS/ + +Unicode mapping data + +=head1 COPYRIGHT + +Copyright 1999 Dan Kogai <dankogai@dan.co.jp> + +This library is free software; you can redistribute it +and/or modify it under the same terms as Perl itself. + +Unicode conversion table here is based on files at +ftp://ftp.unicode.org/Public/MAPPINGS/EASTASIA/JIS/, +Copyright (c) 1991-1994 Unicode, Inc. + +=cut + use strict; use vars qw($RCSID $VERSION); -$RCSID = q$Id: Constants.pm,v 1.1 2000/11/15 05:44:53 dankogai Exp $; -$VERSION = do { my @r = (q$Revision: 1.1 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +$RCSID = q$Id: Constants.pm,v 1.2 2001/05/18 05:14:38 dankogai Exp dankogai $; +$VERSION = do { my @r = (q$Revision: 1.2 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; use Carp; @@ -13041,35 +13072,3 @@ for my $c (0x00..0x7f){ %_E2U = (); 1; - - -=head1 NAME - -Jcode::Unicode::Constants -- UCS2-EUC conversion table - -=head1 SYNOPSIS - -NONE - -=head1 DESCRIPTION - -This module just contains a huge hash that converts UCS2 from/to EUC. - -=head1 SEE ALSO - -=item ftp://ftp.unicode.org/Public/MAPPINGS/EASTASIA/JIS/ - -Unicode mapping data - -=head1 COPYRIGHT - -Copyright 1999 Dan Kogai <dankogai@dan.co.jp> - -This library is free software; you can redistribute it -and/or modify it under the same terms as Perl itself. - -Unicode conversion table here is based on files at -ftp://ftp.unicode.org/Public/MAPPINGS/EASTASIA/JIS/, -Copyright (c) 1991-1994 Unicode, Inc. - -=cut diff --git a/cpan/dist/Jcode/Jcode/Unicode/NoXS.pm b/cpan/dist/Jcode/Jcode/Unicode/NoXS.pm index f0f0b57e..44800ea3 100644 --- a/cpan/dist/Jcode/Jcode/Unicode/NoXS.pm +++ b/cpan/dist/Jcode/Jcode/Unicode/NoXS.pm @@ -1,5 +1,5 @@ # -# $Id: NoXS.pm,v 0.61 2000/11/15 05:45:25 dankogai Exp $ +# $Id: NoXS.pm,v 0.71 2001/05/18 05:14:38 dankogai Exp dankogai $ # package Jcode::Unicode::NoXS; @@ -7,8 +7,8 @@ package Jcode::Unicode::NoXS; use strict; use vars qw($RCSID $VERSION); -$RCSID = q$Id: NoXS.pm,v 0.61 2000/11/15 05:45:25 dankogai Exp $; -$VERSION = do { my @r = (q$Revision: 0.61 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +$RCSID = q$Id: NoXS.pm,v 0.71 2001/05/18 05:14:38 dankogai Exp dankogai $; +$VERSION = do { my @r = (q$Revision: 0.71 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; use Carp; @@ -55,7 +55,7 @@ sub _init_e2u{ sub Jcode::ucs2_euc{ my $thingy = shift; - my $r_str = _mkbuf($thingy); + my $r_str = ref $thingy ? $thingy : \$thingy; _init_u2e(); $$r_str =~ s( @@ -70,13 +70,13 @@ sub Jcode::ucs2_euc{ sub Jcode::euc_ucs2{ my $thingy = shift; - my $r_str = _mkbuf($thingy); + my $r_str = ref $thingy ? $thingy : \$thingy; _init_e2u(); # 3 bytes $$r_str =~ s( ($RE{EUC_0212}|$RE{EUC_C}|$RE{EUC_KANA}|[\x00-\xff]) - ) + ) { exists $_E2U{$1} ? $_E2U{$1} : $CHARCODE{UNDEF_UNICODE}; }geox; @@ -86,21 +86,21 @@ sub Jcode::euc_ucs2{ sub Jcode::euc_utf8{ my $thingy = shift; - my $r_str = _mkbuf($thingy); + my $r_str = ref $thingy ? $thingy : \$thingy; &Jcode::euc_ucs2($r_str); &Jcode::ucs2_utf8($r_str); } sub Jcode::utf8_euc{ my $thingy = shift; - my $r_str = _mkbuf($thingy); + my $r_str = ref $thingy ? $thingy : \$thingy; &Jcode::utf8_ucs2($r_str); &Jcode::ucs2_euc($r_str); } sub Jcode::ucs2_utf8{ my $thingy = shift; - my $r_str = _mkbuf($thingy); + my $r_str = ref $thingy ? $thingy : \$thingy; my $result; for my $uc (unpack("n*", $$r_str)) { if ($uc < 0x80) { @@ -123,7 +123,7 @@ sub Jcode::ucs2_utf8{ sub Jcode::utf8_ucs2{ my $thingy = shift; - my $r_str = _mkbuf($thingy); + my $r_str = ref $thingy ? $thingy : \$thingy; my $result; $$r_str =~ s/^[\200-\277]+//o; # can't start with 10xxxxxx $$r_str =~ @@ -162,6 +162,8 @@ This module is called by Jcode.pm on demand. This module is not intended for direct use by users. This modules implements functions related to Unicode. Following functions are defined here; +=over 4 + =item Jcode::ucs2_euc(); =item Jcode::euc_ucs2(); @@ -174,10 +176,14 @@ Following functions are defined here; =item Jcode::utf8_euc(); +=back + =cut =head1 VARIABLES +=over 4 + =item B<$Jcode::Unicode::PEDANTIC> When set to non-zero, x-to-unicode conversion becomes pedantic. @@ -186,12 +192,18 @@ That is, '\' (chr(0x5c)) is converted to zenkaku backslash and By Default, Jcode::Unicode leaves ascii ([0x00-0x7f]) as it is. +=back + =head1 MODULES +=over 4 + =item Jcode::Unicode::Constants Jumbo hash that contains UCS2-EUC conversion table is there. +=back + =head1 BUGS * It's very slow to initialize, due to the size of the conversion @@ -201,7 +213,7 @@ Jumbo hash that contains UCS2-EUC conversion table is there. =head1 SEE ALSO -=item http://www.unicode.org/ +http://www.unicode.org/ =head1 COPYRIGHT diff --git a/cpan/dist/Jcode/Makefile.PL b/cpan/dist/Jcode/Makefile.PL index 1120cafd..edcb7b4f 100644 --- a/cpan/dist/Jcode/Makefile.PL +++ b/cpan/dist/Jcode/Makefile.PL @@ -1,6 +1,6 @@ #!/usr/local/bin/perl # -# $Id: Makefile.PL,v 0.61 2000/11/15 05:45:25 dankogai Exp $ +# $Id: Makefile.PL,v 0.70 2001/05/15 19:35:59 dankogai Exp $ # use ExtUtils::MakeMaker; diff --git a/cpan/dist/Jcode/README b/cpan/dist/Jcode/README index d3af4746..85723b3d 100644 --- a/cpan/dist/Jcode/README +++ b/cpan/dist/Jcode/README @@ -1,5 +1,5 @@ # -# $Id: README,v 0.61 2000/11/15 05:45:25 dankogai Exp $ +# $Id: README,v 0.70 2001/05/15 19:35:59 dankogai Exp $ # Jcode: diff --git a/cpan/dist/Jcode/Unicode/Unicode.pm b/cpan/dist/Jcode/Unicode/Unicode.pm index 3d84405e..5fd9f408 100644 --- a/cpan/dist/Jcode/Unicode/Unicode.pm +++ b/cpan/dist/Jcode/Unicode/Unicode.pm @@ -1,5 +1,5 @@ # -# $Id: Unicode.pm,v 1.1 2000/11/15 05:44:53 dankogai Exp $ +# $Id: Unicode.pm,v 1.2 2001/05/18 05:14:38 dankogai Exp dankogai $ # package Jcode::Unicode; @@ -7,8 +7,8 @@ package Jcode::Unicode; use strict; use vars qw($RCSID $VERSION @ISA @EXPORT $PEDANTIC); -$RCSID = q$Id: Unicode.pm,v 1.1 2000/11/15 05:44:53 dankogai Exp $; -$VERSION = do { my @r = (q$Revision: 1.1 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +$RCSID = q$Id: Unicode.pm,v 1.2 2001/05/18 05:14:38 dankogai Exp dankogai $; +$VERSION = do { my @r = (q$Revision: 1.2 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; use Carp; require Exporter; @@ -20,43 +20,32 @@ $PEDANTIC ||= 0; bootstrap Jcode::Unicode $VERSION; -sub _mkbuf{ - my $thingy = shift; - if (ref $thingy){ - return $thingy; - } - else{ - my $buf = $thingy; - return \$buf; - } -} - # Merge these subs to Jcode sub Jcode::ucs2_euc{ my ($thingy, $pedantic) = @_; $pedantic ||= 0; - my $r_str = _mkbuf($thingy); + my $r_str = ref $thingy ? $thingy : \$thingy; return $$r_str = Jcode::Unicode::ucs2_euc($$r_str, $pedantic); } sub Jcode::euc_ucs2{ my ($thingy, $pedantic) = @_; $pedantic ||= 0; - my $r_str = _mkbuf($thingy); + my $r_str = ref $thingy ? $thingy : \$thingy; return $$r_str = Jcode::Unicode::euc_ucs2($$r_str, $pedantic); } sub Jcode::ucs2_utf8{ my ($thingy, $pedantic) = @_; - my $r_str = _mkbuf($thingy); + my $r_str = ref $thingy ? $thingy : \$thingy; return $$r_str = Jcode::Unicode::ucs2_utf8($$r_str); } sub Jcode::utf8_ucs2{ my ($thingy) = @_; - my $r_str = _mkbuf($thingy); + my $r_str = ref $thingy ? $thingy : \$thingy; return $$r_str = Jcode::Unicode::utf8_ucs2($$r_str); } @@ -64,14 +53,14 @@ sub Jcode::utf8_ucs2{ sub Jcode::euc_utf8{ my $thingy = shift; - my $r_str = _mkbuf($thingy); + my $r_str = ref $thingy ? $thingy : \$thingy; &Jcode::euc_ucs2($r_str); &Jcode::ucs2_utf8($r_str); } sub Jcode::utf8_euc{ my $thingy = shift; - my $r_str = _mkbuf($thingy); + my $r_str = ref $thingy ? $thingy : \$thingy; &Jcode::utf8_ucs2($r_str); &Jcode::ucs2_euc($r_str); } @@ -95,6 +84,8 @@ This module is called by Jcode.pm on demand. This module is not intended for direct use by users. This modules implements functions related to Unicode. Following functions are defined here; +=over 4 + =item Jcode::ucs2_euc(); =item Jcode::euc_ucs2(); @@ -107,10 +98,14 @@ Following functions are defined here; =item Jcode::utf8_euc(); +=back + =cut =head1 VARIABLES +=over 4 + =item B<$Jcode::Unicode::PEDANTIC> When set to non-zero, x-to-unicode conversion becomes pedantic. @@ -119,6 +114,8 @@ That is, '\' (chr(0x5c)) is converted to zenkaku backslash and By Default, Jcode::Unicode leaves ascii ([0x00-0x7f]) as it is. +=back + =cut =head1 BUGS @@ -127,7 +124,7 @@ If any, that is Unicode, Inc. to Blame (Especially JIS0201.TXT). =head1 SEE ALSO -=item http://www.unicode.org/ +http://www.unicode.org/ =head1 COPYRIGHT diff --git a/cpan/dist/Jcode/Unicode/table.h b/cpan/dist/Jcode/Unicode/table.h index eddf5955..d4c8be77 100644 --- a/cpan/dist/Jcode/Unicode/table.h +++ b/cpan/dist/Jcode/Unicode/table.h @@ -1,5 +1,5 @@ /* - * $Id: table.h,v 1.1 2000/11/15 05:44:53 dankogai Exp $ + * $Id: table.h,v 0.70 2001/05/15 19:35:59 dankogai Exp $ * (c) 1999 Dan Kogai <dankogai@dan.co.jp> */ diff --git a/cpan/dist/Jcode/Unicode/uni.c b/cpan/dist/Jcode/Unicode/uni.c index d099bc18..e2aeb48c 100644 --- a/cpan/dist/Jcode/Unicode/uni.c +++ b/cpan/dist/Jcode/Unicode/uni.c @@ -1,5 +1,5 @@ /* - * $Id: uni.c,v 0.61 2000/11/15 05:45:25 dankogai Exp $ + * $Id: uni.c,v 0.70 2001/05/15 19:35:59 dankogai Exp $ * (c) 1999 Dan Kogai <dankogai@dan.co.jp> */ diff --git a/cpan/dist/Jcode/t/mime.t b/cpan/dist/Jcode/t/mime.t index 236e8985..f00931b3 100644 --- a/cpan/dist/Jcode/t/mime.t +++ b/cpan/dist/Jcode/t/mime.t @@ -31,12 +31,12 @@ my $file; my %mime = ( - "テストtestです" => - "=?ISO-2022-JP?B?GyRCJUYlOSVIGyhCdGVzdBskQiRHJDkbKEI=?=", + "漢字、カタカナ、ひらがな" => + "=?ISO-2022-JP?B?GyRCNEE7eiEiJSslPyUrJUohIiRSJGkkLCRKGyhC?=", "foo bar" => "foo bar", - "01234567890123456789012345678901234567890123456789" => - "=?ISO-2022-JP?B?GyRCIzAjMSMyIzMjNCM1IzYjNyM4IzkjMCMxIzIjMyM0IzUjNiM3GyhC?=\n =?ISO-2022-JP?B?GyRCIzgjOSMwIzEjMiMzIzQjNSM2IzcjOCM5IzAjMSMyIzMjNCM1GyhC?=\n =?ISO-2022-JP?B?GyRCIzYjNyM4IzkjMCMxIzIjMyM0IzUjNiM3IzgjORsoQg==?=", + "漢字、カタカナ、ひらがなの混じったSubject Header." => + "=?ISO-2022-JP?B?GyRCNEE7eiEiJSslPyUrJUohIiRSJGkkLCRKJE46LiQ4JEMkPxsoQlN1?=\n =?ISO-2022-JP?B?YmplY3Q=?= Header.", ); for my $k (keys %mime){ @@ -45,12 +45,17 @@ for my $k (keys %mime){ for my $decoded (sort keys %mime){ my ($ok, $out); + my $encoded = $mime{$decoded}; my $encoded_i = $encoded; $encoded_i =~ s/^(=\?ISO-2022-JP\?B\?)/lc($1)/eo; + my $t_encoded = jcode($decoded)->mime_encode; my $t_decoded = jcode($encoded)->mime_decode; my $t_decoded_i = jcode($encoded_i)->mime_decode; + my $decoded_h = jcode($decoded)->h2z->euc; + my $t_encoded_h = jcode($decoded_h)->mime_encode; + if ($t_decoded eq $decoded){ $ok = "ok"; }else{ @@ -66,7 +71,7 @@ EOF if ($t_decoded_i eq $decoded){ $ok = "ok"; - print $encoded_i, "\n"; + #print $encoded_i, "\n"; }else{ $ok = "not ok"; print <<"EOF"; @@ -88,6 +93,19 @@ EOF } profile(sprintf("MIME encode: %s -> %s %s %d\n", $decoded, $encoded, $ok, ++$n )); + + if ($t_encoded_h eq $encoded){ + $ok = "ok"; + }else{ + $ok = "not ok"; + print <<"EOF"; +E>$decoded_h< +E>$t_encoded_h< +EOF + } + profile(sprintf("MIME encode: %s -> %s %s %d\n", + $decoded_h, $t_encoded_h, $ok, ++$n )); + } diff --git a/cpan/dist/Jcode/t/unibench.pl b/cpan/dist/Jcode/t/unibench.pl index 6a7e084c..d9ac7a42 100644 --- a/cpan/dist/Jcode/t/unibench.pl +++ b/cpan/dist/Jcode/t/unibench.pl @@ -2,16 +2,16 @@ use ExtUtils::testlib; use Benchmark; +use strict; +use lib qw(.); $| = 1; - -print "Jcode Loading...\n"; require Jcode; $Jcode::DEBUG = 1; +$Jcode::NOXS = $ARGV[0]; print "done.\n"; - -$file = "t/table.euc"; +my $file = "t/table.euc"; open F, $file or die "$file:$!"; my $euc; read F, $euc, -s $file; @@ -19,16 +19,14 @@ read F, $euc, -s $file; my $ucs2 = Jcode->new($euc)->ucs2; my $utf8 = Jcode->new($euc)->utf8; -my $count = $ARGV[0] || 16; +my $count = $ARGV[1] || 16; timethese($count, { "utf8->ucs2" => \&utf8_ucs2, "ucs2->utf8" => \&ucs2_utf8, - "euc->ucs2" => \&euc_ucs2, - "ucs2->euc" => \&ucs2_euc, - } - ); - + "ucs2->euc" => \&ucs2_euc, + "ucs2->utf8" => \&ucs2_utf8, +}); sub utf8_ucs2{ &Jcode::utf8_ucs2($utf8); @@ -45,3 +43,4 @@ sub euc_ucs2{ sub ucs2_euc{ &Jcode::ucs2_euc($ucs2); } + diff --git a/cpan/lib/Jcode/Constants.pm b/cpan/lib/Jcode/Constants.pm index 7bce2ea0..57a4b88e 100644 --- a/cpan/lib/Jcode/Constants.pm +++ b/cpan/lib/Jcode/Constants.pm @@ -1,5 +1,5 @@ # -# $Id: Constants.pm,v 1.1 2000/11/15 05:44:53 dankogai Exp $ +# $Id: Constants.pm,v 1.2 2001/05/18 05:14:38 dankogai Exp dankogai $ # package Jcode::Constants; @@ -7,8 +7,8 @@ package Jcode::Constants; use strict; use vars qw($RCSID $VERSION); -$RCSID = q$Id: Constants.pm,v 1.1 2000/11/15 05:44:53 dankogai Exp $; -$VERSION = do { my @r = (q$Revision: 1.1 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +$RCSID = q$Id: Constants.pm,v 1.2 2001/05/18 05:14:38 dankogai Exp dankogai $; +$VERSION = do { my @r = (q$Revision: 1.2 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; use Carp; @@ -17,7 +17,7 @@ BEGIN { use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); @ISA = qw(Exporter); @EXPORT = qw(); - @EXPORT_OK = qw(&_max &_mkbuf %CHARCODE %ESC %RE); + @EXPORT_OK = qw(%CHARCODE %ESC %RE); %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK, @EXPORT ] ); } @@ -59,30 +59,5 @@ my %_0208 = ( UTF8 => '[\xc0-\xdf][\x80-\xbf]|[\xe0-\xef][\x80-\xbf][\x80-\xbf]' ); -# -# Util. Functions -# - -# Make buffer when and only when necessary - -sub _mkbuf { - my $thingy = shift; - if (ref $thingy){ - return $thingy; - } - else{ - my $buf = $thingy; - return \$buf; - } -} - -sub _max { - my $result = shift; - for my $n (@_){ - $result = $n if $n > $result; - } - return $result; -} - 1; diff --git a/cpan/lib/Jcode/H2Z.pm b/cpan/lib/Jcode/H2Z.pm index 79aa3794..53c81201 100644 --- a/cpan/lib/Jcode/H2Z.pm +++ b/cpan/lib/Jcode/H2Z.pm @@ -1,5 +1,5 @@ # -# $Id: H2Z.pm,v 0.61 2000/11/15 05:45:25 dankogai Exp $ +# $Id: H2Z.pm,v 0.70 2001/05/15 19:35:59 dankogai Exp $ # package Jcode::H2Z; @@ -7,8 +7,8 @@ package Jcode::H2Z; use strict; use vars qw($RCSID $VERSION); -$RCSID = q$Id: H2Z.pm,v 0.61 2000/11/15 05:45:25 dankogai Exp $; -$VERSION = do { my @r = (q$Revision: 0.61 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +$RCSID = q$Id: H2Z.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; @@ -116,14 +116,14 @@ use vars qw(%_D2Z $_PAT_D2Z # init only once; -$_PAT_D2Z = join("|", keys %_D2Z); -$_PAT_H2Z = join("|", keys %_H2Z); +#$_PAT_D2Z = join("|", keys %_D2Z); +#$_PAT_H2Z = join("|", keys %_H2Z); %_Z2H = reverse %_H2Z; %_Z2D = reverse %_D2Z; -$_PAT_Z2H = join("|", keys %_Z2H); -$_PAT_Z2D = join("|", keys %_Z2D); +#$_PAT_Z2H = join("|", keys %_Z2H); +#$_PAT_Z2D = join("|", keys %_Z2D); sub h2z { my $r_str = shift; @@ -133,7 +133,7 @@ sub h2z { $n = ( $$r_str =~ s( ($RE{EUC_KANA} - (:?\x8e[\xde\xdf])?) + (?:\x8e[\xde\xdf])?) ){ my $str = $1; $_D2Z{$str} || $_H2Z{$str} || @@ -157,7 +157,7 @@ sub z2h { my $r_str = shift; my $n = ( $$r_str =~ s( - ($RE{EUC_C}|$RE{EUC_KANA}) + ($RE{EUC_C}) ){ $_Z2D{$1} || $_Z2H{$1} || $1; }eogx 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; diff --git a/cpan/lib/Jcode/Unicode/Constants.pm b/cpan/lib/Jcode/Unicode/Constants.pm index 4538da03..f3769683 100644 --- a/cpan/lib/Jcode/Unicode/Constants.pm +++ b/cpan/lib/Jcode/Unicode/Constants.pm @@ -1,14 +1,45 @@ # -# $Id: Constants.pm,v 1.1 2000/11/15 05:44:53 dankogai Exp $ +# $Id: Constants.pm,v 1.2 2001/05/18 05:14:38 dankogai Exp dankogai $ # package Jcode::Unicode::Constants; +=head1 NAME + +Jcode::Unicode::Constants -- UCS2-EUC conversion table + +=head1 SYNOPSIS + +NONE + +=head1 DESCRIPTION + +This module just contains a huge hash that converts UCS2 from/to EUC. + +=head1 SEE ALSO + +ftp://ftp.unicode.org/Public/MAPPINGS/EASTASIA/JIS/ + +Unicode mapping data + +=head1 COPYRIGHT + +Copyright 1999 Dan Kogai <dankogai@dan.co.jp> + +This library is free software; you can redistribute it +and/or modify it under the same terms as Perl itself. + +Unicode conversion table here is based on files at +ftp://ftp.unicode.org/Public/MAPPINGS/EASTASIA/JIS/, +Copyright (c) 1991-1994 Unicode, Inc. + +=cut + use strict; use vars qw($RCSID $VERSION); -$RCSID = q$Id: Constants.pm,v 1.1 2000/11/15 05:44:53 dankogai Exp $; -$VERSION = do { my @r = (q$Revision: 1.1 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +$RCSID = q$Id: Constants.pm,v 1.2 2001/05/18 05:14:38 dankogai Exp dankogai $; +$VERSION = do { my @r = (q$Revision: 1.2 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; use Carp; @@ -13041,35 +13072,3 @@ for my $c (0x00..0x7f){ %_E2U = (); 1; - - -=head1 NAME - -Jcode::Unicode::Constants -- UCS2-EUC conversion table - -=head1 SYNOPSIS - -NONE - -=head1 DESCRIPTION - -This module just contains a huge hash that converts UCS2 from/to EUC. - -=head1 SEE ALSO - -=item ftp://ftp.unicode.org/Public/MAPPINGS/EASTASIA/JIS/ - -Unicode mapping data - -=head1 COPYRIGHT - -Copyright 1999 Dan Kogai <dankogai@dan.co.jp> - -This library is free software; you can redistribute it -and/or modify it under the same terms as Perl itself. - -Unicode conversion table here is based on files at -ftp://ftp.unicode.org/Public/MAPPINGS/EASTASIA/JIS/, -Copyright (c) 1991-1994 Unicode, Inc. - -=cut diff --git a/cpan/lib/Jcode/Unicode/NoXS.pm b/cpan/lib/Jcode/Unicode/NoXS.pm index f0f0b57e..44800ea3 100644 --- a/cpan/lib/Jcode/Unicode/NoXS.pm +++ b/cpan/lib/Jcode/Unicode/NoXS.pm @@ -1,5 +1,5 @@ # -# $Id: NoXS.pm,v 0.61 2000/11/15 05:45:25 dankogai Exp $ +# $Id: NoXS.pm,v 0.71 2001/05/18 05:14:38 dankogai Exp dankogai $ # package Jcode::Unicode::NoXS; @@ -7,8 +7,8 @@ package Jcode::Unicode::NoXS; use strict; use vars qw($RCSID $VERSION); -$RCSID = q$Id: NoXS.pm,v 0.61 2000/11/15 05:45:25 dankogai Exp $; -$VERSION = do { my @r = (q$Revision: 0.61 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +$RCSID = q$Id: NoXS.pm,v 0.71 2001/05/18 05:14:38 dankogai Exp dankogai $; +$VERSION = do { my @r = (q$Revision: 0.71 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; use Carp; @@ -55,7 +55,7 @@ sub _init_e2u{ sub Jcode::ucs2_euc{ my $thingy = shift; - my $r_str = _mkbuf($thingy); + my $r_str = ref $thingy ? $thingy : \$thingy; _init_u2e(); $$r_str =~ s( @@ -70,13 +70,13 @@ sub Jcode::ucs2_euc{ sub Jcode::euc_ucs2{ my $thingy = shift; - my $r_str = _mkbuf($thingy); + my $r_str = ref $thingy ? $thingy : \$thingy; _init_e2u(); # 3 bytes $$r_str =~ s( ($RE{EUC_0212}|$RE{EUC_C}|$RE{EUC_KANA}|[\x00-\xff]) - ) + ) { exists $_E2U{$1} ? $_E2U{$1} : $CHARCODE{UNDEF_UNICODE}; }geox; @@ -86,21 +86,21 @@ sub Jcode::euc_ucs2{ sub Jcode::euc_utf8{ my $thingy = shift; - my $r_str = _mkbuf($thingy); + my $r_str = ref $thingy ? $thingy : \$thingy; &Jcode::euc_ucs2($r_str); &Jcode::ucs2_utf8($r_str); } sub Jcode::utf8_euc{ my $thingy = shift; - my $r_str = _mkbuf($thingy); + my $r_str = ref $thingy ? $thingy : \$thingy; &Jcode::utf8_ucs2($r_str); &Jcode::ucs2_euc($r_str); } sub Jcode::ucs2_utf8{ my $thingy = shift; - my $r_str = _mkbuf($thingy); + my $r_str = ref $thingy ? $thingy : \$thingy; my $result; for my $uc (unpack("n*", $$r_str)) { if ($uc < 0x80) { @@ -123,7 +123,7 @@ sub Jcode::ucs2_utf8{ sub Jcode::utf8_ucs2{ my $thingy = shift; - my $r_str = _mkbuf($thingy); + my $r_str = ref $thingy ? $thingy : \$thingy; my $result; $$r_str =~ s/^[\200-\277]+//o; # can't start with 10xxxxxx $$r_str =~ @@ -162,6 +162,8 @@ This module is called by Jcode.pm on demand. This module is not intended for direct use by users. This modules implements functions related to Unicode. Following functions are defined here; +=over 4 + =item Jcode::ucs2_euc(); =item Jcode::euc_ucs2(); @@ -174,10 +176,14 @@ Following functions are defined here; =item Jcode::utf8_euc(); +=back + =cut =head1 VARIABLES +=over 4 + =item B<$Jcode::Unicode::PEDANTIC> When set to non-zero, x-to-unicode conversion becomes pedantic. @@ -186,12 +192,18 @@ That is, '\' (chr(0x5c)) is converted to zenkaku backslash and By Default, Jcode::Unicode leaves ascii ([0x00-0x7f]) as it is. +=back + =head1 MODULES +=over 4 + =item Jcode::Unicode::Constants Jumbo hash that contains UCS2-EUC conversion table is there. +=back + =head1 BUGS * It's very slow to initialize, due to the size of the conversion @@ -201,7 +213,7 @@ Jumbo hash that contains UCS2-EUC conversion table is there. =head1 SEE ALSO -=item http://www.unicode.org/ +http://www.unicode.org/ =head1 COPYRIGHT |
