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

[PATCH for discussion] new feature: clamp %hash

Thread Next
From:
Jeffrey Friedl
Date:
July 19, 2001 11:15
Subject:
[PATCH for discussion] new feature: clamp %hash
Message ID:
200107191815.LAA12062@ventrue.corp.yahoo.com

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 Next


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