2016-03-01 15:29:10 +01:00
|
|
|
#!/usr/bin/perl
|
|
|
|
use charnames ':full'; # only necessary before v5.16
|
|
|
|
use strict;
|
|
|
|
use v5.10;
|
|
|
|
use warnings;
|
2016-03-08 10:24:02 +01:00
|
|
|
use autodie;
|
|
|
|
use experimental qw(autoderef);
|
2016-03-01 15:29:10 +01:00
|
|
|
|
|
|
|
use DBIx::SimpleConnect;
|
|
|
|
use Encode qw(:fallbacks encode);
|
2016-03-08 10:24:02 +01:00
|
|
|
use Getopt::Long;
|
|
|
|
use Pod::Usage;
|
2016-03-01 15:29:10 +01:00
|
|
|
|
2016-03-08 10:24:02 +01:00
|
|
|
my $db = "default";
|
|
|
|
my $dir = ".";
|
2016-03-01 15:29:10 +01:00
|
|
|
|
2016-03-08 10:24:02 +01:00
|
|
|
GetOptions(
|
|
|
|
'dbname=s' => \$db,
|
|
|
|
'directory=s' => \$dir,
|
|
|
|
) or pod2usage(1);
|
2016-03-01 15:29:10 +01:00
|
|
|
|
2016-03-08 10:24:02 +01:00
|
|
|
binmode STDOUT, ":encoding(UTF-8)";
|
2016-03-01 15:29:10 +01:00
|
|
|
|
2016-03-08 10:24:02 +01:00
|
|
|
{
|
|
|
|
no autodie;
|
|
|
|
unless (chdir($dir)) {
|
|
|
|
# if at first we don't succeed ...
|
|
|
|
mkdir $dir or die "cannot create $dir: $!";
|
|
|
|
chdir $dir or die "cannot chdir to $dir: $!";
|
|
|
|
}
|
2016-03-01 15:29:10 +01:00
|
|
|
}
|
|
|
|
|
2016-03-08 10:24:02 +01:00
|
|
|
my $dbh = DBIx::SimpleConnect->connect($db, {RaiseError => 1});
|
2016-03-01 15:29:10 +01:00
|
|
|
|
2016-03-08 10:24:02 +01:00
|
|
|
my $overview
|
|
|
|
= $dbh->selectall_hashref("
|
|
|
|
select schemaname, tablename,
|
|
|
|
sum(pg_total_relation_size(quote_ident(schemaname) || '.' || quote_ident(tablename))) as total_size,
|
|
|
|
sum(pg_table_size(quote_ident(schemaname) || '.' || quote_ident(tablename))) as table_size,
|
|
|
|
sum(pg_indexes_size(quote_ident(schemaname) || '.' || quote_ident(tablename))) as indexes_size
|
|
|
|
from pg_tables
|
|
|
|
group by rollup (schemaname, tablename)
|
2016-03-01 15:29:10 +01:00
|
|
|
",
|
2016-03-08 10:24:02 +01:00
|
|
|
['schemaname', 'tablename']
|
2016-03-01 15:29:10 +01:00
|
|
|
);
|
|
|
|
|
2016-03-08 10:24:02 +01:00
|
|
|
open(my $fh, ">:encoding(UTF-8)", "index.html.$$");
|
|
|
|
print_header($fh);
|
|
|
|
say $fh "<table>";
|
|
|
|
say $fh "<tr class='header'>";
|
|
|
|
say $fh "<th class='name'>", "Schema", "</th>";
|
|
|
|
say $fh "<th class='name'>", "Table", "</th>";
|
|
|
|
say $fh "<th class='num'>", "Total size (bytes)", "</th>";
|
|
|
|
say $fh "<th class='num'>", "Table size (bytes)", "</th>";
|
|
|
|
say $fh "<th class='num'>", "Indexes size (bytes)", "</th>";
|
|
|
|
say $fh "</tr>";
|
|
|
|
|
|
|
|
for my $s (sort { $overview->{$b}{''}{total_size} <=> $overview->{$a}{''}{total_size} } keys $overview) {
|
|
|
|
|
|
|
|
say $fh "<tr class='schema'>";
|
|
|
|
say $fh "<td class='name'>", escape($s), "</td>";
|
|
|
|
say $fh "<td class='name'>", '', "</td>";
|
|
|
|
say $fh "<td class='num'>", pretty($overview->{$s}{''}{total_size}), "</td>";
|
|
|
|
say $fh "<td class='num'>", pretty($overview->{$s}{''}{table_size}), "</td>";
|
|
|
|
say $fh "<td class='num'>", pretty($overview->{$s}{''}{indexes_size}), "</td>";
|
|
|
|
say $fh "</tr>";
|
|
|
|
|
|
|
|
for my $t (sort { $overview->{$s}{$b}{total_size} <=> $overview->{$s}{$a}{total_size} } keys $overview->{$s}) {
|
|
|
|
next unless $t; # schema - we already have that
|
|
|
|
|
|
|
|
say $fh "<tr class='table'>";
|
|
|
|
say $fh "<td class='name'>", escape($s), "</td>";
|
|
|
|
say $fh "<td class='name'>", escape($t), "</td>";
|
|
|
|
say $fh "<td class='num'>", pretty($overview->{$s}{$t}{total_size}), "</td>";
|
|
|
|
say $fh "<td class='num'>", pretty($overview->{$s}{$t}{table_size}), "</td>";
|
|
|
|
say $fh "<td class='num'>", pretty($overview->{$s}{$t}{indexes_size}), "</td>";
|
|
|
|
say $fh "</tr>";
|
2016-03-01 15:29:10 +01:00
|
|
|
}
|
|
|
|
}
|
2016-03-08 10:24:02 +01:00
|
|
|
say $fh "</table>";
|
|
|
|
close($fh);
|
|
|
|
rename "index.html.$$", "index.html";
|
|
|
|
exit(0);
|
|
|
|
|
2016-03-01 15:29:10 +01:00
|
|
|
|
|
|
|
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;
|
|
|
|
}
|
|
|
|
|
2016-03-08 10:24:02 +01:00
|
|
|
sub print_header {
|
|
|
|
my ($fh) = @_;
|
|
|
|
|
|
|
|
say $fh "<meta charset='utf-8'/>";
|
|
|
|
say $fh "<style>";
|
|
|
|
say $fh " .num {";
|
|
|
|
say $fh " text-align: right;";
|
|
|
|
say $fh " }";
|
|
|
|
say $fh " .schema {";
|
|
|
|
say $fh " background-color: #CCCCCC;";
|
|
|
|
say $fh " }";
|
|
|
|
say $fh " .table {";
|
|
|
|
say $fh " background-color: #E5E5E5;";
|
|
|
|
say $fh " }";
|
|
|
|
say $fh "</style>";
|
|
|
|
}
|
|
|
|
|
2016-03-01 15:29:10 +01:00
|
|
|
# vim: sw=4 tw=132 expandtab
|