view release on metacpan or  search on metacpan

lib/SOAP/Transport/HTTP.pm  view on Meta::CPAN

          # here doesn't work either, because LWP overwrites it with
          # content-length it calculates (which is wrong) AND uses length()
          # during syswrite/sysread, so we are in a bad shape anyway.
          #
          # what to do? we calculate proper content-length (using
          # bytelength() function from SOAP::Utils) and then drop utf8 mark
          # from string (doing pack with 'C0A*' modifier) if length and
          # bytelength are not the same
            my $bytelength = SOAP::Utils::bytelength($envelope);
            if ($] < 5.008) {
                $envelope = pack( 'C0A*', $envelope );
            }
            else {
                require Encode;
                $envelope = Encode::encode($encoding, $envelope);
                $bytelength = SOAP::Utils::bytelength($envelope);
            }
            #  if !$SOAP::Constants::DO_NOT_USE_LWP_LENGTH_HACK
            #      && length($envelope) != $bytelength;

            # compress after encoding
            # doing it before breaks the compressed content (#74577)
            $envelope = Compress::Zlib::memGzip($envelope) if $compressed;

            $http_request->content($envelope);
            $http_request->protocol('HTTP/1.1');

            $http_request->proxy_authorization_basic( $ENV{'HTTP_proxy_user'},
                $ENV{'HTTP_proxy_pass'} )
              if ( $ENV{'HTTP_proxy_user'} && $ENV{'HTTP_proxy_pass'} );

            # by Murray Nesbitt
            if ( $method eq 'M-POST' ) {
                my $prefix = sprintf '%04d', int( rand(1000) );
                $http_request->header(
                    Man => qq!"$SOAP::Constants::NS_ENV"; ns=$prefix! );
                $http_request->header( "$prefix-SOAPAction" => $action )
                  if defined $action;
            }
            else {
                $http_request->header( SOAPAction => $action )
                  if defined $action;
            }

            #            $http_request->header(Expect => '100-Continue');

            # allow compress if present and let server know we could handle it
            $http_request->header( 'Accept-Encoding' =>
                  [$SOAP::Transport::HTTP::Client::COMPRESS] )
              if $self->options->{is_compress};

            $http_request->content_encoding(
                $SOAP::Transport::HTTP::Client::COMPRESS)
              if $compressed;

            if ( !$http_request->content_type ) {
                $http_request->content_type(
                    join '; ',
                    $SOAP::Constants::DEFAULT_HTTP_CONTENT_TYPE,
                    !$SOAP::Constants::DO_NOT_USE_CHARSET && $encoding
                    ? 'charset=' . lc($encoding)
                    : () );
            }
            elsif ( !$SOAP::Constants::DO_NOT_USE_CHARSET && $encoding ) {
                my $tmpType = $http_request->headers->header('Content-type');

                # $http_request->content_type($tmpType.'; charset=' . lc($encoding));
                my $addition = '; charset=' . lc($encoding);
                $http_request->content_type( $tmpType . $addition )
                  if ( $tmpType !~ /$addition/ );
            }

            $http_request->content_length($bytelength) unless $compressed;
            SOAP::Trace::transport($http_request);
            &{$self->{debug_logger}}($http_request->as_string);

            $self->SUPER::env_proxy if $ENV{'HTTP_proxy'};

            # send and receive the stuff.
            # TODO maybe eval this? what happens on connection close?
            $self->http_response( $self->SUPER::request($http_request) );
            SOAP::Trace::transport( $self->http_response );
            &{$self->{debug_logger}}($self->http_response->as_string);

            # 100 OK, continue to read?
            if ( (
                       $self->http_response->code == 510
                    || $self->http_response->code == 501
                )
                && $method ne 'M-POST'
              ) {
                $mpost{$endpoint} = 1;
            }
            elsif ( $self->http_response->code == 415 && $compressed ) {

                # 415 Unsupported Media Type
                $nocompress{$endpoint} = 1;
                $envelope = Compress::Zlib::memGunzip($envelope);
                $http_request->headers->remove_header('Content-Encoding');
                redo COMPRESS;    # try again without compression
            }
            else {
                last;
            }
        }
    }

    $redirect{$endpoint} = $self->http_response->request->url
      if $self->http_response->previous
          && $self->http_response->previous->is_redirect;

    $self->code( $self->http_response->code );
    $self->message( $self->http_response->message );
    $self->is_success( $self->http_response->is_success );
    $self->status( $self->http_response->status_line );

    # Pull out any cookies from the response headers
    $self->{'_cookie_jar'}->extract_cookies( $self->http_response )
      if $self->{'_cookie_jar'};

    my $content =
      ( $self->http_response->content_encoding || '' ) =~
      /\b$SOAP::Transport::HTTP::Client::COMPRESS\b/o
      && $self->options->{is_compress}
      ? Compress::Zlib::memGunzip( $self->http_response->content )
      : ( $self->http_response->content_encoding || '' ) =~ /\S/ ? die
"Can't understand returned Content-Encoding (@{[$self->http_response->content_encoding]})\n"
      : $self->http_response->content;