Debugging and tests, why do we get "database locked" with sqlite?

diff --git a/lib/DBIx/Class/Journal.pm b/lib/DBIx/Class/Journal.pm
index 79c8e01..231f8ba 100644 (file)
--- a/lib/DBIx/Class/Journal.pm
+++ b/lib/DBIx/Class/Journal.pm
@@ -25,7 +25,9 @@ sub insert
         print STDERR "Schema: ", ref($self->result_source->schema), "\n";
         my $al = $self->result_source->schema->_journal_schema->resultset("${s_name}AuditLog");
         $al->create({
-            changeset => $self->result_source->schema->_journal_schema->current_changeset(),
+#            created => {
+#                changeset => $self->result_source->schema->_journal_schema->current_changeset(),
+#            },
         });
     }
 

diff --git a/lib/DBIx/Class/Schema/Journal.pm b/lib/DBIx/Class/Schema/Journal.pm
index 68d6786..ea342f2 100644 (file)
--- a/lib/DBIx/Class/Schema/Journal.pm
+++ b/lib/DBIx/Class/Schema/Journal.pm
@@ -11,6 +11,18 @@ __PACKAGE__->mk_classdata('journal_sources'); ## [ source names ]
 __PACKAGE__->mk_classdata('journal_user'); ## [ class, field for user id ]
 __PACKAGE__->mk_classdata('_journal_schema');
 
+sub throw_exception
+{
+}
+
+sub exception_action
+{
+    my $self = shift;
+    print STDERR Carp::longmess;
+    
+    $self->next::method(@_);
+}
+
 sub connection
 {
     my $self = shift;
@@ -92,8 +104,8 @@ sub txn_do
 
     ## Create a new changeset, then run $code as a transaction
     my $cs = $self->_journal_schema->resultset('ChangeSet');
-    my $changeset = $cs->create({
-        user_id => $self->_journal_schema->current_user(),
+    my $changeset = $cs->create({ ( $self->_journal_schema->current_user() ? ( user_id => $self->_journal_schema->current_user()) : () ),
+#        user_id => $self->_journal_schema->current_user(),
         session_id => $self->_journal_schema->current_session(),
     });
     $self->_journal_schema->current_changeset($changeset->ID);

diff --git a/lib/DBIx/Class/Schema/Journal/DB/AuditHistory.pm b/lib/DBIx/Class/Schema/Journal/DB/AuditHistory.pm
index dde946a..12898e1 100644 (file)
--- a/lib/DBIx/Class/Schema/Journal/DB/AuditHistory.pm
+++ b/lib/DBIx/Class/Schema/Journal/DB/AuditHistory.pm
@@ -14,8 +14,10 @@ sub new
 {
     my ($self, $data, @rest) = @_;
 
-    $data->{change} = {
-        changeset_id => $self->result_source->schema->_journal_schema->current_changeset,
+    $data->{change} = { 
+#        ID => \'DEFAULT',
+        changeset_id => $source->schema->current_changeset,
+        %{$data->{created}}, 
     };
 
     $self->next::method($data, @rest);

diff --git a/lib/DBIx/Class/Schema/Journal/DB/AuditLog.pm b/lib/DBIx/Class/Schema/Journal/DB/AuditLog.pm
index 9c82466..0d410a7 100644 (file)
--- a/lib/DBIx/Class/Schema/Journal/DB/AuditLog.pm
+++ b/lib/DBIx/Class/Schema/Journal/DB/AuditLog.pm
@@ -25,8 +25,10 @@ sub new
 {
     my ($self, $data, $source, @rest) = @_;
 
-    $data->{created} = {
+    $data->{created} = { 
+#        ID => \'DEFAULT',
         changeset_id => $source->schema->current_changeset,
+        %{$data->{created}}, 
     };
 
     $self->next::method($data, $source, @rest);

diff --git a/t/01test.t b/t/01test.t
index 3efaf6b..3ab112b 100644 (file)
--- a/t/01test.t
+++ b/t/01test.t
@@ -21,9 +21,12 @@ isa_ok($schema->_journal_schema->source('CDAuditHistory'), 'DBIx::Class::ResultS
 isa_ok($schema->_journal_schema->source('ArtistAuditLog'), 'DBIx::Class::ResultSource', 'ArtistAuditLog source exists');
 
 my $new_cd = $schema->txn_do( sub {
+    my $artist = $schema->resultset('Artist')->create({
+        name => 'Fred Bloggs',
+    });
     return  $schema->resultset('CD')->create({
         title => 'Angry young man',
-        artist => 0,
+        artist => $artist,
         year => 2000,
     });
 });

diff --git a/t/lib/DBICTest.pm b/t/lib/DBICTest.pm
index 97855cb..354d9c9 100644 (file)
--- a/t/lib/DBICTest.pm
+++ b/t/lib/DBICTest.pm
@@ -56,7 +56,7 @@ sub init_schema {
     my $dbpass = $ENV{"DBICTEST_DBPASS"} || '';
 
     my $schema = DBICTest::Schema->compose_connection('DBICTest' => $dsn, $dbuser, $dbpass);
-    $schema->storage->on_connect_do(['PRAGMA synchronous = OFF']);
+#    $schema->storage->on_connect_do(['PRAGMA synchronous = OFF']);
     if ( !$args{no_deploy} ) {
         __PACKAGE__->deploy_schema( $schema );
         __PACKAGE__->populate_schema( $schema ) if( !$args{no_populate} );