From: Tara L Andrews <tla@mit.edu>
Date: Fri, 29 Aug 2014 20:03:19 +0000 (+0200)
Subject: capture warnings in a variable if asked
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bf5cb67b7b8a5986ed1156de42db6bdac16f787d;p=scpubgit%2Fstemmatology.git

capture warnings in a variable if asked
---

diff --git a/base/lib/Text/Tradition/Parser/CTE.pm b/base/lib/Text/Tradition/Parser/CTE.pm
index d619b8e..a189b13 100644
--- a/base/lib/Text/Tradition/Parser/CTE.pm
+++ b/base/lib/Text/Tradition/Parser/CTE.pm
@@ -10,6 +10,8 @@ use XML::LibXML;
 use XML::LibXML::XPathContext;
 use TryCatch;
 
+binmode( STDERR, ':utf8' );
+
 =head1 NAME
 
 Text::Tradition::Parser::CTE
@@ -49,6 +51,9 @@ sub parse {
 	# CTE uses a DTD rather than any xmlns-based parsing.  Thus we
 	# need no namespace handling.
 	# Get the witnesses and create the witness objects.
+	%sigil_for = ();
+	%apps = ();
+	%has_ac = ();
 	foreach my $wit_el ( $xpc->findnodes( '//sourceDesc/listWit/witness' ) ) {
 		# The witness xml:id is used internally, and is *not* the sigil name.
 		my $id= $wit_el->getAttribute( 'xml:id' );
@@ -65,7 +70,7 @@ sub parse {
 			my @sig_parts = $xpc->findnodes( 'descendant::text()', $wit_el );
 			$sig = _stringify_sigil( @sig_parts );
 		}
-		say STDERR "Adding witness $sig ($identifier)";
+		do_warn( $opts, "Adding witness $sig ($identifier)" );
 		$tradition->add_witness( sigil => $sig, identifier => $identifier, 
 			sourcetype => 'collation' );
 		$sigil_for{'#'.$id} = $sig;  # Make life easy by keying on the ID ref syntax
@@ -129,7 +134,7 @@ sub parse {
     # Finally, add explicit witness paths, remove the base paths, and remove
     # the app/anchor tags.
     try {
-	    _expand_all_paths( $c );
+	    _expand_all_paths( $c, $opts );
 	} catch( Text::Tradition::Error $e ) {
 		throw( $e->message );
 	} catch {
@@ -310,7 +315,7 @@ sub _add_readings {
 			}
 			if( $anchor && @lemma ) {
 				my $success = _attach_transposition( $c, \@lemma, $anchor, 
-					\@transp_nodes, \@witlist, $flag->{'TR'} );
+					\@transp_nodes, \@witlist, $flag->{'TR'}, $opts );
 				unless( $success ) {
 					# If we didn't manage to insert the displaced reading,
 					# then restore it here rather than silently deleting it.
@@ -386,7 +391,7 @@ sub _return_lemma {
 # $witlist contains the list of applicable witnesses
 # $reftxt contains the text to match, after which the $rdgseq should go.
 sub _attach_transposition {
-	my( $c, $lemmaseq, $anchor, $rdgseq, $witlist, $reftxt ) = @_;
+	my( $c, $lemmaseq, $anchor, $rdgseq, $witlist, $reftxt, $opts ) = @_;
 	my @refwords = split( /\s+/, $reftxt );
 	my $checked = $c->reading( $anchor );
 	my $found;
@@ -426,7 +431,7 @@ sub _attach_transposition {
 			throw( "Lemma at $found and transposed sequence different lengths?!" );
 		}
 	} else {
-		say STDERR "WARNING: Unable to find $reftxt in base text for transposition";
+		do_warn( $opts, "WARNING: Unable to find $reftxt in base text for transposition" );
 	}
 	return $success;
 }
@@ -466,7 +471,7 @@ sub interpret {
 	} elsif( $reading =~ /^in[uv]\.$/ 
 			 || $reading =~ /^tr(ans(p)?)?\.$/ ) {
 		# Hope it is two words.
-		say STDERR "WARNING: want to invert a lemma that is not two words" 
+		do_warn( $opts, "WARNING: want to invert a lemma that is not two words" )
 			unless scalar( @words ) == 2;
 		$reading = join( ' ', reverse( @words ) );
 	} elsif( $reading =~ /^iter(\.|at)$/ ) {
@@ -602,7 +607,7 @@ sub _get_sigil {
 }
 
 sub _expand_all_paths { 
-    my( $c ) = @_;
+    my( $c, $opts ) = @_;
     
     # Walk the collation and fish out the paths for each witness
     foreach my $wit ( $c->tradition->witnesses ) {
@@ -635,7 +640,7 @@ sub _expand_all_paths {
 	    	next if $r->is_start;
 	    	my $tag = $r->id;
 	    	$tag =~ s/^r(\d+)\.\d+/$1/;
-    		say STDERR "Deleting orphan reading $r / " . $r->text;
+    		do_warn( $opts, "Deleting orphan reading $r / " . $r->text );
     		push( @{$suspect_apps{$tag}}, $r->id ) if $tag =~ /^\d+$/;
     		$c->del_reading( $r );
     	}
@@ -648,10 +653,10 @@ sub _expand_all_paths {
     		$tag =~ s/^r(\d+)\.\d+/$1/;
     		push( @{$suspect_apps{$tag}}, $_ );
     	}
-		_dump_suspects( %suspect_apps );
+		_dump_suspects( $opts, %suspect_apps );
     	throw( "Remaining hanging readings: @bad" );
 	}
-	_dump_suspects( %suspect_apps ) if keys %suspect_apps;
+	_dump_suspects( $opts, %suspect_apps ) if keys %suspect_apps;
 }
 
 sub _add_wit_path {
@@ -667,13 +672,15 @@ sub _add_wit_path {
 }
 
 sub _dump_suspects {
+	my $opts = shift;
 	my %list = @_;
-	say STDERR "Suspect apparatus entries:";
+	my @warning = "Suspect apparatus entries:";
 	foreach my $suspect ( sort { $a <=> $b } keys %list ) {
 		my @badrdgs = @{$list{$suspect}};
-		say STDERR _print_apparatus( $suspect );
-		say STDERR "\t(Linked to readings @badrdgs)";
+		push( @warning, _print_apparatus( $suspect ) );
+		push( @warning, "\t(Linked to readings @badrdgs)" );
 	}
+	do_warn( $opts, join( "\n", @warning ) );
 }
 
 sub _print_apparatus {
@@ -736,6 +743,15 @@ sub _print_apparatus {
 	return $appstring;
 }
 
+sub do_warn {
+	my( $opts, $message ) = @_;
+	if( $opts->{'warnings_to'} ) {
+		push( @{$opts->{'warnings_to'}}, $message );
+	} else {
+		say STDERR $message;
+	}
+}
+
 sub throw {
 	Text::Tradition::Error->throw( 
 		'ident' => 'Parser::CTE error',