File Coverage

blib/lib/Tie/Array/CSV/HoldRow.pm

Criterion	Covered	Total	%
statement	78	98	79.5
branch	14	20	70.0
condition	2	3	66.6
subroutine	17	23	73.9
pod			n/a
total	111	144	77.0

package Tie::Array::CSV::HoldRow;

use strict;
use warnings;

use Carp;

use Tie::File;
use Text::CSV;

use Scalar::Util qw/weaken/;

use Tie::Array::CSV;
our @ISA = ('Tie::Array::CSV');

# This is essentially the same TIEARRAY method as T::A::CSV,
# but initializes active_rows. This isn't strictly necessary, thanks to autoviv
sub TIEARRAY {
  my $class = shift;

  my $self = $class->SUPER::TIEARRAY(@_);

  $self->{active_rows} = {},

  # rebless
  bless $self, $class;

  return $self;
}

sub FETCH {
  my $self = shift;
  my $index = shift;

  if ($self->{active_rows}{$index}) {
    return $self->{active_rows}{$index}
  }

  my $line_array = $self->SUPER::FETCH($index);

  weaken(
    $self->{active_rows}{$index} = $line_array
  );

  return $line_array;
}

sub STORE {
  my $self = shift;
  my ($index, $value) = @_;

  $self->{file}[$index] = $self->_combine($value);
}

sub SPLICE {
  my $self = shift;
  my $size = $self->FETCHSIZE;
  my $offset = @_ ? shift : 0;
  $offset += $size if $offset < 0;
  my $length = @_ ? shift : $size-$offset;

  my @replace_rows = map { $self->_combine($_) } @_;

  ## reindex active_rows ##

  # assuming removing items
  my @active_rows =
    sort { $a <=> $b }
    grep { defined $self->{active_rows}{$_} }
    keys %{ $self->{active_rows} };
  my $delta = @replace_rows - $length;

  # if instead adding items
  if ($length < @replace_rows) {
    # reverse ot avoid overwriting active items
    @active_rows = reverse @active_rows;
    $delta = @replace_rows + $length;
  }

  foreach my $index (@active_rows) {
    # skip lines before those affected
    next if ($index < $offset);

    if ($index >= $offset and $index < ($offset + $length)) { #items that are being removed
      tied(@{$self->{active_rows}{$index}})->{line_num} = undef;
    } else { #shifting affected items
      tied(@{$self->{active_rows}{$index}})->{line_num} = $index+$delta;
      $self->{active_rows}{$index+$delta} = delete $self->{active_rows}{$index};
    }
  }

  ## end reindexing logic ##

  my @return = map { $self->_parse($_) }
    splice(@{ $self->{file} },$offset,$length,@replace_rows);

  return @return

}

sub SHIFT {
  my $self = shift;
  my ($return) = $self->SPLICE(0,1);
  return $return;
}

sub UNSHIFT { scalar shift->SPLICE(0,0,@_) }

sub PUSH {
  my $self = shift;
  my $i = $self->FETCHSIZE;
  $self->STORE($i++, shift) while (@_);
}

sub POP {
  my $self = shift;
  my $newsize = $self->FETCHSIZE - 1;
  my $val;
  if ($newsize >= 0) {
    $val = $self->FETCH($newsize);
    $self->STORESIZE($newsize);
  }
  return $val;
}

sub CLEAR { shift->STORESIZE(0) }

sub EXTEND  { }

package Tie::Array::CSV::HoldRow::Row;

use Carp;

use Tie::Array::CSV;
our @ISA = ('Tie::Array::CSV::Row');

sub TIEARRAY {
  my $class = shift;
  my $self = $class->SUPER::TIEARRAY(@_);

  # rebless
  bless $self, $class;

  $self->{need_update} = 0;

  return $self;
}

# _update now marks for deferred update
sub _update {
  my $self = shift;
  $self->{need_update} = 1;
}

sub _deferred_update {
  my $self = shift;
  unless (defined $self->{line_num}) {
    carp "Attempted to write out from a severed row";
    return undef;
  }

  $self->SUPER::_update();
}

sub DESTROY {
  my $self = shift;
  $self->_deferred_update if $self->{need_update} == 1;
}

__END__