[scpubgit/stemmatology.git] / base / lib / Text / Tradition / Parser / Self.pm

package Text::Tradition::Parser::Self;

use strict;
use warnings;
use Text::Tradition::Parser::GraphML qw/ graphml_parse /;
use TryCatch;

=head1 NAME

Text::Tradition::Parser::GraphML

=head1 SYNOPSIS

  use Text::Tradition;
  
  my $t_from_file = Text::Tradition->new( 
    'name' => 'my text',
    'input' => 'Self',
    'file' => '/path/to/tradition.xml'
    );
    
  my $t_from_string = Text::Tradition->new( 
    'name' => 'my text',
    'input' => 'Self',
    'string' => $tradition_xml,
    );

=head1 DESCRIPTION

Parser module for Text::Tradition to read in its own GraphML output format.
GraphML is a relatively simple graph description language; a 'graph' element
can have 'node' and 'edge' elements, and each of these can have simple 'data'
elements for attributes to be saved.

The graph itself has attributes as in the Collation object:

=over

=item * linear 

=item * ac_label

=item * baselabel

=item * wit_list_separator

=back

The node objects have the following attributes:

=over

=item * name

=item * reading

=item * identical

=item * rank

=item * class

=back

The edge objects have the following attributes:

=over

=item * class

=item * witness (for 'path' class edges)

=item * extra   (for 'path' class edges)

=item * relationship    (for 'relationship' class edges)

=item * equal_rank      (for 'relationship' class edges)

=item * non_correctable (for 'relationship' class edges)

=item * non_independent (for 'relationship' class edges)

=back

=head1 METHODS

=head2 B<parse>

parse( $graph, $opts );

Takes an initialized Text::Tradition object and a set of options; creates
the appropriate nodes and edges on the graph.  The options hash should
include either a 'file' argument or a 'string' argument, depending on the
source of the XML to be parsed.

=begin testing

use File::Temp;
use Safe::Isa;
use Test::Warn;
use Text::Tradition;
use Text::Tradition::Directory;
use TryCatch;
binmode STDOUT, ":utf8";
binmode STDERR, ":utf8";
eval { no warnings; binmode $DB::OUT, ":utf8"; };

my $tradition = 't/data/florilegium_graphml.xml';
my $t = Text::Tradition->new( 
    'name'  => 'inline', 
    'input' => 'Self',
    'file'  => $tradition,
    );

ok( $t->$_isa('Text::Tradition'), "Parsed GraphML version 2" );
if( $t ) {
    is( scalar $t->collation->readings, 319, "Collation has all readings" );
    is( scalar $t->collation->paths, 376, "Collation has all paths" );
    is( scalar $t->witnesses, 13, "Collation has all witnesses" );
}

# TODO add a relationship, add a stemma, write graphml, reparse it, check that 
# the new data is there
$t->language('Greek');
my $stemma_enabled = $t->can('add_stemma');
if( $stemma_enabled ) {
	$t->add_stemma( 'dotfile' => 't/data/florilegium.dot' );
}
$t->collation->add_relationship( 'w12', 'w13', 
	{ 'type' => 'grammatical', 'scope' => 'global', 
	  'annotation' => 'This is some note' } );
ok( $t->collation->get_relationship( 'w12', 'w13' ), "Relationship set" );
my $graphml_str = $t->collation->as_graphml;

