package Devel::ebug::Console;
use strict;
use warnings;
use lib 'lib';
use Carp;
use Class::Accessor::Chained::Fast;
use Devel::ebug;
use Term::ReadLine;
use YAML::Syck;
use base qw(Class::Accessor::Chained::Fast);
sub run {
my $self = shift;
my $filename = join "", @ARGV;
unless ($filename) {
$filename = '-e "Interactive ebugging shell"';
}
my $ebug = Devel::ebug->new;
$ebug->program($filename);
$ebug->load;
my $codelines;
print "* Welcome to Devel::ebug $Devel::ebug::VERSION\n";
my $term = Term::ReadLine->new('ebug');
my $attribs = $term->Attribs;
$attribs->{completion_function} = sub {
my ($text, $line, $start) = @_;
my $pad = $ebug->pad || {};
return unless $line =~ s/^x //;
my @result = grep { /^\Q$line/ } keys %$pad;
if ($line =~ /^[\$\@]/) {
@result = map { s/^[\$\@]//; $_ } @result;
}
return @result;
};
my $last_command = "s";
my $list_always = 0;
my $list_lines_count = 9;
while (1) {
if ($ebug->finished) {
print "ebug: Program finished. Enter 'restart' or 'q'\n";
} else {
if ($list_always) {
show_codelines($codelines, $ebug, $list_lines_count) if($list_always);
} else {
print $ebug->subroutine
. "(" . $ebug->filename . "#" . $ebug->line . "):\n"
. $ebug->codeline, "\n";
}
}
my $command = $term->readline("ebug: ");
$command = "q" if not defined $command;
$command = $last_command if ($command eq "");
if ($command =~ /[?h]/) {
print 'Commands:
b Set break point at a line number (eg: b 6, b code.pl 6, b code.pl 6 $x > 7,
b Calc::fib)
d Delete a break point (d 6, d code.pl 6)
e Eval Perl code and print the result (eg: e $x+$y)
f Show all the filenames loaded
l List codelines or set number of codelines to list (eg: l, l 20)
L List codelines always (toggle)
n Next (steps over subroutine calls)
o Output (show STDOUT, STDERR)
p Show pad
r Run until next break point or watch point
ret Return from subroutine (eg: ret, ret 3.141)
restart Restart the program
s Step (steps into subroutine calls)
T Show a stack trace
u Undo (eg: u, u 4)
w Set a watchpoint (eg: w $t > 10)
x Dump a variable using YAML (eg: x $object)
q Quit
';
} elsif ($command eq 'l') {
show_codelines($codelines, $ebug, $list_lines_count);
} elsif ($command =~ /^ l \s+ (\d+) $/x) {
$list_lines_count = $1 if $1 > 0;
show_codelines($codelines, $ebug, $list_lines_count);
} elsif ($command eq 'L') {
$list_always = !$list_always;
} elsif ($command eq 'p') {
my $pad = $ebug->pad_human;
foreach my $k (sort keys %$pad) {
my $v = $pad->{$k};
print " $k = $v;\n";
}
} elsif ($command eq 's') {
$ebug->step;
} elsif ($command eq 'n') {
$ebug->next;
} elsif ($command eq 'o') {
my($stdout, $stderr) = $ebug->output;
print "STDOUT:\n$stdout\n";
print "STDERR:\n$stderr\n";
} elsif ($command eq 'r') {
$ebug->run;
} elsif ($command eq 'restart') {
$ebug->load;
} elsif ($command =~ /^ret ?(.*)/) {
$ebug->return($1);
} elsif ($command eq 'T') {
my @trace = $ebug->stack_trace_human;
foreach my $frame (@trace) {
print "$frame\n";
}
} elsif ($command eq 'f') {
print "$_\n" foreach $ebug->filenames;
} elsif (my($line, $condition) = $command =~ /^b (\d+) ?(.*)/) {
undef $condition unless $condition;
$ebug->break_point($line, $condition);
} elsif ($command =~ /^b (.+?) (\d+) ?(.*)/) {
$ebug->break_point($1, $2, $3);
} elsif ($command =~ /^b (.+)/) {
$ebug->break_point_subroutine($1);
} elsif ($command =~ /^d (.+?) (\d+)/) {
$ebug->break_point_delete($1, $2);
} elsif ($command =~ /^d (\d+)/) {
$ebug->break_point_delete($1);
} elsif ($command =~ /^w (.+)/) {
my($watch_point) = $command =~ /^w (.+)/;
$ebug->watch_point($watch_point);
} elsif ($command =~ /^u ?(.*)/) {
$ebug->undo($1);
} elsif ($command eq 'q') {
exit;
} elsif ($command =~ /^x (.+)/) {
my $v = $ebug->eval("use YAML; Dump($1)") || "";
print "$v\n";
} elsif ($command =~ /^e (.+)/) {
my $v = $ebug->eval($1) || "";
print "$v\n";
} elsif ($command) {
my $v = $ebug->eval($command) || "";
print "$v\n";
}
$last_command = $command;
}
}
sub show_codelines {
my ($codelines, $ebug, $list_lines_count) = @_;
my $line_count = int($list_lines_count / 2);
if (not exists $codelines->{$ebug->filename}) {
$codelines->{$ebug->filename} = [$ebug->codelines];
}
my @span = ($ebug->line-$line_count .. $ebug->line+$line_count);
@span = grep { $_ > 0 } @span;
my @codelines = @{$codelines->{$ebug->filename}};
my @break_points = $ebug->break_points();
my %break_points;
$break_points{$_}++ foreach @break_points;
foreach my $s (@span) {
my $codeline = $codelines[$s -1 ];
next unless defined $codeline;
if ($s == $ebug->line) {
print "*";
} elsif ($break_points{$s}) {
print "b";
} else {
print " ";
}
print "$s:$codeline\n";
}
}
1;
__END__
=head1 NAME
Devel::ebug::Console - Console front end to Devel::ebug
=head1 SYNOPSIS
# it's easier to use the 'ebug' script
use Devel::ebug::Console;
my $console = Devel::ebug::Console->new();
$console->run();
=head1 DESCRIPTION
L<Devel::ebug::Console> is an interactive commmand-line front end to L<Devel::ebug>. It
is a simple Perl debugger, much like perl5db.pl.
=head1 SEE ALSO
L<Devel::ebug>, L<ebug>
=head1 AUTHOR
Leon Brocard, C<< <acme@astray.com> >>
=head1 COPYRIGHT
Copyright (C) 2005, Leon Brocard
This program is free software; you can redistribute it or modify it
under the same terms as Perl itself.
syntax highlighted by Code2HTML, v. 0.9.1