Commit 07365fa2c734a0d12da2dbec0c54f23d6210dbb0 - libdata-printer-perl

+98

-0

Changes less more

0	0	Revision history for Data-Printer
	1
	2	0.31 2012-08-09
	3	BUG FIXES:
	4	- fixed test failures in 5.8
	5
	6	OTHER:
	7	- releasing as stable version
	8
	9	0.30_06 2012-07-22
	10	NEW FEATURES:
	11	- new filter for DateTime::Tiny
	12
	13	OTHER:
	14	- new tip: using DDP with Template Toolkit
	15
	16	0.30_05 2012-07-21
	17	NEW FEATURES:
	18	- Add support for FORMAT and LVALUE refs (Rebecca Turner)
	19
	20	BUG FIXES:
	21	- prevent warning when dumping refs to unopened or closed
	22	file handles (Rebecca Turner)
	23	- on Win32, it is allowed to use an RC file without
	24	read-only permissions
	25
	26	0.30_04 2012-07-08
	27	NEW FEATURES:
	28	- Improved support for unknown core datatypes (Rebecca Turner)
	29
	30	BUG FIXES:
	31	- fixed indentation when using colored output (Stanislaw Pusep)
	32	- fixed t/05-obj.t on older perls (Mike Doherty)
	33	- fixed dev-only pod tests
	34	- Issue warning (carp) when color/colour is not a hashref
	35
	36	0.30_03 2012-07-05
	37	NEW FEATURES:
	38	- new class property 'universal', letting you choose whether
	39	to include UNIVERSAL methods during inheritance display
	40	or not (default is 1, meaning to show).
	41	- support for VSTRINGs (Rebecca Turner)
	42
	43	NEW *EXPERIMENTAL* FEATURES:
	44	- new 'show_readonly' property, off by default, to show
	45	variables marked as read-only
	46	(scalars only for now, patches welcome!)
	47
	48	BUG FIXES:
	49	- fixed issue with t/05-obj.t
	50	- minor pod fixes (Rebecca Turner, myself)
	51	- Protect against unknown core data types that don't implement "can" (Rebecca Turner)
	52
	53	0.30_02 2012-07-02
	54	BUG FIXES:
	55	- RC file under taint mode should be properly parsed now.
	56
	57	OTHER:
	58	- Rob Hoeltz and Stephen Thirlwall added to the
	59	contributors list. Thanks guys!
	60
	61	0.30_01 2012-07-02
	62	CHANGES THAT BREAK BACKWARDS COMPATIBILITY:
	63	- linear_isa option is now set to 'auto' by default (see below)
	64
	65	NEW FEATURES:
	66	- linear_isa can now be set to 'auto', in which case
	67	it will show the @ISA only if the object has more than
	68	one parent. Other values are 0 (never show) and 1 (always show)
	69	- new "Digest" filter bundle, for MD5, SHA and other Digest objects!
	70	- separate colours for classes and methods (feature request
	71	by Ivan Bessarabov)
	72	- environment variable DATAPRINTERRC overrides .dataprinter
	73	and lets you pick different RCs at will (Stephen Thirlwall)
	74	- new option 'separator' lets you pick a custom separator
	75	for array/hash elements, including none (''). Default is ','.
	76	- new option 'end_separator' can be set to 1 to show the last
	77	item of an array or hash with a separator (Ivan Bessarabov)
	78	- DateTime filter bundle now also handles DateTime::TimeZone
	79	objects (RT#77755)
	80
	81	BUG FIXES:
	82	- RC file now works under taint mode, with restrictions
	83	(feature request by Rob Hoelz)
	84	- class_method call now includes properties hashref (Joel Berger)
	85
	86	OTHER:
	87	- Replacement of dependencies to permit pure perl operation:
	88	Class::MOP is replaced with mro and Package::Stash
	89	Clone is replaced with Clone::PP
	90	Hash::FieldHash is replaced with Hash::Util::FieldHash
	91	Note that if <5.10 is detected, Data::Printer also requires:
	92	MRO::Compat to provide mro
	93	Hash::Util::FieldHash::Compat to provide Hash::Util::FieldHash
	94	As a result, Data::Printer should now be fatpackable (cpan:MSTROUT)
	95	- new /examples dir, with a sample file to let you easily try
	96	different color schemes (Yanick Champoux)
	97	- pod coverage tests (developer only)
1	98
2	99	0.30 2012-02-13
3	100	CHANGES THAT BREAK BACKWARDS COMPATIBILITY:

17	114	- new 'quote_keys' property to add quotes in hash
18	115	keys. Defaults to 'auto' which means it will
19	116	quote keys containing spaces (and empty keys)
	117
20	118	BUG FIXES:
21	119	- fixed temporary file handling during tests. Thanks
22	120	Andy Bach for reporting and providing a patch.

+14

-0

MANIFEST less more

0	0	Changes
	1	examples/try_me.pl
1	2	lib/Data/Printer.pm
2	3	lib/Data/Printer/Filter.pm
3	4	lib/Data/Printer/Filter/DateTime.pm
4	5	lib/Data/Printer/Filter/DB.pm
	6	lib/Data/Printer/Filter/Digest.pm
5	7	lib/DDP.pm
6	8	Makefile.PL
7	9	MANIFEST This list of files

24	26	t/12-filter_class.t
25	27	t/13-filter_datetime.t
26	28	t/13.2-filter_db.t
	29	t/13.3-filter_digest.t
27	30	t/14-local_conf.t
28	31	t/15-rc_file.t
29	32	t/16-rc_file2.t
30	33	t/16.2-rc_overwrite.t
	34	t/16.3-rc_env.t
	35	t/16.4-rc_env2.t
	36	t/16.5-rc_env3.t
31	37	t/17-parallel.t
32	38	t/18-class_method.t
33	39	t/19-tied.t

48	54	t/30.2-print_escapes.t
49	55	t/31-bad_parameters.t
50	56	t/32-quote_keys.t
	57	t/33-end_separator.t
	58	t/33-separator.t
	59	t/34-show_readonly.t
	60	t/35-vstrings.t
	61	t/36-valign.t
	62	t/37-format.t
	63	t/38-lvalue.t
	64	t/pod-coverage.t
51	65	t/pod.t
52	66	META.yml Module YAML meta-data (added by MakeMaker)
53	67	META.json Module JSON meta-data (added by MakeMaker)

+1

-1

MANIFEST.SKIP less more

0	0	^\.git
1		.pl$
	1	^[^/]+\.pl$
2	2	^\ignore.txt
3	3	^_build
4	4	^Build$

+14

-14

META.json less more

3	3	"Breno G. de Oliveira <garu@cpan.org>"
4	4	],
5	5	"dynamic_config" : 1,
6		"generated_by" : "ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.113640",
	6	"generated_by" : "ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120921",
7	7	"license" : [
8	8	"perl_5"
9	9	],

21	21	"prereqs" : {
22	22	"build" : {
23	23	"requires" : {
24		"ExtUtils::MakeMaker" : 0
	24	"ExtUtils::MakeMaker" : "0"
25	25	}
26	26	},
27	27	"configure" : {
28	28	"requires" : {
29		"ExtUtils::MakeMaker" : 0
	29	"ExtUtils::MakeMaker" : "0"
30	30	}
31	31	},
32	32	"runtime" : {
33	33	"requires" : {
34		"Carp" : 0,
35		"Class::MOP" : "0.81",
36		"Clone" : 0,
37		"Fcntl" : 0,
	34	"Carp" : "0",
	35	"Clone::PP" : "0",
	36	"Fcntl" : "0",
38	37	"File::HomeDir" : "0.91",
39		"File::Spec" : 0,
40		"File::Temp" : 0,
41		"Hash::FieldHash" : 0,
42		"Scalar::Util" : 0,
43		"Sort::Naturally" : 0,
	38	"File::Spec" : "0",
	39	"File::Temp" : "0",
	40	"Package::Stash" : "0.3",
	41	"Scalar::Util" : "0",
	42	"Sort::Naturally" : "0",
44	43	"Term::ANSIColor" : "3",
45		"Test::More" : "0.88"
	44	"Test::More" : "0.88",
	45	"version" : "0.77"
46	46	}
47	47	}
48	48	},

58	58	"url" : "http://github.com/garu/Data-Printer"
59	59	}
60	60	},
61		"version" : "0.3"
	61	"version" : "0.31"
62	62	}

+5

-5

META.yml less more

6	6	configure_requires:
7	7	ExtUtils::MakeMaker: 0
8	8	dynamic_config: 1
9		generated_by: 'ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.113640'
	9	generated_by: 'ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120921'
10	10	license: perl
11	11	meta-spec:
12	12	url: http://module-build.sourceforge.net/META-spec-v1.4.html

18	18	- inc
19	19	requires:
20	20	Carp: 0
21		Class::MOP: 0.81
22		Clone: 0
	21	Clone::PP: 0
23	22	Fcntl: 0
24	23	File::HomeDir: 0.91
25	24	File::Spec: 0
26	25	File::Temp: 0
27		Hash::FieldHash: 0
	26	Package::Stash: 0.3
28	27	Scalar::Util: 0
29	28	Sort::Naturally: 0
30	29	Term::ANSIColor: 3
31	30	Test::More: 0.88
	31	version: 0.77
32	32	resources:
33	33	bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=Data-Printer
34	34	license: http://dev.perl.org/licenses/
35	35	repository: http://github.com/garu/Data-Printer
36		version: 0.3
	36	version: 0.31

+10

-4

Makefile.PL less more

12	12	'Test::More' => 0.88,
13	13	'Term::ANSIColor' => 3.0, # introduces 'bright_*' colors
14	14	'Scalar::Util' => 0,
	15	'version' => 0.77, # handling VSTRINGS
15	16	'Sort::Naturally' => 0,
16		'Class::MOP' => 0.81, # get_all_methods() is introduced in 0.65,
17		# but ActivePerl complains about < 0.81
	17	'Package::Stash' => 0.30,
18	18	'Carp' => 0,
19		'Clone' => 0,
20		'Hash::FieldHash' => 0,
	19	'Clone::PP' => 0,
21	20	'File::HomeDir' => 0.91, # introduces File::HomeDir::Test
22	21	'File::Spec' => 0,
23	22	'File::Temp' => 0,
24	23	'Fcntl' => 0,
	24	($] >= 5.010
	25	? ()
	26	: (
	27	'MRO::Compat' => 0.09,
	28	'Hash::Util::FieldHash::Compat' => 0.03,
	29	)
	30	),
