File Coverage

blib/lib/Data/Pipeline/Action/Rename.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


line stmt bran cond sub pod time code
1             package Data::Pipeline::Action::Rename;
2              
3 2     2   35144 use Moose;
  0            
  0            
4             with 'Data::Pipeline::Action';
5              
6             has renames => (
7             is => 'ro',
8             isa => 'ArrayRef',
9             lazy => 1,
10             default => sub { [ ] },
11             predicate => 'has_renames',
12             );
13              
14             has copies => (
15             is => 'ro',
16             isa => 'ArrayRef',
17             lazy => 1,
18             default => sub { [ ] },
19             predicate => 'has_copies',
20             );
21              
22             sub map_item {
23             my($self, $item) = @_;
24              
25             return $item unless $self -> has_renames || $self -> has_copies;
26              
27             my $i;
28             my $num = scalar(@{$self -> copies});
29             for($i = 0; $i < $num; $i+=2) {
30             $self -> _copy( $self -> copies -> [$i], $self -> copies -> [$i+1], $item );
31             }
32              
33             $num = scalar(@{$self -> renames});
34             for($i = 0; $i < $num; $i+=2) {
35             $self -> _rename( $self -> renames -> [$i], $self -> renames -> [$i+1], $item );
36             }
37              
38             return $item;
39             }
40              
41             sub _copy {
42             my($self, $from, $to, $hash) = @_;
43              
44             my($to_hash, $to_e) = $self -> _decompose( $to, $hash );
45             my($from_hash, $from_e) = $self -> _decompose( $from, $hash );
46              
47             $to_hash -> {$to_e} = $from_hash -> {$from_e} if $to_hash && $from_hash;
48             }
49              
50             sub _rename {
51             my($self, $from, $to, $hash) = @_;
52              
53             my($to_hash, $to_e) = $self -> _decompose( $to, $hash );
54             my($from_hash, $from_e) = $self -> _decompose( $from, $hash );
55              
56             if($to_hash && $from_hash) {
57             $to_hash -> {$to_e} = $from_hash -> {$from_e};
58             delete $from_hash -> {$from_e};
59             }
60             }
61              
62             sub _decompose {
63             my($self, $path, $hash) = @_;
64              
65             my($root, $rest) = split(/\./, $path, 2);
66              
67             if( !defined( $rest ) || $rest == '' ) {
68             return($hash, $root);
69             }
70              
71             if( !exists( $hash -> {$root} ) ) {
72             $hash -> {$root} = { };
73             return $self -> _decompose( $rest, $hash -> {$root} );
74             }
75              
76             if( is_HashRef( $hash -> {$root} ) ) {
77             return $self -> _decompose( $rest, $hash -> {$root} );
78             }
79              
80             return( undef, undef );
81             }
82              
83             1;
84              
85             __END__
86