[Bast-commits] r3764 - in trunk/Devel-REPL: . lib/Devel/REPL/Plugin

[Sartak at dev.catalyst.perl.org]

Author: Sartak
Date: 2007-09-21 04:48:48 +0100 (Fri, 21 Sep 2007)
New Revision: 3764

Added:
   trunk/Devel-REPL/lib/Devel/REPL/Plugin/Colors.pm
Modified:
   trunk/Devel-REPL/Makefile.PL
Log:
'Colors' plugin to colorize return values and errors (dep on Term::ANSIColor)


Modified: trunk/Devel-REPL/Makefile.PL
===================================================================
--- trunk/Devel-REPL/Makefile.PL	2007-09-21 00:26:33 UTC (rev 3763)
+++ trunk/Devel-REPL/Makefile.PL	2007-09-21 03:48:48 UTC (rev 3764)
@@ -18,6 +18,7 @@
 requires 'Lexical::Persistence';
 requires 'Data::Dump::Streamer';
 requires 'PPI';
+requires 'Term::ANSIColor';
 
 auto_install;
 WriteAll;

Added: trunk/Devel-REPL/lib/Devel/REPL/Plugin/Colors.pm
===================================================================
--- trunk/Devel-REPL/lib/Devel/REPL/Plugin/Colors.pm	                        (rev 0)
+++ trunk/Devel-REPL/lib/Devel/REPL/Plugin/Colors.pm	2007-09-21 03:48:48 UTC (rev 3764)
@@ -0,0 +1,101 @@
+package Devel::REPL::Plugin::Colors;
+
+use Moose::Role;
+use Term::ANSIColor;
+use namespace::clean -except => [ 'meta' ];
+
+has normal_color => (
+  is => 'rw', lazy => 1,
+  default => 'green',
+);
+
+has error_color => (
+  is => 'rw', lazy => 1,
+  default => 'bold red',
+);
+
+around error_return => sub {
+  my $orig = shift;
+  my $self = shift;
+  return color($self->error_color)
+       . $orig->($self, @_)
+       . color('reset');
+};
+
+# we can't just munge @_ because that screws up DDS
+around print => sub {
+  my $orig = shift;
+  my $self = shift;
+  print {$self->out_fh} color($self->normal_color);
+  $orig->($self, @_);
+  print {$self->out_fh} color('reset');
+};
+
+# make arbitrary warns colored -- somewhat difficult because warn doesn't
+# get $self, so we localize $SIG{__WARN__} during eval so it can get
+# error_color
+
+around execute => sub {
+  my $orig = shift;
+  my $self = shift;
+
+  local $SIG{__WARN__} = sub {
+    my $warning = shift;
+    chomp $warning;
+    warn color($self->error_color || 'bold red')
+       . $warning
+       . color('reset')
+       . "\n";
+  };
+
+  $orig->($self, @_);
+};
+
+1;
+
+__END__
+
+=head1 NAME
+
+Devel::REPL::Plugin::Colors - add color to return values, warnings, and errors
+
+=head1 SYNOPSIS
+
+    #!/usr/bin/perl 
+
+    use lib './lib';
+    use Devel::REPL;
+
+    my $repl = Devel::REPL->new;
+    $repl->load_plugin('LexEnv');
+    $repl->load_plugin('History');
+    $repl->load_plugin('Colors');
+    $repl->run;
+
+=head1 DESCRIPTION
+
+Colors are very pretty.
+
+This plugin causes certain prints, warns, and errors to be colored. Generally
+the return value(s) of each line will be colored green (you can override this
+by setting C<< $_REPL->normal_color >> in your rcfile). Warnings and
+compile/runtime errors will be colored with C<< $_REPL->error_color >>. This
+plugin uses L<Term::ANSIColor>, so consult that module for valid colors. The
+defaults are actually 'green' and 'bold red'.
+
+=head1 SEE ALSO
+
+C<Devel::REPL>
+
+=head1 AUTHOR
+
+Shawn M Moore, C<< <sartak at gmail dot com> >>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2007 by Shawn M Moore
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut