--- lib/Data/Printer.pm
+++ lib/Data/Printer.pm
@@ -1,7 +1,7 @@
package Data::Printer;
use strict;
use warnings;
-use Term::ANSIColor;
+use Term::ANSIColor qw(); #to prevent accidental direct call
use Scalar::Util;
use Sort::Naturally;
use Class::MOP;
@@ -152,15 +152,15 @@
}
# colors only if we're not being piped
+ my $out = '';
if ( !$p->{colored} or ($p->{colored} eq 'auto' and not -t *STDERR) ) {
- $ENV{ANSI_COLORS_DISABLED} = 1;
+ $p->{_colored} = 0;
}
else {
- delete $ENV{ANSI_COLORS_DISABLED};
+ $p->{_colored} = 1;
+ $out .= Term::ANSIColor::color('reset');
}
- my $out = color('reset');
-
if ( $p->{caller_info} and $p->{_depth} == 0 ) {
$out .= _get_info_message($p);
}
@@ -182,7 +182,7 @@
my $id = _object_id( $item );
if ( exists $p->{_seen}->{$id} ) {
if ( not defined $p->{_reftype} ) {
- return colored($p->{_seen}->{$id}, $p->{color}->{repeated});
+ return _colored($p->{_seen}->{$id}, $p->{color}->{repeated}, $p->{_colored});
}
}
else {
@@ -235,13 +235,13 @@
my $string = '';
if (not defined $$item) {
- $string .= colored('undef', $p->{color}->{'undef'});
+ $string .= _colored('undef', $p->{color}->{'undef'}, $p->{_colored});
}
elsif (Scalar::Util::looks_like_number($$item)) {
- $string .= colored($$item, $p->{color}->{'number'});
+ $string .= _colored($$item, $p->{color}->{'number'}, $p->{_colored});
}
else {
- $string .= colored(qq["$$item"], $p->{color}->{'string'});
+ $string .= _colored(qq["$$item"], $p->{color}->{'string'}, $p->{_colored});
}
$p->{_tie} = ref tied $$item;
@@ -271,9 +271,10 @@
my $array_elem = $item->[$i];
$string .= (' ' x $p->{_current_indent});
if ($p->{'index'}) {
- $string .= colored(
+ $string .= _colored(
sprintf("%-*s", 3 + length($#{$item}), "[$i]"),
- $p->{color}->{'array'}
+ $p->{color}->{'array'},
+ $p->{_colored}
);
}
@@ -287,7 +288,7 @@
else {
$string .= _p( $array_elem, $p );
}
- $string .= ' ' . colored('(weak)', $p->{color}->{'weak'})
+ $string .= ' ' . _colored('(weak)', $p->{color}->{'weak'}, $p->{_colored})
if $ref and Scalar::Util::isweak($item->[$i]);
$string .= ($i == $#{$item} ? '' : ',') . $BREAK;
@@ -315,7 +316,7 @@
qw(SCALAR CODE Regexp ARRAY HASH GLOB REF);
}
$string .= _p($$item, $p);
- $string .= ' ' . colored('(weak)', $p->{color}->{'weak'}) if Scalar::Util::isweak($$item);
+ $string .= ' ' . _colored('(weak)', $p->{color}->{'weak'}, $p->{_colored}) if Scalar::Util::isweak($$item);
return $string;
}
@@ -328,7 +329,7 @@
if ($p->{deparse}) {
$code = _deparse( $item, $p );
}
- $string .= colored($code, $p->{color}->{'code'});
+ $string .= _colored($code, $p->{color}->{'code'}, $p->{_colored});
return $string;
}
@@ -365,9 +366,10 @@
my $element = $item->{$key};
$string .= (' ' x $p->{_current_indent})
- . colored(
+ . _colored(
sprintf("%-*s", $len, $key),
- $p->{color}->{'hash'}
+ $p->{color}->{'hash'},
+ $p->{_colored}
)
. $p->{hash_separator}
;
@@ -381,7 +383,7 @@
else {
$string .= _p( $element, $p );
}
- $string .= ' ' . colored('(weak)', $p->{color}->{'weak'})
+ $string .= ' ' . _colored('(weak)', $p->{color}->{'weak'}, $p->{_colored})
if $ref and Scalar::Util::isweak($item->{$key});
$string .= (--$total_keys == 0 ? '' : ',') . $BREAK;
@@ -409,7 +411,7 @@
# note: we are not validating anything, just grabbing modifiers
if ($val =~ m/\(\?\^?([uladxismpogce]*)(?:\-[uladxismpogce]+)?:(.*)\)/s) {
my ($modifiers, $val) = ($1, $2);
- $string .= colored($val, $p->{color}->{'regex'});
+ $string .= _colored($val, $p->{color}->{'regex'}, $p->{_colored});
if ($modifiers) {
$string .= " (modifiers: $modifiers)";
}
@@ -425,7 +427,7 @@
my ($item, $p) = @_;
my $string = '';
- $string .= colored("$$item", $p->{color}->{'glob'});
+ $string .= _colored("$$item", $p->{color}->{'glob'}, $p->{_colored});
my $extra = '';
@@ -481,7 +483,7 @@
my $string = '';
$p->{class}{_depth}++;
- $string .= colored($ref, $p->{color}->{'class'});
+ $string .= _colored($ref, $p->{color}->{'class'}, $p->{_colored});
if ($p->{class}{expand} eq 'all'
or $p->{class}{expand} >= $p->{class}{_depth}
@@ -496,7 +498,7 @@
if ($p->{class}{parents}) {
$string .= (' ' x $p->{_current_indent})
. 'Parents '
- . join(', ', map { colored($_, $p->{color}->{'class'}) }
+ . join(', ', map { _colored($_, $p->{color}->{'class'}, $p->{_colored}) }
@superclasses
) . $BREAK;
}
@@ -504,7 +506,7 @@
if ($p->{class}{linear_isa}) {
$string .= (' ' x $p->{_current_indent})
. 'Linear @ISA '
- . join(', ', map { colored( $_, $p->{color}->{'class'}) }
+ . join(', ', map { _colored( $_, $p->{color}->{'class'}, $p->{_colored}) }
$meta->linearized_isa
) . $BREAK;
}
@@ -552,6 +554,12 @@
}
}
+sub _colored {
+ my ($string, $color, $do_colors) = @_;
+
+ return $string if !$do_colors;
+ return Term::ANSIColor::colored($string, $color);
+}
sub _show_methods {
my ($ref, $meta, $p) = @_;
@@ -588,7 +596,7 @@
$string .= (' ' x $p->{_current_indent})
. "$type methods (" . scalar @list . ')'
. (@list ? ' : ' : '')
- . join(', ', map { colored($_, $p->{color}->{class}) }
+ . join(', ', map { _colored($_, $p->{color}->{class}, $p->{_colored}) }
@list
) . $BREAK;
}
@@ -618,7 +626,7 @@
$message =~ s/\b__FILENAME__\b/$caller[1]/g;
$message =~ s/\b__LINE__\b/$caller[2]/g;
- return colored($message, $p->{color}{caller_info}) . $BREAK;
+ return _colored($message, $p->{color}{caller_info}, $p->{_colored}) . $BREAK;
}
--- t/02-colors.t
+++ t/02-colors.t
@@ -6,7 +6,7 @@
delete $ENV{ANSI_COLORS_DISABLED};
use File::HomeDir::Test; # avoid user's .dataprinter
use_ok ('Term::ANSIColor');
- use_ok ('Data::Printer');
+ use_ok ('Data::Printer', colored => 1);
};
my $number = 3.14;
--- t/14-local_conf.t
+++ t/14-local_conf.t
@@ -6,7 +6,7 @@
delete $ENV{ANSI_COLORS_DISABLED};
use File::HomeDir::Test; # avoid user's .dataprinter
use_ok 'Term::ANSIColor';
- use_ok 'Data::Printer';
+ use_ok 'Data::Printer', colored => 1;
};
my %hash = ( key => 'value' );
--- t/15-rc_file.t
+++ t/15-rc_file.t
@@ -29,7 +29,7 @@
# file created and in place, let's load up our
# module and see if it overrides the default conf
# with our .dataprinter RC file
- use_ok ('Data::Printer');
+ use_ok ('Data::Printer', colored => 1);
unlink $file or fail('error removing test file');
};
--- t/16-rc_file2.t
+++ t/16-rc_file2.t
@@ -33,7 +33,8 @@
color => {
hash => 'blue'
},
- hash_separator => ' * ',
+ hash_separator => ' * ',
+ colored => 1,
});
unlink $file or fail('error removing test file');
};
--- t/17-parallel.t
+++ t/17-parallel.t
@@ -6,17 +6,17 @@
};
package Foo;
-use Data::Printer { color => { number => 'green' } };
+use Data::Printer { color => { number => 'green' }, colored => 1 };
sub foo { p($_[0]) }
package Bar;
-use Data::Printer { color => { number => 'yellow' } };
+use Data::Printer { color => { number => 'yellow' }, colored => 1 };
sub bar { p($_[0]) }
package main;
use Test::More;
-use Data::Printer { color => { number => 'blue' } };
+use Data::Printer { color => { number => 'blue' }, colored => 1 };
delete $ENV{ANSI_COLORS_DISABLED};
my $data = 42;
--- t/25-weak.t
+++ t/25-weak.t
@@ -7,7 +7,7 @@
use File::HomeDir::Test; # avoid user's .dataprinter
use_ok ('Term::ANSIColor');
use_ok ('Scalar::Util', qw(weaken));
- use_ok ('Data::Printer');
+ use_ok ('Data::Printer', colored => 1);
};
my $number = 3.14;
@@ -15,7 +15,7 @@
weaken($n_ref);
is( p($n_ref), color('reset') . '\\ '
. colored($number, 'bright_blue')
- . colored(' (weak)', 'cyan')
+ . ' ' . colored('(weak)', 'cyan')
, 'weakened ref');
@@ -25,7 +25,7 @@
is( p($circular), color('reset') . "\\ [$/ "
. colored('[0] ', 'bright_white')
. colored('var', 'white on_red')
- . colored(' (weak)', 'cyan')
+ . ' ' . colored('(weak)', 'cyan')
. "$/]"
, 'weakened circular array ref');
@@ -38,7 +38,7 @@
. colored('key', 'magenta')
. ' '
. colored('var', 'white on_red')
- . colored(' (weak)', 'cyan')
+ . ' ' . colored('(weak)', 'cyan')
. "$/}"
, 'weakened circular hash ref');
@@ -49,14 +49,14 @@
my $obj = Foo->new;
-is( p($obj), 'Foo {
- public methods (1) : new
+is( p($obj), color('reset').colored('Foo', 'bright_green').' {
+ public methods (1) : '.colored('new', 'bright_green').'
private methods (0)
internals: [
'
. colored('[0] ', 'bright_white')
. colored('var', 'white on_red')
- . colored(' (weak)', 'cyan').'
+ . ' ' . colored('(weak)', 'cyan').'
]
}', 'circular weak ref to object' );
RT for rt.cpan.org