File Coverage

blib/lib/Devel/GDB/Reflect.pm

Criterion	Covered	Total	%
statement	18	126	14.2
branch	0	50	0.0
condition	0	6	0.0
subroutine	6	16	37.5
pod	2	7	28.5
total	26	205	12.6

=head1 NAME

Devel::GDB::Reflect - Reflection API for GDB/C++

=head1 SYNOPSIS

  use Devel::GDB;
  use Devel::GDB::Reflect;

  my $gdb = new Devel::GDB( -file => $foo );
  my $reflector = new Devel::GDB::Reflect( $gdb );

  print $gdb->get( "b foo.c:123" );
  $gdb->print( "myVariable" );

=head1 DESCRIPTION

Devel::GDB::Reflect provides a reflection API for GDB/C++, which can
be used to recursively print the contents of STL data structures
(C, C, C, etc.) within a GDB session.  It is not
limited to STL, however; you can write your own delegates for printing
custom container types.

The module implements the functionality used by the L script, which
serves as a wrapper around GDB.  You should probably familiarize yourself with
the basic functionality of this script first, before diving into the gory
details presented here.

=head2 Global Variables

The following global variables control the behavior of the L method.

=over

=item $Devel::GDB::Reflect::INDENT

The number of spaces to indent at each level of recursion.  Defaults to 4.

=item $Devel::GDB::Reflect::MAX_DEPTH

The maximum recursion depth.  Defaults to 5.

=item $Devel::GDB::Reflect::MAX_WIDTH

The maximum number of elements to show from a given container.  Defaults to 10.

=back

=head2 Methods

=cut

package Devel::GDB::Reflect;

use warnings;
use strict;

use Devel::GDB::Reflect::GDBGrammar;
use Devel::GDB::Reflect::PrettyPrinter;
use Data::Dumper;
use Devel::GDB;

our $VERSION   = '0.2';
our $MAX_DEPTH = 5;
our $MAX_WIDTH = 10;
our $INDENT    = 4;

sub load_delegates()
{
	my @insts = ();

	my $DELEGATE_NAMESPACE = __PACKAGE__ . "::DelegateProvider";
	(my $DELEGATE_SUBDIR   = $DELEGATE_NAMESPACE) =~ s!::!/!g;

	foreach my $root_dir (@INC)
	{
		my $dir = "$root_dir/$DELEGATE_SUBDIR";

		opendir(DIR, $dir) or next;
		my @delegate_providers = grep { /\.pm$/ && -f "$dir/$_" } readdir(DIR);
		closedir(DIR);

		foreach my $file (@delegate_providers)
		{
			die "Something wrong here: \$file = $file"
				unless $file =~ /^(.+)\.pm$/;

			my $modname = "${DELEGATE_NAMESPACE}::$1";

			require "$dir/$file";
			my $inst = eval "new $modname"
				or do { warn "Can't instantiate $modname; skipping"; next };

			print STDERR " => $modname\n";

			push @insts, $inst;
		}
	}

	return \@insts;
}

=head3 new

Create a new Devel::GDB::Reflect instance.  Takes a single parameter, an
instance of C.

When the constructor is invoked, it searches C<@INC> for modules named
C, and recruits them as delegates.  See
L.

=cut

sub new($$)
{
	my $class = shift;
	my ($gdb) = @_;

	return bless
		{
			parser             => new Devel::GDB::Reflect::GDBGrammar(),
			gdb                => $gdb,
			class_cache        => {},
			delegate_cache     => {},
			delegate_providers => load_delegates(),
		};
}

=head3 print

C<< $reflector->print( "myVar" ); >>

Given a variable or expression, recursively print the contents of the referenced
container.  Specifically, this checks the type of the variable, iterates over
the L to determine the best one, then uses that delegate
to print out the contents of the container.

The recursion is limited by C<$MAX_DEPTH>, and for each container, the number of
elements is limited by C<$MAX_WIDTH>.

=cut

sub print($$)
{
	my $self = shift;
	my ($var) = @_;

	$Devel::GDB::Reflect::PrettyPrinter::PAD = " " x $INDENT;
	$self->_print_rec(0, new Devel::GDB::Reflect::PrettyPrinter(), $var);
	print "\n";
}

sub get_completions($$)
{
    my $self = shift;
    my ($line) = @_;

    my ($result, $error) = $self->{gdb}->get("complete $line");
	die "Fatal Error: $error" if $error;

    return split "\n", $result;
}

sub get_member($$$);
sub get_member($$$)
{
	my $self = shift;
	my ($type, $query) = @_;

	if(ref $type ne 'HASH')
	{
		# Someone passed in a variable, not a type
		$type = $self->get_type($type);
	}

	my $class_spec = $self->_get_class($type->{quotename});
	return undef unless $class_spec->{members};

	foreach my $member (@{$class_spec->{members}})
	{
		foreach my $t ('variable', 'function')
		{
			return $member if (defined $member->{$t} and $member->{$t} eq $query);
		}
	}

	if(defined($class_spec->{parent}))
	{
		return $self->get_member($class_spec->{parent}, $query);
	}

	return undef;
}

sub eval($$)
{
	my $self = shift;
	my ($expr) = @_;

	my ($result, $error) = $self->{gdb}->get("output $expr");
	die "Fatal Error: $error" if $error;

	# We're going to assume that it succeeded if $result either starts with an
	# open brace (it's a struct or class of some sort), OR it's is not
	# terminated with a newline (which is how error messages are shown).
	return undef if($result =~ /^[^{].*\n/); return $result; }

sub _print_rec($$$;$)
{
	my $self = shift;
	my ($depth, $pp, $var, $type) = @_;

	my $pp_fh = $pp->{fh};

	#
	# Control for excessive recursion
	#
	if($depth >= $MAX_DEPTH)
	{
		print $pp_fh "{ ... }";
		return;
	}

	#
	# Get the type of $var, unless we're told what it is
	#

    unless(defined $type)
    {
        $type = $self->get_type($var) or return;
    }

	#
	# Find candidate delegates for this type, unless we already have one cached
	#

    unless(defined $self->{delegate_cache}->{$type->{quotename}})
    {
        my @delegates = ();

        foreach my $inst (@{$self->{delegate_providers}})
        {
            push @delegates, $inst->get_delegates($type, $var, $self);
        }

        if(!@delegates)
        {
            print $pp_fh "[No delegate found!]";
            return;
        }

        #
        # Take the highest-priority one
        #

        my $delegate = (sort { $b->{priority} <=> $a->{priority} } @delegates)[0];
        $self->{delegate_cache}->{$type->{quotename}} = $delegate;
    }

    my $delegate = $self->{delegate_cache}->{$type->{quotename}}
        or die "Something wrong here";

	#
	# Now use $delegate to either dump the object as-is, or iterate
	#

	my $pp_child = new Devel::GDB::Reflect::PrettyPrinter( $pp,
														   $delegate->{print_open_brace},
														   $delegate->{print_separator},
														   $delegate->{print_close_brace} );

	my $callback = sub { $self->_print_rec($depth+1, $pp_child, @_) };
    my $printer = $delegate->{factory}->($var);

	if($delegate->{can_iterate})
	{
		for(my $i=0 ; $i<$MAX_WIDTH && $printer->has_next() ; $i++)
		{
			$printer->print_next($callback, $pp_child->{fh});
		}

		my $pp_child_fh = $pp_child->{fh};
		print $pp_child_fh "..." if($printer->has_next());
	}
	else
	{
		$printer->print($callback, $pp_child->{fh});
	}

	$pp_child->finish($delegate->{print_newline});
}

sub _get_class($$)
{
	my $self = shift;
	my ($typename) = @_;

	unless(defined $self->{class_cache}->{$typename})
	{
		my ($result, $error) = $self->{gdb}->get("ptype $typename");
		die "Fatal Error: $error" if $error;

		my $class_spec = $self->{parser}->parse($result);
		unless(defined $class_spec)
		{
			$DB::single = 2;
			print STDERR "Failed parsing type '$typename'!\n";
			return undef;
		}

		$self->{class_cache}->{$typename} = $class_spec;
	}

	return $self->{class_cache}->{$typename};
}

##
## It would be better to use "whatis" here, rather than "ptype", but GDB
## is stupid.  There, I said it. :-)
##
## If $var is of type std::string, "whatis $var" gives "type = string",
## while "ptype $var" gives the full type specification.
##
sub get_type($$)
{
	my $self = shift;
	my ($var) = @_;

	my ($result, $error) = $self->{gdb}->get("ptype $var");
	die "Fatal Error: $error" if $error;

	if($result !~ /^type =/)
	{
		print STDERR $result;
		return undef;
	}

	# Strip off the class definition, if any.  This is ugly, but it avoids
	# expensively parsing the entire class...
	$result =~ s/ : .*//s;
	$result =~ s/{.*//s;

	my $type = $self->{parser}->parse($result);

	unless(defined $type)
	{
		print STDERR "Failed parsing type!\n  Result was: $result\n";
		return undef;
	}

	return $type;
}

1;

=head2 Delegates

Although this module is designed primarily for printing the contents of STL
containers, it is fully extensible to support custom data types.  The
L method works by iterating over a set of I to determine
how to print out a given variable.

A I is a hash consisting of:

=over

=item priority

A numeric value used to disambiguate which delegate to use when there is more
than one to choose from.  For example, the fallback delegate
(C) can print any data type, but has
very low priority (-1000) to prevent it from being invoked unless no other
delegate is available.

=item can_iterate

A boolean value, B<1> if the delegate is used to print a container that should
be iterated (such as a vector), or B<0> if it is used to print a single value
(such as a string).  If C is true, then the delegate's factory must
provide C and C; otherwise, it must provide C.

=item print_open_brace, print_close_brace

The string to print before and after the contents of the variable; defaults to
C<"["> and C<"]"> respectively.

=item print_separator

The string to print between elements within the variable; defaults to C<",">.
Only makes sense with C is true.

=item print_newline

A boolean indicating whether or not to print a newline after printing the
contents of the container.  Typically this should be B<1> (true) except for
simple types.

=item factory

A C taking a single parameter, C<$var> (a C++ expression) and returning an
object.  This object is expected to contain either C (if C
is false) or C and C:

=over

=item print

Takes two parameters: C<$callback> and C<$fh>.  Either prints the contents of
C<$var> directly to the file handle C<$fh>, or invokes C<$callback> to print
C<$var> recursively.

=item has_next

Like Java's C, this function is called to determine whether or
not there are any items remaining to print out.

=item print_next

Prints out the current element and advances the iterator (similarly again to
Java's C).

Like C, this function takes two parameters, C<$callback> and C<$fh>,
and either prints directly to C<$fh> or invokes C<$callback> recursively.

=back

=back

=head3 Delegate Providers

A I is an object containing a method called C.
This module searches for delegate providers by looking in C<@INC> for modules by
the name of C.

The C method takes three parameters C<($type, $var, $reflector)>:
a I, a C++ expression, and an instance of C.  The
C<$type> is a hash, containing:

=over

=item *

C: the full name of the type, including its namespace and template
specialization, e.g. C<<< class std::vector > * >>>.
This type should B be passed to GDB; use C instead.

=item *

C: the type name without the template or namespace, e.g. C.

=item *

C: the full name, properly quoted to pass to GDB, e.g.
C<<< class 'std::vector >' * >>>.

=item *

C