File Coverage

blib/lib/Data/TreeDumper/OO.pm

Criterion	Covered	Total	%
statement	23	84	27.3
branch	1	6	16.6
condition			n/a
subroutine	9	34	26.4
pod	0	29	0.0
total	33	153	21.5

package Data::TreeDumper::OO;
$Data::TreeDumper::OO::VERSION = '0.10';
use 5.006;
use strict;
use warnings;
use Carp;

require Exporter;

our @ISA         = qw(Exporter);
our %EXPORT_TAGS = ( 'all' => [ qw() ] );
our @EXPORT_OK   = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT      = qw();

use Data::TreeDumper 0.24 ;

#----------------------------------------------------------------------------------------------------

sub new
{
my($class, %setup_data) = @_;

return bless({%Data::TreeDumper::setup, %setup_data}, $class);
}

#------------------------------------------------------------------------------------------
sub Dump
{
my($self, $structure_to_dump, $title, %overrides) = @_;

$title = defined $title ? $title : '' ;

return
	(
	Data::TreeDumper::TreeDumper
			(
			  $structure_to_dump
			, {
			    TITLE                  => $title
			  , FILTER                 => $self->{FILTER}
			  , LEVEL_FILTERS          => $self->{LEVEL_FILTERS}
			  , START_LEVEL            => $self->{START_LEVEL}
			  , USE_ASCII              => $self->{USE_ASCII}
			  , MAX_DEPTH              => $self->{MAX_DEPTH}
			  , INDENTATION            => $self->{INDENTATION}
			  , VIRTUAL_WIDTH          => $self->{VIRTUAL_WIDTH}
			  , DISPLAY_OBJECT_TYPE    => $self->{DISPLAY_OBJECT_TYPE}
			  , DISPLAY_INHERITANCE    => $self->{DISPLAY_INHERITANCE}
			  , DISPLAY_AUTOLOAD       => $self->{DISPLAY_AUTOLOAD}
			  , DISPLAY_TIE            => $self->{DISPLAY_TIE}
			  , DISPLAY_ADDRESS        => $self->{DISPLAY_ADDRESS}
			  , DISPLAY_ROOT_ADDRESS   => $self->{DISPLAY_ROOT_ADDRESS}
			  , DISPLAY_PERL_ADDRESS   => $self->{DISPLAY_PERL_ADDRESS}
			  , DISPLAY_PERL_SIZE      => $self->{DISPLAY_PERL_SIZE}
			  , NUMBER_LEVELS          => $self->{NUMBER_LEVELS}
			  , COLOR_LEVELS           => $self->{COLOR_LEVELS}
			  , NO_OUTPUT              => $self->{NO_OUTPUT}
			  , RENDERER               => $self->{RENDERER}
			  , GLYPHS                 => $self->{GLYPHS}
			  , NO_NO_ELEMENTS         => $self->{NO_NO_ELEMENTS}
			  , QUOTE_HASH_KEYS        => $self->{QUOTE_HASH_KEYS}
			  , QUOTE_VALUES           => $self->{QUOTE_VALUES}
			  , REPLACEMENT_LIST       => $self->{REPLACEMENT_LIST}
			  , DISPLAY_PATH           => $self->{DISPLAY_PATH}

			  , __DATA_PATH            => $self->{__DATA_PATH}
			  , __TYPE_SEPARATORS      => $self->{__TYPE_SEPARATORS}

			  , %overrides
			  }
			)
	) ;
}

#------------------------------------------------------------------------------------------

sub DumpMany
{
my $self = shift ;

my @trees           = grep {'ARRAY' eq ref $_} @_ ;
my %global_override = grep {'ARRAY' ne ref $_} @_ ;

my $dump = '' ;

for my $tree (@trees)
	{
	my ($structure_to_dump, $title, %override) = @{$tree} ;

	$dump .= $self->Dump($structure_to_dump, $title, %global_override, %override) ;
	}

return($dump) ;
}

#------------------------------------------------------------------------------------------
sub SetFilter
{
my($self, $filter) = @_;

croak "Filter must be a code reference!" unless ('CODE' eq ref $filter) ;

$self->{FILTER} = $filter ;
}

#------------------------------------------------------------------------------------------
sub SetLevelFilters
{
my($self, $filters) = @_;

croak "Filter must be an array reference!" unless ('ARRAY' eq ref $filters) ;

$self->{LEVEL_FILTERS} = $filters ;
}

