develooper Front page | perl.perl5.porters | Postings from July 2001

Re: [PATCH for discussion] new feature: clamp %hash

Thread Previous | Thread Next
From:
Graham Barr
Date:
July 19, 2001 11:24
Subject:
Re: [PATCH for discussion] new feature: clamp %hash
Message ID:
20010719192114.F51129@pobox.com
I too have often wanted something like this. Currently I do it by a tied hash,
but due to performance only do so when I run my script in a debug mode.

However I would disagree that reading a non-existant entry should croak.

I often have code which, depending on the path taken through the code,
adds different keys. But later check for existance.

Graham.

On Thu, Jul 19, 2001 at 11:15:12AM -0700, Jeffrey Friedl wrote:
> 
> I have long wished that I could mark a hash such that no new keys could
> be added to it -- sort of like a "use strict" for hashes in that if you
> intended
> 	$foo->{Quiet} = 1;
> and by accident typed
> 	$foo->{Quite} = 1;
> you'd get an error.
> 
> I know you can do this with pseudohashes, but it's not always convenient to
> use one, so I've made an attempt to add it myself -- patch follows below.
> 
> The functionality is what's important to me -- how I happened to have
> implemented it will be met with horror by many, I'm sure. I don't claim to
> know much about Perl internals or Perl language design. (But I'm sure I'll
> find out when I see the replies :-)
> 
> I added a new reserved word (I can hear the cringing already) "clamp".
> 
> To clamp down on a hash and disallow access to nonexistant keys:
>    clamp %hash, 1
> 
> To unclamp:
>    clamp %hash, 0
> 
> To query
>    my $clamped = clamp %hash;
> 
> 
> Here's an example:
> 
>   my %x = (
> 	   A => 1,
> 	   B => 2,
> 	   );
>   $x{C} = 3;           # new key, but not an error here
>   my $dummy = $x{XXX}; # nonexistant, but not an error here
>   clamp %x, 1;         # now they'll be errors
> 
>   $dummy = $x{XXX};    # "Can't access nonexistant key {XXX} of readonly hash"
> 
> 
> 
> Leaving the implementation method (new reserved word) aside for the moment,
> I can see some questions:
> 
>     * If a clamped hash is accessed via a blessed reference $foo, might it be
>       nice to call $foo->clampviolation if such a method exists?
> 
>     * What would it mean to extend this to arrays? That the array couldn't
>       grow further? Or, more restrictivly, that you couldn't put new values
>       in a sparse array?
> 
>     * Clampign is similar to making something readonly, in a sense.
>       While were're at it, why not allow scalars to be made readonly?
> 
>     * What would it mean to make a hash or array readonly? That would be
>       clamping, plus making all its values readonly....
> 
> 
> Anyway, I feel that this type of functionality could make OO stuff a lot
> better, just as 'use strict' does for normal programs.
> 
> Thoughs?
> 	Jeffrey
> ------------------------------------------------------------------
> 
> diff -u -w -r .orig/hv.c ./hv.c
> --- .orig/hv.c	Thu Jul 12 21:39:22 2001
> +++ ./hv.c	Thu Jul 19 10:23:02 2001
> @@ -365,6 +365,15 @@
>  	}
>      }
>  #endif
> +
> +    if (HvCLAMPED(hv))
> +    {
> +	if (lval)
> +	    Perl_croak(aTHX_ "Can't add a new key {%s} to readonly hash", key);
> +	else
> +	    Perl_croak(aTHX_ "Can't access nonexistant key {%s} of readonly hash", key);
> +    }
> +
>      if (key != keysave)
>  	Safefree(key);
>      if (lval) {		/* gonna assign to this, so it better be there */
> @@ -595,6 +604,9 @@
>  	    Safefree(key);
>  	return entry;
>      }
> +
> +    if (HvCLAMPED(hv))
> +	Perl_croak(aTHX_ "Can't access nonexistant key {%s} of readonly hash", key);
>  
>      entry = new_HE();
>      if (HvSHAREKEYS(hv))
> diff -u -w -r .orig/hv.h ./hv.h
> --- .orig/hv.h	Sun Jun 17 19:01:05 2001
> +++ ./hv.h	Thu Jul 19 10:06:32 2001
> @@ -132,6 +132,10 @@
>  #define HvPMROOT(hv)	((XPVHV*)  SvANY(hv))->xhv_pmroot
>  #define HvNAME(hv)	((XPVHV*)  SvANY(hv))->xhv_name
>  
> +#define HvCLAMPED(hv)		(SvFLAGS(hv) &   SVh_CLAMPED)
> +#define HvCLAMPED_on(hv)	(SvFLAGS(hv) |=  SVh_CLAMPED)
> +#define HvCLAMPED_off(hv)	(SvFLAGS(hv) &= ~SVh_CLAMPED)
> +
>  #define HvSHAREKEYS(hv)		(SvFLAGS(hv) & SVphv_SHAREKEYS)
>  #define HvSHAREKEYS_on(hv)	(SvFLAGS(hv) |= SVphv_SHAREKEYS)
>  #define HvSHAREKEYS_off(hv)	(SvFLAGS(hv) &= ~SVphv_SHAREKEYS)
> diff -u -w -r .orig/keywords.h ./keywords.h
> --- .orig/keywords.h	Wed May 23 15:40:25 2001
> +++ ./keywords.h	Thu Jul 19 09:47:40 2001
> @@ -245,3 +245,4 @@
>  #define KEY_x			244
>  #define KEY_xor			245
>  #define KEY_y			246
> +#define KEY_clamp               247
> diff -u -w -r .orig/opcode.pl ./opcode.pl
> --- .orig/opcode.pl	Wed Jul 11 21:31:34 2001
> +++ ./opcode.pl	Thu Jul 19 09:56:28 2001
> @@ -887,3 +887,6 @@
>  # Control (contd.)
>  setstate	set statement info	ck_null		s;
>  method_named	method with known name	ck_null		d$
> +
> +clamp		clamp			ck_fun		si%	H S?
> +
> diff -u -w -r .orig/pod/perlfunc.pod ./pod/perlfunc.pod
> --- .orig/pod/perlfunc.pod	Tue Jul 17 02:08:25 2001
> +++ ./pod/perlfunc.pod	Thu Jul 19 10:37:11 2001
> @@ -199,7 +199,7 @@
>  
>  =item Functions new in perl5
>  
> -C<abs>, C<bless>, C<chomp>, C<chr>, C<exists>, C<formline>, C<glob>,
> +C<abs>, C<bless>, C<chomp>, C<chr>, C<clamp>, C<exists>, C<formline>, C<glob>,
>  C<import>, C<lc>, C<lcfirst>, C<map>, C<my>, C<no>, C<our>, C<prototype>,
>  C<qx>, C<qw>, C<readline>, C<readpipe>, C<ref>, C<sub*>, C<sysopen>, C<tie>,
>  C<tied>, C<uc>, C<ucfirst>, C<untie>, C<use>
> @@ -701,6 +701,15 @@
>  change your current working directory, which is unaffected.)  For security
>  reasons, this call is restricted to the superuser.  If FILENAME is
>  omitted, does a C<chroot> to C<$_>.
> +
> +=item clamp HASH, ACTION
> +
> +=item clamp HASH
> +
> +With a true ACTION, clamps down on the hash to disallow the creation of new
> +keys or the access of non-existant keys. With a false ACTION, unclamps
> +the hash. In either case, returns the previous "clampedness" of the HASH.
> +Without an ACTION, merely returns true if the HASH is currently clamped.
>  
>  =item close FILEHANDLE
>  
> diff -u -w -r .orig/pp.c ./pp.c
> --- .orig/pp.c	Mon Jul  2 01:16:04 2001
> +++ ./pp.c	Thu Jul 19 10:10:03 2001
> @@ -3360,6 +3360,38 @@
>  
>  /* Associative arrays. */
>  
> +/*
> + * "clamp %foo, 1" means error to add key, or access nonexistant key.
> + * "clamp %foo, 0" unclamps.
> + * "clamp %foo"    queries current clampedness.
> + */
> +PP(pp_clamp)
> +{
> +    dSP; dTARG;
> +    HV *hv;
> +    I32 action = 0;
> +    I32 retval;
> +
> +    /* grab 2nd arg, if there */
> +    if (MAXARG > 1)
> +	action = POPi;
> +
> +    hv = (HV*)POPs; /* 1st arg: hash to clamp or query on clampedness */
> +
> +    retval = HvCLAMPED(hv) ? 1 : 0; /* note the current state as the retval */
> +
> +    /* if there's an action, do it */
> +    if (MAXARG > 1)
> +    {
> +	if (action)
> +	    HvCLAMPED_on(hv);
> +	else
> +	    HvCLAMPED_off(hv);
> +    }
> +    XPUSHi(retval);
> +    RETURN;
> +}
> +
>  PP(pp_each)
>  {
>      dSP;
> diff -u -w -r .orig/pp.sym ./pp.sym
> --- .orig/pp.sym	Wed Jul 11 21:31:34 2001
> +++ ./pp.sym	Thu Jul 19 09:59:53 2001
> @@ -389,3 +389,4 @@
>  Perl_pp_threadsv
>  Perl_pp_setstate
>  Perl_pp_method_named
> +Perl_pp_clamp
> diff -u -w -r .orig/sv.h ./sv.h
> --- .orig/sv.h	Sun Jul  8 17:03:52 2001
> +++ ./sv.h	Thu Jul 19 10:05:57 2001
> @@ -234,6 +234,8 @@
>  
>  #define SVprv_WEAKREF   0x80000000      /* Weak reference */
>  
> +#define SVh_CLAMPED	0x08000000	/* hash has been clamped */
> +
>  struct xrv {
>      SV *	xrv_rv;		/* pointer to another SV */
>  };
> diff -u -w -r .orig/toke.c ./toke.c
> --- .orig/toke.c	Wed Jul 11 22:31:54 2001
> +++ ./toke.c	Thu Jul 19 09:47:34 2001
> @@ -4143,6 +4143,9 @@
>  	case KEY_bless:
>  	    LOP(OP_BLESS,XTERM);
>  
> +	case KEY_clamp:
> +	    LOP(OP_CLAMP,XTERM);
> +
>  	case KEY_chop:
>  	    UNI(OP_CHOP);
>  
> @@ -5303,6 +5306,7 @@
>  	    if (strEQ(d,"chmod"))		return -KEY_chmod;
>  	    if (strEQ(d,"chown"))		return -KEY_chown;
>  	    if (strEQ(d,"crypt"))		return -KEY_crypt;
> +	    if (strEQ(d,"clamp"))		return -KEY_clamp;
>  	    break;
>  	case 6:
>  	    if (strEQ(d,"chroot"))		return -KEY_chroot;

Thread Previous | Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About