| encoding-source documentation | Contained in the encoding-source distribution. |
encoding::source - allows you to write your script in non-ascii or non-utf8
use encoding::source 'utf8';
no encoding::source; # back to latin-1
{
use encoding::source 'utf8';
# ...
}
# back to latin-1
This pragma allows to change the default encoding for string literals in the current lexical compilation unit (block or file).
This is like the encoding pragma, but done right:
Encode, encoding
(c) Copyright 2007 by Rafael Garcia-Suarez.
Most test files are adapted from the tests of encoding,
maintained by Dan Kogai as part of the Encode distribution.
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
| encoding-source documentation | Contained in the encoding-source distribution. |
package encoding::source; use 5.009005; use strict; use warnings; use Encode qw(find_encoding); our $VERSION = 0.02; our $SINGLETON = bless {}, __PACKAGE__; sub croak { require Carp; Carp::croak(__PACKAGE__ . ": @_"); } my $LATIN1 = find_encoding('iso-8859-1') or croak("Can't load latin-1"); sub _find_encoding { my $name = shift; return $SINGLETON->{$name} // find_encoding($name); } sub import { my ($class, $name) = @_; my $enc = _find_encoding($name); if (!defined $enc) { croak("Unknown encoding '$name'"); } # canonicalize the encoding name $name = $enc->name; # associate it to the currently compiled lexical unit $^H{$class} = $name; # remember the Encode object for that encoding $SINGLETON->{$name} //= $enc; # make sure to install our encoding handler ${^ENCODING} = $SINGLETON; } sub unimport { my $class = shift; undef $^H{$class}; } # now, the three methods called by the core on ${^ENCODING} # returns the name of the encoding which is in effect in the # caller's lexical unit sub name { my $level = $_[1] // 0; my $hinthash = (caller($level))[10]; return $hinthash->{"" . __PACKAGE__}; } # the other methods are just forwarded to the appropriate # Encode object, retrieved in the $SINGLETON for my $method (qw(decode cat_decode)) { no strict 'refs'; *$method = sub { use strict; my $self = shift; my $name = $self->name(1); if ($name) { my $enc = $self->{$name}; if (!defined $enc) { croak("Can't find compiled encoding for '$name'"); } $enc->$method(@_); } else { $LATIN1->$method(@_); } }; } 1; __END__