On Fri, Sep 28, 2001 at 06:45:07PM +0800, Stas Bekman wrote: > patch: > - this patch implements the list context get
Applied and tested fine
Only issue:
patching file t/response/TestAPR/table.pm
Hunk #3 FAILED at 72.
Hunk #4 FAILED at 87.
2 out of 4 hunks FAILED -- saving rejects to file t/response/TestAPR/table.pm.rej
patching file xs/APR/Table/APR__Table.h
patching file xs/maps/apr_functions.map
Just a few empty lines moved around... try this patch instead.
/home/gozer/sources/mod_perl2/deps/perl/bin/perl build/cvsdiff
Index: t/response/TestAPR/table.pm
===================================================================
RCS file: /home/anoncvs/mod_perl-2-cvs/t/response/TestAPR/table.pm,v
retrieving revision 1.3
diff -u -I'$Id' -I'$Revision' -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 11:05:50
@@ -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,7 +22,17 @@
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;
Index: xs/APR/Table/APR__Table.h
===================================================================
RCS file: /home/anoncvs/mod_perl-2-cvs/xs/APR/Table/APR__Table.h,v
retrieving revision 1.4
diff -u -I'$Id' -I'$Revision' -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 11:05:51
@@ -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/anoncvs/mod_perl-2-cvs/xs/maps/apr_functions.map,v
retrieving revision 1.22
diff -u -I'$Id' -I'$Revision' -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 11:05:51
@@ -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
> 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]
>
--
Philippe M. Chiasson <[EMAIL PROTECTED]>
Extropia's Resident System Guru
http://www.eXtropia.com/
Being an adult isn't about being grown up--it's about
realizing you need to grow up.
-- Larry Wall
perl -e '$$=\${gozer};{$_=unpack(P26,pack(L,$$));/^Just Another Perl
Hacker!\n$/&&print||$$++&&redo}'
msg01905/pgp00000.pgp
Description: PGP signature
