On Tue, 25 Sep 2001, Doug MacEachern wrote:
> On Tue, 25 Sep 2001, Philippe M . Chiasson wrote:
>
> > > my @arr = $r->dir_config->get('key');
> >
> > my @arr = $r->dir_config->{'key'}
> >
> > should also be avaliable
>
> which of course will be by default / "for free" since 'FETCH' is just an
> alias for 'get'.
But, FETCH is aliased to apr_table_get! So it always returns a single
value. Here is my attempt to port FETCH from 1.x:
issues:
- should it be our implementation of APR::Table::get instead and FETCH an
alias?
- I cannot seem to cause the list context, it always gets called with
GIMME == G_SCALAR
e.g. this will fail:
# list context
$table->set(foo => 'bar');
$table->add(foo => 'tar');
my @array = $table->{'foo'};
ok @array == 2;
- I've struggled with making all the things link together, so I won't be
surprised if there was a better way to define the function in the map
file.
so this patch passes all the current tests, but is not completely working
with list context. please advise.
Index: t/response/TestAPR/table.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestAPR/table.pm,v
retrieving revision 1.3
diff -u -r1.3 table.pm
--- t/response/TestAPR/table.pm 2001/09/25 19:44:03 1.3
+++ t/response/TestAPR/table.pm 2001/09/26 09:38:04
@@ -69,8 +69,13 @@
ok $table->{'foo'} = 'bar';
+ # scalar context
ok $table->{'foo'} eq 'bar';
+ # list context
+ my @array = $table->{'foo'};
+ ok $array[0] eq 'bar';
+
ok delete $table->{'foo'} || 1;
ok not exists $table->{'foo'};
@@ -81,7 +86,7 @@
$filter_count = 0;
foreach my $key (sort keys %$table) {
- my_filter($key,$table->{$key});
+ my_filter($key, $table->{$key});
}
ok $filter_count == $TABLE_SIZE;
}
Index: xs/APR/Table/APR__Table.h
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/APR/Table/APR__Table.h,v
retrieving revision 1.4
diff -u -r1.4 APR__Table.h
--- xs/APR/Table/APR__Table.h 2001/09/25 19:44:03 1.4
+++ xs/APR/Table/APR__Table.h 2001/09/26 09:38:04
@@ -1,4 +1,3 @@
-#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
@@ -126,3 +125,48 @@
return mpxs_APR__Table_NEXTKEY(tsv, Nullsv);
}
+
+static XS(MPXS_APR__Table_FETCH)
+{
+ dXSARGS;
+
+ if (items != 2) {
+ Perl_croak(aTHX_ "Usage: $table->get($key)");
+ }
+
+ SP -= items;
+ {
+ APR__Table t = modperl_hash_tied_object(aTHX_ "APR::Table", ST(0));
+ const char *key = (const char *)SvPV_nolen(ST(1));
+
+ if (!t) {
+ XSRETURN_UNDEF;
+ }
+
+ if(GIMME == G_SCALAR) {
+ const char *val = apr_table_get(t, key);
+ if (val) {
+ XPUSHs(sv_2mortal(newSVpv((char*)val, 0)));
+ XSRETURN(1);
+ }
+ else {
+ XSRETURN_UNDEF;
+ }
+ }
+ else {
+ apr_array_header_t *arr = apr_table_elts(t);
+ apr_table_entry_t *elts = (apr_table_entry_t *)arr->elts;
+ int i, count;
+
+ for (i = 0; i < arr->nelts; i++) {
+ if (!elts[i].key || strcasecmp(elts[i].key, key)) {
+ continue;
+ }
+ XPUSHs(sv_2mortal(newSVpv(elts[i].val,0)));
+ count++;
+ }
+ XSRETURN(count);
+ }
+ }
+}
+
Index: xs/maps/apr_functions.map
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/maps/apr_functions.map,v
retrieving revision 1.22
diff -u -r1.22 apr_functions.map
--- xs/maps/apr_functions.map 2001/09/25 19:44:03 1.22
+++ xs/maps/apr_functions.map 2001/09/26 09:38:04
@@ -191,13 +191,13 @@
-apr_table_setn
apr_table_unset
-apr_table_vdo
- 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_FIRSTKEY
mpxs_APR__Table_NEXTKEY
mpxs_APR__Table_EXISTS
+ FETCH | MPXS_APR__Table_ | apr_table_t *:t, const char *:key
!MODULE=APR::File
-apr_file_open
_____________________________________________________________________
Stas Bekman JAm_pH -- Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide http://perl.apache.org/guide
mailto:[EMAIL PROTECTED] http://apachetoday.com http://eXtropia.com/
http://singlesheaven.com http://perl.apache.org http://perlmonth.com/
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