25	31	},
26	32	META_MERGE => {
27	33	resources => {

+39

-0

examples/try_me.pl less more

	0	#!/usr/bin/env perl
	1	use strict;
	2	use warnings;
	3	use Scalar::Util qw(weaken);
	4
	5	# This sample code is available to you so you
	6	# can see Data::Printer working out of the box.
	7	# It can be used as a quick way to test your
	8	# color palette scheme!
	9
	10	package My::SampleClass;
	11	sub new { bless {}, shift }
	12	sub public_method { 42 }
	13	sub _private_method { 'sample' }
	14
	15
	16	package main;
	17
	18	my $obj = My::SampleClass->new;
	19
	20	my %sample = (
	21	number => 123.456,
	22	string => 'a string',
	23	array => [ "foo\0has\tescapes", 6, undef ],
	24	hash => {
	25	foo => 'bar',
	26	baz => 789,
	27	},
	28	regexp => qr/foo.*bar/i,
	29	glob => \*STDOUT,
	30	code => sub { return 42 },
	31	class => $obj,
	32	);
	33
	34	$sample{ref} = \%sample;
	35	weaken $sample{ref};
	36
	37	use DDP; p %sample;
	38

+24

-1

lib/DDP.pm less more

0	0	package DDP;
	1	use strict;
	2	use warnings;
1	3	use Data::Printer;
2	4
3	5	BEGIN {
4		push @ISA, 'Data::Printer';
	6	push our @ISA, 'Data::Printer';
5	7	our $VERSION = $Data::Printer::VERSION;
6	8	}
7	9	1;
	10	__END__
	11
	12	=head1 DDP - Data::Printer shortcut for faster debugging
	13
	14	=head1 SYNOPSIS
	15
	16	use DDP; p $my_data;
	17
	18	=head1 DESCRIPTION
	19
	20	Tired of typing C<use Data::Printer> every time? C<DDP> lets you quickly call
	21	your favorite variable dumper!
	22
	23	It behaves exacly like L<Data::Printer> - it is, indeed, just an alias to it :)
	24
	25	Happy debugging!
	26
	27	=head1 SEE ALSO
	28
	29	L<Data::Printer>
	30

+1

-0

lib/Data/Printer/Filter/DB.pm less more

98	98	{
99	99	filters => {
100	100	-external => [ 'DB' ],
	101	},
101	102	};
102	103
103	104

+16

-0

lib/Data/Printer/Filter/DateTime.pm less more

16	16	return _format( $string, @_ );
17	17	};
18	18
	19	# DateTime::TimeZone filters
	20	filter '-class' => sub {
	21	my ($obj, $properties) = @_;
	22
	23	if ( $obj->isa('DateTime::TimeZone' ) ) {
	24	return $obj->name;
	25	}
	26	else {
	27	return;
	28	}
	29	};
	30
19	31	filter 'DateTime::Incomplete', sub {
20	32	return _format( $_[0]->iso8601, @_ );
21	33	};

30	42	my $string = "$dur[0]y $dur[1]m $dur[2]d $dur[3]h $dur[4]m $dur[5]s";
31	43
32	44	return _format( $string, @_ );
	45	};
	46
	47	filter 'DateTime::Tiny', sub {
	48	return _format( $_[0]->as_string, @_ );
33	49	};
34	50
35	51	filter 'Date::Calc::Object', sub {

+144

-0

lib/Data/Printer/Filter/Digest.pm less more

	0	package Data::Printer::Filter::Digest;
	1	use strict;
	2	use warnings;
	3	use Data::Printer::Filter;
	4	use Term::ANSIColor;
	5
	6	foreach my $digest (
	7	qw( Digest::Adler32 Digest::MD2 Digest::MD4
	8	Digest::MD5 Digest::SHA Digest::SHA1
	9	Digest::Whirlpool Digest::Haval256
	10	)
	11	) {
	12	filter $digest, sub {
	13	my ($obj, $p) = @_;
	14	my $digest = $obj->clone->hexdigest;
	15	my $str = $digest;
	16	my $ref = ref $obj;
	17
	18	if ( $p->{digest}{show_class_name} ) {
	19	$str .= " ($ref)";
	20	}
	21
	22	unless ( exists $p->{digest}{show_reset}
	23	and !$p->{digest}{show_reset}
	24	) {
	25	if ($digest eq $ref->new->hexdigest) {
	26	$str .= ' [reset]';
	27	}
	28	}
	29
	30	my $color = $p->{color}{digest};
	31	$color = 'bright_green' unless defined $color;
	32
	33	return colored( $str, $color );
	34
	35	};
	36	}
	37
	38	1;
	39
	40	__END__
	41
	42	=head1 NAME
	43
	44	Data::Printer::Filter::Digest - pretty-printing MD5, SHA and friends
	45
	46	=head1 SYNOPSIS
	47
	48	In your program:
	49
	50	use Data::Printer filters => {
	51	-external => [ 'Digest' ],
	52	};
	53
	54	or, in your C<.dataprinter> file:
	55
	56	{
	57	filters => {
	58	-external => [ 'Digest' ],
	59	},
	60	};
	61
	62	You can also setup color and display details:
	63
	64	use Data::Printer
	65	filters => {
	66	-external => [ 'Digest' ],
	67	},
	68	color => {
	69	digest => 'bright_green',
	70	}
	71	digest => {
	72	show_class_name => 0, # default.
	73	show_reset => 1, # default.
	74	},
	75	};
	76
	77	=head1 DESCRIPTION
	78
	79	This is a filter plugin for L<Data::Printer>. It filters through
	80	several digest classes and displays their current value in
	81	hexadecimal format as a string.
	82
	83	=head2 Parsed Modules
	84
	85	=over 4
	86
	87	=item * L<Digest::Adler32>
	88
	89	=item * L<Digest::MD2>
	90
	91	=item * L<Digest::MD4>
	92
	93	=item * L<Digest::MD5>
	94
	95	=item * L<Digest::SHA>
	96
	97	=item * L<Digest::SHA1>
	98
	99	=item * L<Digest::Whirlpool>
	100
	101	=item * L<Digest::Haval256>
	102
	103	=back
	104
	105	If you have any suggestions for more modules or better output,
	106	please let us know.
	107
	108	=head2 Extra Options
	109
	110	Aside from the display color, there are a few other options to
	111	be customized via the C<digest> option key:
	112
	113	=head3 show_class_name
	114
	115	Set this to true to display the class name right next to the
	116	hexadecimal digest. Default is 0 (false).
	117
	118	=head3 show_reset
	119
	120	If set to true (the default), the filter will add a C<[reset]>
	121	tag after dumping an empty digest object. See the rationale below.
	122
	123	=head2 Note on dumping Digest::* objects
	124
	125	The digest operation is effectively a destructive, read-once operation. Once it has been performed, most Digest::* objects are automatically reset and can be used to calculate another digest value.
	126
	127	This behaviour - or, rather, forgetting about this behaviour - is
	128	a common source of issues when working with Digests.
	129
	130	This Data::Printer filter will B<not> destroy your object. Instead, we work on a cloned version to display the hexdigest, leaving your
	131	original object untouched.
	132
	133	As another debugging convenience for developers, since the empty
	134	object will produce a digest even after being used, this filter
	135	adds by default a C<[reset]> tag to indicate that the object is
	136	empty, in a 'reset' state - i.e. its hexdigest is the same as
	137	the hexdigest of a new, empty object of that same class.
	138
	139	=head1 SEE ALSO
	140
	141	L<Data::Printer>
	142
	143

+7

-4

lib/Data/Printer/Filter.pm less more

0	0	package Data::Printer::Filter;
1	1	use strict;
2	2	use warnings;
3		use Clone qw(clone);
	3	use Clone::PP qw(clone);
	4	require Carp;
4	5	require Data::Printer;
5	6
6	7	my %_filters_for = ();

13	14
14	15	my $filter = sub {
15	16	my ($type, $code) = @_;
	17
	18	Carp::croak "syntax: filter 'Class', sub { ... }"
	19	unless $type and $code and ref $code eq 'CODE';
16	20
17	21	unshift @{ $_filters_for{$id}{$type} }, sub {
18	22	my ($item, $p) = @_;

47	51
48	52	my $imported = sub (\[@$%&];%) {
49	53	my ($item, $p) = @_;
50		require Data::Printer;
51	54	return Data::Printer::p( $item, %properties );
52	55	};
53	56

101	104
102	105	return $ref->some_method; # or whatever
103	106
104		# see L</HELPER FUNCTIONS> below for
	107	# see 'HELPER FUNCTIONS' below for
105	108	# customization options, including
106	109	# proper indentation.
107		}
	110	};
108	111
109	112	1;
110	113

+313

-68

lib/Data/Printer.pm less more

0	0	package Data::Printer;
1	1	use strict;
2	2	use warnings;
3		use Term::ANSIColor qw(color colored colorstrip);
	3	use Term::ANSIColor qw(color colored);
4	4	use Scalar::Util;
5	5	use Sort::Naturally;
6	6	use Carp qw(croak);
7		use Clone qw(clone);
8		use Hash::FieldHash qw(fieldhash);
	7	use Clone::PP qw(clone);
	8	use if $] >= 5.010, 'Hash::Util::FieldHash' => qw(fieldhash);
	9	use if $] < 5.010, 'Hash::Util::FieldHash::Compat' => qw(fieldhash);
9	10	use File::Spec;
10	11	use File::HomeDir ();
11	12	use Fcntl;
12
13		our $VERSION = 0.30;
	13	use version 0.77 ();
	14
	15	our $VERSION = '0.31';
