From: Tara L Andrews Date: Sat, 14 Jul 2012 18:33:35 +0000 (+0200) Subject: import and export users in GraphML X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=scpubgit%2Fstemmatology.git;a=commitdiff_plain;h=9fef629bd3a741a6d74d130f10056898d504fb47;hp=f7ff202ce1b5c064d0851ad8338e0c1802e988ce import and export users in GraphML --- diff --git a/lib/Text/Tradition/Collation.pm b/lib/Text/Tradition/Collation.pm index 465ef1e..5b3cd96 100644 --- 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 --- 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 --- 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 --- 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" ); }