| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | # $File: //member/autrijus/Encode-HanDetect/HanDetect.pm $ $Author: autrijus $ | 
| 2 |  |  |  |  |  |  | # $Revision: #1 $ $Change: 4051 $ $DateTime: 2003/01/30 22:34:14 $ | 
| 3 |  |  |  |  |  |  |  | 
| 4 | 1 |  |  | 1 |  | 75187 | use 5.008; | 
|  | 1 |  |  |  |  | 5 |  | 
|  | 1 |  |  |  |  | 72 |  | 
| 5 |  |  |  |  |  |  | package Encode::HanDetect; | 
| 6 |  |  |  |  |  |  | $Encode::HanDetect::VERSION = '0.01'; | 
| 7 |  |  |  |  |  |  |  | 
| 8 | 1 |  |  | 1 |  | 7 | use strict; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 39 |  | 
| 9 | 1 |  |  | 1 |  | 178 | use base qw(Encode::Encoding); | 
|  | 1 |  |  |  |  | 3 |  | 
|  | 1 |  |  |  |  | 500 |  | 
| 10 | 1 |  |  | 1 |  | 8 | use Encode qw(find_encoding); | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 133 |  | 
| 11 | 1 |  |  | 1 |  | 9650 | use Lingua::ZH::HanDetect qw(han_detect); | 
|  | 1 |  |  |  |  | 19482 |  | 
|  | 1 |  |  |  |  | 756 |  | 
| 12 |  |  |  |  |  |  |  | 
| 13 |  |  |  |  |  |  | __PACKAGE__->Define('HanDetect'); | 
| 14 |  |  |  |  |  |  |  | 
| 15 | 0 |  |  | 0 | 1 | 0 | sub needs_lines { 1 } | 
| 16 | 0 |  |  | 0 | 1 | 0 | sub perlio_ok { 0 } | 
| 17 |  |  |  |  |  |  |  | 
| 18 |  |  |  |  |  |  | my $Variant = ''; | 
| 19 |  |  |  |  |  |  |  | 
| 20 |  |  |  |  |  |  | sub import { | 
| 21 | 2 |  |  | 2 |  | 1617 | my $class = shift; | 
| 22 | 2 | 100 |  |  |  | 21 | if ($_[0]) { | 
| 23 | 1 | 50 |  |  |  | 8 | die "Unknown variant: $_[0]" unless $_[0] =~ /^[st]/i; | 
| 24 | 1 |  |  |  |  | 6 | $Variant = lc(substr($_[0], 0, 1)); | 
| 25 |  |  |  |  |  |  | } | 
| 26 |  |  |  |  |  |  | } | 
| 27 |  |  |  |  |  |  |  | 
| 28 |  |  |  |  |  |  | sub decode($$;$){ | 
| 29 | 2 |  |  | 2 | 1 | 1779 | my ($obj, $octet, $chk) = @_; | 
| 30 | 2 |  |  |  |  | 12 | my ($encoding, $variant) = han_detect($octet); | 
| 31 | 2 |  |  |  |  | 3685 | my $guessed = find_encoding($encoding); | 
| 32 |  |  |  |  |  |  |  | 
| 33 | 2 | 50 |  |  |  | 158548 | unless (ref($guessed)){ | 
| 34 | 0 |  |  |  |  | 0 | require Encode::Guess; | 
| 35 | 0 |  |  |  |  | 0 | $guessed = find_encoding('Guess'); | 
| 36 |  |  |  |  |  |  | } | 
| 37 |  |  |  |  |  |  |  | 
| 38 | 2 |  | 50 |  |  | 100 | my $utf8 = $guessed->decode($octet, $chk || 0); | 
| 39 | 2 | 100 | 66 |  |  | 18 | if ($Variant and substr($variant, 0, 1) ne $Variant) { | 
| 40 | 1 |  |  |  |  | 3621 | require Encode::HanConvert; | 
| 41 | 1 | 50 |  |  |  | 44321 | if ($Variant eq 's') { | 
| 42 | 0 |  |  |  |  | 0 | $utf8 = Encode::HanConvert::trad_to_simp($utf8); | 
| 43 |  |  |  |  |  |  | } | 
| 44 |  |  |  |  |  |  | else { | 
| 45 | 1 |  |  |  |  | 7 | $utf8 = Encode::HanConvert::simp_to_trad($utf8); | 
| 46 |  |  |  |  |  |  | } | 
| 47 |  |  |  |  |  |  | } | 
| 48 | 2 | 50 |  |  |  | 1741 | $_[1] = $octet if $chk; | 
| 49 | 2 |  |  |  |  | 11 | return $utf8; | 
| 50 |  |  |  |  |  |  | } | 
| 51 |  |  |  |  |  |  |  | 
| 52 |  |  |  |  |  |  | 1; | 
| 53 |  |  |  |  |  |  |  | 
| 54 |  |  |  |  |  |  | __END__ |