You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl-cvs@perl.apache.org by do...@apache.org on 2002/08/27 03:46:27 UTC
cvs commit: modperl-2.0/src/modules/perl modperl_perl.c modperl_perl.h
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 Changes Path
1.15 +123 -0 modperl-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.c 27 May 2002 18:41:52 -0000 1.14
+++ modperl_perl.c 27 Aug 2002 01:46:27 -0000 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.8
diff -u -r1.7 -r1.8
--- modperl_perl.h 1 Nov 2001 23:50:32 -0000 1.7
+++ modperl_perl.h 27 Aug 2002 01:46:27 -0000 1.8
@@ -13,4 +13,15 @@
void modperl_perl_destruct(PerlInterpreter *perl);
+#ifdef USE_ITHREADS
+
+PTR_TBL_t *modperl_svptr_table_clone(pTHX_ PerlInterpreter *proto_perl,
+ PTR_TBL_t *source);
+
+void modperl_svptr_table_destroy(pTHX_ PTR_TBL_t *tbl);
+
+#endif
+
+void modperl_svptr_table_delete(pTHX_ PTR_TBL_t *tbl, void *key);
+
#endif /* MODPERL_PERL_H */