File Coverage

blib/lib/TableDataRole/Munge/MungeColumns.pm
Criterion Covered Total %
statement 14 78 17.9
branch 0 28 0.0
condition 0 5 0.0
subroutine 5 14 35.7
pod 1 8 12.5
total 20 133 15.0


line stmt bran cond sub pod time code
1             package TableDataRole::Munge::MungeColumns;
2              
3 2     2   474193 use 5.010001;
  2         7  
4 2     2   12 use strict;
  2         4  
  2         52  
5 2     2   12 use warnings;
  2         3  
  2         103  
6 2     2   3695 use Log::ger;
  2         125  
  2         12  
7              
8 2     2   884 use Role::Tiny;
  2         4525  
  2         11  
9              
10             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
11             our $DATE = '2024-05-14'; # DATE
12             our $DIST = 'TableDataRoles-Standard'; # DIST
13             our $VERSION = '0.025'; # VERSION
14              
15             with 'TableDataRole::Spec::Basic';
16              
17             sub new {
18 0     0 1   require Module::Load::Util;
19              
20 0           my ($class, %args) = @_;
21              
22             my $tabledata = delete $args{tabledata}
23 0 0         or die "Please supply 'tabledata' argument";
24             my $munge_column_names = delete $args{munge_column_names}
25 0 0         or die "Please supply 'munge_column_names' argument";
26 0           my $munge = delete $args{munge};
27 0           my $munge_hashref = delete $args{munge_hashref};
28 0 0 0       ($munge || $munge_hashref)
29             or die "Please supply 'munge' or 'munge_hashref' argument";
30 0           for ($munge_column_names, $munge, $munge_hashref) {
31 0 0         next unless defined;
32 0 0         unless (ref $_ eq 'CODE') {
33 0           my $code = "package main; sub { no strict; no warnings; $_ }";
34 0           log_trace "Eval-ing: $code";
35 0           $_ = eval $code; ## no critic: BuiltinFunctions::ProhibitStringyEval
36 0 0         die if $@;
37             }
38             }
39 0   0       my $load = delete($args{load}) // 1;
40 0 0         die "Unknown argument(s): ". join(", ", sort keys %args)
41             if keys %args;
42              
43 0           $tabledata = Module::Load::Util::instantiate_class_with_optional_args({load=>$load, ns_prefix=>"TableData"}, $tabledata);
44 0           my $column_names = $munge_column_names->(scalar $tabledata->get_column_names);
45              
46             bless {
47             tabledata => $tabledata,
48             column_names => $column_names,
49 0           column_idxs => {map {$column_names->[$_] => $_} 0..$#{$column_names}},
  0            
  0            
50             munge_column_names => $munge_column_names,
51             munge => $munge,
52             munge_hashref => $munge_hashref,
53             pos => 0, # iterator
54             # buffer => undef,
55             }, $class;
56             }
57              
58             sub get_column_count {
59 0     0 0   my $self = shift;
60              
61 0           scalar @{ $self->{column_names} };
  0            
62             }
63              
64             sub get_column_names {
65 0     0 0   my $self = shift;
66 0 0         wantarray ? @{ $self->{column_names} } : $self->{column_names};
  0            
67             }
68              
69             sub _fill_buffer {
70 0     0     my $self = shift;
71 0 0         return if $self->{buffer};
72 0           while (1) {
73 0 0         return unless $self->{tabledata}->has_next_item;
74 0 0         if ($self->{munge}) {
75 0           my $row = $self->{tabledata}->get_next_row_arrayref;
76 0           my $munged_row = $self->{munge}->($row);
77 0           $self->{buffer} = $munged_row;
78 0           return;
79             } else {
80 0           my $row = $self->{tabledata}->get_next_item;
81 0           my $row_hashref = { map {$self->{column_names}[$_] => $row->[$_]} 0..$#{$row} };
  0            
  0            
82 0           my $munged_row_hashref = $self->{munge_hashref}->($row_hashref);
83 0           my $munged_row = [];
84 0           $munged_row->[ $self->{column_idxs}{$_} ] = $munged_row_hashref->{$_} for keys %$munged_row_hashref;
85 0           $self->{buffer} = $munged_row;
86 0           return;
87             }
88             }
89             }
90              
91             sub has_next_item {
92 0     0 0   my $self = shift;
93 0 0         return 1 if $self->{buffer};
94 0           $self->_fill_buffer;
95 0 0         return $self->{buffer} ? 1:0;
96             }
97              
98             sub get_next_item {
99 0     0 0   my $self = shift;
100 0           $self->_fill_buffer;
101 0 0         die "StopIteration" unless $self->{buffer};
102 0           $self->{pos}++;
103 0           return delete $self->{buffer};
104             }
105              
106             sub get_next_row_hashref {
107 0     0 0   my $self = shift;
108 0           my $row = $self->get_next_item;
109 0           +{ map {($self->{column_names}->[$_] => $row->[$_])} 0..$#{$row} };
  0            
  0            
110             }
111              
112             sub get_iterator_pos {
113 0     0 0   my $self = shift;
114 0           $self->{pos};
115             }
116              
117             sub reset_iterator {
118 0     0 0   my $self = shift;
119 0           $self->{tabledata}->reset_iterator;
120 0           $self->{pos} = 0;
121             }
122              
123             1;
124             # ABSTRACT: Role to munge (add, remove, rename, reorder) columns of each row from another tabledata
125              
126             __END__