File Coverage

blib/lib/Data/Walk/Prune.pm

Criterion	Covered	Total	%
statement	47	57	82.4
branch	10	16	62.5
condition	3	6	50.0
subroutine	11	13	84.6
pod	1	1	100.0
total	72	93	77.4

package Data::Walk::Prune;
our $AUTHORITY = 'cpan:JANDREW';
use version; our $VERSION = version->declare('v0.26.16');

use Moose::Role;
requires
	'_process_the_data',
	'_dispatch_method',
	'_build_branch';
use	Types::Standard -types;
if( $ENV{ Smart_Comments } ){
	use Smart::Comments -ENV;
	### Smart-Comments turned on for Data-Walk-Prune ...
}

#########1 Package Variables  3#########4#########5#########6#########7#########8#########9

$| = 1;
my $prune_keys = {
    slice_ref => 'primary_ref',
    tree_ref => 'secondary_ref',
};

#########1 Dispatch Tables    3#########4#########5#########6#########7#########8#########9

my $prune_dispatch = {######<-----------------------------------------  ADD New types here
    HASH	=> \&_remove_hash_key,
    ARRAY 	=> \&_clear_array_position,
};

my $remember_dispatch = {######<--------------------------------------  ADD New types here
	HASH	=> \&_build_hash_cut,
    ARRAY	=> \&_build_array_cut,
};

my 	$prune_decision_dispatch = {######<-------------------------------  ADD New types here
		HASH	=> sub{ scalar( keys %{$_[1]->{primary_ref}} ) == 0 },
		ARRAY	=> sub{ scalar( @{$_[1]->{primary_ref}} ) == 0 },
		SCALAR	=> sub { return 0 },#No cut signal for SCALARS
		UNDEF	=> sub { return 0 },#No cut signal for UNDEF refs
		name	=> '- Prune - prune_decision_dispatch',
		###### Receives: the current $passed_ref
		###### Returns: pass | fail (Boolean style)
	};

#########1 Public Attributes  3#########4#########5#########6#########7#########8#########9

has 'prune_memory'	=>(
    is			=> 'ro',
    isa     	=> Bool,
    writer  	=> 'set_prune_memory',
	reader		=> 'get_prune_memory',
	predicate	=> 'has_prune_memory',
	clearer		=> 'clear_prune_memory',
);

#########1 Public Methods     3#########4#########5#########6#########7#########8#########9

