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   3275 use strict;
  2         6  
  2         80  
2 2     2   12 use warnings;
  2         46  
  2         197  
3             package Devel::REPL::Plugin::Colors;
4             # ABSTRACT: Add color to return values, warnings, and errors
5              
6             our $VERSION = '1.003027';
7              
8 2     2   538 use Devel::REPL::Plugin;
  2         6  
  2         18  
9 2     2   15073 use Term::ANSIColor;
  2         14205  
  2         216  
10 2     2   21 use namespace::autoclean;
  2         4  
  2         21  
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   367 no warnings 'uninitialized';
  2         3  
  2         561  
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.003027
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 AUTHOR
107              
108             Shawn M Moore, C<< <sartak at gmail dot com> >>
109              
110             =head1 COPYRIGHT AND LICENSE
111              
112             Copyright (C) 2007 by Shawn M Moore
113              
114             This library is free software; you can redistribute it and/or modify
115             it under the same terms as Perl itself.
116              
117             =cut