Devel::DebugInit::GDB - Perl extension for creating .gdbinit file from

  use Devel::DebugInit::GDB;
  use Config;
  my $g = new Devel::DebugInit::GDB "filename => $Config{'archlib'}/CORE/perl.h";

  $g->write("~/perl5.00403/.gdbinit");

    package myGDB;
    use Devel::DebugInit::GDB;
    @myGDB::ISA = (Devel::DebugInit::GDB);

    sub scan {
      my ($gdb,$key,$macro) = @_;

      #first give the superclass scan a chance 
      return 0 unless $gdb->SUPER::scan(@_);

      # dont' print out any macros beginning with 'rfsf_'
      return 0 if $macro =~ /^rfsf_/;

      # print the rest
      return 1;
    }

package Devel::DebugInit::GDB;
use Devel::DebugInit;
require Exporter;

@Devel::DebugInit::GDB::ISA = (Exporter, Devel::DebugInit);

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw(
	
);
$VERSION = '0.1';

# Preloaded methods go here.

sub write {
  my ($gdb,$outfile) = @_;
  my ($key,$defines,$file);
  $outfile = ".gdbinit" unless defined $outfile;

  open(INIT, ">$outfile") or die "Couldn't open $outfile for output";

  my $time = scalar gmtime;
  print INIT "# This file auto generated by GDBinit v$VERSION, ", $time, "\n";

  foreach $file (@{$gdb}) {
    
    # first print out the simple macros (ones without arguments)
    $defines = $file->get_no_args();
    if (defined $defines) {
      print INIT "# macros with no arguments\n\n";
      # sort keys to print them in alphabetical order
      foreach $key (sort keys %{$defines}) {
	my $macro = $defines->{$key};
	# The follow lines filter what to print
	
	# don't print bad macros
	next unless $gdb->scan($key,$macro);
	
	#don't print symbol renames, e.g. #define sv_grow Perl_sv_grow
	if ($macro =~ /^\s*\w+\s*$/) {
	  # it's just a single token, skip it if it's not a number
	  next unless $macro =~ /^\s*\d+\s*$/ || $macro =~ /^\s*0x\d+\s*$/;
	}
	
	# print the rest
	print INIT "define $key\n";
	print INIT "   print $macro\n";
	print INIT "end\n\n";
      }
    }
    
    # then print out the macros with arguments
    $defines = $file->get_args();
    if (defined $defines) {
      print INIT "\n\n# macros with arguments\n\n";
      # sort keys to print them in alphabetical order
      foreach $key (sort keys %{$defines}) {
	my $args  = $defines->{$key}->[0]; # first slot is the arg list
	my $macro = $defines->{$key}->[1]; # second slot is the macro
	
	# don't print bad macros
	next unless $gdb->scan($key,$macro);
	
	# substitue $arg0, $arg1, etc for the arguments to the macro
	my $print_arg = 0;
	foreach my $arg (@{$args}) {
	  $macro =~ s/\b$arg\b/\$arg$print_arg/g;
	  $print_arg++;
	}
	
	# print 'em out...
	print INIT "define $key\n";
	print INIT "   print $macro\n";
	print INIT "end\n\n";
      }
    }
  }
  close(INIT);
}

    
sub scan {
  my ($gdb,$key,$macro) = @_;

  # if the user is printing only the local macros, it is possible for 
  # some to be undefined.
  return 0 unless defined $macro;

  # don't print flags, e.g. #define VMS
  return 0 if $macro eq "";

  # get ready to do some regexp'ing on $key
  study $key;

  # don't print macros with names that begin with '_'
  return 0 if $key =~ /^_/;

  # don't redefine any builtin GDB commands
  return 0 if $key =~ /\b
        (kill|
          target|
          handle|
          run|
          jump|
          step|
          next|
          finish|
          nexti|
          stepi|
          continue|
          signal|
          detach|
          attach|
          unset|
          tty|
          thread|
          apply|
          bt|
          backtrace|
          select\-frame|
          frame|
          down|
          up|
          return|
          whatis|
          ptype|
          inspect|
          print|
          call|
          set|
          output|
          printf|
          display|
          undisplay|
          disassemble|
          x|
          delete|
          disable|
          enable|
          awatch|
          rwatch|
          watch|
          catch|
          break|
          clear|
          thbreak|
          hbreak|
          tbreak|
          condition|
          commands|
          ignore|
          cd|
          pwd|
          core\-file|
          section|
          exec\-file|
          file|
          sharedlibrary|
          path|
          load|
          symbol\-file|
          list|
          reversed\-search|
          search|
          forward\-search|
          directory|
          show|
          info|
          up\-silently|
          down\-silently|
          define|
          ni|
          si|
          where|
          complete|
          remote|
          maintenance)\b/ix;
  
  # Looks OK
  return 1;
}

1;

__END__