14	16
15	17	BEGIN {
16	18	if ($^O =~ /Win32/i) {

31	33	'sort_keys' => 1,
32	34	'deparse' => 0,
33	35	'hash_separator' => ' ',
	36	'separator' => ',',
	37	'end_separator' => 0,
34	38	'show_tied' => 1,
35	39	'show_tainted' => 1,
36	40	'show_weak' => 1,
	41	'show_readonly' => 0,
	42	'show_lvalue' => 1,
37	43	#'escape_chars' => 1, ### <== DEPRECATED!!!
38	44	'print_escapes' => 0,
39	45	'quote_keys' => 'auto',

49	55	'number' => 'bright_blue',
50	56	'string' => 'bright_yellow',
51	57	'class' => 'bright_green',
	58	'method' => 'bright_green',
52	59	'undef' => 'bright_red',
53	60	'hash' => 'magenta',
54	61	'regex' => 'yellow',
55	62	'code' => 'green',
56	63	'glob' => 'bright_cyan',
	64	'vstring' => 'bright_blue',
	65	'lvalue' => 'bright_white',
	66	'format' => 'bright_cyan',
57	67	'repeated' => 'white on_red',
58	68	'caller_info' => 'bright_cyan',
59	69	'weak' => 'cyan',
60	70	'tainted' => 'red',
61	71	'escaped' => 'bright_red',
	72	'unknown' => 'bright_yellow on_blue',
62	73	},
63	74	'class' => {
64	75	inherited => 'none', # also 'all', 'public' or 'private'
	76	universal => 1,
65	77	parents => 1,
66		linear_isa => 1,
	78	linear_isa => 'auto',
67	79	expand => 1, # how many levels to expand. 0 for none, 'all' for all
68	80	internals => 1,
69	81	export => 1,

73	85	_depth => 0, # used internally
74	86	},
75	87	'filters' => {
76		SCALAR => [ \&SCALAR ],
77		ARRAY => [ \&ARRAY ],
78		HASH => [ \&HASH ],
79		REF => [ \&REF ],
80		CODE => [ \&CODE ],
81		GLOB => [ \&GLOB ],
82		Regexp => [ \&Regexp ],
83		-class => [ \&_class ],
	88	# The IO ref type isn't supported as you can't actually create one,
	89	# any handle you make is automatically blessed into an IO::* object,
	90	# and those are separately handled.
	91	SCALAR => [ \&SCALAR ],
	92	ARRAY => [ \&ARRAY ],
	93	HASH => [ \&HASH ],
	94	REF => [ \&REF ],
	95	CODE => [ \&CODE ],
	96	GLOB => [ \&GLOB ],
	97	VSTRING => [ \&VSTRING ],
	98	LVALUE => [ \&LVALUE ],
	99	FORMAT => [ \&FORMAT ],
	100	Regexp => [ \&Regexp ],
	101	-unknown=> [ \&_unknown ],
	102	-class => [ \&_class ],
84	103	},
85	104
86	105	_output => *STDERR, # used internally

104	123	# the RC file overrides the defaults,
105	124	# (and we load it only once)
106	125	unless( exists $properties->{_initialized} ) {
107		my $file = ( $args && exists $args->{rc_file} )
108		? $args->{rc_file}
109		: File::Spec->catfile(File::HomeDir->my_home,'.dataprinter')
110		;
111
112		if (-e $file) {
113		if ( open my $fh, '<', $file ) {
114		my $rc_data;
115		{ local $/; $rc_data = <$fh> }
116		close $fh;
117
118		my $config = eval $rc_data;
119		if ( $@ ) {
120		warn "Error loading $file: $@\n";
121		}
122		elsif (!ref $config or ref $config ne 'HASH') {
123		warn "Error loading $file: config file must return a hash reference\n";
124		}
125		else {
126		$properties = _merge( $config );
127		}
128		}
129		else {
130		warn "error opening '$file': $!\n";
131		}
132		}
	126	_load_rc_file($args);
133	127	$properties->{_initialized} = 1;
134	128	}
135	129

180	174	elsif ($ref eq 'HASH') {
181	175	return %{ $item };
182	176	}
183		elsif ( grep { $ref eq $_ } qw(REF SCALAR CODE Regexp GLOB) ) {
	177	elsif ( grep { $ref eq $_ } qw(REF SCALAR CODE Regexp GLOB VSTRING) ) {
184	178	return $$item;
185	179	}
186	180	else {

279	273	}
280	274	}
281	275
282		if (not $found) {
	276	if (not $found and Scalar::Util::blessed($item) ) {
283	277	# let '-class' filters have a go
284	278	foreach my $filter ( @{ $p->{filters}->{'-class'} } ) {
285	279	if ( defined (my $result = $filter->($item, $p)) ) {
286	280	$string .= $result;
	281	$found = 1;
	282	last;
	283	}
	284	}
	285	}
	286
	287	if ( not $found ) {
	288	# if it's not a class and not a known core type, we must be in
	289	# a future perl with some type we're unaware of
	290	foreach my $filter ( @{ $p->{filters}->{'-unknown'} } ) {
	291	if ( defined (my $result = $filter->($item, $p)) ) {
	292	$string .= $result;
287	293	last;
288	294	}
289	295	}

322	328	if $p->{show_tainted} and Scalar::Util::tainted($$item);
323	329
324	330	$p->{_tie} = ref tied $$item;
	331
	332	if ($p->{show_readonly} and &Internals::SvREADONLY( $item )) {
	333	$string .= ' (read-only)';
	334	}
325	335
326	336	return $string;
327	337	}

401	411	$string .= ' ' . colored('(weak)', $p->{color}->{'weak'})
402	412	if $ref and Scalar::Util::isweak($item->[$i]) and $p->{show_weak};
403	413
404		$string .= ($i == $#{$item} ? '' : ',') . $BREAK;
	414	$string .= $p->{separator}
	415	if $i < $#{$item} \|\| $p->{end_separator};
	416
	417	$string .= $BREAK;
	418
405	419	my $size = 2 + length($i); # [10], [100], etc
406	420	substr $p->{name}, -$size, $size, '';
407	421	}

498	512
499	513	# length of the largest key is used for indenting
500	514	if ($multiline) {
501		my $l = length colorstrip($colored);
	515	my $l = length $colored;
502	516	$len = $l if $l > $len;
503	517	}
504	518	}

530	544	and $p->{show_weak}
531	545	and Scalar::Util::isweak($item->{$raw_key});
532	546
533		$string .= (--$total_keys == 0 ? '' : ',') . $BREAK;
	547	$string .= $p->{separator}
	548	if --$total_keys > 0 \|\| $p->{end_separator};
	549
	550	$string .= $BREAK;
534	551
535	552	my $size = 2 + length($raw_key); # {foo}, {z}, etc
536	553	substr $p->{name}, -$size, $size, '';

566	583	return $string;
567	584	}
568	585
	586	sub VSTRING {
	587	my ($item, $p) = @_;
	588	my $string = '';
	589	$string .= colored(version->declare($$item)->normal, $p->{color}->{'vstring'});
	590	return $string;
	591	}
	592
	593	sub FORMAT {
	594	my ($item, $p) = @_;
	595	my $string = '';
	596	$string .= colored("FORMAT", $p->{color}->{'format'});
	597	return $string;
	598	}
	599
	600	sub LVALUE {
	601	my ($item, $p) = @_;
	602	my $string = SCALAR( $item, $p );
	603	$string .= colored( ' (LVALUE)', $p->{color}{lvalue} )
	604	if $p->{show_lvalue};
	605
	606	return $string;
	607	}
569	608
570	609	sub GLOB {
571	610	my ($item, $p) = @_;

579	618	# implement some of these flags (maybe not even
580	619	# fcntl() itself, so we must wrap it.
581	620	my $flags;
582		eval { $flags = fcntl($$item, F_GETFL, 0) };
	621	eval { no warnings qw( unopened closed ); $flags = fcntl($$item, F_GETFL, 0) };
583	622	if ($flags) {
584	623	$extra .= ($flags & O_WRONLY) ? 'write-only'
585	624	: ($flags & O_RDWR) ? 'read/write'

592	631	# Solaris, for example, doesn't have O_ASYNC :(
593	632	my %flags = ();
594	633	eval { $flags{'append'} = O_APPEND };
595		eval { $flags{'async'} = O_ASYNC };
	634	eval { $flags{'async'} = O_ASYNC }; # leont says this is the only one I should care for.
596	635	eval { $flags{'create'} = O_CREAT };
597	636	eval { $flags{'truncate'} = O_TRUNC };
598	637	eval { $flags{'nonblocking'} = O_NONBLOCK };

603	642	$extra .= ', ';
604	643	}
605	644	my @layers = ();
606		eval { @layers = PerlIO::get_layers $$item };
	645	eval { @layers = PerlIO::get_layers $$item }; # TODO: try PerlIO::Layers::get_layers (leont)
607	646	unless ($@) {
608	647	$extra .= "layers: @layers";
609	648	}

613	652	return $string;
614	653	}
615	654
	655
	656	sub _unknown {
	657	my($item, $p) = @_;
	658	my $ref = ref $item;
	659
	660	my $string = '';
	661	$string = colored($ref, $p->{color}->{'unknown'});
	662	return $string;
	663	}
