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   29 use 5.010001;
  1         4  
4 1     1   6 use strict;
  1         2  
  1         24  
5 1     1   6 use warnings;
  1         1  
  1         39  
6              
7 1     1   451 use parent 'Data::TableData::Object::Base';
  1         395  
  1         6  
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.115'; # VERSION
13              
14             sub new {
15 17     17 1 1953 my ($class, $data) = @_;
16 17         155 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 7 my $self = shift;
25 3         5 scalar @{ $self->{data} };
  3         13  
26             }
27              
28             sub row {
29 5     5 1 1379 my ($self, $idx) = @_;
30 5         26 $self->{data}[$idx];
31             }
32              
33             sub row_as_aos {
34 13     13 1 944 my ($self, $idx) = @_;
35 13 100 66     39 return undef if $idx < 0 || $idx >= @{ $self->{data} }; ## no critic: Subroutines::ProhibitExplicitReturnUndef
  13         48  
36 12         44 [$self->{data}[$idx]];
37             }
38              
39             sub row_as_hos {
40 5     5 1 986 my ($self, $idx) = @_;
41 5 100 66     18 return undef if $idx < 0 || $idx >= @{ $self->{data} }; ## no critic: Subroutines::ProhibitExplicitReturnUndef
  5         25  
42 4         26 {elem=>$self->{data}[$idx]};
43             }
44              
45             sub rows {
46 1     1 1 922 my $self = shift;
47 1         9 $self->{data};
48             }
49              
50             sub rows_as_aoaos {
51 1     1 1 917 my $self = shift;
52 1         3 [map {[$_]} @{ $self->{data} }];
  4         15  
  1         4  
53             }
54              
55             sub rows_as_aohos {
56 7     7 1 949 my $self = shift;
57 7         13 [map {{elem=>$_}} @{ $self->{data} }];
  28         86  
  7         24  
58             }
59              
60             sub uniq_col_names {
61 5     5 1 10 my $self = shift;
62 5         10 my %mem;
63 5         8 for (@{$self->{data}}) {
  5         14  
64 7 100       21 return () unless defined;
65 6 100       29 return () if $mem{$_}++;
66             }
67 3         19 ('elem');
68             }
69              
70             sub const_col_names {
71 7     7 1 16 my $self = shift;
72              
73 7         11 my $i = -1;
74 7         14 my $val;
75             my $val_undef;
76 7         12 for (@{$self->{data}}) {
  7         18  
77 9         14 $i++;
78 9 100       28 if ($i == 0) {
79 6         11 $val = $_;
80 6 100       20 $val_undef = 1 unless defined $val;
81             } else {
82 3 50       13 if ($val_undef) {
83 0 0       0 return () if defined;
84             } else {
85 3 100       13 return () unless defined;
86 2 100       11 return () unless $val eq $_;
87             }
88             }
89             }
90 5         29 ('elem');
91             }
92              
93             sub del_col {
94 2     2 1 569 die "Cannot delete column in aos table";
95             }
96              
97             sub rename_col {
98 2     2 1 547 die "Cannot rename column in aos table";
99             }
100              
101             sub switch_cols {
102 1     1 1 61 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 506 my ($self, $name_or_idx, $value_sub) = @_;
111              
112 2         10 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       21 die "Column '$name_or_idx' does not exist" unless defined $col_name;
116              
117 1         3 my $hash = $self->{data};
118 1         3 for my $i (0..$#{ $self->{data} }) {
  1         5  
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__