joes 2004/06/26 14:35:11
Modified: build xsbuilder.pl
glue/perl/t/response/TestApReq request.pm
glue/perl/xsbuilder/Apache/Upload Apache__Upload.h
glue/perl/xsbuilder/maps apreq_functions.map
Log:
Move f2g assignment to BOOT block for efficiency.
Revision Changes Path
1.24 +75 -0 httpd-apreq-2/build/xsbuilder.pl
Index: xsbuilder.pl
===================================================================
RCS file: /home/cvs/httpd-apreq-2/build/xsbuilder.pl,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -r1.23 -r1.24
--- xsbuilder.pl 7 Apr 2004 02:55:42 -0000 1.23
+++ xsbuilder.pl 26 Jun 2004 21:35:10 -0000 1.24
@@ -354,6 +354,81 @@
close $fh;
}
+use constant GvSHARED => 0;
+
+sub write_xs {
+ my($self, $module, $functions) = @_;
+
+ my $fh = $self->open_class_file($module, '.xs');
+ print $fh "$self->{noedit_warning_c}\n";
+
+ my @includes = @{ $self->includes };
+
+ if (my $mod_h = $self->mod_h($module)) {
+ push @includes, $mod_h;
+ }
+
+ for (@includes) {
+ print $fh qq{\#include "$_"\n\n};
+ }
+
+ my $last_prefix = "";
+ my $fmap = $self -> typemap -> {function_map} ;
+ my $myprefix = $self -> my_xs_prefix ;
+
+ for my $func (@$functions) {
+ my $class = $func->{class};
+ if ($class)
+ {
+ my $prefix = $func->{prefix};
+ $last_prefix = $prefix if $prefix;
+
+ if ($func->{name} =~ /^$myprefix/o) {
+ #e.g. mpxs_Apache__RequestRec_
+ my $class_prefix = $fmap -> class_c_prefix($class);
+ if ($func->{name} =~ /$class_prefix/) {
+ $prefix = $fmap -> class_xs_prefix($class);
+ }
+ }
+
+ $prefix = $prefix ? " PREFIX = $prefix" : "";
+ print $fh "MODULE = $module PACKAGE = $class $prefix\n\n";
+ }
+
+ print $fh $func->{code};
+ }
+
+ if (my $destructor = $self->typemap->destructor($last_prefix)) {
+ my $arg = $destructor->{argspec}[0];
+
+ print $fh <<EOF;
+void
+$destructor->{name}($arg)
+ $destructor->{class} $arg
+
+EOF
+ }
+
+ print $fh "PROTOTYPES: disabled\n\n";
+ print $fh "BOOT:\n";
+ print $fh $self->boot($module);
+ print $fh " items = items; /* -Wall */\n";
+ print $fh <<'EOT' if $module eq "Apache::Upload";
+ f2g = APR_RETRIEVE_OPTIONAL_FN(apr_perlio_apr_file_to_glob);
+ if (f2g == NULL)
+ Perl_croak(aTHX_ "Failed to locate apr_perlio_apr_file_to_glob
during BOOT");
+EOT
+ print $fh "\n";
+ if (my $newxs = $self->{newXS}->{$module}) {
+ for my $xs (@$newxs) {
+ print $fh qq{ cv = newXS("$xs->[0]", $xs->[1], __FILE__);\n};
+ print $fh qq{ GvSHARED_on(CvGV(cv));\n} if GvSHARED;
+ }
+ }
+
+ close $fh;
+}
+
package My::TypeMap;
use base 'ExtUtils::XSBuilder::TypeMap';
1.11 +5 -1 httpd-apreq-2/glue/perl/t/response/TestApReq/request.pm
Index: request.pm
===================================================================
RCS file: /home/cvs/httpd-apreq-2/glue/perl/t/response/TestApReq/request.pm,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- request.pm 26 Jun 2004 20:30:40 -0000 1.10
+++ request.pm 26 Jun 2004 21:35:10 -0000 1.11
@@ -25,6 +25,10 @@
elsif ($test eq 'slurp') {
my ($upload) = values %{$req->upload};
$upload->slurp(my $data);
+ if ($upload->size != length $data) {
+ $req->print("Size mismatch: size() reports ", $upload->size,
+ " but slurp() length is ", length $data, "\n");
+ }
$req->print($data);
}
elsif ($test eq 'bb_read') {
@@ -38,7 +42,7 @@
}
}
elsif ($test eq 'fh_read') {
- my (undef, $upload) = each %{$req->upload};
+ my $upload = $req->upload(($req->upload)[0]);
my $fh = $upload->fh;
$r->print(<$fh>);
}
1.4 +1 -9
httpd-apreq-2/glue/perl/xsbuilder/Apache/Upload/Apache__Upload.h
Index: Apache__Upload.h
===================================================================
RCS file:
/home/cvs/httpd-apreq-2/glue/perl/xsbuilder/Apache/Upload/Apache__Upload.h,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- Apache__Upload.h 26 Jun 2004 20:30:40 -0000 1.3
+++ Apache__Upload.h 26 Jun 2004 21:35:11 -0000 1.4
@@ -267,7 +267,6 @@
apr_status_t s;
apr_off_t len;
apr_file_t *file;
- SV *sv;
if (items != 1 || !SvROK(ST(0)))
Perl_croak(aTHX_ "Usage: $upload->fh()");
@@ -279,11 +278,6 @@
bb = apreq_xs_sv2param(ST(0))->bb;
file = apreq_brigade_spoolfile(bb);
- if (f2g == NULL)
- f2g = APR_RETRIEVE_OPTIONAL_FN(apr_perlio_apr_file_to_glob);
- if (f2g == NULL)
- Perl_croak(aTHX_ "can't locate apr_perlio_apr_file_to_glob");
-
if (file == NULL) {
apr_bucket *last;
const char *tmpdir = apreq_env_temp_dir(env, NULL);
@@ -313,8 +307,6 @@
apr_file_seek(file, 0, &len);
/* Should we pass a dup(2) of the file instead? */
- sv = f2g(aTHX_ file, bb->p, APR_PERLIO_HOOK_READ);
-// ST(0) = sv_2mortal(sv);
- ST(0) = sv;
+ ST(0) = f2g(aTHX_ file, bb->p, APR_PERLIO_HOOK_READ);
XSRETURN(1);
}
1.20 +0 -2
httpd-apreq-2/glue/perl/xsbuilder/maps/apreq_functions.map
Index: apreq_functions.map
===================================================================
RCS file:
/home/cvs/httpd-apreq-2/glue/perl/xsbuilder/maps/apreq_functions.map,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -r1.19 -r1.20
--- apreq_functions.map 26 Jun 2004 20:30:40 -0000 1.19
+++ apreq_functions.map 26 Jun 2004 21:35:11 -0000 1.20
@@ -39,8 +39,6 @@
MODULE=Apache::Upload PACKAGE=Apache::Request PREFIX=Apache__Request_
DEFINE_upload | apreq_xs_upload_get |
-
-
########## Apache::Cookie:: Functions ##########
MODULE=Apache::Cookie PACKAGE=Apache::Cookie
