Data-TreeDumper-Utils

 view release on metacpan or  search on metacpan

lib/Data/TreeDumper/Utils.pm  view on Meta::CPAN

package Data::TreeDumper::Utils ;

use strict;
use warnings ;
use Carp qw(carp croak confess) ;

BEGIN 
{
use Sub::Exporter -setup => 
	{
	exports => [ qw(first_nsort_last_filter keys_order no_sort_filter hash_keys_sorter filter_class_keys get_caller_stack) ],
	groups  => 
		{
		all  => [ qw(first_nsort_last_filter keys_order no_sort_filter hash_keys_sorter filter_class_keys get_caller_stack) ],
		}
	};
	
use vars qw ($VERSION);
$VERSION     = '0.04';
}

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

use Sort::Naturally;
use Check::ISA ;

use Readonly ;
Readonly my $EMPTY_STRING => q{} ;

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

=head1 NAME

Data::TreeDumper::Utils - A selection of utilities to use with Data::TreeDumper

=head1 SYNOPSIS

  use Data::TreeDumper::Utils qw(:all) ;
  
  DumpTree
    (
    $requirements_structure,
    'Requirements structure:',
    FILTER => \&first_nsort_last_filter,
    FILTER_ARGUMENT => {...},
    ) ;
  
  DumpTree #shorthand for the call to first_nsort_last_filter
    (
    $requirements_structure,
    'Requirements structure:',
    keys_order(...),
    ) ;
  
  DumpTree
    (
    $ixhash_hash_ref,
    'An IxHash hash',
    FILTER => \&no_sort_filter,
    ) ;
  
  DumpTree
    (
    $structure,
    'sorted',
    FILTER => 
      CreateChainingFilter
      (
      \&remove_keys_starting_with_A,
      \&hash_keys_sorter
      ),
    ) ;
  
  DumpTree
    (
    $structure,
    'filter_class_keys example:',
    FILTER => filter_class_keys(T1 => ['A'], 'HASH' => [qr/./],),
    ) ;
  
  DumpTree(get_caller_stack(), 'Stack dump:') ;

=head1 DESCRIPTION

lib/Data/TreeDumper/Utils.pm  view on Meta::CPAN

		{
		AXC => 1,
		ZZZ =>  1,
		A => 1,
		B2 => 1,
		B => 1,
		REMOVE => 1,
		EVOMER => 1,
		C => 1,
		D => 1,
		E => 1,
		},
		'structure:',

		FILTER => \&first_nsort_last_filter,
		FILTER_ARGUMENT =>
			{
			REMOVE => ['REMOVE', qr/EVO/],
			AT_START_FIXED => ['ZZZ', qr/B/],
			AT_START => ['ZZZ'], # already taken by AT_START_FIXED
			AT_END => ['C', 'A'],
			AT_END_FIXED => [qr/AX/],
			},
		) ;