616	664
617	665	sub _class {
618	666	my ($item, $p) = @_;
619	667	my $ref = ref $item;
620	668
621	669	# if the user specified a method to use instead, we do that
622		if ( $p->{class_method} and $item->can($p->{class_method}) ) {
623		my $method = $p->{class_method};
624		return $item->$method;
	670	if ( $p->{class_method} and my $method = $item->can($p->{class_method}) ) {
	671	return $method->($item, $p);
625	672	}
626	673
627	674	my $string = '';

643	690
644	691	$p->{_current_indent} += $p->{indent};
645	692
646		require Class::MOP;
647		my $meta = Class::MOP::Class->initialize($ref);
648
649		if ( my @superclasses = $meta->superclasses ) {
	693	if ($] >= 5.010) {
	694	require mro;
	695	} else {
	696	require MRO::Compat;
	697	}
	698	require Package::Stash;
	699
	700	my $stash = Package::Stash->new($ref);
	701
	702	if ( my @superclasses = @{$stash->get_symbol('@ISA')\|\|[]} ) {
650	703	if ($p->{class}{parents}) {
651	704	$string .= (' ' x $p->{_current_indent})
652	705	. 'Parents '

655	708	) . $BREAK;
656	709	}
657	710
658		if ($p->{class}{linear_isa}) {
	711	if ( $p->{class}{linear_isa} and
	712	(
	713	($p->{class}{linear_isa} eq 'auto' and @superclasses > 1)
	714	or
	715	($p->{class}{linear_isa} ne 'auto')
	716	)
	717	) {
659	718	$string .= (' ' x $p->{_current_indent})
660	719	. 'Linear @ISA '
661	720	. join(', ', map { colored( $_, $p->{color}->{'class'}) }
662		$meta->linearized_isa
	721	@{mro::get_linear_isa($ref)}
663	722	) . $BREAK;
664	723	}
665	724	}
666	725
667		$string .= _show_methods($ref, $meta, $p)
	726	$string .= _show_methods($ref, $p)
668	727	if $p->{class}{show_methods} and $p->{class}{show_methods} ne 'none';
669	728
670	729	if ( $p->{'class'}->{'internals'} ) {

708	767
709	768
710	769	sub _show_methods {
711		my ($ref, $meta, $p) = @_;
	770	my ($ref, $p) = @_;
712	771
713	772	my $string = '';
714	773	my $methods = {

717	776	};
718	777	my $inherited = $p->{class}{inherited} \|\| 'none';
719	778
	779	require B;
	780
	781	my $methods_of = sub {
	782	my ($name) = @_;
	783	map {
	784	my $m;
	785	if ($_
	786	and $m = B::svref_2object($_)
	787	and $m->isa('B::CV')
	788	and not $m->GV->isa('B::Special')
	789	) {
	790	[ $m->GV->STASH->NAME, $m->GV->NAME ]
	791	} else {
	792	()
	793	}
	794	} values %{Package::Stash->new($name)->get_all_symbols('CODE')}
	795	};
	796
	797	my %seen_method_name;
	798
720	799	METHOD:
721		foreach my $method ($meta->get_all_methods) {
722		my $method_string = $method->name;
	800	foreach my $method (
	801	map $methods_of->($_), @{mro::get_linear_isa($ref)},
	802	$p->{class}{universal} ? 'UNIVERSAL' : ()
	803	) {
	804	my ($package_string, $method_string) = @$method;
	805
	806	next METHOD if $seen_method_name{$method_string}++;
	807
723	808	my $type = substr($method_string, 0, 1) eq '_' ? 'private' : 'public';
724	809
725		if ($method->package_name ne $ref) {
	810	if ($package_string ne $ref) {
726	811	next METHOD unless $inherited ne 'none'
727	812	and ($inherited eq 'all' or $type eq $inherited);
728		$method_string .= ' (' . $method->package_name . ')';
	813	$method_string .= ' (' . $package_string . ')';
729	814	}
730	815
731	816	push @{ $methods->{$type} }, $method_string;

742	827	$string .= (' ' x $p->{_current_indent})
743	828	. "$type methods (" . scalar @list . ')'
744	829	. (@list ? ' : ' : '')
745		. join(', ', map { colored($_, $p->{color}->{class}) }
	830	. join(', ', map { colored($_, $p->{color}->{method}) }
746	831	@list
747	832	) . $BREAK;
748	833	}

784	869	foreach my $key (keys %$p) {
785	870	if ($key eq 'color' or $key eq 'colour') {
786	871	my $color = $p->{$key};
787		if (defined $color and not $color) {
	872	if ( not ref $color or ref $color ne 'HASH' ) {
	873	Carp::carp q['color' should be a HASH reference. Did you mean 'colored'?];
788	874	$clone->{color} = {};
789	875	}
790	876	else {
791		foreach my $target ( keys %{$p->{$key}} ) {
	877	foreach my $target ( keys %$color ) {
792	878	$clone->{color}->{$target} = $p->{$key}->{$target};
793	879	}
794	880	}

875	961	}
876	962
877	963
	964	sub _load_rc_file {
	965	my $args = shift \|\| {};
	966
	967	my $file = exists $args->{rc_file} ? $args->{rc_file}
	968	: exists $ENV{DATAPRINTERRC} ? $ENV{DATAPRINTERRC}
	969	: File::Spec->catfile(File::HomeDir->my_home,'.dataprinter');
	970
	971	return unless -e $file;
	972
	973	my $mode = (stat $file )[2];
	974	if ($^O !~ /Win32/i && ($mode & 0020 \|\| $mode & 0002) ) {
	975	warn "rc file '$file' must NOT be writeable to other users. Skipping.\n";
	976	return;
	977	}
	978
	979	if ( -l $file \|\| (!-f _) \|\| -p _ \|\| -S _ \|\| -b _ \|\| -c _ ) {
	980	warn "rc file '$file' doesn't look like a plain file. Skipping.\n";
	981	return;
	982	}
	983
	984	unless (-o $file) {
	985	warn "rc file '$file' must be owned by your (effective) user. Skipping.\n";
	986	return;
	987	}
	988
	989	if ( open my $fh, '<', $file ) {
	990	my $rc_data;
	991	{ local $/; $rc_data = <$fh> }
	992	close $fh;
	993
	994	if( ${^TAINT} != 0 ) {
	995	if ( $args->{allow_tainted} ) {
	996	warn "WARNING: Reading tainted file '$file' due to user override.\n";
	997	$rc_data =~ /(.+)/s; # very bad idea - god help you
	998	$rc_data = $1;
	999	}
	1000	else {
	1001	warn "taint mode on: skipping rc file '$file'.\n";
	1002	return;
	1003	}
	1004	}
	1005
	1006	my $config = eval $rc_data;
	1007	if ( $@ ) {
	1008	warn "Error loading $file: $@\n";
	1009	}
	1010	elsif (!ref $config or ref $config ne 'HASH') {
	1011	warn "Error loading $file: config file must return a hash reference\n";
	1012	}
	1013	else {
	1014	$properties = _merge( $config );
	1015	}
	1016	}
	1017	else {
	1018	warn "error opening '$file': $!\n";
	1019	}
	1020	}
	1021
	1022
878	1023	1;
879	1024	__END__
880	1025

1083	1228	number => 'bright_blue', # numbers
1084	1229	string => 'bright_yellow', # strings
1085	1230	class => 'bright_green', # class names
	1231	method => 'bright_green', # method names
1086	1232	undef => 'bright_red', # the 'undef' value
1087	1233	hash => 'magenta', # hash keys
1088	1234	regex => 'yellow', # regular expressions
1089	1235	code => 'green', # code references
1090	1236	glob => 'bright_cyan', # globs (usually file handles)
	1237	vstring => 'bright_blue', # version strings (v5.16.0, etc)
1091	1238	repeated => 'white on_red', # references to seen values
1092	1239	caller_info => 'bright_cyan', # details on what's being printed
1093	1240	weak => 'cyan', # weak references
1094	1241	tainted => 'red', # tainted content
1095	1242	escaped => 'bright_red', # escaped characters (\t, \n, etc)
	1243
	1244	# potential new Perl datatypes, unknown to Data::Printer
	1245	unknown => 'bright_yellow on_blue',
1096	1246	},
1097	1247	};
1098	1248

1148	1298	show_tied => 1, # expose tied variables
1149	1299	show_tainted => 1, # expose tainted variables
1150	1300	show_weak => 1, # expose weak references
	1301	show_readonly => 0, # expose scalar variables marked as read-only
	1302	show_lvalue => 1, # expose lvalue types
1151	1303	print_escapes => 0, # print non-printable chars as "\n", "\t", etc.
1152	1304	quote_keys => 'auto', # quote hash keys (1 for always, 0 for never).
1153	1305	# 'auto' will quote when key is empty/space-only.
	1306	separator => ',', # uses ',' to separate array/hash elements
	1307	end_separator => 0, # prints the separator after last element in array/hash.
	1308	# the default is 0 that means not to print
1154	1309
1155	1310	caller_info => 0, # include information on what's being printed
1156	1311	use_prototypes => 1, # allow p(%foo), but prevent anonymous data

1167	1322	inherited => 'none', # show inherited methods,
1168	1323	# can also be 'all', 'private', or 'public'.
1169	1324
1170		parents => 1, # show parents?
1171		linear_isa => 1, # show the entire @ISA, linearized
	1325	universal => 1, # include UNIVERSAL methods in inheritance list
	1326
	1327	parents => 1, # show parents, if there are any
	1328	linear_isa => 'auto', # show the entire @ISA, linearized, whenever
	1329	# the object has more than one parent. Can
	1330	# also be set to 1 (always show) or 0 (never).
1172	1331
1173	1332	expand => 1, # how deep to traverse the object (in case
1174	1333	# it contains other objects). Defaults to

1326	1485
1327	1486	You can even set this to undef or to a non-existing file to disable your
1328	1487	RC file at will.
	1488
	1489	The RC file location can also be specified with the C<DATAPRINTERRC>
	1490	environment variable. Using C<rc_file> in code will override the environment
	1491	variable.
	1492
	1493	=head2 RC File Security
	1494
	1495	The C<.dataprinter> RC file is nothing but a Perl hash that
	1496	gets C<eval>'d back into the code. This means that whatever
	1497	is in your RC file B<WILL BE INTERPRETED BY PERL AT RUNTIME>.
	1498	This can be quite worrying if you're not the one in control
	1499	of the RC file.
	1500
	1501	For this reason, Data::Printer takes extra precaution before
	1502	loading the file:
	1503
	1504	=over 4
	1505
	1506	=item * The file has to be in your home directory unless you
	1507	specifically point elsewhere via the 'C<rc_file>' property or
	1508	the DATAPRINTERRC environment variable;
	1509
	1510	=item * The file B<must> be a plain file, never a symbolic
	1511	link, named pipe or socket;
	1512
	1513	=item * The file B<must> be owned by you (i.e. the effective
	1514	user id that ran the script using Data::Printer);
	1515
	1516	=item * The file B<must> be read-only for everyone but your user.
	1517	This usually means permissions C<0644>, C<0640> or C<0600> in
	1518	Unix-like systems. B<THIS IS NOT CHECKED IN WIN32>;
	1519
	1520	=item * The file will B<NOT> be loaded in Taint mode, unless
	1521	you specifically load Data::Printer with the 'allow_tainted'
	1522	option set to true. And even if you do that, Data::Printer
	1523	will still issue a warning before loading the file. But
	1524	seriously, don't do that.
	1525
	1526	=back
	1527
	1528	Failure to comply with the security rules above will result in
	1529	the RC file not being loaded (likely with a warning on what went
	1530	wrong).
	1531
1329	1532
1330	1533	=head1 THE "DDP" PACKAGE ALIAS
1331	1534

1640	1843	HTML escaped output of C<p($object)>, so you can print it for
1641	1844	later inspection or render it (if it's a web app).
1642	1845
	1846	=head2 Using Data::Printer with Template Toolkit
	1847
	1848	I<< (contributed by Stephen Thirlwall (sdt)) >>
	1849
	1850	If you use Template Toolkit and want to dump your variables using Data::Printer,
	1851	install the L<Template::Plugin::DataPrinter> module and load it in your template:
	1852
	1853	[% USE DataPrinter %]
	1854
	1855	The provided methods match those of C<Template::Plugin::Dumper>:
	1856
	1857	ansi-colored dump of the data structure in "myvar":
	1858	[% DataPrinter.dump( myvar ) %]
	1859
	1860	html-formatted, colored dump of the same data structure:
	1861	[% DataPrinter.dump_html( myvar ) %]
	1862
	1863	The module allows several customization options, even letting you load it as a
	1864	complete drop-in replacement for Template::Plugin::Dumper so you don't even have
	1865	to change your previous templates!
	1866
1643	1867	=head2 Unified interface for Data::Printer and other debug formatters
1644	1868
1645	1869	I<< (contributed by Kevin McGrath (catlgrep)) >>

1695	1919
1696	1920	You can check you L<dip>'s own documentation for more information and options.
1697	1921
	1922	=head2 Sample output for color fine-tuning
	1923
	1924	I<< (contributed by Yanick Champoux (yanick)) >>
	1925
	1926	The "examples/try_me.pl" file included in this distribution has a sample
	1927	dump with a complex data structure to let you quickly test color schemes.
	1928
1698	1929
1699	1930	=head1 BUGS
1700	1931

1756	1987
1757	1988	=item * Fitz Elliott
1758	1989
	1990	=item * Ivan Bessarabov (bessarabv)
	1991
1759	1992	=item * J Mash
1760	1993
1761	1994	=item * Jesse Luehrs (doy)
1762	1995
	1996	=item * Joel Berger (jberger)
	1997
1763	1998	=item * Kartik Thakore (kthakore)
1764	1999
1765	2000	=item * Kevin Dawson (bowtie)

1780	2015
1781	2016	=item * Przemysław Wesołek (jest)
1782	2017
	2018	=item * Rebecca Turner (iarna)
	2019
	2020	=item * Rob Hoelz (hoelzro)
	2021
1783	2022	=item * Sebastian Willing (Sewi)
1784	2023
1785	2024	=item * Sergey Aleynikov (randir)
1786	2025
	2026	=item * Stanislaw Pusep (syp)
	2027
	2028	=item * Stephen Thirlwall (sdt)
	2029
1787	2030	=item * sugyan
1788	2031
1789	2032	=item * Tatsuhiko Miyagawa (miyagawa)

1793	2036	=item * Torsten Raudssus (Getty)
1794	2037
1795	2038	=item * Wesley Dal`Col (blabos)
	2039
	2040	=item * Yanick Champoux (yanick)
1796	2041
1797	2042	=back
1798	2043

+1

-4

t/00-load.t less more

0	0	#!perl
1	1
2		use Test::More tests => 2;
	2	use Test::More tests => 1;
3	3
4	4	BEGIN {
5	5	diag( "Beginning Data::Printer tests in $^O with Perl $], $^X" );
6		use_ok( 'Class::MOP' ) \|\| print "Bail out!
7		";
8		diag( "Trying to load Data::Printer with Class::MOP $Class::MOP::VERSION" );
9	6	use_ok( 'Data::Printer' ) \|\| print "Bail out!
10	7	";
11	8	}

+1

-0

t/01-p.t less more

3	3	use Test::More;
4	4	BEGIN {
5	5	$ENV{ANSI_COLORS_DISABLED} = 1;
	6	delete $ENV{DATAPRINTERRC};
6	7	use File::HomeDir::Test; # avoid user's .dataprinter
7	8	};
8	9

+1

-0

t/02-colors.t less more

3	3
4	4	BEGIN {
5	5	delete $ENV{ANSI_COLORS_DISABLED};
	6	delete $ENV{DATAPRINTERRC};
6	7	use File::HomeDir::Test; # avoid user's .dataprinter
7	8	use_ok ('Term::ANSIColor');
8	9	use_ok ('Data::Printer', colored => 1);

+1

-0

t/02.2-autocolor.t less more

3	3
4	4	BEGIN {
5	5	delete $ENV{ANSI_COLORS_DISABLED};
	6	delete $ENV{DATAPRINTERRC};
6	7	use File::HomeDir::Test; # avoid user's .dataprinter
7	8	use Term::ANSIColor;
8	9	};

+1

-0

t/03-conf.t less more

3	3	use Test::More;
4	4	BEGIN {
5	5	$ENV{ANSI_COLORS_DISABLED} = 1;
	6	delete $ENV{DATAPRINTERRC};
6	7	use File::HomeDir::Test; # avoid user's .dataprinter
7	8	};
8	9

+1

-0

t/03-conf_not_ref.t less more

3	3	use Test::More;
4	4	BEGIN {
5	5	$ENV{ANSI_COLORS_DISABLED} = 1;
	6	delete $ENV{DATAPRINTERRC};
6	7	use File::HomeDir::Test; # avoid user's .dataprinter
7	8	};
8	9

+1

-0

t/04-multiline.t less more

3	3	use Test::More;
4	4	BEGIN {
5	5	$ENV{ANSI_COLORS_DISABLED} = 1;
	6	delete $ENV{DATAPRINTERRC};
6	7	use File::HomeDir::Test; # avoid user's .dataprinter
7	8	};
8	9

+83

-34

t/05-obj.t less more

2	2
3	3	BEGIN {
4	4	$ENV{ANSI_COLORS_DISABLED} = 1;
	5	delete $ENV{DATAPRINTERRC};
5	6	use File::HomeDir::Test; # avoid user's .dataprinter
6	7	};
7	8

23	24
24	25	1;
25	26
	27	package Baz;
	28	sub bar { 42 }
	29
	30	1;
	31
	32	package Meep;
	33	our @ISA = qw(Foo Baz);
	34
	35	1;
	36
	37	package ParentLess;
	38	sub new { bless {}, shift }
	39
	40	1;
	41
26	42	package main;
27	43	use Test::More;
28	44	use Data::Printer;
29	45
30		my $old_MOP = 0;
31		eval 'use Class::MOP 2.0300';
32		$old_MOP = 1 if $@;
33
34	46	my $obj = Foo->new;
35	47
36	48	is( p($obj), 'Foo {
37	49	Parents Bar
	50	public methods (4) : baz, borg, foo, new
	51	private methods (1) : _other
	52	internals: {
	53	test 42
	54	}
	55	}', 'testing objects' );
	56
	57	is( p($obj, class => { linear_isa => 1 }), 'Foo {
	58	Parents Bar
38	59	Linear @ISA Foo, Bar
39	60	public methods (4) : baz, borg, foo, new
40	61	private methods (1) : _other
41	62	internals: {
42	63	test 42
43	64	}
44		}', 'testing objects' );
	65	}', 'testing objects, forcing linear @ISA' );
45	66
46	67	is( p($obj, class => { parents => 0 }), 'Foo {
47		Linear @ISA Foo, Bar
48	68	public methods (4) : baz, borg, foo, new
49	69	private methods (1) : _other
50	70	internals: {

52	72	}
53	73	}', 'testing objects (parents => 0)' );
54	74
55		is( p($obj, class => { linear_isa => 0 }), 'Foo {
56		Parents Bar
57		public methods (4) : baz, borg, foo, new
58		private methods (1) : _other
59		internals: {
60		test 42
61		}
62		}', 'testing objects (linear_isa => 0)' );
63
64	75	is( p($obj, class => { show_methods => 'none' }), 'Foo {
65	76	Parents Bar
66		Linear @ISA Foo, Bar
67	77	internals: {
68	78	test 42
69	79	}

71	81
72	82	is( p($obj, class => { show_methods => 'public' }), 'Foo {
73	83	Parents Bar
74		Linear @ISA Foo, Bar
75	84	public methods (4) : baz, borg, foo, new
76	85	internals: {
77	86	test 42

80	89
81	90	is( p($obj, class => { show_methods => 'private' }), 'Foo {
82	91	Parents Bar
83		Linear @ISA Foo, Bar
84	92	private methods (1) : _other
85	93	internals: {
86	94	test 42

89	97
90	98	is( p($obj, class => { show_methods => 'all' }), 'Foo {
91	99	Parents Bar
92		Linear @ISA Foo, Bar
93	100	public methods (4) : baz, borg, foo, new
94	101	private methods (1) : _other
95	102	internals: {

100	107	is( p($obj, class => { internals => 0 } ),
101	108	'Foo {
102	109	Parents Bar
103		Linear @ISA Foo, Bar
104	110	public methods (4) : baz, borg, foo, new
105	111	private methods (1) : _other
106	112	}', 'testing objects (no internals)' );
107	113
108	114	is( p($obj, class => { inherited => 0 }), 'Foo {
109	115	Parents Bar
110		Linear @ISA Foo, Bar
111	116	public methods (4) : baz, borg, foo, new
112	117	private methods (1) : _other
113	118	internals: {

115	120	}
116	121	}', 'testing objects (inherited => 0)' );
117	122
118		my $public = $old_MOP
119		? 'public methods (5) : bar (Bar), baz, borg, foo, new'
120		: 'public methods (9) : bar (Bar), baz, borg, can (UNIVERSAL), DOES (UNIVERSAL), foo, isa (UNIVERSAL), new, VERSION (UNIVERSAL)'
121		;
	123	my $extra_field = ( $] < 5.010 ) ? '' : ' DOES (UNIVERSAL),';
122	124
123	125	is( p($obj, class => { inherited => 'all' }), "Foo {
124	126	Parents Bar
125		Linear \@ISA Foo, Bar
126		$public
	127	public methods (9) : bar (Bar), baz, borg, can (UNIVERSAL),$extra_field foo, isa (UNIVERSAL), new, VERSION (UNIVERSAL)
127	128	private methods (2) : _moo (Bar), _other
128	129	internals: {
129	130	test 42
130	131	}
131	132	}", 'testing objects (inherited => "all")' );
132	133
	134	is( p($obj, class => { inherited => 'all', universal => 0 }), "Foo {
	135	Parents Bar
	136	public methods (5) : bar (Bar), baz, borg, foo, new
	137	private methods (2) : _moo (Bar), _other
	138	internals: {
	139	test 42
	140	}
	141	}", 'testing objects (inherited => "all", universal => 0)' );
133	142
134	143	is( p($obj, class => { inherited => 'public' }), "Foo {
135	144	Parents Bar
136		Linear \@ISA Foo, Bar
137		$public
	145	public methods (9) : bar (Bar), baz, borg, can (UNIVERSAL),$extra_field foo, isa (UNIVERSAL), new, VERSION (UNIVERSAL)
138	146	private methods (1) : _other
139	147	internals: {
140	148	test 42
141	149	}
142	150	}", 'testing objects (inherited => "public")' );
143	151
	152	is( p($obj, class => { inherited => 'public', universal => 0 }), "Foo {
	153	Parents Bar
	154	public methods (5) : bar (Bar), baz, borg, foo, new
	155	private methods (1) : _other
	156	internals: {
	157	test 42
	158	}
	159	}", 'testing objects (inherited => "public", universal => 0)' );
	160
144	161	is( p($obj, class => { inherited => 'private' }), 'Foo {
145	162	Parents Bar
146		Linear @ISA Foo, Bar
147	163	public methods (4) : baz, borg, foo, new
148	164	private methods (2) : _moo (Bar), _other
149	165	internals: {

158	174
159	175	is( p($obj), 'Foo {
160	176	Parents Bar
161		Linear @ISA Foo, Bar
162	177	public methods (4) : baz, borg, foo, new
163	178	private methods (1) : _other
164	179	internals: {

169	184
170	185	is( p($obj, class => { expand => 'all'} ), 'Foo {
171	186	Parents Bar
172		Linear @ISA Foo, Bar
173	187	public methods (4) : baz, borg, foo, new
174	188	private methods (1) : _other
175	189	internals: {
176	190	borg Foo {
177	191	Parents Bar
178		Linear @ISA Foo, Bar
179	192	public methods (4) : baz, borg, foo, new
180	193	private methods (1) : _other
181	194	internals: {

186	199	}
187	200	}', 'testing nested objects with expansion' );
188	201
189
	202	my $obj_with_isa = Meep->new;
	203
	204	is( p($obj_with_isa), 'Meep {
	205	Parents Foo, Baz
	206	Linear @ISA Meep, Foo, Bar, Baz
	207	public methods (0)
	208	private methods (0)
	209	internals: {
	210	test 42
	211	}
	212	}', 'testing objects with @ISA' );
	213
	214	is( p($obj_with_isa, class => { linear_isa => 0 }), 'Meep {
	215	Parents Foo, Baz
	216	public methods (0)
	217	private methods (0)
	218	internals: {
	219	test 42
	220	}
	221	}', 'testing objects with @ISA, opting out the @ISA' );
	222
	223	is( p($obj_with_isa, class => { linear_isa => 0 }), 'Meep {
	224	Parents Foo, Baz
	225	public methods (0)
	226	private methods (0)
	227	internals: {
	228	test 42
	229	}
	230	}', 'testing objects with @ISA' );
	231
	232	my $parentless = ParentLess->new;
	233
	234	is( p($parentless), 'ParentLess {
	235	public methods (1) : new
	236	private methods (0)
	237	internals: {}
	238	}', 'testing parentless object' );
190	239
191	240	done_testing;

+1

-0

t/06-obj2.t less more

2	2
3	3	BEGIN {
4	4	$ENV{ANSI_COLORS_DISABLED} = 1;
	5	delete $ENV{DATAPRINTERRC};
5	6	use File::HomeDir::Test; # avoid user's .dataprinter
6	7	};
7	8

+1

-0

t/07-sort.t less more

13	13	use Test::More;
14	14	BEGIN {
15	15	$ENV{ANSI_COLORS_DISABLED} = 1;
	16	delete $ENV{DATAPRINTERRC};
16	17	use File::HomeDir::Test; # avoid user's .dataprinter
17	18	};
18	19

+1

-0

t/08-deparse.t less more

3	3	use Test::More;
4	4	BEGIN {
5	5	$ENV{ANSI_COLORS_DISABLED} = 1;
	6	delete $ENV{DATAPRINTERRC};
6	7	use File::HomeDir::Test; # avoid user's .dataprinter
7	8	};
8	9

+1

-0

t/09-alias.t less more

3	3	use Test::More;
4	4	BEGIN {
5	5	$ENV{ANSI_COLORS_DISABLED} = 1;
	6	delete $ENV{DATAPRINTERRC};
6	7	use File::HomeDir::Test; # avoid user's .dataprinter
7	8	};
8	9

+1

-0

t/10-filter.t less more

3	3
4	4	BEGIN {
5	5	$ENV{ANSI_COLORS_DISABLED} = 1;
	6	delete $ENV{DATAPRINTERRC};
6	7	use File::HomeDir::Test; # avoid user's .dataprinter
7	8	};
8	9

+1

-0

t/11-aliased_with_filter.t less more

3	3	use Test::More;
4	4	BEGIN {
5	5	$ENV{ANSI_COLORS_DISABLED} = 1;
	6	delete $ENV{DATAPRINTERRC};
6	7	use File::HomeDir::Test; # avoid user's .dataprinter
7	8	};
8	9

+1

-0

t/12-filter_class.t less more

3	3
4	4	BEGIN {
5	5	$ENV{ANSI_COLORS_DISABLED} = 1;
	6	delete $ENV{DATAPRINTERRC};
6	7	use File::HomeDir::Test; # avoid user's .dataprinter
7	8	};
8	9

+30

-1

t/13-filter_datetime.t less more

5	5
6	6	BEGIN {
7	7	$ENV{ANSI_COLORS_DISABLED} = 1;
	8	delete $ENV{DATAPRINTERRC};
8	9	use File::HomeDir::Test; # avoid user's .dataprinter
9	10
10	11	# Time::Piece is only able to overload

49	50
50	51	SKIP: {
51	52	eval 'use DateTime';
52		skip 'DateTime not available', 3 if $@;
	53	skip 'DateTime not available', 4 if $@;
53	54
54	55	my $d1 = DateTime->new( year => 1981, month => 9, day => 29 );
55	56	my $d2 = DateTime->new( year => 1984, month => 11, day => 15 );

67	68	};
68	69
69	70	SKIP: {
	71	eval 'use DateTime::TimeZone';
	72	skip 'DateTime::TimeZone not available', 2 if $@;
	73
	74	my $d = DateTime::TimeZone->new( name => 'America/Sao_Paulo' );
	75	is( p($d), 'America/Sao_Paulo', 'DateTime::TimeZone' );
	76	my @list = ($d, { foo => 1 });
	77	is( p(@list), '[
	78	[0] America/Sao_Paulo,
	79	[1] this is a hash
	80	]', 'inline and class filters together (DateTime::TimeZone)'
	81	);
	82	};
	83
	84	SKIP: {
70	85	eval 'use DateTime::Incomplete';
71	86	skip 'DateTime::Incomplete not available', 2 if $@;
72	87

77	92	[0] 2003-xx-xxTxx:xx:xx,
78	93	[1] this is a hash
79	94	]', 'inline and class filters together (DateTime::Incomplete)'
	95	);
	96	};
	97
	98	SKIP: {
	99	eval 'use DateTime::Tiny';
	100	skip 'DateTime::Tiny not available', 2 if $@;
	101
	102	my $d = DateTime::Tiny->new( year => 2003, month => 3, day => 11 );
	103	is( p($d), '2003-03-11T00:00:00', 'DateTime::Tiny' );
	104	my @list = ($d, { foo => 1 });
	105	is( p(@list), '[
	106	[0] 2003-03-11T00:00:00,
	107	[1] this is a hash
	108	]', 'inline and class filters together (DateTime::Tiny)'
80	109	);
81	110	};
82	111

+1

-0

t/13.2-filter_db.t less more

5	5
6	6	BEGIN {
7	7	$ENV{ANSI_COLORS_DISABLED} = 1;
	8	delete $ENV{DATAPRINTERRC};
8	9	use File::HomeDir::Test;
9	10	};
10	11

+53

-0

t/13.3-filter_digest.t less more

	0	use strict;
	1	use warnings;
	2	use Test::More;
	3
	4	BEGIN {
	5	$ENV{ANSI_COLORS_DISABLED} = 1;
	6	delete $ENV{DATAPRINTERRC};
	7	use File::HomeDir::Test; # avoid user's .dataprinter
	8	};
	9
	10	use Data::Printer {
	11	filters => {
	12	-external => [ 'Digest' ],
	13	HASH => sub { 'this is a hash' }
	14	},
	15	};
	16
	17	my $data = 'I can has Digest?';
	18
	19	foreach my $module (qw( Digest::Adler32 Digest::MD2 Digest::MD4 Digest::MD5
	20	Digest::SHA Digest::SHA1
	21	Digest::Whirlpool Digest::Haval256
	22	)) {
	23
	24	SKIP: {
	25	eval "use $module";
	26	skip "$module not available", 1 if $@;
	27
	28	my $digest = $module->new;
	29	$digest->add( $data );
	30
	31	my $dump = p $digest;
	32	my $named_dump = p $digest, digest => { show_class_name => 1 };
	33
	34	my @list = ($digest, { foo => 1 });
	35	my $list_dump = p @list;
	36	my $hex = $digest->hexdigest;
	37
	38	is( $dump, $hex, $module );
	39	is( $named_dump, "$hex ($module)", "$module with class name" );
	40
	41	is( $list_dump, "[
	42	[0] $hex,
	43	[1] this is a hash
	44	]", "inline and class filters together ($module)"
	45	);
	46
	47	is( p($digest), $digest->hexdigest . ' [reset]', "reset $module");
	48	};
	49
	50	}
	51
	52	done_testing;

+1

-0

t/14-local_conf.t less more

3	3
4	4	BEGIN {
5	5	delete $ENV{ANSI_COLORS_DISABLED};
	6	delete $ENV{DATAPRINTERRC};
6	7	use File::HomeDir::Test; # avoid user's .dataprinter
7	8	use_ok 'Term::ANSIColor';
8	9	use_ok 'Data::Printer', colored => 1;

+2

-0

t/15-rc_file.t less more

4	4	my $file;
5	5	BEGIN {
6	6	delete $ENV{ANSI_COLORS_DISABLED};
	7	delete $ENV{DATAPRINTERRC};
7	8	use Term::ANSIColor;
8	9	use File::HomeDir::Test;
9	10	use File::HomeDir;

17	18	if (-e $file) {
18	19	plan skip_all => 'File .dataprinter should not be in test homedir';
19	20	}
	21	umask 0022;
20	22	open my $fh, '>', $file
21	23	or plan skip_all => "error opening .dataprinter: $!";
22	24

+2

-0

t/16-rc_file2.t less more

4	4	my $file;
5	5	BEGIN {
6	6	delete $ENV{ANSI_COLORS_DISABLED};
	7	delete $ENV{DATAPRINTERRC};
7	8	use_ok ('Term::ANSIColor');
8	9	use_ok ('File::HomeDir::Test');
9	10	use_ok ('File::HomeDir');

17	18	if (-e $file) {
18	19	plan skip_all => 'File .dataprinter should not be in test homedir';
19	20	}
	21	umask 0022;
20	22	open my $fh, '>', $file
21	23	or plan skip_all => "error opening .dataprinter: $!";
22	24

+2

-0

t/16.2-rc_overwrite.t less more

4	4	my $file;
5	5	BEGIN {
6	6	delete $ENV{ANSI_COLORS_DISABLED};
	7	delete $ENV{DATAPRINTERRC};
7	8	use Term::ANSIColor;
8	9	use File::HomeDir::Test;
9	10	use File::HomeDir;

17	18	if (-e $file) {
18	19	plan skip_all => 'File my_rc_file should not be in test homedir';
19	20	}
	21	umask 0022;
20	22	open my $fh, '>', $file
21	23	or plan skip_all => "error opening .dataprinter: $!";
22	24

+68

-0

t/16.3-rc_env.t less more

	0	use strict;
	1	use warnings;
	2	use Test::More;
	3
	4	sub create_rc_file {
	5	my ($filename, $content) = @_;
	6
	7	my $file = File::Spec->catfile(
	8	File::HomeDir->my_home,
	9	$filename
	10	);
	11
	12	if (-e $file) {
	13	plan skip_all => "File $filename should not be in test homedir";
	14	}
	15	umask 0022;
	16	open my $fh, '>', $file
	17	or plan skip_all => "error opening $filename: $!";
	18
	19	print {$fh} $content
	20	or plan skip_all => "error writing to $filename: $!";
	21
	22	close $fh;
	23	return $file;
	24	}
	25
	26	my $standard_rcfile;
	27	my $custom_rcfile;
	28	BEGIN {
	29	delete $ENV{ANSI_COLORS_DISABLED};
	30	use_ok ('Term::ANSIColor');
	31	use_ok ('File::HomeDir::Test');
	32	use_ok ('File::HomeDir');
	33	use_ok ('File::Spec');
	34
	35	$standard_rcfile = create_rc_file('.dataprinter',
	36	'{ colored => 1, color => { hash => "red" }, hash_separator => " + "}'
	37	);
	38	$custom_rcfile = create_rc_file('.customrc',
	39	'{ colored => 1, color => { hash => "green" }, hash_separator => " % "}'
	40	);
	41	$ENV{DATAPRINTERRC} = $custom_rcfile;
	42
	43	# standard and custom rc files created
	44	# check that the custom rc overrides the standard one
	45	use_ok ('Data::Printer');
	46
	47	unlink $standard_rcfile or fail('error removing test file');
	48	unlink $custom_rcfile or fail('error removing test file');
	49	};
	50
	51	my %hash = ( key => 'value' );
	52
	53	is( p(%hash), color('reset') . "{$/ "
	54	. colored('key', 'green')
	55	. ' % '
	56	. colored('"value"', 'bright_yellow')
	57	. "$/}"
	58	, 'custom rc file overrides standard rc file');
	59
	60	is( p(%hash, color => { hash => 'blue' }, hash_separator => ' * ' ), color('reset') . "{$/ "
	61	. colored('key', 'blue')
	62	. ' * '
	63	. colored('"value"', 'bright_yellow')
	64	. "$/}"
	65	, 'in-code configuration overrides custom rc file');
	66
	67	done_testing;

+52

-0

t/16.4-rc_env2.t less more

	0	use strict;
	1	use warnings;
	2	use Test::More;
	3
	4	my $file;
	5	BEGIN {
	6	delete $ENV{ANSI_COLORS_DISABLED};
	7	use_ok ('Term::ANSIColor');
	8	use_ok ('File::HomeDir::Test');
	9	use_ok ('File::HomeDir');
	10	use_ok ('File::Spec');
	11
	12	$file = File::Spec->catfile(
	13	File::HomeDir->my_home,
	14	'.customrc'
	15	);
	16
	17	if (-e $file) {
	18	plan skip_all => 'File .customrc should not be in test homedir';
	19	}
	20	umask 0022;
	21	open my $fh, '>', $file
	22	or plan skip_all => "error opening .customrc: $!";
	23
	24	print {$fh} '{ colored => 1, color => { hash => "red" }, hash_separator => " + "}'
	25	or plan skip_all => "error writing to .customrc: $!";
	26
	27	close $fh;
	28
	29	$ENV{DATAPRINTERRC} = $file;
	30
	31	# file created and in place, check that the explicit configuration below
	32	# overrides the custom rc file
	33	use_ok ('Data::Printer', {
	34	color => {
	35	hash => 'blue'
	36	},
	37	hash_separator => ' * ',
	38	});
	39	unlink $file or fail('error removing test file');
	40	};
	41
	42	my %hash = ( key => 'value' );
	43
	44	is( p(%hash), color('reset') . "{$/ "
	45	. colored('key', 'blue')
	46	. ' * '
	47	. colored('"value"', 'bright_yellow')
	48	. "$/}"
	49	, 'global configuration overrides our custom rc file');
	50
	51	done_testing;

+62

-0

t/16.5-rc_env3.t less more

	0	use strict;
	1	use warnings;
	2	use Test::More;
	3
	4	sub create_rc_file {
	5	my ($filename, $content) = @_;
	6
	7	my $file = File::Spec->catfile(
	8	File::HomeDir->my_home,
	9	$filename
	10	);
	11
	12	if (-e $file) {
	13	plan skip_all => "File $filename should not be in test homedir";
	14	}
	15	umask 0022;
	16	open my $fh, '>', $file
	17	or plan skip_all => "error opening $filename: $!";
	18
	19	print {$fh} $content
	20	or plan skip_all => "error writing to $filename: $!";
	21
	22	close $fh;
	23	return $file;
	24	}
	25
	26	my $code_rcfile;
	27	my $env_rcfile;
	28	BEGIN {
	29	delete $ENV{ANSI_COLORS_DISABLED};
	30	use_ok ('Term::ANSIColor');
	31	use_ok ('File::HomeDir::Test');
	32	use_ok ('File::HomeDir');
	33	use_ok ('File::Spec');
	34
	35	$code_rcfile = create_rc_file('.coderc',
	36	'{ colored => 1, color => { hash => "red" }, hash_separator => " + "}'
	37	);
	38	$env_rcfile = create_rc_file('.envrc',
	39	'{ colored => 1, color => { hash => "green" }, hash_separator => " % "}'
	40	);
	41	$ENV{DATAPRINTERRC} = $env_rcfile;
	42
	43	# code and env rc files created
	44	# check that the rc file specified with rc_file overrides the one
	45	# specified with $ENV{DATAPRINTERRC}
	46	use_ok ('Data::Printer', rc_file => $code_rcfile);
	47
	48	unlink $code_rcfile or fail('error removing test file');
	49	unlink $env_rcfile or fail('error removing test file');
	50	};
	51
	52	my %hash = ( key => 'value' );
	53
	54	is( p(%hash), color('reset') . "{$/ "
	55	. colored('key', 'red')
	56	. ' + '
	57	. colored('"value"', 'bright_yellow')
	58	. "$/}"
	59	, 'custom configuration overrides standard rc file');
	60
	61	done_testing;

+1

-0

t/17-parallel.t less more

0	0	use strict;
1	1	use warnings;
2	2	BEGIN {
	3	delete $ENV{DATAPRINTERRC};
3	4	use File::HomeDir::Test; # avoid user's .dataprinter
4	5	use Term::ANSIColor;
5	6	};

+3

-2

t/18-class_method.t less more

2	2
3	3	BEGIN {
4	4	$ENV{ANSI_COLORS_DISABLED} = 1;
	5	delete $ENV{DATAPRINTERRC};
5	6	use File::HomeDir::Test; # avoid user's .dataprinter
6	7	};
7	8
8	9	package Foo;
9		sub bar { "I exist with " . scalar @_ . " argument" }
	10	sub bar { "I exist with " . scalar @_ . " arguments" }
10	11	sub _moo { }
11	12	sub new { bless {}, shift }
12	13

19	20
20	21	my $obj = Foo->new;
21	22
22		is p($obj), 'I exist with 1 argument', 'printing object via class_method "bar()"';
	23	is p($obj), 'I exist with 2 arguments', 'printing object via class_method "bar()"';

+1

-0

t/19-tied.t less more

2	2
3	3	BEGIN {
4	4	$ENV{ANSI_COLORS_DISABLED} = 1;
	5	delete $ENV{DATAPRINTERRC};
5	6	use File::HomeDir::Test; # avoid user's .dataprinter
6	7	};
7	8

+1

-0

t/20-handles.t less more

3	3	my ($var, $filename);
4	4	BEGIN {
5	5	$ENV{ANSI_COLORS_DISABLED} = 1;
	6	delete $ENV{DATAPRINTERRC};
6	7	use File::HomeDir::Test; # avoid user's .dataprinter
7	8	use File::HomeDir;
8	9	use File::Spec;

+1

-0

t/21-ddp.t less more

2	2
3	3	BEGIN {
4	4	$ENV{ANSI_COLORS_DISABLED} = 1;
	5	delete $ENV{DATAPRINTERRC};
5	6	use File::HomeDir::Test; # avoid user's .dataprinter
6	7
7	8	use Test::More;

+1

-0

t/22-class_method.t less more

2	2
3	3	BEGIN {
4	4	$ENV{ANSI_COLORS_DISABLED} = 1;
	5	delete $ENV{DATAPRINTERRC};
5	6	use File::HomeDir::Test; # avoid user's .dataprinter
6	7	};
7	8

+4

-3

t/23-caller_info.t less more

1	1	use warnings;
2	2
3	3	BEGIN {
	4	delete $ENV{DATAPRINTERRC};
4	5	use File::HomeDir::Test; # avoid user's .dataprinter
5	6	use Term::ANSIColor;
6	7	};

12	13	my $filepath = _get_path();
13	14
14	15	my $var = [ 1, { foo => 'bar' } ];
15		is p($var), "Printing in line 16 of $filepath:
	16	is p($var), "Printing in line " . __LINE__ . " of $filepath:
16	17	\\ [
17	18	[0] 1,
18	19	[1] {

26	27	3', 'output with custom caller message';
27	28
28	29	is p($var, colored => 1), color('reset')
29		. colored("Printing in line 29 of $filepath:", 'bright_cyan')
	30	. colored("Printing in line " . (__LINE__ - 1) . " of $filepath:", 'bright_cyan')
30	31	. "\n" . colored($var, 'bright_blue')
31	32	, 'colored caller message';
32	33
33	34	is p( $var, colored => 1, color => { caller_info => 'red' } ), color('reset')
34		. colored("Printing in line 34 of $filepath:", 'red')
	35	. colored("Printing in line " . (__LINE__ - 1) . " of $filepath:", 'red')
35	36	. "\n" . colored($var, 'bright_blue')
36	37	, 'custom colored caller message';
37	38

+1

-0

t/24-no_prototypes.t less more

3	3	use Test::More;
4	4	BEGIN {
5	5	$ENV{ANSI_COLORS_DISABLED} = 1;
	6	delete $ENV{DATAPRINTERRC};
6	7	use File::HomeDir::Test; # avoid user's .dataprinter
7	8	};
8	9

+1

-0

t/25-weak.t less more

3	3
4	4	BEGIN {
5	5	delete $ENV{ANSI_COLORS_DISABLED};
	6	delete $ENV{DATAPRINTERRC};
6	7	use File::HomeDir::Test; # avoid user's .dataprinter
7	8	use_ok ('Term::ANSIColor');
8	9	use_ok ('Scalar::Util', qw(weaken));

+1

-0

t/26-tainted.t less more

13	13	unless tainted($path);
14	14
15	15	delete $ENV{ANSI_COLORS_DISABLED};
	16	delete $ENV{DATAPRINTERRC};
16	17	use File::HomeDir::Test; # avoid user's .dataprinter
17	18	use_ok ('Term::ANSIColor');
18	19	use_ok ('Data::Printer', colored => 1);

+1

-0

t/27.2-pass_through.t less more

3	3	use Test::More;
4	4	BEGIN {
5	5	$ENV{ANSI_COLORS_DISABLED} = 1;
	6	delete $ENV{DATAPRINTERRC};
6	7	use File::HomeDir::Test; # avoid user's .dataprinter
7	8	};
8	9

+1

-0

t/27.3-pass_through-DDP.t less more

3	3	use Test::More;
4	4	BEGIN {
5	5	$ENV{ANSI_COLORS_DISABLED} = 1;
	6	delete $ENV{DATAPRINTERRC};
6	7	use File::HomeDir::Test; # avoid user's .dataprinter
7	8	};
8	9

+1

-0

t/27.4-pass_through-DDP.t less more

3	3	use Test::More;
4	4	BEGIN {
5	5	$ENV{ANSI_COLORS_DISABLED} = 1;
	6	delete $ENV{DATAPRINTERRC};
6	7	use File::HomeDir::Test; # avoid user's .dataprinter
7	8	};
8	9

+1

-0

t/28-void_return.t less more

3	3	use Test::More;
4	4	BEGIN {
5	5	$ENV{ANSI_COLORS_DISABLED} = 1;
	6	delete $ENV{DATAPRINTERRC};
6	7	use File::HomeDir::Test; # avoid user's .dataprinter
7	8	};
8	9

+1

-0

t/29-output.t less more

2	2	use Test::More;
3	3	BEGIN {
4	4	$ENV{ANSI_COLORS_DISABLED} = 1;
	5	delete $ENV{DATAPRINTERRC};
5	6	use File::HomeDir::Test; # avoid user's .dataprinter
6	7	};
7	8

+1

-0

t/30-escape_chars.t less more

11	11	###########################################
12	12	BEGIN {
13	13	delete $ENV{ANSI_COLORS_DISABLED};
	14	delete $ENV{DATAPRINTERRC};
14	15	use File::HomeDir::Test; # avoid user's .dataprinter
15	16	use_ok ('Term::ANSIColor');
16	17	use_ok (

+1

-0

t/30.2-print_escapes.t less more

3	3
4	4	BEGIN {
5	5	delete $ENV{ANSI_COLORS_DISABLED};
	6	delete $ENV{DATAPRINTERRC};
6	7	use File::HomeDir::Test; # avoid user's .dataprinter
7	8	use_ok ('Term::ANSIColor');
8	9	use_ok (

+1

-0

t/31-bad_parameters.t less more

3	3	use Test::More;
4	4	BEGIN {
5	5	$ENV{ANSI_COLORS_DISABLED} = 1;
	6	delete $ENV{DATAPRINTERRC};
6	7	use File::HomeDir::Test; # avoid user's .dataprinter
7	8	};
8	9

+1

-0

t/32-quote_keys.t less more

3	3
4	4	BEGIN {
5	5	delete $ENV{ANSI_COLORS_DISABLED};
	6	delete $ENV{DATAPRINTERRC};
6	7	use File::HomeDir::Test; # avoid user's .dataprinter
7	8	use_ok ('Term::ANSIColor');
8	9	use_ok (

+38

-0

t/33-end_separator.t less more

	0	use strict;
	1	use warnings;
	2
	3	use Test::More tests => 1;
	4	BEGIN {
	5	$ENV{ANSI_COLORS_DISABLED} = 1;
	6	delete $ENV{DATAPRINTERRC};
	7	use File::HomeDir::Test; # avoid user's .dataprinter
	8	};
	9
	10	use Data::Printer end_separator => 1, separator => '--';
	11
	12	my $structure = [
	13	1,
	14	2,
	15	{
	16	a => 1,
	17	b => 2,
	18	long_line => 3,
	19	},
	20	];
	21
	22	my $end_comma_output = '\ [
	23	[0] 1--
	24	[1] 2--
	25	[2] {
	26	a 1--
	27	b 2--
	28	long_line 3--
	29	}--
	30	]';
	31
	32	is(
	33	p($structure),
	34	$end_comma_output,
	35	"Got correct structure with end_separator => 1 and separator => '--'",
	36	);
	37

+59

-0

t/33-separator.t less more

	0	use strict;
	1	use warnings;
	2
	3	use Test::More tests => 3;
	4	BEGIN {
	5	$ENV{ANSI_COLORS_DISABLED} = 1;
	6	delete $ENV{DATAPRINTERRC};
	7	use File::HomeDir::Test; # avoid user's .dataprinter
	8	};
	9
	10	use Data::Printer separator => '--';
	11
	12	my $structure = [
	13	1,
	14	2,
	15	{
	16	a => 1,
	17	b => 2,
	18	long_line => 3,
	19	},
	20	];
	21
	22	my $end_comma_output = '\ [
	23	[0] 1--
	24	[1] 2--
	25	[2] {
	26	a 1--
	27	b 2--
	28	long_line 3
	29	}
	30	]';
	31
	32	is(
	33	p($structure),
	34	$end_comma_output,
	35	"Got correct structure with separator => '--'",
	36	);
	37
	38	$end_comma_output = '\ [
	39	[0] 1
	40	[1] 2
	41	[2] {
	42	a 1
	43	b 2
	44	long_line 3
	45	}
	46	]';
	47
	48	is(
	49	p($structure, separator => ''),
	50	$end_comma_output,
	51	"Got correct structure with no separator",
	52	);
	53
	54	is(
	55	p($structure, separator => '', end_separator => 1),
	56	$end_comma_output,
	57	"Got correct structure with no separator, even with end_separator set to 1",
	58	);

+20

-0

t/34-show_readonly.t less more

	0	######################################
	1	######## EXPERIMENTAL FEATURE ########
	2	######################################
	3	use strict;
	4	use warnings;
	5
	6	use Test::More tests => 1;
	7	BEGIN {
	8	$ENV{ANSI_COLORS_DISABLED} = 1;
	9	delete $ENV{DATAPRINTERRC};
	10	use File::HomeDir::Test; # avoid user's .dataprinter
	11	};
	12
	13	use Data::Printer show_readonly => 1;
	14
	15	my $foo = 42;
	16
	17	&Internals::SvREADONLY( \$foo, 1 );
	18
	19	is p($foo), '42 (read-only)', 'readonly variables (experimental)';

+23

-0

t/35-vstrings.t less more

	0	use strict;
	1	use warnings;
	2
	3	BEGIN {
	4	$ENV{ANSI_COLORS_DISABLED} = 1;
	5	delete $ENV{DATAPRINTERRC};
	6	use File::HomeDir::Test; # avoid user's .dataprinter
	7
	8	use Test::More;
	9	use Data::Printer;
	10
	11	}
	12
	13	my $scalar = v1.2.3;
	14	eval {
	15	is( p($scalar), 'v1.2.3', "VSTRINGs" );
	16	};
	17	if ($@) {
	18	fail( "VSTRINGs" );
	19	diag( $@ );
	20	}
	21
	22	done_testing();

+25

-0

t/36-valign.t less more

	0	# making sure data is properly aligned
	1	use strict;
	2	use warnings;
	3
	4	use Test::More tests => 1;
	5
	6	BEGIN {
	7	$ENV{ANSI_COLORS_DISABLED} = 1;
	8	delete $ENV{DATAPRINTERRC};
	9	use File::HomeDir::Test; # avoid user's .dataprinter
	10	use Data::Printer;
	11	};
	12
	13	my $var = { q[foo bar],2,3,4};
	14
	15	is(
	16	p($var),
	17	q{\ {
	18	3 4,
	19	'foo bar' 2
	20	}},
	21	'colored alignment'
	22	);
	23
	24

+27

-0

t/37-format.t less more

	0	use strict;
	1	use warnings;
	2
	3	BEGIN {
	4	$ENV{ANSI_COLORS_DISABLED} = 1;
	5	delete $ENV{DATAPRINTERRC};
	6	use File::HomeDir::Test; # avoid user's .dataprinter
	7
	8	use Test::More;
	9	use Data::Printer;
	10
	11	}
	12
	13	format TEST =
	14	.
	15
	16	my $form = *TEST{FORMAT};
	17	my $test_name = "FORMAT refs";
	18	eval {
	19	is( p($form), 'FORMAT', $test_name );
	20	};
	21	if ($@) {
	22	fail( $test_name );
	23	diag( $@ );
	24	}
	25
	26	done_testing();

+25

-0

t/38-lvalue.t less more

	0	use strict;
	1	use warnings;
	2
	3	BEGIN {
	4	$ENV{ANSI_COLORS_DISABLED} = 1;
	5	delete $ENV{DATAPRINTERRC};
	6	use File::HomeDir::Test; # avoid user's .dataprinter
	7
	8	use Test::More;
	9	use Data::Printer;
	10
	11	}
	12
	13	my $scalar = \substr( "abc", 2);
	14	my $test_name = "LVALUE refs";
	15	eval {
	16	is( p($scalar), '"c" (LVALUE)', $test_name );
	17	is( p($scalar, show_lvalue => 0), '"c"', 'disabled ' . $test_name );
	18	};
	19	if ($@) {
	20	fail( $test_name );
	21	diag( $@ );
	22	}
	23
	24	done_testing();

+13

-0

t/pod-coverage.t less more

	0	use strict;
	1	use warnings;
	2	use Test::More;
	3
	4	eval "use Test::Pod::Coverage 1.04";
	5	plan skip_all => 'Test::Pod::Coverage 1.04 required' if $@;
	6
	7	plan skip_all => 'set TEST_POD to enable this test (developer only!)'
	8	unless $ENV{TEST_POD};
	9
	10	all_pod_coverage_ok({
	11	also_private => [ qr/^(?:ARRAY\|CODE\|GLOB\|HASH\|REF\|VSTRING\|Regexp\|FORMAT\|LVALUE)$/, qr/^np$/ ],
	12	});