File Coverage

blib/lib/Data/TableData/Object/aos.pm
Criterion Covered Total %
statement 67 69 97.1
branch 19 22 86.3
condition 4 6 66.6
subroutine 18 19 94.7
pod 14 15 93.3
total 122 131 93.1


line stmt bran cond sub pod time code
1             package Data::TableData::Object::aos;
2              
3 1     1   27 use 5.010001;
  1         3  
4 1     1   5 use strict;
  1         2  
  1         25  
5 1     1   4 use warnings;
  1         2  
  1         35  
6              
7 1     1   439 use parent 'Data::TableData::Object::Base';
  1         348  
  1         7  
8              
9             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
10             our $DATE = '2021-11-17'; # DATE
11             our $DIST = 'Data-TableData-Object'; # DIST
12             our $VERSION = '0.114'; # VERSION
13              
14             sub new {
15 17     17 1 1788 my ($class, $data) = @_;
16 17         129 bless {
17             data => $data,
18             cols_by_name => {elem=>0},
19             cols_by_idx => ["elem"],
20             }, $class;
21             }
22              
23             sub row_count {
24 3     3 1 9 my $self = shift;
25 3         6 scalar @{ $self->{data} };
  3         14  
26             }
27              
28             sub row {
29 5     5 1 831 my ($self, $idx) = @_;
30 5         22 $self->{data}[$idx];
31             }
32              
33             sub row_as_aos {
34 13     13 1 877 my ($self, $idx) = @_;
35 13 100 66     34 return undef if $idx < 0 || $idx >= @{ $self->{data} }; ## no critic: Subroutines::ProhibitExplicitReturnUndef
  13         47  
36 12         45 [$self->{data}[$idx]];
37             }
38              
39             sub row_as_hos {
40 5     5 1 848 my ($self, $idx) = @_;
41 5 100 66     19 return undef if $idx < 0 || $idx >= @{ $self->{data} }; ## no critic: Subroutines::ProhibitExplicitReturnUndef
  5         25  
42 4         25 {elem=>$self->{data}[$idx]};
43             }
44              
45             sub rows {
46 1     1 1 913 my $self = shift;
47 1         7 $self->{data};
48             }
49              
50             sub rows_as_aoaos {
51 1     1 1 768 my $self = shift;
52 1         3 [map {[$_]} @{ $self->{data} }];
  4         14  
  1         4  
53             }
54              
55             sub rows_as_aohos {
56 7     7 1 845 my $self = shift;
57 7         16 [map {{elem=>$_}} @{ $self->{data} }];
  28         104  
  7         27  
58             }
59              
60             sub uniq_col_names {
61 5     5 1 10 my $self = shift;
62 5         8 my %mem;
63 5         11 for (@{$self->{data}}) {
  5         12  
64 7 100       19 return () unless defined;
65 6 100       25 return () if $mem{$_}++;
66             }
67 3         17 ('elem');
68             }
69              
70             sub const_col_names {
71 7     7 1 16 my $self = shift;
72              
73 7         13 my $i = -1;
74 7         14 my $val;
75             my $val_undef;
76 7         12 for (@{$self->{data}}) {
  7         20  
77 9         13 $i++;
78 9 100       21 if ($i == 0) {
79 6         13 $val = $_;
80 6 100       17 $val_undef = 1 unless defined $val;
81             } else {
82 3 50       8 if ($val_undef) {
83 0 0       0 return () if defined;
84             } else {
85 3 100       12 return () unless defined;
86 2 100       11 return () unless $val eq $_;
87             }
88             }
89             }
90 5         32 ('elem');
91             }
92              
93             sub del_col {
94 2     2 1 455 die "Cannot delete column in aos table";
95             }
96              
97             sub rename_col {
98 2     2 1 449 die "Cannot rename column in aos table";
99             }
100              
101             sub switch_cols {
102 1     1 1 58 die "Cannot switch column in aos table";
103             }
104              
105             sub add_col {
106 0     0 1 0 die "Cannot add_col in aos table";
107             }
108              
109             sub set_col_val {
110 2     2 0 425 my ($self, $name_or_idx, $value_sub) = @_;
111              
112 2         11 my $col_name = $self->col_name($name_or_idx);
113 2         7 my $col_idx = $self->col_idx($name_or_idx);
114              
115 2 100       18 die "Column '$name_or_idx' does not exist" unless defined $col_name;
116              
117 1         4 my $hash = $self->{data};
118 1         3 for my $i (0..$#{ $self->{data} }) {
  1         6  
119             $self->{data}[$i] = $value_sub->(
120             table => $self,
121             row_idx => $i,
122             col_name => $col_name,
123             col_idx => $col_idx,
124 3         22 value => $self->{data}[$i],
125             );
126             }
127             }
128              
129             1;
130             # ABSTRACT: Manipulate array of scalars via table object
131              
132             __END__