perl-unicode

Re: Unicode aware module

1999-06-11 14:06:37
On Sat, 24 Apr 1999 12:11:17 BST, Tim Bunce wrote:
On Fri, Apr 23, 1999 at 06:07:31PM -0700, Gurusamy Sarathy wrote:
Right, but I didn't think we were talking about how we mark data
as being of a particular type.  Rather, we were talking about
how to inherit the caller's context for perl builtins within a
subroutine, so it would behave as if it were inlined where it
was called.

Think of a custom mychomp() subroutine that you may want to write
that returns the result rather than the number of chopped characters.
How will you write it so that it behaves as expected when the caller
is in utf8 mode?

I agree that there's a need to be able to discover more a callers
context. (Including the hints value in the output of caller seems like
one obvious approach.)

Here's an implementation of that excellent idea.

And here, for example, is mychomp():

     sub mychomp {
         use caller 'encoding';
         chomp @_;
         @_;
     }

I expect that most modules that don't manipulate binary data
will be utf8-ready if they just put a C<use caller 'encoding'>
at the top.


Sarathy
gsar(_at_)activestate(_dot_)com
-----------------------------------8<-----------------------------------
Change 3534 by gsar(_at_)sparc26 on 1999/06/11 20:41:51

        implement C<use caller 'encoding'>

Affected files ...

... //depot/perl/MANIFEST#162 edit
... //depot/perl/lib/caller.pm#1 add
... //depot/perl/perl.h#146 edit
... //depot/perl/pod/perldelta.pod#69 edit
... //depot/perl/pod/perlfunc.pod#86 edit
... //depot/perl/pp_ctl.c#127 edit

Differences ...

==== //depot/perl/MANIFEST#162 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST.~1~   Fri Jun 11 10:33:25 1999
+++ perl/MANIFEST       Fri Jun 11 10:33:25 1999
@@ -639,6 +639,7 @@
 lib/bigrat.pl          An arbitrary precision rational arithmetic package
 lib/blib.pm            For "use blib"
 lib/cacheout.pl                Manages output filehandles when you need too 
many
+lib/caller.pm          Inherit pragmatic attributes from caller's context
 lib/chat2.pl            Obsolete ipc library (use Comm.pm etc instead)
 lib/complete.pl                A command completion subroutine
 lib/constant.pm                For "use constant"

==== //depot/perl/perl.h#146 (text) ====
Index: perl/perl.h
--- perl/perl.h.~1~     Fri Jun 11 10:33:25 1999
+++ perl/perl.h Fri Jun 11 10:33:25 1999
@@ -2286,6 +2286,7 @@
 
                                /* Note: the lowest 8 bits are reserved for
                                   stuffing into op->op_private */
+#define HINT_PRIVATE_MASK      0x000000ff
 #define HINT_INTEGER           0x00000001
 #define HINT_STRICT_REFS       0x00000002
 /* #define HINT_notused4       0x00000004 */

==== //depot/perl/pod/perldelta.pod#69 (text) ====
Index: perl/pod/perldelta.pod
--- perl/pod/perldelta.pod.~1~  Fri Jun 11 10:33:25 1999
+++ perl/pod/perldelta.pod      Fri Jun 11 10:33:25 1999
@@ -296,6 +296,11 @@
 
 =over 4
 
+=item caller
+
+Allows modules to inherit pragmatic attributes from the caller's
+context.  C<utf8> is currently the only supported attribute.
+
 =item Dumpvalue
 
 Added Dumpvalue module provides screen dumps of Perl data.

==== //depot/perl/pod/perlfunc.pod#86 (text) ====
Index: perl/pod/perlfunc.pod
--- perl/pod/perlfunc.pod.~1~   Fri Jun 11 10:33:25 1999
+++ perl/pod/perlfunc.pod       Fri Jun 11 10:33:25 1999
@@ -512,8 +512,8 @@
 print a stack trace.  The value of EXPR indicates how many call frames
 to go back before the current one.
 
