[Summary view] [Print] [Text view]

   1  # $File: //member/autrijus/Encode-compat/lib/Encode/compat/common.pm $ $Author: autrijus $
   2  # $Revision: #6 $ $Change: 2534 $ $DateTime: 2002/12/02 00:33:16 $
   3  
   4  package Encode::compat::common;
   5  our $VERSION = '0.05';
   6  
   7  1;
   8  
   9  package Encode;
  10  
  11  use strict;
  12  our $VERSION = '0.05';
  13  
  14  our @EXPORT = qw(
  15    decode  decode_utf8  encode  encode_utf8
  16    encodings  find_encoding
  17  );
  18  
  19  use constant DIE_ON_ERR        => 1;
  20  use constant WARN_ON_ERR    => 2;
  21  use constant RETURN_ON_ERR    => 4;
  22  use constant LEAVE_SRC        => 8;
  23  
  24  use constant PERLQQ        => 256;
  25  use constant HTMLCREF        => 512;
  26  use constant XMLCREF        => 1024;
  27  
  28  use constant FB_DEFAULT        => 0;
  29  use constant FB_CROAK        => 1;
  30  use constant FB_QUIET        => 4;
  31  use constant FB_WARN        => 6;
  32  use constant FB_PERLQQ        => 256;
  33  use constant FB_HTMLCREF    => 512;
  34  use constant FB_XMLCREF        => 1024;
  35  
  36  our @FB_FLAGS  = qw(DIE_ON_ERR WARN_ON_ERR RETURN_ON_ERR LEAVE_SRC
  37                      PERLQQ HTMLCREF XMLCREF);
  38  our @FB_CONSTS = qw(FB_DEFAULT FB_CROAK FB_QUIET FB_WARN
  39                      FB_PERLQQ FB_HTMLCREF FB_XMLCREF);
  40  
  41  our @EXPORT_OK =
  42      (
  43       qw(
  44         _utf8_off _utf8_on define_encoding from_to is_16bit is_8bit
  45         is_utf8 perlio_ok resolve_alias utf8_downgrade utf8_upgrade
  46        ),
  47       @FB_FLAGS, @FB_CONSTS,
  48      );
  49  
  50  our %EXPORT_TAGS =
  51      (
  52       all          =>  [ @EXPORT, @EXPORT_OK ],
  53       fallbacks    =>  [ @FB_CONSTS ],
  54       fallback_all =>  [ @FB_CONSTS, @FB_FLAGS ],
  55      );
  56  
  57  sub from_to ($$$;$) {
  58      use utf8;
  59  
  60      # XXX: bad hack
  61      if ($_[3] and $_[3] == FB_HTMLCREF() and lc($_[2]) eq 'latin1') {
  62      $_[0] = join('', map {
  63          ord($_) < 128
  64          ? $_ : '&#' . ord($_) . ';'
  65      } split(//, decode($_[1], $_[0])));
  66      }
  67      else {
  68      $_[0] = _convert(@_[0..2]);
  69      }
  70  }
  71  
  72  sub encodings {
  73      # XXX: revisit
  74      require Encode::Alias;
  75      return sort values %Encode::Alias::Alias;
  76  }
  77  
  78  sub find_encoding {
  79      return $_[0];
  80  }
  81  
  82  sub decode_utf8($;$) {
  83      return decode("utf8", @_);
  84  }
  85  
  86  sub encode_utf8($;$) {
  87      return encode("utf8", @_);
  88  }
  89  
  90  sub decode($$;$) {
  91      my $result = _convert($_[1], $_[0] => 'utf-8'); 
  92      _utf8_on($result);
  93      return $result;
  94  }
  95  
  96  sub encode($$;$) {
  97      return _convert($_[1], 'utf-8' => $_[0]);
  98  }
  99  
 100  {
 101      my %decoder;
 102      sub _convert {
 103      require Text::Iconv;
 104      Text::Iconv->raise_error(1);
 105  
 106      require Encode::Alias;
 107      my ($from, $to) = map {
 108          s/^utf8$/utf-8/;
 109          s/^big5-eten$/big5/;
 110          $_;
 111      } map {
 112          Encode::Alias->find_alias($_) || lc($_)
 113      } ($_[1], $_[2]);
 114  
 115      my $result = ($from eq $to) ? $_[0] : (
 116          $decoder{$from, $to} ||= Text::Iconv->new( $from, $to )
 117      )->convert($_[0]);
 118  
 119      return $result;
 120      }
 121  }
 122  
 123  1;