view release on metacpan or  search on metacpan

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

                          };

      foreach my $acc_pre (qw(get set)) {
        $full_name = $classname .'::'. $acc_pre .'_'. $accessor;
        *{$full_name} = $acc_pre eq 'get' ? sub { my $self = shift @_; $self->{$accessor} } : sub { my $self = shift @_; $self->{$accessor} = shift @_ };
      }
    }
  }

  bless { asnmtapInherited => $asnmtapInherited, urls => $urls_ar, matches => [], returns => {}, ua => undef, newAgent => 1, number_of_images_downloaded => 0, _unknownErrors => 0, _KnownError => undef, _timing_tries => 0 }, $classname;
  # The field urls contains a ref to a list of (hashes) records representing the web transaction.

  # self->_my_match() will update $self->{matches};
  # with the set of matches it finds by matching patterns with memory (ie patterns in paren) from
  # the Exp field against the request response.
  # An array ref to the array containing the matches is stored in the field 'matches'.

  # Qs_var = [ form_name_1 => 0, form_name_2 => 1 ..] will lead to a query_string like
  # form_name_1 = $matches[0] form_name_2 = $matches[1] .. in $self->_make_request() by
  # @matches = $self->matches(); and using 0, 1 etc as indices of @matches.
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

sub check {
  my ($self, $cgi_parm_vals_hr) = @_;

  my %defaults = ( custom           => undef,
                   perfdataLabel    => undef,
                   newAgent         => undef,
                   timeout          => undef,
                   triesTiming      => '1,3,15',
                   triesCodes       => '408,500,502,503,504',
                   openAppend       => TRUE,
                   cookies          => TRUE,
                   protocol         => TRUE,
                   keepAlive        => TRUE,
                   download_images  => FALSE,
                   fail_if_1        => TRUE );

  my %parms = (%defaults, @_);

  my $debug         = ${$self->{asnmtapInherited}}->getOptionsValue ( 'debug' );
  my $onDemand      = ${$self->{asnmtapInherited}}->getOptionsValue ( 'onDemand' );
  my $debugfile     = ${$self->{asnmtapInherited}}->getOptionsArgv ( 'debugfile' );
  my $openAppend    = $parms{openAppend};
  my $triesTiming   = $parms{triesTiming};
  my %triesCodesToDeterminate = map { $_ => 1 } ( $parms{triesCodes} =~ m<(\d+(?:\.\d+)*)>g );

  my $proxyServer   = ${$self->{asnmtapInherited}}->proxy ( 'server' );
  my $proxyUsername = ${$self->{asnmtapInherited}}->proxy ( 'username' );
  my $proxyPassword = ${$self->{asnmtapInherited}}->proxy ( 'password' );

  $self->{newAgent} = $parms{newAgent} if ( defined $parms{newAgent} and defined $ua );

  if ( $self->{newAgent} or ! defined $ua ) {
    $self->{newAgent} = 0;
    LWP::Debug::level('+') if ( $debug );

    if ( $parms{keepAlive} ) {
      $ua = LWP::UserAgent->new ( keep_alive => 1 );
    } else {
      $ua = LWP::UserAgent->new ( keep_alive => 0 );
    }

    $self->{ua} = $ua;
    $ua->agent ( ${$self->{asnmtapInherited}}->browseragent () );
    $ua->timeout ( ${$self->{asnmtapInherited}}->timeout () );

    $ua->default_headers->push_header ( 'Accept-Language' => 'no, en' );
    $ua->default_headers->push_header ( 'Accept-Charset'  => 'iso-8859-1,*,utf-8' );
    $ua->default_headers->push_header ( 'Accept-Encoding' => 'gzip, deflate' );

    $ua->default_headers->push_header ( 'Keep-Alive' => ${$self->{asnmtapInherited}}->timeout () ) if ( $parms{keepAlive} );
    $ua->default_headers->push_header ( 'Connection' => 'Keep-Alive' );

    if ( defined $proxyServer ) {
      $ua->default_headers->push_header ( 'Proxy-Connection' => 'Keep-Alive' );

      # don't use $ua->proxy ( ['http', 'https', 'ftp'] => $proxyServer ); or $ua->proxy ( 'https' => undef ) ;
      $ua->proxy ( ['http', 'ftp'] => $proxyServer );

      # do not proxy requests to the given domains. Calling no_proxy without any domains clears the list of domains.
      ( defined ${$self->{asnmtapInherited}}->proxy ( 'no' ) and ${$self->{asnmtapInherited}}->proxy ( 'no' ) ne '' ? $ua->no_proxy( @{ ${$self->{asnmtapInherited}}->proxy ( 'no' ) } ) : $ua->no_proxy( ) ) ;
    }

    $ua->cookie_jar ( HTTP::Cookies->new ) if ( $parms{cookies} );
  }

  if ( defined $parms{timeout} ) {
    $ua->timeout ( $parms{timeout} );
    $ua->default_headers->push_header ( 'Keep-Alive' => $parms{timeout} ) if ( $parms{keepAlive} );
  }

  my $returnCode = $parms{fail_if_1} ? $ERRORS{OK} : $ERRORS{CRITICAL};
  my ($response_as_content, $response, $found);

  my $startTime;

  if ( defined $parms{perfdataLabel} and $parms{perfdataLabel} ) {
    ${$self->{asnmtapInherited}}->setEndTime_and_getResponsTime ( ${$self->{asnmtapInherited}}->pluginValue ('endTime') );
    $startTime = ${$self->{asnmtapInherited}}->pluginValue ('endTime');
  }

  my $statusTimeout;

  foreach my $url_r ( @{ $self->{urls} } ) {
    if ( defined $url_r->{Timeout} ) {
      $statusTimeout = 1;
      $ua->timeout ( $url_r->{Timeout} );
      $ua->default_headers->push_header ( 'Keep-Alive' => $url_r->{Timeout} ) if ( $parms{keepAlive} );
    } elsif ( defined $statusTimeout ) {
      $statusTimeout = undef;

      if ( defined $parms{timeout} ) {
        $ua->timeout ( $parms{timeout} );
        $ua->default_headers->push_header ( 'Keep-Alive' => $parms{timeout} ) if ( $parms{keepAlive} );
      } else {
        $ua->timeout ( ${$self->{asnmtapInherited}}->timeout () );
        $ua->default_headers->push_header ( 'Keep-Alive' => ${$self->{asnmtapInherited}}->timeout () ) if ( $parms{keepAlive} );
      }
    }