ease validation rules during collation init; fix bug in reading relationship merge

[scpubgit/stemmatology.git] / script / make_tradition.pl

diff --git a/script/make_tradition.pl b/script/make_tradition.pl
index e7da55b..50aab73 100755 (executable)
--- a/script/make_tradition.pl
+++ b/script/make_tradition.pl
@@ -4,18 +4,20 @@ use lib 'lib';
 use strict;
 use warnings;
 use Getopt::Long;
+use TryCatch;
 use Text::Tradition;
 use Text::Tradition::Directory;
-use Text::Tradition::StemmaUtil;
+use Text::Tradition::StemmaUtil qw/ character_input phylip_pars /;
 
 binmode STDERR, ":utf8";
 binmode STDOUT, ":utf8";
 eval { no warnings; binmode $DB::OUT, ":utf8"; };
 
-my( $informat, $inbase, $outformat, $help, $language, $name, $sep, $stemmafile, 
-       $dsn, $dbuser, $dbpass ) 
-    = ( '', '', '', '', 'Default', 'Tradition', "\t", '',
-       "dbi:SQLite:dbname=stemmaweb/db/traditions.db", undef, undef );
+# Variables with defaults
+my( $informat, $outformat, $language, $name, $sep, $dsn )  = ( '', '', 'Default', 
+       'Tradition', "\t", "dbi:SQLite:dbname=stemmaweb/db/traditions.db" );
+# Variables with no default
+my( $inbase, $help, $stemmafile,  $dbuser, $dbpass, $from, $to, $dbid, $debug );
 
 GetOptions( 'i|in=s'    => \$informat,
             'b|base=s'  => \$inbase,
@@ -26,8 +28,12 @@ GetOptions( 'i|in=s'    => \$informat,
             's|stemma=s' => \$stemmafile,
             'u|user=s'  => \$dbuser,
             'p|pass=s'  => \$dbpass,
+            'f|from=s'  => \$from,
+            't|to=s'    => \$to,
             'sep=s'            => \$sep,
             'dsn=s'            => \$dsn,
+           'dbid=s'    => \$dbid,
+               'debug'     => \$debug
     );
 
 if( $help ) {
@@ -49,6 +55,11 @@ unless( $outformat =~ /^(graphml|svg|dot|stemma|csv|db)$/ ) {
     help( "Output format must be one of db, graphml, svg, csv, stemma, or dot" );
 }
 
+if( $from || $to ) {
+       help( "Subgraphs only supported in GraphML format" ) 
+               unless $outformat eq 'graphml';
+}
+
 # Do we have a base if we need it?
 if( $informat =~ /^(KUL|CollateText)$/ && !$inbase ) {
     help( "$informat input needs a base text" );
@@ -77,12 +88,11 @@ if( $stemmafile ) {
 
 # Now output what we have been asked to.
 if( $outformat eq 'stemma' ) {
-    my $cdata = character_input( $tradition->collation->make_alignment_table );
-    my( $result, $tree ) = phylip_pars( $cdata );
-    if( $result ) {
-        print $tree;
-    } else {
-        print STDERR "Bad result: $tree";
+    my $cdata = character_input( $tradition->collation->alignment_table );
+    try {
+       print phylip_pars( $cdata );
+    } catch( Text::Tradition::Error $e ) {
+        print STDERR "Bad result: " . $e->message;
     }
 } elsif( $outformat eq 'db' ) {
        my $extra_args = { 'create' => 1 };
@@ -91,11 +101,20 @@ if( $outformat eq 'stemma' ) {
        my $dir = Text::Tradition::Directory->new( 'dsn' => $dsn, 
                'extra_args' => $extra_args );
        my $scope = $dir->new_scope;
-       my $uuid = $dir->store( $tradition );
+       my $uuid;
+       if( $dbid ) {
+               $uuid = $dir->store( $dbid => $tradition );
+       } else {
+               $uuid = $dir->store( $tradition );
+       }
        print STDERR "Saved tradition to database with ID $uuid\n";
 } else {
     my $output = "as_$outformat";
-    print $tradition->collation->$output();
+    my $opts = {};
+    $opts->{'from'} = $from if $from;
+    $opts->{'to'} = $to if $to;
+    $opts->{'nocalc'} = 1 if $debug;
+    print $tradition->collation->$output( $opts );
 }
 
 sub help {