File Coverage

blib/lib/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 TableData::Object::aos;
2              
3             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
4             our $DATE = '2021-01-10'; # DATE
5             our $DIST = 'TableData-Object'; # DIST
6             our $VERSION = '0.113'; # VERSION
7              
8 1     1   19 use 5.010001;
  1         3  
9 1     1   4 use strict;
  1         3  
  1         21  
10 1     1   4 use warnings;
  1         2  
  1         33  
11              
12 1     1   396 use parent 'TableData::Object::Base';
  1         266  
  1         5  
13              
14             sub new {
15 17     17 1 1488 my ($class, $data) = @_;
16 17         122 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 5 my $self = shift;
25 3         5 scalar @{ $self->{data} };
  3         11  
26             }
27              
28             sub row {
29 5     5 1 755 my ($self, $idx) = @_;
30 5         21 $self->{data}[$idx];
31             }
32              
33             sub row_as_aos {
34 13     13 1 771 my ($self, $idx) = @_;
35 13 100 66     27 return undef if $idx < 0 || $idx >= @{ $self->{data} };
  13         40  
36 12         32 [$self->{data}[$idx]];
37             }
38              
39             sub row_as_hos {
40 5     5 1 705 my ($self, $idx) = @_;
41 5 100 66     13 return undef if $idx < 0 || $idx >= @{ $self->{data} };
  5         20  
42 4         21 {elem=>$self->{data}[$idx]};
43             }
44              
45             sub rows {
46 1     1 1 706 my $self = shift;
47 1         5 $self->{data};
48             }
49              
50             sub rows_as_aoaos {
51 1     1 1 655 my $self = shift;
52 1         3 [map {[$_]} @{ $self->{data} }];
  4         13  
  1         3  
53             }
54              
55             sub rows_as_aohos {
56 7     7 1 691 my $self = shift;
57 7         10 [map {{elem=>$_}} @{ $self->{data} }];
  28         83  
  7         19  
58             }
59              
60             sub uniq_col_names {
61 5     5 1 8 my $self = shift;
62 5         6 my %mem;
63 5         9 for (@{$self->{data}}) {
  5         11  
64 7 100       21 return () unless defined;
65 6 100       19 return () if $mem{$_}++;
66             }
67 3         17 ('elem');
68             }
69              
70             sub const_col_names {
71 7     7 1 12 my $self = shift;
72              
73 7         11 my $i = -1;
74 7         9 my $val;
75             my $val_undef;
76 7         12 for (@{$self->{data}}) {
  7         17  
77 9         11 $i++;
78 9 100       16 if ($i == 0) {
79 6         8 $val = $_;
80 6 100       17 $val_undef = 1 unless defined $val;
81             } else {
82 3 50       7 if ($val_undef) {
83 0 0       0 return () if defined;
84             } else {
85 3 100       11 return () unless defined;
86 2 100       7 return () unless $val eq $_;
87             }
88             }
89             }
90 5         25 ('elem');
91             }
92              
93             sub del_col {
94 2     2 1 386 die "Cannot delete column in aos table";
95             }
96              
97             sub rename_col {
98 2     2 1 372 die "Cannot rename column in aos table";
99             }
100              
101             sub switch_cols {
102 1     1 1 52 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 355 my ($self, $name_or_idx, $value_sub) = @_;
111              
112 2         10 my $col_name = $self->col_name($name_or_idx);
113 2         6 my $col_idx = $self->col_idx($name_or_idx);
114              
115 2 100       17 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         18 value => $self->{data}[$i],
125             );
126             }
127             }
128              
129             1;
130             # ABSTRACT: Manipulate array of scalars via table object
131              
132             __END__