From 369387258b4058bb7d10c591dcfe44845bfcd83e Mon Sep 17 00:00:00 2001
From: Oliver Gorwits <oliver@cpan.org>
Date: Tue, 14 May 2013 23:50:42 +0100
Subject: [PATCH] initial implementation of locking from schema object

---
 Netdisco/lib/App/Netdisco/DB.pm               |  5 +-
 .../lib/App/Netdisco/DB/ExplicitLocking.pm    | 50 +++++++++++++++++++
 2 files changed, 54 insertions(+), 1 deletion(-)
 create mode 100644 Netdisco/lib/App/Netdisco/DB/ExplicitLocking.pm

diff --git a/Netdisco/lib/App/Netdisco/DB.pm b/Netdisco/lib/App/Netdisco/DB.pm
index 63881db0..7636ad03 100644
--- a/Netdisco/lib/App/Netdisco/DB.pm
+++ b/Netdisco/lib/App/Netdisco/DB.pm
@@ -17,7 +17,10 @@ my (undef, $libpath, undef) = fileparse( $INC{ 'App/Netdisco/DB.pm' } );
 our $schema_versions_dir = Path::Class::Dir->new($libpath)
   ->subdir("DB", "schema_versions")->stringify;
 
-__PACKAGE__->load_components(qw/Schema::Versioned/);
+__PACKAGE__->load_components(qw/
+  Schema::Versioned
+  +App::Netdisco::DB::ExplicitLocking
+/);
 __PACKAGE__->upgrade_directory($schema_versions_dir);
 
 1;
diff --git a/Netdisco/lib/App/Netdisco/DB/ExplicitLocking.pm b/Netdisco/lib/App/Netdisco/DB/ExplicitLocking.pm
new file mode 100644
index 00000000..875159eb
--- /dev/null
+++ b/Netdisco/lib/App/Netdisco/DB/ExplicitLocking.pm
@@ -0,0 +1,50 @@
+package App::Netdisco::DB::ExplicitLocking;
+
+use strict;
+use warnings FATAL => 'all';
+
+our %lock_modes;
+
+BEGIN {
+  %lock_modes = (
+    ACCESS_SHARE => 'ACCESS SHARE',
+    ROW_SHARE => 'ROW SHARE',
+    ROW_EXCLUSIVE => 'ROW EXCLUSIVE',
+    SHARE_UPDATE_EXCLUSIVE => 'SHARE UPDATE EXCLUSIVE',
+    SHARE => 'SHARE',
+    SHARE_ROW_EXCLUSIVE => 'SHARE ROW EXCLUSIVE',
+    EXCLUSIVE => 'EXCLUSIVE',
+    ACCESS_EXCLUSIVE => 'ACCESS EXCLUSIVE',
+  );
+}
+
+use constant \%lock_modes;
+
+use base 'Exporter';
+our @EXPORT = ();
+our @EXPORT_OK = (keys %lock_modes);
+our %EXPORT_TAGS = (modes => \@EXPORT_OK);
+
+sub txn_do_locked {
+  my ($self, $table, $mode, $sub, @rest) = @_;
+  my $sql_fmt = q{LOCK TABLE %s IN %%s MODE};
+
+  return unless $table;
+  $table = [$table] if ref '' eq ref $table;
+  my $table_fmt = join ', ', ('%s' x scalar @$table);
+  my $sql = sprintf $sql_fmt, $table_fmt;
+
+  if (!length $mode) {
+      unshift @rest, $sub if $sub;
+      $sub = $mode;
+      $mode = 'ACCESS EXCLUSIVE';
+  }
+
+  $self->txn_do(sub {
+      my @params = map {$self->storage->dbh->quote_identifier($_)} @$table;
+      $self->storage->dbh->do(sprintf $sql, @params, $mode);
+      $sub->(@rest);
+  });
+}
+
+1;