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     foreach my $e ( @{$graph_data->{'edges'}} ) {
  78         my $from = $e->{$SOURCE_KEY};
  79         my $to = $e->{$TARGET_KEY};
  80         my $class = $e->{$CLASS_KEY};
  81
  82         # We may have more information depending on the class.
  83         if( $class eq 'path' ) {
  84                 # We need the witness, and whether it is an 'extra' reading path.
  85                 my $wit = $e->{$WITNESS_KEY};
  86                 warn "No witness label on path edge!" unless $wit;
  87                 my $extra = $e->{$EXTRA_KEY};
  88                 my $label = $wit . ( $extra ? $collation->ac_label : '' );
  89                 $collation->add_path( $from->{$IDKEY}, $to->{$IDKEY}, $label );
  90                 # Add the witness if we don't have it already.
  91                         unless( $witnesses{$wit} ) {
  92                                 $tradition->add_witness( sigil => $wit );
  93                                 $witnesses{$wit} = 1;
  94                         }
  95         } elsif( $class eq 'relationship' ) {
  96                 # We need the metadata about the relationship.
  97                 my $opts = { 'type' => $e->{$RELATIONSHIP_KEY} };
  98                 $opts->{'equal_rank'} = $e->{'equal_rank'}
  99                         if exists $e->{'equal_rank'};
 100                 $opts->{'non_correctable'} = $e->{'non_correctable'}
 101                         if exists $e->{'non_correctable'};
 102                 $opts->{'non_independent'} = $e->{'non_independent'}
 103                         if exists $e->{'non_independent'};
 104                 warn "No relationship type for relationship edge!" unless $opts->{'type'};
 105                 $collation->add_relationship( $from->{$IDKEY}, $to->{$IDKEY}, $opts );
 106         }
 107     }
 108
 109     ## Deal with node information (transposition, relationships, etc.) that
 110     ## needs to be processed after all the nodes are created.
 111     print STDERR "Adding second-pass node data\n";
 112     my $linear = undef;
 113     foreach my $nkey ( keys %$extra_data ) {
 114         foreach my $edkey ( keys %{$extra_data->{$nkey}} ) {
 115             my $this_reading = $collation->reading( $nkey );
 116             if( $edkey eq $TRANSPOS_KEY ) {
 117                 my $other_reading = $collation->reading( $extra_data->{$nkey}->{$edkey} );
 118                 # We evidently have a linear graph.
 119                 $linear = 1;
 120                 $this_reading->set_identical( $other_reading );
 121             } else {
 122                 warn "Unfamiliar reading node data $edkey for $nkey";
 123             }
 124         }
 125     }
 126     $collation->linear( $linear );
 127     # TODO We probably need to set the $witness->path arrays for each wit.
 128 }
 129
 130 =back
 131
 132 =head1 LICENSE
 133
 134 This package is free software and is provided "as is" without express
 135 or implied warranty.  You can redistribute it and/or modify it under
 136 the same terms as Perl itself.
 137
 138 =head1 AUTHOR
 139
 140 Tara L Andrews, aurum@cpan.org
 141
 142 =cut
 143
 144 1;