save the name of the text too
[scpubgit/stemmatology.git] / lib / Text / Tradition / Parser / Self.pm
index 2e7a0f1..895ca4d 100644 (file)
@@ -2,48 +2,143 @@ package Text::Tradition::Parser::Self;
 
 use strict;
 use warnings;
-use Text::Tradition::Parser::GraphML;
+use Text::Tradition::Parser::GraphML qw/ graphml_parse populate_witness_path /;
 
 =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.
-TODO document what this format is.
+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.
 
-=head1 METHODS
+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 B<parse>
+=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)
 
-parse( $graph, $graphml_string );
+=item * non_independent (for 'relationship' class edges)
 
-Takes an initialized Text::Tradition::Graph object and a string
-containing the GraphML; creates the appropriate nodes and edges on the
-graph.
+=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 Text::Tradition;
+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,
+    );
+
+is( ref( $t ), 'Text::Tradition', "Parsed our own GraphML" );
+if( $t ) {
+    is( scalar $t->collation->readings, 319, "Collation has all readings" );
+    is( scalar $t->collation->paths, 2854, "Collation has all paths" );
+    is( scalar $t->witnesses, 13, "Collation has all witnesses" );
+}
+
+=end testing
 
 =cut
 
-# TODO share these with Collation.pm somehow
 my( $IDKEY, $TOKENKEY, $TRANSPOS_KEY, $RANK_KEY, $CLASS_KEY,
        $SOURCE_KEY, $TARGET_KEY, $WITNESS_KEY, $EXTRA_KEY, $RELATIONSHIP_KEY ) 
     = qw/ name reading identical rank class 
          source target witness extra relationship/;
 
 sub parse {
-    my( $tradition, $graphml_str ) = @_;
+    my( $tradition, $opts ) = @_;
+    my $graph_data = 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.
+    print STDERR "Setting graph globals\n";
+    $tradition->name( $graph_data->{'name'} );
+    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?
 
     my $extra_data = {}; # Keep track of data that needs to be processed
                          # after the nodes & edges are created.
@@ -58,11 +153,13 @@ 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.
         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,6 +171,7 @@ sub parse {
         
     # Now add the edges.
     print STDERR "Adding graph edges\n";
+    my $has_ante_corr = {};
     foreach my $e ( @{$graph_data->{'edges'}} ) {
         my $from = $e->{$SOURCE_KEY};
         my $to = $e->{$TARGET_KEY};
@@ -92,6 +190,7 @@ sub parse {
                                $tradition->add_witness( sigil => $wit );
                                $witnesses{$wit} = 1;
                        }
+                       $has_ante_corr->{$wit} = 1 if $extra;
         } elsif( $class eq 'relationship' ) {
                # We need the metadata about the relationship.
                my $opts = { 'type' => $e->{$RELATIONSHIP_KEY} };
@@ -109,24 +208,34 @@ sub parse {
     ## 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 ) {
                 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.
+    populate_witness_path( $tradition, $has_ante_corr );
 }
 
+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
@@ -137,8 +246,4 @@ the same terms as Perl itself.
 
 =head1 AUTHOR
 
-Tara L Andrews, aurum@cpan.org
-
-=cut
-
-1;
+Tara L Andrews E<lt>aurum@cpan.orgE<gt>