116 lines
3.4 KiB
Plaintext
116 lines
3.4 KiB
Plaintext
|
#!/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
|