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;