view release on metacpan or  search on metacpan

PApp.pm  view on Meta::CPAN

   my $ct = $request->header_in("Content-Type");
   $ct =~ m{^multipart/form-data} or return;
   $ct =~ m#boundary=\"?([^\";,]+)\"?#; #FIXME# should use parse_mime_header
   my $boundary = $1;
   my $fh = new PApp::FormBuffer
                fh => $request,
                boundary => $boundary,
                rsize => $request->header_in("Content-Length");

   $request->header_in("Content-Type", "");

   while ($fh->skip_boundary) {
      my ($ct, %ct, %cd);
      my $hdr = "";
      my $line;
      do {
	 $line = $fh->READLINE;
	 if ($line =~ /^\s/) {
	    $hdr .= $line;
	 } else {
	    if ($hdr =~ /^Content-Type:\s+(.*)$/i) {
	       ($ct, %ct) = parse_mime_header $1;
	    } elsif ($hdr =~ /^Content-Disposition:\s+(.*)/i) {
	       (undef, %cd) = parse_mime_header $1;
	       # ^^^ eq "form-data" or die ";-[";
	    }
	    $hdr = $line;
	 }
      } while ($line ne "");

      my $name = delete $cd{name};

      if (defined $name) {
         $ct ||= "text/plain";
         $ct{charset} ||= $state{papp_lcs} || "iso-8859-1";
         $cb->($fh, $name, $ct, \%ct, \%cd);

         # read (& skip) the remaining data, if any
         my $buf; 1 while $fh->read($buf, 16384) > 0;
      }
   }

   $request->header_in("Content-Length", 0);

   1;
}

=item PApp::flush [not exported by default]

Send generated output to the client and flush the output buffer. There is
no need to call this function unless you have a long-running operation
and want to partially output the page. Please note, however, that, as
headers have to be output on the first call, no headers (this includes the
content-type and character set) can be changed after this call. Also, you
must not change any state variables or any related info after this call,
as the result might not get saved in the database, so you better commit
everything before flushing and then just continue output (use GET or POST
to create new links after this).

Flushing does not yet harmonize with output stylesheet processing, for the
semi-obvious reason that PApp::XSLT does not support streaming operation.

BUGS: No links that have been output so far can be followed until the
document is finished, because the neccessary information will not reach
the disk until the document.... is finished ;)

=cut

sub _unicode_to_entity {
   sprintf "&#x%x;", $_[0];
}

sub flush_cvt {
   if (@fixup) {
      my @fixup = map { (ref) ? &$_ : $_ } @fixup;
      $$routput =~ s/\x{fc00}(......)/$fixup[$1]/sg;
   }

   # charset conversion
   if ($output_charset eq "*" or $output_charset eq "utf-8") {
      utf8::encode $$routput;
      $output_charset = "utf-8";
   } elsif ($output_charset) {
      # convert to destination charset
      if ($output_charset ne "iso-8859-1") {
         utf8::encode $$routput;
         my $pconv = PApp::Recode::Pconv::open $output_charset, CHARSET, \&_unicode_to_entity
                        or fancydie "charset conversion to $output_charset not available";
         $$routput = PApp::Recode::Pconv::convert ($pconv, $$routput);
      } # else iso-8859-1 == transparent
   } else {
      utf8::downgrade $$routput;
   }

   $state{papp_lcs} = $output_charset;
   $request->content_type ($output_charset
                           ? "$content_type; charset=$output_charset"
                           : $content_type);
}

sub flush_snd {
   $request->send_http_header unless $output_p++;
   # $routput should suffice in the next line, but it sometimes doesn't,
   # so just COPY THAT DAMNED THING UNTIL MODPERL WORKS. #d##FIXME#TODO#
   $request->print ($$routput) unless $request->header_only;

   $$routput = "";
}

sub flush {
   flush_cvt;
   local $| = 1;
   flush_snd;
}

sub flush_snd_length {
   $request->header_out('Content-Length', length $$routput);
   flush_snd;
}

=item PApp::set_output ($data) [not exported by default]