[Bast-commits] r5129 - in DBIx-Class-OptimisticLocking/1.000/trunk:
. lib/DBIx/Class t t/lib t/lib/OLTest/Schema t/var
bpphillips at dev.catalyst.perl.org
bpphillips at dev.catalyst.perl.org
Fri Nov 14 15:19:38 GMT 2008
Author: bpphillips
Date: 2008-11-14 15:19:38 +0000 (Fri, 14 Nov 2008)
New Revision: 5129
Added:
DBIx-Class-OptimisticLocking/1.000/trunk/t/05-version.t
DBIx-Class-OptimisticLocking/1.000/trunk/t/06-version-custom-column.t
DBIx-Class-OptimisticLocking/1.000/trunk/t/07-version-with-ignored.t
DBIx-Class-OptimisticLocking/1.000/trunk/t/perlcritic.t
DBIx-Class-OptimisticLocking/1.000/trunk/t/perlcriticrc
DBIx-Class-OptimisticLocking/1.000/trunk/t/var/.gitignore
Modified:
DBIx-Class-OptimisticLocking/1.000/trunk/.gitignore
DBIx-Class-OptimisticLocking/1.000/trunk/Makefile.PL
DBIx-Class-OptimisticLocking/1.000/trunk/lib/DBIx/Class/OptimisticLocking.pm
DBIx-Class-OptimisticLocking/1.000/trunk/t/lib/OLTest.pm
DBIx-Class-OptimisticLocking/1.000/trunk/t/lib/OLTest/Schema/TestVersion.pm
DBIx-Class-OptimisticLocking/1.000/trunk/t/lib/OLTest/Schema/TestVersionAlt.pm
DBIx-Class-OptimisticLocking/1.000/trunk/t/var/oltest.sql
Log:
finished unit tests
Modified: DBIx-Class-OptimisticLocking/1.000/trunk/.gitignore
===================================================================
--- DBIx-Class-OptimisticLocking/1.000/trunk/.gitignore 2008-11-14 09:46:00 UTC (rev 5128)
+++ DBIx-Class-OptimisticLocking/1.000/trunk/.gitignore 2008-11-14 15:19:38 UTC (rev 5129)
@@ -8,3 +8,4 @@
.lwpcookies
DBIx-Class-OptimisticLocking-*
cover_db
+*.sw?
Modified: DBIx-Class-OptimisticLocking/1.000/trunk/Makefile.PL
===================================================================
--- DBIx-Class-OptimisticLocking/1.000/trunk/Makefile.PL 2008-11-14 09:46:00 UTC (rev 5128)
+++ DBIx-Class-OptimisticLocking/1.000/trunk/Makefile.PL 2008-11-14 15:19:38 UTC (rev 5129)
@@ -3,18 +3,19 @@
use ExtUtils::MakeMaker;
WriteMakefile(
- NAME => 'DBIx::Class::OptimisticLocking',
- AUTHOR => 'Brian Phillips <bphillips at cpan.org>',
- VERSION_FROM => 'lib/DBIx/Class/OptimisticLocking.pm',
- ABSTRACT_FROM => 'lib/DBIx/Class/OptimisticLocking.pm',
- ($ExtUtils::MakeMaker::VERSION >= 6.3002
- ? ('LICENSE'=> 'perl')
- : ()),
- PL_FILES => {},
- PREREQ_PM => {
- 'Test::More' => 0,
- 'DBIx::Class' => 0,
+ NAME => 'DBIx::Class::OptimisticLocking',
+ AUTHOR => 'Brian Phillips <bphillips at cpan.org>',
+ VERSION_FROM => 'lib/DBIx/Class/OptimisticLocking.pm',
+ ABSTRACT_FROM => 'lib/DBIx/Class/OptimisticLocking.pm',
+ ( $ExtUtils::MakeMaker::VERSION >= 6.3002
+ ? ( 'LICENSE' => 'perl' )
+ : () ),
+ PL_FILES => {},
+ TESTS => [ 't/*.t', 't/*/*.t' ],
+ PREREQ_PM => {
+ 'Test::More' => 0,
+ 'DBIx::Class' => 0,
},
- dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
- clean => { FILES => 'DBIx-Class-OptimisticLocking-*' },
+ dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
+ clean => { FILES => 'DBIx-Class-OptimisticLocking-*' },
);
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-14 09:46:00 UTC (rev 5128)
+++ DBIx-Class-OptimisticLocking/1.000/trunk/lib/DBIx/Class/OptimisticLocking.pm 2008-11-14 15:19:38 UTC (rev 5129)
@@ -4,8 +4,8 @@
use strict;
use base 'DBIx::Class';
+use Carp qw(croak);
-
=head1 NAME
DBIx::Class::OptimisticLocking - Optimistic locking support for
@@ -88,6 +88,16 @@
__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 _get_original_columns {
my $self = shift;
my %columns = ( $self->get_columns, %{ $self->{_opt_locking_orig_values} || {} } );
@@ -117,23 +127,16 @@
=cut
sub set_column {
- my $self = shift;
- my ($column) = @_;
+ my @args = @_;
+ my $self = shift(@args);
+ my ($column) = $args[0];
- my $track_original_values = (
- (
- $self->optimistic_locking_strategy eq 'dirty'
- || $self->optimistic_locking_strategy 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){
+ if($self->optimistic_locking_strategy && !$self->is_column_changed($column)){
$self->{_opt_locking_orig_values}->{$column} = $self->get_column($column);
}
- return $self->next::method(@_);
+ return $self->next::method(@args);
}
=head2 update
@@ -201,9 +204,8 @@
$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 );
+ $ident_condition->{ $v_col } = $self->_get_original_column( $v_col );
} elsif ( $mode eq 'all' ) {
Added: DBIx-Class-OptimisticLocking/1.000/trunk/t/05-version.t
===================================================================
--- DBIx-Class-OptimisticLocking/1.000/trunk/t/05-version.t (rev 0)
+++ DBIx-Class-OptimisticLocking/1.000/trunk/t/05-version.t 2008-11-14 15:19:38 UTC (rev 5129)
@@ -0,0 +1,57 @@
+use strict;
+use warnings;
+use Test::More;
+
+
+BEGIN {
+ eval "use DBD::SQLite";
+ plan $@
+ ? ( skip_all => 'needs DBD::SQLite for testing' )
+ : ( tests => 11 );
+ $DBD::SQLite::sqlite_version; # get rid of warnings
+}
+
+use lib 't/lib';
+
+use_ok('DBIx::Class::OptimisticLocking');
+
+use_ok( 'OLTest' );
+
+use_ok( 'OLTest::Schema' );
+
+my $s = OLTest->init_schema();
+
+my $r1 = $s->resultset('TestVersion')->new({
+ col1 => 'a',
+ col2 => 'a',
+});
+$r1->insert;
+$r1->discard_changes;
+is($r1->version, 0, 'version at 0');
+
+my $r2 = $s->resultset('TestVersion')->find($r1->id);
+is($r1->id, $r2->id, 'retrieved identical object');
+
+$r1->col1('b');
+$r2->col2('c');
+$r1->update;
+$r1->discard_changes;
+
+is($r1->version, 1, 'version incremented');
+
+# fails because $r2's version is behind $r1's version
+eval {$r2->update};
+ok($@,'error expected, version mismatch');
+
+$r2 = $s->resultset('TestVersion')->find($r1->id);
+$r2->col2('d');
+$r2->update;
+$r2->discard_changes;
+is($r2->version, 2, 'version incremented');
+is($r2->col2,'d', 'update succeeded after refresh');
+
+$r1->col2('d');
+eval { $r1->update; };
+ok($@, 'error expected even on identical update because version did not match');
+$r1->discard_changes;
+is($r1->version, 2, 'version remains on error');
Added: DBIx-Class-OptimisticLocking/1.000/trunk/t/06-version-custom-column.t
===================================================================
--- DBIx-Class-OptimisticLocking/1.000/trunk/t/06-version-custom-column.t (rev 0)
+++ DBIx-Class-OptimisticLocking/1.000/trunk/t/06-version-custom-column.t 2008-11-14 15:19:38 UTC (rev 5129)
@@ -0,0 +1,36 @@
+use strict;
+use warnings;
+use Test::More;
+
+
+BEGIN {
+ eval "use DBD::SQLite";
+ plan $@
+ ? ( skip_all => 'needs DBD::SQLite for testing' )
+ : ( tests => 5 );
+ $DBD::SQLite::sqlite_version; # get rid of warnings
+}
+
+use lib 't/lib';
+
+use_ok('DBIx::Class::OptimisticLocking');
+
+use_ok( 'OLTest' );
+
+use_ok( 'OLTest::Schema' );
+
+my $s = OLTest->init_schema();
+
+my $r1 = $s->resultset('TestVersionAlt')->new({
+ col1 => 'a',
+ col2 => 'a',
+});
+$r1->insert;
+$r1->discard_changes;
+is($r1->myversion, 0, 'myversion at 0');
+
+$r1->col1('b');
+$r1->update;
+$r1->discard_changes;
+
+is($r1->myversion, 1, 'myversion incremented');
Added: DBIx-Class-OptimisticLocking/1.000/trunk/t/07-version-with-ignored.t
===================================================================
--- DBIx-Class-OptimisticLocking/1.000/trunk/t/07-version-with-ignored.t (rev 0)
+++ DBIx-Class-OptimisticLocking/1.000/trunk/t/07-version-with-ignored.t 2008-11-14 15:19:38 UTC (rev 5129)
@@ -0,0 +1,48 @@
+use strict;
+use warnings;
+use Test::More;
+
+
+BEGIN {
+ eval "use DBD::SQLite";
+ plan $@
+ ? ( skip_all => 'needs DBD::SQLite for testing' )
+ : ( tests => 7 );
+ $DBD::SQLite::sqlite_version; # get rid of warnings
+}
+
+use lib 't/lib';
+
+use_ok('DBIx::Class::OptimisticLocking');
+
+use_ok( 'OLTest' );
+
+use_ok( 'OLTest::Schema' );
+
+my $s = OLTest->init_schema();
+
+my $r1 = $s->resultset('TestVersionIgnored')->new({
+ col1 => 'a',
+ col2 => 'a',
+});
+$r1->insert;
+$r1->discard_changes;
+is($r1->version, 0, 'myversion at 0');
+
+$r1->col1('b');
+$r1->update;
+$r1->discard_changes;
+
+is($r1->version, 1, 'version incremented');
+
+$r1->col2('c');
+$r1->update;
+
+$r1->discard_changes;
+
+is($r1->version, 1, 'version not incremented when only ignored column is updated');
+
+$r1->update({col1=>'d', col2=>'e'});
+
+$r1->discard_changes;
+is($r1->version, 2, 'version incremented when columns updated are mixed between ignored and non-ignored');
Modified: DBIx-Class-OptimisticLocking/1.000/trunk/t/lib/OLTest/Schema/TestVersion.pm
===================================================================
--- DBIx-Class-OptimisticLocking/1.000/trunk/t/lib/OLTest/Schema/TestVersion.pm 2008-11-14 09:46:00 UTC (rev 5128)
+++ DBIx-Class-OptimisticLocking/1.000/trunk/t/lib/OLTest/Schema/TestVersion.pm 2008-11-14 15:19:38 UTC (rev 5129)
@@ -5,7 +5,7 @@
use base qw/DBIx::Class/;
__PACKAGE__->load_components(qw/ OptimisticLocking PK::Auto Core /);
__PACKAGE__->table('test_version');
-__PACKAGE__->add_columns( qw/ id col1 version / );
+__PACKAGE__->add_columns( qw/ id col1 col2 version / );
__PACKAGE__->set_primary_key('id');
__PACKAGE__->optimistic_locking_strategy('version');
Modified: DBIx-Class-OptimisticLocking/1.000/trunk/t/lib/OLTest/Schema/TestVersionAlt.pm
===================================================================
--- DBIx-Class-OptimisticLocking/1.000/trunk/t/lib/OLTest/Schema/TestVersionAlt.pm 2008-11-14 09:46:00 UTC (rev 5128)
+++ DBIx-Class-OptimisticLocking/1.000/trunk/t/lib/OLTest/Schema/TestVersionAlt.pm 2008-11-14 15:19:38 UTC (rev 5129)
@@ -5,7 +5,7 @@
use base qw/DBIx::Class/;
__PACKAGE__->load_components(qw/ OptimisticLocking PK::Auto Core /);
__PACKAGE__->table('test_version_alt');
-__PACKAGE__->add_columns( qw/ id col1 myversion / );
+__PACKAGE__->add_columns( qw/ id col1 col2 myversion / );
__PACKAGE__->set_primary_key('id');
__PACKAGE__->optimistic_locking_strategy('version');
Modified: DBIx-Class-OptimisticLocking/1.000/trunk/t/lib/OLTest.pm
===================================================================
--- DBIx-Class-OptimisticLocking/1.000/trunk/t/lib/OLTest.pm 2008-11-14 09:46:00 UTC (rev 5128)
+++ DBIx-Class-OptimisticLocking/1.000/trunk/t/lib/OLTest.pm 2008-11-14 15:19:38 UTC (rev 5129)
@@ -4,6 +4,11 @@
use strict;
use warnings;
+use File::Spec;
+use Cwd qw(abs_path);
+
+my ($vol, $dir, $file) = File::Spec->splitpath(abs_path(__FILE__));
+
# much of this is ripped directly from DBIx::Class::VirtualColumns (thanks for the jumpstart!)
sub init_schema {
my $self = shift;
@@ -14,14 +19,14 @@
if ( $args{compose_connection} ) {
$schema =
OLTest::Schema->compose_connection( 'OLTest',
- "dbi:SQLite:t/var/oltest.db", "", "", { AutoCommit => 1 } );
+ "dbi:SQLite:$dir/../var/oltest.db", "", "", { AutoCommit => 1 } );
}
else {
$schema = OLTest::Schema->compose_namespace('OLTest');
}
if ( !$args{no_connect} ) {
$schema =
- $schema->connect( "dbi:SQLite:t/var/oltest.db", "", "", { AutoCommit => 1 } );
+ $schema->connect( "dbi:SQLite:$dir/../var/oltest.db", "", "", { AutoCommit => 1 } );
$schema->storage->on_connect_do( ['PRAGMA synchronous = OFF'] );
}
unless ( $args{no_deploy} ) {
@@ -38,7 +43,7 @@
return $schema->deploy();
}
else {
- open IN, "t/var/oltest.sql";
+ open IN, "$dir/../var/oltest.sql";
my $sql;
{ local $/ = undef; $sql = <IN>; }
close IN;
Added: DBIx-Class-OptimisticLocking/1.000/trunk/t/perlcritic.t
===================================================================
--- DBIx-Class-OptimisticLocking/1.000/trunk/t/perlcritic.t (rev 0)
+++ DBIx-Class-OptimisticLocking/1.000/trunk/t/perlcritic.t 2008-11-14 15:19:38 UTC (rev 5129)
@@ -0,0 +1,22 @@
+use strict;
+use warnings;
+use File::Spec;
+use Test::More;
+use English qw(-no_match_vars);
+
+if ( not $ENV{TEST_AUTHOR} ) {
+ my $msg = 'Author test. Set $ENV{TEST_AUTHOR} to a true value to run.';
+ plan( skip_all => $msg );
+}
+
+eval { require Test::Perl::Critic; };
+
+if ($EVAL_ERROR) {
+ my $msg = 'Test::Perl::Critic required to criticise code';
+ plan( skip_all => $msg );
+}
+
+my $rcfile = File::Spec->catfile( 't', 'perlcriticrc' );
+Test::Perl::Critic->import( -profile => $rcfile );
+all_critic_ok();
+
Added: DBIx-Class-OptimisticLocking/1.000/trunk/t/perlcriticrc
===================================================================
--- DBIx-Class-OptimisticLocking/1.000/trunk/t/perlcriticrc (rev 0)
+++ DBIx-Class-OptimisticLocking/1.000/trunk/t/perlcriticrc 2008-11-14 15:19:38 UTC (rev 5129)
@@ -0,0 +1 @@
+severity = 3
Added: DBIx-Class-OptimisticLocking/1.000/trunk/t/var/.gitignore
===================================================================
--- DBIx-Class-OptimisticLocking/1.000/trunk/t/var/.gitignore (rev 0)
+++ DBIx-Class-OptimisticLocking/1.000/trunk/t/var/.gitignore 2008-11-14 15:19:38 UTC (rev 5129)
@@ -0,0 +1 @@
+oltest.db
Modified: DBIx-Class-OptimisticLocking/1.000/trunk/t/var/oltest.sql
===================================================================
--- DBIx-Class-OptimisticLocking/1.000/trunk/t/var/oltest.sql 2008-11-14 09:46:00 UTC (rev 5128)
+++ DBIx-Class-OptimisticLocking/1.000/trunk/t/var/oltest.sql 2008-11-14 15:19:38 UTC (rev 5129)
@@ -33,17 +33,19 @@
CREATE TABLE test_version (
id INTEGER PRIMARY KEY AUTOINCREMENT,
col1 TEXT NOT NULL,
- version INTEGER NOT NULL
+ col2 TEXT NOT NULL,
+ version INTEGER NOT NULL default 0
);
CREATE TABLE test_version_ignored (
id INTEGER PRIMARY KEY AUTOINCREMENT,
col1 TEXT NOT NULL,
col2 TEXT NOT NULL,
- version INTEGER NOT NULL
+ version INTEGER NOT NULL default 0
);
CREATE TABLE test_version_alt (
id INTEGER PRIMARY KEY AUTOINCREMENT,
col1 TEXT NOT NULL,
- myversion INTEGER NOT NULL
+ col2 TEXT NOT NULL,
+ myversion INTEGER NOT NULL default 0
);
COMMIT;
More information about the Bast-commits
mailing list