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	dpavlin	465	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	dpavlin	470	lazy => 1,
17	dpavlin	465	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;