File Coverage

blib/lib/TableData/Object/hash.pm
Criterion Covered Total %
statement 76 77 98.7
branch 21 24 87.5
condition n/a
subroutine 16 17 94.1
pod 12 13 92.3
total 125 131 95.4


line stmt bran cond sub pod time code
1             package TableData::Object::hash;
2              
3             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
4             our $DATE = '2020-05-29'; # DATE
5             our $DIST = 'TableData-Object'; # DIST
6             our $VERSION = '0.112'; # VERSION
7              
8 1     1   20 use 5.010001;
  1         3  
9 1     1   4 use strict;
  1         3  
  1         20  
10 1     1   5 use warnings;
  1         2  
  1         28  
11              
12 1     1   422 use parent 'TableData::Object::Base';
  1         316  
  1         6  
13              
14             sub new {
15 17     17 1 35 my ($class, $data) = @_;
16              
17 17         116 bless {
18             data => $data,
19             cols_by_name => {key=>0, value=>1},
20             cols_by_idx => ["key", "value"],
21             }, $class;
22             }
23              
24             sub row_count {
25 5     5 1 7 my $self = shift;
26 5         10 scalar keys %{ $self->{data} };
  5         15  
27             }
28              
29             sub row {
30 4     4 1 769 my ($self, $idx) = @_;
31             # XXX not very efficient
32 4         9 my $rows = $self->rows;
33 4         21 $rows->[$idx];
34             }
35              
36             sub row_as_aos {
37 16     16 1 747 my ($self, $idx) = @_;
38             # XXX not very efficient
39 16         28 my $rows = $self->rows;
40 16         52 $rows->[$idx];
41             }
42              
43             sub row_as_hos {
44 4     4 1 716 my ($self, $idx) = @_;
45             # XXX not very efficient
46 4         10 my $rows = $self->rows;
47 4         9 my $row = $rows->[$idx];
48 4 100       13 return undef unless $row;
49 3         22 {key => $row->[0], value => $row->[1]};
50             }
51              
52             sub rows {
53 25     25 1 742 my $self = shift;
54 25         44 $self->rows_as_aoaos;
55             }
56              
57             sub rows_as_aoaos {
58 26     26 1 772 my $self = shift;
59 26         38 my $data = $self->{data};
60 26         102 [map {[$_, $data->{$_}]} sort keys %$data];
  78         194  
61             }
62              
63             sub rows_as_aohos {
64 7     7 1 733 my $self = shift;
65 7         14 my $data = $self->{data};
66 7         31 [map {{key=>$_, value=>$data->{$_}}} sort keys %$data];
  21         77  
67             }
68              
69             sub uniq_col_names {
70 6     6 1 12 my $self = shift;
71              
72 6         11 my @res = ('key'); # by definition, hash key is unique
73 6         11 my %mem;
74 6         8 for (values %{$self->{data}}) {
  6         21  
75 7 100       37 return @res unless defined;
76 5 100       32 return @res if $mem{$_}++;
77             }
78 3         6 push @res, 'value';
79 3         17 @res;
80             }
81              
82             sub const_col_names {
83 6     6 1 13 my $self = shift;
84              
85             # by definition, hash key is not constant
86 6         9 my $i = -1;
87 6         10 my $val;
88             my $val_undef;
89 6         9 for (values %{$self->{data}}) {
  6         20  
90 8         12 $i++;
91 8 100       18 if ($i == 0) {
92 5         7 $val = $_;
93 5 100       17 $val_undef = 1 unless defined $val;
94             } else {
95 3 100       7 if ($val_undef) {
96 1 50       8 return () if defined;
97             } else {
98 2 50       7 return () unless defined;
99 2 100       11 return () unless $val eq $_;
100             }
101             }
102             }
103 4         19 ('value');
104             }
105              
106             sub switch_cols {
107 4     4 1 1246 die "Cannot switch column in hash table";
108             }
109              
110             sub add_col {
111 0     0 1 0 die "Cannot add_col in hash table";
112             }
113              
114             sub set_col_val {
115 3     3 0 1059 my ($self, $name_or_idx, $value_sub) = @_;
116              
117 3         10 my $col_name = $self->col_name($name_or_idx);
118 3         10 my $col_idx = $self->col_idx($name_or_idx);
119              
120 3 100       19 die "Column '$name_or_idx' does not exist" unless defined $col_name;
121              
122 2         5 my $hash = $self->{data};
123 2 100       9 if ($col_name eq 'key') {
124 1         3 my $row_idx = -1;
125 1         6 for my $key (sort keys %$hash) {
126 3         7 $row_idx++;
127             my $new_key = $value_sub->(
128             table => $self,
129             row_idx => $row_idx,
130             row_name => $key,
131             col_name => $col_name,
132             col_idx => $col_idx,
133 3         18 value => $hash->{$key},
134             );
135 3 50       33 $hash->{$new_key} = delete $hash->{$key}
136             unless $key eq $new_key;
137             }
138             } else {
139 1         2 my $row_idx = -1;
140 1         7 for my $key (sort keys %$hash) {
141 3         8 $row_idx++;
142             $hash->{$key} = $value_sub->(
143             table => $self,
144             row_idx => $row_idx,
145             row_name => $key,
146             col_name => $col_name,
147             col_idx => $col_idx,
148 3         8 value => $hash->{$key},
149             );
150             }
151             }
152             }
153              
154             1;
155             # ABSTRACT: Manipulate hash via table object
156              
157             __END__