From 9ee81d8cd856bbcf6a4fdfb96029a98c50b3cdd7 Mon Sep 17 00:00:00 2001
From: "Peter J. Holzer" <hjp@hjp.at>
Date: Thu, 10 Sep 2015 11:33:22 +0200
Subject: [PATCH] 1st draft of report on locks.

---
 reports/locks | 56 +++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 56 insertions(+)
 create mode 100755 reports/locks

diff --git a/reports/locks b/reports/locks
new file mode 100755
index 0000000..a6d8d27
--- /dev/null
+++ b/reports/locks
@@ -0,0 +1,56 @@
+#!/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();
+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>";
+}
+
+sub xmlencode {
+    my ($s) = @_;
+    return encode("us-ascii", $s, FB_XMLCREF);
+}
+