File Coverage

blib/lib/Text/Table/Read/RelationOn/Tiny.pm

Criterion	Covered	Total	%
statement	91	91	100.0
branch	57	58	98.2
condition	7	7	100.0
subroutine	13	13	100.0
pod	7	7	100.0
total	175	176	99.4

package Text::Table::Read::RelationOn::Tiny;

use 5.010_001;
use strict;
use warnings;
use autodie;

use Carp qw(confess);

our $VERSION = '0.01';

sub new {
  my $class = shift;
  $class = ref($class) if ref($class);
  my %arguments = @_;
  my $inc   = delete $arguments{inc}   // "X";
  my $noinc = delete $arguments{noinc} // "";
  confess(join(", ", sort(keys(%arguments))) . ": unexpected argument")
    if %arguments;
  confess("inc must be a scalar")            if ref($inc);
  confess("noinc must be a scalar")          if ref($noinc);
  confess("inc and noinc must be different") if $inc eq $noinc;
  return bless({inc    => $inc,
                noinc  => $noinc,
                matrix => undef,
                set    => undef},
               $class);
}


sub get {
  my $self = shift;
  confess("Wrong number of arguments") if @_ != 1;
  my @lines;
  if (ref($_[0])) {
    confess("Invalid argument") if ref($_[0]) ne 'ARRAY';
    @lines = @{$_[0]};
  } elsif ($_[0] !~ /\n/) {
    open(my $h, '<', $_[0]);
    @lines = <$h>;
    close($h);
  } else {
    @lines = split(/\n/, $_[0]);
  }

  my ($elem_array, $elem_ids) = _get_elems_from_header(\@lines);
  my %remaining_elements = map {$_ => undef} @{$elem_array};
  my ($inc, $noinc) = @{$self}{qw(inc noinc)};
  my %matrix;
  my %seen;
  foreach my $line (@lines) {
    $line =~ s/^\s+//;
    last if $line eq "";
    next if substr($line, 0, 2) eq "|-";
    $line =~ s/^\|\s*([^|]*?)\s*\|\s*// or confess("Wrong row format: '$line'");
    my $element = $1;
    confess("'$element': duplicate element") if exists($seen{$element});
    confess("'$element': not in header") if !exists($remaining_elements{$element});
    delete $remaining_elements{$element};
    $seen{$element} = undef;
    $line =~ s/\s*\|\s*$//;
    my %new_row;
    my $index = 0;
    foreach my $entry (split(/\s*\|\s*/, $line, -1)) {
      if ($entry eq $inc) {
        $new_row{$index} = undef;
      } elsif ($entry ne $noinc) {
        confess("'$entry': unexpected entry");
      }
      $index++;
    }
    $matrix{$elem_ids->{$element}} = \%new_row if %new_row;
  }
  confess(join(', ', map("'$_'", keys(%remaining_elements))) . ": no rows for these elements")
    if %remaining_elements;

  $self->{matrix}   = \%matrix;
  $self->{elems}    = $elem_array;
  $self->{elem_ids} = $elem_ids;
  return wantarray ? (\%matrix, $elem_array, $elem_ids) : $self;
}


sub inc      {confess("Unexpected arguments") if @_ > 1; $_[0]->{inc};}
sub noinc    {confess("Unexpected arguments") if @_ > 1; $_[0]->{noinc};}
sub matrix   {confess("Unexpected arguments") if @_ > 1; $_[0]->{matrix};}
sub elems    {confess("Unexpected arguments") if @_ > 1; $_[0]->{elems};}
sub elem_ids {confess("Unexpected arguments") if @_ > 1; $_[0]->{elem_ids};}


sub _get_elems_from_header {
  my $lines = shift;
  my $header;
  while (defined($header = shift(@{$lines})) and $header !~ /\S/) { 1; }
  return ([], {}) if !defined($header);
  $header =~ s/^\s*\|.*?\|\s*// or confess("'$header': Wrong header format");
  my @elem_array = $header eq "|" ? ('') : split(/\s*\|\s*/, $header);
  return ([], {}) if $header eq "";
  my $index = 0;
  my %elem_ids;
  foreach my $name (@elem_array) {
    confess("'$name': duplicate name in header") if exists($elem_ids{$name});
    $elem_ids{$name} = $index++;
  }
  return (\@elem_array, \%elem_ids);
}



1; # End of Text::Table::Read::RelationOn::Tiny



__END__