final fixes for live reference objects as opposed to the clones which were being...

Conflicts:

	lib/Text/Tradition/Directory.pm
	lib/Text/Tradition/Parser/Self.pm

diff --git a/lib/Text/Tradition/Directory.pm b/lib/Text/Tradition/Directory.pm
index 311088a..51a4b89 100644 (file)
--- a/lib/Text/Tradition/Directory.pm
+++ b/lib/Text/Tradition/Directory.pm
@@ -12,7 +12,9 @@ use Text::Tradition::Error;
 
 ## users
 use KiokuX::User::Util qw(crypt_password);
+use Text::Tradition::Store;
 use Text::Tradition::User;
+use Text::Tradition::TypeMap::Entry;
 
 extends 'KiokuX::Model';
 
@@ -189,10 +191,20 @@ has +typemap => (
   default => sub {
     KiokuDB::TypeMap->new(
       isa_entries => {
+       # now that we fall back to YAML deflation, all attributes of
+       # Text::Tradition will be serialized to YAML as individual objects
+       # Except if we declare a specific entry type here
         "Text::Tradition" =>
-          Text::Tradition::TypeMap::Entry->new(),
-        "Graph" => Text::Tradition::TypeMap::Entry->new(),
-        "Graph::AdjacencyMap" => Text::Tradition::TypeMap::Entry->new(),
+          KiokuDB::TypeMap::Entry::MOP->new(),
+       # We need users to be naive entries so that they hold
+       # references to the original tradition objects, not clones
+        "Text::Tradition::User" =>
+          KiokuDB::TypeMap::Entry::MOP->new(),
+        "Text::Tradition::Collation" =>
+          KiokuDB::TypeMap::Entry::MOP->new(),
+        "Text::Tradition::Witness" =>
+          KiokuDB::TypeMap::Entry::MOP->new(),
+        "Graph" => Text::Tradition::TypeMap::Entry->new()
         "Set::Scalar" => Text::Tradition::TypeMap::Entry->new(),
       }
     );
@@ -209,22 +221,34 @@ around BUILDARGS => sub {
        } else {
                $args = { @_ };
        }
+       my @column_args;
        if( $args->{'dsn'} =~ /^dbi/ ) { # We're using Backend::DBI
-               my @column_args = ( 'columns',
+               @column_args = ( 'columns',
                        [ 'name' => { 'data_type' => 'varchar', 'is_nullable' => 1 } ] );
-               my $ea = $args->{'extra_args'};
-               if( ref( $ea ) eq 'ARRAY' ) {
-                       push( @$ea, @column_args );
-               } elsif( ref( $ea ) eq 'HASH' ) {
-                       $ea = { %$ea, @column_args };
-               } else {
-                       $ea = { @column_args };
-               }
-               $args->{'extra_args'} = $ea;
        }
+       my $ea = $args->{'extra_args'};
+       if( ref( $ea ) eq 'ARRAY' ) {
+               push( @$ea, @column_args );
+       } elsif( ref( $ea ) eq 'HASH' ) {
+               $ea = { %$ea, @column_args };
+       } else {
+               $ea = { @column_args };
+       }
+       $args->{'extra_args'} = $ea;
+
        return $class->$orig( $args );
 };
 
+override _build_directory => sub {
+  my($self) = @_;
+  Text::Tradition::Store->connect(@{ $self->_connect_args },
+    resolver_constructor => sub {
+      my($class) = @_;
+      $class->new({ typemap => $self->directory->merged_typemap,
+                    fallback_entry => Text::Tradition::TypeMap::Entry->new() });
+  });
+};
+
 ## These checks don't cover store($id, $obj)
 # before [ qw/ store update insert delete / ] => sub {
 before [ qw/ delete / ] => sub {

diff --git a/lib/Text/Tradition/Parser/Self.pm b/lib/Text/Tradition/Parser/Self.pm
index 51c49aa..92ec2a1 100644 (file)
--- a/lib/Text/Tradition/Parser/Self.pm
+++ b/lib/Text/Tradition/Parser/Self.pm
@@ -229,13 +229,13 @@ sub parse {
        # If it is the start or end node, we already have one, so
        # grab the rank and go.
         if( defined $n->{'is_start'} ) {
-         warn Data::Dump::dump($n);
-         warn $collation->start->id;
+#        warn Data::Dump::dump($n);
+#        warn $collation->start->id;
          $collation->start->rank($n->{'rank'});
           next;
         }
        if( defined $n->{'is_end'} ) {
-         warn Data::Dump::dump($n);
+#        warn Data::Dump::dump($n);
                $collation->end->rank( $n->{'rank'} );
                next;
        }

diff --git a/lib/Text/Tradition/Store.pm b/lib/Text/Tradition/Store.pm
new file mode 100644 (file)
index 0000000..39c31ae
--- /dev/null
+++ b/lib/Text/Tradition/Store.pm
@@ -0,0 +1,19 @@
+package Text::Tradition::Store;
+use Moose;
+use Class::Load ();
+extends 'KiokuDB';
+
+has resolver_class =>
+  ( is => 'rw', isa => 'Str', default => 'KiokuDB::TypeMap::Resolver' );
+has resolver_constructor =>
+  ( is => 'rw', isa => 'Str|CodeRef', default => 'new' );
+
+override _build_typemap_resolver => sub {
+  my ($self) = @_;
+  my $rclass = $self->resolver_class;
+  Class::Load::load_class($rclass);
+  my $meth = $self->resolver_constructor;
+  return $rclass->$meth;
+};
+
+1;

diff --git a/lib/Text/Tradition/TypeMap/Entry.pm b/lib/Text/Tradition/TypeMap/Entry.pm
index 00cdfd1..50dfb51 100644 (file)
--- a/lib/Text/Tradition/TypeMap/Entry.pm
+++ b/lib/Text/Tradition/TypeMap/Entry.pm
@@ -16,7 +16,6 @@ sub compile_collapse_body {
         my ( $self, %args ) = @_;
 
         my $object = $args{object};
-
         return $self->make_entry(
             %args,
             data => YAML::XS::Dump($object)
@@ -29,9 +28,9 @@ sub compile_expand {
 
     return sub {
         my ( $self, $entry ) = @_;
-        $self->inflate_data( YAML::XS::Load($entry->data), \( my $obj ), $entry );
-
+       $self->inflate_data( YAML::XS::Load($entry->data), \(my $obj), $entry );
         bless $obj, $class;
+       return $obj;
     };
 }
 

diff --git a/t/load-save-speed.t b/t/load-save-speed.t
index 57aa714..ad4bf53 100644 (file)
--- a/t/load-save-speed.t
+++ b/t/load-save-speed.t
@@ -11,6 +11,7 @@ use File::Path 'mkpath';
 use Text::Tradition;
 use Text::Tradition::Directory;
 use Test::More;
+use Test::Memory::Cycle;
 
 ## Don't run this test when running make test or prove, to run it use perl -Ilib t/load-save-speed.t
 
@@ -28,7 +29,7 @@ my $test_name = 'besoin';
 my $benchmark_file = 't/data/load-save-benchmark.json';
 
 ## SQL file (previously dumped KiokuDB) for testing tradition directory loading:
-my $load_sql = 't/data/speed_test_load.sql';
+# my $load_sql = 't/data/speed_test_load.sql';
 
 ## uuid to load from the above stored db:
 my $load_uuid = 'load-test';
@@ -61,12 +62,13 @@ $tradition->add_stemma(dotfile => "t/data/${test_name}.dot");
 #$fh->close;
 ## use t/var so you can look at the results after if neccessary:
 
-my $load_db = 't/var/speed_test_load.db';
-unlink($load_db) if(-e $load_db);
-my $load_dsn = "dbi:SQLite:dbname=$load_db";
+#my $load_db = 't/var/speed_test_load.db';
+#unlink($load_db) if(-e $load_db);
+#my $load_dsn = "dbi:SQLite:dbname=$load_db";
 ## Prime db from .sql file:
 ## ?? fails
-`sqlite3 $load_db < $load_sql`;
+
+#`sqlite3 $load_db < $load_sql`;
 
 my $save_db = 't/var/speed_test_save.db';
 unlink($save_db) if(-e $save_db);
@@ -85,21 +87,20 @@ my $test_save = sub {
     my $scope = $dir->new_scope;
 
     ## save the tradition (with stemma) to the db:
-    my $uuid = $dir->save($tradition);
+    $dir->save($load_uuid => $tradition);
 #    print STDERR "UUID: $uuid\n";
 
 };
 
-my $load_tradition;
 my $test_load = sub {
     my $dir = Text::Tradition::Directory->new(
-        dsn => $load_dsn,
+        dsn => $save_dsn,
     );
 
     ## This seems to be a required magic incantation:
     my $scope = $dir->new_scope;
-
-    $load_tradition = $dir->tradition($load_uuid);
+    my $t = $dir->tradition($load_uuid);
+    return $t;
 #    print STDERR $load_tradition->name, $tradition->name, "\n";
 };
 
@@ -112,24 +113,24 @@ if(!$last_benchmark) {
 }
 
 
-## Benchmark current code:
-## Should probably run the test the same number of times as the last time it ran
-## Or compare results more sanely
+# Benchmark current code:
+# Should probably run the test the same number of times as the last time it ran
+# Or compare results more sanely
 my $new_save_result = timethis(5, $test_save);
 
 my $new_save = $new_save_result->[1] + $new_save_result->[2];
-use Data::Dump;
+#use Data::Dump;
 
 my $old_save = $last_benchmark->{save_times}[1] + $last_benchmark->{save_times}[2];
 ok( $new_save < $old_save, "Saving to a Tradition Directory got faster: $new_save vs $old_save");
 
-my $new_load_result = timethis(20, $test_load);
+my $new_load_result = timethis(5, $test_load);
 
 my $new_load = $new_load_result->[1] + $new_load_result->[2];
 my $old_load = $last_benchmark->{load_times}[1] + $last_benchmark->{load_times}[2];
 ok($new_load < $old_load, "Loading from a Tradition Directory got faster: $new_load vs $old_load");
 
-$test_load->();
+my $load_tradition = $test_load->();
 isa_ok($load_tradition, 'Text::Tradition');
 ok($load_tradition->collation->as_svg());
 
@@ -144,7 +145,7 @@ if($git_hash) {
     save_benchmark($benchmark_file, $benchmark_data);
 }
 
-## -----------------------------------------------------------------------------
+# -----------------------------------------------------------------------------
 
 sub load_benchmark {
     my ($filename) = @_;