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 File::Slurp;
   9 use Data::Dump qw(dump);
  10 use Encode;
  11
  12 __PACKAGE__->attr('full_path');
  13
  14 my $null = ''; # FIXME undef?
  15
  16 sub _split_line {
  17         my ( $delimiter, $line ) = @_;
  18         my @v;
  19         while ( $line ) {
  20                 my $v;
  21                 if ( $line =~ s/^"// ) {
  22                         $line =~ s/""/_qq_/gc;
  23                         $line =~ s/^\s*([^"]*)\s*"\Q$delimiter\E?// || die "can't parse [$line] ",dump(@v);
  24                         $v = $1;
  25                 } elsif ( $line =~ s/^\s*([^\Q$delimiter\E]+)\s*\Q$delimiter\E?// ) {
  26                         $v = $1;
  27                 } elsif ( $line =~ s/^\s*\Q$delimiter\E// ) {
  28                         $v = $null;
  29                 } else {
  30                         die "can't parse [$line]\n";
  31                 }
  32
  33                 $v =~ s/^\s*(.+?)\s*$/$1/;
  34                 $v = $null if $v eq '_qq_'; # "" field which is not first one
  35                 $v =~ s/_qq_/"/g;
  36                 $v =~ s/_LF_/\n/g;
  37                 push @v, $v;
  38         }
  39
  40         return @v;
  41 }
  42
  43 sub data {
  44         my $self = shift;
  45
  46         my $path = $self->full_path;
  47
  48         my $data = read_file $path, { binmode => ':raw' }; # FIXME configurable!
  49         my $encoding = 'utf-8';
  50         if ( $path =~ m/\.(\w+).csv/i ) {
  51                 $encoding = $1;
  52         }
  53         warn "decoding ", length($data), " bytes using $encoding\n";
  54         $data = decode($encoding, $data);
  55
  56         # multi-line strings
  57         while ( $data =~ s/(,"[^"]*)[\n\r]+([^"]*)/$1_LF_$2/sg ) {
  58                  warn "multi-line quoted CSV data found";
  59         }
  60
  61         my @lines = split(/\r?\n/, $data);
  62         $data = { items => [] };
  63
  64         my $delimiter = ',';
  65
  66         if ( $lines[0] !~ m/,/ ) {
  67                 if ( $lines[0] =~ m/;/ ) {
  68                         $delimiter = ';';
  69                 } elsif ( $lines[0] !~ /;/ && $lines[1] =~ /;/ ) {
  70                         shift @lines; # FIXME skip non-header line
  71                         $delimiter = ';';
  72                 }
  73         }
  74
  75         warn "$path ", $#lines + 1, " lines encoding: $encoding delimiter:",dump($delimiter);
  76
  77         my $header_line = shift @lines;
  78
  79         my @header = _split_line( $delimiter, $header_line );
  80         warn "# header ",dump( @header );
  81
  82         while ( my $line = shift @lines ) {
  83                 chomp $line;
  84                 my @v = _split_line($delimiter, $line);
  85                 my $item;
  86                 foreach my $i ( 0 .. $#v ) {
  87                         $item->{ $header[$i] || "f_$i" } = [ $v[$i] ];
  88                 }
  89                 push @{ $data->{items} }, $item;
  90         }
  91
  92         $data->{header} = [ @header ];
  93
  94         return $data;
  95
  96 }
  97
  98 1