view release on metacpan or  search on metacpan

lib/CGI.pm  view on Meta::CPAN

            $self->param('-name'=>$name,'-value'=> $val);
            if (defined $val and ref $val eq 'ARRAY') {
                for my $fh (grep {defined($_) && ref($_) && defined(fileno($_))} @$val) {
                   seek($fh,0,0); # reset the filehandle.  
                }

            }
        }
        $self->charset($QUERY_CHARSET);
        # so an error parsing the request (e.g. a malformed or too large
        # body) is seen by every object, not just the first
        $self->cgi_error($QUERY_CGI_ERROR) if defined $QUERY_CGI_ERROR;
        $self->{'.fieldnames'} = {%QUERY_FIELDNAMES};
        $self->{'.tmpfiles'}   = {%QUERY_TMPFILES};
        return;
    }

    $meth=$ENV{'REQUEST_METHOD'} if defined($ENV{'REQUEST_METHOD'});
    $content_length = defined($ENV{'CONTENT_LENGTH'}) ? $ENV{'CONTENT_LENGTH'} : 0;

    $fh = to_filehandle($initializer) if $initializer;

    # set charset to the safe ISO-8859-1
    $self->charset('ISO-8859-1');

  METHOD: {

      # avoid unreasonably large postings
      if (($POST_MAX > 0) && ($content_length > $POST_MAX)) {
	#discard the post, unread
	$self->cgi_error("413 Request entity too large");
	$too_large = 1;
	last METHOD;
      }

      # Process multipart postings, but only if the initializer is
      # not defined.
      if ($meth eq 'POST'
	  && defined($ENV{'CONTENT_TYPE'})
	  && $ENV{'CONTENT_TYPE'}=~m|^multipart/form-data|
	  && !defined($initializer)
	  ) {
	  my($boundary) = $ENV{'CONTENT_TYPE'} =~ /boundary=\"?([^\";,]+)\"?/;
	  unless ( $self->_within_request_limits(
	      sub { $self->read_multipart($boundary,$content_length) }
	  ) ) {
	      $too_large = 1;
	      last METHOD;
	  }
	  if ($APPEND_QUERY_STRING) {
	    # Some people want to have their cake and eat it too!
	    # Set $APPEND_QUERY_STRING = 1 to have the contents of the query string
	    # APPENDED to the POST data.
	    $query_string .= (length($query_string) ? '&' : '') . $ENV{'QUERY_STRING'} if defined $ENV{'QUERY_STRING'};
	  }
	  last METHOD;
      } 

      # Process XForms postings. We know that we have XForms in the
      # following cases:
      # method eq 'POST' && content-type eq 'application/xml'
      # method eq 'POST' && content-type =~ /multipart\/related.+start=/
      # There are more cases, actually, but for now, we don't support other
      # methods for XForm posts.
      # In a XForm POST, the QUERY_STRING is parsed normally.
      # If the content-type is 'application/xml', we just set the param
      # XForms:Model (referring to the xml syntax) param containing the
      # unparsed XML data.
      # In the case of multipart/related we set XForms:Model as above, but
      # the other parts are available as uploads with the Content-ID as the
      # the key.
      # See the URL below for XForms specs on this issue.
      # http://www.w3.org/TR/2006/REC-xforms-20060314/slice11.html#submit-options
      if ($meth eq 'POST' && defined($ENV{'CONTENT_TYPE'})) {
              if ($ENV{'CONTENT_TYPE'} eq 'application/xml') {
                      my($param) = 'XForms:Model';
                      my($value) = '';
                      $self->add_parameter($param);
                      $self->read_from_client(\$value,$content_length,0)
                        if $content_length > 0;
                      push (@{$self->{param}{$param}},$value);
                      $is_xforms = 1;
              } elsif ($ENV{'CONTENT_TYPE'} =~ m|^multipart/related\b|
                  # separate (linear) matches for each parameter - a single
                  # pattern with .+ between them backtracks in cubic time on
                  # a crafted Content-Type, and parameters can be in any order
                  and my ($boundary) = $ENV{'CONTENT_TYPE'} =~ /[;\s]boundary=\"?([^\";,]+)\"?/
                  and my ($start)    = $ENV{'CONTENT_TYPE'} =~ /[;\s]start=\"?\<?([^\"\>]+)\>?\"?/
              ) {
                      my($param) = 'XForms:Model';
                      $self->add_parameter($param);
                      my($value);
                      unless ( $self->_within_request_limits(
                          sub { $value = $self->read_multipart_related($start,$boundary,$content_length,0) }
                      ) ) {
                          $too_large = 1;
                          last METHOD;
                      }
                      push (@{$self->{param}{$param}},$value);
					  $query_string = $self->_get_query_string_from_env;
                      $is_xforms = 1;
              }
      }


      # If initializer is defined, then read parameters
      # from it.
      if (!$is_xforms && defined($initializer)) {
	  if (UNIVERSAL::isa($initializer,'CGI')) {
	      $query_string = $initializer->query_string;
	      last METHOD;
	  }
	  if (ref($initializer) && ref($initializer) eq 'HASH') {
	      for (sort keys %$initializer) {
		  $self->param('-name'=>$_,'-value'=>$initializer->{$_});
	      }
	      last METHOD;
	  }

          if (defined($fh) && ($fh ne '')) {
              while (my $line = <$fh>) {
                  chomp $line;
                  last if $line =~ /^=$/;
                  push(@lines,$line);
              }
              # massage back into standard format