File: Theme.pm

package info (click to toggle)
libdata-printer-perl 1.000001-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye
  • size: 692 kB
  • sloc: perl: 4,208; makefile: 7
file content (329 lines) | stat: -rw-r--r-- 11,524 bytes parent folder | download
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
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
package Data::Printer::Theme;
use strict;
use warnings;
use Data::Printer::Common;

# the theme name
sub name {
    my ($self) = @_;
    return $self->{name};
}

# true if the theme has at least one color override
sub customized {
    my ($self) = @_;
    return exists $self->{is_custom} ? 1 : 0;
}

# displays the color as-is
sub color_for {
    my ($self, $color_type) = @_;
    return $self->{colors}{$color_type} || '';
}

# prints the SGR (terminal) color modifier
sub sgr_color_for {
    my ($self, $color_type) = @_;
    return unless exists $self->{sgr_colors}{$color_type};
    return $self->{sgr_colors}{$color_type} || ''
}

# prints the SGR (terminal) color reset modifier
sub color_reset { return "\e[0m" }

sub new {
    my ($class, %params) = @_;

    my $color_level        = $params{color_level};
    my $colors_to_override = $params{color_overrides};
    my $theme_name         = $params{name};

    # before we put user info on string eval, make sure
    # it's just a module name:
    $theme_name =~ s/[^a-zA-Z0-9:]+//gsm;

    my $theme = bless {
        name        => $theme_name,
        color_level => $color_level,
        colors      => {},
        sgr_colors  => {},
    }, $class;
    $theme->_load_theme($params{ddp}) or delete $theme->{name};
    $theme->_maybe_override_theme_colors($colors_to_override, $params{ddp});
    return $theme;
}

sub _maybe_override_theme_colors {
    my ($self, $colors_to_override, $ddp) = @_;

    return unless $colors_to_override
               && ref $colors_to_override eq 'HASH'
               && keys %$colors_to_override;

    my $error = Data::Printer::Common::_tryme(sub {
        foreach my $kind (keys %$colors_to_override ) {
            my $override = $colors_to_override->{$kind};
            die "invalid color for '$kind': must be scalar not ref" if ref $override;
            my $parsed = $self->_parse_color($override, $ddp);
            if (defined $parsed) {
                $self->{colors}{$kind}     = $override;
                $self->{sgr_colors}{$kind} = $parsed;
                $self->{is_custom}{$kind}  = 1;
            }
        }
    });
    if ($error) {
        Data::Printer::Common::_warn($ddp, "error overriding color: $error. Skipping!");
    }
    return;
}

sub _load_theme {
    my ($self, $ddp) = @_;
    my $theme_name = $self->{name};

    my $class = 'Data::Printer::Theme::' . $theme_name;
    my $error = Data::Printer::Common::_tryme("use $class; 1;");
    if ($error) {
        Data::Printer::Common::_warn($ddp, "error loading theme '$theme_name': $error.");
        return;
    }
    my $loaded_colors     = {};
    my $loaded_colors_sgr = {};
    $error = Data::Printer::Common::_tryme(sub {
        my $class_colors;
        { no strict 'refs'; $class_colors = &{ $class . '::colors'}(); }
        die "${class}::colors() did not return a hash reference"
            unless ref $class_colors eq 'HASH';

        foreach my $kind (keys %$class_colors) {
            my $loaded_color = $class_colors->{$kind};
            die "color for '$kind' must be a scalar in theme '$theme_name'"
                if ref $loaded_color;
            my $parsed_color = $self->_parse_color($loaded_color, $ddp);
            if (defined $parsed_color) {
                $loaded_colors->{$kind}     = $loaded_color;
                $loaded_colors_sgr->{$kind} = $parsed_color;
            }
        }
    });
    if ($error) {
        Data::Printer::Common::_warn($ddp, "error loading theme '$theme_name': $error. Output will have no colors");
        return;
    }
    $self->{colors}     = $loaded_colors;
    $self->{sgr_colors} = $loaded_colors_sgr;
    return 1;
}

