2015-09-10 11:33:22 +02:00
|
|
|
#!/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);
|
|
|
|
|
|
|
|
|
|
my $db = shift // "default";
|
|
|
|
|
|
|
|
|
|
my $dbh = DBIx::SimpleConnect->connect($db);
|
|
|
|
|
|
|
|
|
|
my $sth
|
|
|
|
|
= $dbh->prepare("
|
|
|
|
|
select locks_blocking.pid as blocking_pid,
|
|
|
|
|
query_blocking.query as blocking_query,
|
|
|
|
|
query_blocking.usename as blocking_username,
|
|
|
|
|
locks_blocked.pid as blocked_pid,
|
|
|
|
|
query_blocked.query as blocked_query,
|
|
|
|
|
query_blocked.usename as blocked_username
|
|
|
|
|
from pg_locks locks_blocked join pg_locks locks_blocking using (locktype, database, relation)
|
|
|
|
|
join pg_stat_activity query_blocked on (locks_blocked.pid=query_blocked.pid)
|
|
|
|
|
join pg_stat_activity query_blocking on (locks_blocking.pid = query_blocking.pid)
|
|
|
|
|
where locks_blocking.granted and not locks_blocked.granted
|
|
|
|
|
"
|
|
|
|
|
);
|
|
|
|
|
$sth->execute();
|
|
|
|
|
my $locks = $sth->fetchall_arrayref();
|
2015-09-10 11:58:52 +02:00
|
|
|
|
|
|
|
|
|
|
|
|
|
binmode STDOUT, ":encoding(UTF-8)";
|
|
|
|
|
say "<!DOCTYPE html";
|
|
|
|
|
say "<html>";
|
|
|
|
|
say "<head>";
|
|
|
|
|
say "<meta charset='UTF-8'/>";
|
|
|
|
|
say "</head>";
|
|
|
|
|
say "<body>";
|
|
|
|
|
|
2015-09-10 11:33:22 +02:00
|
|
|
if (@$locks) {
|
|
|
|
|
say "<table>";
|
|
|
|
|
say "<tr>";
|
|
|
|
|
say map {
|
|
|
|
|
"<th>" . xmlencode($_) . "</th>"
|
|
|
|
|
} @{$sth->{NAME}};
|
|
|
|
|
say "</tr>";
|
|
|
|
|
for my $lk (@$locks) {
|
|
|
|
|
say "<tr>";
|
|
|
|
|
say map {
|
|
|
|
|
"<td>"
|
|
|
|
|
. (defined($_) ? xmlencode($_) : '<em>NULL</em>')
|
|
|
|
|
. "</td>"
|
|
|
|
|
} @$lk;
|
|
|
|
|
say "</tr>";
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
say "</table>";
|
|
|
|
|
} else {
|
|
|
|
|
say "<p>No locks \N{WHITE SMILING FACE}</p>";
|
|
|
|
|
}
|
2015-09-10 11:58:52 +02:00
|
|
|
say "</body>";
|
|
|
|
|
say "</html>";
|
|
|
|
|
exit(0);
|
2015-09-10 11:33:22 +02:00
|
|
|
|
|
|
|
|
sub xmlencode {
|
|
|
|
|
my ($s) = @_;
|
|
|
|
|
return encode("us-ascii", $s, FB_XMLCREF);
|
|
|
|
|
}
|
|
|
|
|
|