-    ($package, $filename, $line, $subroutine,
-     $hasargs, $wantarray, $evaltext, $is_require) = caller($i);
+    ($package, $filename, $line, $subroutine, $hasargs,
+    $wantarray, $evaltext, $is_require, $hints) = caller($i);
 
 Here $subroutine may be C<"(eval)"> if the frame is not a subroutine
 call, but an C<eval>.  In such a case additional elements $evaltext and
@@ -522,7 +522,9 @@
 C<eval EXPR> statement.  In particular, for a C<eval BLOCK> statement,
 $filename is C<"(eval)">, but $evaltext is undefined.  (Note also that
 each C<use> statement creates a C<require> frame inside an C<eval EXPR>)
-frame.
+frame.  C<$hints> contains pragmatic hints that the caller was
+compiled with.  It currently only reflects the hint corresponding to
+C<use utf8>.
 
 Furthermore, when called from within the DB package, caller returns more
 detailed information: it sets the list variable C<@DB::args> to be the

==== //depot/perl/pp_ctl.c#127 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c.~1~   Fri Jun 11 10:33:25 1999
+++ perl/pp_ctl.c       Fri Jun 11 10:33:25 1999
@@ -1475,7 +1475,7 @@
 
     if (MAXARG)
        count = POPi;
-    EXTEND(SP, 6);
+    EXTEND(SP, 7);
     for (;;) {
        /* we may be in a higher stacklevel, so dig down deeper */
        while (cxix < 0 && top_si->si_type != PERLSI_MAIN) {
@@ -1573,6 +1573,11 @@
        Copy(AvALLOC(ary), AvARRAY(PL_dbargs), AvFILLp(ary) + 1 + off, SV*);
        AvFILLp(PL_dbargs) = AvFILLp(ary) + off;
     }
+    /* XXX only hints propagated via op_private are currently
+     * visible (others are not easily accessible, since they
+     * use the global PL_hints) */
+    PUSHs(sv_2mortal(newSViv((I32)cx->blk_oldcop->op_private &
+                            HINT_PRIVATE_MASK)));
     RETURN;
 }
 

==== //depot/perl/lib/caller.pm#1 (text) ====
Index: perl/lib/caller.pm
--- perl/lib/caller.pm.~1~      Fri Jun 11 10:33:25 1999
+++ perl/lib/caller.pm  Fri Jun 11 10:33:25 1999
@@ -0,0 +1,61 @@
+package caller;
+use vars qw($VERSION);
+$VERSION = "1.0";
+
+=head1 NAME
+
+caller - inherit pragmatic attributes from the context of the caller
+
+=head1 SYNOPSIS
+
+        use caller qw(encoding);
+
+=head1 DESCRIPTION
+
+This pragma allows a module to inherit some attributes from the
+context which loaded it.
+
+Inheriting attributes takes place at compile time; this means
+only attributes that are visible in the calling context at compile
+time will be propagated.
+
+Currently, the only supported attribute is C<encoding>.
+
+=over
+
+=item encoding
+
+Indicates that the character set encoding of the caller's context
+must be inherited.  This can be used to inherit the C<use utf8>
+setting in the calling context.
+
+=back
+
+=cut
+
+my %bits = (
+    # only HINT_UTF8 supported for now
+    encoding => 0x8
+);
+
+sub bits {
+    my $bits = 0;
+    for my $s (@_) { $bits |= $bitmask{$s} || 0; };
+    $bits;
+}
+
+sub import {
+    shift;
+    my @cxt = caller(3);
+    if (@cxt and $cxt[7]) {    # was our parent require-d?
+       #warn "hints was $^H\n";
+       $^H |= bits(@_) | $cxt[8];
+       #warn "hints now $^H\n";
+    }
+}
+
+sub unimport {
+    # noop currently
+}
+
+1;
End of Patch.

<Prev in Thread] Current Thread [Next in Thread>