The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package SQLite::VirtualTable::CSV;

use Data::Dumper;
use Text::CSV_XS;
use IO::Handle;

use SQLite::VirtualTable::Util qw(unescape);

use base 'SQLite::VirtualTable';

sub CREATE {
    my ($class, $mod, $db, $table, $fn, @opts) = @_;
    defined $fn or die "file name missing\n";
    open my $fh, '<', unescape $fn
        or die "unable to open $fn: $!\n";
    my %opts;
    for (@opts) {
        $_ = unescape $_;
        /^(\w+)\s*=\s*(.*)$/
            or die "invalid option '$_'";
        $opts{$1} = $2;
    }

    my @cols;
    my $cols = delete $opts{columns};
    my $csv = Text::CSV_XS->new(\%opts);

    if (defined $cols) {
        @cols = split(/\s*,\s*/, $cols)
    }
    else {
        while (<$fh>) {
            next if /^\s*$/;
            if (s/^\s*#+//) {
                if ($csv->parse($_)) {
                    @cols = $csv->fields;
                    last;
                }
            }
            if (my $cols = $csv->getline($fh)) {
                @cols = map { "COL$_" } 0..$#$cols;
                last;
            }
            else {
                die "unable to read CSV file header";
            }
        }
    }
    my $self = bless { fh => $fh, fn => $fn,
                       table => $table, columns => \@cols,
                       csv => $csv }, $class;
    return $self;
}

*CONNECT = \&CREATE;

sub DECLARE_SQL {
    my $self = shift;
    my $desc = join(', ', @{$self->{columns}});
    my $decl = "CREATE TABLE $self->{table} ($desc)";
    # warn "decl: $decl\n";
    $decl;
}

sub BEST_INDEX {
    # warn "BEST_INDEX";
    return (0, "", undef, 0)
}

sub OPEN {
    # warn "OPEN";
    return [0];
}

sub FILTER {
    # warn "FILTER";
    my ($self, $cur) = @_;
    @$cur = (0, 0, 0, undef);
}

sub EOF {
    # warn "EOF";
    my ($self, $cur) = @_;
    seek($self->{fh}, $cur->[1], 0);
    my $eof = eof($self->{fh});
    # print "eof: $eof\n";
    $eof;
}

sub populate {
    my ($self, $cur) = @_;
    unless ($cur->[3]) {
        my $fh = $self->{fh};
        seek $fh, $cur->[1], 0;
        my $data = $self->{csv}->getline($fh);
        $cur->[2] = tell($fh);
        $cur->[3] = $data;
    }
}

sub NEXT {
    # warn "NEXT";
    my ($self, $cur) = @_;
    $self->populate($cur);
    $cur->[0]++;
    $cur->[1] = $cur->[2];
    $cur->[2] = undef;
    $cur->[3] = undef;
}

sub COLUMN {
    # warn "COLUMN";
    my ($self, $cur, $n) = @_;
    $self->populate($cur);
    my $data = $cur->[3] || [];
    my $col = $data->[$n];
    $col = int($col) if $col =~ /^[+-]?\d+(?:\.\d+)?$/;
    # print "col = $col\n";
    return $col;
}

sub ROWID {
    my ($self, $cur) = @_;
    warn "ROWID [cur: @$cur]";

    $cur->[0];
}

sub CLOSE {
    # warn "CLOSE";
    my ($self, $cur) = @_;
    @$cur = ();
}

sub DISCONNECT {}

*DESTROY = \&DISCONNECT;

1;