X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FText%2FTradition%2FCollation.pm;h=022c2bc4e413d684f57444e18b2ac305a5171964;hb=db61303b93ba08ca97778858ee56ad31747dc308;hp=fcdd1ff78959c66662fc5ac00a9481fba6afdf90;hpb=2a8127263ef278f3f14b480a12b84f9aa4f92fdc;p=scpubgit%2Fstemmatology.git diff --git a/lib/Text/Tradition/Collation.pm b/lib/Text/Tradition/Collation.pm index fcdd1ff..022c2bc 100644 --- a/lib/Text/Tradition/Collation.pm +++ b/lib/Text/Tradition/Collation.pm @@ -1,11 +1,13 @@ package Text::Tradition::Collation; +use feature 'say'; use Encode qw( decode_utf8 ); use File::Temp; use File::Which; use Graph; use IPC::Run qw( run binary ); use Text::CSV; +use Text::Tradition::Collation::Data; use Text::Tradition::Collation::Reading; use Text::Tradition::Collation::RelationshipStore; use Text::Tradition::Error; @@ -14,28 +16,42 @@ use XML::LibXML; use XML::LibXML::XPathContext; use Moose; -has 'sequence' => ( - is => 'ro', - isa => 'Graph', - default => sub { Graph->new() }, - handles => { - paths => 'edges', - }, - ); - -has 'relations' => ( - is => 'ro', - isa => 'Text::Tradition::Collation::RelationshipStore', - handles => { - relationships => 'relationships', - related_readings => 'related_readings', - get_relationship => 'get_relationship', - del_relationship => 'del_relationship', - equivalence => 'equivalence', - equivalence_graph => 'equivalence_graph', - }, - writer => '_set_relations', - ); +has _data => ( + isa => 'Text::Tradition::Collation::Data', + is => 'ro', + required => 1, + handles => [ qw( + sequence + paths + _set_relations + relations + _set_start + _set_end + ac_label + has_cached_table + relationships + related_readings + get_relationship + del_relationship + equivalence + equivalence_graph + readings + reading + _add_reading + del_reading + has_reading + wit_list_separator + baselabel + linear + wordsep + start + end + cached_table + _graphcalc_done + has_cached_svg + wipe_table + )] +); has 'tradition' => ( is => 'ro', @@ -44,83 +60,6 @@ has 'tradition' => ( weak_ref => 1, ); -has 'readings' => ( - isa => 'HashRef[Text::Tradition::Collation::Reading]', - traits => ['Hash'], - handles => { - reading => 'get', - _add_reading => 'set', - del_reading => 'delete', - has_reading => 'exists', - readings => 'values', - }, - default => sub { {} }, - ); - -has 'wit_list_separator' => ( - is => 'rw', - isa => 'Str', - default => ', ', - ); - -has 'baselabel' => ( - is => 'rw', - isa => 'Str', - default => 'base text', - ); - -has 'linear' => ( - is => 'rw', - isa => 'Bool', - default => 1, - ); - -has 'ac_label' => ( - is => 'rw', - isa => 'Str', - default => ' (a.c.)', - ); - -has 'wordsep' => ( - is => 'rw', - isa => 'Str', - default => ' ', - ); - -has 'start' => ( - is => 'ro', - isa => 'Text::Tradition::Collation::Reading', - writer => '_set_start', - weak_ref => 1, - ); - -has 'end' => ( - is => 'ro', - isa => 'Text::Tradition::Collation::Reading', - writer => '_set_end', - weak_ref => 1, - ); - -has 'cached_svg' => ( - is => 'rw', - isa => 'Str', - predicate => 'has_cached_svg', - clearer => 'wipe_svg', - ); - -has 'cached_table' => ( - is => 'rw', - isa => 'HashRef', - predicate => 'has_cached_table', - clearer => 'wipe_table', - ); - -has '_graphcalc_done' => ( - is => 'rw', - isa => 'Bool', - default => undef, - ); - =head1 NAME Text::Tradition::Collation - a software model for a text collation @@ -271,11 +210,27 @@ See L for the available options. =cut +sub BUILDARGS { + my ( $class, @args ) = @_; + my %args = @args == 1 ? %{ $args[0] } : @args; + # TODO determine these from the Moose::Meta object + my @delegate_attrs = qw(sequence relations readings wit_list_separator baselabel + linear wordsep start end cached_table _graphcalc_done); + my %data_args; + for my $attr (@delegate_attrs) { + $data_args{$attr} = delete $args{$attr} if exists $args{$attr}; + } + $args{_data} = Text::Tradition::Collation::Data->new(%data_args); + return \%args; +} + sub BUILD { my $self = shift; $self->_set_relations( Text::Tradition::Collation::RelationshipStore->new( 'collation' => $self ) ); - $self->_set_start( $self->add_reading( { 'collation' => $self, 'is_start' => 1 } ) ); - $self->_set_end( $self->add_reading( { 'collation' => $self, 'is_end' => 1 } ) ); + $self->_set_start( $self->add_reading( + { 'collation' => $self, 'is_start' => 1, 'init' => 1 } ) ); + $self->_set_end( $self->add_reading( + { 'collation' => $self, 'is_end' => 1, 'init' => 1 } ) ); } ### Reading construct/destruct functions @@ -284,7 +239,11 @@ sub add_reading { my( $self, $reading ) = @_; unless( ref( $reading ) eq 'Text::Tradition::Collation::Reading' ) { my %args = %$reading; - if( $self->tradition->has_language && !exists $args{'language'} ) { + if( $args{'init'} ) { + # If we are initializing an empty collation, don't assume that we + # have set a tradition. + delete $args{'init'}; + } elsif( $self->tradition->has_language && !exists $args{'language'} ) { $args{'language'} = $self->tradition->language; } $reading = Text::Tradition::Collation::Reading->new( @@ -369,11 +328,23 @@ is( $c->reading('n21p0')->text, 'unto', "Reading n21p0 merged correctly" ); sub merge_readings { my $self = shift; + # Sanity check + my( $kept_obj, $del_obj, $combine, $combine_char ) = $self->_objectify_args( @_ ); + my $mergemeta = $kept_obj->is_meta; + throw( "Cannot merge meta and non-meta reading" ) + unless ( $mergemeta && $del_obj->is_meta ) + || ( !$mergemeta && !$del_obj->is_meta ); + if( $mergemeta ) { + throw( "Cannot merge with start or end node" ) + if( $kept_obj eq $self->start || $kept_obj eq $self->end + || $del_obj eq $self->start || $del_obj eq $self->end ); + } # We only need the IDs for adding paths to the graph, not the reading # objects themselves. - my( $kept, $deleted, $combine, $combine_char ) = $self->_stringify_args( @_ ); + my $kept = $kept_obj->id; + my $deleted = $del_obj->id; $self->_graphcalc_done(0); - + # The kept reading should inherit the paths and the relationships # of the deleted reading. foreach my $path ( $self->sequence->edges_at( $deleted ) ) { @@ -387,22 +358,91 @@ sub merge_readings { @wits{keys %$fwits} = values %$fwits; $self->sequence->set_edge_attributes( @vector, \%wits ); } - $self->relations->merge_readings( $kept, $deleted, $combine_char ); + $self->relations->merge_readings( $kept, $deleted, $combine ); # Do the deletion deed. if( $combine ) { - my $kept_obj = $self->reading( $kept ); - my $del_obj = $self->reading( $deleted ); + # Combine the text of the readings my $joinstr = $combine_char; unless( defined $joinstr ) { $joinstr = '' if $kept_obj->join_next || $del_obj->join_prior; $joinstr = $self->wordsep unless defined $joinstr; } $kept_obj->alter_text( join( $joinstr, $kept_obj->text, $del_obj->text ) ); + # Change this reading to a joining one if necessary + $kept_obj->_set_join_next( $del_obj->join_next ); + $kept_obj->normal_form( + join( $joinstr, $kept_obj->normal_form, $del_obj->normal_form ) ); + # Combine the lexemes present in the readings + if( $kept_obj->has_lexemes && $del_obj->has_lexemes ) { + $kept_obj->add_lexeme( $del_obj->lexemes ); + } } $self->del_reading( $deleted ); } +=head2 compress_readings + +Where possible in the graph, compresses plain sequences of readings into a +single reading. The sequences must consist of readings with no +relationships to other readings, with only a single witness path between +them and no other witness paths from either that would skip the other. The +readings must also not be marked as nonsense or bad grammar. + +WARNING: This operation cannot be undone. + +=cut + +sub compress_readings { + my $self = shift; + # Anywhere in the graph that there is a reading that joins only to a single + # successor, and neither of these have any relationships, just join the two + # readings. + my %gobbled; + foreach my $rdg ( sort { $a->rank <=> $b->rank } $self->readings ) { + # While we are here, get rid of any extra wordforms from a disambiguated + # reading. + if( $rdg->disambiguated ) { + foreach my $lex ( $rdg->lexemes ) { + $lex->clear_matching_forms(); + $lex->add_matching_form( $lex->form ); + } + } + # Now look for readings that can be joined to their successors. + next if $rdg->is_meta; + next if $gobbled{$rdg->id}; + next if $rdg->grammar_invalid || $rdg->is_nonsense; + next if $rdg->related_readings(); + my %seen; + while( $self->sequence->successors( $rdg ) == 1 ) { + my( $next ) = $self->reading( $self->sequence->successors( $rdg ) ); + throw( "Infinite loop" ) if $seen{$next->id}; + $seen{$next->id} = 1; + last if $self->sequence->predecessors( $next ) > 1; + last if $next->is_meta; + last if $next->grammar_invalid || $next->is_nonsense; + last if $next->related_readings(); + say "Joining readings $rdg and $next"; + $self->merge_readings( $rdg, $next, 1 ); + } + } + # Make sure we haven't screwed anything up + foreach my $wit ( $self->tradition->witnesses ) { + my $pathtext = $self->path_text( $wit->sigil ); + my $origtext = join( ' ', @{$wit->text} ); + throw( "Text differs for witness " . $wit->sigil ) + unless $pathtext eq $origtext; + if( $wit->is_layered ) { + $pathtext = $self->path_text( $wit->sigil.$self->ac_label ); + $origtext = join( ' ', @{$wit->layertext} ); + throw( "Ante-corr text differs for witness " . $wit->sigil ) + unless $pathtext eq $origtext; + } + } + + $self->relations->rebuild_equivalence(); + $self->calculate_ranks(); +} # Helper function for manipulating the graph. sub _stringify_args { @@ -560,23 +600,19 @@ sub as_svg { throw( "Need GraphViz installed to output SVG" ) unless File::Which::which( 'dot' ); my $want_subgraph = exists $opts->{'from'} || exists $opts->{'to'}; - $self->calculate_ranks() unless( $self->_graphcalc_done || $opts->{'nocalc'} ); - if( !$self->has_cached_svg || $opts->{'recalc'} || $want_subgraph ) { - my @cmd = qw/dot -Tsvg/; - my( $svg, $err ); - my $dotfile = File::Temp->new(); - ## USE FOR DEBUGGING - # $dotfile->unlink_on_destroy(0); - binmode $dotfile, ':utf8'; - print $dotfile $self->as_dot( $opts ); - push( @cmd, $dotfile->filename ); - run( \@cmd, ">", binary(), \$svg ); - $svg = decode_utf8( $svg ); - $self->cached_svg( $svg ) unless $want_subgraph; - return $svg; - } else { - return $self->cached_svg; - } + $self->calculate_ranks() + unless( $self->_graphcalc_done || $opts->{'nocalc'} || !$self->linear ); + my @cmd = qw/dot -Tsvg/; + my( $svg, $err ); + my $dotfile = File::Temp->new(); + ## USE FOR DEBUGGING + # $dotfile->unlink_on_destroy(0); + binmode $dotfile, ':utf8'; + print $dotfile $self->as_dot( $opts ); + push( @cmd, $dotfile->filename ); + run( \@cmd, ">", binary(), \$svg ); + $svg = decode_utf8( $svg ); + return $svg; } @@ -712,23 +748,28 @@ sub as_dot { $dot .= sprintf( "\t\"%s\" -> \"%s\" %s;\n", $edge->[0], $edge->[1], $varopts ); } elsif( $used{$edge->[0]} ) { - $subend{$edge->[0]} = 1; + $subend{$edge->[0]} = $edge->[1]; } elsif( $used{$edge->[1]} ) { - $substart{$edge->[1]} = 1; + $substart{$edge->[1]} = $edge->[0]; } } # Add substitute start and end edges if necessary foreach my $node ( keys %substart ) { - my $witstr = $self->_path_display_label ( $self->reading_witnesses( $self->reading( $node ) ) ); + my $witstr = $self->_path_display_label ( $self->path_witnesses( $substart{$node}, $node ) ); my $variables = { %edge_attrs, 'label' => $witstr }; + my $nrdg = $self->reading( $node ); + if( $nrdg->has_rank && $nrdg->rank > $startrank ) { + # Substart is actually one lower than $startrank + $variables->{'minlen'} = $nrdg->rank - ( $startrank - 1 ); + } my $varopts = _dot_attr_string( $variables ); - $dot .= "\t\"__SUBSTART__\" -> \"$node\" $varopts;"; + $dot .= "\t\"__SUBSTART__\" -> \"$node\" $varopts;\n"; } foreach my $node ( keys %subend ) { - my $witstr = $self->_path_display_label ( $self->reading_witnesses( $self->reading( $node ) ) ); + my $witstr = $self->_path_display_label ( $self->path_witnesses( $node, $subend{$node} ) ); my $variables = { %edge_attrs, 'label' => $witstr }; my $varopts = _dot_attr_string( $variables ); - $dot .= "\t\"$node\" -> \"__SUBEND__\" $varopts;"; + $dot .= "\t\"$node\" -> \"__SUBEND__\" $varopts;\n"; } # HACK part 2 if( $STRAIGHTENHACK ) { @@ -817,6 +858,7 @@ sub _path_display_label { # See if we are in a majority situation. my $maj = scalar( $self->tradition->witnesses ) * 0.6; + $maj = $maj > 5 ? $maj : 5; if( scalar keys %wits > $maj ) { unshift( @disp_ac, 'majority' ); return join( ', ', @disp_ac ); @@ -887,13 +929,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 @@ -925,6 +977,7 @@ sub as_graphml { 'http://graphml.graphdrawing.org/xmlns/1.0/graphml.xsd'; # Create the document and root node + require XML::LibXML; my $graphml = XML::LibXML->createDocument( "1.0", "UTF-8" ); my $root = $graphml->createElementNS( $graphml_ns, 'graphml' ); $graphml->setDocumentElement( $root ); @@ -942,11 +995,6 @@ sub as_graphml { 'RelationshipScope' => 'string', ); - # List of attribute names *not* to save on our objects. - # We will also not save any attribute beginning with _. - my %skipsave; - map { $skipsave{$_} = 1 } qw/ cached_svg /; - # Add the data keys for the graph. Include an extra key 'version' for the # GraphML output version. my %graph_data_keys; @@ -960,18 +1008,28 @@ sub as_graphml { map { $gattr_from{$_->name} = 'Collation' } $cmeta->get_all_attributes; foreach my $attr ( ( $tmeta->get_all_attributes, $cmeta->get_all_attributes ) ) { next if $attr->name =~ /^_/; - next if $skipsave{$attr->name}; 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} ); } @@ -981,7 +1039,6 @@ sub as_graphml { my $rmeta = Text::Tradition::Collation::Reading->meta; foreach my $attr( $rmeta->get_all_attributes ) { next if $attr->name =~ /^_/; - next if $skipsave{$attr->name}; next unless $save_types{$attr->type_constraint->name}; $reading_attributes{$attr->name} = $save_types{$attr->type_constraint->name}; } @@ -1011,7 +1068,6 @@ sub as_graphml { my $pmeta = Text::Tradition::Collation::Relationship->meta; foreach my $attr( $pmeta->get_all_attributes ) { next if $attr->name =~ /^_/; - next if $skipsave{$attr->name}; next unless $save_types{$attr->type_constraint->name}; $edge_attributes{$attr->name} = $save_types{$attr->type_constraint->name}; } @@ -1044,11 +1100,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 { @@ -1077,6 +1131,8 @@ sub as_graphml { # serialize them. Otherwise set nval to undef so that the # key is excluded from this reading. $nval = $nval ? $n->_serialize_lexemes : undef; + } elsif( $d eq 'normal_form' && $n->normal_form eq $n->text ) { + $nval = undef; } if( $rankoffset && $d eq 'rank' && $n ne $self->start ) { # Adjust the ranks within the subgraph. @@ -1202,7 +1258,7 @@ sub alignment_table { my $table = { 'alignment' => [], 'length' => $self->end->rank - 1 }; my @all_pos = ( 1 .. $self->end->rank - 1 ); foreach my $wit ( sort { $a->sigil cmp $b->sigil } $self->tradition->witnesses ) { - # print STDERR "Making witness row(s) for " . $wit->sigil . "\n"; + # say STDERR "Making witness row(s) for " . $wit->sigil; my @wit_path = $self->reading_sequence( $self->start, $self->end, $wit->sigil ); my @row = _make_witness_row( \@wit_path, \@all_pos ); push( @{$table->{'alignment'}}, @@ -1225,10 +1281,8 @@ sub _make_witness_row { map { $char_hash{$_} = undef } @$positions; my $debug = 0; foreach my $rdg ( @$path ) { - my $rtext = $rdg->text; - $rtext = '#LACUNA#' if $rdg->is_lacuna; - print STDERR "rank " . $rdg->rank . "\n" if $debug; - # print STDERR "No rank for " . $rdg->id . "\n" unless defined $rdg->rank; + say STDERR "rank " . $rdg->rank if $debug; + # say STDERR "No rank for " . $rdg->id unless defined $rdg->rank; $char_hash{$rdg->rank} = { 't' => $rdg }; } my @row = map { $char_hash{$_} } @$positions; @@ -1452,7 +1506,7 @@ Call make_witness_path for all witnesses in the tradition. sub make_witness_paths { my( $self ) = @_; foreach my $wit ( $self->tradition->witnesses ) { - # print STDERR "Making path for " . $wit->sigil . "\n"; + # say STDERR "Making path for " . $wit->sigil; $self->make_witness_path( $wit ); } } @@ -1520,14 +1574,8 @@ sub calculate_ranks { # Do the rankings based on the relationship equivalence graph, starting # with the start node. - my $topo_start = $self->equivalence( $self->start->id ); - my $node_ranks = { $topo_start => 0 }; - my @curr_origin = ( $topo_start ); - # A little iterative function. - while( @curr_origin ) { - @curr_origin = _assign_rank( $self->equivalence_graph, - $node_ranks, @curr_origin ); - } + my ( $node_ranks, $rank_nodes ) = $self->relations->equivalence_ranks(); + # Transfer our rankings from the topological graph to the real one. foreach my $r ( $self->readings ) { if( defined $node_ranks->{$self->equivalence( $r->id )} ) { @@ -1542,7 +1590,7 @@ sub calculate_ranks { } } # Do we need to invalidate the cached data? - if( $self->has_cached_svg || $self->has_cached_table ) { + if( $self->has_cached_table ) { foreach my $r ( $self->readings ) { next if defined( $existing_ranks{$r} ) && $existing_ranks{$r} == $r->rank; @@ -1557,44 +1605,8 @@ sub calculate_ranks { $self->_graphcalc_done(1); } -sub _assign_rank { - my( $graph, $node_ranks, @current_nodes ) = @_; - # Look at each of the children of @current_nodes. If all the child's - # parents have a rank, assign it the highest rank + 1 and add it to - # @next_nodes. Otherwise skip it; we will return when the highest-ranked - # parent gets a rank. - my @next_nodes; - foreach my $c ( @current_nodes ) { - warn "Current reading $c has no rank!" - unless exists $node_ranks->{$c}; - # print STDERR "Looking at child of node $c, rank " - # . $node_ranks->{$c} . "\n"; - foreach my $child ( $graph->successors( $c ) ) { - next if exists $node_ranks->{$child}; - my $highest_rank = -1; - my $skip = 0; - foreach my $parent ( $graph->predecessors( $child ) ) { - if( exists $node_ranks->{$parent} ) { - $highest_rank = $node_ranks->{$parent} - if $highest_rank <= $node_ranks->{$parent}; - } else { - $skip = 1; - last; - } - } - next if $skip; - my $c_rank = $highest_rank + 1; - # print STDERR "Assigning rank $c_rank to node $child \n"; - $node_ranks->{$child} = $c_rank; - push( @next_nodes, $child ); - } - } - return @next_nodes; -} - sub _clear_cache { my $self = shift; - $self->wipe_svg if $self->has_cached_svg; $self->wipe_table if $self->has_cached_table; } @@ -1614,8 +1626,17 @@ sub flatten_ranks { next unless $rdg->has_rank; my $key = $rdg->rank . "||" . $rdg->text; if( exists $unique_rank_rdg{$key} ) { + # Make sure they don't have different grammatical forms + my $ur = $unique_rank_rdg{$key}; + if( $rdg->disambiguated && $ur->disambiguated ) { + my $rform = join( '//', map { $_->form->to_string } $rdg->lexemes ); + my $uform = join( '//', map { $_->form->to_string } $ur->lexemes ); + next unless $rform eq $uform; + } elsif( $rdg->disambiguated xor $ur->disambiguated ) { + next; + } # Combine! - # print STDERR "Combining readings at same rank: $key\n"; + #say STDERR "Combining readings at same rank: $key"; $changed = 1; $self->merge_readings( $unique_rank_rdg{$key}, $rdg ); # TODO see if this now makes a common point. @@ -1777,7 +1798,7 @@ sub _common_in_path { my @last_r2 = ( $r2 ); # my %all_seen = ( $r1 => 'r1', $r2 => 'r2' ); my %all_seen; - # print STDERR "Finding common $dir for $r1, $r2\n"; + # say STDERR "Finding common $dir for $r1, $r2"; while( !@candidates ) { last unless $iter--; # Avoid looping infinitely # Iterate separately down the graph from r1 and r2 @@ -1785,7 +1806,7 @@ sub _common_in_path { foreach my $lc ( @last_r1 ) { foreach my $p ( $lc->$dir ) { if( $all_seen{$p->id} && $all_seen{$p->id} ne 'r1' ) { - # print STDERR "Path candidate $p from $lc\n"; + # say STDERR "Path candidate $p from $lc"; push( @candidates, $p ); } elsif( !$all_seen{$p->id} ) { $all_seen{$p->id} = 'r1'; @@ -1796,7 +1817,7 @@ sub _common_in_path { foreach my $lc ( @last_r2 ) { foreach my $p ( $lc->$dir ) { if( $all_seen{$p->id} && $all_seen{$p->id} ne 'r2' ) { - # print STDERR "Path candidate $p from $lc\n"; + # say STDERR "Path candidate $p from $lc"; push( @candidates, $p ); } elsif( !$all_seen{$p->id} ) { $all_seen{$p->id} = 'r2';