+sub read_application_x_www_form_urlencoded($)
+{
+my($class)=@_;
+
+ my $body="";
+ for (;;) {
+ my $got=$W->{"r"}->read(my($buf),0x1000);
+ # Do not: cluck "Error reading POST data: $!" if !defined $got;
+ # as it should be done using: APR::Error exceptions
+ last if !$got;
+ $body.=$buf;
+ }
+ return URI->new("?".$body)->query_form();
+}
+
+sub read_multipart_form_data($)
+{
+my($class)=@_;
+
+ my $parser=MIME::Parser->new();
+ # FIXME: No unlink()s done!
+ $parser->output_under("/tmp");
+
+ local *R_FH;
+ tie *R_FH,$W->{"r"};
+ local *FH;
+ tie *FH,"My::Web::ReadMerged",
+ join("",map(($_.": ".$W->{"headers_in"}{$_}."\n"),qw(
+ Content-type
+ )))."\n",
+ \*R_FH;
+ my $body=$parser->parse(\*FH);
+ cluck "No multipart POST request body?" if !$body->is_multipart();
+
+ return map((
+ $_->head()->mime_attr("content-disposition.name")
+ =>
+ join("",@{$_->body()})
+ ),$body->parts());
+
+ # TODO: Globalize, make it IO::* compatible, split to the merging part + IO::Scalar.
+ package My::Web::ReadMerged;
+
+ require Tie::Handle;
+ require Exporter;
+ our @ISA=qw(Tie::Handle Exporter);
+ use Carp qw(cluck confess);
+
+ sub READLINE($)
+ {
+ my($self)=@_;
+
+ confess "Slurp not yet implemented" if !defined $/;
+ # Apache2::RequestIO does not support 'READLINE'!
+ for (;;) {
+ if (defined $self->{"data"} && $self->{"data"}=~s{^.*\Q$/\E}{}) {
+ $self->{"offset"}+=length $&;
+ return $&;
+ }
+ my $fh_orig=$self->{"fh_orig"};
+ if (!$fh_orig) {
+ my $r=$self->{"data"};
+ delete $self->{"data"};
+ $self->{"offset"}+=length $r if defined $r;
+ return $r;
+ }
+ my $got=read $fh_orig,my($buf),0x1000;
+ cluck "Error reading POST data: $!" if !defined $got;
+ delete $self->{"fh_orig"} if !$got;
+ cluck "INTERNAL: fh_orig should not exist here" if !defined $self->{"data"};
+ $self->{"data"}.=$buf;
+ }
+ }
+
+ sub TELL($)
+ {
+ my($self)=@_;
+
+ return $self->{"offset"};
+ }
+
+ sub TIEHANDLE($$$)
+ {
+ my($class,$data,$fh_orig)=@_;
+
+ my $self=bless {},$class;
+ $self->{"data"}=$data;
+ $self->{"offset"}=0;
+ $self->{"fh_orig"}=$fh_orig;
+ return $self;
+ }
+}
+
+sub cleanup($)
+{
+my($apache_request)=@_;
+
+ cluck "CORE::GLOBAL::exit hook not ran" if !$W->{"_exit_done"};
+ cluck "packages not finalized" if !$packages_used_hash{$W->{"__PACKAGE__"}}{"_done"};
+ cache_finish();
+ # Sanity protection.
+ $W=undef();
+ exit_hook_stop();
+ return OK;
+}
+
+# PerlResponseHandler is RUN_FIRST and &ModPerl::Util::exit returns OK, so no (sane) go.
+# PerlLogHandler is already too late to be able to produce any output.
+my $exit_orig;
+sub exit_hook
+{
+ cluck "Missing ->init while in exit_hook()" if !$W->{"_init_done"};
+ # &footer will call us recursively!
+ footer() if !$W->{"_exit_done"}++;
+ return &{$exit_orig}(@_);
+}
+sub exit_hook_start
+{
+ do { cluck "exit_hook_start() twice?"; return; } if defined $exit_orig;
+ $exit_orig=\&CORE::GLOBAL::exit;
+ # Prevent: Subroutine CORE::GLOBAL::exit redefined
+ no warnings 'redefine';
+ *CORE::GLOBAL::exit=\&exit_hook;
+}
+sub exit_hook_stop
+{
+ do { cluck "exit_hook_stop() without exit_hook_start()?"; return; }
+ if \&exit_hook ne \&CORE::GLOBAL::exit;
+ do { cluck "INTERNAL: exit_orig uninitialized"; return; }
+ if !$exit_orig;
+ # Prevent: Subroutine CORE::GLOBAL::exit redefined
+ no warnings 'redefine';
+ *CORE::GLOBAL::exit=$exit_orig;
+ $exit_orig=undef();
+}
+
+# Be aware other parts of code (non-My::Web) will NOT use this function!