On Fri, 2003-06-06 at 12:19, Joe Schaefer wrote: > Stas Bekman <[EMAIL PROTECTED]> writes: > > > I'd hate to take the joy of adding these wonderful features away from > > Philippe, who's now busy wrestling with mod_perl 1.28 release, but > > once done will certainly love to do those. Right Philippe?
Right ;-) I've just finally decided to peek into this long thread and
I'll need some time to sort it all out in my busy head ;-)
> Curiosity got the better of me. Here's a patch that seems to
> work (all tests pass), but it sure ain't pretty. Hopefully
> it'll help once Philippe gets some free tuits.
I'll read over all this and provide hopefully usefull comments ;-)
One thing I _do_ remember is that while (my($a, $b) = each %$table) { }
did iterate over all key/value pairs when I initially implemented the
TIE'ed stuff.. But once again, it's been a long time since I looked at
that stuff.
But one thing is for sure, this patch (and this thread also, actually)
is indeed quite ugly (no offense meant)...
There _has_ to be a simpler to make this work...
I'll probably get around looking at this near the end of this week.
Gozer out.
> Index: t/response/TestAPR/table.pm
> ===================================================================
> RCS file: /home/cvspublic/modperl-2.0/t/response/TestAPR/table.pm,v
> retrieving revision 1.5
> diff -u -r1.5 table.pm
> --- t/response/TestAPR/table.pm 11 Apr 2002 11:08:44 -0000 1.5
> +++ t/response/TestAPR/table.pm 6 Jun 2003 04:07:33 -0000
> @@ -15,7 +15,7 @@
> sub handler {
> my $r = shift;
>
> - plan $r, tests => 17;
> + plan $r, tests => 26;
>
> my $table = APR::Table::make($r->pool, $TABLE_SIZE);
>
> @@ -34,6 +34,14 @@
> $array[0] eq 'bar' &&
> $array[1] eq 'tar' &&
> $array[2] eq 'kar';
> +
> + my $c = 0;
> + while (my($a, $b) = each %$table) {
> + ok $a eq 'foo';
> + ok $b eq $array[$c];
> + ok not defined $table->{'bar'};
> + $c++;
> + }
>
> ok $table->unset('foo') || 1;
>
> Index: xs/APR/Table/APR__Table.h
> ===================================================================
> RCS file: /home/cvspublic/modperl-2.0/xs/APR/Table/APR__Table.h,v
> retrieving revision 1.10
> diff -u -r1.10 APR__Table.h
> --- xs/APR/Table/APR__Table.h 4 Jun 2003 02:31:56 -0000 1.10
> +++ xs/APR/Table/APR__Table.h 6 Jun 2003 04:07:33 -0000
> @@ -1,4 +1,4 @@
> -#define mpxs_APR__Table_FETCH apr_table_get
> +//#define mpxs_APR__Table_FETCH apr_table_get
> #define mpxs_APR__Table_STORE apr_table_set
> #define mpxs_APR__Table_DELETE apr_table_unset
> #define mpxs_APR__Table_CLEAR apr_table_clear
> @@ -105,25 +105,45 @@
> ((apr_table_entry_t *) \
> apr_table_elts(t)->elts)[mpxs_apr_table_iterix(sv)++].key
>
> -static MP_INLINE const char *mpxs_APR__Table_NEXTKEY(pTHX_ SV *tsv, SV *key)
> +
> +static MP_INLINE SV *mpxs_APR__Table_NEXTKEY(pTHX_ SV *tsv, SV *key)
> {
> apr_table_t *t = mp_xs_sv2_APR__Table(tsv);
> -
> if (apr_is_empty_table(t)) {
> - return NULL;
> + return Nullsv;
> }
>
> if (mpxs_apr_table_iterix(tsv) < apr_table_elts(t)->nelts) {
> - return mpxs_apr_table_nextkey(t, tsv);
> - }
> + apr_table_entry_t *e = ((apr_table_entry_t *)
> + apr_table_elts(t)->elts) + mpxs_apr_table_iterix(tsv)++;
> + STRLEN len = strlen(e->key);
> + SV *sv = newSV(0);
> +
> + /* XXX: really nasty hack: set the numeric value of the key
> + * to represent a pointer to the corresponding val.
> + * We mark SvEND with another copy of the val's address
> + * as a means of confirming SvIVX really repesents a
> + * pointer.
> + */
> + SvUPGRADE(sv, SVt_PVIV);
> + SvGROW(sv, len + 3*sizeof(IV) + 1);
> + memcpy(SvPVX(sv), e->key, len);
> + SvCUR_set(sv, len);
> + SvEND(sv)[0] = 0;
> + SvIVX(sv) = (IV) e->val;
> + ((IV *)SvEND(sv))[1] = SvIVX(sv) = (IV) e->val;
> + SvPOK_on(sv);
> + SvIOK_on(sv);
>
> - return NULL;
> + return sv;
> + }
> + mpxs_apr_table_iterix(tsv) = 0; /* done */
> + return &PL_sv_undef;
> }
>
> -static MP_INLINE const char *mpxs_APR__Table_FIRSTKEY(pTHX_ SV *tsv)
> +static MP_INLINE SV *mpxs_APR__Table_FIRSTKEY(pTHX_ SV *tsv)
> {
> mpxs_apr_table_iterix(tsv) = 0; /* reset iterator index */
> -
> return mpxs_APR__Table_NEXTKEY(aTHX_ tsv, Nullsv);
> }
>
> @@ -164,4 +184,30 @@
> }
> });
>
> +}
> +
> +static MP_INLINE
> +const char *mpxs_APR__Table_FETCH(pTHX_ SV *tsv, SV *sv)
> +{
> + apr_table_t *t = mp_xs_sv2_APR__Table(tsv);
> + MAGIC *mg;
> + if (!t) {
> + return NULL;
> + }
> +
> + /* XXX: really nasty hack, part 2: check for
> + * an SV coming from mpxs_APR_TABLE_NEXT. If
> + * it is, we take the return value directly
> + * from SvIVX.
> + */
> +
> + if (SvPOK(sv) && SvIOK(sv) &&
> + SvLEN(sv) == SvCUR(sv) + 3*sizeof(IV) + 1 &&
> + ((IV *)SvEND(sv))[1] == SvIVX(sv))
> + {
> + return (const char *)SvIVX(sv);
> + }
> + else {
> + return apr_table_get(t, SvPV_nolen(sv));
> + }
> }
> Index: xs/maps/apr_functions.map
> ===================================================================
> RCS file: /home/cvspublic/modperl-2.0/xs/maps/apr_functions.map,v
> retrieving revision 1.52
> diff -u -r1.52 apr_functions.map
> --- xs/maps/apr_functions.map 15 Apr 2003 08:39:52 -0000 1.52
> +++ xs/maps/apr_functions.map 6 Jun 2003 04:07:34 -0000
> @@ -246,10 +246,11 @@
> -apr_table_setn
> apr_table_unset
> -apr_table_vdo
> - const char *:DEFINE_FETCH | | apr_table_t *:t, const char *:key
> +#const char *:DEFINE_FETCH | | apr_table_t *:t, const char *:key
> void:DEFINE_STORE | | apr_table_t *:t, const char *:key, const char *:value
> void:DEFINE_DELETE | | apr_table_t *:t, const char *:key
> void:DEFINE_CLEAR | | apr_table_t *:t
> + mpxs_APR__Table_FETCH
> mpxs_APR__Table_FIRSTKEY
> mpxs_APR__Table_NEXTKEY
> mpxs_APR__Table_EXISTS
> Index: xs/tables/current/ModPerl/FunctionTable.pm
> ===================================================================
> RCS file: /home/cvspublic/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
> retrieving revision 1.116
> diff -u -r1.116 FunctionTable.pm
> --- xs/tables/current/ModPerl/FunctionTable.pm 4 Jun 2003 16:50:38 -0000
> 1.116
> +++ xs/tables/current/ModPerl/FunctionTable.pm 6 Jun 2003 04:07:39 -0000
> @@ -4958,7 +4958,7 @@
> ]
> },
> {
> - 'return_type' => 'const char *',
> + 'return_type' => 'SV *',
> 'name' => 'mpxs_APR__Table_FIRSTKEY',
> 'attr' => [
> 'static',
> @@ -4977,6 +4977,28 @@
> },
> {
> 'return_type' => 'const char *',
> + 'name' => 'mpxs_APR__Table_FETCH',
> + 'attr' => [
> + 'static',
> + '__inline__'
> + ],
> + 'args' => [
> + {
> + 'type' => 'PerlInterpreter *',
> + 'name' => 'my_perl'
> + },
> + {
> + 'type' => 'SV *',
> + 'name' => 'tsv'
> + },
> + {
> + 'type' => 'SV *',
> + 'name' => 'key'
> + }
> + ]
> + },
> + {
> + 'return_type' => 'SV *',
> 'name' => 'mpxs_APR__Table_NEXTKEY',
> 'attr' => [
> 'static',
--
-- -----------------------------------------------------------------------------
Philippe M. Chiasson /gozer\@(cpan|ectoplasm)\.org/ 88C3A5A5 (122FF51B/C634E37B)
http://gozer.ectoplasm.org/ F9BF E0C2 480E 7680 1AE5 3631 CB32 A107 88C3 A5A5
Q: It is impossible to make anything foolproof because fools are so ingenious.
perl -e'$$=\${gozer};{$_=unpack(P7,pack(L,$$));/^JAm_pH\n$/&&print||$$++&&redo}'
signature.asc
Description: This is a digitally signed message part
