Have you ever spent too much time rolling your own script to take some statistics from tables stored in files ?

Well, I go through this in a weekly basis, it always starts with something simple to do in a perl one-liner and quickly (d)evolves into a massive ball of nearly all tools in your $PATH.

The usual way to solve that for me is loading the files into a database and making my queries from there, it works great but importing and exporting the files takes too much time and finding a place on the server to load the database is another problem.

Scratch DB, is a thin layer around DBD::SQLite, that gives you a temporary database to load your text files as tables and query them with all SQL have, without the need for a server.

# creates a new db on db_file, or stores the database on RAM
$ perl sdb.pl [db_file]

# loads a file into a table, defaults to tab delimited fields
sdb> load file.txt [tablename [field_separator]]

sdb> *any SQL statement*

# writes the contents of table_x to filename
sdb> dump table_x [filename [field_separator]]
[download]

Also, thanks to DBD::SQLite, the database is stored all in RAM so it is quite fast, and no temporary files to mess with.

use strict;
use warnings;

use String::Escape qw( unprintable );
use Text::ParseWords;
use Term::ReadLine;
use File::Basename;
use Text::Table;
use Text::CSV;
use DBI;

my $db;
run(shift @ARGV || ':memory:');
exit(0);

sub run {
    my $dbfile = shift;
    $db = DBI->connect("dbi:SQLite:dbname=$dbfile", undef, undef, {
        sqlite_see_if_its_a_number => 1,
    });
    my $term = Term::ReadLine->new($0);
    $term->ornaments(0); # no fancy underline
    while(defined ($_ = $term->readline("sdb> "))) {
        next unless /\S/;
        s/^\s*//;
        
        if(/^quit/i) {
            last;
        }
        elsif(/^(load|dump)/i) {
            no strict 'refs';
            my ($method, @args) = shellwords($_);
            my $output = eval { &$method(@args) };
            warn $@ if $@;
            print "$output\n" if $output;
        }
        else {
            my $output = eval { sql_command($_) };
            warn $@ if $@;
            print "$output\n" if $output;
        }
    }
}

sub load {
    my $file = shift || die "usage: load <file> [<table> [<field_separ
+ator>]]\n";
    my ($table_name, undef, undef) = shift || fileparse($file, qr/\.[^
+.]*/);
    my $FS = unprintable(shift) || "\t";

    my $asv = Text::CSV->new({ binary => 1, sep_char => $FS});

    open my $fh, '<', $file or die "open [$file]: $!";
    my $table;
    push @$table, $asv->getline($fh) while(!eof $fh);
    my $n_col = scalar @{$table->[0]};

    $db->prepare("CREATE TABLE $table_name (".join(', ',map { "col".$_
+ }0..$n_col - 1).");")
        ->execute() or die $!;
    my $i = $db->prepare("INSERT INTO $table_name VALUES(".join(", ",(
+'?')x$n_col).");");
    
    for(@$table) {
        $i->execute(@$_) or die $!;
    }
    return @$table." row(s) loaded on table $table_name.";
}

sub dump {
    my $table = shift || die "usage: dump <table> [<file> [<field_sepa
+rator>]]\n";
    my $file = shift || $table;
    my $FS = unprintable(shift) || "\t";

    my $asv = Text::CSV->new({ binary => 1, sep_char => $FS, eol => $/
+});
    
    my $s = $db->prepare("SELECT * FROM $table") or die $!;

    open my $fh, '>', $file or die "open [$file]: $!";
    
    $s->execute() or die $!;
    while(my $row = $s->fetch) {
        $asv->print($fh, $row);
    }
    return $s->rows." row(s) written to file $file.";
}

sub sql_command {
    my ($str) = @_;
    my $s = $db->prepare($str) or die $!;
    $s->execute() or die $!;
    my $table;
    push @$table, [ map { defined $_ ? $_ : "undef" } @{$s->{'NAME'}} 
+];
    while(my $row = $s->fetch) {
        push @$table, [ map{ defined $_ ? $_ : "undef" }@$row ];
    }
    box_format($table);
    return $s->rows.' row(s) affected.';
}

sub box_format {
    my $table = shift;
    my $n_cols = scalar @{$table->[0]};

    my $tb = Text::Table->new(\'| ', '', (\' | ','')x($n_cols-1), \' |
+');
    $tb->load(@$table);
    my $rule = $tb->rule(qw/- +/);
    my @rows = $tb->body();
    print $rule, shift @rows, $rule, @rows, $rule
        if @rows;
}
[download]