File Coverage

lib/StackTrace/Pretty/Printer.pm
Criterion Covered Total %
statement 15 69 21.7
branch 2 26 7.6
condition 0 7 0.0
subroutine 4 8 50.0
pod 0 2 0.0
total 21 112 18.7


line stmt bran cond sub pod time code
1             package StackTrace::Pretty::Printer;
2 1     1   73437 use strict;
  1         13  
  1         28  
3 1     1   4 use warnings;
  1         2  
  1         35  
4 1     1   5 use utf8;
  1         2  
  1         4  
5              
6             our $COLOR_RAW_LINE = "\e[38;5;252m";
7             our $COLOR_RAW_LINE_DEST_NAME = "\e[38;5;10m";
8             our $COLOR_RAW_LINE_DEST_ARGS = "\e[38;5;69m";
9             our $COLOR_RAW_LINE_FILENAME = "\e[38;5;208m";
10             our $COLOR_LINENUM = "\e[38;5;239m";
11             our $COLOR_NORMAL_LINE = "\e[38;5;242m";
12             our $COLOR_CURRENT_LINE = "\e[38;5;230m\e[48;5;234m";
13             our $COLOR_RESET = "\e[0m";
14             our $COLOR_STACK_TRACE_START = "\e[38;5;11m";
15              
16              
17             sub new {
18 0     0 0 0 my ($class, @args) = @_;
19 0 0       0 my $args = (ref $args[0] eq 'HASH') ? $args[0] : { @args };
20              
21 0         0 bless $args, $class;
22             }
23              
24             sub print {
25 0     0 0 0 my ($self, @args) = @_;
26 0 0       0 my $args = (ref $args[0] eq 'HASH') ? $args[0] : { @args };
27              
28 0         0 my $depth = $args->{depth};
29              
30 0 0       0 defined $args->{line} or die "'line' required";
31 0         0 my $extracted_from_line = $self->_extract_func_and_line_num($args->{line});
32 0   0     0 my $dest_func = $extracted_from_line->{dest_func} // '';
33 0         0 my $filename = $extracted_from_line->{filename};
34 0         0 my $lineno = $extracted_from_line->{lineno};
35              
36 0 0 0     0 if (defined $depth and $depth == 0) {
37 0         0 $self->_print_start_stack_trace($filename, $lineno);
38             }
39              
40 0   0     0 my $num_lines_context = $args->{num_lines_context} // 2;
41              
42 0         0 my $print_start = $lineno - $num_lines_context;
43 0 0       0 if ($print_start < 1) {
44 0         0 $print_start = 1;
45             }
46 0         0 my $print_end = $lineno + $num_lines_context;
47 0         0 my $line_num_area_width = length $print_end;
48              
49 0 0       0 if (defined $depth) {
50 0         0 print "[$depth] ";
51             }
52 0         0 my $string_printed_raw = $args->{line};
53 0         0 $string_printed_raw
54             =~ s/called at (\S+) line (\d+)$/${COLOR_RAW_LINE}called at${COLOR_RAW_LINE} ${COLOR_RAW_LINE_FILENAME}${1}${COLOR_RAW_LINE} line ${COLOR_RAW_LINE_FILENAME}${2}${COLOR_RAW_LINE}/;
55 0         0 $string_printed_raw
56             =~ s/^([^\(]+)/${COLOR_RAW_LINE_DEST_NAME}${1}${COLOR_RAW_LINE_DEST_ARGS}/;
57 0         0 print "${COLOR_RAW_LINE}${string_printed_raw}${COLOR_RESET}\n";
58              
59 0 0       0 return if $self->_excluded_destination($dest_func);
60              
61 0         0 my $open_success = open my $IN, '<', $filename;
62 0 0       0 if (not $open_success) {
63 0         0 print "No such file $filename\n";
64 0         0 return;
65             };
66              
67 0         0 <$IN> for (1 .. $print_start - 1);
68              
69 0         0 print "----------------------------------------------------\n";
70 0         0 for my $current_line_no ($print_start .. $print_end) {
71 0         0 my $line = <$IN>;
72 0 0       0 if (not $line) {
73 0         0 last;
74             }
75 0         0 chomp($line);
76              
77 0 0       0 my $color_highlight_code = ($lineno == $current_line_no) ? $COLOR_CURRENT_LINE : $COLOR_NORMAL_LINE;
78 0         0 print sprintf(
79             "${COLOR_LINENUM}%${line_num_area_width}d:${COLOR_RESET} "
80             . "${color_highlight_code}%s${COLOR_RESET}"
81             . "\n",
82             $current_line_no,
83             $line
84             );
85             }
86 0         0 print "----------------------------------------------------\n";
87              
88 0         0 close $IN;
89             }
90              
91             sub _excluded_destination {
92 0     0   0 my ($self, $dest_func) = @_;
93              
94 0 0       0 return unless $self->{excluded_modules};
95              
96 0         0 for my $module_name (@{ $self->{excluded_modules} }) {
  0         0  
97 0 0       0 if ($dest_func =~ /$module_name/) {
98 0         0 return 1;
99             }
100             }
101              
102 0         0 return 0;
103             }
104              
105             sub _print_start_stack_trace {
106 0     0   0 my ($self, $filename, $lineno) = @_;
107              
108 0         0 print $COLOR_STACK_TRACE_START;
109 0         0 print "-------------------------------------------------------------------------\n";
110 0         0 print " Stack trace start at line $lineno of $filename\n";
111 0         0 print "-------------------------------------------------------------------------\n";
112 0         0 print $COLOR_RESET;
113             }
114              
115             sub _extract_func_and_line_num {
116 2     2   6466 my ($self, $line) = @_;
117              
118 2         4 my ($dest_func, $filename, $target_line_num);
119              
120 2 100       8 if ($line =~ /^\S/) { # first line
121 1         11 ($filename, $target_line_num) = $line =~ /^.*? at (\S+) line (\d+)\.$/;
122             }
123             else {
124 1         17 ($dest_func, $filename, $target_line_num) = $line =~ /^\s+(.*?) called at (\S+) line (\d+)$/;
125             }
126              
127             return {
128 2         11 dest_func => $dest_func,
129             filename => $filename,
130             lineno => $target_line_num,
131             };
132             }
133              
134              
135             1;