DBIx-Class-OptimisticLocking
view release on metacpan or search on metacpan
lib/DBIx/Class/OptimisticLocking.pm view on Meta::CPAN
package DBIx::Class::OptimisticLocking;
BEGIN {
$DBIx::Class::OptimisticLocking::VERSION = '0.02';
}
# ABSTRACT: Optimistic locking support for DBIx::Class
use strict;
use warnings;
use DBIx::Class 0.08195;
use base 'DBIx::Class';
use Carp qw(croak);
use List::Util qw(first);
__PACKAGE__->mk_classdata( optimistic_locking_strategy => 'dirty' );
__PACKAGE__->mk_classdata('optimistic_locking_ignore_columns');
__PACKAGE__->mk_classdata( optimistic_locking_version_column => 'version' );
my %valid_strategies = map { $_ => undef } qw(dirty all none version);
sub optimistic_locking_strategy {
my @args = @_;
my $class = shift(@args);
my ($strategy) = $args[0];
croak "invalid optimistic_locking_strategy $strategy" unless exists $valid_strategies{$strategy};
return $class->_opt_locking_strategy_accessor(@args);
}
sub update {
my $self = shift;
my $upd = shift;
# we have to do this ahead of time to make sure our WHERE
# clause is computed correctly
$self->set_inflated_columns($upd) if($upd);
# short-circuit if we're not changed
return $self if !$self->is_changed;
if ( $self->optimistic_locking_strategy eq 'version' ) {
# increment the version number but only if there are dirty
# columns that are not being ignored by the optimistic
# locking
my %dirty_columns = $self->get_dirty_columns;
delete(@dirty_columns{ @{ $self->optimistic_locking_ignore_columns || [] } });
if(%dirty_columns){
my $v_col = $self->optimistic_locking_version_column;
my $current_version = $self->{_column_data_in_storage}{$v_col};
$current_version = $self->get_column($v_col) || 0 if ! defined $current_version;
# increment the version
$self->set_column( $v_col, $current_version + 1);
}
}
my $return = $self->next::method();
return $return;
}
sub _track_storage_value {
my ( $self, $col ) = @_;
return 1 if $self->next::method($col);
my $mode = $self->optimistic_locking_strategy;
my $ignore_columns = $self->optimistic_locking_ignore_columns || [];
if ( $mode eq 'dirty' || $mode eq 'all' ) {
return !first { $col eq $_ } @$ignore_columns; # implicit return from do block
} elsif ( $mode eq 'version' ) {
return $col eq $self->optimistic_locking_version_column; # implicit return from do block
}
return 0;
}
sub _storage_ident_condition {
my $self = shift;
my $ident_condition = $self->next::method(@_);
# YUCK YUCK YUCK
my(undef,undef,undef,$caller) = caller(1);
( run in 1.145 second using v1.01-cache-2.11-cpan-39bf76dae61 )