Merge branch 'master' of github.com:tla/stemmatology

diff --git a/lib/Text/Tradition/Collation.pm b/lib/Text/Tradition/Collation.pm
index 7606cc2..2879026 100644 (file)
--- a/lib/Text/Tradition/Collation.pm
+++ b/lib/Text/Tradition/Collation.pm
@@ -313,7 +313,10 @@ sub as_dot {
     my( $self, $view ) = @_;
     $view = 'path' unless $view;
     # TODO consider making some of these things configurable
-    my $dot = sprintf( "digraph %s {\n", $self->tradition->name );
+    my $graph_name = $self->tradition->name;
+    $graph_name =~ s/[^\w\s]//g;
+    $graph_name = join( '_', split( /\s+/, $graph_name ) );
+    my $dot = sprintf( "digraph %s {\n", $graph_name );
     $dot .= "\tedge [ arrowhead=open ];\n";
     $dot .= "\tgraph [ rankdir=LR ];\n";
     $dot .= sprintf( "\tnode [ fontsize=%d, fillcolor=%s, style=%s, shape=%s ];\n",
@@ -556,6 +559,7 @@ sub _make_witness_row {
     foreach my $rdg ( @$path ) {
         my $rtext = $rdg->text;
         $rtext = '#LACUNA#' if $rdg->is_lacuna;
+        # print STDERR "No rank for " . $rdg->name . "\n" unless defined $rdg->rank;
         $char_hash{$rdg->rank} = $noderefs ? $rdg : $rtext;
     }
     my @row = map { $char_hash{$_} } @$positions;
@@ -988,7 +992,13 @@ sub calculate_ranks {
     }
     # Transfer our rankings from the topological graph to the real one.
     foreach my $r ( $self->readings ) {
-        $r->rank( $node_ranks->{$rel_containers{$r->name}} );
+        if( defined $node_ranks->{$rel_containers{$r->name}} ) {
+            $r->rank( $node_ranks->{$rel_containers{$r->name}} );
+        } else {
+            $DB::single = 1;
+            die "No rank calculated for node " . $r->name 
+                . " - do you have a cycle in the graph?";
+        }
     }
 }
 

diff --git a/lib/Text/Tradition/Parser/BaseText.pm b/lib/Text/Tradition/Parser/BaseText.pm
index e0e6ec2..545ca6d 100644 (file)
--- a/lib/Text/Tradition/Parser/BaseText.pm
+++ b/lib/Text/Tradition/Parser/BaseText.pm
@@ -17,7 +17,7 @@ merge_base( $graph, 'reference.txt', @apparatus_entries )
 =head1 DESCRIPTION
 
 For an overview of the package, see the documentation for the
-Text::Tradition::Graph module.
+Text::Tradition module.
 
 This module is meant for use with certain of the other Parser classes
 - whenever a list of variants is given with reference to a base text,
@@ -31,9 +31,9 @@ will join those listed variants onto the reference text.
 
 =item B<parse>
 
-parse( $graph, %opts );
+parse( $graph, $opts );
 
-Takes an initialized graph and a set of options, which must include:
+Takes an initialized graph and a hashref of options, which must include:
 - 'base' - the base text referenced by the variants
 - 'format' - the format of the variant list
 - 'data' - the variants, in the given format.
@@ -45,7 +45,8 @@ sub parse {
 
     my $format_mod = 'Text::Tradition::Parser::' . $opts->{'input'};
     load( $format_mod );
-    my @apparatus_entries = $format_mod->can('read')->( $opts->{'file'} );
+    # TODO Handle a string someday if we ever have a format other than KUL
+    my @apparatus_entries = $format_mod->can('read')->( $opts );
     merge_base( $tradition->collation, $opts->{'base'}, @apparatus_entries );
 }
 
@@ -285,65 +286,12 @@ sub merge_base {
     }
 
     ### HACKY HACKY Do some one-off path corrections here.
-    if( $collation->linear ) {
-       my $c = $collation;
-       my $end = $SHORTEND ? $SHORTEND : 155;
-       # Vb11
-       my $path;
-       if( $end > 16 ) {
-           $c->merge_readings( $c->reading('rdg_1/16.3.0'), $c->reading('rdg_1/16.2.1') );
-           $path = $c->tradition->witness('Vb11')->path;
-           splice( @$path, 209, 2, $c->reading( 'rdg_1/16.3.0' ), $c->reading( 'rdg_1/16.2.2' ) );
-           $path = $c->tradition->witness('Vb11')->uncorrected_path;
-           splice( @$path, 209, 2, $c->reading( 'rdg_1/16.3.0' ), $c->reading( 'rdg_1/16.2.2' ) );
-       }
-       # What else?
-       # Vb26:
-       $path = $c->tradition->witness('Vb26')->path;
-       splice( @$path, 618, 0, $c->reading('rdg_1/46.1.1') ) if $end > 46;
-       # Vb13:
-       $path = $c->tradition->witness('Vb13')->path;
-       splice( @$path, 782, 0, $c->reading( '58,5' ) ) if $end > 58;
-       $path = $c->tradition->witness('Vb13')->uncorrected_path;
-       splice( @$path, 758, 0, $c->reading( '58,5' ) ) if $end > 58;
-       # Vb20 a.c.: 
-       $path = $c->tradition->witness('Vb20')->uncorrected_path;
-       splice( @$path, 1251, 1, $c->reading( '94,4' ) ) if $end > 94;
-       # Vb5:
-       $path = $c->tradition->witness('Vb5')->path;
-       splice( @$path, 1436, 0, $c->reading('rdg_1/106.5.1') ) if $end > 106;
-       # extraneous:
-       $c->del_reading( 'rdg_2/147.6.13' );
-       $c->del_reading( 'rdg_2/147.6.14' );
-       $c->del_reading( 'rdg_2/147.6.15' );
-       
-    } else {
-       my $c = $collation;
-       my $end = $SHORTEND ? $SHORTEND : 155;
-       # Vb5:
-       my $path = $c->tradition->witness('Vb5')->path;
-       splice( @$path, 1436, 0, $c->reading('106,14') ) if $end > 106;
-       # Vb11: 
-       $path = $c->tradition->witness('Vb11')->path;
-       if( $end > 16 ) {
-           $c->merge_readings( $c->reading('rdg_1/16.3.0'), $c->reading('rdg_1/16.2.1') );
-           splice( @$path, 209, 2, $c->reading( 'rdg_1/16.3.0' ), $c->reading( '16,1' ) );
-       }
-       # Vb13:
-       $path = $c->tradition->witness('Vb13')->path;
-       splice( @$path, 782, 0, $c->reading( '58,5' ) ) if $end > 58;
-       $path = $c->tradition->witness('Vb13')->uncorrected_path;
-       splice( @$path, 758, 0, $c->reading( '58,5' ) ) if $end > 58;
-       # Vb20 a.c.: 
-       $path = $c->tradition->witness('Vb20')->uncorrected_path;
-       splice( @$path, 1251, 1, $c->reading( '94,4' ) ) if $end > 94;
-       # Vb26: 
-       $path = $c->tradition->witness('Vb26')->path;
-       splice( @$path, 618, 0, $c->reading('46,2') ) if $end > 46;
-    }
+    require( 'data/boodts/s158.HACK' );
+    KUL::HACK::pre_path_hack( $collation );
 
     # Now walk paths and calculate positional rank.
     $collation->make_witness_paths();
+    KUL::HACK::post_path_hack( $collation );
     # Have to check relationship validity at this point, because before that
     # we had no paths.
 #     foreach my $rel ( $collation->relationships ) {

diff --git a/make_tradition.pl b/make_tradition.pl
index 41c575f..a7a5030 100755 (executable)
--- a/make_tradition.pl
+++ b/make_tradition.pl
@@ -11,15 +11,16 @@ binmode STDERR, ":utf8";
 binmode STDOUT, ":utf8";
 eval { no warnings; binmode $DB::OUT, ":utf8"; };
 
-my( $informat, $inbase, $outformat, $help, $linear, $HACK ) 
+my( $informat, $inbase, $outformat, $help, $linear, $name, $HACK ) 
     = ( '', '', '', '', 1, 0 );
 
-GetOptions( 'i|in=s'   => \$informat,
-            'b|base=s' => \$inbase,
-            'o|out=s'  => \$outformat,
+GetOptions( 'i|in=s'    => \$informat,
+            'b|base=s'  => \$inbase,
+            'o|out=s'   => \$outformat,
             'l|linear!' => \$linear,
-            'h|help' => \$help,
-            'hack' => \$HACK,
+            'n|name'    => \$name,
+            'h|help'    => \$help,
+            'hack'      => \$HACK,
     );
 
 if( $help ) {
@@ -53,6 +54,7 @@ my %args = ( 'input' => $informat,
              'file' => $input,
              'linear' => $linear );
 $args{'base'} = $inbase if $inbase;
+$args{'name'} = $name if $name;
 my $tradition = Text::Tradition->new( %args );
 
 ### Custom hacking