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';
=head1 NAME
Devel::DebugInit::GDB - Perl extension for creating .gdbinit file from
C header file macros
=head1 SYNOPSIS
use Devel::DebugInit::GDB;
use Config;
my $g = new Devel::DebugInit::GDB "filename => $Config{'archlib'}/CORE/perl.h";
$g->write("~/perl5.00403/.gdbinit");
=head1 DESCRIPTION
This module is a backend for the GNU debugger, gdb, that is used
together with the generic Devel::DebugInit front end to produce an
initialization file for gdb. This module provides the output routines
that are specific for gdb. See L<Devel::DebugInit> for more information.
=cut
# Preloaded methods go here.
=head1 METHODS
=head2 write()
=head2 write($filename)
This method outputs the macros to $filename, which defaults to
"./gdbinit". It first writes out any macros without arguments (if
enabled, see L<Devel::DebugInit/INTERNALS> for more info), and
then it writes any macros with arguments.
=cut
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);
}
=head2 scan($name,$macro)
This is used by the print function to determine if $macro should be
printed or not. It returns 0 if the macro should NOT be
printed. Currently, the method rejects undefined macros (this is
possible if the user specified printing of local macros only), empty
macros (typical compiler flags like -DDEBUG, or #define linux), macros
whose names begin with '_', as well as any macro whose name is a
built-in GDB command.
This function can be overloaded by the user to more rigidly restrict
the output of print. For example:
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;
}
=cut
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__
=head1 AUTHOR
Jason E. Stewart, jasons@cs.unm.edu
=head1 SEE ALSO
perl(1), Devel::DebugInit(3).
=cut