1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
package Reply::Plugin::CarpReply;
use strict;
use warnings;
use base 'Reply::Plugin';
use Devel::StackTrace::WithLexicals;
sub new {
my $class = shift;
my $self = $class->SUPER::new(@_);
$self->{stacktrace} = Devel::StackTrace::WithLexicals->new(
ignore_class => ['Reply', 'Carp::Reply', __PACKAGE__],
);
$self->{frame_index} = 0;
return $self;
}
sub compile {
my $self = shift;
my ($next, $line, %opts) = @_;
$opts{environment} = $self->_frame->lexicals;
return $next->($line, %opts);
}
sub command_backtrace {
my $self = shift;
print "Backtrace:\n";
print $self->{stacktrace};
return '';
}
sub command_top {
my $self = shift;
$self->_frame_index($self->{stacktrace}->frame_count - 1);
return '';
}
sub command_bottom {
my $self = shift;
$self->_frame_index(0);
return '';
}
sub command_up {
my $self = shift;
$self->_frame_index($self->{frame_index} + 1);
return '';
}
sub command_down {
my $self = shift;
$self->_frame_index($self->{frame_index} - 1);
return '';
}
sub command_list {
my $self = shift;
my $file = $self->_frame->filename;
my $line = $self->_frame->line;
if (open my $fh, '<', $file) {
my @code = <$fh>;
chomp @code;
my $min = $line - 6;
my $max = $line + 4;
$min = 0 if $min < 0;
$max = $#code if $max > $#code;
print "File $file:\n";
for my $cur ($min..$max) {
next unless defined $code[$cur];
printf "%s%*d: %s\n",
$cur + 1 == $line ? '*' : ' ',
length($max + 1),
$cur + 1,
$code[$cur];
}
}
else {
print "Unable to open $file for reading: $!";
}
return '';
}
sub command_env {
my $self = shift;
our $env = $self->_frame->lexicals;
return '$' . __PACKAGE__ . '::env';
}
sub command_trace { shift->command_backtrace(@_) }
sub command_bt { shift->command_backtrace(@_) }
sub command_t { shift->command_top(@_) }
sub command_b { shift->command_bottom(@_) }
sub command_u { shift->command_up(@_) }
sub command_d { shift->command_down(@_) }
sub command_l { shift->command_list(@_) }
sub _frame_index {
my $self = shift;
my ($index) = @_;
if ($index < 0) {
print "You're already at the bottom frame.\n";
}
elsif ($index >= $self->{stacktrace}->frame_count) {
print "You're already at the top frame.\n";
}
else {
$self->{frame_index} = $index;
printf "Now at %s:%s (frame $index)\n",
$self->_frame->filename,
$self->_frame->line;
}
}
sub _frame {
my $self = shift;
return $self->{stacktrace}->frame($self->{frame_index});
}
1;
|