sub prune_data{#Used to convert names
    ### <where> - Made it to prune_data
    ##### <where> - Passed input  : @_
    my  $self = $_[0];
    my  $passed_ref = ( @_ == 2 and is_HashRef( $_[1] ) ) ? $_[1] : { @_[1 .. $#_] } ;
    ##### <where> - Passed hashref: $passed_ref
    @$passed_ref{ 'before_method', 'after_method' } = # Hash slice
        ( '_prune_before_method', '_prune_after_method' );
	$self->_clear_pruned_positions;
    ##### <where> - Start recursive parsing with: $passed_ref
    $passed_ref = $self->_process_the_data( $passed_ref, $prune_keys );
    ### <where> - End recursive parsing with: $passed_ref
	##### <where> - self: $self
    return $passed_ref->{tree_ref};
}

#########1 Private Attributes 3#########4#########5#########6#########7#########8#########9

has '_prune_list' =>(
    is			=> 'ro',
    traits		=> ['Array'],
    isa			=> ArrayRef[ArrayRef[Item]],
    handles => {
        _add_prune_item		=> 'push',
        _next_prune_item	=> 'shift',
    },
    clearer		=> '_clear_prune_list',
    predicate	=> '_has_prune_list',
);

has '_pruned_positions' =>(
    is				=> 'ro',
    traits  		=> ['Array'],
    isa     		=> ArrayRef[HashRef],
    handles => {
        _remember_prune_item	=> 'push',
		number_of_cuts			=> 'count',
    },
    clearer		=> '_clear_pruned_positions',
    predicate	=> 'has_pruned_positions',
	reader		=> 'get_pruned_positions',
);

#########1 Private Methods    3#########4#########5#########6#########7#########8#########9

sub _prune_before_method{
    my ( $self, $passed_ref ) = @_;
    ### <where> - reached _prune_before_method
    #### <where> - received input: $passed_ref
    if( !exists $passed_ref->{secondary_ref} ){
        ### <where> - no matching tree_ref element so 'skip'ing the slice node ...
        $passed_ref->{skip} = 'YES';
    }
	#### <where> - skip state: $passed_ref->{skip}
    return $passed_ref;
}

sub _prune_after_method{
    my ( $self, $passed_ref ) = @_;
    ### <where> - reached _prune_after_method
    #### <where> - received input: $passed_ref
	### <where> - Slice state: $self->_has_prune_list
	### <where> - running the cut test ...
	if( $passed_ref->{skip} eq 'NO') {
		### <where> - The node was not skipped ...
		if( $self->_dispatch_method(
				$prune_decision_dispatch,
				$passed_ref->{primary_type},
				$passed_ref,				) ){
			### <where> - adding prune item: $passed_ref->{branch_ref}->[-1]
			$self->_add_prune_item( $passed_ref->{branch_ref}->[-1] );
			### <where> - go back up and prune ...
		}elsif( $self->_has_prune_list ){
			my  $tree_ref   =
				( exists $passed_ref->{secondary_ref} ) ?
					$passed_ref->{secondary_ref} : undef ;
			### <where> - tree_ref: $tree_ref
			while( my $item_ref = $self->_next_prune_item ){
				### <where> - item ref: $item_ref
				$tree_ref = $self->_prune_the_item( $item_ref, $tree_ref );
				#### <where> - tree ref: $tree_ref
				if(	$self->has_prune_memory and
					$self->get_prune_memory 	){
					### <where> - building the rememberance ref ...
					my $rememberance_ref = $self->_dispatch_method(
							$remember_dispatch,
							$item_ref->[0],
							$item_ref,
					);
					###  <where> - current branch ref is: $passed_ref->{branch_ref}
					$rememberance_ref = $self->_build_branch(
						$rememberance_ref,
						@{ $passed_ref->{branch_ref}},
					);
					###  <where> - rememberance ref: $rememberance_ref
					$self->_remember_prune_item( $rememberance_ref );
					#### <where> - prune memory: $self->get_pruned_positions
				}
			}
			$passed_ref->{secondary_ref} = $tree_ref;
			### <where> - finished pruning at this node - clear the prune list ...
			$self->_clear_prune_list;
		}
    }
    return $passed_ref;
}

sub _prune_the_item{
    my ( $self, $item_ref, $tree_ref ) = @_;
    ### <where> - Made it to _prune_the_item
    ### <where> - item ref  : $item_ref
    ##### <where> - tree ref  : $tree_ref
	$tree_ref = $self->_dispatch_method(
		$prune_dispatch,
		$item_ref->[0],
		$item_ref,
		$tree_ref,
	);
    ### <where> - cut completed succesfully
    return $tree_ref;
}

sub _remove_hash_key{
    my ( $self, $item_ref, $tree_ref ) = @_;
    ### <where> - Made it to _remove_hash_key
    ##### <where> - self      : $self
    ### <where> - item ref  : $item_ref
    ##### <where> - tree ref  : $tree_ref
    delete $tree_ref->{$item_ref->[1]};
    ##### <where> - tree ref  : $tree_ref
    return $tree_ref;
}

sub _clear_array_position{
    my ( $self, $item_ref, $tree_ref ) = @_;
    ### <where> - Made it to _clear_array_position
    ### <where> - item ref  : $item_ref
    ##### <where> - tree ref  : $tree_ref
    if( $self->change_array_size ){
        ### <where> - splicing out position: $item_ref->[2]
        splice( @$tree_ref, $item_ref->[2]);
    }else{
        ### <where> - Setting undef at position: $item_ref->[2]
        $tree_ref->[$item_ref->[2]] = undef;
    }
    ##### <where> - tree ref  : $tree_ref
    return $tree_ref;
}

sub _build_hash_cut{
    my ( $self, $item_ref ) = @_;
    ### <where> - Made it to _build_hash_cut
    ### <where> - item ref  : $item_ref
	return { $item_ref->[1] => {} };
}

sub _build_array_cut{
    my ( $self, $item_ref ) = @_;
    ### <where> - Made it to _build_array_cut
    ### <where> - item ref  : $item_ref
	my  $array_ref;
	$array_ref->[$item_ref->[2]] = [];
    ### <where> - item ref  : $item_ref
	return $item_ref;
}

#########1 Phinish Strong     3#########4#########5#########6#########7#########8#########9

no Moose::Role;

1;
# The preceding line will help the module return a true value

#########1 Main POD starts    3#########4#########5#########6#########7#########8#########9


__END__

=head1 NAME

Data::Walk::Prune - A way to say what should be removed

=head1 SYNOPSIS

	#!perl
	use Moose::Util qw( with_traits );
	use Data::Walk::Extracted;
	use Data::Walk::Prune;
	use Data::Walk::Print;

	my $edward_scissorhands = with_traits(
			'Data::Walk::Extracted',
			(
				'Data::Walk::Prune',
				'Data::Walk::Print',
			),
		)->new( change_array_size => 1, );#Default
	my  $firstref = {
			Helping => [
				'Somelevel',
				{
					MyKey => {
						MiddleKey => {
							LowerKey1 => 'low_value1',
							LowerKey2 => {
								BottomKey1 => 'bvalue1',
								BottomKey2 => 'bvalue2',
							},
						},
					},
				},
			],
		};
	my	$result = $edward_scissorhands->prune_data(
			tree_ref    => $firstref,
			slice_ref   => {
				Helping => [
					undef,
					{
						MyKey => {
							MiddleKey => {
								LowerKey1 => {},
							},
						},
					},
				],
			},
		);
	$edward_scissorhands->print_data( $result );

	######################################################################################
	#     Output of SYNOPSIS
	# 01 {
	# 02 	Helping => [
	# 03 		'Somelevel',
	# 04 		{
	# 05 			MyKey => {
	# 06 				MiddleKey => {
	# 07 					LowerKey2 => {
	# 08 						BottomKey1 => 'bvalue1',
	# 09 						BottomKey2 => 'bvalue2',
	# 10 					},
	# 12 				},
	# 13 			},
	# 14 		},
	# 15 	],
	# 16 },
	######################################################################################

=head1 DESCRIPTION

This L<Moose::Role|https://metacpan.org/module/Moose::Manual::Roles> implements the method
L<prune_data|/prune_data( %args )>.  It takes a $tree_ref and a $slice_ref and uses
L<Data::Walk::Extracted|https://metacpan.org/module/Data::Walk::Extracted>.  To remove
portions of the 'tree_ref' defined by an empty hash ref (no keys) or an empty array ref
(no positions) at all required points of the 'slice_ref'.  The 'slice_ref' must match the
tree ref up to each slice point.  If the slice points are on a branch of the slice_ref that
does not exist on the tree_ref then no cut takes place.

=head2 USE

This is a L<Moose::Role|https://metacpan.org/module/Moose::Manual::Roles> specifically
designed to be used with L<Data::Walk::Extracted
|https://metacpan.org/module/Data::Walk::Extracted#Extending-Data::Walk::Extracted>.
It can be combined traditionaly to the ~::Extracted class using L<Moose
|https://metacpan.org/module/Moose::Manual::Roles> methods or for information on how to join
this role to Data::Walk::Extracted at run time see L<Moose::Util
|https://metacpan.org/module/Moose::Util> or L<MooseX::ShortCut::BuildInstance
|https://metacpan.org/module/MooseX::ShortCut::BuildInstance> for more information.

=head1 Attributes

Data passed to -E<gt>new when creating an instance.  For modification of these attributes
see L<Methods|/Methods>.  The -E<gt>new function will either accept fat comma lists or a
complete hash ref that has the possible attributes as the top keys.  Additionally
some attributes that have all the following methods; get_$attribute, set_$attribute,
has_$attribute, and clear_$attribute, can be passed to L<prune_data
|/prune_data( %args )> and will be adjusted for just the run of that
method call.  These are called 'one shot' attributes.  The class and each role (where
applicable) in this package have a list of L<supported one shot attributes
|/Supported one shot attributes>.

=head2 prune_memory

=over

B<Definition:> When running a prune operation any branch called on the pruner
that does not exist in the tree will not be used.  This attribute turns on tracking
of the actual cuts made and stores them for review after the method is complete.
This is a way to know if the cut was actually implemented.

B<Default> undefined

B<Range> 1 = remember the cuts | 0 = don't remember

=back

=head2 (see also)

L<Data::Walk::Extracted|https://metacpan.org/module/Data::Walk::Extracted#Attributes>
- Attributes

=head1 Methods

=head2 prune_data( %args )

=over

B<Definition:> This is a method used to remove targeted parts of a data reference.

B<Accepts:> a hash ref with the keys 'slice_ref' and 'tree_ref' (both required).
The slice ref can contain more than one 'slice' location in the data reference.

=over

B<tree_ref> This is the primary data ref that will be manipulated and returned changed.

B<slice_ref> This is a data ref that will be used to prune the 'tree_ref'.  In general
the slice_ref should match the tree_ref for positions that should remain unchanged.
Where the tree_ref should be trimmed insert either an empty array ref or an empty hash
ref.  If this position represents a value in a hash key => value pair then the hash
key is deleted.  If this position represents a value in an array then the position is
deleted/cleared depending on the attribute L<change_array_size
|https://metacpan.org/module/Data::Walk::Extracted#change_array_size> in
Data::Walk::Extracted.  If the slice ref diverges from the tree ref then no action is
taken past the divergence, even if there is a mandated slice. (no auto vivication occurs!)

B<[attribute name]> - attribute names are accepted with temporary attribute settings.
These settings are temporarily set for a single "prune_data" call and then the original
attribute values are restored.  For this to work the the attribute must meet the
L<necessary criteria|/Attributes>.

=back

B<Example>

	$pruned_tree_ref = $self->prune_data(
		tree_ref => $tree_data,
		slice_ref => $slice_data,
		prune_memory => 0,
	);

B<Returns:> The $tree_ref with any changes

=back

=head2 set_prune_memory( $Bool )

=over

B<Definition:> This will change the setting of the L<prune_memory|/prune_memory>
attribute.

B<Accepts:> 1 = remember | 0 = no memory

B<Returns:> nothing

=back

=head2 get_prune_memory

=over

B<Definition:> This will return the current setting of the L<prune_memory|/prune_memory>
attribute.

B<Accepts:> nothing

B<Returns:> A $Bool value for the current state

=back

=head2 has_prune_memory

=over

B<Definition:> This will indicate if the L<prune_memory|/prune_memory> attribute is set

B<Accepts:> nothing

B<Returns:> A $Bool value 1 = defined, 0 = not defined

=back

=head2 clear_prune_memory

=over

B<Definition:> This will clear the L<prune_memory|/prune_memory> attribute value
(Not the actual prune memory)

B<Accepts:> nothing

B<Returns:> A $Bool value 1 = defined, 0 = not defined

=back

=head2 has_pruned_positions

=over

B<Definition:> This answers if any pruned positions were stored

B<Accepts:> nothing

B<Returns:> A $Bool value 1 = pruned cuts are stored, 0 = no stored cuts

=back

=head2 get_pruned_positions

=over

B<Definition:> This returns an array ref of stored cuts

B<Accepts:> nothing

B<Returns:> an ArrayRef - although the cuts were defined in one data ref
this will return one data ref per cut.  Each ref will go to the root of the
original data ref.

=back

=head2 number_of_cuts

=over

B<Definition:> This returns the number of cuts actually made

B<Accepts:> nothing

B<Returns:> an integer

=back

=head1 Caveat utilitor

=head2 deep cloning

Because this uses Data::Walk::Extracted the final $tree_ref is deep cloned where
the $slice_ref passed through.

=head2 Supported Node types

=over

=item ARRAY

=item HASH

=item SCALAR

=item UNDEF

=back

=head2 Supported one shot attributes

L<explanation|/Attributes>

=over

=item prune_memory

=back

=head1 GLOBAL VARIABLES

=over

B<$ENV{Smart_Comments}>

The module uses L<Smart::Comments|https://metacpan.org/module/Smart::Comments> if the '-ENV'
option is set.  The 'use' is encapsulated in an if block triggered by an environmental
variable to comfort non-believers.  Setting the variable $ENV{Smart_Comments} in a BEGIN
block will load and turn on smart comment reporting.  There are three levels of 'Smartness'
available in this module '###',  '####', and '#####'.

=back

=head1 SUPPORT

=over

L<github Data-Walk-Extracted/issues|https://github.com/jandrew/Data-Walk-Extracted/issues>

=back

=head1 TODO

=over

B<1.> Add L<Log::Shiras|https://metacpan.org/module/Log::Shiras> debugging in exchange for
L<Smart::Comments|https://metacpan.org/module/Smart::Comments>

B<2.> Support pruning through Objects / Instances nodes

B<3.> Support pruning through CodeRef nodes

B<4.> Support pruning through REF nodes

=back

=head1 AUTHOR

=over

=item Jed Lund

=item [e-mail]

=back

=head1 COPYRIGHT

This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.

The full text of the license can be found in the
LICENSE file included with this module.

This software is copyrighted (c) 2013 by Jed Lund.

=head1 Dependencies

L<version|https://metacpan.org/module/version>

L<Moose::Role|https://metacpan.org/module/Moose::Role>

=over

B<requires>

=over

=item _process_the_data

=item _dispatch_method

=item _build_branch

=back

=back

L<MooseX::Types::Moose|https://metacpan.org/module/MooseX::Types::Moose>

L<Data::Walk::Extracted|https://metacpan.org/module/Data::Walk::Extracted>

L<Data::Walk::Extracted::Dispatch|https://metacpan.org/module/Data::Walk::Extracted::Dispatch>

=head1 SEE ALSO

=over

L<Smart::Comments|https://metacpan.org/module/Smart::Comments> - is used if the -ENV option is set

L<Data::Walk|https://metacpan.org/module/Data::Walk>

L<Data::Walker|https://metacpan.org/module/Data::Walker>

L<Data::ModeMerge|https://metacpan.org/module/Data::ModeMerge>

L<Data::Walk::Print|https://metacpan.org/module/Data::Walk::Print> - available Data::Walk::Extracted Role

L<Data::Walk::Graft|https://metacpan.org/module/Data::Walk::Graft> - available Data::Walk::Extracted Role

L<Data::Walk::Clone|https://metacpan.org/module/Data::Walk::Clone> - available Data::Walk::Extracted Role

=back

=cut

#########1 Main POD ends      3#########4#########5#########6#########7#########8#########9