view release on metacpan or  search on metacpan

lib/App/Netdisco/DB/ExplicitLocking.pm  view on Meta::CPAN

package App::Netdisco::DB::ExplicitLocking;

use strict;
use warnings;

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 $table;

  $table = [$table] if ref '' eq ref $table;
  my $table_fmt = join ', ', ('%s' x scalar @$table);
  my $sql = sprintf $sql_fmt, $table_fmt;

  if (ref '' eq ref $mode and $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>