package cyrreencode;
use File::Copy;
use CGI::Carp qw(carpout);
use strict;

=head2 Usage:

    use cyrreencode;
    print  'cyrreencode'->from_to ("koi",'dos','Some text in CP866 encoding');

=head2 OOP usage:

    use cyrreencode;
    my $kd=cyrreencode->reencode("koi",'dos');
    $kd->print( "'Ну и что? \n");   

=head2 Functions

    from_to (FROM_ENC, TO_ENC, STRING);

=head2 Supported table names:

    koi dos mac win iso 
    lat - only 'to'
    
=head2 Supported methods:

    in, out                     
                    (set or get input/output encoding name)
    code (@LIST)      
                    (returns List with all strings in  @LIST reencoded)
    Kod_in                  
                    (set input encoding from the russian word 'Kod').   
    print, sprintf, printf          
                    (with usual sintax)
    print_from, sprintf_from, 
    printf_from                     
                    (the same with arg0 input table name)
    print_Kod, sprintf_Kod, 
    printf_Kod                     
                    (the same with arg0 the russian word 'Kod' in 
                        the input encoding)
    
    

=cut
#use Exporter();
#use vars       qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
#$VERSION     = 1.00;
#@ISA         = qw(Exporter);
#@EXPORT      = qw(&rus);
#%EXPORT_TAGS = ( );
#use vars      @EXPORT_OK;
#@EXPORT_OK   = qw($in $out);

my  %chars=('iso'=> "\x80-\xFF",
    'win'=> "\x95\x85\x99\x82\x87\x88\x89\x8B\xA0\x9B\xA6\xB7\x98\xB0\xAD\xA4".
            "\xA9\xAC\xAE\xB1\xB5\xB6\xA5\xB4\x96\x97\x91\x92\x93\x94\x84\x86".
            "\xAB\xA8\x80\x81\xAA\xBD\xB2\xAF\xA3\x8A\x8C\x8E\x8D\xBB\xA1\x8F".
            "\xC0-\xFF".
            "\xB9\xB8\x90\x83\xBA\xBE\xB3\xBF\xBC\x9A\x9C\x9E\x9D\xA7\xA2\x9F",
    'dos'=> "\xC9\xB0\xCB\xDA\xCA\xCE\xDF\xB9\xFF\xCC\xB1\xB2\xFE\xF8\xFB\xFD".
            "\xDC\xB3\xC5\xBF\xCD\xBA\xC3\xB4\xC2\xC1\xC0\xD9\xBC\xC8\xBB\xC4".
            "\xB7\xF0\xD5\xDE\xF2\xB8\xDD\xF4\xD4\xD3\xBE\xBD\xF9\xD6\xF6\xC6".
            "\x80-\xAF\xE0-\xEF".
            "\xFC\xF1\xC7\xB5\xF3\xB6\xD1\xF5\xD2\xCF\xD0\xD8\xD7\xFA\xF7\xDB",
    'koi'=> "\xA5\x90\xB8\x82\xBB\xBE\x8B\xB5\x9A\xB1\x91\x92\x94\x9C\x96\x8C".
            "\xBF\x81\x8A\x83\xA0\xA1\x86\x87\x88\x89\x84\x85\xAE\xAB\xA8\x80".
            "\xA7\xB3\xA2\x8F\x99\xA6\x8E\x93\xA9\xAA\xAC\xAD\x95\xA4\x9F\xAF".
            "\xE1\xE2\xF7\xE7\xE4\xE5\xF6\xFA\xE9\xEA\xEB\xEC\xED\xEE\xEF\xF0".
            "\xF2\xF3\xF4\xF5\xE6\xE8\xE3\xFE\xFB\xFD\xFF\xF9\xF8\xFC\xE0\xF1".
            "\xC1\xC2\xD7\xC7\xC4\xC5\xD6\xDA\xC9\xCA\xCB\xCC\xCD\xCE\xCF\xD0".
            "\xD2\xD3\xD4\xD5\xC6\xC8\xC3\xDE\xDB\xDD\xDF\xD9\xD8\xDC\xC0\xD1".
            "\x9D\xA3\xB0\xB2\x98\xB4\xB6\x9B\xB7\xB9\xBA\xBC\xBD\x9E\x97\x8D",
    'mac'=> "\xA5\xC9\xAA\xA3\xAD\xB0\xC6\xB2\xCA\xB3\xD6\xC4\xC5\xA1\xC3\xFF".
            "\xA9\xC2\xA8\xB1\xB5\xA6\xA2\xB6\xD0\xD1\xD4\xD5\xD2\xD3\xD7\xA0".
            "\xC7\xDD\xAB\xAE\xB8\xC1\xA7\xBA\xB7\xBC\xBE\xCB\xCD\xC8\xD8\xDA".
            "\x80-\x9F\xE0-\xDF".
            "\xDC\xDE\xAC\xAF\xB9\xCF\xB4\xBB\xC0\xBD\xBF\xCC\xCE\xA4\xD9\xDB");