my $newt = Text::Tradition->new( 'input' => 'Self', 'string' => $graphml_str );
ok( $newt->$_isa('Text::Tradition'), "Parsed current GraphML version" );
if( $newt ) {
    is( scalar $newt->collation->readings, 319, "Collation has all readings" );
    is( scalar $newt->collation->paths, 376, "Collation has all paths" );
    is( scalar $newt->witnesses, 13, "Collation has all witnesses" );
    is( scalar $newt->collation->relationships, 1, "Collation has added relationship" );
    is( $newt->language, 'Greek', "Tradition has correct language setting" );
    my $rel = $newt->collation->get_relationship( 'w12', 'w13' );
    ok( $rel, "Found set relationship" );
    is( $rel->annotation, 'This is some note', "Relationship has its properties" );
    if( $stemma_enabled ) {
	    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::Directory->new( { dsn => $dsn,
	extra_args => { create => 1 } } );
my $scope = $userstore->new_scope();
my $testuser = $userstore->create_user( { url => 'http://example.com' } );
ok( $testuser->$_isa('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' => $userstore );
is( $usert->user->id, $testuser->id, "Parsed tradition with userstore points to correct user" );

# Test warning if we can
unless( $stemma_enabled ) {
	my $nst;
	warnings_exist {
		$nst = Text::Tradition->new( 'input' => 'Self', 'file' => 't/data/lexformat.xml' );
	} [qr/DROPPING stemmata/],
		"Got expected stemma drop warning on parse";
}

=end testing

=cut
use Data::Dump;
sub parse {
    my( $tradition, $opts ) = @_;
    
    # Collation data is in the first graph; relationship-specific stuff 
    # is in the second.
    my( $graph_data, $rel_data ) = graphml_parse( $opts );

    my $collation = $tradition->collation;
    my %witnesses;
    
    # print STDERR "Setting graph globals\n";
    $tradition->name( $graph_data->{'name'} );

    my $use_version;
    my $tmeta = $tradition->meta;
    my $cmeta = $collation->meta;
    foreach my $gkey ( keys %{$graph_data->{'global'}} ) {
		my $val = $graph_data->{'global'}->{$gkey};
		if( $gkey eq 'version' ) {
			$use_version = $val;
		} elsif( $gkey eq 'stemmata' ) {
			# Make sure we can handle stemmata
			# Parse the stemmata into objects
			if( $tradition->can('add_stemma') ) {
				foreach my $dotstr ( split( /\n/, $val ) ) {
					$tradition->add_stemma( 'dot' => $dotstr );
				}
			} else {
				warn "Analysis module not installed; DROPPING stemmata";
			}
		} elsif( $gkey eq 'user' ) {
			# Assign the tradition to the user if we can
			if( exists $opts->{'userstore'} ) {
				my $userdir = delete $opts->{'userstore'};
				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 {
			$collation->$gkey( $val );
		}
	}
		
    # Add the nodes to the graph.
    # Note any reading IDs that were changed in order to comply with XML 
    # name restrictions; we have to hardcode start & end.
    my %namechange = ( '#START#' => '__START__', '#END#' => '__END__' );

    # print STDERR "Adding collation readings\n";
    foreach my $n ( @{$graph_data->{'nodes'}} ) {    	
    	# If it is the start or end node, we already have one, so
    	# grab the rank and go.
        if( defined $n->{'is_start'} ) {
			$collation->start->rank($n->{'rank'});
			next;
        }
    	if( defined $n->{'is_end'} ) {
    		$collation->end->rank( $n->{'rank'} );
    		next;
    	}
		my $gnode = $collation->add_reading( $n );
		if( $gnode->id ne $n->{'id'} ) {
			$namechange{$n->{'id'}} = $gnode->id;
		}
    }
        
    # Now add the edges.
    # print STDERR "Adding collation path edges\n";
    foreach my $e ( @{$graph_data->{'edges'}} ) {
    	my $sourceid = exists $namechange{$e->{'source'}->{'id'}}
    		? $namechange{$e->{'source'}->{'id'}} : $e->{'source'}->{'id'};
    	my $targetid = exists $namechange{$e->{'target'}->{'id'}}
    		? $namechange{$e->{'target'}->{'id'}} : $e->{'target'}->{'id'};
        my $from = $collation->reading( $sourceid );
        my $to = $collation->reading( $targetid );

		warn "No witness label on path edge!" unless $e->{'witness'};
		my $label = $e->{'witness'} . ( $e->{'extra'} ? $collation->ac_label : '' );
		$collation->add_path( $from, $to, $label );
		
		# Add the witness if we don't have it already.
		unless( $witnesses{$e->{'witness'}} ) {
			$tradition->add_witness( 
				sigil => $e->{'witness'}, 'sourcetype' => 'collation' );
			$witnesses{$e->{'witness'}} = 1;
		}
		$tradition->witness( $e->{'witness'} )->is_layered( 1 ) if $e->{'extra'};
    }
    
    ## Done with the main graph, now look at the relationships.
	# Nodes are added via the call to add_reading above.  We only need
	# add the relationships themselves.
	# TODO check that scoping does trt
	$rel_data->{'edges'} ||= []; # so that the next line doesn't break on no rels
	foreach my $e ( sort { _layersort_rel( $a, $b ) } @{$rel_data->{'edges'}} ) {
    	my $sourceid = exists $namechange{$e->{'source'}->{'id'}}
    		? $namechange{$e->{'source'}->{'id'}} : $e->{'source'}->{'id'};
    	my $targetid = exists $namechange{$e->{'target'}->{'id'}}
    		? $namechange{$e->{'target'}->{'id'}} : $e->{'target'}->{'id'};
        my $from = $collation->reading( $sourceid );
        my $to = $collation->reading( $targetid );
		delete $e->{'source'};
		delete $e->{'target'};
		# The remaining keys are relationship attributes.
		# Backward compatibility...
		if( $use_version eq '2.0' || $use_version eq '3.0' ) {
			delete $e->{'class'};
			$e->{'type'} = delete $e->{'relationship'} if exists $e->{'relationship'};
		}
		# Add the specified relationship unless we already have done.
		my $rel_exists;
		if( $e->{'scope'} ne 'local' ) {
			my $relobj = $collation->get_relationship( $from, $to );
			if( $relobj && $relobj->scope eq $e->{'scope'}
				&& $relobj->type eq $e->{'type'} ) {
				$rel_exists = 1;
			}
		}
		try {
			$collation->add_relationship( $from, $to, $e ) unless $rel_exists;
		} catch( Text::Tradition::Error $e ) {
			warn "DROPPING $from -> $to: " . $e->message;
		}
	}
	
    # Save the text for each witness so that we can ensure consistency
    # later on
	$collation->text_from_paths();	
}

## Return the relationship that comes first in priority.
my %LAYERS = (
	'collated' => 1,
	'orthographic' => 2,
	'spelling' => 3,
	);

sub _layersort_rel {
	my( $a, $b ) = @_;
	my $key = exists $a->{'type'} ? 'type' : 'relationship';
	my $at = $LAYERS{$a->{$key}} || 99;
	my $bt = $LAYERS{$b->{$key}} || 99;
	return $at <=> $bt;
}

1;

=head1 BUGS / TODO

=over

=item * Make this into a stream parser with GraphML

=item * Simply field -> attribute correspondence for nodes and edges

=item * Share key name constants with Collation.pm

=back

=head1 LICENSE

This package is free software and is provided "as is" without express
or implied warranty.  You can redistribute it and/or modify it under
the same terms as Perl itself.

=head1 AUTHOR

Tara L Andrews E<lt>aurum@cpan.orgE<gt>
Commit	Line	Data
32014ec9	1	package Text::Tradition::Parser::Self;
	2
	3	use strict;
	4	use warnings;
1f7aa795	5	use Text::Tradition::Parser::GraphML qw/ graphml_parse /;
00c5bf0b	6	use TryCatch;
32014ec9	7
	8	=head1 NAME
	9
	10	Text::Tradition::Parser::GraphML
	11
e867486f	12	=head1 SYNOPSIS
	13
	14	use Text::Tradition;
	15
	16	my $t_from_file = Text::Tradition->new(
	17	'name' => 'my text',
	18	'input' => 'Self',
	19	'file' => '/path/to/tradition.xml'
	20	);
	21
	22	my $t_from_string = Text::Tradition->new(
	23	'name' => 'my text',
	24	'input' => 'Self',
	25	'string' => $tradition_xml,
	26	);
	27
32014ec9	28	=head1 DESCRIPTION
	29
	30	Parser module for Text::Tradition to read in its own GraphML output format.
e867486f	31	GraphML is a relatively simple graph description language; a 'graph' element
	32	can have 'node' and 'edge' elements, and each of these can have simple 'data'
	33	elements for attributes to be saved.
32014ec9	34
e867486f	35	The graph itself has attributes as in the Collation object:
	36
	37	=over
	38
	39	=item * linear
	40
	41	=item * ac_label
	42
	43	=item * baselabel
	44
	45	=item * wit_list_separator
	46
	47	=back
	48
	49	The node objects have the following attributes:
32014ec9	50
	51	=over
	52
e867486f	53	=item * name
	54
	55	=item * reading
	56
	57	=item * identical
	58
	59	=item * rank
	60
	61	=item * class
	62
	63	=back
	64
	65	The edge objects have the following attributes:
	66
	67	=over
	68
	69	=item * class
	70
	71	=item * witness (for 'path' class edges)
	72
	73	=item * extra (for 'path' class edges)
	74
	75	=item * relationship (for 'relationship' class edges)
	76
	77	=item * equal_rank (for 'relationship' class edges)
32014ec9	78
e867486f	79	=item * non_correctable (for 'relationship' class edges)
32014ec9	80
e867486f	81	=item * non_independent (for 'relationship' class edges)
	82
	83	=back
	84
	85	=head1 METHODS
	86
	87	=head2 B<parse>
	88
	89	parse( $graph, $opts );
	90
	91	Takes an initialized Text::Tradition object and a set of options; creates
	92	the appropriate nodes and edges on the graph. The options hash should
	93	include either a 'file' argument or a 'string' argument, depending on the
	94	source of the XML to be parsed.
	95
	96	=begin testing
	97
9fef629b	98	use File::Temp;
951ddfe8	99	use Safe::Isa;
9fef629b	100	use Test::Warn;
e867486f	101	use Text::Tradition;
a445ce40	102	use Text::Tradition::Directory;
951ddfe8	103	use TryCatch;
e867486f	104	binmode STDOUT, ":utf8";
	105	binmode STDERR, ":utf8";
	106	eval { no warnings; binmode $DB::OUT, ":utf8"; };
	107
	108	my $tradition = 't/data/florilegium_graphml.xml';
	109	my $t = Text::Tradition->new(
	110	'name' => 'inline',
	111	'input' => 'Self',
	112	'file' => $tradition,
	113	);
	114
951ddfe8	115	ok( $t->$_isa('Text::Tradition'), "Parsed GraphML version 2" );
e867486f	116	if( $t ) {
e867486f	117	is( scalar $t->collation->readings, 319, "Collation has all readings" );
255875b8	118	is( scalar $t->collation->paths, 376, "Collation has all paths" );
e867486f	119	is( scalar $t->witnesses, 13, "Collation has all witnesses" );
	120	}
	121
2a812726	122	# TODO add a relationship, add a stemma, write graphml, reparse it, check that
2a812726	123	# the new data is there
bbd064a9	124	$t->language('Greek');
37bf09f4	125	my $stemma_enabled = $t->can('add_stemma');
951ddfe8	126	if( $stemma_enabled ) {
	127	$t->add_stemma( 'dotfile' => 't/data/florilegium.dot' );
	128	}
bbd064a9	129	$t->collation->add_relationship( 'w12', 'w13',
	130	{ 'type' => 'grammatical', 'scope' => 'global',
	131	'annotation' => 'This is some note' } );
	132	ok( $t->collation->get_relationship( 'w12', 'w13' ), "Relationship set" );
	133	my $graphml_str = $t->collation->as_graphml;
	134
	135	my $newt = Text::Tradition->new( 'input' => 'Self', 'string' => $graphml_str );
951ddfe8	136	ok( $newt->$_isa('Text::Tradition'), "Parsed current GraphML version" );
bbd064a9	137	if( $newt ) {
	138	is( scalar $newt->collation->readings, 319, "Collation has all readings" );
	139	is( scalar $newt->collation->paths, 376, "Collation has all paths" );
	140	is( scalar $newt->witnesses, 13, "Collation has all witnesses" );
	141	is( scalar $newt->collation->relationships, 1, "Collation has added relationship" );
	142	is( $newt->language, 'Greek', "Tradition has correct language setting" );
	143	my $rel = $newt->collation->get_relationship( 'w12', 'w13' );
	144	ok( $rel, "Found set relationship" );
	145	is( $rel->annotation, 'This is some note', "Relationship has its properties" );
951ddfe8	146	if( $stemma_enabled ) {
	147	is( scalar $newt->stemmata, 1, "Tradition has its stemma" );
	148	is( $newt->stemma(0)->witnesses, $t->stemma(0)->witnesses, "Stemma has correct length witness list" );
	149	}
bbd064a9	150	}
bbd064a9	151
9fef629b	152	# Test user save / restore
	153	my $fh = File::Temp->new();
	154	my $file = $fh->filename;
	155	$fh->close;
	156	my $dsn = "dbi:SQLite:dbname=$file";
1df4baa9	157	my $userstore = Text::Tradition::Directory->new( { dsn => $dsn,
9fef629b	158	extra_args => { create => 1 } } );
9fef629b	159	my $scope = $userstore->new_scope();
1df4baa9	160	my $testuser = $userstore->create_user( { url => 'http://example.com' } );
951ddfe8	161	ok( $testuser->$_isa('Text::Tradition::User'), "Created test user via userstore" );
9fef629b	162	$testuser->add_tradition( $newt );
	163	is( $newt->user->id, $testuser->id, "Assigned tradition to test user" );
	164	$graphml_str = $newt->collation->as_graphml;
	165	my $usert;
	166	warning_is {
	167	$usert = Text::Tradition->new( 'input' => 'Self', 'string' => $graphml_str );
	168	} 'DROPPING user assignment without a specified userstore',
	169	"Got expected user drop warning on parse";
	170	$usert = Text::Tradition->new( 'input' => 'Self', 'string' => $graphml_str,
1df4baa9	171	'userstore' => $userstore );
9fef629b	172	is( $usert->user->id, $testuser->id, "Parsed tradition with userstore points to correct user" );
9fef629b	173
951ddfe8	174	# Test warning if we can
	175	unless( $stemma_enabled ) {
	176	my $nst;
	177	warnings_exist {
	178	$nst = Text::Tradition->new( 'input' => 'Self', 'file' => 't/data/lexformat.xml' );
	179	} [qr/DROPPING stemmata/],
	180	"Got expected stemma drop warning on parse";
	181	}
bbd064a9	182
e867486f	183	=end testing
32014ec9	184
32014ec9	185	=cut
144d845b	186	use Data::Dump;
32014ec9	187	sub parse {
dfc37e38	188	my( $tradition, $opts ) = @_;
2626f709	189
	190	# Collation data is in the first graph; relationship-specific stuff
	191	# is in the second.
	192	my( $graph_data, $rel_data ) = graphml_parse( $opts );
144d845b	193
32014ec9	194	my $collation = $tradition->collation;
32014ec9	195	my %witnesses;
e309421a	196
0068967c	197	# print STDERR "Setting graph globals\n";
e3196b2a	198	$tradition->name( $graph_data->{'name'} );
144d845b	199
2626f709	200	my $use_version;
bbd064a9	201	my $tmeta = $tradition->meta;
bbd064a9	202	my $cmeta = $collation->meta;
255875b8	203	foreach my $gkey ( keys %{$graph_data->{'global'}} ) {
	204	my $val = $graph_data->{'global'}->{$gkey};
	205	if( $gkey eq 'version' ) {
	206	$use_version = $val;
9fef629b	207	} elsif( $gkey eq 'stemmata' ) {
951ddfe8	208	# Make sure we can handle stemmata
9fef629b	209	# Parse the stemmata into objects
37bf09f4	210	if( $tradition->can('add_stemma') ) {
951ddfe8	211	foreach my $dotstr ( split( /\n/, $val ) ) {
	212	$tradition->add_stemma( 'dot' => $dotstr );
	213	}
37bf09f4	214	} else {
37bf09f4	215	warn "Analysis module not installed; DROPPING stemmata";
2a812726	216	}
9fef629b	217	} elsif( $gkey eq 'user' ) {
	218	# Assign the tradition to the user if we can
	219	if( exists $opts->{'userstore'} ) {
1df4baa9	220	my $userdir = delete $opts->{'userstore'};
9fef629b	221	my $user = $userdir->find_user( { username => $val } );
	222	if( $user ) {
	223	$user->add_tradition( $tradition );
	224	} else {
	225	warn( "Found no user with ID $val; DROPPING user assignment" );
	226	}
	227	} else {
	228	warn( "DROPPING user assignment without a specified userstore" );
	229	}
bbd064a9	230	} elsif( $tmeta->has_attribute( $gkey ) ) {
bbd064a9	231	$tradition->$gkey( $val );
255875b8	232	} else {
	233	$collation->$gkey( $val );
	234	}
	235	}
e309421a	236
10e4b1ac	237	# Add the nodes to the graph.
	238	# Note any reading IDs that were changed in order to comply with XML
	239	# name restrictions; we have to hardcode start & end.
	240	my %namechange = ( '#START#' => '__START__', '#END#' => '__END__' );
32014ec9	241
bbd064a9	242	# print STDERR "Adding collation readings\n";
2626f709	243	foreach my $n ( @{$graph_data->{'nodes'}} ) {
0174d6a9	244	# If it is the start or end node, we already have one, so
0174d6a9	245	# grab the rank and go.
144d845b	246	if( defined $n->{'is_start'} ) {
a445ce40	247	$collation->start->rank($n->{'rank'});
a445ce40	248	next;
144d845b	249	}
bbd064a9	250	if( defined $n->{'is_end'} ) {
bbd064a9	251	$collation->end->rank( $n->{'rank'} );
0174d6a9	252	next;
0174d6a9	253	}
bbd064a9	254	my $gnode = $collation->add_reading( $n );
10e4b1ac	255	if( $gnode->id ne $n->{'id'} ) {
	256	$namechange{$n->{'id'}} = $gnode->id;
	257	}
32014ec9	258	}
910a0a6d	259
32014ec9	260	# Now add the edges.
bbd064a9	261	# print STDERR "Adding collation path edges\n";
32014ec9	262	foreach my $e ( @{$graph_data->{'edges'}} ) {
10e4b1ac	263	my $sourceid = exists $namechange{$e->{'source'}->{'id'}}
	264	? $namechange{$e->{'source'}->{'id'}} : $e->{'source'}->{'id'};
	265	my $targetid = exists $namechange{$e->{'target'}->{'id'}}
	266	? $namechange{$e->{'target'}->{'id'}} : $e->{'target'}->{'id'};
	267	my $from = $collation->reading( $sourceid );
	268	my $to = $collation->reading( $targetid );
bbd064a9	269
	270	warn "No witness label on path edge!" unless $e->{'witness'};
	271	my $label = $e->{'witness'} . ( $e->{'extra'} ? $collation->ac_label : '' );
	272	$collation->add_path( $from, $to, $label );
	273
2626f709	274	# Add the witness if we don't have it already.
bbd064a9	275	unless( $witnesses{$e->{'witness'}} ) {
82fa4d57	276	$tradition->add_witness(
82fa4d57	277	sigil => $e->{'witness'}, 'sourcetype' => 'collation' );
bbd064a9	278	$witnesses{$e->{'witness'}} = 1;
255875b8	279	}
bbd064a9	280	$tradition->witness( $e->{'witness'} )->is_layered( 1 ) if $e->{'extra'};
32014ec9	281	}
2626f709	282
	283	## Done with the main graph, now look at the relationships.
	284	# Nodes are added via the call to add_reading above. We only need
	285	# add the relationships themselves.
	286	# TODO check that scoping does trt
bf6e338d	287	$rel_data->{'edges'} \|\|= []; # so that the next line doesn't break on no rels
bf6e338d	288	foreach my $e ( sort { _layersort_rel( $a, $b ) } @{$rel_data->{'edges'}} ) {
10e4b1ac	289	my $sourceid = exists $namechange{$e->{'source'}->{'id'}}
	290	? $namechange{$e->{'source'}->{'id'}} : $e->{'source'}->{'id'};
	291	my $targetid = exists $namechange{$e->{'target'}->{'id'}}
	292	? $namechange{$e->{'target'}->{'id'}} : $e->{'target'}->{'id'};
	293	my $from = $collation->reading( $sourceid );
	294	my $to = $collation->reading( $targetid );
bbd064a9	295	delete $e->{'source'};
	296	delete $e->{'target'};
	297	# The remaining keys are relationship attributes.
	298	# Backward compatibility...
	299	if( $use_version eq '2.0' \|\| $use_version eq '3.0' ) {
	300	delete $e->{'class'};
	301	$e->{'type'} = delete $e->{'relationship'} if exists $e->{'relationship'};
	302	}
	303	# Add the specified relationship unless we already have done.
fdfa59a7	304	my $rel_exists;
bbd064a9	305	if( $e->{'scope'} ne 'local' ) {
	306	my $relobj = $collation->get_relationship( $from, $to );
	307	if( $relobj && $relobj->scope eq $e->{'scope'}
	308	&& $relobj->type eq $e->{'type'} ) {
fdfa59a7	309	$rel_exists = 1;
	310	}
	311	}
00c5bf0b	312	try {
	313	$collation->add_relationship( $from, $to, $e ) unless $rel_exists;
	314	} catch( Text::Tradition::Error $e ) {
	315	warn "DROPPING $from -> $to: " . $e->message;
	316	}
2626f709	317	}
861c3e27	318
	319	# Save the text for each witness so that we can ensure consistency
	320	# later on
bbd064a9	321	$collation->text_from_paths();
32014ec9	322	}
32014ec9	323
bf6e338d	324	## Return the relationship that comes first in priority.
	325	my %LAYERS = (
	326	'collated' => 1,
	327	'orthographic' => 2,
	328	'spelling' => 3,
	329	);
	330
	331	sub _layersort_rel {
	332	my( $a, $b ) = @_;
	333	my $key = exists $a->{'type'} ? 'type' : 'relationship';
	334	my $at = $LAYERS{$a->{$key}} \|\| 99;
	335	my $bt = $LAYERS{$b->{$key}} \|\| 99;
	336	return $at <=> $bt;
	337	}
	338
e867486f	339	1;
	340
	341	=head1 BUGS / TODO
	342
	343	=over
	344
	345	=item * Make this into a stream parser with GraphML
	346
	347	=item * Simply field -> attribute correspondence for nodes and edges
	348
	349	=item * Share key name constants with Collation.pm
	350
32014ec9	351	=back
	352
	353	=head1 LICENSE
	354
	355	This package is free software and is provided "as is" without express
	356	or implied warranty. You can redistribute it and/or modify it under
	357	the same terms as Perl itself.
	358
	359	=head1 AUTHOR
	360
e867486f	361	Tara L Andrews E<lt>aurum@cpan.orgE<gt>