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 = '2020-05-29'; # DATE
5             our $DIST = 'TableData-Object'; # DIST
6             our $VERSION = '0.112'; # VERSION
7              
8 1     1   17 use 5.010001;
  1         3  
9 1     1   4 use strict;
  1         1  
  1         17  
10 1     1   4 use warnings;
  1         2  
  1         25  
11              
12 1     1   387 use parent 'TableData::Object::Base';
  1         251  
  1         4  
13              
14             sub new {
15 17     17 1 1305 my ($class, $data) = @_;
16 17         108 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 4 my $self = shift;
25 3         5 scalar @{ $self->{data} };
  3         8  
26             }
27              
28             sub row {
29 5     5 1 617 my ($self, $idx) = @_;
30 5         17 $self->{data}[$idx];
31             }
32              
33             sub row_as_aos {
34 13     13 1 611 my ($self, $idx) = @_;
35 13 100 66     25 return undef if $idx < 0 || $idx >= @{ $self->{data} };
  13         36  
36 12         39 [$self->{data}[$idx]];
37             }
38              
39             sub row_as_hos {
40 5     5 1 602 my ($self, $idx) = @_;
41 5 100 66     13 return undef if $idx < 0 || $idx >= @{ $self->{data} };
  5         20  
42 4         18 {elem=>$self->{data}[$idx]};
43             }
44              
45             sub rows {
46 1     1 1 596 my $self = shift;
47 1         6 $self->{data};
48             }
49              
50             sub rows_as_aoaos {
51 1     1 1 625 my $self = shift;
52 1         2 [map {[$_]} @{ $self->{data} }];
  4         12  
  1         3  
53             }
54              
55             sub rows_as_aohos {
56 7     7 1 610 my $self = shift;
57 7         11 [map {{elem=>$_}} @{ $self->{data} }];
  28         60  
  7         14  
58             }
59              
60             sub uniq_col_names {
61 5     5 1 7 my $self = shift;
62 5         8 my %mem;
63 5         6 for (@{$self->{data}}) {
  5         10  
64 7 100       18 return () unless defined;
65 6 100       22 return () if $mem{$_}++;
66             }
67 3         14 ('elem');
68             }
69              
70             sub const_col_names {
71 7     7 1 12 my $self = shift;
72              
73 7         9 my $i = -1;
74 7         11 my $val;
75             my $val_undef;
76 7         8 for (@{$self->{data}}) {
  7         15  
77 9         8 $i++;
78 9 100       15 if ($i == 0) {
79 6         10 $val = $_;
80 6 100       14 $val_undef = 1 unless defined $val;
81             } else {
82 3 50       5 if ($val_undef) {
83 0 0       0 return () if defined;
84             } else {
85 3 100       10 return () unless defined;
86 2 100       18 return () unless $val eq $_;
87             }
88             }
89             }
90 5         22 ('elem');
91             }
92              
93             sub del_col {
94 2     2 1 374 die "Cannot delete column in aos table";
95             }
96              
97             sub rename_col {
98 2     2 1 352 die "Cannot rename column in aos table";
99             }
100              
101             sub switch_cols {
102 1     1 1 38 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 328 my ($self, $name_or_idx, $value_sub) = @_;
111              
112 2         8 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       12 die "Column '$name_or_idx' does not exist" unless defined $col_name;
116              
117 1         2 my $hash = $self->{data};
118 1         3 for my $i (0..$#{ $self->{data} }) {
  1         4  
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         19 value => $self->{data}[$i],
125             );
126             }
127             }
128              
129             1;
130             # ABSTRACT: Manipulate array of scalars via table object
131              
132             __END__