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;