• Files
• Commits
• Log
• Graph
• Stats

# same as Text::CSV::Simple, but changes default on_failure trigger to make stderr warning more explicit:

package Text_CSV_Simple_Base;

use Class::Trigger;
use Data::Dumper; 

__PACKAGE__->add_trigger(on_failure => sub { 
	my ($self, $csv) = @_;
	if (my $err = $csv->error_input) {
		warn qq!LIMS::Local::Text_CSV_Simple parser failed on "$err"\n!;
		# warn Dumper [$csv->error_diag]; # uncomment to dump error diagnostics
	}
});

package LIMS::Local::Text_CSV_Simple;

use base 'Text_CSV_Simple_Base';

$VERSION = '1.00';

use strict;

use Text::CSV_XS;
use File::Slurp ();

sub new {
	my $class = shift;
	return bless { _parser => Text::CSV_XS->new(@_), } => $class;
}

sub _parser { shift->{_parser} }

sub _file {
	my $self = shift;
	$self->{_file} = shift if @_;
	return $self->{_file};
}

sub _contents {
	my $self  = shift;
	my @lines = File::Slurp::read_file($self->_file)
		or die "Can't read " . $self->_file;
	return @lines;
}

sub want_fields {
	my $self = shift;
	if (@_) {
		$self->{_wanted} = [@_];
	}
	return @{ $self->{_wanted} || [] };
}

sub field_map {
	my $self = shift;
	if (@_) {
		$self->{_map} = [@_];
	}
	return @{ $self->{_map} || [] };
}

sub read_file {
	my ($self, $file) = @_;
	$self->_file($file);
	my @lines = $self->_contents;
	my @return;
	my $csv = $self->_parser;
	foreach my $line (@lines) {
		eval { $self->call_trigger(before_parse => $line) };
		next if $@;
		next unless $line;
		unless ($csv->parse($line)) {
			$self->call_trigger(on_failure => $csv);
			next;
		}
		my @fields = $csv->fields;
		eval { $self->call_trigger(after_parse => \@fields) };
		next if $@;
		if (my @wanted = $self->want_fields) {
			@fields = @fields[ $self->want_fields ];
		}
		my $addition = [ @fields ];
		if (my @map = $self->field_map) {
			my $hash = { map { $_ => shift @fields } @map };
			delete $hash->{null};
			$addition = $hash;
		} 
		eval { $self->call_trigger(after_processing => $addition) };
		next if $@;
		push @return, $addition;
	}
	return @return;
}