# -*- cperl -*-
# Copyright (C) 2004-2006 MySQL AB
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; version 2 of the License.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA

package My::CoreDump;

use strict;
use Carp;
use My::Platform;

use File::Temp qw/ tempfile tempdir /;

sub _gdb {
  my ($core_name)= @_;

  print "\nTrying 'gdb' to get a backtrace\n";

  return unless -f $core_name;

  # Find out name of binary that generated core
  `gdb -c '$core_name' --batch 2>&1` =~
    /Core was generated by `([^\s\'\`]+)/;
  my $binary= $1 or return;
  print "Core generated by '$binary'\n";

  # Create tempfile containing gdb commands
  my ($tmp, $tmp_name) = tempfile();
  print $tmp
    "bt\n",
    "thread apply all bt\n",
    "quit\n";
  close $tmp or die "Error closing $tmp_name: $!";

  # Run gdb
  my $gdb_output=
    `gdb '$binary' -c '$core_name' -x '$tmp_name' --batch 2>&1`;

  unlink $tmp_name or die "Error removing $tmp_name: $!";

  return unless $gdb_output;

  print <<EOF, $gdb_output, "\n";
Output from gdb follows. The first stack trace is from the failing thread.
The following stack traces are from all threads (so the failing one is
duplicated).
EOF
  return 1;
}


sub show {
  my ($class, $core_name)= @_;

  my @debuggers =
    (
     \&_gdb,
     # TODO...
   );

  foreach my $debugger (@debuggers){
    if ($debugger->($core_name)){
      return;
    }
  }
  return;
}


1;
