#!/usr/bin/perl -w

use strict;

my $serverroot;

if ($ENV{'SERVERROOT'}) {
  $serverroot = $ENV{'SERVERROOT'};
}
else {
  print STDERR "Please set SERVERROOT environment variable.\n";
  exit(1);
}

my $ppid = `cat $serverroot/logs/httpd.pid`;
chomp($ppid);

my @children = get_children($ppid);

print "parent:\t$ppid\n";

foreach my $child (@children) {
  my @tracebacks = get_tracebacks($child);
  my $type = "unknown";

  foreach my $thread (@tracebacks) {
    # print "$thread\n";
    if ($thread =~ /\|cgid_server\|/) {
      $type = "cgid daemon";
      last;
    }
    if ($thread =~ /\|listener_thread\|/) {
      if ($thread =~ /apr_proc_mutex_lock/) {
	$type = "listener thread waiting on mutex";
      }
      else {
	$type = "listener thread not waiting on mutex";
      }
      last;
    }
  }

  print "child: $child\t$type\n";
}

exit(0);

sub get_tracebacks
{
  my ($child) = @_;
  my @tracebacks = ();
  my $index = -1;

  open(P, "pstack $child|");
  while (<P>) {
    my $inline = $_;

    if (substr($inline, 0, 6) eq "------") {
      ++$index;
      $tracebacks[$index] = "|";
      next;
    }

    if ($inline =~ / +([\dabcdef]+) +([a-zA-Z\d_]+) /) {
      $tracebacks[$index] .= "$2|";
    }
  }
  close(P);
  return @tracebacks;
}

sub get_children
{
  my ($ppid) = @_;
  my @children = ();

  if ($ppid eq "") {
    print STDERR "server not running\n";
    exit(1);
  }

  if (kill($ppid, 0) != 0) {
    print STDERR "server not running\n";
    exit(1);
  }

  open(P, "ps -A -o pid,ppid|");
  while (<P>) {
    if (/(\d+) +(\d+)/) {
      if ($2 == $ppid) {
	@children = (@children, $1);
      }
    }
  }
  close(P);
  return @children;
}