#!/usr/bin/perl

use strict;

my $quick = 0;
my $pdump = 0;
my $parent;
my @pids;

while (scalar(@ARGV) > 0 &&
       substr($ARGV[0], 0, 1) eq "-") {
  if ($ARGV[0] eq "-q") {
    $quick = 1;
  }
  elsif ($ARGV[0] eq "-P") {
    $pdump = 1;
  }
  elsif ($ARGV[0] eq "-p") {
    $parent = $ARGV[1];
    shift(@ARGV);
  }
  else {
    usage();
  }
  shift(@ARGV);
}

if ($pdump != 0 && ! -e "./pdump.sh") {
  print STDERR "pdump.sh must be in current directory and must\n";
  print STDERR "be executable for -P option to work\n";
  exit(1);
}

if ((!defined($parent) && scalar(@ARGV) eq 0) ||
    (defined($parent) && scalar(@ARGV) ne 0))
{
  usage();
}

if (defined($parent)) {
  @pids = get_children($parent);
  @pids = (@pids, $parent);
}
else {
  @pids = @ARGV;
}

foreach my $pid (@pids) {
  getbt($pid, $quick);
  if ($pdump != 0) {
    system("./pdump.sh $pid");
  }
}

exit(0);

sub usage
{
  print STDERR "Usage: $0 process-id ...\n";
  print STDERR "    or $0 -p parent-process-id\n";
  print STDERR "Example: $0 9124 9125 9126\n";
  exit 1;
}

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

  open(PS, "ps -A -o pid,ppid | ")
    or die "couldn't start ps to find children";
  while (<PS>) {
    if (/(\d+) +$parent/) {
      @children = (@children, $1);
    }
  }
  close(PS);

  return @children;
}

sub getbt
{
  my ($pid, $quick) = @_;

  print "Getting backtrace for pid $pid...\n";

  my $cmdsfile = "dbxcmds";
  my $outputfile = "backtraces.$pid";

  open(C, ">$cmdsfile") or die "can't create $cmdsfile: $!";
  print C "thread\n";
  print C "detach\n";
  close(C);

  system("dbx -a $pid < $cmdsfile > $outputfile 2>&1");

  if (!$quick) {
    open(O, "<$outputfile") or die "can't read $outputfile: $!";
    open(C, ">$cmdsfile") or die "can't create $cmdsfile: $!";
    print C "thread\n";
    while (<O>)
    {
      if (/^.\$t(\d+)/)
      {
	my $tid = $1;
	
	print C "print \"\\nBacktrace for thread $tid:\\n\"\n";
	print C "thread current $tid\nwhere\n";
      }
    }
    print C "detach\n";
    close(O);
    close(C);
    system("dbx -a $pid < $cmdsfile > $outputfile 2>&1");
  }
  
  print "The backtrace for pid $pid is in file $outputfile.\n";
}