#!usr/local/bin/perl
use strict;
use warnings;
use DBI;

my $fileStr = do {local $/; <DATA>};
my ($header, $meat) = $fileStr =~ /(.*)^PATH 1(.*)END_PATH 1.*/sm;
my $dbName = 'test1.sqlite';
my $paths  = 4000;

$fileStr = join '', $header, map {"PATH $_${meat}END_PATH $_\n"} 1 .. $paths;

unlink $dbName;
open my $fin, '<', \$fileStr;

my $startTick = time ();
run($fin, $dbName);
my $seconds = time () - $startTick;

print "Took $seconds for $paths paths\n";

sub run {
    my ($fin, $dbName) = @_;
    my $self     = bless {fin => $fin};
    my $dsn      = "DBI:SQLite:dbname=$dbName";
    my $userid   = "";
    my $password = "";

    $self->{dbh} = DBI->connect($dsn, $userid, $password, {RaiseError => 1})
        or die $DBI::errstr;

    my %dispatch = (
        VERSION => sub { },
        PTDEF   => sub { },
        BANNER  => \&banner,
        PATH    => \&path,
    );

    $self->{dbh}->do('BEGIN TRANSACTION;');
    while (defined (my $line = <$fin>)) {
        my ($key, $tail) = $line =~ /^(\w+)\s*(.*)/ or next;

        die "Parser doesn't understand $line" if !exists $dispatch{$key};
        $dispatch{$key}($self, $key, $tail);
    }
    $self->{dbh}->do('COMMIT TRANSACTION;');
}


sub banner {
    my ($self, $key, $tail) = @_;
    my $fin = $self->{fin};
    my @cols;
    my @values;

    while (defined (my $line = <$fin>)) {
        last if $line =~ /END_$key/;

        my ($key, $value) = $line =~ /\{([^}]+)\}/g or next;
        push @cols,   $key;
        push @values, $value;
    }

    $self->table_create('FileInfo', @cols);
    $self->insertRow('FileInfo', @values);
}


sub path {
    my ($self, $key, $tail) = @_;
    my $fin      = $self->{fin};
    my %dispatch = (
        REQ_CLC         => \&rasGate,
        SLK_CLC         => \&rasGate,
        ARR_CLC         => \&rasGate,
        LAUNCH_CLK_PATH => \&ldcGate,
        DATA_PATH       => \&ldcGate,
        CAP_CLK_PATH    => \&ldcGate,
    );

    $self->{pathNum} = $tail;
    print "Processing path $tail\n";

    while (defined (my $line = <$fin>)) {
        last if $line =~ /END_$key/;

        my ($key, $tail) = $line =~ /^\s+(\w+)\s*(.*)/ or next;
        warn "Parser doesn't understand $line", next if !exists $dispatch{$key};
        $dispatch{$key}($self, $key, $tail);
    }
}


sub rasGate {
    my ($self, $key, $tail) = @_;
    my $fin = $self->{fin};
    my @cols;
    my @values;
    my $rasToken;

    while (defined (my $line = <$fin>)) {
        last if $line =~ /END_$key/;

        my (undef, $key, $value) = $line =~ /\{([^}]+)\}/g or next;
        push @cols,   $key;
        push @values, $value;
    }

    $self->table_create($key, 'Path', @cols);
    $self->insertRow($key, $self->{pathNum}, @values);
}


sub ldcGate {
    my ($self, $key, $tail) = @_;
    my $fin      = $self->{fin};
    my %dispatch = (
        COLUMNS => \&ldcColumns,
        INST    => \&instLine,
        HPIN    => \&ldcLine,
        NET     => \&ldcLine,
        PORT    => \&ldcLine,
    );

    $self->{ldcKey} = $key;
    $self->{rows}   = [];

    while (defined (my $line = <$fin>)) {
        last if $line =~ /END_$key/;

        my ($key, $tail) = $line =~ /^\s*(\w+)\s*(.*)/ or next;
        die "Parser doesn't understand $line" if !exists $dispatch{$key};
        $dispatch{$key}($self, $key, $tail);
    }

    $self->{ldcSth}->execute($self->{pathNum}, @$_) for @{$self->{rows}};
}


sub ldcLine {
    my ($self, $key, $tail) = @_;

    push @{$self->{rows}},
        [map {defined ($_) ? $_ : ''} $tail =~ /\{([^}]*)\}/g];
}


sub instLine {
    my ($self, $key, $tail) = @_;
    my @values = map {defined ($_) ? $_ : ''} $tail =~ /\{([^}]*)\}/g;

    $values[-3] = "$values[-3]$values[-2]";
    splice @values, $#values - 1, 1;
    push @{$self->{rows}}, \@values;
}


sub ldcColumns {
    my ($self, $key, $tail) = @_;
    my @cols = $tail =~ /\{([^}]+)\}/g;

    $self->table_create($self->{ldcKey}, 'Path', @cols);

    my $places = join ', ', ('?') x @cols;
    my $stmt = qq(INSERT INTO '$self->{ldcKey}' VALUES(?, $places););

    $self->{ldcSth} = $self->{dbh}->prepare($stmt) or die $DBI::errstr;
}


sub table_create {
    my ($self, $tbname, @cols) = @_;
    my $columns = "'" . join ("', '", @cols) . "'";

    return if $self->{haveTable}{$tbname}++;

    my $sth = $self->{dbh}->prepare("CREATE TABLE $tbname ($columns)");
    my $rv = $sth->execute() or die $DBI::errstr;

    if ($rv < 0) {
        print $DBI::errstr;
    } else {
        #	print "Table $tbname created";
    }
}


sub insertRow {
    my ($self, $tbname, @data) = @_;
    my $places = join ', ', ('?') x @data;
    my $stmt   = qq(INSERT INTO $tbname VALUES($places););
    my $sth    = $self->{dbh}->prepare($stmt) or die $DBI::errstr;

    $sth->execute(@data) or die $DBI::errstr;
}