patch:
- this patch implements the list context get
changes:
- fixing the args initialization (thanks gozer!)
- a few style fixes
- a more extensive sub-test
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/28 10:38:36
@@ -14,7 +14,7 @@
sub handler {
my $r = shift;
- plan $r, tests => 16;
+ plan $r, tests => 17;
my $table = APR::Table::make($r->pool, $TABLE_SIZE);
@@ -22,8 +22,18 @@
ok $table->set('foo','bar') || 1;
+ # scalar context
ok $table->get('foo') eq 'bar';
+ # add + list context
+ $table->add(foo => 'tar');
+ $table->add(foo => 'kar');
+ my @array = $table->get('foo');
+ ok @array == 3 &&
+ $array[0] eq 'bar' &&
+ $array[1] eq 'tar' &&
+ $array[2] eq 'kar';
+
ok $table->unset('foo') || 1;
ok not defined $table->get('foo');
@@ -62,13 +72,14 @@
#Tied interface
{
my $table = APR::Table::make($r->pool, $TABLE_SIZE);
-
+
ok (UNIVERSAL::isa($table, 'HASH'));
-
+
ok (UNIVERSAL::isa($table, 'HASH')) && tied(%$table);
-
+
ok $table->{'foo'} = 'bar';
+ # scalar context
ok $table->{'foo'} eq 'bar';
ok delete $table->{'foo'} || 1;
@@ -76,16 +87,16 @@
ok not exists $table->{'foo'};
for (1..$TABLE_SIZE) {
- $table->{chr($_+97)} = $_ ;
+ $table->{chr($_+97)} = $_;
}
$filter_count = 0;
foreach my $key (sort keys %$table) {
- my_filter($key,$table->{$key});
+ my_filter($key, $table->{$key});
}
ok $filter_count == $TABLE_SIZE;
}
-
+
Apache::OK;
}
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/28 10:38:36
@@ -126,3 +126,42 @@
return mpxs_APR__Table_NEXTKEY(tsv, Nullsv);
}
+
+static XS(MPXS_apr_table_get)
+{
+ dXSARGS;
+
+ if (items != 2) {
+ Perl_croak(aTHX_ "Usage: $table->get($key)");
+ }
+
+ mpxs_PPCODE({
+ 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_V == G_SCALAR) {
+ const char *val = apr_table_get(t, key);
+
+ if (val) {
+ XPUSHs(sv_2mortal(newSVpv((char*)val, 0)));
+ }
+ }
+ else {
+ apr_array_header_t *arr = apr_table_elts(t);
+ apr_table_entry_t *elts = (apr_table_entry_t *)arr->elts;
+ int i;
+
+ 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)));
+ }
+ }
+ });
+
+}
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/28 10:38:36
@@ -184,7 +184,7 @@
apr_table_add
-apr_table_addn
apr_table_do | mpxs_ | ...
- apr_table_get
+ apr_table_get | MPXS_ | ...
apr_table_merge
-apr_table_mergen
apr_table_set
_____________________________________________________________________
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]
