File Coverage

blib/lib/TableData/Object/aos.pm
Criterion Covered Total %
statement 55 59 93.2
branch 15 18 83.3
condition n/a
subroutine 14 16 87.5
pod 11 12 91.6
total 95 105 90.4


line stmt bran cond sub pod time code
1             package TableData::Object::aos;
2              
3             our $DATE = '2019-09-15'; # DATE
4             our $VERSION = '0.111'; # VERSION
5              
6 1     1   16 use 5.010001;
  1         4  
7 1     1   5 use strict;
  1         1  
  1         16  
8 1     1   4 use warnings;
  1         1  
  1         24  
9              
10 1     1   348 use parent 'TableData::Object::Base';
  1         249  
  1         4  
11              
12             sub new {
13 17     17 1 1280 my ($class, $data) = @_;
14 17         88 bless {
15             data => $data,
16             cols_by_name => {elem=>0},
17             cols_by_idx => ["elem"],
18             }, $class;
19             }
20              
21             sub row_count {
22 1     1 1 2 my $self = shift;
23 1         2 scalar @{ $self->{data} };
  1         4  
24             }
25              
26             sub rows {
27 0     0 1 0 my $self = shift;
28 0         0 $self->{data};
29             }
30              
31             sub rows_as_aoaos {
32 1     1 1 575 my $self = shift;
33 1         1 [map {[$_]} @{ $self->{data} }];
  4         11  
  1         3  
34             }
35              
36             sub rows_as_aohos {
37 7     7 1 586 my $self = shift;
38 7         10 [map {{elem=>$_}} @{ $self->{data} }];
  28         69  
  7         14  
39             }
40              
41             sub uniq_col_names {
42 5     5 1 11 my $self = shift;
43 5         6 my %mem;
44 5         6 for (@{$self->{data}}) {
  5         11  
45 7 100       16 return () unless defined;
46 6 100       18 return () if $mem{$_}++;
47             }
48 3         14 ('elem');
49             }
50              
51             sub const_col_names {
52 7     7 1 11 my $self = shift;
53              
54 7         10 my $i = -1;
55 7         8 my $val;
56             my $val_undef;
57 7         10 for (@{$self->{data}}) {
  7         14  
58 9         11 $i++;
59 9 100       15 if ($i == 0) {
60 6         7 $val = $_;
61 6 100       15 $val_undef = 1 unless defined $val;
62             } else {
63 3 50       5 if ($val_undef) {
64 0 0       0 return () if defined;
65             } else {
66 3 100       11 return () unless defined;
67 2 100       8 return () unless $val eq $_;
68             }
69             }
70             }
71 5         20 ('elem');
72             }
73              
74             sub del_col {
75 2     2 1 358 die "Cannot delete column in aos table";
76             }
77              
78             sub rename_col {
79 2     2 1 360 die "Cannot rename column in aos table";
80             }
81              
82             sub switch_cols {
83 1     1 1 37 die "Cannot switch column in aos table";
84             }
85              
86             sub add_col {
87 0     0 1 0 die "Cannot add_col in aos table";
88             }
89              
90             sub set_col_val {
91 2     2 0 316 my ($self, $name_or_idx, $value_sub) = @_;
92              
93 2         7 my $col_name = $self->col_name($name_or_idx);
94 2         5 my $col_idx = $self->col_idx($name_or_idx);
95              
96 2 100       14 die "Column '$name_or_idx' does not exist" unless defined $col_name;
97              
98 1         2 my $hash = $self->{data};
99 1         3 for my $i (0..$#{ $self->{data} }) {
  1         3  
100             $self->{data}[$i] = $value_sub->(
101             table => $self,
102             row_idx => $i,
103             col_name => $col_name,
104             col_idx => $col_idx,
105 3         18 value => $self->{data}[$i],
106             );
107             }
108             }
109              
110             1;
111             # ABSTRACT: Manipulate array of scalars via table object
112              
113             __END__