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

package encoding;
our $VERSION = do { my @r = (q$Revision: 1.28 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };

use Encode;
use strict;

BEGIN {
    if (ord("A") == 193) {
	require Carp;
	Carp::croak "encoding pragma does not support EBCDIC platforms";
    }
}

our $HAS_PERLIO_ENCODING;

eval { require PerlIO::encoding; };
if ($@){
    $HAS_PERLIO_ENCODING = 0;
}else{
    $HAS_PERLIO_ENCODING = 1;
    binmode(STDIN);
}

sub import {
    my $class = shift;
    my $name  = shift;
    my %arg = @_;
    $name ||= $ENV{PERL_ENCODING};

    my $enc = find_encoding($name);
    unless (defined $enc) {
	require Carp;
	Carp::croak "Unknown encoding '$name'";
    }
    unless ($arg{Filter}){
	${^ENCODING} = $enc; # this is all you need, actually.
	$HAS_PERLIO_ENCODING or return 1;
	for my $h (qw(STDIN STDOUT)){
	    if ($arg{$h}){
		unless (defined find_encoding($arg{$h})) {
		    require Carp;
		    Carp::croak "Unknown encoding for $h, '$arg{$h}'";
		}
		eval qq{ binmode($h, ":encoding($arg{$h})") };
	    }else{
		unless (exists $arg{$h}){
		    eval qq{ binmode($h, ":encoding($name)") };
		}
	    }
	    if ($@){
		require Carp;
		Carp::croak($@);
	    }
	}
    }else{
	defined(${^ENCODING}) and undef ${^ENCODING};
	eval {
	    require Filter::Util::Call ;
	    Filter::Util::Call->import ;
	    binmode(STDIN);
	    binmode(STDOUT);
	    filter_add(sub{
			   my $status;
                           if (($status = filter_read()) > 0){
			       $_ = $enc->decode($_, 1);
			       # warn $_;
			   }
			   $status ;
		       });
	};
	# warn "Filter installed";
    }
    return 1; # I doubt if we need it, though
}

sub unimport{
    no warnings;
    undef ${^ENCODING};
    binmode(STDIN);
    binmode(STDOUT);
    if ($INC{"Filter/Util/Call.pm"}){
	eval { filter_del() };
    }
}

1;
__END__
=pod

=head1 NAME

encoding -  allows you to write your script in non-asii or non-utf8

=head1 SYNOPSIS

  use encoding "greek";  # Perl like Greek to you?
  use encoding "euc-jp"; # Jperl!

  # or you can even do this if your shell supports your native encoding

  perl -Mencoding=latin2 -e '...' # Feeling centrally European?
  perl -Mencoding=euc-ko -e '...'

  # or from the shebang line

  #!/your/path/to/perl -Mencoding="8859-6" # Arabian Nights
  #!/your/path/to/perl -Mencoding=euc-tw

  # more control

  # A simple euc-cn => utf-8 converter
  use encoding "euc-cn", STDOUT => "utf8";  while(<>){print};

  # "no encoding;" supported (but not scoped!)
  no encoding;

  # an alternate way, Filter
  use encoding "euc-jp", Filter=>1;
  use utf8;
  # now you can use kanji identifiers -- in euc-jp!

=head1 ABSTRACT

Let's start with a bit of history: Perl 5.6.0 introduced Unicode
support.  You could apply C<substr()> and regexes even to complex CJK
characters -- so long as the script was written in UTF-8.  But back
then text editors that supported UTF-8 were still rare and many users
rather chose to write scripts in legacy encodings, given up whole new
feature of Perl 5.6.

Rewind to the future: starting from perl 5.8.0 with B<encoding>
pragma, you can write your script in any encoding you like (so long
as the C<Encode> module supports it) and still enjoy Unicode support.
You can write a code in EUC-JP as follows:

  my $Rakuda = "\xF1\xD1\xF1\xCC"; # Camel in Kanji
               #<-char-><-char->   # 4 octets
  s/\bCamel\b/$Rakuda/;

And with C<use encoding "euc-jp"> in effect, it is the same thing as
the code in UTF-8:

  my $Rakuda = "\x{99F1}\x{99DD}"; # who Unicode Characters
  s/\bCamel\b/$Rakuda/;

The B<encoding> pragma also modifies the filehandle disciplines of
STDIN, STDOUT, and STDERR to the specified encoding.  Therefore,

  use encoding "euc-jp";
  my $message = "Camel is the symbol of perl.\n";
  my $Rakuda = "\xF1\xD1\xF1\xCC"; # Camel in Kanji
  $message =~ s/\bCamel\b/$Rakuda/;
  print $message;

Will print "\xF1\xD1\xF1\xCC is the symbol of perl.\n",
not "\x{99F1}\x{99DD} is the symbol of perl.\n".

You can override this by giving extra arguments, see below.

=head1 USAGE

=over 4

=item use encoding [I<ENCNAME>] ;

Sets the script encoding to I<ENCNAME> and filehandle disciplines of
STDIN, STDOUT are set to ":encoding(I<ENCNAME>)".  Note STDERR will
not be changed.

If no encoding is specified, the environment variable L<PERL_ENCODING>
is consulted.  If no encoding can be found, the error C<Unknown encoding
'I<ENCNAME>'> will be thrown.

Note that non-STD file handles remain unaffected.  Use C<use open> or
C<binmode> to change disciplines of those.

=item use encoding I<ENCNAME> [ STDIN =E<gt> I<ENCNAME_IN> ...] ;

You can also individually set encodings of STDIN and STDOUT via
STDI<FH> =E<gt> I<ENCNAME_FH> form.  In this case, you cannot omit the
first I<ENCNAME>.  C<STDI<FH> =E<gt> undef> turns the IO transcoding
completely off.

=item no encoding;

Unsets the script encoding and the disciplines of STDIN, STDOUT are
reset to ":raw" (the default unprocessed raw stream of bytes).

=back

=head1 CAVEATS

=head2 NOT SCOPED

The pragma is a per script, not a per block lexical.  Only the last
C<use encoding> or C<matters, and it affects B<the whole script>.
However, <no encoding> pragma is supported and C<use encoding> can
appear as many times as you want in a given script.  The multiple use
of this pragma is discouraged.

=head2 DO NOT MIX MULTIPLE ENCODINGS

Notice that only literals (string or regular expression) having only
legacy code points are affected: if you mix data like this

	\xDF\x{100}

the data is assumed to be in (Latin 1 and) Unicode, not in your native
encoding.  In other words, this will match in "greek":

	"\xDF" =~ /\x{3af}/

but this will not

	"\xDF\x{100}" =~ /\x{3af}\x{100}/

since the C<\xDF> (ISO 8859-7 GREEK SMALL LETTER IOTA WITH TONOS) on
the left will B<not> be upgraded to C<\x{3af}> (Unicode GREEK SMALL
LETTER IOTA WITH TONOS) because of the C<\x{100}> on the left.  You
should not be mixing your legacy data and Unicode in the same string.

This pragma also affects encoding of the 0x80..0xFF code point range:
normally characters in that range are left as eight-bit bytes (unless
they are combined with characters with code points 0x100 or larger,
in which case all characters need to become UTF-8 encoded), but if
the C<encoding> pragma is present, even the 0x80..0xFF range always
gets UTF-8 encoded.

After all, the best thing about this pragma is that you don't have to
resort to \x... just to spell your name in native a encoding.  So feel
free to put your strings in your encoding in quotes and regexes.

=head1 Non-ASCII Identifiers and Filter option

The magic of C<use encoding> is not applied to the names of
identifiers.  In order to make C<${"4eba"}++> ($human++, where human
is a single Han ideograph) work, you still need to write your script
in UTF-8 or use a source filter.

In other words, the same restriction as Jperl applies.

If you dare to experiment, however, you can try Filter option.

=over 4

=item use encoding I<ENCNAME> Filter=E<gt>1;

This turns encoding pragma into source filter.  While the default
approach just decodes interpolated literals (in qq() and qr()), this
will apply source filter to entire source code.  In this case, STDIN
and STDOUT remain untouched.

=back

What does this mean?  Your source code behaves as if it is written in
UTF-8.  So even if your editor only supports Shift_JIS, for example.
You can still try examples in Chapter 15 of C<Programming Perl, 3rd
Ed.> For instance, you can use UTF-8 identifiers.

This option is significantly slower and (as of this writing) non-ASCII
identifiers are not very stable WITHOUT this option and with the
source code written in UTF-8.

To make your script in legacy encoding work with minimum effort,
do not use Filter=E<gt>1.

=head1 EXAMPLE - Greekperl

    use encoding "iso 8859-7";

    # The \xDF of ISO 8859-7 (Greek) is \x{3af} in Unicode.

    $a = "\xDF";
    $b = "\x{100}";

    printf "%#x\n", ord($a); # will print 0x3af, not 0xdf

    $c = $a . $b;

    # $c will be "\x{3af}\x{100}", not "\x{df}\x{100}".

    # chr() is affected, and ...

    print "mega\n"  if ord(chr(0xdf)) == 0x3af;

    # ... ord() is affected by the encoding pragma ...

    print "tera\n" if ord(pack("C", 0xdf)) == 0x3af;

    # ... as are eq and cmp ...

    print "peta\n" if "\x{3af}" eq  pack("C", 0xdf);
    print "exa\n"  if "\x{3af}" cmp pack("C", 0xdf) == 0;

    # ... but pack/unpack C are not affected, in case you still
    # want back to your native encoding

    print "zetta\n" if unpack("C", (pack("C", 0xdf))) == 0xdf;

=head1 KNOWN PROBLEMS

For native multibyte encodings (either fixed or variable length)
the current implementation of the regular expressions may introduce
recoding errors for longer regular expression literals than 127 bytes.

The encoding pragma is not supported on EBCDIC platforms.
(Porters wanted.)

=head1 SEE ALSO

L<perlunicode>, L<Encode>, L<open>, L<Filter::Util::Call>,

Ch. 15 of C<Programming Perl (3rd Edition)>
by Larry Wall, Tom Christiansen, Jon Orwant;
O'Reilly & Associates; ISBN 0-596-00027-8

=cut
Commit	Line	Data
3ef515df	1	package encoding;
b2704119	2	our $VERSION = do { my @r = (q$Revision: 1.28 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
3ef515df	3
3ef515df	4	use Encode;
046f36bf	5	use strict;
3ef515df	6
	7	BEGIN {
	8	if (ord("A") == 193) {
	9	require Carp;
	10	Carp::croak "encoding pragma does not support EBCDIC platforms";
	11	}
	12	}
	13
b2704119	14	our $HAS_PERLIO_ENCODING;
	15
	16	eval { require PerlIO::encoding; };
	17	if ($@){
	18	$HAS_PERLIO_ENCODING = 0;
	19	}else{
	20	$HAS_PERLIO_ENCODING = 1;
	21	binmode(STDIN);
	22	}
	23
3ef515df	24	sub import {
	25	my $class = shift;
	26	my $name = shift;
	27	my %arg = @_;
	28	$name \|\|= $ENV{PERL_ENCODING};
	29
	30	my $enc = find_encoding($name);
	31	unless (defined $enc) {
	32	require Carp;
	33	Carp::croak "Unknown encoding '$name'";
	34	}
aae85ceb	35	unless ($arg{Filter}){
aae85ceb	36	${^ENCODING} = $enc; # this is all you need, actually.
b2704119	37	$HAS_PERLIO_ENCODING or return 1;
aae85ceb	38	for my $h (qw(STDIN STDOUT)){
aae85ceb	39	if ($arg{$h}){
b2704119	40	unless (defined find_encoding($arg{$h})) {
aae85ceb	41	require Carp;
	42	Carp::croak "Unknown encoding for $h, '$arg{$h}'";
	43	}
	44	eval qq{ binmode($h, ":encoding($arg{$h})") };
	45	}else{
	46	unless (exists $arg{$h}){
	47	eval qq{ binmode($h, ":encoding($name)") };
	48	}
	49	}
	50	if ($@){
3ef515df	51	require Carp;
aae85ceb	52	Carp::croak($@);
3ef515df	53	}
3ef515df	54	}
aae85ceb	55	}else{
	56	defined(${^ENCODING}) and undef ${^ENCODING};
	57	eval {
	58	require Filter::Util::Call ;
	59	Filter::Util::Call->import ;
b2704119	60	binmode(STDIN);
b2704119	61	binmode(STDOUT);
aae85ceb	62	filter_add(sub{
	63	my $status;
	64	if (($status = filter_read()) > 0){
	65	$_ = $enc->decode($_, 1);
	66	# warn $_;
	67	}
	68	$status ;
	69	});
	70	};
	71	# warn "Filter installed";
3ef515df	72	}
	73	return 1; # I doubt if we need it, though
	74	}
	75
	76	sub unimport{
	77	no warnings;
	78	undef ${^ENCODING};
b2704119	79	binmode(STDIN);
b2704119	80	binmode(STDOUT);
aae85ceb	81	if ($INC{"Filter/Util/Call.pm"}){
	82	eval { filter_del() };
	83	}
3ef515df	84	}
	85
	86	1;
	87	__END__
	88	=pod
	89
	90	=head1 NAME
	91
	92	encoding - allows you to write your script in non-asii or non-utf8
	93
	94	=head1 SYNOPSIS
	95
962111ca	96	use encoding "greek"; # Perl like Greek to you?
3ef515df	97	use encoding "euc-jp"; # Jperl!
3ef515df	98
962111ca	99	# or you can even do this if your shell supports your native encoding
3ef515df	100
962111ca	101	perl -Mencoding=latin2 -e '...' # Feeling centrally European?
962111ca	102	perl -Mencoding=euc-ko -e '...'
3ef515df	103
	104	# or from the shebang line
	105
962111ca	106	#!/your/path/to/perl -Mencoding="8859-6" # Arabian Nights
962111ca	107	#!/your/path/to/perl -Mencoding=euc-tw
3ef515df	108
	109	# more control
	110
962111ca	111	# A simple euc-cn => utf-8 converter
962111ca	112	use encoding "euc-cn", STDOUT => "utf8"; while(<>){print};
3ef515df	113
	114	# "no encoding;" supported (but not scoped!)
	115	no encoding;
	116
aae85ceb	117	# an alternate way, Filter
	118	use encoding "euc-jp", Filter=>1;
	119	use utf8;
	120	# now you can use kanji identifiers -- in euc-jp!
	121
3ef515df	122	=head1 ABSTRACT
3ef515df	123
962111ca	124	Let's start with a bit of history: Perl 5.6.0 introduced Unicode
	125	support. You could apply C<substr()> and regexes even to complex CJK
	126	characters -- so long as the script was written in UTF-8. But back
	127	then text editors that supported UTF-8 were still rare and many users
	128	rather chose to write scripts in legacy encodings, given up whole new
	129	feature of Perl 5.6.
3ef515df	130
962111ca	131	Rewind to the future: starting from perl 5.8.0 with B<encoding>
	132	pragma, you can write your script in any encoding you like (so long
	133	as the C<Encode> module supports it) and still enjoy Unicode support.
	134	You can write a code in EUC-JP as follows:
3ef515df	135
	136	my $Rakuda = "\xF1\xD1\xF1\xCC"; # Camel in Kanji
	137	#<-char-><-char-> # 4 octets
	138	s/\bCamel\b/$Rakuda/;
	139
	140	And with C<use encoding "euc-jp"> in effect, it is the same thing as
962111ca	141	the code in UTF-8:
3ef515df	142
	143	my $Rakuda = "\x{99F1}\x{99DD}"; # who Unicode Characters
	144	s/\bCamel\b/$Rakuda/;
	145
962111ca	146	The B<encoding> pragma also modifies the filehandle disciplines of
3ef515df	147	STDIN, STDOUT, and STDERR to the specified encoding. Therefore,
	148
	149	use encoding "euc-jp";
	150	my $message = "Camel is the symbol of perl.\n";
	151	my $Rakuda = "\xF1\xD1\xF1\xCC"; # Camel in Kanji
	152	$message =~ s/\bCamel\b/$Rakuda/;
	153	print $message;
	154
962111ca	155	Will print "\xF1\xD1\xF1\xCC is the symbol of perl.\n",
962111ca	156	not "\x{99F1}\x{99DD} is the symbol of perl.\n".
3ef515df	157
962111ca	158	You can override this by giving extra arguments, see below.
3ef515df	159
	160	=head1 USAGE
	161
	162	=over 4
	163
	164	=item use encoding [I<ENCNAME>] ;
	165
962111ca	166	Sets the script encoding to I<ENCNAME> and filehandle disciplines of
	167	STDIN, STDOUT are set to ":encoding(I<ENCNAME>)". Note STDERR will
	168	not be changed.
3ef515df	169
3ef515df	170	If no encoding is specified, the environment variable L<PERL_ENCODING>
962111ca	171	is consulted. If no encoding can be found, the error C<Unknown encoding
962111ca	172	'I<ENCNAME>'> will be thrown.
3ef515df	173
	174	Note that non-STD file handles remain unaffected. Use C<use open> or
	175	C<binmode> to change disciplines of those.
	176
aae85ceb	177	=item use encoding I<ENCNAME> [ STDIN =E<gt> I<ENCNAME_IN> ...] ;
3ef515df	178
aae85ceb	179	You can also individually set encodings of STDIN and STDOUT via
aae85ceb	180	STDI<FH> =E<gt> I<ENCNAME_FH> form. In this case, you cannot omit the
962111ca	181	first I<ENCNAME>. C<STDI<FH> =E<gt> undef> turns the IO transcoding
aae85ceb	182	completely off.
3ef515df	183
	184	=item no encoding;
	185
f2a2953c	186	Unsets the script encoding and the disciplines of STDIN, STDOUT are
962111ca	187	reset to ":raw" (the default unprocessed raw stream of bytes).
3ef515df	188
	189	=back
	190
	191	=head1 CAVEATS
	192
	193	=head2 NOT SCOPED
	194
	195	The pragma is a per script, not a per block lexical. Only the last
	196	C<use encoding> or C<matters, and it affects B<the whole script>.
962111ca	197	However, <no encoding> pragma is supported and C<use encoding> can
962111ca	198	appear as many times as you want in a given script. The multiple use
3ef515df	199	of this pragma is discouraged.
	200
	201	=head2 DO NOT MIX MULTIPLE ENCODINGS
	202
	203	Notice that only literals (string or regular expression) having only
	204	legacy code points are affected: if you mix data like this
	205
	206	\xDF\x{100}
	207
	208	the data is assumed to be in (Latin 1 and) Unicode, not in your native
	209	encoding. In other words, this will match in "greek":
	210
	211	"\xDF" =~ /\x{3af}/
	212
	213	but this will not
	214
	215	"\xDF\x{100}" =~ /\x{3af}\x{100}/
	216
962111ca	217	since the C<\xDF> (ISO 8859-7 GREEK SMALL LETTER IOTA WITH TONOS) on
	218	the left will B<not> be upgraded to C<\x{3af}> (Unicode GREEK SMALL
	219	LETTER IOTA WITH TONOS) because of the C<\x{100}> on the left. You
	220	should not be mixing your legacy data and Unicode in the same string.
3ef515df	221
	222	This pragma also affects encoding of the 0x80..0xFF code point range:
	223	normally characters in that range are left as eight-bit bytes (unless
	224	they are combined with characters with code points 0x100 or larger,
	225	in which case all characters need to become UTF-8 encoded), but if
	226	the C<encoding> pragma is present, even the 0x80..0xFF range always
	227	gets UTF-8 encoded.
	228
	229	After all, the best thing about this pragma is that you don't have to
962111ca	230	resort to \x... just to spell your name in native a encoding. So feel
3ef515df	231	free to put your strings in your encoding in quotes and regexes.
3ef515df	232
962111ca	233	=head1 Non-ASCII Identifiers and Filter option
aae85ceb	234
962111ca	235	The magic of C<use encoding> is not applied to the names of
	236	identifiers. In order to make C<${"4eba"}++> ($human++, where human
	237	is a single Han ideograph) work, you still need to write your script
	238	in UTF-8 or use a source filter.
aae85ceb	239
	240	In other words, the same restriction as Jperl applies.
	241
962111ca	242	If you dare to experiment, however, you can try Filter option.
aae85ceb	243
	244	=over 4
	245
	246	=item use encoding I<ENCNAME> Filter=E<gt>1;
	247
	248	This turns encoding pragma into source filter. While the default
	249	approach just decodes interpolated literals (in qq() and qr()), this
	250	will apply source filter to entire source code. In this case, STDIN
	251	and STDOUT remain untouched.
	252
	253	=back
	254
962111ca	255	What does this mean? Your source code behaves as if it is written in
	256	UTF-8. So even if your editor only supports Shift_JIS, for example.
	257	You can still try examples in Chapter 15 of C<Programming Perl, 3rd
	258	Ed.> For instance, you can use UTF-8 identifiers.
aae85ceb	259
	260	This option is significantly slower and (as of this writing) non-ASCII
	261	identifiers are not very stable WITHOUT this option and with the
	262	source code written in UTF-8.
	263
962111ca	264	To make your script in legacy encoding work with minimum effort,
962111ca	265	do not use Filter=E<gt>1.
aae85ceb	266
3ef515df	267	=head1 EXAMPLE - Greekperl
	268
	269	use encoding "iso 8859-7";
	270
	271	# The \xDF of ISO 8859-7 (Greek) is \x{3af} in Unicode.
	272
	273	$a = "\xDF";
	274	$b = "\x{100}";
	275
	276	printf "%#x\n", ord($a); # will print 0x3af, not 0xdf
	277
	278	$c = $a . $b;
	279
	280	# $c will be "\x{3af}\x{100}", not "\x{df}\x{100}".
	281
	282	# chr() is affected, and ...
	283
	284	print "mega\n" if ord(chr(0xdf)) == 0x3af;
	285
	286	# ... ord() is affected by the encoding pragma ...
	287
	288	print "tera\n" if ord(pack("C", 0xdf)) == 0x3af;
	289
	290	# ... as are eq and cmp ...
	291
	292	print "peta\n" if "\x{3af}" eq pack("C", 0xdf);
	293	print "exa\n" if "\x{3af}" cmp pack("C", 0xdf) == 0;
	294
	295	# ... but pack/unpack C are not affected, in case you still
	296	# want back to your native encoding
	297
	298	print "zetta\n" if unpack("C", (pack("C", 0xdf))) == 0xdf;
	299
	300	=head1 KNOWN PROBLEMS
	301
	302	For native multibyte encodings (either fixed or variable length)
	303	the current implementation of the regular expressions may introduce
	304	recoding errors for longer regular expression literals than 127 bytes.
	305
	306	The encoding pragma is not supported on EBCDIC platforms.
	307	(Porters wanted.)
	308
	309	=head1 SEE ALSO
	310
aae85ceb	311	L<perlunicode>, L<Encode>, L<open>, L<Filter::Util::Call>,
	312
	313	Ch. 15 of C<Programming Perl (3rd Edition)>
	314	by Larry Wall, Tom Christiansen, Jon Orwant;
	315	O'Reilly & Associates; ISBN 0-596-00027-8
3ef515df	316
3ef515df	317	=cut