lib/Text/Tradition/Parser/Self.pm

   1 package Text::Tradition::Parser::Self;
   2
   3 use strict;
   4 use warnings;
   5 use Text::Tradition::Parser::GraphML;
   6
   7 =head1 NAME
   8
   9 Text::Tradition::Parser::GraphML
  10
  11 =head1 DESCRIPTION
  12
  13 Parser module for Text::Tradition to read in its own GraphML output format.
  14 TODO document what this format is.
  15
  16 =head1 METHODS
  17
  18 =over
  19
  20 =item B<parse>
  21
  22 parse( $graph, $graphml_string );
  23
  24 Takes an initialized Text::Tradition::Graph object and a string
  25 containing the GraphML; creates the appropriate nodes and edges on the
  26 graph.
  27
  28 =cut
  29
  30 # TODO share these with Collation.pm somehow
  31 my( $IDKEY, $TOKENKEY, $TRANSPOS_KEY, $RANK_KEY, $CLASS_KEY,
  32         $SOURCE_KEY, $TARGET_KEY, $WITNESS_KEY, $EXTRA_KEY, $RELATIONSHIP_KEY )
  33     = qw/ name reading identical rank class
  34           source target witness extra relationship/;
  35
  36 sub parse {
  37     my( $tradition, $graphml_str ) = @_;
  38
  39     # TODO this is begging for stream parsing instead of multiple loops.
  40     my $graph_data = Text::Tradition::Parser::GraphML::parse( $graphml_str );
  41
  42     my $collation = $tradition->collation;
  43     my %witnesses;
  44
  45     # Add the nodes to the graph.
  46     # TODO Are we adding extra start/end nodes?
  47
  48     my $extra_data = {}; # Keep track of data that needs to be processed
  49                          # after the nodes & edges are created.
  50     print STDERR "Adding graph nodes\n";
  51     foreach my $n ( @{$graph_data->{'nodes'}} ) {
  52         # First extract the data that we can use without reference to
  53         # anything else.
  54         my %node_data = %$n; # Need $n itself untouched for edge processing
  55         my $nodeid = delete $node_data{$IDKEY};
  56         my $reading = delete $node_data{$TOKENKEY};
  57         my $class = delete $node_data{$CLASS_KEY} || '';
  58         my $rank = delete $node_data{$RANK_KEY};
  59
  60         # Create the node.  Current valid classes are common and meta.
  61         # Everything else is a normal reading.
  62         my $gnode = $collation->add_reading( $nodeid );
  63         $gnode->text( $reading );
  64         $gnode->make_common if $class eq 'common';
  65         $gnode->is_meta( 1 ) if $class eq 'meta';
  66         $gnode->rank( $rank ) if defined $rank;
  67
  68         # Now save the data that we need for post-processing,
  69         # if it exists.
  70         if ( keys %node_data ) {
  71             $extra_data->{$nodeid} = \%node_data
  72         }
  73     }
  74
  75     # Now add the edges.
  76     print STDERR "Adding graph edges\n";
  77     $DB::single = 1;
  78     foreach my $e ( @{$graph_data->{'edges'}} ) {
  79         my $from = $e->{$SOURCE_KEY};
  80         my $to = $e->{$TARGET_KEY};
  81         my $class = $e->{$CLASS_KEY};
  82
  83         # We may have more information depending on the class.
  84         if( $class eq 'path' ) {
  85                 # We need the witness, and whether it is an 'extra' reading path.
  86                 my $wit = $e->{$WITNESS_KEY};
  87                 warn "No witness label on path edge!" unless $wit;
  88                 my $extra = $e->{$EXTRA_KEY};
  89                 my $label = $wit . ( $extra ? $collation->ac_label : '' );
  90                 $collation->add_path( $from->{$IDKEY}, $to->{$IDKEY}, $label );
  91                 # Add the witness if we don't have it already.
  92                         unless( $witnesses{$wit} ) {
  93                                 $tradition->add_witness( sigil => $wit );
  94                                 $witnesses{$wit} = 1;
  95                         }
  96         } elsif( $class eq 'relationship' ) {
  97                 # We need the relationship type.
  98                 my $rel = $e->{$RELATIONSHIP_KEY};
  99                 warn "No relationship type for relationship edge!" unless $rel;
 100                 $collation->add_relationship( $rel, $from->{$IDKEY}, $to->{$IDKEY} );
 101         }
 102     }
 103
 104     ## Deal with node information (transposition, relationships, etc.) that
 105     ## needs to be processed after all the nodes are created.
 106     print STDERR "Adding second-pass node data\n";
 107     my $linear = undef;
 108     foreach my $nkey ( keys %$extra_data ) {
 109         foreach my $edkey ( keys %{$extra_data->{$nkey}} ) {
 110             my $this_reading = $collation->reading( $nkey );
 111             if( $edkey eq $TRANSPOS_KEY ) {
 112                 $DB::single = 1;
 113                 my $other_reading = $collation->reading( $extra_data->{$nkey}->{$edkey} );
 114                 # We evidently have a linear graph.
 115                 $linear = 1;
 116                 $this_reading->set_identical( $other_reading );
 117             } else {
 118                 warn "Unfamiliar reading node data $edkey for $nkey";
 119             }
 120         }
 121     }
 122     $collation->linear( $linear );
 123     # TODO We probably need to set the $witness->path arrays for each wit.
 124 }
 125
 126 =back
 127
 128 =head1 LICENSE
 129
 130 This package is free software and is provided "as is" without express
 131 or implied warranty.  You can redistribute it and/or modify it under
 132 the same terms as Perl itself.
 133
 134 =head1 AUTHOR
 135
 136 Tara L Andrews, aurum@cpan.org
 137
 138 =cut
 139
 140 1;