generates:
  structure:
  |- ZZZ = 1  [S1]
  |- B = 1  [S2]
  |- B2 = 1  [S3]
  |- D = 1  [S4]
  |- E = 1  [S5]
  |- A = 1  [S6]
  |- C = 1  [S7]
  `- AXC = 1  [S8]

B<Arguments>

The arguments are passed through the call to L<Data::TreeDumper> in the B<FILTER_ARGUMENT>
option. B<FILTER_ARGUMENT> points to a hash reference with the possible following keys. All the keys are optional.

Each key is an array reference containing a list of regexes or strings. Keys matching the regexes or string will be 
sorted in the category in which the matching regex or string was declared. The categories are, in priority order:

=over 2 

=item * REMOVE - the keys that should not be rendered

=item * AT_START_FIXED - the keys that should be rendered at the start, will not be sorted

=item * AT_START - the keys that should be rendered next, will be sorted

=item * AT_END - the keys that should be rendered last, will be sorted

=item * AT_END_FIXED - the keys that should be rendered at the end, will not be sorted

=back

Any key that doesn't match a regex or a string will automatically be in this category.

Keys are sorted by L<Sort::Naturally>.

B<Returns> - the keys sorted according to the defined categories.

B<See> - I<Filters> in L<Data::TreeDumper>.

=cut

my ($structure, undef, undef, $nodes_to_display, undef, $filter_argument) = @_ ;

if('HASH' eq ref $structure || obj($structure, 'HASH'))
	{
	my $keys = defined $nodes_to_display ? $nodes_to_display : [keys %{$structure}] ;
	return
		(
		'HASH',
		undef,
		first_nsort_last
			(
			%{$filter_argument}, 
			KEYS => $keys,
			)  
		) ;
	}
	
return(Data::TreeDumper::DefaultNodesToDisplay($structure)) ;
}

sub keys_order
{

=head2 keys_order(@filtering_categories)ma

See L<first_nsort_last_filter()>

  DumpTree($structure, 'title:', keys_order(REMOVE => [], AT_START => [], ...)) ;
  
=cut

return
	FILTER => \&first_nsort_last_filter,
	FILTER_ARGUMENT => { @_ } ;
}

sub first_nsort_last
{

=head2 [p] first_nsort_last(AT_START => [regex, string, ...], AT_END => [regex, string, ...], ..., KEYS => [keys to sort] )

Implementation of I<first_nsort_last_filter> key sorting.

B<Arguments>

=over 2 

=item * REMOVE - a reference to an array containing regexes or strings, keys matching will be removed from display

=item * AT_START_FIXED - a reference to an array containing regexes or strings, won't be sorted, multiple matches to regex are sorted

=item * AT_START - a reference to an array containing regexes or strings, will be sorted

lib/Data/TreeDumper/Utils.pm  view on Meta::CPAN

			last ;
			}
		}
	else
		{
		if ($key eq $regexp->{regexp})
			{
			push @{ $regexp->{matches} }, $key ;
			$match++ ;
			last ;
			}
		}
	}
	
return $match ;
}

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

sub  no_sort_filter
{

=head2 no_sort_filter()

A hash filter to replace the default L<Data::TreeDumper> filter which sorts hash keys. This is useful if you have a 
hash based on L<Tie::IxHash>, or equivalent, that keep the key order internally.

  print DumpTree
    (
    $ixhash_hash_ref,
    'An IxHash hash',
    FILTER => \&no_sort_filter,
    ) ;

B<Arguments> - none

B<Returns> - hash keys unsorted

=cut

my ($structure, undef, undef, $keys) = @_ ;

if('HASH' eq ref $structure|| obj($_, 'HASH'))
	{
	return('HASH', undef, @{$keys}) if(defined $keys) ;
	return('HASH', undef, keys %{$structure}) ;
	}
else
	{
	return Data::TreeDumper::DefaultNodesToDisplay(@_) ;
	}
}

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

sub hash_keys_sorter
{

=head2 hash_keys_sorter()

When no filter is given to L<Data::TreeDumper>, it will sort hash keys using L<Sort::Naturally>. If you create your
own filter or have chaining filters, you will have to do the sorting yourself (if you want keys to be sorted) or you can
use this filter to do the sorting.

  # Remove keys starting with A, return in keys in the order the hash returns them
  DumpTree($s, 'not sorted', FILTER => \&remove_keys_starting_with_A,) ;
  
  # Remove keys starting with A, sort keys
  DumpTree
    (
    $s,
    'sorted',
    FILTER => CreateChainingFilter(\&remove_keys_starting_with_A, \&hash_keys_sorter),
    ) ;
	

B<Arguments> - none

B<Returns> - the sorted keys

=cut

my ($structure, undef, undef, $nodes_to_display) = @_ ;

if('HASH' eq ref $structure || obj($structure, 'HASH'))
	{
	my $keys = defined $nodes_to_display ? $nodes_to_display : [keys %{$structure}] ;
	
	my %keys ;
	
	for my $key (@{$keys})
		{
		if('ARRAY' eq ref $key)
			{
			$keys{$key->[0]} = $key ;
			}
		else
			{
			$keys{$key} = $key ;
			}
		}
		
	return('HASH', undef, map{$keys{$_}} nsort keys %keys) ;
	}

return(Data::TreeDumper::DefaultNodesToDisplay($structure)) ;
}

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

sub filter_class_keys
{

=head2 filter_class_keys($class => \@keys,  $class => \@keys,,  ...)

A filter that allows you select which keys to render depending on the type of the structure elements. This lets you
filter out data you don't want to render.

Note: this filter does not sort the keys!

  package Potatoe ;