lib/MojoFacets/Import/CSV.pm

   1 package MojoFacets::Import::CSV;
   2
   3 use warnings;
   4 use strict;
   5
   6 use base 'Mojo::Base';
   7
   8 use Text::CSV;
   9 use Data::Dump qw(dump);
  10
  11 __PACKAGE__->attr('full_path');
  12
  13 sub ext { '\.[ct]sv$' };
  14
  15 sub data {
  16         my $self = shift;
  17
  18         my $path = $self->full_path;
  19
  20         my $encoding = 'utf-8';
  21         if ( $path =~ m/\.([\w\-]+).[ct]sv/i ) {
  22                 $encoding = $1;
  23         }
  24
  25         my $data = { items => [] };
  26         my @header;
  27
  28         open my $fh, "<:encoding($encoding)", $path or die "$path: $!";
  29         my $first = <$fh>;
  30         my $possible_delimiters;
  31         while ( $first =~ s/(\W)// ) {
  32                 $possible_delimiters->{$1}++;
  33         }
  34         warn "# possible_delimiters = ",dump($possible_delimiters);
  35         seek $fh,0,0; # rewind for Text::CSV
  36
  37         my @sep_by_usage = sort { $possible_delimiters->{$b} <=> $possible_delimiters->{$a} } keys %$possible_delimiters;
  38         my $sep_char = shift @sep_by_usage;
  39         while ( $sep_char =~ m/^\s$/ ) {
  40                 last if $sep_char eq "\t" && $path =~ m/\.tsv$/i;
  41                 warn "## skip whitespace separator ",dump($sep_char);
  42                 $sep_char = shift @sep_by_usage;
  43         }
  44
  45         while ( $sep_char =~ m/^\"$/ ) {
  46                 warn "## skip quote separator ",dump($sep_char);
  47                 $sep_char = shift @sep_by_usage;
  48         }
  49
  50         if ( $sep_char !~ m/,/ && $possible_delimiters->{','} && $path =~ m/\.csv/i ) {
  51                 $sep_char = ',';
  52                 warn "## csv file detected so prefer , as separator";
  53         }
  54
  55         warn "sep_char = [$sep_char] for $path\n";
  56
  57         my $csv = Text::CSV->new ( { binary => 1, eol => $/, sep_char => $sep_char } )
  58                 or die "Cannot use CSV: ".Text::CSV->error_diag ();
  59
  60         while ( my $row = $csv->getline( $fh ) ) {
  61                 if ( ! @header ) {
  62                         @header = @$row;
  63                         next;
  64                 }
  65                 my $item;
  66                 foreach my $i ( 0 .. $#{$row} ) {
  67                         $item->{ $header[$i] || "f_$i" } = [ $row->[$i] ];
  68                 }
  69                 push @{ $data->{items} }, $item;
  70         }
  71
  72         $csv->eof or $csv->error_diag();
  73         close $fh;
  74
  75         $data->{header} = [ @header ];
  76
  77         return $data;
  78
  79 }
  80
  81 1