Data-Printer
view release on metacpan or search on metacpan
array_max elements and replace the rest with '(...skipping XX items...)'.
Other available options are 'end', 'middle', 'extremes', and 'none'.
- hash_max / hash_overflow / hash_preserve (same! note however that
preserved keys will only be the same if hash keys are sorted)
Defaults to 50.
- ignore_keys to skip their dump (feature by Eugen Konkov)
- string_max/string_overflow/string_preserve to limit string entries (scalars),
just like arrays and hashes. Defaults to 1024 and 'begin'. Set it
to 0 for unlimited size.
- new 'separator', 'brackets' and 'overflow' colors to control
- unicode_charnames, when set to 1 (together with escape_chars)
will try and use the Unicode name when escaping strings.
So `$s = "\x{2603}"; p $s` will output "\N{SNOWMAN}"
- show_refcount => 1 exposes the reference count for the data structure
(and inner data) if the count is greater than 1. (default 0, showing no refcounts).
- show_memsize => 1 shows the (approximated) amount of memory the variable
occupies for all variables on that level. This means that '1' will show
the size of the entire data structure, while 2 will also show sizes of
inner data, 3 will go even deeper and so on. To get the size of everything,
use 'all' - though usually you'll probably want to just use '1'.
This requires Devel::Size, so the default is 0 for none.
OTHER:
- document availability of np() on Data::Printer::Filter (Olaf Alders)
0.38 2016-01-28
BUG FIXES:
- removed Test::Most unlisted dependency
(thanks Marco Masetti for reporting)
0.37 2016-01-28
NEW FEATURES:
- Support for displaying scalar's unicode flag
(Michael Conrad)
BUG FIXES:
- Fixed test failure due to leaking environment variables
(Thomas Sibley)
- class_method only works if it's actually something we can call
(RenatoCRON)
- Attempt to fix a taint error on old Win32 systems
(Baldur Kristinsson)
- Prevent some 5.8 errors caused by the version module
(Baldur Kristinsson)
lib/Data/Printer.pm view on Meta::CPAN
or restart running code.
=head2 Properties Quick Reference
Below are (almost) all available properties and their (hopefully sane)
default values. See L<Data::Printer::Object> for further information on
each of them:
# scalar options
show_tainted = 1
show_unicode = 1
show_lvalue = 1
print_escapes = 0
scalar_quotes = "
escape_chars = none
string_max = 4096
string_preserve = begin
string_overflow = '(...skipping __SKIPPED__ chars...)'
unicode_charnames = 0
# array options
array_max = 100
array_preserve = begin
array_overflow = '(...skipping __SKIPPED__ items...)'
index = 1
# hash options
hash_max = 100
hash_preserve = begin
lib/Data/Printer/Common.pm view on Meta::CPAN
sub _filter_category_for {
my ($name) = @_;
my %core_types = map { $_ => 1 }
qw(SCALAR LVALUE ARRAY HASH REF VSTRING GLOB FORMAT Regexp CODE OBJECT);
return exists $core_types{$name} ? 'type_filters' : 'class_filters';
}
# strings are tough to process: there are control characters like "\t",
# unicode characters to name or escape (or do nothing), max_string to
# worry about, and every single piece of that could have its own color.
# That, and hash keys and strings share this. So we put it all in one place.
sub _process_string {
my ($ddp, $string, $src_color) = @_;
# colorizing messes with reduce_string because we are effectively
# adding new (invisible) characters to the string. So we need to
# handle reduction first. But! Because we colorize string_max
# *and* we should escape any colors already present, we need to
# do both at the same time.
lib/Data/Printer/Common.pm view on Meta::CPAN
# have different colors, we need to be aware of that.
sub _escape_chars {
my ($ddp, $scalar, $src_color) = @_;
my $escape_kind = $ddp->escape_chars;
my %target_for = (
nonascii => '[^\x{00}-\x{7f}]+',
nonlatin1 => '[^\x{00}-\x{ff}]+',
);
if ($ddp->unicode_charnames) {
require charnames;
if ($escape_kind eq 'all') {
$scalar = join('', map { sprintf '\N{%s}', charnames::viacode(ord $_) } split //, $scalar);
$scalar = $ddp->maybe_colorize($scalar, 'escaped');
}
else {
$scalar =~ s{($target_for{$escape_kind})}{$ddp->maybe_colorize( (join '', map { sprintf '\N{%s}', charnames::viacode(ord $_) } split //, $1), 'escaped', undef, $src_color)}ge if exists $target_for{$escape_kind};
}
}
elsif ($escape_kind eq 'all') {
lib/Data/Printer/Filter/SCALAR.pm view on Meta::CPAN
}
}
elsif (_is_number($value)) {
$ret = $ddp->maybe_colorize($value, 'number');
}
else {
$ret = Data::Printer::Common::_process_string($ddp, $value, 'string');
$ret = _quoteme($ddp, $ret);
}
$ret .= _check_tainted($ddp, $scalar_ref);
$ret .= _check_unicode($ddp, $scalar_ref);
if ($ddp->show_tied and my $tie = ref tied $$scalar_ref) {
$ret .= " (tied to $tie)";
}
return $ret;
};
#######################################
### Private auxiliary helpers below ###
lib/Data/Printer/Filter/SCALAR.pm view on Meta::CPAN
}
return $text;
}
sub _check_tainted {
my ($self, $var) = @_;
return ' (TAINTED)' if $self->show_tainted && Scalar::Util::tainted($$var);
return '';
}
sub _check_unicode {
my ($self, $var) = @_;
return ' (U)' if $self->show_unicode && utf8::is_utf8($$var);
return '';
}
sub _is_number {
my ($maybe_a_number) = @_;
# Scalar values that start with a zero are strings, NOT numbers.
# You can write `my $foo = 0123`, but then `$foo` will be 83,
# (numbers starting with zero are octal integers)
return if $maybe_a_number =~ /^-?0[0-9]/;
lib/Data/Printer/Object.pm view on Meta::CPAN
use Data::Printer::Filter::VSTRING;
use Data::Printer::Filter::GLOB;
use Data::Printer::Filter::FORMAT;
use Data::Printer::Filter::Regexp;
use Data::Printer::Filter::CODE;
use Data::Printer::Filter::OBJECT;
use Data::Printer::Filter::GenericClass;
# create our basic accessors:
my @method_names =qw(
name show_tainted show_unicode show_readonly show_lvalue show_refcount
show_memsize memsize_unit print_escapes scalar_quotes escape_chars
caller_info caller_message caller_message_newline caller_message_position
string_max string_overflow string_preserve resolve_scalar_refs
array_max array_overflow array_preserve hash_max hash_overflow
hash_preserve unicode_charnames colored theme show_weak
max_depth index separator end_separator class_method class hash_separator
align_hash sort_keys quote_keys deparse return_value show_dualvar show_tied
warnings arrows coderef_stub coderef_undefined
);
foreach my $method_name (@method_names) {
no strict 'refs';
*{__PACKAGE__ . "::$method_name"} = sub {
$_[0]->{$method_name} = $_[1] if @_ > 1;
return $_[0]->{$method_name};
}
lib/Data/Printer/Object.pm view on Meta::CPAN
$self->{'arrows'} = Data::Printer::Common::_fetch_anyof(
$props,
'arrows',
'none',
[qw(none first all)]
);
$self->{'show_tainted'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'show_tainted', 1);
$self->{'show_tied'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'show_tied', 1);
$self->{'show_weak'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'show_weak', 1);
$self->{'show_unicode'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'show_unicode', 0);
$self->{'show_readonly'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'show_readonly', 1);
$self->{'show_lvalue'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'show_lvalue', 1);
$self->{'show_refcount'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'show_refcount', 0);
$self->{'show_memsize'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'show_memsize', 0);
$self->{'memsize_unit'} = Data::Printer::Common::_fetch_anyof(
$props,
'memsize_unit',
'auto',
[qw(auto b k m)]
);
lib/Data/Printer/Object.pm view on Meta::CPAN
$props,
'hash_preserve',
'begin',
[qw(begin end middle extremes none)]
);
$self->{'hash_overflow'} = Data::Printer::Common::_fetch_scalar_or_default(
$props,
'hash_overflow',
'(...skipping __SKIPPED__ keys...)'
);
$self->{'unicode_charnames'} = Data::Printer::Common::_fetch_scalar_or_default(
$props,
'unicode_charnames',
0
);
$self->{'colored'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'colored', 'auto');
$self->{'max_depth'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'max_depth', 0);
$self->{'separator'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'separator', ',');
$self->{'end_separator'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'end_separator', 0);
$self->{'class_method'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'class_method', '_data_printer');
$self->{'class'} = Data::Printer::Object::ClassOptions->new($props->{'class'});
$self->{'hash_separator'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'hash_separator', ' ');
$self->{'align_hash'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'align_hash', 1);
lib/Data/Printer/Object.pm view on Meta::CPAN
=head2 Scalar Options
=head3 show_tainted
When set, will detect and let you know of any tainted data (default: 1)
Note that this is a no-op unless your script is in taint mode, meaning
it's running with different real and effective user/group IDs, or with the
-T flag. See L<perlsec> for extra information.
=head3 show_unicode
Whether to label data that has the L<unicode flag|perlunifaq> set. (default: 1)
=head3 show_dualvar
Perl can interpret strings as numbers and vice-versa, but that doesn't mean
it always gets it right. When this option is set to "lax", Data::Printer will
show both values if they differ. If set to "strict", it will always show both
values, and when set to "off" it will never show the second value. (default: lax)
=head3 show_lvalue
lib/Data/Printer/Object.pm view on Meta::CPAN
=head3 scalar_quotes
Which quotation character to use when printing strings (default: ")
=head3 escape_chars
Use this to escape certain characters from strings, which could be useful if
your terminal is in a different encoding than the data being printed. Can be
set to 'nonascii', 'nonlatin1', 'all' or 'none' (default: none).
=head3 unicode_charnames
whether to use the character's names when escaping unicode (e.g. SNOWMAN instead of \x{2603}) (default: 0)
=head3 print_escapes
Whether to print invisible characters in strings, like \b, \n and \t (default: 0)
=head3 resolve_scalar_refs
If a reference to a scalar value is found more than once, print the resolved
value. For example, you may have an object that you reuse to represent 'true'
or 'false'. If you have more than one of those in your data, Data::Printer
lib/Data/Printer/Profile.pm view on Meta::CPAN
Data::Printer::Profile - customize your Data::Printer with code
=head1 SYNOPSIS
package Data::Printer::Profile::MyProfile;
sub profile {
return {
show_tainted => 1,
show_unicode => 0,
array_max => 30,
# ...and so on...
}
}
1;
Then put in your '.dataprinter' file:
profile = MyProfile
lib/Data/Printer/Profile/Dumper.pm view on Meta::CPAN
package Data::Printer::Profile::Dumper;
use strict;
use warnings;
sub profile {
return {
show_tainted => 0,
show_unicode => 0,
show_lvalue => 0,
print_escapes => 0,
scalar_quotes => q('),
escape_chars => 'none',
string_max => 0,
unicode_charnames => 0,
array_max => 0,
index => 0,
hash_max => 0,
hash_separator => ' => ',
align_hash => 0,
sort_keys => 0,
quote_keys => 1,
name => '$VAR1',
arrows => 'first',
return_value => 'dump',
lib/Data/Printer/Profile/JSON.pm view on Meta::CPAN
package Data::Printer::Profile::JSON;
use strict;
use warnings;
sub profile {
return {
show_tainted => 0,
show_unicode => 0,
show_lvalue => 0,
print_escapes => 0,
scalar_quotes => q("),
escape_chars => 'none',
string_max => 0,
unicode_charnames => 0,
array_max => 0,
index => 0,
hash_max => 0,
hash_separator => ': ',
align_hash => 0,
sort_keys => 0,
quote_keys => 1,
name => 'var',
return_value => 'dump',
output => 'stderr',
lib/Data/Printer/Theme.pm view on Meta::CPAN
glob => '#aabbcc', # globs (usually file handles)
vstring => '#aabbcc', # version strings (v5.30.1, etc)
lvalue => '#aabbcc', # lvalue label
format => '#aabbcc', # format type
true => '#aabbcc', # boolean type (true)
false => '#aabbcc', # boolean type (false)
repeated => '#aabbcc', # references to seen values
caller_info => '#aabbcc', # details on what's being printed
weak => '#aabbcc', # weak references flag
tainted => '#aabbcc', # tainted flag
unicode => '#aabbcc', # utf8 flag
escaped => '#aabbcc', # escaped characters (\t, \n, etc)
brackets => '#aabbcc', # (), {}, []
separator => '#aabbcc', # the "," between hash pairs, array elements, etc
quotes => '#aabbcc', # q(")
unknown => '#aabbcc', # any (potential) data type unknown to Data::Printer
};
}
1;
Then in your C<.dataprinter> file:
lib/Data/Printer/Theme/Classic.pm view on Meta::CPAN
glob => 'bright_cyan', # globs (usually file handles)
vstring => 'bright_blue', # version strings (v5.16.0, etc)
lvalue => '', # lvalue label
format => '', # format type
true => 'bright_cyan', # boolean type (true)
false => 'bright_cyan', # boolean type (false)
repeated => 'white on_red', # references to seen values
caller_info => 'bright_cyan', # details on what's being printed
weak => 'cyan', # weak references
tainted => 'red', # tainted content
unicode => '', # utf8 flag
escaped => 'bright_red', # escaped characters (\t, \n, etc)
brackets => '', # (), {}, []
separator => '', # the "," between hash pairs, array elements, etc
quotes => '',
unknown => 'bright_yellow on_blue', # any (potential) data type unknown to Data::Printer
};
}
1;
__END__
lib/Data/Printer/Theme/Material.pm view on Meta::CPAN
glob => $code_for{strong_orange}, # globs (usually file handles)
vstring => $code_for{strong_orange}, # version strings (v5.16.0, etc)
lvalue => $code_for{strong_orange}, # lvalue label
format => $code_for{strong_orange}, # format type
true => $code_for{blue}, # boolean type (true)
false => $code_for{blue}, # boolean type (false)
repeated => $code_for{red}, # references to seen values
caller_info => $code_for{gray}, # details on what's being printed
weak => $code_for{green}, # weak references flag
tainted => $code_for{light_orange}, # tainted flag
unicode => $code_for{light_orange}, # utf8 flag
escaped => $code_for{teal}, # escaped characters (\t, \n, etc)
brackets => $code_for{cyan}, # (), {}, []
separator => $code_for{cyan}, # the "," between hash pairs, array elements, etc
quotes => $code_for{cyan},
unknown => $code_for{red}, # any (potential) data type unknown to Data::Printer
};
}
1;
__END__
lib/Data/Printer/Theme/Monokai.pm view on Meta::CPAN
glob => $code_for{violet}, # globs (usually file handles)
vstring => $code_for{cyan}, # version strings (v5.16.0, etc)
lvalue => $code_for{green}, # lvalue label
format => $code_for{violet}, # format type
true => $code_for{violet}, # boolean type (true)
false => $code_for{violet}, # boolean type (false)
repeated => $code_for{pink}, # references to seen values
caller_info => $code_for{grey}, # details on what's being printed
weak => $code_for{green}, # weak references flag
tainted => $code_for{green}, # tainted flag
unicode => $code_for{green}, # utf8 flag
escaped => $code_for{pink}, # escaped characters (\t, \n, etc)
brackets => $code_for{empty}, # (), {}, []
separator => $code_for{empty}, # the "," between hash pairs, array elements, etc
quotes => $code_for{yellow},
unknown => $code_for{pink}, # any (potential) data type unknown to Data::Printer
};
}
1;
__END__
lib/Data/Printer/Theme/Solarized.pm view on Meta::CPAN
glob => $code_for{blue}, # globs (usually file handles)
vstring => $code_for{base1}, # version strings (v5.16.0, etc)
lvalue => $code_for{green}, # lvalue label
format => $code_for{green}, # format type
true => $code_for{blue}, # boolean type (true)
false => $code_for{blue}, # boolean type (false)
repeated => $code_for{red}, # references to seen values
caller_info => $code_for{cyan}, # details on what's being printed
weak => $code_for{violet}, # weak references flag
tainted => $code_for{violet}, # tainted flag
unicode => $code_for{magenta}, # utf8 flag
escaped => $code_for{red}, # escaped characters (\t, \n, etc)
brackets => $code_for{base0}, # (), {}, []
separator => $code_for{base0}, # the "," between hash pairs, array elements, etc
quotes => $code_for{'base0'},
unknown => $code_for{red}, # any (potential) data type unknown to Data::Printer
};
}
1;
t/001-object.t view on Meta::CPAN
test_defaults();
test_customization();
test_aliases();
test_colorization();
exit;
sub test_defaults {
ok my $ddp = Data::Printer::Object->new, 'Data::Printer::Object created';
is $ddp->name, 'var', 'default variable name is "var"';
is $ddp->show_tainted, 1, 'show_tainted default ON';
is $ddp->show_unicode, 0, 'show_unicode default OFF';
is $ddp->show_readonly, 1, 'show_readonly default OFF';
is $ddp->show_lvalue, 1, 'show_lvalue default ON';
is $ddp->show_refcount, 0, 'show_refcount default OFF';
is $ddp->show_memsize, 0, 'show_memsize default OFF';
is $ddp->memsize_unit, 'auto', 'memsize_unit default "auto"';
is $ddp->print_escapes, 0, 'print_escapes default OFF';
is $ddp->scalar_quotes, '"', 'scalar_quotes defaults to ["]';
is $ddp->escape_chars, 'none', 'escape_chars defaults to "none"';
is $ddp->caller_info, 0, 'caller_info default OFF';
is $ddp->caller_message, 'Printing in line __LINE__ of __FILENAME__:', 'default message';
t/001-object.t view on Meta::CPAN
$ddp->string_overflow,
'(...skipping __SKIPPED__ chars...)',
'string_overflow'
);
is $ddp->array_max, 100, 'array_max default to 100';
is $ddp->array_preserve, 'begin', 'array_preserve defaults to "begin"';
is $ddp->array_overflow, '(...skipping __SKIPPED__ items...)', 'array_overflow';
is $ddp->hash_max, 100, 'hash_max default 100';
is $ddp->hash_preserve, 'begin', 'hash_preserve defaults to "begin"';
is $ddp->hash_overflow, '(...skipping __SKIPPED__ keys...)', 'hash_overflow';
is $ddp->unicode_charnames, 0, 'unicode_charnames defaults OFF';
is $ddp->colored, 'auto', 'colored defaults to "auto"';
my $theme = $ddp->theme;
is $theme->name, 'Material', 'default theme';
is $ddp->show_weak, 1, 'show_weak default ON';
is $ddp->max_depth, 0, 'max_depth defaults to infinite depth';
is $ddp->index, 1, 'index default ON';
is $ddp->separator, ',', 'separator is ","';
is $ddp->end_separator, 0, 'end_separator default OFF';
is $ddp->class_method, '_data_printer', 'class_method';
my $class_opts = $ddp->class;
t/001-object.t view on Meta::CPAN
is $ddp->sort_keys, 1, 'sort_keys default ON';
is $ddp->quote_keys, 'auto', 'quote_keys defaults to "auto"';
is $ddp->deparse, 0, 'deparse default OFF';
is $ddp->show_dualvar, 'lax', 'dualvar default LAX';
}
sub test_customization {
my %custom = (
name => 'something',
show_tainted => 0,
show_unicode => 1,
show_readonly => 0,
show_lvalue => 0,
show_refcount => 1,
show_dualvar => 'strict',
show_memsize => 1,
memsize_unit => 'k',
print_escapes => 1,
scalar_quotes => q('),
escape_chars => 'all',
caller_info => 1,
caller_message => 'meep!',
string_max => 3,
string_preserve => 'end',
string_overflow => 'oh, noes! __SKIPPED__',
array_max => 5,
array_preserve => 'middle',
array_overflow => 'hey!',
hash_max => 7,
hash_preserve => 'extremes',
hash_overflow => 'YAY!',
unicode_charnames => 1,
colored => 0,
theme => 'Monokai',
show_weak => 0,
max_depth => 4,
index => 0,
separator => '::',
end_separator => 1,
class_method => '_foo',
class => {
},
t/001-object.t view on Meta::CPAN
);
run_customization_tests(1, %custom); # as hash
run_customization_tests(2, \%custom); # as hashref
}
sub run_customization_tests {
my $pass = shift;
ok my $ddp = Data::Printer::Object->new(@_);
is $ddp->name, 'something', "custom variable name (pass: $pass)";
is $ddp->show_tainted, 0, "custom show_tainted (pass: $pass)";
is $ddp->show_unicode, 1, "custom show_unicode (pass: $pass)";
is $ddp->show_readonly, 0, "custom show_readonly (pass: $pass)";
is $ddp->show_lvalue, 0, "custom show_lvalue (pass: $pass)";
is $ddp->show_refcount, 1, "custom show_refcount (pass: $pass)";
is $ddp->show_dualvar, 'strict', "custom show_dualvar (pass: $pass)";
is $ddp->show_memsize, 1, "custom show_memsize (pass: $pass)";
is $ddp->memsize_unit, 'k', "custom memsize_unit (pass: $pass)";
is $ddp->print_escapes, 1, "custom print_escapes (pass: $pass)";
is $ddp->scalar_quotes, q('), "custom scalar_quotes (pass: $pass)";
is $ddp->escape_chars, 'all', "custom escape_chars (pass: $pass)";
is $ddp->caller_info, 1, "custom caller_info (pass: $pass)";
is $ddp->caller_message, 'meep!', "custom message (pass: $pass)";
is $ddp->string_max, 3, "custom string_max (pass: $pass)";
is $ddp->string_preserve, 'end', "custom string_preserve (pass: $pass)";
is( $ddp->string_overflow, 'oh, noes! __SKIPPED__', "custom string_overflow");
is $ddp->array_max, 5, "custom array_max (pass: $pass)";
is $ddp->array_preserve, 'middle', "custom array_preserve (pass: $pass)";
is $ddp->array_overflow, 'hey!', "custom array_overflow (pass: $pass)";
is $ddp->hash_max, 7, "custom hash_max (pass: $pass)";
is $ddp->hash_preserve, 'extremes', "custom hash_preserve (pass: $pass)";
is $ddp->hash_overflow, 'YAY!', "custom hash_overflow (pass: $pass)";
is $ddp->unicode_charnames, 1, "custom unicode_charnames (pass: $pass)";
is $ddp->colored, 0, "custom colored (pass: $pass)";
my $theme = $ddp->theme;
is $theme->name, 'Monokai', "custom theme (pass: $pass)";
is $ddp->show_weak, 0, "custom show_weak (pass: $pass)";
is $ddp->max_depth, 4, "custom max_depth (pass: $pass)";
is $ddp->index, 0, "custom index (pass: $pass)";
is $ddp->separator, '::', "custom separator (pass: $pass)";
is $ddp->end_separator, 1, "custom end_separator (pass: $pass)";
is $ddp->class_method, '_foo', "custom class_method (pass: $pass)";
my $class_opts = $ddp->class;
t/002-scalar.t view on Meta::CPAN
# ^^ taint mode must be on for taint checking.
use strict;
use warnings;
use Test::More tests => 72;
use Data::Printer::Object;
use Scalar::Util;
test_basic_values();
test_boolean_values();
test_tainted_values();
test_unicode_string();
test_escape_chars();
test_print_escapes();
test_max_string();
test_weak_ref();
test_readonly();
test_dualvar_lax();
test_dualvar_strict();
test_dualvar_off();
sub test_weak_ref {
t/002-scalar.t view on Meta::CPAN
skip 'Skipping taint test: sample not found.', 2
=> unless Scalar::Util::tainted($tainted);
my $object = Data::Printer::Object->new( colored => 0 );
is $object->parse(\$tainted), qq("$tainted" (TAINTED)), 'show tainted scalar';
$object = Data::Printer::Object->new( colored => 0, show_tainted => 0 );
is $object->parse(\$tainted), qq("$tainted"), 'no tainted flag without show_tainted';
}
}
sub test_unicode_string {
my $object = Data::Printer::Object->new( colored => 0 );
my $unicode_str = "\x{2603}";
my $ascii_str = "\x{ff}";
is $object->parse(\$unicode_str), qq("$unicode_str"), 'no suffix on unicode by default';
is $object->parse(\$ascii_str), qq("$ascii_str"), 'ascii scalar never has suffix (1)';
$object = Data::Printer::Object->new( colored => 0, show_unicode => 1 );
is $object->parse(\$unicode_str), qq("$unicode_str" (U)), 'unicode scalar gets suffix';
is $object->parse(\$ascii_str), qq("$ascii_str"), 'ascii scalar never has suffix (2)';
}
sub test_escape_chars {
my $string = "L\x{e9}on likes to build a m\x{f8}\x{f8}se \x{2603} with \x{2744}\x{2746}";
my $object = Data::Printer::Object->new( colored => 0 );
is $object->parse(\$string), qq("$string"), 'escape_chars => "none"';
$object = Data::Printer::Object->new( colored => 0, escape_chars => 'nonascii' );
is(
$object->parse(\$string),
qq("L\\x{e9}on likes to build a m\\x{f8}\\x{f8}se \\x{2603} with \\x{2744}\\x{2746}"),
'escaping nonascii'
);
$object = Data::Printer::Object->new( colored => 0, escape_chars => 'nonascii', unicode_charnames => 1 );
is(
$object->parse(\$string),
qq("L\\N{LATIN SMALL LETTER E WITH ACUTE}on likes to build a m\\N{LATIN SMALL LETTER O WITH STROKE}\\N{LATIN SMALL LETTER O WITH STROKE}se \\N{SNOWMAN} with \\N{SNOWFLAKE}\\N{HEAVY CHEVRON SNOWFLAKE}"),
'escaping nonascii (with unicode_charnames)'
);
$object = Data::Printer::Object->new( colored => 0, escape_chars => 'nonlatin1' );
is(
$object->parse(\$string),
qq("L\x{e9}on likes to build a m\x{f8}\x{f8}se \\x{2603} with \\x{2744}\\x{2746}"),
'escaping nonlatin1'
);
$object = Data::Printer::Object->new( colored => 0, escape_chars => 'nonlatin1', unicode_charnames => 1 );
is(
$object->parse(\$string),
qq("L\x{e9}on likes to build a m\x{f8}\x{f8}se \\N{SNOWMAN} with \\N{SNOWFLAKE}\\N{HEAVY CHEVRON SNOWFLAKE}"),
'escaping nonlatin1 (with unicode_charnames)'
);
$object = Data::Printer::Object->new( colored => 0, escape_chars => 'all' );
is(
$object->parse(\$string),
'"' . join('', map {(sprintf '\x{%02x}', ord($_)) } split //, $string) . '"',
'escaping all'
);
$object = Data::Printer::Object->new( colored => 0, escape_chars => 'all', unicode_charnames => 1 );
$string = "L\x{e9}on";
is(
$object->parse(\$string),
'"\N{LATIN CAPITAL LETTER L}\N{LATIN SMALL LETTER E WITH ACUTE}\N{LATIN SMALL LETTER O}\N{LATIN SMALL LETTER N}"',
'escaping all (with unicode_charnames)'
);
}
sub test_print_escapes {
my $object = Data::Printer::Object->new( colored => 0 );
my $string = "\n\r\t\0\f\b\a\e";
is $object->parse(\$string), qq("\n\r\t\\0\f\b\a\e"), 'only \0 is always escaped';
$object = Data::Printer::Object->new( colored => 0, print_escapes => 1 );
is $object->parse(\$string), q("\n\r\t\0\f\b\a\e"), 'print_escapes works';
}
( run in 0.787 second using v1.01-cache-2.11-cpan-88abd93f124 )