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...@hyperreal.org on 1998/08/06 18:52:42 UTC
cvs commit: modperl/t/net/perl tie_table.pl
dougm 98/08/06 09:52:42
Modified: . Changes ToDo
src/modules/perl Tie.xs
t/net/perl tie_table.pl
Log:
Apache::TieHashTable->get in list context will return all values found for
the given key
Revision Changes Path
1.102 +3 -0 modperl/Changes
Index: Changes
===================================================================
RCS file: /export/home/cvs/modperl/Changes,v
retrieving revision 1.101
retrieving revision 1.102
diff -u -r1.101 -r1.102
--- Changes 1998/08/06 16:44:04 1.101
+++ Changes 1998/08/06 16:52:39 1.102
@@ -8,6 +8,9 @@
=item 1.15_01-dev
+Apache::TieHashTable->get in list context will return all values found for
+the given key
+
move mod_perl_cleanup_av outside of #ifdef PERL_DIRECTIVE_HANDLERS to
cure compile problem spotted by David-Michael Lincke
1.59 +0 -2 modperl/ToDo
Index: ToDo
===================================================================
RCS file: /export/home/cvs/modperl/ToDo,v
retrieving revision 1.58
retrieving revision 1.59
diff -u -r1.58 -r1.59
--- ToDo 1998/08/06 16:44:04 1.58
+++ ToDo 1998/08/06 16:52:40 1.59
@@ -21,8 +21,6 @@
- make 'make test_report' more useful
-- $r->header_out->get in list context
-
- ap_scan_script_header_err_string? and/or update cgi_header_out to
take action on Last-Modified header
1.5 +16 -6 modperl/src/modules/perl/Tie.xs
Index: Tie.xs
===================================================================
RCS file: /export/home/cvs/modperl/src/modules/perl/Tie.xs,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- Tie.xs 1998/06/09 13:37:27 1.4
+++ Tie.xs 1998/08/06 16:52:41 1.5
@@ -39,7 +39,7 @@
CODE:
safefree(self);
-const char*
+void
FETCH(self, key)
Apache::TieHashTable self
const char *key
@@ -47,13 +47,23 @@
ALIAS:
get = 1
- CODE:
+ PPCODE:
ix = ix; /*avoid warning*/
if(!self->table) XSRETURN_UNDEF;
- RETVAL = table_get(self->table, key);
-
- OUTPUT:
- RETVAL
+ if(GIMME == G_SCALAR) {
+ const char *val = table_get(self->table, key);
+ if (val) XPUSHs(sv_2mortal(newSVpv((char*)val,0)));
+ else XSRETURN_UNDEF;
+ }
+ else {
+ int i;
+ array_header *arr = table_elts(self->table);
+ table_entry *elts = (table_entry *)arr->elts;
+ 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)));
+ }
+ }
bool
EXISTS(self, key)
1.4 +6 -2 modperl/t/net/perl/tie_table.pl
Index: tie_table.pl
===================================================================
RCS file: /export/home/cvs/modperl/t/net/perl/tie_table.pl,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- tie_table.pl 1998/06/07 17:58:51 1.3
+++ tie_table.pl 1998/08/06 16:52:42 1.4
@@ -6,7 +6,7 @@
$r->send_http_header("text/plain");
my $i = 0;
-my $tests = 26;
+my $tests = 27;
print "1..$tests\n";
my $headers_in = $r->headers_in;
@@ -40,8 +40,12 @@
@{ $r->notes }{ keys %my_hash } = (values %my_hash);
for (keys %my_hash) {
- test ++$i, $r->notes->get($_);
+ test ++$i, scalar $r->notes->get($_);
}
+$r->notes->add(three => "tre");
+my(@notes) = $r->notes->get("three");
+print "\@notes = @notes\n";
+test ++$i, @notes == 2;
for my $meth (qw{
headers_in headers_out err_headers_out notes dir_config subprocess_env