view release on metacpan or  search on metacpan

lib/AnyEvent/HTTPD/HTTPConnection.pm  view on Meta::CPAN

      my %p;

      my @res;

      for my $name_para (@pars) {
         my ($name, $par) = split /\s*=\s*/o, $name_para;
         if ($par =~ /^".*"$/o) { $par = _unquote ($par) }
         $p{$name} = $par;
      }

      my ($ctype, $bound) = _content_type_boundary ($hdr->{'content-type'});

      if ($ctype eq 'multipart/mixed') {
         my $parts = $self->decode_multipart ($cont, $bound);
         for my $sp (keys %$parts) {
            for (@{$parts->{$sp}}) {
               push @res, [$p{name}, @$_];
            }
         }

      } else {
         push @res, [$p{name}, $cont, $hdr->{'content-type'}, $p{filename}];
      }

      return @res
   }

   ();
}

sub decode_multipart {
   my ($self, $cont, $boundary) = @_;

   my $parts = {};

   while ($cont =~ s/
      ^--\Q$boundary\E             \015?\012
      ((?:[^\015\012]+\015\012)* ) \015?\012
      (.*?)                        \015?\012
      (--\Q$boundary\E (--)?       \015?\012)
      /\3/xs) {
      my ($h, $c, $e) = ($1, $2, $4);

      if (my (@p) = $self->decode_part ($h, $c)) {
         for my $part (@p) {
            push @{$parts->{$part->[0]}}, [$part->[1], $part->[2], $part->[3]];
         }
      }

      last if $e eq '--';
   }

   return $parts;
}

# application/x-www-form-urlencoded
#
# This is the default content type. Forms submitted with this content type must
# be encoded as follows:
#
#    1. Control names and values are escaped. Space characters are replaced by
#    `+', and then reserved characters are escaped as described in [RFC1738],
#    section 2.2: Non-alphanumeric characters are replaced by `%HH', a percent
#    sign and two hexadecimal digits representing the ASCII code of the
#    character. Line breaks are represented as "CR LF" pairs (i.e., `%0D%0A').
#
#    2. The control names/values are listed in the order they appear in the
#    document. The name is separated from the value by `=' and name/value pairs
#    are separated from each other by `&'.
#

sub _content_type_boundary {
   my ($ctype) = @_;
   my ($c, @params) = split /\s*[;,]\s*/o, $ctype;
   my $bound;
   for (@params) {
      if (/^\s*boundary\s*=\s*(.*?)\s*$/o) {
         $bound = _unquote ($1);
      }
   }
   ($c, $bound)
}

sub handle_request {
   my ($self, $method, $uri, $hdr, $cont) = @_;

   $self->{keep_alive} = ($hdr->{connection} =~ /keep-alive/io);

   my ($ctype, $bound) = _content_type_boundary ($hdr->{'content-type'});

   if ($ctype eq 'multipart/form-data') {
      $cont = $self->decode_multipart ($cont, $bound);

   } elsif ($ctype =~ /x-www-form-urlencoded/o) {
      $cont = parse_urlencoded ($cont);
   }

   $self->event (request => $method, $uri, $hdr, $cont);
}

# loosely adopted from AnyEvent::HTTP:
sub _parse_headers {
   my ($header) = @_;
   my $hdr;

   $header =~ y/\015//d;

   while ($header =~ /\G
      ([^:\000-\037]+):
      [\011\040]*
      ( (?: [^\012]+ | \012 [\011\040] )* )
      \012
   /sgcxo) {

      $hdr->{lc $1} .= ",$2"
   }

   return undef unless $header =~ /\G$/sgxo;

   for (keys %$hdr) {
      substr $hdr->{$_}, 0, 1, '';
      # remove folding: