lib/Frey/Backtrace.pm

package Frey::Backtrace;
use Moose::Role;

use Data::Dump qw/dump/;

=head1 DESCRIPTION

Show backtrace with links to editor

=cut

has 'caller_fields' => (
        is => 'rw',
        isa => 'ArrayRef[Str]',
        required => 1,
        lazy => 1,
        default => sub { [ qw/
                        package filename line
                        subroutine hasargs
                        wantarray evaltext is_require
                        hints bitmask hinthash
        / ] },
);

=head2 backtrace

  my @backtrace = $self->backtrace;

=cut

sub backtrace {
        my ($self) = @_;

        my @backtrace;
        foreach ( 0 .. 5 ) {
                my @caller = caller($_) or last;
                push @backtrace, join(' ',
                        map {
                                my $name = $self->caller_fields->[$_];
                                my $val  = $caller[$_];
                                if ( $name eq 'filename' ) {
                                        my $line = $caller[ $_ + 1 ];
                                        qq|$name <a target="editor" href="/editor+$val+$line">$val</a>|;
                                } else {
                                        $name . ': ' . dump $val
                                }
                        } ( 0 .. $#{ $self->caller_fields } )
                );
        }
        warn "# backtrace: ", dump( @backtrace ) if @backtrace;
        return @backtrace;
}

1;
1	package Frey::Backtrace;
2	use Moose::Role;
3
4	use Data::Dump qw/dump/;
5
6	=head1 DESCRIPTION
7
8	Show backtrace with links to editor
9
10	=cut
11
12	has 'caller_fields' => (
13	is => 'rw',
14	isa => 'ArrayRef[Str]',
15	required => 1,
16	lazy => 1,
17	default => sub { [ qw/
18	package filename line
19	subroutine hasargs
20	wantarray evaltext is_require
21	hints bitmask hinthash
22	/ ] },
23	);
24
25	=head2 backtrace
26
27	my @backtrace = $self->backtrace;
28
29	=cut
30
31	sub backtrace {
32	my ($self) = @_;
33
34	my @backtrace;
35	foreach ( 0 .. 5 ) {
36	my @caller = caller($_) or last;
37	push @backtrace, join(' ',
38	map {
39	my $name = $self->caller_fields->[$_];
40	my $val = $caller[$_];
41	if ( $name eq 'filename' ) {
42	my $line = $caller[ $_ + 1 ];
43	qq\|$name <a target="editor" href="/editor+$val+$line">$val</a>\|;
44	} else {
45	$name . ': ' . dump $val
46	}
47	} ( 0 .. $#{ $self->caller_fields } )
48	);
49	}
50	warn "# backtrace: ", dump( @backtrace ) if @backtrace;
51	return @backtrace;
52	}
53
54	1;