import and export users in GraphML

diff --git a/lib/Text/Tradition/Collation.pm b/lib/Text/Tradition/Collation.pm
index 465ef1e..5b3cd96 100644 (file)
--- a/lib/Text/Tradition/Collation.pm
+++ b/lib/Text/Tradition/Collation.pm
@@ -973,13 +973,23 @@ is( scalar $st->collation->readings, $READINGS, "Reparsed collation has all read
 is( scalar $st->collation->paths, $PATHS, "Reparsed collation has all paths" );
 is( scalar $st->collation->relationships, 3, "Reparsed collation has new relationships" );
 
-# Now add a stemma, write to GraphML, and parse again.
+# Now add a stemma, write to GraphML, and look at the output.
 my $stemma = $tradition->add_stemma( 'dotfile' => 't/data/florilegium.dot' );
 is( ref( $stemma ), 'Text::Tradition::Stemma', "Parsed dotfile into stemma" );
 is( $tradition->stemmata, 1, "Tradition now has the stemma" );
 $graphml = $c->as_graphml;
 like( $graphml, qr/digraph/, "Digraph declaration exists in GraphML" );
 
+# Now add a user, write to GraphML, and look at the output.
+unlike( $graphml, qr/testuser/, "Test user name does not exist in GraphML yet" );
+my $testuser = Text::Tradition::User->new( 
+       id => 'testuser', password => 'testpass' );
+is( ref( $testuser ), 'Text::Tradition::User', "Created test user object" );
+$testuser->add_tradition( $tradition );
+is( $tradition->user->id, $testuser->id, "Tradition assigned to test user" );
+$graphml = $c->as_graphml;
+like( $graphml, qr/testuser/, "Test user name now exists in GraphML" );
+
 =end testing
 
 =cut
@@ -1050,14 +1060,25 @@ sub as_graphml {
                next unless $save_types{$attr->type_constraint->name};
                $graph_attributes{$attr->name} = $save_types{$attr->type_constraint->name};
        }
-    # Extra custom key for the tradition stemma(ta)
-    $graph_attributes{'stemmata'} = 'string';
+    # Extra custom keys for complex objects that should be saved in some form.
+    # The subroutine should return a string, or undef/empty.
+    $graph_attributes{'stemmata'} = sub { 
+       my @stemstrs;
+               map { push( @stemstrs, $_->editable( {linesep => ''} ) ) } 
+                       $self->tradition->stemmata;
+               join( "\n", @stemstrs );
+       };
+    $graph_attributes{'user'} = sub { 
+       $self->tradition->user ? $self->tradition->user->id : undef 
+    };
        
     foreach my $datum ( sort keys %graph_attributes ) {
        $graph_data_keys{$datum} = 'dg'.$gdi++;
         my $key = $root->addNewChild( $graphml_ns, 'key' );
+        my $dtype = ref( $graph_attributes{$datum} ) ? 'string' 
+               : $graph_attributes{$datum};
         $key->setAttribute( 'attr.name', $datum );
-        $key->setAttribute( 'attr.type', $graph_attributes{$datum} );
+        $key->setAttribute( 'attr.type', $dtype );
         $key->setAttribute( 'for', 'graph' );
         $key->setAttribute( 'id', $graph_data_keys{$datum} );          
     }
@@ -1130,11 +1151,9 @@ sub as_graphml {
        my $value;
        if( $datum eq 'version' ) {
                $value = '3.2';
-       } elsif( $datum eq 'stemmata' ) {
-               my @stemstrs;
-               map { push( @stemstrs, $_->editable( {linesep => ''} ) ) } 
-                       $self->tradition->stemmata;
-               $value = join( "\n", @stemstrs );
+       } elsif( ref( $graph_attributes{$datum} ) ) {
+               my $sub = $graph_attributes{$datum};
+               $value = &$sub();
        } elsif( $gattr_from{$datum} eq 'Tradition' ) {
                $value = $self->tradition->$datum;
        } else {

diff --git a/lib/Text/Tradition/Parser/Self.pm b/lib/Text/Tradition/Parser/Self.pm
index 8483891..ae70531 100644 (file)
--- a/lib/Text/Tradition/Parser/Self.pm
+++ b/lib/Text/Tradition/Parser/Self.pm
@@ -3,6 +3,7 @@ package Text::Tradition::Parser::Self;
 use strict;
 use warnings;
 use Text::Tradition::Parser::GraphML qw/ graphml_parse /;
+use Text::Tradition::UserStore;
 use TryCatch;
 
 =head1 NAME
@@ -95,6 +96,8 @@ source of the XML to be parsed.
 
 =begin testing
 
+use File::Temp;
+use Test::Warn;
 use Text::Tradition;
 binmode STDOUT, ":utf8";
 binmode STDERR, ":utf8";
@@ -139,6 +142,28 @@ if( $newt ) {
     is( $newt->stemma(0)->witnesses, $t->stemma(0)->witnesses, "Stemma has correct length witness list" );
 }
 
+# Test user save / restore
+my $fh = File::Temp->new();
+my $file = $fh->filename;
+$fh->close;
+my $dsn = "dbi:SQLite:dbname=$file";
+my $userstore = Text::Tradition::UserStore->new( { dsn => $dsn,
+       extra_args => { create => 1 } } );
+my $scope = $userstore->new_scope();
+my $testuser = $userstore->add_user( { url => 'http://example.com' } );
+is( ref( $testuser ), 'Text::Tradition::User', "Created test user via userstore" );
+$testuser->add_tradition( $newt );
+is( $newt->user->id, $testuser->id, "Assigned tradition to test user" );
+$graphml_str = $newt->collation->as_graphml;
+my $usert;
+warning_is {
+       $usert = Text::Tradition->new( 'input' => 'Self', 'string' => $graphml_str );
+} 'DROPPING user assignment without a specified userstore',
+       "Got expected user drop warning on parse";
+$usert = Text::Tradition->new( 'input' => 'Self', 'string' => $graphml_str,
+       'userstore' => { 'dsn' => $dsn } );
+is( $usert->user->id, $testuser->id, "Parsed tradition with userstore points to correct user" );
+
 
 =end testing
 
@@ -163,10 +188,29 @@ sub parse {
                my $val = $graph_data->{'global'}->{$gkey};
                if( $gkey eq 'version' ) {
                        $use_version = $val;
-               } elsif( $gkey eq 'stemmata' ) { # Special case, yuck
+               } elsif( $gkey eq 'stemmata' ) {
+                       # Parse the stemmata into objects
                        foreach my $dotstr ( split( /\n/, $val ) ) {
                                $tradition->add_stemma( 'dot' => $dotstr );
                        }
+               } elsif( $gkey eq 'user' ) {
+                       # Assign the tradition to the user if we can
+                       if( exists $opts->{'userstore'} ) {
+                               my $userdir;
+                               try {
+                                       $userdir = Text::Tradition::UserStore->new( $opts->{'userstore'} );
+                               } catch {
+                                       warn( "Could not connect to specified user store; DROPPING user assignment" );
+                               }
+                               my $user = $userdir->find_user( { username => $val } );
+                               if( $user ) {
+                                       $user->add_tradition( $tradition );
+                               } else {
+                                       warn( "Found no user with ID $val; DROPPING user assignment" );
+                               }
+                       } else {
+                               warn( "DROPPING user assignment without a specified userstore" );
+                       }
                } elsif( $tmeta->has_attribute( $gkey ) ) {
                        $tradition->$gkey( $val );
                } else {

diff --git a/t/text_tradition_collation.t b/t/text_tradition_collation.t
index b0070d4..fc7abe1 100644 (file)
--- a/t/text_tradition_collation.t
+++ b/t/text_tradition_collation.t
@@ -85,12 +85,22 @@ is( scalar $st->collation->readings, $READINGS, "Reparsed collation has all read
 is( scalar $st->collation->paths, $PATHS, "Reparsed collation has all paths" );
 is( scalar $st->collation->relationships, 3, "Reparsed collation has new relationships" );
 
-# Now add a stemma, write to GraphML, and parse again.
+# Now add a stemma, write to GraphML, and look at the output.
 my $stemma = $tradition->add_stemma( 'dotfile' => 't/data/florilegium.dot' );
 is( ref( $stemma ), 'Text::Tradition::Stemma', "Parsed dotfile into stemma" );
 is( $tradition->stemmata, 1, "Tradition now has the stemma" );
 $graphml = $c->as_graphml;
 like( $graphml, qr/digraph/, "Digraph declaration exists in GraphML" );
+
+# Now add a user, write to GraphML, and look at the output.
+unlike( $graphml, qr/testuser/, "Test user name does not exist in GraphML yet" );
+my $testuser = Text::Tradition::User->new( 
+       id => 'testuser', password => 'testpass' );
+is( ref( $testuser ), 'Text::Tradition::User', "Created test user object" );
+$testuser->add_tradition( $tradition );
+is( $tradition->user->id, $testuser->id, "Tradition assigned to test user" );
+$graphml = $c->as_graphml;
+like( $graphml, qr/testuser/, "Test user name now exists in GraphML" );
 }
 
 

diff --git a/t/text_tradition_parser_self.t b/t/text_tradition_parser_self.t
index 0a1ec10..00c973d 100644 (file)
--- a/t/text_tradition_parser_self.t
+++ b/t/text_tradition_parser_self.t
@@ -8,6 +8,8 @@ $| = 1;
 
 # =begin testing
 {
+use File::Temp;
+use Test::Warn;
 use Text::Tradition;
 binmode STDOUT, ":utf8";
 binmode STDERR, ":utf8";
@@ -51,6 +53,28 @@ if( $newt ) {
     is( scalar $newt->stemmata, 1, "Tradition has its stemma" );
     is( $newt->stemma(0)->witnesses, $t->stemma(0)->witnesses, "Stemma has correct length witness list" );
 }
+
+# Test user save / restore
+my $fh = File::Temp->new();
+my $file = $fh->filename;
+$fh->close;
+my $dsn = "dbi:SQLite:dbname=$file";
+my $userstore = Text::Tradition::UserStore->new( { dsn => $dsn,
+       extra_args => { create => 1 } } );
+my $scope = $userstore->new_scope();
+my $testuser = $userstore->add_user( { url => 'http://example.com' } );
+is( ref( $testuser ), 'Text::Tradition::User', "Created test user via userstore" );
+$testuser->add_tradition( $newt );
+is( $newt->user->id, $testuser->id, "Assigned tradition to test user" );
+$graphml_str = $newt->collation->as_graphml;
+my $usert;
+warning_is {
+       $usert = Text::Tradition->new( 'input' => 'Self', 'string' => $graphml_str );
+} 'DROPPING user assignment without a specified userstore',
+       "Got expected user drop warning on parse";
+$usert = Text::Tradition->new( 'input' => 'Self', 'string' => $graphml_str,
+       'userstore' => { 'dsn' => $dsn } );
+is( $usert->user->id, $testuser->id, "Parsed tradition with userstore points to correct user" );
 }