| Subject: | More customization for class output |
I propose 2 new configuration parameters for more concise class output:
'methods' and 'parents', that allow to leave off at least 4 rows of
output (when you're debugging your own structures, they're often
unnecessary). Proposed patch (with tests) is attached. By default, their
values are to retain current output.
| Subject: | data-printer.class.diff |
diff --git a/lib/Data/Printer.pm b/lib/Data/Printer.pm
index 1ca8784..35c8233 100644
--- a/lib/Data/Printer.pm
+++ b/lib/Data/Printer.pm
@@ -55,6 +55,8 @@ my $properties = {
internals => 1,
export => 1,
sort_methods => 1,
+ parents => 1,
+ methods => 1,
},
'filters' => {},
};
@@ -489,7 +491,9 @@ sub _class {
my $meta = Class::MOP::Class->initialize($ref);
- if ( my @superclasses = $meta->superclasses ) {
+ if ( $p->{class}{parents} &&
+ (my @superclasses = $meta->superclasses )
+ ) {
$string .= (' ' x $p->{_current_indent})
. 'Parents '
. join(', ', map { colored($_, $p->{color}->{'class'}) }
@@ -503,7 +507,9 @@ sub _class {
) . $BREAK;
}
- $string .= _show_methods($ref, $meta, $p);
+ if ( $p->{class}{methods} ) {
+ $string .= _show_methods($ref, $meta, $p);
+ }
if ( $p->{'class'}->{'internals'} ) {
my $realtype = Scalar::Util::reftype $item;
@@ -745,10 +751,15 @@ customization options available, as shown below (with default values):
# and able to dump themselves.
class => {
+ parents => 1, # show information about base class(es)
+
internals => 1, # show internal data structures of classes
+ methods => 1, # show class methods
+
inherited => 'none', # show inherited methods,
# can also be 'all', 'private', or 'public'.
+ # not applicable, if 'methods' is set to 0
expand => 1, # how deep to traverse the object (in case
# it contains other objects). Defaults to
diff --git a/t/05-obj.t b/t/05-obj.t
index 5db4aea..a2851c1 100644
--- a/t/05-obj.t
+++ b/t/05-obj.t
@@ -59,6 +59,24 @@ is( p($obj, class => { inherited => 0 }), 'Foo {
}', 'testing objects (inherited => 0)' );
+is( p($obj, class => { parents => 0 }), 'Foo {
+ public methods (4) : baz, borg, foo, new
+ private methods (1) : _other
+ internals: {
+ test 42
+ }
+}', 'testing objects (parents => 0)' );
+
+
+is( p($obj, class => { methods => 0 }), 'Foo {
+ Parents Bar
+ Linear @ISA Foo, Bar
+ internals: {
+ test 42
+ }
+}', 'testing objects (methods => 0)' );
+
+
is( p($obj, class => { inherited => 'all' }), 'Foo {
Parents Bar
Linear @ISA Foo, Bar