# 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; }