diff options
| -rw-r--r-- | lib/bytes.pm | 6 | ||||
| -rw-r--r-- | lib/charnames.pm | 48 | ||||
| -rw-r--r-- | lib/filetest.pm | 6 | ||||
| -rw-r--r-- | lib/integer.pm | 6 | ||||
| -rw-r--r-- | lib/locale.pm | 6 | ||||
| -rw-r--r-- | lib/overload.pm | 4 | ||||
| -rw-r--r-- | lib/utf8.pm | 6 |
7 files changed, 49 insertions, 33 deletions
diff --git a/lib/bytes.pm b/lib/bytes.pm index e8ab16f1bd..ae7b5fbf5a 100644 --- a/lib/bytes.pm +++ b/lib/bytes.pm @@ -1,11 +1,13 @@ package bytes; +$bytes::hint_bits = 0x00000008; + sub import { - $^H |= 0x00000008; + $^H |= $bytes::hint_bits; } sub unimport { - $^H &= ~0x00000008; + $^H &= ~$bytes::hint_bits; } sub AUTOLOAD { diff --git a/lib/charnames.pm b/lib/charnames.pm index ff9d5ea891..21b4dd61bc 100644 --- a/lib/charnames.pm +++ b/lib/charnames.pm @@ -1,4 +1,6 @@ package charnames; +use bytes (); # for $bytes::hint_bits +$charnames::hint_bits = 0x20000; my $fname = 'unicode/UnicodeData-Latest.txt'; my $txt; @@ -30,7 +32,7 @@ sub charnames { die "Unknown charname '$name'" unless @off; my $ord = hex substr $txt, $off[0] - 4, 4; - if ($^H & 0x8) { # "use bytes" in effect? + if ($^H & $bytes::hint_bits) { # "use bytes" in effect? use bytes; return chr $ord if $ord <= 255; my $hex = sprintf '%X=0%o', $ord, $ord; @@ -42,8 +44,8 @@ sub charnames { sub import { shift; - die "No scripts for `use charnames'" unless @_; - $^H |= 0x20000; + die "`use charnames' needs explicit imports list" unless @_; + $^H |= $charnames::hint_bits; $^H{charnames} = \&charnames ; my %h; @h{@_} = (1) x @_; @@ -84,42 +86,45 @@ C<CHARNAME> is looked up as a letter in the given scripts (in the specified order). For lookup of C<CHARNAME> inside a given script C<SCRIPTNAME> -F<charcodes.pm> looks for the names +this pragma looks for the names SCRIPTNAME CAPITAL LETTER CHARNAME SCRIPTNAME SMALL LETTER CHARNAME SCRIPTNAME LETTER CHARNAME in the table of standard Unicode names. If C<CHARNAME> is lowercase, -then the C<CAPITAL> variant is ignored, otherwise C<SMALL> variant is +then the C<CAPITAL> variant is ignored, otherwise the C<SMALL> variant is ignored. =head1 CUSTOM TRANSLATORS -The mechanism of translation is C<\N{...}> escapes is general and not +The mechanism of translation of C<\N{...}> escapes is general and not hardwired into F<charnames.pm>. A module can install custom -translations (inside the scope which C<use>s the module) by the +translations (inside the scope which C<use>s the module) with the following magic incantation: - sub import { - shift; - $^H |= 0x20000; - $^H{charnames} = \&translator; - } + use charnames (); # for $charnames::hint_bits + sub import { + shift; + $^H |= $charnames::hint_bits; + $^H{charnames} = \&translator; + } Here translator() is a subroutine which takes C<CHARNAME> as an argument, and returns text to insert into the string instead of the C<\N{CHARNAME}> escape. Since the text to insert should be different -in C<utf8> mode and out of it, the function should check the current -state of C<utf8>-flag as in - - sub translator { - if ($^H & 0x8) { - return utf_translator(@_); - } else { - return no_utf_translator(@_); +in C<bytes> mode and out of it, the function should check the current +state of C<bytes>-flag as in: + + use bytes (); # for $bytes::hint_bits + sub translator { + if ($^H & $bytes::hint_bits) { + return bytes_translator(@_); + } + else { + return utf8_translator(@_); + } } - } =head1 BUGS @@ -129,4 +134,3 @@ do any C<eval>s or C<require>s. This restriction should be lifted in a future version of Perl. =cut - diff --git a/lib/filetest.pm b/lib/filetest.pm index d08f9b4d48..b52a9b484d 100644 --- a/lib/filetest.pm +++ b/lib/filetest.pm @@ -47,9 +47,11 @@ operators is a filename, not when it is a filehandle. =cut +$filetest::hint_bits = 0x00400000; + sub import { if ( $_[1] eq 'access' ) { - $^H |= 0x00400000; + $^H |= $filetest::hint_bits; } else { die "filetest: the only implemented subpragma is 'access'.\n"; } @@ -57,7 +59,7 @@ sub import { sub unimport { if ( $_[1] eq 'access' ) { - $^H &= ~0x00400000; + $^H &= ~$filetest::hint_bits; } else { die "filetest: the only implemented subpragma is 'access'.\n"; } diff --git a/lib/integer.pm b/lib/integer.pm index f6be58a0eb..86afcaf130 100644 --- a/lib/integer.pm +++ b/lib/integer.pm @@ -43,12 +43,14 @@ See L<perlmod/Pragmatic Modules>. =cut +$integer::hint_bits = 0x1; + sub import { - $^H |= 1; + $^H |= $integer::hint_bits; } sub unimport { - $^H &= ~1; + $^H &= ~$integer::hint_bits; } 1; diff --git a/lib/locale.pm b/lib/locale.pm index 44e88f48c6..6314aca59e 100644 --- a/lib/locale.pm +++ b/lib/locale.pm @@ -25,12 +25,14 @@ locales. =cut +$locale::hint_bits = 0x800; + sub import { - $^H |= 0x800; + $^H |= $locale::hint_bits; } sub unimport { - $^H &= ~0x800; + $^H &= ~$locale::hint_bits; } 1; diff --git a/lib/overload.pm b/lib/overload.pm index 3750a43168..ba96bc9ab6 100644 --- a/lib/overload.pm +++ b/lib/overload.pm @@ -1,5 +1,7 @@ package overload; +$overload::hint_bits = 0x20000; + sub nil {} sub OVERLOAD { @@ -129,7 +131,7 @@ sub constant { # Arguments: what, sub while (@_) { $^H{$_[0]} = $_[1]; - $^H |= $constants{$_[0]} | 0x20000; + $^H |= $constants{$_[0]} | $overload::hint_bits; shift, shift; } } diff --git a/lib/utf8.pm b/lib/utf8.pm index 3098fe21bd..c362a1c516 100644 --- a/lib/utf8.pm +++ b/lib/utf8.pm @@ -1,12 +1,14 @@ package utf8; +$utf8::hint_bits = 0x00800000; + sub import { - $^H |= 0x00800000; + $^H |= $utf8::hint_bits; $enc{caller()} = $_[1] if $_[1]; } sub unimport { - $^H &= ~0x00800000; + $^H &= ~$utf8::hint_bits; } sub AUTOLOAD { |