[p5sagit/p5-mst-13.2.git] / ext / Encode / lib / Encode / Alias.pm

package Encode::Alias;
use strict;
use Encode;
our $VERSION = do { my @r = (q$Revision: 1.28 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
our $DEBUG = 0;
require Exporter;

our @ISA = qw(Exporter);

# Public, encouraged API is exported by default

our @EXPORT = 
    qw (
	define_alias
	find_alias
	);

our @Alias;  # ordered matching list
our %Alias;  # cached known aliases

sub find_alias
{
    my $class = shift;
    local $_ = shift;
    unless (exists $Alias{$_})
    {
        $Alias{$_} = undef; # Recursion guard
	for (my $i=0; $i < @Alias; $i += 2)
	{
	    my $alias = $Alias[$i];
	    my $val   = $Alias[$i+1];
	    my $new;
	    if (ref($alias) eq 'Regexp' && $_ =~ $alias)
	    {
		$DEBUG and warn "eval $val";
		$new = eval $val;
		# $@ and warn "$val, $@";
	    }
	    elsif (ref($alias) eq 'CODE')
	    {
		$DEBUG and warn "$alias", "->", "($val)";
		$new = $alias->($val);
	    }
	    elsif (lc($_) eq lc($alias))
	    {
		$new = $val;
	    }
	    if (defined($new))
	    {
		next if $new eq $_; # avoid (direct) recursion on bugs
		$DEBUG and warn "$alias, $new";
		my $enc = (ref($new)) ? $new : Encode::find_encoding($new);
		if ($enc)
		{
		    $Alias{$_} = $enc;
		    last;
		}
	    }
	}
    }
    if ($DEBUG){
	my $name;
	if (my $e = $Alias{$_}){
	    $name = $e->name;
	}else{
	    $name = "";
	}
	warn "find_alias($class, $_)->name = $name";
    }
    return $Alias{$_};
}

sub define_alias
{
    while (@_)
    {
	my ($alias,$name) = splice(@_,0,2);
	unshift(@Alias, $alias => $name);   # newer one has precedence
	# clear %Alias cache to allow overrides
	if (ref($alias)){
	    my @a = keys %Alias;
	    for my $k (@a){
		if (ref($alias) eq 'Regexp' && $k =~ $alias)
		{
		    $DEBUG and warn "delete \$Alias\{$k\}";
		    delete $Alias{$k};
		}
		elsif (ref($alias) eq 'CODE')
		{
		    $DEBUG and warn "delete \$Alias\{$k\}";
		    delete $Alias{$alias->($name)};
		}
	    }
	}else{
	    $DEBUG and warn "delete \$Alias\{$alias\}";
	    delete $Alias{$alias};
	}
    }
}

# Allow latin-1 style names as well
                     # 0  1  2  3  4  5   6   7   8   9  10
our @Latin2iso = ( 0, 1, 2, 3, 4, 9, 10, 13, 14, 15, 16 );
# Allow winlatin1 style names as well
our %Winlatin2cp   = (
		      'latin1'     => 1252,
		      'latin2'     => 1250,
		      'cyrillic'   => 1251,
		      'greek'      => 1253,
		      'turkish'    => 1254,
		      'hebrew'     => 1255,
		      'arabic'     => 1256,
		      'baltic'     => 1257,
		      'vietnamese' => 1258,
		     );

init_aliases();

sub undef_aliases{
    @Alias = ();
    %Alias = ();
}

sub init_aliases
{
    undef_aliases();

    # Try all-lower-case version should all else fails
    define_alias( qr/^(.*)$/ => '"\L$1"' );

    # UTF/UCS stuff
    define_alias( qr/^UCS-?2-?LE$/i    => '"UCS-2LE"' );
    define_alias( qr/^UCS-?2-?(BE)?$/i => '"UCS-2BE"',
		  qr/^iso-10646-1$/i   => '"UCS-2BE"' );
    define_alias( qr/^UTF(16|32)-?BE$/i => '"UTF-$1BE"',
		  qr/^UTF(16|32)-?LE$/i => '"UTF-$1LE"',
		  qr/^UTF(16|32)$/i     => '"UTF-$1"',
		);
    # ASCII
    define_alias(qr/^(?:US-?)ascii$/i => '"ascii"');
    define_alias('C' => 'ascii');
    # Allow variants of iso-8859-1 etc.
    define_alias( qr/\biso[-_]?(\d+)[-_](\d+)$/i => '"iso-$1-$2"' );

    # At least HP-UX has these.
    define_alias( qr/\biso8859(\d+)$/i => '"iso-8859-$1"' );

    # More HP stuff.
    define_alias( qr/\b(?:hp-)?(arabic|greek|hebrew|kana|roman|thai|turkish)8$/i => '"${1}8"' );

    # The Official name of ASCII.
    define_alias( qr/\bANSI[-_]?X3\.4[-_]?1968$/i => '"ascii"' );

    # This is a font issue, not an encoding issue.
    # (The currency symbol of the Latin 1 upper half
    #  has been redefined as the euro symbol.)
    define_alias( qr/^(.+)\@euro$/i => '"$1"' );

    define_alias( qr/\b(?:iso[-_]?)?latin[-_]?(\d+)$/i 
		  => '"iso-8859-$Encode::Alias::Latin2iso[$1]"' );

    define_alias( qr/\bwin(latin[12]|cyrillic|baltic|greek|turkish|
			 hebrew|arabic|baltic|vietnamese)$/ix => 
		  '"cp" . $Encode::Alias::Winlatin2cp{lc($1)}' );

    # Common names for non-latin prefered MIME names
    define_alias( 'ascii'    => 'US-ascii',
		  'cyrillic' => 'iso-8859-5',
		  'arabic'   => 'iso-8859-6',
		  'greek'    => 'iso-8859-7',
		  'hebrew'   => 'iso-8859-8',
		  'thai'     => 'iso-8859-11',
		  'tis620'   => 'iso-8859-11',
		  );

    # At least AIX has IBM-NNN (surprisingly...) instead of cpNNN.
    # And Microsoft has their own naming (again, surprisingly).
    # And windows-* is registered in IANA! 
    define_alias( qr/\b(?:ibm|ms|windows)[-_]?(\d\d\d\d?)$/i => '"cp$1"');

    # Sometimes seen with a leading zero.
    # define_alias( qr/\bcp037\b/i => '"cp37"');

    # Mac Mappings
    # predefined in *.ucm; unneeded
    # define_alias( qr/\bmacIcelandic$/i => '"macIceland"');
    define_alias( qr/^mac_(.*)$/i => '"mac$1"');
    # Ououououou. gone.  They are differente!
    # define_alias( qr/\bmacRomanian$/i => '"macRumanian"');
  
    # Standardize on the dashed versions.
    # define_alias( qr/\butf8$/i  => 'utf-8' );
    define_alias( qr/\bkoi8r$/i => 'koi8-r' );
    define_alias( qr/\bkoi8u$/i => 'koi8-u' );

    unless ($Encode::ON_EBCDIC){
        # for Encode::CN
	define_alias( qr/\beuc.*cn$/i        => '"euc-cn"' );
	define_alias( qr/\bcn.*euc$/i        => '"euc-cn"' );
	# define_alias( qr/\bGB[- ]?(\d+)$/i => '"euc-cn"' )
	# CP936 doesn't have vendor-addon for GBK, so they're identical.
	define_alias( qr/^gbk$/i => '"cp936"');
	# This fixes gb2312 vs. euc-cn confusion, practically
	define_alias( qr/\bGB[-_ ]?2312(?:\D.*$|$)/i => '"euc-cn"' );
	# for Encode::JP
	define_alias( qr/\bjis$/i            => '"7bit-jis"' );
	define_alias( qr/\beuc.*jp$/i        => '"euc-jp"' );
	define_alias( qr/\bjp.*euc$/i        => '"euc-jp"' );
	define_alias( qr/\bujis$/i           => '"euc-jp"' );
	define_alias( qr/\bshift.*jis$/i     => '"shiftjis"' );
	define_alias( qr/\bsjis$/i           => '"shiftjis"' );
        # for Encode::KR
	define_alias( qr/\beuc.*kr$/i        => '"euc-kr"' );
	define_alias( qr/\bkr.*euc$/i        => '"euc-kr"' );
	# This fixes ksc5601 vs. euc-kr confusion, practically
        define_alias( qr/(?:x-)?uhc$/i            => '"cp949"' );
        define_alias( qr/(?:x-)?windows-949$/i    => '"cp949"' );
        define_alias( qr/\bks_c_5601-1987$/i      => '"cp949"' );
        # for Encode::TW
	define_alias( qr/\bbig-?5$/i		  => '"big5-eten"' );
	define_alias( qr/\bbig5-?et(?:en)$/i	  => '"big5-eten"' );
	define_alias( qr/\bbig5-?hk(?:scs)?$/i	  => '"big5-hkscs"' );
    }
    # utf8 is blessed :)
    define_alias( qr/^UTF-8$/i => '"utf8"',);
    # At last, Map white space and _ to '-'
    define_alias( qr/^(\S+)[\s_]+(.*)$/i => '"$1-$2"' );
}

1;
__END__

# TODO: HP-UX '8' encodings arabic8 greek8 hebrew8 kana8 thai8 turkish8
# TODO: HP-UX '15' encodings japanese15 korean15 roi15
# TODO: Cyrillic encoding ISO-IR-111 (useful?)
# TODO: Armenian encoding ARMSCII-8
# TODO: Hebrew encoding ISO-8859-8-1
# TODO: Thai encoding TCVN
# TODO: Vietnamese encodings VPS
# TODO: Mac Asian+African encodings: Arabic Armenian Bengali Burmese
#       ChineseSimp ChineseTrad Devanagari Ethiopic ExtArabic
#       Farsi Georgian Gujarati Gurmukhi Hebrew Japanese
#       Kannada Khmer Korean Laotian Malayalam Mongolian
#       Oriya Sinhalese Symbol Tamil Telugu Tibetan Vietnamese

=head1 NAME

Encode::Alias - alias definitions to encodings

=head1 SYNOPSIS

  use Encode;
  use Encode::Alias;
  define_alias( newName => ENCODING);

=head1 DESCRIPTION

Allows newName to be used as an alias for ENCODING. ENCODING may be
either the name of an encoding or an encoding object (as described 
in L<Encode>).

Currently I<newName> can be specified in the following ways:

=over 4

=item As a simple string.

=item As a qr// compiled regular expression, e.g.:

  define_alias( qr/^iso8859-(\d+)$/i => '"iso-8859-$1"' );

In this case if I<ENCODING> is not a reference it is C<eval>-ed to
allow C<$1> etc. to be substituted.  The example is one way to alias
names as used in X11 fonts to the MIME names for the iso-8859-*
family.  Note the double quote inside the single quote.

If you are using a regex here, you have to use the quotes as shown or
it won't work.  Also note that regex handling is tricky even for the
experienced.  Use it with caution.

=item As a code reference, e.g.:

  define_alias( sub { return /^iso8859-(\d+)$/i ? "iso-8859-$1" : undef } , '');


In this case C<$_> will be set to the name that is being looked up and
I<ENCODING> is passed to the sub as its first argument.  The example
is another way to alias names as used in X11 fonts to the MIME names
for the iso-8859-* family.

=back

=head2  Alias overloading

You can override predefined aliases by simply applying define_alias().
New alias is always evaluated first and when neccessary define_alias()
flushes internal cache to make new definition available.

  # redirect  SHIFT_JIS to MS/IBM Code Page 932, which is a
  # superset of SHIFT_JIS

  define_alias( qr/shift.*jis$/i  => '"cp932"' );
  define_alias( qr/sjis$/i        => '"cp932"' );

If you want to zap all predefined aliases, you can

  Encode::Alias->undef_aliases;

to do so.  And

  Encode::Alias->init_aliases;

gets factory setting back.


=head1 SEE ALSO

L<Encode>, L<Encode::Supported>

=cut
Commit	Line	Data
5d030b67	1	package Encode::Alias;
5d030b67	2	use strict;
5129552c	3	use Encode;
b0b300a3	4	our $VERSION = do { my @r = (q$Revision: 1.28 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
5d030b67	5	our $DEBUG = 0;
	6	require Exporter;
	7
	8	our @ISA = qw(Exporter);
	9
	10	# Public, encouraged API is exported by default
5129552c	11
fcb875d4	12	our @EXPORT =
5129552c	13	qw (
	14	define_alias
	15	find_alias
	16	);
5d030b67	17
	18	our @Alias; # ordered matching list
	19	our %Alias; # cached known aliases
	20
5129552c	21	sub find_alias
5d030b67	22	{
	23	my $class = shift;
	24	local $_ = shift;
	25	unless (exists $Alias{$_})
	26	{
eaac0a15	27	$Alias{$_} = undef; # Recursion guard
5d030b67	28	for (my $i=0; $i < @Alias; $i += 2)
	29	{
	30	my $alias = $Alias[$i];
	31	my $val = $Alias[$i+1];
	32	my $new;
	33	if (ref($alias) eq 'Regexp' && $_ =~ $alias)
	34	{
a63c962f	35	$DEBUG and warn "eval $val";
5d030b67	36	$new = eval $val;
	37	# $@ and warn "$val, $@";
	38	}
	39	elsif (ref($alias) eq 'CODE')
	40	{
a63c962f	41	$DEBUG and warn "$alias", "->", "($val)";
5d030b67	42	$new = $alias->($val);
	43	}
	44	elsif (lc($_) eq lc($alias))
	45	{
	46	$new = $val;
	47	}
	48	if (defined($new))
	49	{
	50	next if $new eq $_; # avoid (direct) recursion on bugs
a63c962f	51	$DEBUG and warn "$alias, $new";
5d030b67	52	my $enc = (ref($new)) ? $new : Encode::find_encoding($new);
	53	if ($enc)
	54	{
	55	$Alias{$_} = $enc;
	56	last;
	57	}
	58	}
	59	}
	60	}
a63c962f	61	if ($DEBUG){
	62	my $name;
	63	if (my $e = $Alias{$_}){
	64	$name = $e->name;
	65	}else{
	66	$name = "";
	67	}
	68	warn "find_alias($class, $_)->name = $name";
	69	}
5d030b67	70	return $Alias{$_};
	71	}
	72
	73	sub define_alias
	74	{
	75	while (@_)
	76	{
	77	my ($alias,$name) = splice(@_,0,2);
	78	unshift(@Alias, $alias => $name); # newer one has precedence
	79	# clear %Alias cache to allow overrides
	80	if (ref($alias)){
5129552c	81	my @a = keys %Alias;
5129552c	82	for my $k (@a){
5d030b67	83	if (ref($alias) eq 'Regexp' && $k =~ $alias)
5d030b67	84	{
a63c962f	85	$DEBUG and warn "delete \$Alias\{$k\}";
5d030b67	86	delete $Alias{$k};
	87	}
	88	elsif (ref($alias) eq 'CODE')
	89	{
a63c962f	90	$DEBUG and warn "delete \$Alias\{$k\}";
5d030b67	91	delete $Alias{$alias->($name)};
	92	}
	93	}
	94	}else{
a63c962f	95	$DEBUG and warn "delete \$Alias\{$alias\}";
5d030b67	96	delete $Alias{$alias};
	97	}
	98	}
	99	}
	100
5d030b67	101	# Allow latin-1 style names as well
	102	# 0 1 2 3 4 5 6 7 8 9 10
	103	our @Latin2iso = ( 0, 1, 2, 3, 4, 9, 10, 13, 14, 15, 16 );
5d030b67	104	# Allow winlatin1 style names as well
	105	our %Winlatin2cp = (
	106	'latin1' => 1252,
	107	'latin2' => 1250,
	108	'cyrillic' => 1251,
	109	'greek' => 1253,
	110	'turkish' => 1254,
	111	'hebrew' => 1255,
	112	'arabic' => 1256,
	113	'baltic' => 1257,
	114	'vietnamese' => 1258,
	115	);
	116
5129552c	117	init_aliases();
	118
	119	sub undef_aliases{
	120	@Alias = ();
	121	%Alias = ();
	122	}
	123
	124	sub init_aliases
	125	{
	126	undef_aliases();
a999c27c	127
f2a2953c	128	# Try all-lower-case version should all else fails
a999c27c	129	define_alias( qr/^(.*)$/ => '"\L$1"' );
a999c27c	130
f2a2953c	131	# UTF/UCS stuff
	132	define_alias( qr/^UCS-?2-?LE$/i => '"UCS-2LE"' );
	133	define_alias( qr/^UCS-?2-?(BE)?$/i => '"UCS-2BE"',
	134	qr/^iso-10646-1$/i => '"UCS-2BE"' );
	135	define_alias( qr/^UTF(16\|32)-?BE$/i => '"UTF-$1BE"',
	136	qr/^UTF(16\|32)-?LE$/i => '"UTF-$1LE"',
	137	qr/^UTF(16\|32)$/i => '"UTF-$1"',
	138	);
	139	# ASCII
a999c27c	140	define_alias(qr/^(?:US-?)ascii$/i => '"ascii"');
a999c27c	141	define_alias('C' => 'ascii');
67d7b5ef	142	# Allow variants of iso-8859-1 etc.
67d7b5ef	143	define_alias( qr/\biso[-_]?(\d+)[-_](\d+)$/i => '"iso-$1-$2"' );
5129552c	144
67d7b5ef	145	# At least HP-UX has these.
67d7b5ef	146	define_alias( qr/\biso8859(\d+)$/i => '"iso-8859-$1"' );
5129552c	147
67d7b5ef	148	# More HP stuff.
67d7b5ef	149	define_alias( qr/\b(?:hp-)?(arabic\|greek\|hebrew\|kana\|roman\|thai\|turkish)8$/i => '"${1}8"' );
5129552c	150
67d7b5ef	151	# The Official name of ASCII.
67d7b5ef	152	define_alias( qr/\bANSI[-_]?X3\.4[-_]?1968$/i => '"ascii"' );
5129552c	153
67d7b5ef	154	# This is a font issue, not an encoding issue.
	155	# (The currency symbol of the Latin 1 upper half
	156	# has been redefined as the euro symbol.)
5129552c	157	define_alias( qr/^(.+)\@euro$/i => '"$1"' );
5129552c	158
fcb875d4	159	define_alias( qr/\b(?:iso[-_]?)?latin[-_]?(\d+)$/i
5129552c	160	=> '"iso-8859-$Encode::Alias::Latin2iso[$1]"' );
5129552c	161
67d7b5ef	162	define_alias( qr/\bwin(latin[12]\|cyrillic\|baltic\|greek\|turkish\|
fcb875d4	163	hebrew\|arabic\|baltic\|vietnamese)$/ix =>
5129552c	164	'"cp" . $Encode::Alias::Winlatin2cp{lc($1)}' );
5d030b67	165
67d7b5ef	166	# Common names for non-latin prefered MIME names
5129552c	167	define_alias( 'ascii' => 'US-ascii',
	168	'cyrillic' => 'iso-8859-5',
	169	'arabic' => 'iso-8859-6',
	170	'greek' => 'iso-8859-7',
	171	'hebrew' => 'iso-8859-8',
	172	'thai' => 'iso-8859-11',
	173	'tis620' => 'iso-8859-11',
	174	);
5d030b67	175
67d7b5ef	176	# At least AIX has IBM-NNN (surprisingly...) instead of cpNNN.
67d7b5ef	177	# And Microsoft has their own naming (again, surprisingly).
fcb875d4	178	# And windows-* is registered in IANA!
67d7b5ef	179	define_alias( qr/\b(?:ibm\|ms\|windows)[-_]?(\d\d\d\d?)$/i => '"cp$1"');
5d030b67	180
67d7b5ef	181	# Sometimes seen with a leading zero.
c731e18e	182	# define_alias( qr/\bcp037\b/i => '"cp37"');
5d030b67	183
3ef515df	184	# Mac Mappings
a999c27c	185	# predefined in *.ucm; unneeded
a999c27c	186	# define_alias( qr/\bmacIcelandic$/i => '"macIceland"');
3ef515df	187	define_alias( qr/^mac_(.*)$/i => '"mac$1"');
a999c27c	188	# Ououououou. gone. They are differente!
a999c27c	189	# define_alias( qr/\bmacRomanian$/i => '"macRumanian"');
fcb875d4	190
f2a2953c	191	# Standardize on the dashed versions.
67d7b5ef	192	# define_alias( qr/\butf8$/i => 'utf-8' );
	193	define_alias( qr/\bkoi8r$/i => 'koi8-r' );
	194	define_alias( qr/\bkoi8u$/i => 'koi8-u' );
5129552c	195
a63c962f	196	unless ($Encode::ON_EBCDIC){
a63c962f	197	# for Encode::CN
67d7b5ef	198	define_alias( qr/\beuc.*cn$/i => '"euc-cn"' );
	199	define_alias( qr/\bcn.*euc$/i => '"euc-cn"' );
	200	# define_alias( qr/\bGB[- ]?(\d+)$/i => '"euc-cn"' )
	201	# CP936 doesn't have vendor-addon for GBK, so they're identical.
	202	define_alias( qr/^gbk$/i => '"cp936"');
	203	# This fixes gb2312 vs. euc-cn confusion, practically
	204	define_alias( qr/\bGB[-_ ]?2312(?:\D.*$\|$)/i => '"euc-cn"' );
	205	# for Encode::JP
	206	define_alias( qr/\bjis$/i => '"7bit-jis"' );
	207	define_alias( qr/\beuc.*jp$/i => '"euc-jp"' );
	208	define_alias( qr/\bjp.*euc$/i => '"euc-jp"' );
	209	define_alias( qr/\bujis$/i => '"euc-jp"' );
	210	define_alias( qr/\bshift.*jis$/i => '"shiftjis"' );
	211	define_alias( qr/\bsjis$/i => '"shiftjis"' );
a63c962f	212	# for Encode::KR
67d7b5ef	213	define_alias( qr/\beuc.*kr$/i => '"euc-kr"' );
	214	define_alias( qr/\bkr.*euc$/i => '"euc-kr"' );
	215	# This fixes ksc5601 vs. euc-kr confusion, practically
	216	define_alias( qr/(?:x-)?uhc$/i => '"cp949"' );
	217	define_alias( qr/(?:x-)?windows-949$/i => '"cp949"' );
	218	define_alias( qr/\bks_c_5601-1987$/i => '"cp949"' );
a63c962f	219	# for Encode::TW
b0b300a3	220	define_alias( qr/\bbig-?5$/i => '"big5-eten"' );
	221	define_alias( qr/\bbig5-?et(?:en)$/i => '"big5-eten"' );
	222	define_alias( qr/\bbig5-?hk(?:scs)?$/i => '"big5-hkscs"' );
a63c962f	223	}
f2a2953c	224	# utf8 is blessed :)
f2a2953c	225	define_alias( qr/^UTF-8$/i => '"utf8"',);
67d7b5ef	226	# At last, Map white space and _ to '-'
5129552c	227	define_alias( qr/^(\S+)[\s_]+(.*)$/i => '"$1-$2"' );
	228	}
	229
	230	1;
	231	__END__
5d030b67	232
	233	# TODO: HP-UX '8' encodings arabic8 greek8 hebrew8 kana8 thai8 turkish8
	234	# TODO: HP-UX '15' encodings japanese15 korean15 roi15
	235	# TODO: Cyrillic encoding ISO-IR-111 (useful?)
	236	# TODO: Armenian encoding ARMSCII-8
	237	# TODO: Hebrew encoding ISO-8859-8-1
	238	# TODO: Thai encoding TCVN
5d030b67	239	# TODO: Vietnamese encodings VPS
	240	# TODO: Mac Asian+African encodings: Arabic Armenian Bengali Burmese
	241	# ChineseSimp ChineseTrad Devanagari Ethiopic ExtArabic
	242	# Farsi Georgian Gujarati Gurmukhi Hebrew Japanese
	243	# Kannada Khmer Korean Laotian Malayalam Mongolian
	244	# Oriya Sinhalese Symbol Tamil Telugu Tibetan Vietnamese
	245
5d030b67	246	=head1 NAME
5d030b67	247
ce912cd4	248	Encode::Alias - alias definitions to encodings
5d030b67	249
	250	=head1 SYNOPSIS
	251
5129552c	252	use Encode;
5129552c	253	use Encode::Alias;
5d030b67	254	define_alias( newName => ENCODING);
	255
	256	=head1 DESCRIPTION
	257
3ef515df	258	Allows newName to be used as an alias for ENCODING. ENCODING may be
fcb875d4	259	either the name of an encoding or an encoding object (as described
3ef515df	260	in L<Encode>).
5d030b67	261
	262	Currently I<newName> can be specified in the following ways:
	263
	264	=over 4
	265
	266	=item As a simple string.
	267
	268	=item As a qr// compiled regular expression, e.g.:
	269
	270	define_alias( qr/^iso8859-(\d+)$/i => '"iso-8859-$1"' );
	271
	272	In this case if I<ENCODING> is not a reference it is C<eval>-ed to
3ef515df	273	allow C<$1> etc. to be substituted. The example is one way to alias
	274	names as used in X11 fonts to the MIME names for the iso-8859-*
	275	family. Note the double quote inside the single quote.
5d030b67	276
3ef515df	277	If you are using a regex here, you have to use the quotes as shown or
	278	it won't work. Also note that regex handling is tricky even for the
	279	experienced. Use it with caution.
5d030b67	280
	281	=item As a code reference, e.g.:
	282
	283	define_alias( sub { return /^iso8859-(\d+)$/i ? "iso-8859-$1" : undef } , '');
	284
3ef515df	285
5d030b67	286	In this case C<$_> will be set to the name that is being looked up and
5d030b67	287	I<ENCODING> is passed to the sub as its first argument. The example
3ef515df	288	is another way to alias names as used in X11 fonts to the MIME names
3ef515df	289	for the iso-8859-* family.
5d030b67	290
5129552c	291	=back
	292
	293	=head2 Alias overloading
5d030b67	294
3ef515df	295	You can override predefined aliases by simply applying define_alias().
5d030b67	296	New alias is always evaluated first and when neccessary define_alias()
	297	flushes internal cache to make new definition available.
	298
	299	# redirect SHIFT_JIS to MS/IBM Code Page 932, which is a
	300	# superset of SHIFT_JIS
	301
5129552c	302	define_alias( qr/shift.*jis$/i => '"cp932"' );
	303	define_alias( qr/sjis$/i => '"cp932"' );
	304
	305	If you want to zap all predefined aliases, you can
	306
	307	Encode::Alias->undef_aliases;
	308
	309	to do so. And
	310
	311	Encode::Alias->init_aliases;
	312
	313	gets factory setting back.
	314
5d030b67	315
	316	=head1 SEE ALSO
	317
	318	L<Encode>, L<Encode::Supported>
	319
5129552c	320	=cut
5d030b67	321