changed interface for Tradition init

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

diff --git a/lib/Text/Tradition/Parser/Self.pm b/lib/Text/Tradition/Parser/Self.pm
index addff13..0c4b83f 100644 (file)
--- a/lib/Text/Tradition/Parser/Self.pm
+++ b/lib/Text/Tradition/Parser/Self.pm
@@ -34,14 +34,23 @@ my( $IDKEY, $TOKENKEY, $TRANSPOS_KEY, $RANK_KEY, $CLASS_KEY,
          source target witness extra relationship/;
 
 sub parse {
-    my( $tradition, $graphml_str ) = @_;
+    my( $tradition, $opts ) = @_;
+    my $graph_data = Text::Tradition::Parser::GraphML::parse( $opts );
     
     # TODO this is begging for stream parsing instead of multiple loops.
-    my $graph_data = Text::Tradition::Parser::GraphML::parse( $graphml_str );
 
     my $collation = $tradition->collation;
     my %witnesses;
-
+    
+    # Set up the graph-global attributes.  They will appear in the
+    # hash under their accessor names.
+    # TODO Consider simplifying this for nodes & edges as well.
+    print STDERR "Setting graph globals\n";
+    foreach my $gkey ( keys %{$graph_data->{'attr'}} ) {
+               my $val = $graph_data->{'attr'}->{$gkey};
+               $collation->$gkey( $val );
+       }
+               
     # Add the nodes to the graph. 
     # TODO Are we adding extra start/end nodes?
 
@@ -58,11 +67,14 @@ sub parse {
         my $rank = delete $node_data{$RANK_KEY};
         
         # Create the node.  Current valid classes are common and meta. 
-        # Everything else is a normal reading.  
+        # Everything else is a normal reading.
+        ## TODO RATIONALIZE THESE CLASSES
         my $gnode = $collation->add_reading( $nodeid );
         $gnode->text( $reading );
         $gnode->make_common if $class eq 'common';
         $gnode->is_meta( 1 ) if $class eq 'meta';
+        # This is a horrible hack.
+        $gnode->is_lacuna( $reading =~ /^\#LACUNA/ );
         $gnode->rank( $rank ) if defined $rank;
 
         # Now save the data that we need for post-processing,
@@ -74,7 +86,6 @@ sub parse {
         
     # Now add the edges.
     print STDERR "Adding graph edges\n";
-    $DB::single = 1;
     foreach my $e ( @{$graph_data->{'edges'}} ) {
         my $from = $e->{$SOURCE_KEY};
         my $to = $e->{$TARGET_KEY};
@@ -93,34 +104,49 @@ sub parse {
                                $tradition->add_witness( sigil => $wit );
                                $witnesses{$wit} = 1;
                        }
+                       $witnesses{$wit} = 2 if $extra;
         } elsif( $class eq 'relationship' ) {
-               # We need the relationship type.
-               my $rel = $e->{$RELATIONSHIP_KEY};
-               warn "No relationship type for relationship edge!" unless $rel;
-               $collation->add_relationship( $rel, $from->{$IDKEY}, $to->{$IDKEY} );
+               # We need the metadata about the relationship.
+               my $opts = { 'type' => $e->{$RELATIONSHIP_KEY} };
+               $opts->{'equal_rank'} = $e->{'equal_rank'} 
+                       if exists $e->{'equal_rank'};
+               $opts->{'non_correctable'} = $e->{'non_correctable'} 
+                       if exists $e->{'non_correctable'};
+               $opts->{'non_independent'} = $e->{'non_independent'} 
+                       if exists $e->{'non_independent'};
+               warn "No relationship type for relationship edge!" unless $opts->{'type'};
+               $collation->add_relationship( $from->{$IDKEY}, $to->{$IDKEY}, $opts );
         } 
     }
 
     ## Deal with node information (transposition, relationships, etc.) that
     ## needs to be processed after all the nodes are created.
     print STDERR "Adding second-pass node data\n";
-    my $linear = undef;
     foreach my $nkey ( keys %$extra_data ) {
         foreach my $edkey ( keys %{$extra_data->{$nkey}} ) {
             my $this_reading = $collation->reading( $nkey );
             if( $edkey eq $TRANSPOS_KEY ) {
-               $DB::single = 1;
                 my $other_reading = $collation->reading( $extra_data->{$nkey}->{$edkey} );
-                # We evidently have a linear graph.
-                $linear = 1;
                 $this_reading->set_identical( $other_reading );
             } else {
                 warn "Unfamiliar reading node data $edkey for $nkey";
             }
         }
     }
-    $collation->linear( $linear );
-    # TODO We probably need to set the $witness->path arrays for each wit.
+    
+    # Set the $witness->path arrays for each wit.
+    print STDERR "Walking paths for witnesses\n";
+    foreach my $wit ( $tradition->witnesses ) {
+       my @path = $collation->reading_sequence( $collation->start, $collation->end, 
+               $wit->sigil );
+       $wit->path( \@path );
+       if( $witnesses{$wit->sigil} == 2 ) {
+               # Get the uncorrected path too
+               my @uc = $collation->reading_sequence( $collation->start, $collation->end, 
+                       $wit->sigil . $collation->ac_label, $wit->sigil );
+               $wit->uncorrected_path( \@uc );
+       }
+    }
 }
 
 =back