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 )