#------------------------------------------------------------------------------------------
sub SetStartLevel
{
my($self, $start_level) = @_ ;
$self->{START_LEVEL} = $start_level;
}

#------------------------------------------------------------------------------------------
sub NoOutput
{
my($self, $no_output) = @_ ;
$self->{NO_OUTPUT} = $no_output ;
}

#------------------------------------------------------------------------------------------
sub UseAscii
{
my($self, $use_ascii) = @_ ;
$self->{USE_ASCII} = $use_ascii ;
}

#------------------------------------------------------------------------------------------
sub UseAnsi
{
my($self, $use_ansi) = @_ ;
$self->{USE_ASCII} = (!$use_ansi) ;
}

#------------------------------------------------------------------------------------------
sub SetMaxDepth
{
my($self, $max_depth) = @_ ;
$self->{MAX_DEPTH} = $max_depth ;
}

#------------------------------------------------------------------------------------------
sub SetIndentation
{
my($self, $indentation) = @_ ;
$self->{INDENTATION} = $indentation ;
}

#------------------------------------------------------------------------------------------
sub ReplacementList
{
my($self, $replacement) = @_ ;
$self->{REPLACEMENT_LIST} = $replacement ;
}

#------------------------------------------------------------------------------------------
sub QuoteHashKeys
{
my($self, $quote) = @_ ;
$self->{QUOTE_HASH_KEYS} = $quote ;
}

#------------------------------------------------------------------------------------------
sub QuoteValues
{
my($self, $quote) = @_ ;
$self->{QUOTE_VALUES} = $quote ;
}

#------------------------------------------------------------------------------------------
sub DisplayNoElements
{
my($self, $no_no_elements) = @_ ;
$self->{NO_NO_ELEMENTS} = ! $no_no_elements;
}

#------------------------------------------------------------------------------------------
sub SetVirtualWidth
{
my($self, $width) = @_ ;
$self->{VIRTUAL_WIDTH} = $width ;
}

#------------------------------------------------------------------------------------------
sub DisplayRootAddress
{
my($self, $display_root_address) = @_ ;
$self->{DISPLAY_ROOT_ADDRESS} = $display_root_address ;
}

#------------------------------------------------------------------------------------------
sub DisplayAddress
{
my($self, $display_address) = @_ ;
$self->{DISPLAY_ADDRESS} = $display_address ;
}

#------------------------------------------------------------------------------------------
sub DisplayPath
{
my($self, $display_path) = @_ ;
$self->{DISPLAY_PATH} = $display_path;
}

#------------------------------------------------------------------------------------------
sub DisplayObjectType
{
my($self, $display_object_type) = @_ ;
$self->{DISPLAY_OBJECT_TYPE} = $display_object_type ;
}

#------------------------------------------------------------------------------------------
sub DisplayInheritance
{
my($self, $display_inheritance) = @_ ;
$self->{DISPLAY_INHERITANCE} = $display_inheritance ;
}

#------------------------------------------------------------------------------------------
sub DisplayAutoload
{
my($self, $display_autoload) = @_ ;
$self->{DISPLAY_AUTOLOAD} = $display_autoload ;
}

#------------------------------------------------------------------------------------------
sub Displaytie
{
my($self, $display_tie) = @_ ;
$self->{DISPLAY_TIE} = $display_tie ;
}

#------------------------------------------------------------------------------------------
sub DisplayPerlSize
{
my($self, $display_perl_size) = @_ ;
$self->{DISPLAY_PERL_SIZE} = $display_perl_size;
}

#------------------------------------------------------------------------------------------
sub DisplayPerlAddress
{
my($self, $display_perl_address) = @_ ;
$self->{DISPLAY_PERL_ADDRESS} = $display_perl_address ;
}

#------------------------------------------------------------------------------------------
sub NumberLevels
{
my($self, $number_levels) = @_ ;
$self->{NUMBER_LEVELS} = $number_levels;
}

#------------------------------------------------------------------------------------------
sub ColorLevels
{
my($self, $color_levels) = @_ ;
$self->{COLOR_LEVELS} = $color_levels ;
}

#------------------------------------------------------------------------------------------
sub SetGlyphs
{
my($self, $glyphs) = @_ ;
$self->{GLYPHS} = $glyphs ;
}

#------------------------------------------------------------------------------------------
sub SetRenderer
{
my($self, $renderer) = @_ ;
$self->{RENDERER} = $renderer ;
}

#------------------------------------------------------------------------------------------

1 ;

__END__