my  %charset_cod=(
        &from_to('','koi','iso','Код') => 'iso', 
        &from_to('','koi','win','Код') => 'win',
        &from_to('','koi','dos','Код') => 'dos',
        'Код'                       => 'koi', 
        &from_to('','koi','mac','Код') => 'mac', 
        'Kod'                       => 'lat');

sub from_to{my $c=shift; local $_; $_=$_[2];
    if($_[0].$_[1] eq 'latlat'){return $_[2]}
    elsif($_[1] eq 'lat'){eval "tr/$chars{$_[0]}/$chars{'win'}/";
            s/\xC6/ZH/g;     s/\xE6/zh/g;
            s/\xA8/YO/g;     s/\xB8/yo/g;
            s/\xD5/KH/g;     s/\xF5/kh/g;
            s/\xD6/TS/g;     s/\xF6/ts/g;
            s/\xD7/CH/g;     s/\xF7/ch/g;
            s/\xD8/SH/g;     s/\xF8/sh/g;
            s/\xD9/SHCH/g;   s/\xF9/shch/g;
            s/\xDD/'E/g;     s/\xFD/'e/g;
            s/\xDE/YU/g;     s/\xFE/yu/g;
            s/\xDF/YA/g;     s/\xFF/ya/g;
        tr/\xC0-\xFC/ABVGDEWZIJKLMNOPRSTUFHCCSS"Y'EUAabvgdewzijklmnoprstufhccss"y''/}
    elsif($_[0] eq 'lat'){
            s/SHCH/\xD9/g;   s/shch/\xF9/g;  s/Shch/\xD9/g;
            s/ZH/\xC6/g;     s/zh/\xE6/g;    s/Zh/\xC6/g;
            s/YO/\xA8/g;     s/yo/\xB8/g;    s/Yo/\xA8/g;
            s/KH/\xD5/g;     s/kh/\xF5/g;    s/Kh/\xD5/g;
            s/TS/\xD6/g;     s/ts/\xF6/g;    s/Ts/\xD6/g;
            s/CH/\xD7/g;     s/ch/\xF7/g;    s/Ch/\xD7/g;
            s/SH/\xD8/g;     s/sh/\xF8/g;    s/Sh/\xD8/g;

            s/YU/\xDE/g;     s/yu/\xFE/g;    s/Yu/\xDE/g;
            s/YA/\xDF/g;     s/ya/\xFF/g;    s/Ya/\xDF/g;
            s/'E/\xDD/g;     s/'e/\xFD/g;
    tr/ABVGDEWZIJKLMNOPRSTUFHCCSS"Y'EUAabvgdewzijklmnoprstufhccss"y''/\xC0-\xFC/;
    eval "tr/$chars{'win'}/$chars{$_[1]}/";}
    else{eval "tr/$chars{$_[0]}/$chars{$_[1]}/"} 
    return $_}

sub reencode {
    my $this = shift;
    my $class = ref($this) || $this;
    my $self={};
    my $in=shift; $self->{in}=$in if $in;
    my $out=shift; $self->{out}=$out if $out;
    bless $self , $class;
    }

sub Kod_in {
   my $self = shift;
   if (@_) { $self->{in} = $charset_cod{$_[0]} }
   return $self->{in}}
   
sub in {
   my $self = shift;
   if (@_) { $self->{in} = shift }
   return $self->{in}}

sub debug {
   my $self = shift;
   if (@_) { $self->{debug} = shift }
   return $self->{debug}}

sub out {
   my $self = shift;
   if (@_) { $self->{out} = shift }
   return $self->{out}}

sub from{local $_;
    my $this = shift; my $from = shift;
    return "" unless @_;    
    return map {&from_to($this,$charset_cod{$from},$this->{out}, $_)} @_}
sub print_from {return print &code_from(@_)}
sub sprintf_from {my @r=&code_from(@_); return sprintf shift(@r),@r}
sub printf_from { my @r=&code_from(@_); return  printf shift(@r),@r}    
sub from_Kod{&from(shift(@_),$charset_cod{shift(@_)},@_)}
sub print_Kod {return print &from_Kod(@_)}
sub sprintf_Kod {my @r=&from_Kod(@_); return sprintf shift(@r),@r}
sub printf_Kod { my @r=&from_Kod(@_); return  printf shift(@r),@r}  
sub code {my $this=shift; &code_from($this,$this->{in},@_)}
sub print {return print &code(@_)}
sub sprintf {my @r=&code(@_); return sprintf shift(@r),@r}
sub printf { my @r=&code(@_); return  printf shift(@r),@r}  


1;
