dougm 2002/08/26 18:46:27
Modified:src/modules/perl modperl_perl.c modperl_perl.h
Log:
modperl_svptr_table api is an add-on to the Perl ptr_table_ api.
we use a PTR_TBL_t to map config structures (e.g. from parsed
httpd.conf or .htaccess), where each interpreter needs to have its
own copy of the Perl SV object. we do not use an HV* for this, because
the HV keys must be SVs with a string value, too much overhead.
we do not use an apr_hash_t because they only have the lifetime of
the pool used to create them. which may or may not be the same lifetime
of the objects we need to lookup.
Revision ChangesPath
1.15 +123 -0modperl-2.0/src/modules/perl/modperl_perl.c
Index: modperl_perl.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl.c,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -r1.14 -r1.15
--- modperl_perl.c27 May 2002 18:41:52 - 1.14
+++ modperl_perl.c27 Aug 2002 01:46:27 - 1.15
@@ -137,3 +137,126 @@
}
#endif
}
+
+/*
+ * modperl_svptr_table api is an add-on to the Perl ptr_table_ api.
+ * we use a PTR_TBL_t to map config structures (e.g. from parsed
+ * httpd.conf or .htaccess), where each interpreter needs to have its
+ * own copy of the Perl SV object. we do not use an HV* for this, because
+ * the HV keys must be SVs with a string value, too much overhead.
+ * we do not use an apr_hash_t because they only have the lifetime of
+ * the pool used to create them. which may or may not be the same lifetime
+ * of the objects we need to lookup.
+ */
+
+#ifdef USE_ITHREADS
+
+/*
+ * copy a PTR_TBL_t whos PTR_TBL_ENT_t values are SVs.
+ * the SVs are dup-ed so each interpreter has its own copy.
+ */
+PTR_TBL_t *modperl_svptr_table_clone(pTHX_ PerlInterpreter *proto_perl,
+ PTR_TBL_t *source)
+{
+UV i;
+PTR_TBL_t *tbl;
+PTR_TBL_ENT_t **src_ary, **dst_ary;
+CLONE_PARAMS parms;
+
+Newz(0, tbl, 1, PTR_TBL_t);
+tbl->tbl_max = source->tbl_max;
+tbl->tbl_items = source->tbl_items;
+Newz(0, tbl->tbl_ary, tbl->tbl_max + 1, PTR_TBL_ENT_t *);
+
+dst_ary = tbl->tbl_ary;
+src_ary = source->tbl_ary;
+
+Zero(&parms, 0, CLONE_PARAMS);
+parms.flags = 0;
+parms.stashes = newAV();
+
+for (i=0; i < source->tbl_max; i++, dst_ary++, src_ary++) {
+ PTR_TBL_ENT_t *src_ent, *dst_ent=NULL;
+
+ if (!*src_ary) {
+ continue;
+}
+
+ for (src_ent = *src_ary;
+ src_ent;
+ src_ent = src_ent->next)
+{
+if (dst_ent == NULL) {
+Newz(0, dst_ent, 1, PTR_TBL_ENT_t);
+*dst_ary = dst_ent;
+}
+else {
+Newz(0, dst_ent->next, 1, PTR_TBL_ENT_t);
+dst_ent = dst_ent->next;
+}
+
+/* key is just a pointer we do not modify, no need to copy */
+dst_ent->oldval = src_ent->oldval;
+
+dst_ent->newval =
+SvREFCNT_inc(sv_dup((SV*)src_ent->newval, &parms));
+}
+}
+
+SvREFCNT_dec(parms.stashes);
+
+return tbl;
+}
+
+/*
+ * need to free the SV values in addition to ptr_table_free
+ */
+void modperl_svptr_table_destroy(pTHX_ PTR_TBL_t *tbl)
+{
+UV i;
+PTR_TBL_ENT_t **ary = tbl->tbl_ary;
+
+for (i=0; i < tbl->tbl_max; i++, ary++) {
+ PTR_TBL_ENT_t *ent;
+
+ if (!*ary) {
+ continue;
+}
+
+ for (ent = *ary; ent; ent = ent->next) {
+if (!ent->newval) {
+continue;
+}
+
+SvREFCNT_dec((SV*)ent->newval);
+ent->newval = NULL;
+}
+}
+
+ptr_table_free(tbl);
+}
+#endif
+
+/*
+ * the Perl ptr_table_ api does not provide a function to remove
+ * an entry from the table. we need to SvREFCNT_dec the SV value
+ * anyhow.
+ */
+void modperl_svptr_table_delete(pTHX_ PTR_TBL_t *tbl, void *key)
+{
+PTR_TBL_ENT_t *entry, **oentry;
+UV hash = PTR2UV(key);
+
+oentry = &tbl->tbl_ary[hash & tbl->tbl_max];
+entry = *oentry;
+
+for (; entry; oentry = &entry->next, entry = *oentry) {
+ if (entry->oldval == key) {
+*oentry = entry->next;
+SvREFCNT_dec((SV*)entry->newval);
+Safefree(entry);
+tbl->tbl_items--;
+ return;
+ }
+}
+}
1.8 +11 -0 modperl-2.0/src/modules/perl/modperl_perl.h
Index: modperl_perl.h
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl.h,v
retrieving revision 1.7
retrieving revision 1.
