File Coverage

blib/lib/Data/TableData/Object/aoaos.pm

Criterion	Covered	Total	%
statement	175	175	100.0
branch	62	72	86.1
condition	5	6	83.3
subroutine	19	19	100.0
pod	14	15	93.3
total	275	287	95.8

package Data::TableData::Object::aoaos;

use 5.010001;
use strict;
use warnings;

use parent 'Data::TableData::Object::Base';

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2021-11-17'; # DATE
our $DIST = 'Data-TableData-Object'; # DIST
our $VERSION = '0.114'; # VERSION

sub new {
    my ($class, $data, $spec) = @_;
    my $self = bless {
        data     => $data,
        spec     => $spec,
    }, $class;
    if ($spec) {
        $self->{cols_by_idx}  = [];
        my $ff = $spec->{fields};
        for (keys %$ff) {
            $self->{cols_by_idx}[ $ff->{$_}{pos} ] = $_;
        }
        $self->{cols_by_name} = {
            map { $_ => $ff->{$_}{pos} }
                keys %$ff
        };
    } else {
        if (@$data) {
            my $ncols = @{ $data->[0] };
            $self->{cols_by_idx}  = [ map {"column$_"} 0 .. $ncols-1 ];
            $self->{cols_by_name} = { map {("column$_" => $_)} 0..$ncols-1 };
        } else {
            $self->{cols_by_idx}  = [];
            $self->{cols_by_name} = {};
        }
    }
    $self;
}

sub row_count {
    my $self = shift;
    scalar @{ $self->{data} };
}

sub row {
    my ($self, $idx) = @_;
    $self->{data}[$idx];
}

sub row_as_aos {
    my ($self, $idx) = @_;
    $self->{data}[$idx];
}

sub row_as_hos {
    my ($self, $idx) = @_;
    my $row_aos = $self->{data}[$idx];
    return undef unless $row_aos; ## no critic: Subroutines::ProhibitExplicitReturnUndef
    my $cols = $self->{cols_by_idx};
    my $row_hos = {};
    for my $i (0..$#{$cols}) {
        $row_hos->{$cols->[$i]} = $row_aos->[$i];
    }
    $row_hos;
}

sub rows {
    my $self = shift;
    $self->{data};
}

sub rows_as_aoaos {
    my $self = shift;
    $self->{data};
}

sub rows_as_aohos {
    my $self = shift;
    my $data = $self->{data};

    my $cols = $self->{cols_by_idx};
    my $rows = [];
    for my $aos (@{$self->{data}}) {
        my $row = {};
        for my $i (0..$#{$cols}) {
            $row->{$cols->[$i]} = $aos->[$i];
        }
        push @$rows, $row;
    }
    $rows;
}

sub uniq_col_names {
    my ($self, $which) = @_;

    my @res;
  COL:
    for my $colname (sort keys %{$self->{cols_by_name}}) {
        my $colidx = $self->{cols_by_name}{$colname};
        my %mem;
        for my $row (@{$self->{data}}) {
            next COL unless $#{$row} >= $colidx;
            next COL unless defined $row->[$colidx];
            next COL if $mem{ $row->[$colidx] }++;
        }
        push @res, $colname;
    }

    @res;
}

sub const_col_names {
    my ($self, $which) = @_;

    my @res;
  COL:
    for my $colname (sort keys %{$self->{cols_by_name}}) {
        my $colidx = $self->{cols_by_name}{$colname};
        my $i = -1;
        my $val;
        my $val_undef;
        for my $row (@{$self->{data}}) {
            next COL unless $#{$row} >= $colidx;
            $i++;
            if ($i == 0) {
                $val = $row->[$colidx];
                $val_undef = 1 unless defined $val;
            } else {
                if ($val_undef) {
                    next COL if defined;
                } else {
                    next COL unless defined $row->[$colidx];
                    next COL unless $val eq $row->[$colidx];
                }
            }
        }
        push @res, $colname;
    }

    @res;
}

