PostgreSQL explicit locking support.

Squashed commit of the following:

commit 76e1539102
Author: Oliver Gorwits <oliver@cpan.org>
Date:   Wed May 15 23:54:25 2013 +0100

    finished explicit locking module

commit 369387258b
Author: Oliver Gorwits <oliver@cpan.org>
Date:   Tue May 14 23:50:42 2013 +0100

    initial implementation of locking from schema object

Netdisco/lib/App/Netdisco/DB.pm

@@ -17,7 +17,11 @@ 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;

Netdisco/lib/App/Netdisco/DB/ExplicitLocking.pm

@@ -0,0 +1,165 @@
+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) = @_;
+  my $sql_fmt = q{LOCK TABLE %s IN %%s MODE};
+  my $schema = $self;
+
+  if ($self->can('result_source')) {
+      # ResultSet component
+      $sub = $mode;
+      $mode = $table;
+      $table = $self->result_source->from;
+      $schema = $self->result_source->schema;
+  }
+
+  $schema->throw_exception('missing Table name to txn_do_locked()')
+    unless length $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) {
+      scalar grep {$_ eq $mode} values %lock_modes
+        or $schema->throw_exception('bad LOCK_MODE to txn_do_locked()');
+  }
+  else {
+      $sub = $mode;
+      $mode = 'ACCESS EXCLUSIVE';
+  }
+
+  $schema->txn_do(sub {
+      my @params = map {$schema->storage->dbh->quote_identifier($_)} @$table;
+      $schema->storage->dbh->do(sprintf $sql, @params, $mode);
+      $sub->();
+  });
+}
+
+=head1 NAME
+
+App::Netdisco::DB::ExplicitLocking - Support for PostgreSQL Lock Modes
+
+=head1 SYNOPSIS
+
+In your L<DBIx::Class> schema:
+
+ package My::Schema;
+ __PACKAGE__->load_components('+App::Netdisco::DB::ExplicitLocking');
+
+Then, in your application code:
+
+ use App::Netdisco::DB::ExplicitLocking ':modes';
+ $schema->txn_do_locked($table, MODE_NAME, sub { ... });
+
+This also works for the ResultSet:
+
+ package My::Schema::ResultSet::TableName;
+ __PACKAGE__->load_components('+App::Netdisco::DB::ExplicitLocking');
+
+Then, in your application code:
+
+ use App::Netdisco::DB::ExplicitLocking ':modes';
+ $schema->resultset('TableName')->txn_do_locked(MODE_NAME, sub { ... });
+
+=head1 DESCRIPTION
+
+This L<DBIx::Class> component provides an easy way to execute PostgreSQL table
+locks before a transaction block.
+
+You can load the component in either the Schema class or ResultSet class (or
+both) and then use an interface very similar to C<DBIx::Class>'s C<txn_do()>.
+
+The package also exports constants for each of the table lock modes supported
+by PostgreSQL, which must be used if specifying the mode (default mode is
+C<ACCESS EXCLUSIVE>).
+
+=head1 EXPORTS
+
+With the C<:modes> tag (as in SYNOPSIS above) the following constants are
+exported and must be used if specifying the lock mode:
+
+=over 4
+
+=item * C<ACCESS_SHARE>
+
+=item * C<ROW_SHARE>
+
+=item * C<ROW_EXCLUSIVE>
+
+=item * C<SHARE_UPDATE_EXCLUSIVE>
+
+=item * C<SHARE>
+
+=item * C<SHARE_ROW_EXCLUSIVE>
+
+=item * C<EXCLUSIVE>
+
+=item * C<ACCESS_EXCLUSIVE>
+
+=back
+
+=head1 METHODS
+
+=head2 C<< $schema->txn_do_locked($table|\@tables, MODE_NAME?, $subref) >>
+
+This is the method signature used when the component is loaded into your
+Schema class. The reason you might want to use this over the ResultSet version
+(below) is to specify multiple tables to be locked before the transaction.
+
+The first argument is one or more tables, and is required. Note that these are
+the real table names in PostgreSQL, and not C<DBIx::Class> ResultSet aliases
+or anything like that.
+
+The mode name is optional, and defaults to C<ACCESS EXCLUSIVE>. You must use
+one of the exported constants in this parameter.
+
+Finally pass a subroutine reference, just as you would to the normal
+C<DBIx::Class> C<txn_do()> method. Note that additional arguments are not
+supported.
+
+=head2 C<< $resultset->txn_do_locked(MODE_NAME?, $subref) >>
+
+This is the method signature used when the component is loaded into your
+ResultSet class. If you don't yet have a ResultSet class (which is the default
+- normally only Result classes are created) then you can create a stub which
+simply loads this component (and inherits from C<DBIx::Class::ResultSet>).
+
+This is the simplest way to use this module if you only want to lock one table
+before your transaction block.
+
+The first argument is the optional mode name, which defaults to C<ACCESS
+EXCLUSIVE>. You must use one of the exported constants in this parameter.
+
+The second argument is a subroutine reference, just as you would pass to the
+normal C<DBIx::Class> C<txn_do()> method. Note that additional arguments are
+not supported.
+
+=cut
+
+1;

Netdisco/lib/App/Netdisco/DB/ResultSet/Node.pm

@@ -4,6 +4,10 @@ use base 'DBIx::Class::ResultSet';
 use strict;
 use warnings FATAL => 'all';
 
+__PACKAGE__->load_components(qw/
+  +App::Netdisco::DB::ExplicitLocking
+/);
+
 =head1 search_by_mac( \%cond, \%attrs? )
 
  my $set = $rs->search_by_mac({mac => '00:11:22:33:44:55', active => 1});

Netdisco/lib/App/Netdisco/DB/ResultSet/NodeIp.pm

@@ -4,6 +4,10 @@ use base 'DBIx::Class::ResultSet';
 use strict;
 use warnings FATAL => 'all';
 
+__PACKAGE__->load_components(qw/
+  +App::Netdisco::DB::ExplicitLocking
+/);
+
 my $search_attr = {
     order_by => {'-desc' => 'time_last'},
     '+columns' => [

Netdisco/lib/App/Netdisco/DB/ResultSet/NodeWireless.pm

@@ -0,0 +1,11 @@
+package App::Netdisco::DB::ResultSet::DeviceModule;
+use base 'DBIx::Class::ResultSet';
+
+use strict;
+use warnings FATAL => 'all';
+
+__PACKAGE__->load_components(qw/
+  +App::Netdisco::DB::ExplicitLocking
+/);
+
+1;

Netdisco/lib/App/Netdisco/DB/ResultSet/Subnets.pm

@@ -0,0 +1,11 @@
+package App::Netdisco::DB::ResultSet::Subnets;
+use base 'DBIx::Class::ResultSet';
+
+use strict;
+use warnings FATAL => 'all';
+
+__PACKAGE__->load_components(qw/
+  +App::Netdisco::DB::ExplicitLocking
+/);
+
+1;