dougm 01/05/05 15:08:45
Modified: lib/ModPerl Code.pm
src/modules/perl mod_perl.c mod_perl.h
Added: t/apache cgihandler.t
t/response/TestApache cgihandler.pm
Log:
add the start of a 1.x style "perl-script" response handler
Revision Changes Path
1.62 +1 -1 modperl-2.0/lib/ModPerl/Code.pm
Index: Code.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/lib/ModPerl/Code.pm,v
retrieving revision 1.61
retrieving revision 1.62
diff -u -r1.61 -r1.62
--- Code.pm 2001/05/03 22:23:58 1.61
+++ Code.pm 2001/05/05 22:08:44 1.62
@@ -522,7 +522,7 @@
);
my @c_src_names = qw(interp tipool log config cmd options callback handler
- gtop util filter bucket mgv pcw global);
+ gtop util io filter bucket mgv pcw global);
my @g_c_names = map { "modperl_$_" } qw(hooks directives flags xsinit);
my @c_names = ('mod_perl', (map "modperl_$_", @c_src_names));
sub c_files { [map { "$_.c" } @c_names, @g_c_names] }
1.54 +42 -5 modperl-2.0/src/modules/perl/mod_perl.c
Index: mod_perl.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/mod_perl.c,v
retrieving revision 1.53
retrieving revision 1.54
diff -u -r1.53 -r1.54
--- mod_perl.c 2001/05/04 05:57:52 1.53
+++ mod_perl.c 2001/05/05 22:08:44 1.54
@@ -291,6 +291,9 @@
ap_hook_handler(modperl_response_handler,
NULL, NULL, APR_HOOK_MIDDLE);
+ ap_hook_handler(modperl_response_handler_cgi,
+ NULL, NULL, APR_HOOK_MIDDLE);
+
ap_hook_insert_filter(modperl_output_filter_register,
NULL, NULL, APR_HOOK_LAST);
@@ -359,14 +362,10 @@
modperl_wbucket_flush(&rcfg->wbucket);
}
-int modperl_response_handler(request_rec *r)
+static int modperl_response_handler_run(request_rec *r)
{
int retval;
- if (!strEQ(r->handler, "modperl")) {
- return DECLINED;
- }
-
modperl_response_init(r);
retval = modperl_callback_per_dir(MP_RESPONSE_HANDLER, r);
@@ -376,6 +375,44 @@
}
modperl_response_finish(r);
+
+ return retval;
+}
+
+int modperl_response_handler(request_rec *r)
+{
+ if (!strEQ(r->handler, "modperl")) {
+ return DECLINED;
+ }
+
+ return modperl_response_handler_run(r);
+}
+
+int modperl_response_handler_cgi(request_rec *r)
+{
+ GV *h_stdin, *h_stdout;
+ int retval;
+#ifdef USE_ITHREADS
+ pTHX;
+ modperl_interp_t *interp;
+#endif
+
+ if (!strEQ(r->handler, "perl-script")) {
+ return DECLINED;
+ }
+
+#ifdef USE_ITHREADS
+ interp = modperl_interp_select(r, r->connection, r->server);
+ aTHX = interp->perl;
+#endif
+
+ h_stdout = modperl_io_tie_stdout(aTHX_ r);
+ h_stdin = modperl_io_tie_stdin(aTHX_ r);
+
+ retval = modperl_response_handler_run(r);
+
+ modperl_io_handle_untie(aTHX_ h_stdout);
+ modperl_io_handle_untie(aTHX_ h_stdin);
return retval;
}
1.32 +2 -0 modperl-2.0/src/modules/perl/mod_perl.h
Index: mod_perl.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/mod_perl.h,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -r1.31 -r1.32
--- mod_perl.h 2001/04/30 07:17:46 1.31
+++ mod_perl.h 2001/05/05 22:08:44 1.32
@@ -26,6 +26,7 @@
#include "modperl_log.h"
#include "modperl_options.h"
#include "modperl_directives.h"
+#include "modperl_io.h"
#include "modperl_filter.h"
#include "modperl_pcw.h"
#include "modperl_mgv.h"
@@ -43,6 +44,7 @@
void modperl_response_init(request_rec *r);
void modperl_response_finish(request_rec *r);
int modperl_response_handler(request_rec *r);
+int modperl_response_handler_cgi(request_rec *r);
/* betting on Perl*Handlers not using CvXSUBANY
* mod_perl reuses this field for handler attributes
1.1 modperl-2.0/t/apache/cgihandler.t
Index: cgihandler.t
===================================================================
use strict;
use warnings FATAL => 'all';
use Apache::Test;
use Apache::TestRequest;
plan tests => 2, \&have_lwp;
my $location = "/TestApache::cgihandler";
my $str;
my $data = "1..3\nok 1\nok 2\nok 3\n";
$str = POST_BODY $location, content => $data;
ok $str eq $data;
$str = GET_BODY $location;
ok $str eq $data;
1.1 modperl-2.0/t/response/TestApache/cgihandler.pm
Index: cgihandler.pm
===================================================================
package TestApache::cgihandler;
use strict;
use warnings FATAL => 'all';
use Apache::Const -compile => 'M_POST';
#test the 1.x style perl-script handler
sub handler {
my $r = shift;
$r->content_type('text/plain');
if ($r->method_number == Apache::M_POST) {
my $ct = $r->headers_in->get('content-length');
my $buff;
read STDIN, $buff, $ct;
print $buff;
}
else {
print "1..3\n";
print "ok 1\n", "ok ", "2\n";
print "ok 3\n";
}
Apache::OK;
}
1;
__END__
SetHandler perl-script