sub del_col {
    my ($self, $name_or_idx) = @_;

    my $idx = $self->col_idx($name_or_idx);
    return undef unless defined $idx; ## no critic: Subroutines::ProhibitExplicitReturnUndef

    my $name = $self->{cols_by_idx}[$idx];

    for my $row (@{$self->{data}}) {
        splice @$row, $idx, 1;
    }

    # adjust cols_by_{name,idx}
    for my $i (reverse 0..$#{$self->{cols_by_idx}}) {
        my $name = $self->{cols_by_idx}[$i];
        if ($i > $idx) {
            $self->{cols_by_name}{$name}--;
        } elsif ($i == $idx) {
            splice @{ $self->{cols_by_idx} }, $i, 1;
            delete $self->{cols_by_name}{$name};
        }
    }

    # adjust spec
    if ($self->{spec}) {
        my $ff = $self->{spec}{fields};
        for my $name (keys %$ff) {
            if (!exists $self->{cols_by_name}{$name}) {
                delete $ff->{$name};
            } else {
                $ff->{$name}{pos} = $self->{cols_by_name}{$name};
            }
        }
    }

    $name;
}

sub rename_col {
    my ($self, $old_name_or_idx, $new_name) = @_;

    my $idx = $self->col_idx($old_name_or_idx);
    die "Unknown column '$old_name_or_idx'" unless defined($idx);
    my $old_name = $self->{cols_by_idx}[$idx];
    die "Please specify new column name" unless length($new_name);
    return if $new_name eq $old_name;
    die "New column name must not be a number" if $new_name =~ /\A\d+\z/;

    $self->{cols_by_idx}[$idx] = $new_name;
    $self->{cols_by_name}{$new_name} = delete($self->{cols_by_name}{$old_name});
    if ($self->{spec}) {
        my $ff = $self->{spec}{fields};
        $ff->{$new_name} = delete($ff->{$old_name});
    }
}

sub switch_cols {
    my ($self, $name_or_idx1, $name_or_idx2) = @_;

    my $idx1 = $self->col_idx($name_or_idx1);
    die "Unknown first column '$name_or_idx1'" unless defined($idx1);
    my $idx2 = $self->col_idx($name_or_idx2);
    die "Unknown second column '$name_or_idx2'" unless defined($idx2);
    return if $idx1 == $idx2;

    my $name1 = $self->col_name($name_or_idx1);
    my $name2 = $self->col_name($name_or_idx2);

    ($self->{cols_by_idx}[$idx1], $self->{cols_by_idx}[$idx2]) =
        ($self->{cols_by_idx}[$idx2], $self->{cols_by_idx}[$idx1]);
    ($self->{cols_by_name}{$name1}, $self->{cols_by_name}{$name2}) =
        ($self->{cols_by_name}{$name2}, $self->{cols_by_name}{$name1});
    if ($self->{spec}) {
        my $ff = $self->{spec}{fields};
        ($ff->{$name1}, $ff->{$name2}) = ($ff->{$name2}, $ff->{$name1});
    }
}

sub add_col {
    my ($self, $name, $idx, $spec, $data) = @_;

    die "Column '$name' already exists" if defined $self->col_name($name);
    my $col_count = $self->col_count;
    if (defined $idx) {
        die "Index must be between 0..$col_count"
            unless $idx >= 0 && $idx <= $col_count;
    } else {
        $idx = $col_count;
    }

    for (keys %{ $self->{cols_by_name} }) {
        $self->{cols_by_name}{$_}++ if $self->{cols_by_name}{$_} >= $idx;
    }
    $self->{cols_by_name}{$name} = $idx;
    splice @{ $self->{cols_by_idx} }, $idx, 0, $name;
    if ($self->{spec}) {
        my $ff = $self->{spec}{fields};
        for my $f (values %$ff) {
            $f->{pos}++ if defined($f->{pos}) && $f->{pos} >= $idx;
        }
        $ff->{$name} = defined($spec) ? {%$spec} : {};
        $ff->{$name}{pos} = $idx;
    }

    my $i = 0;
    for my $row (@{ $self->{data} }) {
        splice @$row, $idx, 0, ($data ? $data->[$i] : undef);
        $i++;
    }
}

sub set_col_val {
    my ($self, $name_or_idx, $value_sub) = @_;

    my $col_name = $self->col_name($name_or_idx);
    my $col_idx  = $self->col_idx($name_or_idx);

    die "Column '$name_or_idx' does not exist" unless defined $col_name;

    for my $i (0..$#{ $self->{data} }) {
        my $row = $self->{data}[$i];
        $row->[$col_idx] = $value_sub->(
            table    => $self,
            row_idx  => $i,
            col_name => $col_name,
            col_idx  => $col_idx,
            value    => $row->[$col_idx],
        );
    }
}

1;
# ABSTRACT: Manipulate array of arrays-of-scalars via table object

__END__