[Bast-commits] r5122 - DBIx-Class-OptimisticLocking/1.000/trunk/lib/DBIx/Class

bpphillips at dev.catalyst.perl.org bpphillips at dev.catalyst.perl.org
Thu Nov 13 22:00:55 GMT 2008


Author: bpphillips
Date: 2008-11-13 22:00:55 +0000 (Thu, 13 Nov 2008)
New Revision: 5122

Modified:
   DBIx-Class-OptimisticLocking/1.000/trunk/lib/DBIx/Class/OptimisticLocking.pm
Log:
first round for committing

no tests yet but fairly feature complete (I think) and with docs!

Modified: DBIx-Class-OptimisticLocking/1.000/trunk/lib/DBIx/Class/OptimisticLocking.pm
===================================================================
--- DBIx-Class-OptimisticLocking/1.000/trunk/lib/DBIx/Class/OptimisticLocking.pm	2008-11-13 22:00:45 UTC (rev 5121)
+++ DBIx-Class-OptimisticLocking/1.000/trunk/lib/DBIx/Class/OptimisticLocking.pm	2008-11-13 22:00:55 UTC (rev 5122)
@@ -3,9 +3,13 @@
 use warnings;
 use strict;
 
+use base 'DBIx::Class';
+
+
 =head1 NAME
 
-DBIx::Class::OptimisticLocking - The great new DBIx::Class::OptimisticLocking!
+DBIx::Class::OptimisticLocking - Optimistic locking support for
+DBIx::Class
 
 =head1 VERSION
 
@@ -15,39 +19,187 @@
 
 our $VERSION = '0.01';
 
-
 =head1 SYNOPSIS
 
-Quick summary of what the module does.
+This module allows the user to utilize optimistic locking when updating
+a row.
 
-Perhaps a little code snippet.
+Example usage:
 
-    use DBIx::Class::OptimisticLocking;
+	package My::Class;
 
-    my $foo = DBIx::Class::OptimisticLocking->new();
-    ...
+	use base qw/DBIx::Class/;
 
-=head1 EXPORT
+	__PACKAGE__->load_components(qw/OptimisticLocking Core/);
 
-A list of functions that can be exported.  You can delete this section
-if you don't export anything, such as for a purely object-oriented module.
+=head1 CONFIGURATION
 
-=head1 FUNCTIONS
+=head2 optimistic_locking_mode
 
-=head2 function1
+This configuration controls the main functionality of this component.
+The current recognized optimistic locking modes supported are:
 
+=over 4
+
+=item * dirty
+
+When issuing an update, the C<WHERE> clause of the update will include
+all of the original values of the columns that are being updated.
+Any columns that are not being updated will be ignored.
+
+=item * version
+
+When issuing an update, the C<WHERE> clause of the update will include
+a check of the C<version> column (or otherwise configured column using
+L<optimistic_locking_version_column>).  The C<version> column will also
+be incremented on each update as well.
+
+=item * all
+
+When issuing an update, the C<WHERE> clause of the update will include
+a check on each column in the object regardless of whether they were
+updated or not.
+
+=item * none (or any other value)
+
+This turns off the functionality of this component.  But why would you
+load it if you don't need it? :-)
+
+=back
+
+=head2 optimistic_locking_insignificant_dirty_columns
+
+Occassionally you may elect to ignore certain columns that are not
+significant enough to detect colisions and cause the update to fail.
+For instance, if you have a timestamp column, you may want to add
+that to this list so that it is ignored when generating the C<UPDATE>
+where clause for the update.
+
+=head2 optimistic_locking_version_column
+
+If you are using 'version' as your L<optimistic_locking_mode>, you can
+optionally specify a different name for the column used for version
+tracking.  If an alternate name is not passed, the component will look
+for a column named C<version>.
+
 =cut
 
-sub function1 {
+__PACKAGE__->mk_classdata(optimistic_locking_mode => 'dirty');
+__PACKAGE__->mk_classdata('optimistic_locking_insignificant_dirty_columns');
+__PACKAGE__->mk_classdata(optimistic_locking_version_column => 'version');
+
+=head1 METHODS
+
+=head2 get_original_columns
+
+Corresponds to L<DBIx::Class::Row/get_columns> except that the values
+returned reflect the original state of the object.
+
+=cut
+
+
+sub get_original_columns {
+	my $self = shift;
+	my %columns = ( $self->get_columns, %{ $self->{_opt_locking_orig_values} || {} } );
+	return %columns;
 }
 
-=head2 function2
+=head2 get_original_column
 
+Corresponds to L<DBIx::Class::Row/get_column> except that the value
+returned reflects the original state of the object.
+
 =cut
 
-sub function2 {
+sub get_original_column {
+	my $self = shift;
+	my $column = shift;
+	my %columns = $self->get_original_columns;
+	return exists $columns{$column} ? $columns{$column} : ();
 }
 
+sub set_column {
+	my $self = shift;
+	my ($column) = @_;
+
+    my $track_original_values = (
+        (
+                 $self->optimistic_locking_mode eq 'dirty'
+              || $self->optimistic_locking_mode eq 'all'
+        )
+        && !$self->is_column_changed($column)
+    );
+
+	# save off the original if this is the first time the column has been changed
+	if($track_original_values){
+
+            $self->{_opt_locking_orig_values}->{$column} = $self->get_column($column);
+	}
+	return $self->next::method(@_);
+}
+
+
+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_mode eq 'version' ) {
+        my $v_col = $self->optimistic_locking_version_column;
+
+        # increment the version
+        $self->set_column( $v_col, $self->get_original_column($v_col) + 1 );
+    }
+
+	# DBIx::Class::Row::update looks at this value, we'll precompute it
+	# here to make sure it has all the elements we need (kind of a hack)
+	$self->{_orig_ident} = $self->_optimistic_locking_ident_condition;
+
+	my $return = $self->next::method(@_);
+
+	# flush the original values cache
+	undef $self->{_opt_locking_orig_values};
+
+	return $return;
+}
+
+sub _optimistic_locking_ident_condition {
+	my $self = shift;
+	my $ident_condition = $self->{_orig_ident} || $self->ident_condition;
+	my $mode = $self->optimistic_locking_mode;
+
+	# also check to see if this column is considered insignificant (default behavior: every column is significant)
+	my $insignificant = $self->optimistic_locking_insignificant_dirty_columns || [];
+	
+	# also check to see if this column is considered insignificant (default behavior: every column is significant)
+	my $insignificant = $self->optimistic_locking_insignificant_dirty_columns || [];
+		
+	if ( $mode eq 'dirty' ) {
+
+        my %orig = %{$self->{_opt_locking_orig_values} || {}};
+		delete($orig{$_}) foreach(@$insignificant);
+        $ident_condition = {%orig, %$ident_condition };
+
+	} elsif ( $mode eq 'version' ) {
+
+		my $v_col = $self->optimistic_locking_version_column;
+		$ident_condition->{ $v_col } = $self->get_column( $v_col );
+
+	} elsif ( $mode eq 'all' ) {
+
+		$ident_condition = { $self->get_original_columns, %$ident_condition };
+
+	}
+
+	return $ident_condition;
+}
+
 =head1 AUTHOR
 
 Brian Phillips, C<< <bphillips at cpan.org> >>
@@ -58,9 +210,6 @@
 the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=DBIx-Class-OptimisticLocking>.  I will be notified, and then you'll
 automatically be notified of progress on your bug as I make changes.
 
-
-
-
 =head1 SUPPORT
 
 You can find documentation for this module with the perldoc command.




More information about the Bast-commits mailing list