view release on metacpan or  search on metacpan

lib/ASNMTAP/Asnmtap/Plugins/WebTransact.pm  view on Meta::CPAN

    my $request_as_string = $request->as_string;
    print "\n", ref ($self), '::send_request: ', $request_as_string, "\n" if ( $debug );

    if ( defined $triesTiming and $triesTiming ) {
      my (@timing_tries) = ( $triesTiming =~ m<(\d+(?:\.\d+)*)>g );
      LWP::Debug::debug ('My retrial code policy is ['. join(' ', sort keys %triesCodesToDeterminate) .'].');
      LWP::Debug::debug ('My retrial timing policy is ['. $triesTiming .'].');
      my $timing_tries = 0;

      foreach my $pause_if_unsuccessful ( @timing_tries, undef ) {
        $response = $ua->request ($request);
        my $code = $response->code;
        my $message = $response->message;
        $message =~ s/\s+$//s;
        $timing_tries++;

        unless( $triesCodesToDeterminate{$code} ) { # normal case: all is well (or 404, etc)
          LWP::Debug::debug ("It returned a code ($code $message) blocking a retry");
          last;
        }

        if ( defined $pause_if_unsuccessful ) {
          LWP::Debug::debug ("It returned a code ($code $message) that'll make me retry, after $pause_if_unsuccessful seconds.");
          sleep $pause_if_unsuccessful if ( $pause_if_unsuccessful );
          $self->{_timing_tries}++;
        } else {
          LWP::Debug::debug ("I give up.  I'm returning this '$code $message' response.");
        }
      }

      print ref ($self), '::timing_tries: ', $timing_tries, " - $url\n" if ( $onDemand );
    } else {
      $response = $ua->request ($request);
    }

    if ( defined $response->content_encoding and $response->content_encoding =~ /^gzip$/i ) {
      use Compress::Zlib;
      $response_as_content = Compress::Zlib::memGunzip ( $response->content );
    } else {
      $response_as_content = $response->content;
    }

    if ( $debug >= 3 ) {
      print "\n", ref ($self), '::request: ()', "\n", $response->as_string, "\n\n";
    } elsif ( $debug >= 2 ) {
      print "\n", ref ($self), '::content: ()', "\n", $response_as_content, "\n\n";
    }

    my $responseTime = ${$self->{asnmtapInherited}}->setEndTime_and_getResponsTime ( ${$self->{asnmtapInherited}}->pluginValue ('endTime') );
    print ref ($self), '::response_time: ', $responseTime, " - $url\n" if ( $onDemand );
    ${$self->{asnmtapInherited}}->appendPerformanceData ( "'". $url_r->{Perfdata_Label} ."'=". $responseTime .'ms;;;;' ) if ( defined $url_r->{Perfdata_Label} );

    $self->_write_debugfile ( $request_as_string, $response_as_content, $debugfile, $openAppend ) if ( defined $debugfile );

    if ( $parms{fail_if_1} ) {
      unless ( $response->is_success or $response->is_redirect ) {
        my $response_as_request = $response->as_string;

        # Deal with __Can't__ from LWP.
        # Otherwise notification fails because /bin/sh is called to
        # printf '$OUTPUT' and sh cannot deal with nested quotes (eg Can't echo ''')
        $response_as_request =~ s#'#_#g;

        $returnCode = $ERRORS{CRITICAL};
        my $knownError = 0;
        my $errorMessage = "other than HTTP 200";

        for ( $response_as_request ) {
          # ***************************************************************************
          # The 500 series of Web error codes indicate an error with the Web server   *
          # ***************************************************************************

          # The server had some sort of internal error trying to fulfil the request. The client may see a partial page or error message.
          # It's a fault in the server and happens all too frequently.
          /500 Can_t connect to/       && do { $knownError = 1; $errorMessage = "500 Can't connect to ..."; $returnCode = $ERRORS{UNKNOWN}; last; };
          /500 Connect failed/         && do { $knownError = 1; $errorMessage = "500 Connect failed"; $returnCode = $ERRORS{UNKNOWN}; last; };
          /500 proxy connect failed/   && do { $knownError = 1; $errorMessage = "500 Proxy connect failed"; $returnCode = $ERRORS{UNKNOWN}; last; };
          /500 Server Error/           && do { $knownError = 1; $errorMessage = "500 Server Error"; $returnCode = $ERRORS{UNKNOWN}; last; };
          /500 SSL negotiation failed/ && do { $knownError = 1; $errorMessage = "500 SSL negotiation failed"; $returnCode = $ERRORS{UNKNOWN}; last; };
          /500 SSL read timeout/       && do { $knownError = 1; $errorMessage = "500 SSL read timeout"; $returnCode = $ERRORS{UNKNOWN}; last; };

          /Internal Server Error/      && do { $knownError = 0; $errorMessage = "500 Internal Server Error"; $returnCode = $ERRORS{UNKNOWN}; last; };

          # Function not implemented in Web server software. The request needs functionality not available on the server
          /501 (?:No Server|Not Implemented)/ && do { $errorMessage = "501 Not Implemented"; last; };

          # Bad Gateway: a server being used by this Web server has sent an invalid response.
          # The response by an intermediary server was invalid. This may happen if there is a problem with the DNS routing tables.
          /502 (?:Bad Gateway|Server Overload)/ && do { $knownError = 1; $errorMessage = "502 Bad Gateway"; last; };

          # Service temporarily unavailable because of currently/temporary overload or maintenance.
          /503 (?:Out of Resources|Service Unavailable)/ && do { $knownError = 1; $errorMessage = "503 Service Unavailable"; last; };

          # The server did not respond back to the gateway within acceptable time period
          /504 Gateway Time-?Out/ && do { $knownError = 1; $errorMessage = "504 Gateway Timeout"; last; };

          # The server does not support the HTTP protocol version that was used in the request message.
          /505 HTTP Version [nN]ot supported/ && do { $knownError = 1; $errorMessage = "505 HTTP Version Not Supported"; last; };

          # ***************************************************************************
          # The 400 series of Web error codes indicate an error with your Web browser *
          # ***************************************************************************

          # The request could not be understood by the server due to incorrect syntax.
          /400 Bad Request/ && do { $knownError = 1; $errorMessage = "400 Bad Request"; last; };

          # The client does not have access to this resource, authorization is needed
          /401 (?:Unauthorized|Authorization Required)/ && do { $knownError = 1; $errorMessage = "401 Unauthorized User"; last; };

          # Payment is required. Reserved for future use
          /402 Payment Required/ && do { $knownError = 1; $errorMessage = "402 Payment Required"; last; };

          # The server understood the request, but is refusing to fulfill it. Access to a resource is not allowed.
          # The most frequent case of this occurs when directory listing access is not allowed.
          /403 Forbidden/ && do { $knownError = 1; $errorMessage = "403 Forbidden Connection"; last; };

          # The resource request was not found. This is the code returned for missing pages or graphics.
          # Viruses will often attempt to access resources that do not exist, so the error does not necessarily represent a problem.
          /404 (?:Page )?Not Found/ && do { $knownError = 1; $errorMessage = "404 Page Not Found"; last; };

          # The access method (GET, POST, HEAD) is not allowed on this resource