File Coverage

blib/lib/Tie/File/AnyData/MultiRecord_CSV.pm

Criterion	Covered	Total	%
statement	41	41	100.0
branch	7	8	87.5
condition	4	6	66.6
subroutine	7	7	100.0
pod			n/a
total	59	62	95.1

package Tie::File::AnyData::MultiRecord_CSV;

use strict;
use warnings;
use Carp;

BEGIN{
  require Parse::CSV;
  require Tie::File::AnyData;
}

our $VERSION = '0.01';

sub TIEARRAY
  {
    my ($pack,$file,%opts) = @_;
    my $field_sep = $opts{'field_sep'} || "\t";
    my $key = $opts{'key'} || 0;
    my $recsep = $opts{'recsep'} || "\n";
    delete $opts{'field_sep'};
    delete $opts{'key'};

    my $coderef = sub {
      use Parse::CSV;
      my ($fh) = @_;
      return undef if (eof $fh);
      my $csv_parser = Parse::CSV->new (
				    handle => $fh,
				    sep_char => $field_sep
				   );
      my $arref = $csv_parser->fetch;
      my $rec = join ("$field_sep",@$arref).$recsep;
      my $rec_key = ${$arref}[$key];
      my $pos = tell($fh);
      while (my $arref = $csv_parser->fetch){
	if (${$arref}[$key] eq $rec_key){
	  $rec .= join "$field_sep",(@$arref);
	  $rec .= $recsep;
	  $pos = tell($fh);
	  return $rec if eof($fh);
	} else {
	  seek $fh,$pos,0;
	  return $rec;
	}
      }
    };

    carp "Overriding code ref" if (defined $opts{'code'});
    local $/="\n";
    Tie::File::AnyData::TIEARRAY (
				  'Tie::File::AnyData',
				  $file,
				  %opts,
				  code => $coderef
				 );
  }

1;

__END__