#!/usr/bin/perl
use charnames ':full'; # only necessary before v5.16
use strict;
use v5.10;
use warnings;

use DBIx::SimpleConnect;
use Encode qw(:fallbacks encode);

binmode STDOUT, ":encoding(UTF-8)";

my $db = shift // "default";

my $dbh = DBIx::SimpleConnect->connect($db, {RaiseError => 1});

my $table_usage
    = $dbh->selectall_arrayref("
                select schemaname,
                       tablename,
                       pg_total_relation_size(quote_ident(schemaname) || '.' || quote_ident(tablename)) as s
                from pg_tables
                ",
                { Slice => {} }
            );
my $du;
for my $tu (@$table_usage) {
    $du->{$tu->{schemaname}}{".s"} += $tu->{s};
    $du->{$tu->{schemaname}}{$tu->{tablename}}{".s"} += $tu->{s};
    $du->{$tu->{schemaname}}{$tu->{tablename}}{".ts"} += $tu->{s};
}


my $index_usage
    = $dbh->selectall_arrayref("
                select schemaname,
                       tablename,
                       indexname,
                       pg_total_relation_size(quote_ident(schemaname) || '.' || quote_ident(indexname)) as s
                from pg_indexes
                ",
                { Slice => {} }
            );
for my $iu (@$index_usage) {
    $du->{$iu->{schemaname}}{".s"} += $iu->{s};
    $du->{$iu->{schemaname}}{$iu->{tablename}}{".s"} += $iu->{s};
    $du->{$iu->{schemaname}}{$iu->{tablename}}{$iu->{indexname}}{".s"} += $iu->{s};
}

say "<meta charset='utf-8'/>";
say "<style>";
say "    .num {";
say "        text-align: right;";
say "    }";
say "    .schema {";
say "        background-color: #CCCCCC;";
say "    }";
say "    .table {";
say "        background-color: #E5E5E5;";
say "    }";
say "</style>";

say "<table>";
for my $schema (sort { $du->{$b}{".s"} <=> $du->{$a}{".s"} }
                     keys %$du) {
    say "<tr class='schema'>";
    say "<td class='num'>", pretty($du->{$schema}{".s"}), "</td>";
    say "<td class='name'>", escape($schema), "</td>";

    for my $table (sort { $du->{$schema}{$b}{".s"} <=> $du->{$schema}{$a}{".s"} }
                        grep !/^\./,
                             keys %{$du->{$schema}}) {
        say "<tr class='table'>";
        say "<td class='num'>", pretty($du->{$schema}{$table}{".s"}), "</td>";
        say "<td class='empty'></td>";
        say "<td class='name'>", escape($table), "</td>";

        if ($du->{$schema}{$table}{".ts"} != $du->{$schema}{$table}{".s"}) {
            say "<tr class='table'>";
            say "<td class='num'>", pretty($du->{$schema}{$table}{".ts"}), "</td>";
            say "<td class='empty'></td>";
            say "<td class='empty'></td>";
            say "<td class='name'>", "(table)", "</td>";
        }

        for my $index (sort { $du->{$schema}{$table}{$b}{".s"} <=> $du->{$schema}{$table}{$a}{".s"} }
                            grep !/^\./,
                                 keys %{$du->{$schema}{$table}}) {
            say "<tr class='index'>";
            say "<td class='num'>", pretty($du->{$schema}{$table}{$index}{".s"}), "</td>";
            say "<td class='empty'></td>";
            say "<td class='empty'></td>";
            say "<td class='name'>", escape($index), "</td>";

        }
    }
}
say "</table>";

sub pretty {
    my ($n) = @_;

    while ($n =~ /[0-9]{4}/) {
        $n =~ s/([0-9]+)([0-9]{3})/$1\N{NARROW NO-BREAK SPACE}$2/;
    }
    return $n;
}

sub escape {
    my ($s) = @_;

    $s =~ s/[<>&'"]/sprintf("&#%d;", ord($1))/eg;
    return $s;
}

# vim: sw=4 tw=132 expandtab