File Coverage

blib/lib/Tie/Array/CSV.pm

Criterion	Covered	Total	%
statement	127	145	87.5
branch	27	36	75.0
condition	9	11	81.8
subroutine	28	32	87.5
pod	1	2	50.0
total	192	226	84.9

package Tie::Array::CSV;

use strict;
use warnings;

our $VERSION = '0.07';
$VERSION = eval $VERSION;

use Carp;

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

use Scalar::Util qw/blessed/;

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

sub parse_opts {
  my $class = shift;

  croak "Must specify a file" unless @_;

  my ($file, %opts);

  # handle one arg as either hashref (of opts) or file
  if (@_ == 1) {
    if (ref $_[0] eq 'HASH') {
      %opts = %{ shift() };
    } else {
      $file = shift;
    }
  }

  # handle file and hashref of opts
  if (@_ == 2 and ref $_[1] eq 'HASH') {
    $file = shift;
    %opts = %{ shift() };
  }

  # handle file before hash of opts
  if (@_ % 2) {
    $file = shift;
  }

  # handle hash of opts
  if (@_) {
    %opts = @_;
  }

  # handle file passed has hash(ref) value to 'file' key
  if (!$file and defined $opts{file}) {
    $file = delete $opts{file};
  }

  # file wasn't specified as lone arg or as a hash opt
  croak "Must specify a file" unless $file;

  # parse specific options
  if (exists $opts{sep_char}) {
    $opts{text_csv}{sep_char} = delete $opts{sep_char};
  }

  return ($file, \%opts);
}

sub new {
  my $class = shift;
  my ($file, $opts) = $class->parse_opts(@_);

  my @self;
  tie @self, $class, $file, $opts;

  return \@self;

}

sub TIEARRAY {
  my $class = shift;
  my ($file, $opts) = $class->parse_opts(@_);

  my @tiefile;
  tie @tiefile, 'Tie::File', $file, recsep => "\n", %{ $opts->{tie_file} || {} }
    or croak "Cannot tie file $file";

  my $csv;
  if (blessed $opts->{text_csv} and $opts->{text_csv}->isa('Text::CSV')) {
    $csv = $opts->{text_csv};
  } else {
    $csv = Text::CSV->new($opts->{text_csv} || {})
      or croak "CSV (new) error: " . Text::CSV->error_diag();
  }

  my $self = {
    file => \@tiefile,
    csv => $csv,
  };

  bless $self, $class;

  return $self;
}

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

  my $line = $self->{file}[$index];

  my $rowclass = ref($self) . '::Row';
  tie my @line, $rowclass, {
    file => $self->{file},
    line_num => $index,
    fields => $self->_parse($line),
    csv => $self->{csv},
  };

  return \@line;
}

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

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

sub FETCHSIZE {
  my $self = shift;

  return scalar @{ $self->{file} };
}

sub STORESIZE {
  my $self = shift;
  my $new_size = shift;

  $#{ $self->{file} } = $new_size - 1;

}

sub EXISTS {
  my $self = shift;
  my ($index) = shift;
  return exists $self->{file}[$index];
}

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

sub _parse {
  my $self = shift;
  my ($line) = @_;
  $line = '' unless defined $line;

  return [$self->{csv}->fields] if $self->{csv}->parse($line);

  croak "CSV parse error: " . $self->{csv}->error_diag;
}

sub _combine {
  my $self = shift;
  my ($value) = @_;

  return $self->{csv}->string
    if $self->{csv}->combine( ref $value ? @$value : ($value) );

  croak "CSV combine error: " . $self->{csv}->error_diag();
}

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

use Carp;

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

use overload
  '@{}' => sub{ $_[0]{fields} };

sub TIEARRAY {
  my $class = shift;
  my $self = shift;

  bless $self, $class;

  return $self;
}

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

  return $self->{fields}[$index];
}

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

  $self->{fields}[$index] = $value;

  $self->_update;

}

sub FETCHSIZE {
  my $self = shift;

  return scalar @{ $self->{fields} };
}

sub STORESIZE {
  my $self = shift;
  my $new_size = shift;

  my $return = (
    $#{ $self->{fields} } = $new_size - 1
  );

  $self->_update;

  return $return;
}

sub SHIFT {
  my $self = shift;

  my $value = shift @{ $self->{fields} };

  $self->_update;

  return $value;
}

sub UNSHIFT {
  my $self = shift;
  my $value = shift;

  unshift @{ $self->{fields} }, $value;

  $self->_update;

  return $self->FETCHSIZE();
}

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

  my $return = splice @{ $self->{fields} }, $index, 1;
  $self->_update;

  return $return;
}

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

  return exists $self->{fields}[$index];
}

sub _update {
  my $self = shift;

  $self->{csv}->combine(@{ $self->{fields} })
    or croak "CSV combine error: " . $self->{csv}->error_diag();
  $self->{file}[$self->{line_num}] = $self->{csv}->string;
}

__END__