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