You are viewing a plain text version of this content. The canonical link for it is here.
Posted to apreq-cvs@httpd.apache.org by jo...@apache.org on 2005/03/13 05:33:41 UTC
svn commit: r157311 - in httpd/apreq/branches/multi-env-unstable: build/
glue/perl/ glue/perl/lib/Apache/ glue/perl/lib/Apache2/ glue/perl/t/
glue/perl/t/apreq/ glue/perl/t/response/TestApReq/ glue/perl/xsbuilder/
glue/perl/xsbuilder/APR/Request/ glue/perl/xsbuilder/APR/Request/Apache2/
glue/perl/xsbuilder/APR/Request/Cookie/
glue/perl/xsbuilder/APR/Request/Error/
glue/perl/xsbuilder/APR/Request/Param/ glue/perl/xsbuilder/maps/
Author: joes
Date: Sat Mar 12 20:33:36 2005
New Revision: 157311
URL: http://svn.apache.org/viewcvs?view=rev&rev=157311
Log:
Major perl glue changes:
1) Follow mp2's Apache:: -> Apache2:: rename strategy.
Besides renaming our Apache:: modules, the apache2-rename-unstable
subversion branches for both modperl and Apache-Test are now
prerequisites. Yes, at the moment that means you must install
unstable branches before you can build the perl glue. Caveat
emptor.
2) Fix all the upload-related perl glue tests, and skipping all the
doc tests for now.
3) Start phasing out ExtUtils::XSBuilder, beginning with the typemap
file.
Added:
httpd/apreq/branches/multi-env-unstable/glue/perl/lib/Apache2/
- copied from r155864, httpd/apreq/branches/multi-env-unstable/glue/perl/lib/Apache/
httpd/apreq/branches/multi-env-unstable/glue/perl/lib/Apache2/Cookie.pm
- copied, changed from r157278, httpd/apreq/branches/multi-env-unstable/glue/perl/lib/Apache/Cookie.pm
httpd/apreq/branches/multi-env-unstable/glue/perl/lib/Apache2/Request.pm
- copied, changed from r157278, httpd/apreq/branches/multi-env-unstable/glue/perl/lib/Apache/Request.pm
httpd/apreq/branches/multi-env-unstable/glue/perl/lib/Apache2/Upload.pm
- copied, changed from r157278, httpd/apreq/branches/multi-env-unstable/glue/perl/lib/Apache/Upload.pm
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/typemap
Removed:
httpd/apreq/branches/multi-env-unstable/glue/perl/lib/Apache/
Modified:
httpd/apreq/branches/multi-env-unstable/build/version_check.pl
httpd/apreq/branches/multi-env-unstable/glue/perl/Makefile.PL
httpd/apreq/branches/multi-env-unstable/glue/perl/t/TEST.PL
httpd/apreq/branches/multi-env-unstable/glue/perl/t/apreq/cgi.t
httpd/apreq/branches/multi-env-unstable/glue/perl/t/apreq/request.t
httpd/apreq/branches/multi-env-unstable/glue/perl/t/apreq/upload.t
httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestApReq/big_input.pm
httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestApReq/cookie.pm
httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestApReq/inherit.pm
httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestApReq/request.pm
httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestApReq/upload.pm
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Apache2/APR__Request__Apache2.h
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Cookie/APR__Request__Cookie.h
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Error/Error.xs
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Param/APR__Request__Param.h
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Param/Param.pm
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Param/Param.xs
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Request.xs
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/apreq_xs_postperl.h
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/maps/apreq_functions.map
httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/maps/apreq_types.map
Modified: httpd/apreq/branches/multi-env-unstable/build/version_check.pl
URL: http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/build/version_check.pl?view=diff&r1=157310&r2=157311
==============================================================================
--- httpd/apreq/branches/multi-env-unstable/build/version_check.pl (original)
+++ httpd/apreq/branches/multi-env-unstable/build/version_check.pl Sat Mar 12 20:33:36 2005
@@ -32,11 +32,7 @@
sub mp2_version {
eval {
- require Apache2;
- require mod_perl;
- $mod_perl::VERSION;
- } or do {
- require mod_perl;
+ require mod_perl2;
$mod_perl::VERSION;
};
}
Modified: httpd/apreq/branches/multi-env-unstable/glue/perl/Makefile.PL
URL: http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/Makefile.PL?view=diff&r1=157310&r2=157311
==============================================================================
--- httpd/apreq/branches/multi-env-unstable/glue/perl/Makefile.PL (original)
+++ httpd/apreq/branches/multi-env-unstable/glue/perl/Makefile.PL Sat Mar 12 20:33:36 2005
@@ -17,8 +17,8 @@
use Config;
use File::Find qw(finddepth);
use File::Basename;
-use Apache::Build;
-use constant WIN32 => Apache::Build::WIN32;
+use Apache2::Build;
+use constant WIN32 => Apache2::Build::WIN32;
use Cwd;
use ExtUtils::XSBuilder::ParseSource;
@@ -95,7 +95,7 @@
qq{-L$base_dir/win32/libs -llib$apreq_libname -lmod_apreq2 -L$perl_lib -llibaprext -L$apache_dir/lib -lmod_perl} :
qx{$base_dir/apreq2-config --link-ld --ldflags --libs};
-my $mp2_typemaps = Apache::Build->new->typemaps;
+my $mp2_typemaps = Apache2::Build->new->typemaps;
package My::ParseSource;
use base qw/ExtUtils::XSBuilder::ParseSource/;
@@ -247,7 +247,7 @@
doc_test : @tests
\$(FULLPERLRUN) "-Mblib" "-MTest::Harness" "-e" "runtests(\@ARGV)" @tests
-test :: doc_test
+#test :: doc_test
EOT
} else {
@@ -464,45 +464,21 @@
}
-# another bug in WrapXS.pm -
-# must insert a space before typemap definition
+# For now, just copy the typemap file in xsbuilder til we
+# can remove ExtUtils::XSBuilder.
sub write_typemap
{
my $self = shift;
+
my $typemap = $self->typemap;
my $map = $typemap->get;
my %seen;
my $fh = $self->open_class_file('', 'typemap');
print $fh "$self->{noedit_warning_hash}\n";
-
- while (my($type, $t) = each %$map) {
- my $class = $t -> {class} ;
- $class ||= $type;
- next if $seen{$type}++ || $typemap->special($class);
-
- my $typemap = $t -> {typemapid} ;
- if ($class =~ /::/) {
- next if $seen{$class}++ ;
- $class =~ s/::$// ;
- print $fh "$class\t$typemap\n";
- }
- else {
- print $fh "$type\t$typemap\n";
- }
- }
-
- my $typemap_code = $typemap -> typemap_code ;
-
- foreach my $dir ('INPUT', 'OUTPUT') {
- print $fh "\n$dir\n" ;
- while (my($type, $code) = each %{$typemap_code}) {
- print $fh "$type\n\t$code->{$dir}\n\n" if ($code->{$dir}) ;
- }
- }
-
- close $fh;
+ open my $tfh, "$xs_dir/typemap" or die $!;
+ print $fh $_ while <$tfh>;
}
Copied: httpd/apreq/branches/multi-env-unstable/glue/perl/lib/Apache2/Cookie.pm (from r157278, httpd/apreq/branches/multi-env-unstable/glue/perl/lib/Apache/Cookie.pm)
URL: http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/lib/Apache2/Cookie.pm?view=diff&rev=157311&p1=httpd/apreq/branches/multi-env-unstable/glue/perl/lib/Apache/Cookie.pm&r1=157278&p2=httpd/apreq/branches/multi-env-unstable/glue/perl/lib/Apache2/Cookie.pm&r2=157311
==============================================================================
--- httpd/apreq/branches/multi-env-unstable/glue/perl/lib/Apache/Cookie.pm (original)
+++ httpd/apreq/branches/multi-env-unstable/glue/perl/lib/Apache2/Cookie.pm Sat Mar 12 20:33:36 2005
@@ -1,5 +1,4 @@
-package Apache::Cookie;
-use Apache::RequestRec;
+package Apache2::Cookie;
use APR::Request::Cookie;
use APR::Request::Apache2;
use APR::Request qw/encode decode/;
@@ -31,8 +30,8 @@
my $class = shift;
my $req = shift;
unless (defined $req) {
- my $usage = 'Usage: Apache::Cookie->fetch($r): missing argument $r';
- $req = eval {Apache->request} or die <<EOD;
+ my $usage = 'Usage: Apache2::Cookie->fetch($r): missing argument $r';
+ $req = eval {Apache2->request} or die <<EOD;
$usage: attempt to fetch global Apache->request failed: $@.
EOD
}
@@ -53,7 +52,7 @@
sub freeze {
my ($class, $value) = @_;
- die 'Usage: Apache::Cookie->freeze($value)' unless @_ == 2;
+ die 'Usage: Apache2::Cookie->freeze($value)' unless @_ == 2;
if (not ref $value) {
return encode($value);
@@ -78,9 +77,9 @@
return shift->thaw;
}
-package Apache::Cookie::Jar;
+package Apache2::Cookie::Jar;
use APR::Request::Apache2;
push our @ISA, qw/APR::Request::Apache2/;
-sub cookies { Apache::Cookie->fetch(shift) }
+sub cookies { Apache2::Cookie->fetch(shift) }
1;
Copied: httpd/apreq/branches/multi-env-unstable/glue/perl/lib/Apache2/Request.pm (from r157278, httpd/apreq/branches/multi-env-unstable/glue/perl/lib/Apache/Request.pm)
URL: http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/lib/Apache2/Request.pm?view=diff&rev=157311&p1=httpd/apreq/branches/multi-env-unstable/glue/perl/lib/Apache/Request.pm&r1=157278&p2=httpd/apreq/branches/multi-env-unstable/glue/perl/lib/Apache2/Request.pm&r2=157311
==============================================================================
--- httpd/apreq/branches/multi-env-unstable/glue/perl/lib/Apache/Request.pm (original)
+++ httpd/apreq/branches/multi-env-unstable/glue/perl/lib/Apache2/Request.pm Sat Mar 12 20:33:36 2005
@@ -1,7 +1,7 @@
-package Apache::Request;
+package Apache2::Request;
use APR::Request::Param;
use APR::Request::Apache2 qw/args/;
-use Apache::RequestRec;
-push our @ISA, qw/Apache::RequestRec APR::Request::Apache2/;
+use Apache2::RequestRec;
+push our @ISA, qw/Apache2::RequestRec APR::Request::Apache2/;
1;
Copied: httpd/apreq/branches/multi-env-unstable/glue/perl/lib/Apache2/Upload.pm (from r157278, httpd/apreq/branches/multi-env-unstable/glue/perl/lib/Apache/Upload.pm)
URL: http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/lib/Apache2/Upload.pm?view=diff&rev=157311&p1=httpd/apreq/branches/multi-env-unstable/glue/perl/lib/Apache/Upload.pm&r1=157278&p2=httpd/apreq/branches/multi-env-unstable/glue/perl/lib/Apache2/Upload.pm&r2=157311
==============================================================================
--- httpd/apreq/branches/multi-env-unstable/glue/perl/lib/Apache/Upload.pm (original)
+++ httpd/apreq/branches/multi-env-unstable/glue/perl/lib/Apache2/Upload.pm Sat Mar 12 20:33:36 2005
@@ -1,18 +1,27 @@
-package Apache::Upload;
-use Apache::Request;
+package Apache2::Upload;
+use Apache2::Request;
push our @ISA, qw/APR::Request::Param/;
no strict 'refs';
-for (qw/slurp type size link tempname/) {
+for (qw/slurp type size link tempname fh io filename/) {
*{$_} = *{"APR::Request::Param::upload_$_"}{CODE};
}
-sub Apache::Request::upload {
+sub Apache2::Request::upload {
my $req = shift;
my $body = $req->body;
$body->param_class(__PACKAGE__);
- my @uploads = grep $_->upload,
- @_ ? $body->get(@_) : values %$body;
- wantarray ? @uploads : $uploads[0];
+ my @uploads;
+ if (@_) {
+ @uploads = grep $_->upload, $body->get(@_);
+ return wantarray ? @uploads : $uploads[0];
+ }
+
+ return map { $_->upload ? $_->name : () } values %$body
+ if wantarray;
+
+ return $body->uploads($req->pool);
+
}
+*bb = *APR::Request::Param::upload;
1;
Modified: httpd/apreq/branches/multi-env-unstable/glue/perl/t/TEST.PL
URL: http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/t/TEST.PL?view=diff&r1=157310&r2=157311
==============================================================================
--- httpd/apreq/branches/multi-env-unstable/glue/perl/t/TEST.PL (original)
+++ httpd/apreq/branches/multi-env-unstable/glue/perl/t/TEST.PL Sat Mar 12 20:33:36 2005
@@ -3,8 +3,8 @@
use strict;
use warnings FATAL => 'all';
use Apache2;
-use Apache::Build;
-use constant WIN32 => Apache::Build::WIN32;
+use Apache2::Build;
+use constant WIN32 => Apache2::Build::WIN32;
use Cwd;
my $cwd = WIN32 ?
@@ -12,7 +12,7 @@
$cwd =~ m{^(.+)/glue/perl$} or die "Can't find base cvs directory";
my $base_dir = $1;
my $module_dir = "$base_dir/module";
-my $mod_apreq2_dir = Apache::Build::WIN32 ?
+my $mod_apreq2_dir = Apache2::Build::WIN32 ?
"$base_dir/win32/libs" : "$module_dir/apache2/.libs";
use base 'Apache::TestRunPerl';
Modified: httpd/apreq/branches/multi-env-unstable/glue/perl/t/apreq/cgi.t
URL: http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/t/apreq/cgi.t?view=diff&r1=157310&r2=157311
==============================================================================
--- httpd/apreq/branches/multi-env-unstable/glue/perl/t/apreq/cgi.t (original)
+++ httpd/apreq/branches/multi-env-unstable/glue/perl/t/apreq/cgi.t Sat Mar 12 20:33:36 2005
@@ -157,8 +157,6 @@
}
# file upload tests
-skip 1, "- Upload API not yet implemented" for 1..10;
-exit 0;
foreach my $name (@names) {
my $url = ( ($name =~ /\.pod$/) ?
@@ -209,7 +207,6 @@
use File::Basename;
use warnings FATAL => 'all';
use blib;
-use Apache2;
use APR;
use APR::Pool;
use APR::Request::Param;
@@ -265,40 +262,43 @@
my $temp_dir = File::Spec->tmpdir;
my $has_md5 = $req->args('has_md5');
require Digest::MD5 if $has_md5;
- my $upload = $req->upload(($req->upload)[0]);
- my $type = $upload->type;
- my $basename = File::Basename::basename($upload->filename);
+ my $body = $req->body;
+ $body->param_class("APR::Request::Param");
+ my ($param) = values %{$body->uploads($p)};
+ my $type = $param->upload_type;
+ my $basename = File::Basename::basename($param->upload_filename);
my ($data, $fh);
if ($method eq 'slurp') {
- $upload->slurp($data);
+ $param->upload_slurp($data);
}
elsif ($method eq 'fh') {
- read $upload->fh, $data, $upload->size;
+ read $param->upload_fh, $data, $param->upload_size;
}
elsif ($method eq 'tempname') {
- my $name = $upload->tempname;
+ my $name = $param->upload_tempname;
open $fh, "<", $name or die "Can't open $name: $!";
binmode $fh;
- read $fh, $data, $upload->size;
+ read $fh, $data, $param->upload_size;
close $fh;
}
elsif ($method eq 'link') {
my $link_file = File::Spec->catfile($temp_dir, "linkfile");
unlink $link_file if -f $link_file;
- $upload->link($link_file) or die "Can't link to $link_file: $!";
+ $param->upload_link($link_file) or die "Can't link to $link_file: $!";
open $fh, "<", $link_file or die "Can't open $link_file: $!";
binmode $fh;
- read $fh, $data, $upload->size;
+ read $fh, $data, $param->upload_size;
close $fh;
unlink $link_file if -f $link_file;
}
elsif ($method eq 'io') {
- read $upload->io, $data, $upload->size;
+ read $param->upload_io, $data, $param->upload_size;
}
else {
die "unknown method: $method";
}
+
my $temp_file = File::Spec->catfile($temp_dir, $basename);
unlink $temp_file if -f $temp_file;
open my $wfh, ">", $temp_file or die "Can't open $temp_file: $!";
Modified: httpd/apreq/branches/multi-env-unstable/glue/perl/t/apreq/request.t
URL: http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/t/apreq/request.t?view=diff&r1=157310&r2=157311
==============================================================================
--- httpd/apreq/branches/multi-env-unstable/glue/perl/t/apreq/request.t (original)
+++ httpd/apreq/branches/multi-env-unstable/glue/perl/t/apreq/request.t Sat Mar 12 20:33:36 2005
@@ -41,6 +41,9 @@
ok t_cmp($result, "text/plain", "type");
}
+skip 1, "- config() API not yet implemented" for 1..2;
+exit 0;
+
{
my $value = 'DataUpload' x 100;
my $result = UPLOAD_BODY("$location?test=hook", content => $value);
Modified: httpd/apreq/branches/multi-env-unstable/glue/perl/t/apreq/upload.t
URL: http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/t/apreq/upload.t?view=diff&r1=157310&r2=157311
==============================================================================
--- httpd/apreq/branches/multi-env-unstable/glue/perl/t/apreq/upload.t (original)
+++ httpd/apreq/branches/multi-env-unstable/glue/perl/t/apreq/upload.t Sat Mar 12 20:33:36 2005
@@ -17,7 +17,7 @@
my @names = sort keys %types;
my @methods = sort qw/slurp fh tempname link io/;
-plan tests => @names * @methods, under_construction; # have_lwp
+plan tests => @names * @methods, have_lwp;
foreach my $name (@names) {
my $url = ( ($name =~ /\.pod$/) ?
Modified: httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestApReq/big_input.pm
URL: http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestApReq/big_input.pm?view=diff&r1=157310&r2=157311
==============================================================================
--- httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestApReq/big_input.pm (original)
+++ httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestApReq/big_input.pm Sat Mar 12 20:33:36 2005
@@ -2,13 +2,13 @@
use strict;
use warnings FATAL => 'all';
-use Apache::Request ();
-use Apache::RequestIO;
-use Apache::RequestRec;
+use Apache2::Request ();
+use Apache2::RequestIO;
+use Apache2::RequestRec;
sub handler {
my $r = shift;
- my $req = Apache::Request->new($r);
+ my $req = Apache2::Request->new($r);
my $len = 0;
for ($req->param) {
Modified: httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestApReq/cookie.pm
URL: http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestApReq/cookie.pm?view=diff&r1=157310&r2=157311
==============================================================================
--- httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestApReq/cookie.pm (original)
+++ httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestApReq/cookie.pm Sat Mar 12 20:33:36 2005
@@ -3,18 +3,17 @@
use strict;
use warnings FATAL => 'all';
-use Apache::Request ();
-use Apache::RequestIO;
-use Apache::RequestRec;
-use Apache::Connection;
+use Apache2::RequestIO;
+use Apache2::RequestRec;
+use Apache2::Connection;
-use Apache::Cookie ();
-use Apache::Request ();
+use Apache2::Cookie ();
+use Apache2::Request ();
sub handler {
my $r = shift;
- my $req = Apache::Request->new($r);
- my %cookies = Apache::Cookie->fetch($r);
+ my $req = Apache2::Request->new($r);
+ my %cookies = Apache2::Cookie->fetch($r);
$r->content_type('text/plain');
my $test = $req->APR::Request::args('test');
@@ -33,9 +32,10 @@
}
else {
my @expires;
- @expires = ("expires", $req->APR::Request::args('expires')) if $req->APR::Request::args('expires');
- my $cookie = Apache::Cookie->new($r, name => "foo",
- value => "bar", @expires);
+ @expires = ("expires", $req->APR::Request::args('expires'))
+ if $req->APR::Request::args('expires');
+ my $cookie = Apache2::Cookie->new($r, name => "foo",
+ value => "bar", @expires);
if ($test eq "bake") {
$cookie->bake($req);
}
Modified: httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestApReq/inherit.pm
URL: http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestApReq/inherit.pm?view=diff&r1=157310&r2=157311
==============================================================================
--- httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestApReq/inherit.pm (original)
+++ httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestApReq/inherit.pm Sat Mar 12 20:33:36 2005
@@ -1,18 +1,18 @@
package TestApReq::inherit;
-use Apache::Cookie;
-use base qw/Apache::Request Apache::Cookie::Jar/;
+use Apache2::Cookie;
+use base qw/Apache2::Request Apache2::Cookie::Jar/;
use strict;
use warnings FATAL => 'all';
use APR;
-use Apache::RequestRec;
-use Apache::RequestIO;
+use Apache2::RequestRec;
+use Apache2::RequestIO;
sub handler {
my $r = shift;
$r = __PACKAGE__->new($r); # tickles refcnt bug in apreq-1
die "Wrong package: ", ref $r unless $r->isa('TestApReq::inherit');
$r->content_type('text/plain');
- # look for segfault when $r->isa("Apache::Request")
+ # look for segfault when $r->isa("Apache2::Request")
my $req = bless { r => $r };
$req->printf("method => %s\n", $req->method);
Modified: httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestApReq/request.pm
URL: http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestApReq/request.pm?view=diff&r1=157310&r2=157311
==============================================================================
--- httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestApReq/request.pm (original)
+++ httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestApReq/request.pm Sat Mar 12 20:33:36 2005
@@ -3,14 +3,15 @@
use strict;
use warnings FATAL => 'all';
-use Apache::RequestRec;
-use Apache::RequestIO;
-use Apache::Request ();
-use Apache::Connection;
-use Apache::Upload;
+use Apache2::RequestRec;
+use Apache2::RequestIO;
+use Apache2::Request ();
+use Apache2::Connection;
+use Apache2::Upload;
use APR::Pool;
+use APR::Bucket;
use APR::PerlIO;
-use Apache::ServerUtil;
+use Apache2::ServerUtil;
use File::Spec;
my $data;
@@ -27,9 +28,9 @@
sub handler {
my $r = shift;
my $temp_dir =
- File::Spec->catfile(Apache::ServerUtil::server_root, 'logs');
- my $req = Apache::Request->new($r);#, POST_MAX => 1_000_000,
- #TEMP_DIR => $temp_dir);
+ File::Spec->catfile(Apache2::ServerUtil::server_root, 'logs');
+ my $req = Apache2::Request->new($r);#, POST_MAX => 1_000_000,
+ #TEMP_DIR => $temp_dir);
$req->temp_dir($temp_dir);
$req->read_limit(1_000_000);
$req->content_type('text/plain');
@@ -43,7 +44,7 @@
$req->print($value);
}
elsif ($test eq 'slurp') {
- my ($upload) = $req->upload;#values %{$req->upload};
+ my ($upload) = values %{$req->upload};
$upload->slurp(my $data);
if ($upload->size != length $data) {
$req->print("Size mismatch: size() reports ", $upload->size,
@@ -115,8 +116,9 @@
$r->print(<$io>);
}
elsif ($test eq 'bad') {
+ require APR::Request::Error;
eval {my $q = $req->args('query')};
- if (ref $@ eq "Apache::Request::Error") {
+ if (ref $@ && $@->isa("APR::Request::Error")) {
$req->upload("HTTPUPLOAD")->slurp(my $data);
$req->print($data);
}
@@ -136,7 +138,7 @@
elsif ($test eq 'disable_uploads') {
$req->config(DISABLE_UPLOADS => 1);
eval {my $upload = $req->upload('HTTPUPLOAD')};
- if (ref $@ eq "Apache::Request::Error") {
+ if (ref $@ eq "Apache2::Request::Error") {
my $args = $@->{_r}->args('test'); # checks _r is an object ref
my $upload = $@->upload('HTTPUPLOAD'); # no exception this time!
die "args test failed" unless $args eq $test;
Modified: httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestApReq/upload.pm
URL: http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestApReq/upload.pm?view=diff&r1=157310&r2=157311
==============================================================================
--- httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestApReq/upload.pm (original)
+++ httpd/apreq/branches/multi-env-unstable/glue/perl/t/response/TestApReq/upload.pm Sat Mar 12 20:33:36 2005
@@ -3,16 +3,16 @@
use strict;
use warnings FATAL => 'all';
-use Apache::RequestRec;
-use Apache::RequestIO;
-use Apache::Request ();
-use Apache::Upload;
+use Apache2::RequestRec;
+use Apache2::RequestIO;
+use Apache2::Request ();
+use Apache2::Upload;
use File::Spec;
require File::Basename;
sub handler {
my $r = shift;
- my $req = Apache::Request->new($r);
+ my $req = Apache2::Request->new($r);
my $temp_dir = File::Spec->tmpdir;
my $method = $req->args('method');
Modified: httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Apache2/APR__Request__Apache2.h
URL: http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Apache2/APR__Request__Apache2.h?view=diff&r1=157310&r2=157311
==============================================================================
--- httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Apache2/APR__Request__Apache2.h (original)
+++ httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Apache2/APR__Request__Apache2.h Sat Mar 12 20:33:36 2005
@@ -137,7 +137,7 @@
request_rec *r;
const apr_table_t *t;
- r = modperl_xs_sv2request_rec(aTHX_ sv, "Apache::RequestRec", cv);
+ r = modperl_xs_sv2request_rec(aTHX_ sv, "Apache2::RequestRec", cv);
d.pkg = NULL;
d.parent = obj;
Modified: httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Cookie/APR__Request__Cookie.h
URL: http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Cookie/APR__Request__Cookie.h?view=diff&r1=157310&r2=157311
==============================================================================
--- httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Cookie/APR__Request__Cookie.h (original)
+++ httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Cookie/APR__Request__Cookie.h Sat Mar 12 20:33:36 2005
@@ -29,12 +29,12 @@
if (idx > 0 && idx <= arr->nelts) {
const apr_table_entry_t *te = (const apr_table_entry_t *)arr->elts;
- const char *cookie_class = mg_find(obj, PERL_MAGIC_ext)->mg_ptr;
apreq_cookie_t *c = apreq_value_to_cookie(te[idx-1].val);
- SV *parent = mg_find(obj, PERL_MAGIC_ext)->mg_obj;
+ MAGIC *my_magic = mg_find(obj, PERL_MAGIC_ext);
SvMAGICAL_off(nsv);
- sv_setsv(nsv, sv_2mortal(apreq_xs_cookie2sv(aTHX_ c, cookie_class, parent)));
+ sv_setsv(nsv, sv_2mortal(apreq_xs_cookie2sv(aTHX_ c, my_magic->mg_ptr,
+ my_magic->mg_obj)));
}
return 0;
Modified: httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Error/Error.xs
URL: http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Error/Error.xs?view=diff&r1=157310&r2=157311
==============================================================================
--- httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Error/Error.xs (original)
+++ httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Error/Error.xs Sat Mar 12 20:33:36 2005
@@ -7,6 +7,13 @@
MODULE = APR::Request::Error PACKAGE = APR::Request::Error
+SV *strerror(s)
+ apr_status_t s
+ CODE:
+ RETVAL = apreq_xs_error2sv(aTHX_ s);
+ OUTPUT:
+ RETVAL
+
SV *as_string(hv, p1=NULL, p2=NULL)
APR::Request::Error hv
SV *p1
Modified: httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Param/APR__Request__Param.h
URL: http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Param/APR__Request__Param.h?view=diff&r1=157310&r2=157311
==============================================================================
--- httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Param/APR__Request__Param.h (original)
+++ httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Param/APR__Request__Param.h Sat Mar 12 20:33:36 2005
@@ -29,11 +29,12 @@
if (idx > 0 && idx <= arr->nelts) {
const apr_table_entry_t *te = (const apr_table_entry_t *)arr->elts;
- const char *param_class = mg_find(obj, PERL_MAGIC_ext)->mg_ptr;
apreq_param_t *p = apreq_value_to_param(te[idx-1].val);
+ MAGIC *my_magic = mg_find(obj, PERL_MAGIC_ext);
SvMAGICAL_off(nsv);
- sv_setsv(nsv, sv_2mortal(apreq_xs_param2sv(aTHX_ p, param_class, obj)));
+ sv_setsv(nsv, sv_2mortal(apreq_xs_param2sv(aTHX_ p, my_magic->mg_ptr,
+ my_magic->mg_obj)));
}
return 0;
@@ -64,4 +65,217 @@
SvREFCNT_dec(rv); /* corrects SvREFCNT_inc(rv) implicit in sv_magic */
return sv_bless(newRV_noinc(sv), SvSTASH(SvRV(rv)));
+}
+
+
+
+APR_INLINE
+static SV *apreq_xs_find_bb_obj(pTHX_ SV *in)
+{
+ while (in && SvROK(in)) {
+ SV *sv = SvRV(in);
+ switch (SvTYPE(sv)) {
+ MAGIC *mg;
+ case SVt_PVIO:
+ if (SvMAGICAL(sv) && (mg = mg_find(sv, PERL_MAGIC_tiedscalar))) {
+ in = mg->mg_obj;
+ break;
+ }
+ Perl_croak(aTHX_ "panic: cannot find tied scalar in pvio magic");
+ case SVt_PVMG:
+ if (SvOBJECT(sv) && SvIOKp(sv))
+ return sv;
+ default:
+ Perl_croak(aTHX_ "panic: unsupported SV type: %d", SvTYPE(sv));
+ }
+ }
+ return in;
+}
+
+/* XXX these Apache::Upload::Brigade funcs need a makeover as vanilla XS. */
+
+static XS(apreq_xs_brigade_copy)
+{
+ dXSARGS;
+ apr_bucket_brigade *bb, *bb_copy;
+ char *class;
+ SV *sv, *obj;
+
+ if (items != 2 || !SvPOK(ST(0)) || !SvROK(ST(1)))
+ Perl_croak(aTHX_ "Usage: APR::Request::Brigade->new($bb)");
+
+ class = SvPV_nolen(ST(0));
+ obj = apreq_xs_find_bb_obj(aTHX_ ST(1));
+ bb = (apr_bucket_brigade *)SvIVX(obj);
+ bb_copy = apr_brigade_create(bb->p, bb->bucket_alloc);
+ apreq_brigade_copy(bb_copy, bb);
+
+ sv = sv_setref_pv(newSV(0), class, bb_copy);
+ if (SvTAINTED(obj))
+ SvTAINTED_on(SvRV(sv));
+ ST(0) = sv_2mortal(sv);
+ XSRETURN(1);
+}
+
+static XS(apreq_xs_brigade_read)
+{
+ dXSARGS;
+ apr_bucket_brigade *bb;
+ apr_bucket *e, *end;
+ IV want = -1, offset = 0;
+ SV *sv, *obj;
+ apr_status_t s;
+ char *buf;
+
+ switch (items) {
+ case 4:
+ offset = SvIV(ST(3));
+ case 3:
+ want = SvIV(ST(2));
+ case 2:
+ sv = ST(1);
+ SvUPGRADE(sv, SVt_PV);
+ if (SvROK(ST(0))) {
+ obj = apreq_xs_find_bb_obj(aTHX_ ST(0));
+ bb = (apr_bucket_brigade *)SvIVX(obj);
+ break;
+ }
+ default:
+ Perl_croak(aTHX_ "Usage: $bb->READ($buf,$len,$off)");
+ }
+
+ if (want == 0) {
+ SvCUR_set(sv, offset);
+ XSRETURN_IV(0);
+ }
+
+ if (APR_BRIGADE_EMPTY(bb)) {
+ SvCUR_set(sv, offset);
+ XSRETURN_UNDEF;
+ }
+
+ if (want == -1) {
+ const char *data;
+ apr_size_t dlen;
+ e = APR_BRIGADE_FIRST(bb);
+ s = apr_bucket_read(e, &data, &dlen, APR_BLOCK_READ);
+ if (s != APR_SUCCESS)
+ apreq_xs_croak(aTHX_ newHV(), s,
+ "APR::Request::Brigade::READ",
+ "APR::Error");
+ want = dlen;
+ end = APR_BUCKET_NEXT(e);
+ }
+ else {
+ switch (s = apr_brigade_partition(bb, (apr_off_t)want, &end)) {
+ apr_off_t len;
+
+ case APR_INCOMPLETE:
+ s = apr_brigade_length(bb, 1, &len);
+ if (s != APR_SUCCESS)
+ apreq_xs_croak(aTHX_ newHV(), s,
+ "APR::Request::Brigade::READ",
+ "APR::Error");
+ want = len;
+
+ case APR_SUCCESS:
+ break;
+
+ default:
+ apreq_xs_croak(aTHX_ newHV(), s,
+ "APR::Request::Brigade::READ",
+ "APR::Error");
+ }
+ }
+
+ SvGROW(sv, want + offset + 1);
+ buf = SvPVX(sv) + offset;
+ SvCUR_set(sv, want + offset);
+ if (SvTAINTED(obj))
+ SvTAINTED_on(sv);
+
+ while ((e = APR_BRIGADE_FIRST(bb)) != end) {
+ const char *data;
+ apr_size_t dlen;
+ s = apr_bucket_read(e, &data, &dlen, APR_BLOCK_READ);
+ if (s != APR_SUCCESS)
+ apreq_xs_croak(aTHX_ newHV(), s,
+ "APR::Request::Brigade::READ", "APR::Error");
+ memcpy(buf, data, dlen);
+ buf += dlen;
+ apr_bucket_delete(e);
+ }
+
+ *buf = 0;
+ SvPOK_only(sv);
+ SvSETMAGIC(sv);
+ XSRETURN_IV(want);
+}
+
+static XS(apreq_xs_brigade_readline)
+{
+ dXSARGS;
+ apr_bucket_brigade *bb;
+ apr_bucket *e;
+ SV *sv, *obj;
+ apr_status_t s;
+ unsigned tainted;
+
+ if (items != 1 || !SvROK(ST(0)))
+ Perl_croak(aTHX_ "Usage: $bb->READLINE");
+
+ obj = apreq_xs_find_bb_obj(aTHX_ ST(0));
+ bb = (apr_bucket_brigade *)SvIVX(obj);
+
+ if (APR_BRIGADE_EMPTY(bb))
+ XSRETURN(0);
+
+ tainted = SvTAINTED(obj);
+
+ XSprePUSH;
+
+ sv = sv_2mortal(newSVpvn("",0));
+ if (tainted)
+ SvTAINTED_on(sv);
+
+ XPUSHs(sv);
+
+ while (!APR_BRIGADE_EMPTY(bb)) {
+ const char *data;
+ apr_size_t dlen;
+ const char *eol;
+
+ e = APR_BRIGADE_FIRST(bb);
+ s = apr_bucket_read(e, &data, &dlen, APR_BLOCK_READ);
+ if (s != APR_SUCCESS)
+ apreq_xs_croak(aTHX_ newHV(), s,
+ "APR::Request::Brigade::READLINE",
+ "APR::Error");
+
+ eol = memchr(data, '\012', dlen); /* look for LF (linefeed) */
+
+ if (eol != NULL) {
+ if (eol < data + dlen - 1) {
+ dlen = eol - data + 1;
+ apr_bucket_split(e, dlen);
+ }
+
+ sv_catpvn(sv, data, dlen);
+ apr_bucket_delete(e);
+
+ if (GIMME_V != G_ARRAY || APR_BRIGADE_EMPTY(bb))
+ break;
+
+ sv = sv_2mortal(newSVpvn("",0));
+ if (tainted)
+ SvTAINTED_on(sv);
+ XPUSHs(sv);
+ }
+ else {
+ sv_catpvn(sv, data, dlen);
+ apr_bucket_delete(e);
+ }
+ }
+
+ PUTBACK;
}
Modified: httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Param/Param.pm
URL: http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Param/Param.pm?view=diff&r1=157310&r2=157311
==============================================================================
--- httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Param/Param.pm (original)
+++ httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Param/Param.pm Sat Mar 12 20:33:36 2005
@@ -1,2 +1,22 @@
use APR::Request;
use APR::Table;
+use APR::Brigade;
+
+sub upload_io {
+ tie local (*FH), "APR::Request::Brigade", shift->upload;
+ return bless *FH{IO}, "APR::Request::Brigade::IO";
+}
+
+sub upload_fh {
+ my $fname = shift->upload_tempname(@_);
+ open my $fh, "<", $fname
+ or die "Can't open ", $fname, ": ", $!;
+ binmode $fh;
+ return $fh;
+}
+
+package APR::Request::Brigade;
+push our(@ISA), "APR::Brigade";
+
+package APR::Request::Brigade::IO;
+push our(@ISA), ();
Modified: httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Param/Param.xs
URL: http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Param/Param.xs?view=diff&r1=157310&r2=157311
==============================================================================
--- httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Param/Param.xs (original)
+++ httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Param/Param.xs Sat Mar 12 20:33:36 2005
@@ -301,6 +301,20 @@
OUTPUT:
RETVAL
+SV *
+upload_filename(obj)
+ APR::Request::Param obj
+ PREINIT:
+
+ CODE:
+ if (obj->upload != NULL)
+ RETVAL = apreq_xs_param2sv(aTHX_ obj, NULL, NULL);
+ else
+ RETVAL = &PL_sv_undef;
+
+ OUTPUT:
+ RETVAL
+
BOOT:
@@ -626,5 +640,22 @@
if (s != APR_SUCCESS)
Perl_croak(aTHX_ "$param->upload_link($file): can't get spool file name");
+ OUTPUT:
+ RETVAL
+
+
+MODULE = APR::Request::Param PACKAGE = APR::Request::Param::Table
+
+SV *
+uploads(t, pool)
+ APR::Request::Param::Table t
+ APR::Pool pool
+ PREINIT:
+ SV *obj = apreq_xs_sv2object(aTHX_ ST(0), TABLE_CLASS, 't');
+ SV *parent = apreq_xs_sv2object(aTHX_ ST(0), HANDLE_CLASS, 'r');
+ MAGIC *mg = mg_find(obj, PERL_MAGIC_ext);
+ CODE:
+ RETVAL = apreq_xs_table2sv(aTHX_ apreq_uploads(t, pool), HvNAME(SvSTASH(obj)),
+ parent, mg->mg_ptr, mg->mg_len);
OUTPUT:
RETVAL
Modified: httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Request.xs
URL: http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Request.xs?view=diff&r1=157310&r2=157311
==============================================================================
--- httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Request.xs (original)
+++ httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/APR/Request/Request.xs Sat Mar 12 20:33:36 2005
@@ -13,11 +13,11 @@
XSprePUSH;
EXTEND(SP, 3);
s = apreq_jar(req, &t);
- PUSHs(sv_2mortal(newSViv(s)));
+ PUSHs(sv_2mortal(apreq_xs_error2sv(aTHX_ s)));
s = apreq_args(req, &t);
- PUSHs(sv_2mortal(newSViv(s)));
+ PUSHs(sv_2mortal(apreq_xs_error2sv(aTHX_ s)));
s = apreq_body(req, &t);
- PUSHs(sv_2mortal(newSViv(s)));
+ PUSHs(sv_2mortal(apreq_xs_error2sv(aTHX_ s)));
PUTBACK;
}
@@ -173,5 +173,3 @@
OUTPUT:
RETVAL
-
-
Modified: httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/apreq_xs_postperl.h
URL: http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/apreq_xs_postperl.h?view=diff&r1=157310&r2=157311
==============================================================================
--- httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/apreq_xs_postperl.h (original)
+++ httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/apreq_xs_postperl.h Sat Mar 12 20:33:36 2005
@@ -33,6 +33,7 @@
typedef apr_table_t apreq_xs_cookie_table_t;
typedef HV apreq_xs_error_t;
typedef char* apreq_xs_subclass_t;
+#define APR__Request__Param__Table const apr_table_t *
#define HANDLE_CLASS "APR::Request"
#define COOKIE_CLASS "APR::Request::Cookie"
Modified: httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/maps/apreq_functions.map
URL: http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/maps/apreq_functions.map?view=diff&r1=157310&r2=157311
==============================================================================
--- httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/maps/apreq_functions.map (original)
+++ httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/maps/apreq_functions.map Sat Mar 12 20:33:36 2005
@@ -110,11 +110,6 @@
apreq_header_in
apreq_header_out
-
-MODULE=APR::Request PACKAGE=APR::Request PREFIX=APR__Request_
-DEFINE_parse | apreq_xs_parse |
-
-
MODULE=APR::Request PACKAGE=APR::Request PREFIX=APR__Request_
DEFINE_parse | apreq_xs_parse |
@@ -158,3 +153,13 @@
DEFINE_NEXTKEY | apreq_xs_table_NEXTKEY |
DEFINE_FIRSTKEY | apreq_xs_table_NEXTKEY |
#DEFINE_do | apreq_xs_table_do |
+
+MODULE=APR::Request::Param PACKAGE=APR::Request::Brigade PREFIX=APR__Request__Brigade_
+DEFINE_new | apreq_xs_brigade_copy |
+DEFINE_TIEHANDLE | apreq_xs_brigade_copy |
+DEFINE_READ | apreq_xs_brigade_read |
+DEFINE_READLINE | apreq_xs_brigade_readline |
+
+MODULE=APR::Request::Param PACKAGE=APR::Request::Brigade::IO PREFIX=APR__Request__Brigade__IO_
+DEFINE_read | apreq_xs_brigade_read |
+DEFINE_readline | apreq_xs_brigade_readline |
Modified: httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/maps/apreq_types.map
URL: http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/maps/apreq_types.map?view=diff&r1=157310&r2=157311
==============================================================================
--- httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/maps/apreq_types.map (original)
+++ httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/maps/apreq_types.map Sat Mar 12 20:33:36 2005
@@ -10,10 +10,9 @@
const void * | PTR
unsigned | UV
unsigned char | UV
-#apreq_cookie_version_t | APREQ_COOKIE_VERSION
#data structure stuff
-struct request_rec | Apache::RequestRec | T_APACHEOBJ | r
+struct request_rec | Apache2::RequestRec | T_APACHEOBJ | r
struct apr_pool_t | APR::Pool | T_POOLOBJ
struct apr_array_header_t | APR::ArrayHeader
struct apr_table_t | APR::Table | T_HASHOBJ
@@ -27,7 +26,6 @@
struct apreq_xs_handle_cgi_t | APR::Request::CGI | T_APREQ_HANDLE_CGI
struct apreq_xs_error_t | APR::Request::Error | T_APREQ_ERROR
struct apreq_xs_cookie_table_t | APR::Request::Cookie::Table | T_HASHOBJ
-struct apreq_xs_param_table_t | APR::Request::Param::Table | T_HASHOBJ
+const apreq_xs_param_table_t * | APR::Request::Param::Table | T_HASHOBJ
apreq_xs_subclass_t | SUBCLASS
-
Added: httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/typemap
URL: http://svn.apache.org/viewcvs/httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/typemap?view=auto&rev=157311
==============================================================================
--- httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/typemap (added)
+++ httpd/apreq/branches/multi-env-unstable/glue/perl/xsbuilder/typemap Sat Mar 12 20:33:36 2005
@@ -0,0 +1,142 @@
+APR::Pool T_POOLOBJ
+APR::Request::Apache2 T_APREQ_HANDLE_APACHE2
+APR::Request::Cookie T_APREQ_COOKIE
+APR::Request::Param::Table T_APREQ_TABLE
+APR::Brigade T_PTROBJ
+APR::Table T_HASHOBJ
+APR::Request::CGI T_APREQ_HANDLE_CGI
+APR::Request::Param T_APREQ_PARAM
+APR::Request::Error T_APREQ_ERROR
+Apache2::RequestRec T_APACHEOBJ
+APR::Request::Cookie::Table T_HASHOBJ
+APR::Request T_APREQ_HANDLE
+apr_status_t T_IV
+const void * T_PTR
+const char * T_PV
+apreq_xs_subclass_t T_SUBCLASS
+const apreq_xs_subclass_t * T_SUBCLASS
+const apr_size_t T_UV
+apreq_xs_subclass_t * T_SUBCLASS
+apr_size_t T_UV
+unsigned char T_UV
+
+INPUT
+T_APREQ_HANDLE
+ $var = apreq_xs_sv2handle(aTHX_ $arg)
+
+T_HASHOBJ
+ if (sv_derived_from($arg, \"${ntype}\")) {
+ if (SVt_PVHV == SvTYPE(SvRV($arg))) {
+ SV *hv = SvRV($arg);
+ MAGIC *mg;
+ if (SvMAGICAL(hv)) {
+ if ((mg = mg_find(hv, PERL_MAGIC_tied))) {
+ $var = (void *)MgObjIV(mg);
+ }
+ else {
+ Perl_warn(aTHX_ \"Not a tied hash: (magic=%c)\", mg);
+ $var = NULL;
+ }
+ }
+ else {
+ Perl_warn(aTHX_ \"SV is not tied\");
+ $var = NULL;
+ }
+ }
+ else {
+ $var = (void *)SvObjIV($arg);
+ }
+ }
+ else {
+ Perl_croak(aTHX_
+ \"argument is not a blessed reference \"
+ \"(expecting an %s derived object)\", \"${ntype}\");
+ }
+
+
+T_APREQ_ERROR
+ $var = (HV *)SvRV($arg)
+
+T_APREQ_HANDLE_APACHE2
+ $var = apreq_xs_sv2handle(aTHX_ $arg)
+
+T_APREQ_COOKIE
+ $var = apreq_xs_sv2cookie(aTHX_ $arg)
+
+T_SUBCLASS
+ if (SvROK($arg) || !sv_derived_from($arg, \"$Package\"))
+ Perl_croak(aTHX_ \"Usage: argument is not a subclass of $Package\");
+ $var = SvPV_nolen($arg)
+
+
+T_APREQ_HANDLE_CGI
+ $var = apreq_xs_sv2handle(aTHX_ $arg)
+
+T_APREQ_PARAM
+ $var = apreq_xs_sv2param(aTHX_ $arg)
+
+T_APREQ_TABLE
+ if (sv_derived_from($arg, \"${ntype}\")) {
+ if (SVt_PVHV == SvTYPE(SvRV($arg))) {
+ SV *hv = SvRV($arg);
+ MAGIC *mg;
+ if (SvMAGICAL(hv)) {
+ if ((mg = mg_find(hv, PERL_MAGIC_tied))) {
+ $var = (void *)MgObjIV(mg);
+ }
+ else {
+ Perl_warn(aTHX_ \"Not a tied hash: (magic=%c)\", mg);
+ $var = NULL;
+ }
+ }
+ else {
+ Perl_warn(aTHX_ \"SV is not tied\");
+ $var = NULL;
+ }
+ }
+ else {
+ $var = (void *)SvObjIV($arg);
+ }
+ }
+ else {
+ Perl_croak(aTHX_
+ \"argument is not a blessed reference \"
+ \"(expecting an %s derived object)\", \"${ntype}\");
+ }
+
+
+OUTPUT
+T_APREQ_HANDLE
+ $arg = apreq_xs_handle2sv(aTHX_ $var, class, parent);
+
+T_APREQ_TABLE
+ $arg = apreq_xs_table2sv(aTHX_ $var, \"${ntype}\", parent, PARAM_CLASS, sizeof(PARAM_CLASS)-1);
+
+T_HASHOBJ
+ {
+ SV *hv = (SV*)newHV();
+ SV *rsv = $arg;
+ sv_setref_pv(rsv, \"${ntype}\", $var);
+ sv_magic(hv, rsv, PERL_MAGIC_tied, Nullch, 0);
+ $arg = SvREFCNT_inc(sv_bless(sv_2mortal(newRV_noinc(hv)),
+ gv_stashpv(\"${ntype}\", TRUE)));
+ }
+
+
+T_APREQ_ERROR
+ $arg = sv_bless(newRV_noinc((SV*)$var), gv_stashpvn(\"${ntype}\", sizeof(\"${ntype}\") - 1, FALSE);
+
+T_APREQ_HANDLE_APACHE2
+ $arg = apreq_xs_handle2sv(aTHX_ $var, class, SvRV(ST(1)));
+ SvMAGIC(SvRV($arg))->mg_ptr = (void *)r;
+
+
+T_APREQ_COOKIE
+ $arg = apreq_xs_cookie2sv(aTHX_ $var, class, parent);
+
+T_APREQ_HANDLE_CGI
+ $arg = apreq_xs_handle2sv(aTHX_ $var, class, SvRV(ST(1)));
+
+T_APREQ_PARAM
+ $arg = apreq_xs_param2sv(aTHX_ $var, class, parent);
+