File Coverage

blib/lib/Devel/REPL/Plugin/Colors.pm
Criterion Covered Total %
statement 18 32 56.2
branch n/a
condition 0 4 0.0
subroutine 6 9 66.6
pod n/a
total 24 45 53.3


line stmt bran cond sub pod time code
1 2     2   2384 use strict;
  2         4  
  2         64  
2 2     2   10 use warnings;
  2         4  
  2         124  
3             # ABSTRACT: Add color to return values, warnings, and errors
4              
5             our $VERSION = '1.003029';
6              
7             use Devel::REPL::Plugin;
8 2     2   354 use Term::ANSIColor;
  2         5  
  2         12  
9 2     2   9949 use namespace::autoclean;
  2         14816  
  2         219  
10 2     2   19  
  2         4  
  2         23  
11             has normal_color => (
12             is => 'rw', lazy => 1,
13             default => 'green',
14             );
15              
16             has error_color => (
17             is => 'rw', lazy => 1,
18             default => 'bold red',
19             );
20              
21             around format_error => sub {
22             my $orig = shift;
23             my $self = shift;
24             return color($self->error_color)
25             . $orig->($self, @_)
26             . color('reset');
27             };
28              
29             # we can't just munge @_ because that screws up DDS
30             around format_result => sub {
31             my $orig = shift;
32             my $self = shift;
33             no warnings 'uninitialized';
34 2     2   361 return join "", (
  2         4  
  2         439  
35             color($self->normal_color),
36             $orig->($self, @_),
37             color('reset'),
38             );
39             };
40              
41             # make arbitrary warns colored -- somewhat difficult because warn doesn't
42             # get $self, so we localize $SIG{__WARN__} during eval so it can get
43             # error_color
44              
45             my $orig = shift;
46             my $self = shift;
47 0     0      
  0     0      
48 0           local $SIG{__WARN__} = sub {
  0            
49             my $warning = shift;
50             chomp $warning;
51 0     0     warn color($self->error_color || 'bold red')
  0            
52 0           . $warning
  0            
53 0   0       . color('reset')
  0   0        
54             . "\n";
55             };
56              
57 0           $orig->($self, @_);
  0            
58             };
59 0            
  0            
60             around compile => \&_wrap_warn;
61             around execute => \&_wrap_warn;
62              
63             1;
64              
65              
66             =pod
67              
68             =encoding UTF-8
69              
70             =head1 NAME
71              
72             Devel::REPL::Plugin::Colors - Add color to return values, warnings, and errors
73              
74             =head1 VERSION
75              
76             version 1.003029
77              
78             =head1 SYNOPSIS
79              
80             use Devel::REPL;
81              
82             my $repl = Devel::REPL->new;
83             $repl->load_plugin('LexEnv');
84             $repl->load_plugin('History');
85             $repl->load_plugin('Colors');
86             $repl->run;
87              
88             =head1 DESCRIPTION
89              
90             Colors are very pretty.
91              
92             This plugin causes certain prints, warns, and errors to be colored. Generally
93             the return value(s) of each line will be colored green (you can override this
94             by setting C<< $_REPL->normal_color >> in your rcfile). Warnings and
95             compile/runtime errors will be colored with C<< $_REPL->error_color >>. This
96             plugin uses L<Term::ANSIColor>, so consult that module for valid colors. The
97             defaults are actually 'green' and 'bold red'.
98              
99             =head1 SEE ALSO
100              
101             C<Devel::REPL>
102              
103             =head1 SUPPORT
104              
105             Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=Devel-REPL>
106             (or L<bug-Devel-REPL@rt.cpan.org|mailto:bug-Devel-REPL@rt.cpan.org>).
107              
108             There is also an irc channel available for users of this distribution, at
109             L<C<#devel> on C<irc.perl.org>|irc://irc.perl.org/#devel-repl>.
110              
111             =head1 AUTHOR
112              
113             Shawn M Moore, C<< <sartak at gmail dot com> >>
114              
115             =head1 COPYRIGHT AND LICENSE
116              
117             Copyright (C) 2007 by Shawn M Moore
118              
119             This library is free software; you can redistribute it and/or modify
120             it under the same terms as Perl itself.
121              
122             =cut