← Index
NYTProf Performance Profile   « line view »
For split.pl
  Run on Thu Apr 20 02:05:47 2023
Reported on Thu Apr 20 18:31:10 2023

Filename/home/hejohns/perl5/lib/perl5/Data/Printer/Theme.pm
StatementsExecuted 9 statements in 843µs
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1118µs9µsData::Printer::Theme::::BEGIN@4Data::Printer::Theme::BEGIN@4
1118µs9µsData::Printer::Theme::::BEGIN@2Data::Printer::Theme::BEGIN@2
1116µs9µsData::Printer::Theme::::BEGIN@95Data::Printer::Theme::BEGIN@95
1113µs18µsData::Printer::Theme::::BEGIN@3Data::Printer::Theme::BEGIN@3
111300ns300nsData::Printer::Theme::::__ANON__Data::Printer::Theme::__ANON__ (xsub)
0000s0sData::Printer::Theme::::__ANON__[:109]Data::Printer::Theme::__ANON__[:109]
0000s0sData::Printer::Theme::::__ANON__[:74]Data::Printer::Theme::__ANON__[:74]
0000s0sData::Printer::Theme::::_load_themeData::Printer::Theme::_load_theme
0000s0sData::Printer::Theme::::_maybe_override_theme_colorsData::Printer::Theme::_maybe_override_theme_colors
0000s0sData::Printer::Theme::::_parse_colorData::Printer::Theme::_parse_color
0000s0sData::Printer::Theme::::_rgb2shortData::Printer::Theme::_rgb2short
0000s0sData::Printer::Theme::::color_forData::Printer::Theme::color_for
0000s0sData::Printer::Theme::::color_resetData::Printer::Theme::color_reset
0000s0sData::Printer::Theme::::customizedData::Printer::Theme::customized
0000s0sData::Printer::Theme::::nameData::Printer::Theme::name
0000s0sData::Printer::Theme::::newData::Printer::Theme::new
0000s0sData::Printer::Theme::::sgr_color_forData::Printer::Theme::sgr_color_for
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package Data::Printer::Theme;
2219µs211µs
# spent 9µs (8+2) within Data::Printer::Theme::BEGIN@2 which was called: # once (8µs+2µs) by Data::Printer::Object::BEGIN@51 at line 2
use strict;
# spent 9µs making 1 call to Data::Printer::Theme::BEGIN@2 # spent 2µs making 1 call to strict::import
3213µs232µs
# spent 18µs (3+14) within Data::Printer::Theme::BEGIN@3 which was called: # once (3µs+14µs) by Data::Printer::Object::BEGIN@51 at line 3
use warnings;
# spent 18µs making 1 call to Data::Printer::Theme::BEGIN@3 # spent 14µs making 1 call to warnings::import
42329µs29µs
# spent 9µs (8+300ns) within Data::Printer::Theme::BEGIN@4 which was called: # once (8µs+300ns) by Data::Printer::Object::BEGIN@51 at line 4
use Data::Printer::Common;
# spent 9µs making 1 call to Data::Printer::Theme::BEGIN@4 # spent 300ns making 1 call to Data::Printer::Theme::__ANON__
5
6# the theme name
7sub name {
8 my ($self) = @_;
9 return $self->{name};
10}
11
12# true if the theme has at least one color override
13sub customized {
14 my ($self) = @_;
15 return exists $self->{is_custom} ? 1 : 0;
16}
17
18# displays the color as-is
19sub color_for {
20 my ($self, $color_type) = @_;
21 return $self->{colors}{$color_type} || '';
22}
23
24# prints the SGR (terminal) color modifier
25sub sgr_color_for {
26 my ($self, $color_type) = @_;
27 return unless exists $self->{sgr_colors}{$color_type};
28 return $self->{sgr_colors}{$color_type} || ''
29}
30
31# prints the SGR (terminal) color reset modifier
32sub color_reset { return "\e[m" }
33
34sub new {
35 my ($class, %params) = @_;
36
37 my $color_level = $params{color_level};
38 my $colors_to_override = $params{color_overrides};
39 my $theme_name = $params{name};
40
41 # before we put user info on string eval, make sure
42 # it's just a module name:
43 $theme_name =~ s/[^a-zA-Z0-9:]+//gsm;
44
45 my $theme = bless {
46 name => $theme_name,
47 color_level => $color_level,
48 colors => {},
49 sgr_colors => {},
50 }, $class;
51 $theme->_load_theme($params{ddp}) or delete $theme->{name};
52 $theme->_maybe_override_theme_colors($colors_to_override, $params{ddp});
53 return $theme;
54}
55
56sub _maybe_override_theme_colors {
57 my ($self, $colors_to_override, $ddp) = @_;
58
59 return unless $colors_to_override
60 && ref $colors_to_override eq 'HASH'
61 && keys %$colors_to_override;
62
63 my $error = Data::Printer::Common::_tryme(sub {
64 foreach my $kind (keys %$colors_to_override ) {
65 my $override = $colors_to_override->{$kind};
66 die "invalid color for '$kind': must be scalar not ref" if ref $override;
67 my $parsed = $self->_parse_color($override, $ddp);
68 if (defined $parsed) {
69 $self->{colors}{$kind} = $override;
70 $self->{sgr_colors}{$kind} = $parsed;
71 $self->{is_custom}{$kind} = 1;
72 }
73 }
74 });
75 if ($error) {
76 Data::Printer::Common::_warn($ddp, "error overriding color: $error. Skipping!");
77 }
78 return;
79}
80
81sub _load_theme {
82 my ($self, $ddp) = @_;
83 my $theme_name = $self->{name};
84
85 my $class = 'Data::Printer::Theme::' . $theme_name;
86 my $error = Data::Printer::Common::_tryme("use $class; 1;");
87 if ($error) {
88 Data::Printer::Common::_warn($ddp, "error loading theme '$theme_name': $error.");
89 return;
90 }
91 my $loaded_colors = {};
92 my $loaded_colors_sgr = {};
93 $error = Data::Printer::Common::_tryme(sub {
94 my $class_colors;
952481µs212µs
# spent 9µs (6+3) within Data::Printer::Theme::BEGIN@95 which was called: # once (6µs+3µs) by Data::Printer::Object::BEGIN@51 at line 95
{ no strict 'refs'; $class_colors = &{ $class . '::colors'}(); }
# spent 9µs making 1 call to Data::Printer::Theme::BEGIN@95 # spent 3µs making 1 call to strict::unimport
96 die "${class}::colors() did not return a hash reference"
97 unless ref $class_colors eq 'HASH';
98
99 foreach my $kind (keys %$class_colors) {
100 my $loaded_color = $class_colors->{$kind};
101 die "color for '$kind' must be a scalar in theme '$theme_name'"
102 if ref $loaded_color;
103 my $parsed_color = $self->_parse_color($loaded_color, $ddp);
104 if (defined $parsed_color) {
105 $loaded_colors->{$kind} = $loaded_color;
106 $loaded_colors_sgr->{$kind} = $parsed_color;
107 }
108 }
109 });
110 if ($error) {
111 Data::Printer::Common::_warn($ddp, "error loading theme '$theme_name': $error. Output will have no colors");
112 return;
113 }
114 $self->{colors} = $loaded_colors;
115 $self->{sgr_colors} = $loaded_colors_sgr;
116 return 1;
117}
118
119sub _parse_color {
120 my ($self, $color_label, $ddp) = @_;
121 return unless defined $color_label;
122 return '' unless $color_label;
123
124 my $color_code;
125 if ($color_label =~ /\Argb\((\d+),(\d+),(\d+)\)\z/) {
126 my ($r, $g, $b) = ($1, $2, $3);
127 if ($r < 256 && $g < 256 && $b < 256) {
128 if ($self->{color_level} == 3) {
129 $color_code = "\e[0;38;2;$r;$g;${b}m";
130 }
131 else {
132 my $reduced = _rgb2short($r,$g,$b);
133 $color_code = "\e[0;38;5;${reduced}m";
134 }
135 }
136 else {
137 Data::Printer::Common::_warn($ddp, "invalid color '$color_label': all colors must be between 0 and 255");
138 }
139 }
140 elsif ($color_label =~ /\A#([0-9a-f]{2})([0-9a-f]{2})([0-9a-f]{2})\z/i) {
141 my ($r, $g, $b) = map hex($_), ($1, $2, $3);
142 if ($self->{color_level} == 3) {
143 $color_code = "\e[0;38;2;$r;$g;${b}m";
144 }
145 else {
146 my $reduced = _rgb2short($r,$g,$b);
147 $color_code = "\e[0;38;5;${reduced}m";
148 }
149 }
150 elsif ($color_label =~ /\A\e\[\d+(:?;\d+)*m\z/) {
151 $color_code = $color_label;
152 }
153 elsif ($color_label =~ /\A
154 (?:
155 \s*
156 (?:on_)?
157 (?:bright_)?
158 (?:black|red|green|yellow|blue|magenta|cyan|white)
159 )+
160 \s*\z/x
161 ) {
162 my %ansi_colors = (
163 'black' => 30, 'on_black' => 40,
164 'red' => 31, 'on_red' => 41,
165 'green' => 32, 'on_green' => 42,
166 'yellow' => 33, 'on_yellow' => 43,
167 'blue' => 34, 'on_blue' => 44,
168 'magenta' => 35, 'on_magenta' => 45,
169 'cyan' => 36, 'on_cyan' => 46,
170 'white' => 37, 'on_white' => 47,
171 'bright_black' => 90, 'on_bright_black' => 100,
172 'bright_red' => 91, 'on_bright_red' => 101,
173 'bright_green' => 92, 'on_bright_green' => 102,
174 'bright_yellow' => 93, 'on_bright_yellow' => 103,
175 'bright_blue' => 94, 'on_bright_blue' => 104,
176 'bright_magenta' => 95, 'on_bright_magenta' => 105,
177 'bright_cyan' => 96, 'on_bright_cyan' => 106,
178 'bright_white' => 97, 'on_bright_white' => 107,
179 );
180 $color_code = "\e["
181 . join(';' => map $ansi_colors{$_}, split(/\s+/, $color_label))
182 . 'm'
183 ;
184 }
185 else {
186 Data::Printer::Common::_warn($ddp, "invalid color '$color_label'");
187 }
188 return $color_code;
189}
190
191sub _rgb2short {
192 my ($r,$g,$b) = @_;
193 my @snaps = (47, 115, 155, 195, 235);
194 my @new;
195 foreach my $color ($r,$g,$b) {
196 my $big = 0;
197 foreach my $s (@snaps) {
198 $big++ if $s < $color;
199 }
200 push @new, $big
201 }
202 return $new[0]*36 + $new[1]*6 + $new[2] + 16
203}
204
20512µs1;
206__END__
 
# spent 300ns within Data::Printer::Theme::__ANON__ which was called: # once (300ns+0s) by Data::Printer::Theme::BEGIN@4 at line 4
sub Data::Printer::Theme::__ANON__; # xsub
Report produced by the NYTProf 6.12 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.