Caching The Data Dictionary

Not this type of cash

In the last couple of posts I have talked about extracting table names using DBI->table_info() and extracting column names using DBI->column_info().

If for example I had a tetchy DBA who didn’t want me to hit the database every time I wanted this information, or I was too impatient to wait for socket set-up/teardown, I might consider caching the returned data.

In this case, the module I need is CHI, the unified cache handling interface.

Putting everything together with a basic command line interface gives me this script.

use strict;
use warnings;

use CHI;
use DBI;
use File::Basename;
use Getopt::Long;

use constant CACHE_EXPIRY => "1 day";

my $database = 'wordpress';
my $user = 'readonly_user';
my $password = '...';

my $dsn = "DBI:mysql:database=$database";
my $dbh = DBI->connect($dsn, $user, $password);

my $cache = CHI->new(driver => 'File',
                     root_dir => "$ENV{HOME}/.dbInfoCache");

my %args = parseArgs();
if (defined($args{help})) {
    usage();
} elsif (defined($args{names})) {
    print join("\n", @{getTables($dbh, $cache)}), "\n";
    exit 0;
}

my $tables;

if (defined($args{table})) {
    $tables = [$args{table}];
} elsif (defined($args{all})) {
    $tables = getTables($dbh, $cache);
} else {
    usage();
}

my $noPrefix = @$tables == 1;
foreach my $table (@$tables) {
    print join("\n", map { ($noPrefix ? '' : "$table." ) . $_ }
                     @{getColumns($dbh, $cache, $table)}), "\n\n";
}

sub parseArgs {
    my %args;
    GetOptions(\%args,
               "all",
               "help",
               "names|tablenames",
               "table=s",);
    return %args;
}

sub usage {
    my $script = basename($0);
    print <<"EOF"
$script -names | -all | -table <table name> | -help
-names : return the names of the tables only
-all   : return columns for all of the tables
-table : return columns for just this table
EOF
    ;
    exit 0;
}

sub getTables {
    my ($db, $cache) = @_;
    my $cacheKey = "tables";
    my $tables = $cache->get($cacheKey);
    # $tables will be undefined if the cache entry has expired or
    # never been set
    unless (defined $tables) {
        warn "Info: getting tables from DB\n";
        $tables = getTablesFromDb($db);
        # CHI->set($key, $value, $time) automatically serializes references
        $cache->set($cacheKey, $tables, CACHE_EXPIRY);
    }
    return $tables;
}

sub getTablesFromDb {
    my ($db) = @_;
    my $sth = $dbh->table_info();
    my @tables;
    while (defined(my $row = $sth->fetchrow_hashref())) {
        push @tables, $row->{TABLE_NAME};
    }
    return \@tables;
}

sub getColumns {
    my ($db, $cache, $table) = @_;
    my $cacheKey = "columns.$table";
    my $columns = $cache->get($cacheKey);
    # $columns will be undefined if the cache entry has expired or
    # never been set
    unless (defined $columns) {
        warn "Info: getting columns.$table from DB\n";
        $columns = getColumnsFromDb($db, $table);
        # CHI->set($key, $value, $time) automatically serializes references
        $cache->set($cacheKey, $columns, CACHE_EXPIRY);
    }
    return $columns;
}

sub getColumnsFromDb {
    my ($db, $table) = @_;
    my $sth = $dbh->column_info(undef, undef, $table, '%');
    $sth->execute();
    my @results;
    while (defined(my $row = $sth->fetchrow_hashref())) {
        push @results, $row->{COLUMN_NAME};
    }
    return \@results;
}