From: Artur Bergman <sky@nanisky.com>
Date: Wed, 24 Oct 2001 19:06:55 +0000 (+0000)
Subject: Adds support for hashes. Neither hashes nor arrays can contain references yet.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8669ce85400697f979231096bfa64a8216391e5e;p=p5sagit%2Fp5-mst-13.2.git

Adds support for hashes. Neither hashes nor arrays can contain references yet.

p4raw-id: //depot/perl@12624
---

diff --git a/ext/threads/shared/shared.pm b/ext/threads/shared/shared.pm
index d9fbcc3..3fec356 100644
--- a/ext/threads/shared/shared.pm
+++ b/ext/threads/shared/shared.pm
@@ -45,6 +45,8 @@ sub share_enabled (\[$@%]) { # \]
 	weaken($shared{$$obj});
     } elsif($ref eq "ARRAY") {
 	tie @$value, 'threads::shared::av', $value;
+    } elsif($ref eq "HASH") {
+	tie %$value, "threads::shared::hv", $value;
     } else {
 	die "You cannot share ref of type $_[0]\n";
     }
@@ -83,7 +85,17 @@ sub TIEARRAY {
 
 package threads::shared::hv;
 use base 'threads::shared';
+use Scalar::Util qw(weaken);
+sub TIEHASH {
+    my $class = shift;
+    my $value = shift;
+    my $self = bless \threads::shared::hv->new($value),'threads::shared::hv';
+    $shared{$self->ptr} = $value;
+    weaken($shared{$self->ptr});
+    return $self;
+}
 
+package threads::shared;
 bootstrap threads::shared $VERSION;
 
 __END__
diff --git a/ext/threads/shared/shared.xs b/ext/threads/shared/shared.xs
index cf6c41e..d807b66 100644
--- a/ext/threads/shared/shared.xs
+++ b/ext/threads/shared/shared.xs
@@ -413,4 +413,188 @@ SPLICE(self, offset, length, ...)
 	CODE:
 	croak("Splice is not implmented for shared arrays");
 	
+MODULE = threads::shared		PACKAGE = threads::shared::hv
 
+SV* 
+new(class, value)
+	SV* class
+	SV* value
+	CODE:
+	shared_sv* shared = Perl_sharedsv_new(aTHX);
+	SV* obj = newSViv((IV)shared);
+        SHAREDSvEDIT(shared);
+        SHAREDSvGET(shared) = (SV*) newHV();
+        SHAREDSvRELEASE(shared);
+        RETVAL = obj;
+        OUTPUT:
+        RETVAL
+
+void
+STORE(self, key, value)
+        SV* self
+        SV* key
+        SV* value
+        CODE:
+        shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
+        shared_sv* slot;
+        SV* hentry;
+        SV** hentry_;
+	STRLEN len;
+	char* ckey = SvPV(key, len);
+        SHAREDSvLOCK(shared);
+        hentry_ = hv_fetch((HV*) SHAREDSvGET(shared), ckey, len, 0);
+        if(hentry_ && SvIV((*hentry_))) {
+            hentry = (*hentry_);
+            slot = (shared_sv*) SvIV(hentry);
+            if(SvROK(SHAREDSvGET(slot)))
+                Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
+            SHAREDSvEDIT(slot);
+            sv_setsv(SHAREDSvGET(slot), value);
+            SHAREDSvRELEASE(slot);
+        } else {
+            slot = Perl_sharedsv_new(aTHX);
+            SHAREDSvEDIT(shared);
+            SHAREDSvGET(slot) = newSVsv(value);
+            hentry = newSViv((IV)slot);
+            hv_store((HV*) SHAREDSvGET(shared), ckey,len , hentry, 0);
+            SHAREDSvRELEASE(shared);
+        }
+        SHAREDSvUNLOCK(shared);
+
+
+SV*
+FETCH(self, key)
+        SV* self
+        SV* key
+        CODE:
+        shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
+        shared_sv* slot;
+        SV* hentry;
+        SV** hentry_;
+        SV* retval;
+	STRLEN len;
+	char* ckey = SvPV(key, len);
+        SHAREDSvLOCK(shared);
+        hentry_ = hv_fetch((HV*) SHAREDSvGET(shared), ckey, len,0);
+        if(hentry_) {
+            hentry = (*hentry_);
+            if(SvTYPE(hentry) == SVt_NULL) {
+                retval = &PL_sv_undef;
+            } else {
+                slot = (shared_sv*) SvIV(hentry);
+                retval = newSVsv(SHAREDSvGET(slot));
+            }
+        } else {
+            retval = &PL_sv_undef;
+        }
+        SHAREDSvUNLOCK(shared);
+        RETVAL = retval;
+        OUTPUT:
+        RETVAL
+
+void
+CLEAR(self)
+	SV* self
+	CODE:
+        shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
+        shared_sv* slot;
+	HE* entry;
+	SHAREDSvLOCK(shared);
+	Perl_hv_iterinit(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
+	entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
+	while(entry) {
+		slot = (shared_sv*) SvIV(Perl_hv_iterval(PL_sharedsv_space, (HV*) SHAREDSvGET(shared), entry));
+		Perl_sharedsv_thrcnt_dec(aTHX_ slot);
+		entry = Perl_hv_iternext(PL_sharedsv_space,(HV*) SHAREDSvGET(shared));
+	}
+	SHAREDSvEDIT(shared);
+	hv_clear((HV*) SHAREDSvGET(shared));
+	SHAREDSvRELEASE(shared);
+	SHAREDSvUNLOCK(shared);
+
+SV*
+FIRSTKEY(self)
+	SV* self
+	CODE:
+        shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
+	char* key = NULL;
+	I32 len;
+	HE* entry;
+	SHAREDSvLOCK(shared);
+        Perl_hv_iterinit(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
+        entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
+	if(entry) {
+                key = Perl_hv_iterkey(PL_sharedsv_space, entry,&len);
+		RETVAL = newSVpv(key, len);
+        } else {
+	     RETVAL = &PL_sv_undef;
+	}
+        SHAREDSvUNLOCK(shared);
+	OUTPUT:
+	RETVAL
+
+
+SV*
+NEXTKEY(self, oldkey)
+        SV* self
+	SV* oldkey
+        CODE:
+        shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
+        char* key = NULL;
+        I32 len;
+        HE* entry;
+        SHAREDSvLOCK(shared);
+        entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
+        if(entry) {
+                key = Perl_hv_iterkey(PL_sharedsv_space, entry,&len);
+                RETVAL = newSVpv(key, len);
+        } else {
+             RETVAL = &PL_sv_undef;
+        }
+        SHAREDSvUNLOCK(shared);
+        OUTPUT:
+        RETVAL
+
+
+SV*
+EXISTS(self, key)
+	SV* self
+	SV* key
+	CODE:
+	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
+	STRLEN len;
+	char* ckey = SvPV(key, len);
+	SHAREDSvLOCK(shared);
+	if(hv_exists((HV*)SHAREDSvGET(shared), ckey, len)) {
+		RETVAL = &PL_sv_yes;
+	} else {
+		RETVAL = &PL_sv_no;
+	}
+	SHAREDSvUNLOCK(shared);
+	OUTPUT:
+	RETVAL
+
+SV*
+DELETE(self, key)
+        SV* self
+        SV* key
+        CODE:
+        shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
+	shared_sv* slot;
+        STRLEN len;
+        char* ckey = SvPV(key, len);
+        SV* tmp;
+	SHAREDSvLOCK(shared);
+	SHAREDSvEDIT(shared);
+	tmp = hv_delete((HV*) SHAREDSvGET(shared), ckey, len,0);
+	SHAREDSvRELEASE(shared);
+	if(tmp) {
+		slot = SvIV(tmp);	
+		RETVAL = newSVsv(SHAREDSvGET(slot));
+		Perl_sharedsv_thrcnt_dec(aTHX_ slot);
+	} else {
+		RETVAL = &PL_sv_undef;
+	}
+        SHAREDSvUNLOCK(shared);
+        OUTPUT:
+        RETVAL