joes 2004/06/26 13:30:40
Modified: glue/perl/t/apreq request.t
glue/perl/t/response/TestApReq request.pm
glue/perl/xsbuilder/Apache/Request Request_pm Request_pod
glue/perl/xsbuilder/Apache/Upload Apache__Upload.h
glue/perl/xsbuilder/maps apreq_functions.map
Log:
Add $upload->size and $upload->fh. Need to temporarily include copy of
apr_perlio.h into Apache__Upload.h for implementing $upload->fh as an
APR::PerlIO object. More tests and docfixes also.
Revision Changes Path
1.8 +3 -3 httpd-apreq-2/glue/perl/t/apreq/request.t
Index: request.t
===================================================================
RCS file: /home/cvs/httpd-apreq-2/glue/perl/t/apreq/request.t,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- request.t 11 Jun 2004 17:43:07 -0000 1.7
+++ request.t 26 Jun 2004 20:30:40 -0000 1.8
@@ -6,7 +6,7 @@
use Apache::TestUtil;
use Apache::TestRequest qw(GET_BODY UPLOAD_BODY);
-plan tests => 3, have_lwp;
+plan tests => 7, have_lwp;
my $location = "/TestApReq__request";
#print GET_BODY $location;
@@ -19,9 +19,9 @@
GET_BODY("$location?test=$test&value=$value"),
"basic param");
}
-{
+
+for my $test (qw/slurp bb_read fh_read/) {
# upload a string as a file
- my $test = 'upload';
my $value = 'DataUpload' x 100_000;
my $result = UPLOAD_BODY("$location?test=$test", content => $value);
ok t_cmp($value, $result, "basic upload");
1.10 +17 -2 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.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- request.pm 14 Jun 2004 02:02:23 -0000 1.9
+++ request.pm 26 Jun 2004 20:30:40 -0000 1.10
@@ -22,10 +22,25 @@
my $value = $req->param('value');
$req->print($value);
}
- elsif ($test eq 'upload') {
+ elsif ($test eq 'slurp') {
my ($upload) = values %{$req->upload};
$upload->slurp(my $data);
- $r->print($data);
+ $req->print($data);
+ }
+ elsif ($test eq 'bb_read') {
+ my ($upload) = $req->upload("HTTPUPLOAD");
+ my $bb = $upload->bb;
+ my $e;
+ while ($e = $bb->first) {
+ $e->read(my $buf);
+ $req->print($buf);
+ $e->remove;
+ }
+ }
+ elsif ($test eq 'fh_read') {
+ my (undef, $upload) = each %{$req->upload};
+ my $fh = $upload->fh;
+ $r->print(<$fh>);
}
return 0;
1.12 +7 -0
httpd-apreq-2/glue/perl/xsbuilder/Apache/Request/Request_pm
Index: Request_pm
===================================================================
RCS file:
/home/cvs/httpd-apreq-2/glue/perl/xsbuilder/Apache/Request/Request_pm,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- Request_pm 26 Jun 2004 03:25:10 -0000 1.11
+++ Request_pm 26 Jun 2004 20:30:40 -0000 1.12
@@ -23,3 +23,10 @@
$req->config(@_);
return $req;
}
+
+*instance = *new;
+
+sub param;
+
+*parms = *param;
+*params = *param;
\ No newline at end of file
1.13 +31 -33
httpd-apreq-2/glue/perl/xsbuilder/Apache/Request/Request_pod
Index: Request_pod
===================================================================
RCS file:
/home/cvs/httpd-apreq-2/glue/perl/xsbuilder/Apache/Request/Request_pod,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- Request_pod 26 Jun 2004 01:49:19 -0000 1.12
+++ Request_pod 26 Jun 2004 20:30:40 -0000 1.13
@@ -13,11 +13,6 @@
requests where I<Content-type> is one of I<application/x-www-form-urlencoded>
or I<multipart/form-data>.
-=head1 VERSION
-
-This is Version @PACKAGE_VERSION@ of C<Apache::Request>, based on
[EMAIL PROTECTED]@ Version @[EMAIL PROTECTED]
-
=head1 Apache::Request METHODS
The interface is designed to mimic CGI.pm 's routines for parsing
@@ -72,7 +67,7 @@
Extra configuration info passed to an upload hook.
See the description for the next item, I<UPLOAD_HOOK>.
-=item UPLOAD_HOOK [TODO]
+=item UPLOAD_HOOK (requires Apache::Upload) [TODO]
Sets up a callback to run whenever file upload data is read. This
can be used to provide an upload progress meter during file uploads.
@@ -80,7 +75,7 @@
$upload->fh after the hook exits.
my $transparent_hook = sub {
- my ($upload, $buf, $len, $hook_data) = @_;
+ my ($upload, $bb, $hook_data, $next_hook) = @_;
warn "$hook_data: got $len bytes for " . $upload->name;
};
@@ -91,7 +86,7 @@
=back
-=head2 instance
+=head2 instance [DEPRECATED]
The default (and only) behavior of I<Apache::Request> is to intelligently
cache B<POST> data for the duration of the request. Thus there is no longer
@@ -99,16 +94,13 @@
for Apache 1.3 - all B<POST> data is always available from each and every
I<Apache::Request> object created during the request's lifetime.
-If you need an C<instance()> method to make ease the pains of porting to
-Apache 2.0, you can add this shortcut to your C<startup.pl>:
-
- use Apache::Request;
- *Apache::Request::instance = \&Apache::Request::new;
+However an C<instance()> method is aliased to C<new()> in this release
+to ease the pain of porting from 1.X to 2.X.
=head2 param
Get or set (TODO) the request parameters (using case-insensitive keys) by
-mimicing the OO interface of C<CGI::param>.
+mimicing the OO interface of C<CGI::param>. WIth a single
# similar to CGI.pm
@@ -118,23 +110,15 @@
# the following differ slightly from CGI.pm
- # assigns multiple values to 'foo'
- $req->param('foo' => [qw(one two three)]); # TODO
-
- # returns ref to underlying apache table object
- my $table = $req->param; # identical to $apr->parms - see below
-
-=head2 parms, params
+ # returns ref to APR::Table object representing all (args + body) params
+ my $table = $req->param;
-Get the full parameter table of the I<Apache::Request> object.
+=head2 parms, params [DEPRECATED]
- # returns ref to Apache::Request::Table object provided by $apache_table
- my $table = $req->parms;
-
-An optional name parameter can be passed to return the parameter
-associated with the given name:
-
- my $param = $req->parms($name);
+The functionality of these functions is assumed by C<param>,
+so they are no longer necessary. Aliases to C<param> are
+provided in this release for backwards compatibility,
+however they may be removed from a future release.
=head2 args
@@ -189,6 +173,24 @@
}
+=head1 CHANGES in Apache::Request API from 1.X to 2.X
+
+=over 4
+
+=item You must use the two-argument form of $req->args or $req->body to
assign
+ parameters to the request. You may no longer use
+
+ $req->param("foo" => "bar"); # invalid in 2.X
+
+=item C<instance> is now identical to C<new>.
+
+=item C<param> includes the functionality of C<parms> and C<params>.
+
+=item The argument list for the upload hook has changed
+
+=back
+
+
=head1 SEE ALSO
Apache::Cookie(3), Apache::Upload(3), APR::Table(3)
@@ -196,10 +198,6 @@
=head1 CREDITS
This interface is based on the original pure Perl version by Lincoln Stein.
-
-=head1 AUTHORS
-
-Doug MacEachern, Joe Schaefer, Steve Hay.
=head1 MISSING DOCS
1.3 +155 -0
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.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- Apache__Upload.h 19 Jun 2004 15:38:18 -0000 1.2
+++ Apache__Upload.h 26 Jun 2004 20:30:40 -0000 1.3
@@ -13,6 +13,70 @@
** See the License for the specific language governing permissions and
** limitations under the License.
*/
+#include "apr_optional.h"
+
+/* Temporary work-around for missing apr_perlio.h file.
+ * #include "apr_perlio.h"
+ */
+#ifndef APR_PERLIO_H
+
+#ifdef PERLIO_LAYERS
+#include "perliol.h"
+#else
+#include "iperlsys.h"
+#endif
+
+#include "apr_portable.h"
+#include "apr_file_io.h"
+#include "apr_errno.h"
+
+#ifndef MP_SOURCE_SCAN
+#include "apr_optional.h"
+#endif
+
+/* 5.6.0 */
+#ifndef IoTYPE_RDONLY
+#define IoTYPE_RDONLY '<'
+#endif
+#ifndef IoTYPE_WRONLY
+#define IoTYPE_WRONLY '>'
+#endif
+
+typedef enum {
+ APR_PERLIO_HOOK_READ,
+ APR_PERLIO_HOOK_WRITE
+} apr_perlio_hook_e;
+
+void apr_perlio_init(pTHX);
+
+/* The following functions can be used from other .so libs, they just
+ * need to load APR::PerlIO perl module first
+ */
+#ifndef MP_SOURCE_SCAN
+
+#ifdef PERLIO_LAYERS
+PerlIO *apr_perlio_apr_file_to_PerlIO(pTHX_ apr_file_t *file, apr_pool_t
*pool,
+ apr_perlio_hook_e type);
+APR_DECLARE_OPTIONAL_FN(PerlIO *,
+ apr_perlio_apr_file_to_PerlIO,
+ (pTHX_ apr_file_t *file, apr_pool_t *pool,
+ apr_perlio_hook_e type));
+#endif /* PERLIO_LAYERS */
+
+
+SV *apr_perlio_apr_file_to_glob(pTHX_ apr_file_t *file, apr_pool_t *pool,
+ apr_perlio_hook_e type);
+APR_DECLARE_OPTIONAL_FN(SV *,
+ apr_perlio_apr_file_to_glob,
+ (pTHX_ apr_file_t *file, apr_pool_t *pool,
+ apr_perlio_hook_e type));
+#endif /* MP_SOURCE_SCAN */
+
+#endif /*APR_PERLIO_H*/
+
+
+
+
#define READ_BLOCK_SIZE (1024 * 256)
#define S2P(s) (s ? apreq_value_to_param(apreq_strtoval(s)) : NULL)
@@ -162,4 +226,95 @@
SvPOK_only(ST(1));
s = apr_brigade_flatten(bb, data, &len_size);
XSRETURN_IV(s);
+}
+
+static XS(apreq_xs_upload_size)
+{
+ dXSARGS;
+ MAGIC *mg;
+ void *env;
+ apr_bucket_brigade *bb;
+ apr_status_t s;
+ apr_off_t len;
+
+ if (items != 1 || !SvROK(ST(0)))
+ Perl_croak(aTHX_ "Usage: $upload->size()");
+
+ if (!(mg = mg_find(SvRV(ST(0)), PERL_MAGIC_ext)))
+ Perl_croak(aTHX_ "$upload->size(): can't find env");
+
+ env = mg->mg_ptr;
+ bb = apreq_xs_sv2param(ST(0))->bb;
+
+ s = apr_brigade_length(bb, 1, &len);
+
+ if (s != APR_SUCCESS) {
+ apreq_log(APREQ_ERROR s, env, "apreq_xs_upload_size:"
+ "apr_brigade_length failed");
+ Perl_croak(aTHX_ "$upload->size: can't get brigade length");
+ }
+ XSRETURN_IV((IV)len);
+}
+
+static APR_OPTIONAL_FN_TYPE(apr_perlio_apr_file_to_glob) *f2g;
+
+static XS(apreq_xs_upload_fh)
+{
+ dXSARGS;
+ MAGIC *mg;
+ void *env;
+ apr_bucket_brigade *bb;
+ 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()");
+
+ if (!(mg = mg_find(SvRV(ST(0)), PERL_MAGIC_ext)))
+ Perl_croak(aTHX_ "$upload->fh(): can't find env");
+
+ env = mg->mg_ptr;
+ 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);
+
+ s = apreq_file_mktemp(&file, apreq_env_pool(env), tmpdir);
+
+ if (s != APR_SUCCESS) {
+ apreq_log(APREQ_ERROR s, env, "apreq_xs_upload_fh:"
+ "apreq_file_mktemp failed");
+ Perl_croak(aTHX_ "$upload->fh: can't make tempfile");
+ }
+
+ s = apreq_brigade_fwrite(file, &len, bb);
+
+ if (s != APR_SUCCESS) {
+ apreq_log(APREQ_ERROR s, env, "apreq_xs_upload_fh:"
+ "apreq_brigade_fwrite failed");
+ Perl_croak(aTHX_ "$upload->fh: can't write brigade to tempfile");
+ }
+
+ last = apr_bucket_file_create(file, len, 0, bb->p, bb->bucket_alloc);
+ APR_BRIGADE_INSERT_TAIL(bb, last);
+ }
+
+ /* Reset seek pointer before passing apr_file_t to perl. */
+ len = 0;
+ 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;
+ XSRETURN(1);
}
1.19 +4 -3
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.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- apreq_functions.map 14 Jun 2004 02:02:23 -0000 1.18
+++ apreq_functions.map 26 Jun 2004 20:30:40 -0000 1.19
@@ -2,8 +2,8 @@
MODULE=Apache::Request PACKAGE=Apache::Request PREFIX=apreq_
apreq_request | apreq_xs_request | const char *:class, void *:env, const
char *:qs=NULL
- apreq_parse_request
- apreq_params
+! apreq_parse_request
+! apreq_params
apreq_param | apreq_xs_request_get |
MODULE=Apache::Request PACKAGE=Apache::Request
@@ -23,13 +23,14 @@
########## Apache::Upload:: Functions ##########
MODULE=Apache::Upload PACKAGE=Apache::Upload PREFIX=Apache__Upload_
-! apr_table_t *:DEFINE_info | apreq_param_info(apreq_xs_sv2param(sv))
| SV *:sv
const char *:DEFINE_name | apreq_param_name(apreq_xs_sv2param(sv)) |
SV *:sv
char *:DEFINE_filename | apreq_param_value(apreq_xs_sv2param(sv))
| SV *:sv
apr_status_t:DEFINE_status | apreq_param_status(apreq_xs_sv2param(sv))
| SV *:sv
DEFINE_env | apreq_xs_upload_env |
DEFINE_link | apreq_xs_upload_link |
DEFINE_slurp | apreq_xs_upload_slurp |
+ DEFINE_size | apreq_xs_upload_size |
+ DEFINE_fh | apreq_xs_upload_fh |
MODULE=Apache::Upload PACKAGE=Apache::Upload::Table
PREFIX=Apache__Upload__Table_
DEFINE_get | apreq_xs_upload_table_get |
