view release on metacpan or  search on metacpan

src/Monitor.pm  view on Meta::CPAN

# Other items we are prepared to export if requested
@EXPORT_OK = qw(
                error_message
		constant
               );

sub rxdebug {
  my %subreq;

  # parse the arguments and build a hash to pass to the XS do_rxdebug call.
  return eval {
    while (@_) {
      $_ = shift;

      if ( @_ and $_[0] !~ /^-/ ) {
        $subreq{$_} = shift;
      }
      else {
        $subreq{$_} = 1;
      }
    }
    my $rxd = do_rxdebug(\%subreq);
    return $rxd;
  }
}

sub afsmonitor {
  my %subreq;

  return eval {
    while (@_) {
      $_ = shift;

      if ( @_ and $_[0] !~ /^-/ ) {
        $subreq{$_} = shift;
      }
      else {
        $subreq{$_} = 1;
      }
    }
    my ($fs, $cm) = do_afsmonitor(\%subreq);
    return ($fs, $cm);
  }
}

sub cmdebug {
  my %subreq;

  return eval {
    while (@_) {
     $_ = shift;

      if ( @_ and $_[0] !~ /^-/ ) {
        $subreq{$_} = shift;
      }
      else {
        $subreq{$_} = 1;
      }
    }
    my ($locks, $cache_entries) = do_cmdebug(\%subreq);
    return ($locks, $cache_entries);
  }
}

sub udebug {
  my %subreq;

  return eval {
    while (@_) {
     $_ = shift;

      if ( @_ and $_[0] !~ /^-/ ) {
        $subreq{$_} = shift;
      }
      else {
        $subreq{$_} = 1;
      }
    }
    my $result = do_udebug(\%subreq);
    return $result;
  }
}

sub scout {
  my %subreq;

  return eval {
    while (@_) {
     $_ = shift;

      if ( @_ and $_[0] !~ /^-/ ) {
        $subreq{$_} = shift;
      }
      else {
        $subreq{$_} = 1;
      }
    }
    my $result = do_scout(\%subreq);
    return $result;
  }
}

sub xstat_fs_test {
  my %subreq;

  return eval {
    while (@_) {
     $_ = shift;

      if ( @_ and $_[0] !~ /^-/ ) {
        $subreq{$_} = shift;
      }
      else {
        $subreq{$_} = 1;
      }
    }
    my $result = do_xstat_fs_test(\%subreq);
    return $result;
  }
}

sub xstat_cm_test {
  my %subreq;

  return eval {
    while (@_) {
     $_ = shift;

      if ( @_ and $_[0] !~ /^-/ ) {
        $subreq{$_} = shift;
      }
      else {
        $subreq{$_} = 1;
      }
    }

src/Monitor.xs  view on Meta::CPAN

    hv_store(RETVAL, "tstats", 6, newRV_inc((SV*)(TSTATS)), 0);

    /* get rxstats if requested, and supported by the server */
    /* hash containing stats added at key 'rxstats' in RETVAL */
    if (rxstats)
    {
      if (!withRxStats)
      {
        noRxStats:
        withRxStats = 0;
        warn("WARNING: Server doesn't support retrieval of Rx statistics\n");
      }
      else {
        struct rx_statistics rxstats;

        /* should gracefully handle the case where rx_statistics grows */
        code = rx_GetServerStats(s, host, port, &rxstats, &supportedStatValues);
        if (code < 0) {
          sprintf(buffer, "rxstats call failed with code %d", code);
          VSETCODE(code, buffer);
          XSRETURN_UNDEF;

src/Monitor.xs  view on Meta::CPAN

        hv_store(RETVAL, "rxstats", 7, newRV_inc((SV*)(RXSTATS)), 0);

      }
    }

    /* get connections unless -noconns flag was set */
    /* array of connections added at key 'connections' in RETVAL hash */
    if (!noConns) {
      if (allconns) {
        if (!withAllConn) {
          warn("WARNING: Server doesn't support retrieval of all connections,\n");
          warn("         getting only interesting instead.\n");
          }
      }

      CONNECTIONS = newAV();
      index = 0;
      for ( i = 0; ; i++) {
        code = rx_GetServerConnections(s, host, port, &nextconn, allconns,
                      supportedDebugValues, &tconn,
                      &supportedConnValues);