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