[Date Prev][Date Next][Thread Prev][Thread Next] [Search] [Date Index] [Thread Index]

[FWP] too many hints



While noticing that this didn't do what I expected:

  # Change just the even elements of listref:
  @$a[map { $_ * 2 } (1 .. $#$a / 2)] = (0 .. 42);

[The problem is two-fold: I really want $a / 2, but what caught my eye
was that I forgot that Perl isn't C and that for $a = [qw(a b c d)],
$#$a / 2 is 1.5.]

I started perusing the integer pragmatic module.  As is my habit, I used
trusty cperl-mode on the *Man -m integer* buffer returned from
cperl-perldoc, and started to pry into how "use integer" does it's job. 
Much to my surprise, all it does is:

  sub import {
    $^H |= 1;
  }

Pretty trivial, no?  But what is this!  I recalled that "use strict" did
the same sort of thing.  A quick grep-find revealed that $^H is quite a
magical variable indeed.  So, a trip to the perl5.005 source code
revealed that all the magic was bound up in these cpp defines:

				/* Note: the lowest 8 bits are reserved for
				   stuffing into op->op_private */
#define HINT_INTEGER		0x00000001
#define HINT_STRICT_REFS	0x00000002

#define HINT_BLOCK_SCOPE	0x00000100
#define HINT_STRICT_SUBS	0x00000200
#define HINT_STRICT_VARS	0x00000400
#define HINT_LOCALE		0x00000800

#define HINT_NEW_INTEGER	0x00001000
#define HINT_NEW_FLOAT		0x00002000
#define HINT_NEW_BINARY		0x00004000
#define HINT_NEW_STRING		0x00008000
#define HINT_NEW_RE		0x00010000
#define HINT_LOCALIZE_HH	0x00020000 /* %^H needs to be copied */

#define HINT_RE_TAINT		0x00100000
#define HINT_RE_EVAL		0x00200000

And this bit of fun in toke.c [* at the bottom of this message]. 
Yikes!  Just want are all the amazing HINTs for?  My first guess is that
$^H and %^H are used/reused/abused by various bits of Perl and that mere
mortals should keep their noses out.

What is the real story behind [$%]^H?  (I noticed no other types of
variables for ^H than scalar and hash.)


Cheers!
--binkley



[* as promised:]

STATIC SV *
new_constant(char *s, STRLEN len, char *key, SV *sv, SV *pv, char *type) 
{
    dSP;
    HV *table = GvHV(PL_hintgv);		 /* ^H */
    BINOP myop;
    SV *res;
    bool oldcatch = CATCH_GET;
    SV **cvp;
    SV *cv, *typesv;
    char buf[128];
	    
    if (!table) {
	yyerror("%^H is not defined");
	return sv;
    }
    cvp = hv_fetch(table, key, strlen(key), FALSE);
    if (!cvp || !SvOK(*cvp)) {
	sprintf(buf,"$^H{%s} is not defined", key);
	yyerror(buf);
	return sv;
    }
    sv_2mortal(sv);			/* Parent created it permanently */
    cv = *cvp;
    if (!pv)
	pv = sv_2mortal(newSVpv(s, len));
    if (type)
	typesv = sv_2mortal(newSVpv(type, 0));
    else
	typesv = &PL_sv_undef;
    CATCH_SET(TRUE);
    Zero(&myop, 1, BINOP);
    myop.op_last = (OP *) &myop;
    myop.op_next = Nullop;
    myop.op_flags = OPf_WANT_SCALAR | OPf_STACKED;

    PUSHSTACKi(PERLSI_OVERLOAD);
    ENTER;
    SAVEOP();
    PL_op = (OP *) &myop;
    if (PERLDB_SUB && PL_curstash != PL_debstash)
	PL_op->op_private |= OPpENTERSUB_DB;
    PUTBACK;
    pp_pushmark(ARGS);

    EXTEND(sp, 4);
    PUSHs(pv);
    PUSHs(sv);
    PUSHs(typesv);
    PUSHs(cv);
    PUTBACK;

    if (PL_op = pp_entersub(ARGS))
      CALLRUNOPS();
    LEAVE;
    SPAGAIN;

    res = POPs;
    PUTBACK;
    CATCH_SET(oldcatch);
    POPSTACK;

    if (!SvOK(res)) {
	sprintf(buf,"Call to &{$^H{%s}} did not return a defined value", key);
	yyerror(buf);
    }
    return SvREFCNT_inc(res);
}

==== Want to unsubscribe from Fun With Perl?  Well, if you insist...
==== Send email to <fwp-request@technofile.org> with message _body_
====   unsubscribe