sub _parse_color {
    my ($self, $color_label, $ddp) = @_;
    return unless defined $color_label;
    return '' unless $color_label;

    my $color_code;
    if ($color_label =~ /\Argb\((\d+),(\d+),(\d+)\)\z/) {
        my ($r, $g, $b) = ($1, $2, $3);
        if ($r < 256 && $g < 256 && $b < 256) {
            if ($self->{color_level} == 3) {
                $color_code = "\e[0;38;2;$r;$g;${b}m";
            }
            else {
                my $reduced = _rgb2short($r,$g,$b);
                $color_code = "\e[0;38;5;${reduced}m";
            }
        }
        else {
            Data::Printer::Common::_warn($ddp, "invalid color '$color_label': all colors must be between 0 and 255");
        }
    }
    elsif ($color_label =~ /\A#([0-9a-f]{2})([0-9a-f]{2})([0-9a-f]{2})\z/i) {
        my ($r, $g, $b) = map hex($_), ($1, $2, $3);
        if ($self->{color_level} == 3) {
            $color_code = "\e[0;38;2;$r;$g;${b}m";
        }
        else {
            my $reduced = _rgb2short($r,$g,$b);
            $color_code = "\e[0;38;5;${reduced}m";
        }
    }
    elsif ($color_label =~ /\A\e\[\d+(:?;\d+)*m\z/) {
        $color_code = $color_label;
    }
    elsif ($color_label =~ /\A
        (?:
         \s*
          (?:on_)?
          (?:bright_)?
          (?:black|red|green|yellow|blue|magenta|cyan|white)
        )+
        \s*\z/x
    ) {
        my %ansi_colors = (
            'black'          => 30,   'on_black'          => 40,
            'red'            => 31,   'on_red'            => 41,
            'green'          => 32,   'on_green'          => 42,
            'yellow'         => 33,   'on_yellow'         => 43,
            'blue'           => 34,   'on_blue'           => 44,
            'magenta'        => 35,   'on_magenta'        => 45,
            'cyan'           => 36,   'on_cyan'           => 46,
            'white'          => 37,   'on_white'          => 47,
            'bright_black'   => 90,   'on_bright_black'   => 100,
            'bright_red'     => 91,   'on_bright_red'     => 101,
            'bright_green'   => 92,   'on_bright_green'   => 102,
            'bright_yellow'  => 93,   'on_bright_yellow'  => 103,
            'bright_blue'    => 94,   'on_bright_blue'    => 104,
            'bright_magenta' => 95,   'on_bright_magenta' => 105,
            'bright_cyan'    => 96,   'on_bright_cyan'    => 106,
            'bright_white'   => 97,   'on_bright_white'   => 107,
        );
        $color_code = "\e["
                    . join(';' => map $ansi_colors{$_}, split(/\s+/, $color_label))
                    . 'm'
                    ;
    }
    else {
        Data::Printer::Common::_warn($ddp, "invalid color '$color_label'");
    }
    return $color_code;
}

sub _rgb2short {
    my ($r,$g,$b) = @_;
    my @snaps = (47, 115, 155, 195, 235);
    my @new;
    foreach my $color ($r,$g,$b) {
        my $big = 0;
        foreach my $s (@snaps) {
            $big++ if $s < $color;
        }
        push @new, $big
    }
    return $new[0]*36 + $new[1]*6 + $new[2] + 16
}

1;
__END__

=head1 NAME

Data::Printer::Theme - create your own color themes for DDP!

=head1 SYNOPSIS

    package Data::Printer::Theme::MyCustomTheme;

    sub colors {
        return {
            array       => '#aabbcc', # array index numbers
            number      => '#aabbcc', # numbers
            string      => '#aabbcc', # strings
            class       => '#aabbcc', # class names
            method      => '#aabbcc', # method names
            undef       => '#aabbcc', # the 'undef' value
            hash        => '#aabbcc', # hash keys
            regex       => '#aabbcc', # regular expressions
            code        => '#aabbcc', # code references
            glob        => '#aabbcc', # globs (usually file handles)
            vstring     => '#aabbcc', # version strings (v5.30.1, etc)
            lvalue      => '#aabbcc', # lvalue label
            format      => '#aabbcc', # format type
            repeated    => '#aabbcc', # references to seen values
            caller_info => '#aabbcc', # details on what's being printed
            weak        => '#aabbcc', # weak references flag
            tainted     => '#aabbcc', # tainted flag
            unicode     => '#aabbcc', # utf8 flag
            escaped     => '#aabbcc', # escaped characters (\t, \n, etc)
            brackets    => '#aabbcc', # (), {}, []
            separator   => '#aabbcc', # the "," between hash pairs, array elements, etc
            quotes      => '#aabbcc', # q(")
            unknown     => '#aabbcc', # any (potential) data type unknown to Data::Printer
        };
    }
    1;

Then in your C<.dataprinter> file:

    theme = MyCustomTheme

That's it! Alternatively, you can load it at runtime:

    use DDP theme => 'MyCustomTheme';


=head1 DESCRIPTION

Data::Printer colorizes your output by default. Originally, the only way to
customize colors was to override the default ones. Data::Printer 1.0 introduced
themes, and now you can pick a theme or create your own.

Data::Printer comes with several themes for you to choose from:

=over 4

=item * L<Material|Data::Printer::Theme::Material> I<(the default)>

=for html <a href="https://metacpan.org/pod/Data::Printer::Theme::Material"><img style="height:50%" src="https://raw.githubusercontent.com/garu/Data-Printer/master/examples/theme-material.png" alt="Material Theme" /></a>

=item * L<Monokai|Data::Printer::Theme::Monokai>

=for html <a href="https://metacpan.org/pod/Data::Printer::Theme::Monokai"><img style="height:50%" src="https://raw.githubusercontent.com/garu/Data-Printer/master/examples/theme-monokai.png" alt="Monokai Theme" /></a>

=item * L<Solarized|Data::Printer::Theme::Solarized>

=for html <a href="https://metacpan.org/pod/Data::Printer::Theme::Solarized"><img style="height:50%" src="https://raw.githubusercontent.com/garu/Data-Printer/master/examples/theme-solarized.png" alt="Solarized Theme" /></a>

=item * L<Classic|Data::Printer::Theme::Classic> I<(original pre-1.0 colors)>

=for html <a href="https://metacpan.org/pod/Data::Printer::Theme::Classic"><img style="height:50%" src="https://raw.githubusercontent.com/garu/Data-Printer/master/examples/theme-classic.png" alt="Classic Theme" /></a>

=back

Run C<< examples/try_me.pl >> to see them in action on your own terminal!


=head1 CREATING YOUR THEMES

A theme is a module in the C<Data::Printer::Theme> namespace. It doesn't have
to inherit or load any module. All you have to do is implement a single
function, C<colors>, that returns a hash reference where keys are the
expected color labels, and values are the colors you want to use.

Feel free to copy & paste the code from the SYNOPSIS and customize at will :)

=head2 Customizing Colors

Setting any color to C<undef> means I<< "Don't colorize this" >>.
Otherwise, the color is a string which can be one of the following:

=head3 Named colors, Term::ANSIColor style (discouraged)

Only 8 named colors are supported:

black, red, green, yellow, blue, magenta, cyan, white

and their C<bright_XXX>, C<on_XXX> and C<on_bright_XXX> variants.

Those are provided only as backards compatibility with older versions
of Data::Printer and, because of their limitation, we encourage you
to try and use one of the other representations.

=head3 SGR Escape code (Terminal style)

You may provide any SGR escape sequence, and they will be honored
as long as you use double quotes (e.g. C<"\e[38;5;196m">). You may
use this to achieve extra control like blinking, etc. Note, however,
that some terminals may not support them.

=head3 An RGB value in one of those formats (Recommended)

    'rgb(0,255,30)'
    '#00FF3B'

B<NOTE:> There may not be a real 1:1 conversion between RGB and
terminal colors. In those cases we use approximation to achieve the
closest option.

=head1 SEE ALSO

L<Data::Printer>