X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fstemmaweb%2FController%2FRelation.pm;h=a8e63d0b1de2e88ec416af96f17e4d3f84c45fdd;hb=2a65f5c92fc04069b827194aa591a5795bc9b81b;hp=1c3bf8e7425fb97702a08af7afb6d1505336b4df;hpb=995efe7648cfa5cc4d8224a7752c3950d7935e14;p=scpubgit%2Fstemmaweb.git

diff --git a/lib/stemmaweb/Controller/Relation.pm b/lib/stemmaweb/Controller/Relation.pm
index 1c3bf8e..a8e63d0 100644
--- a/lib/stemmaweb/Controller/Relation.pm
+++ b/lib/stemmaweb/Controller/Relation.pm
@@ -10,6 +10,14 @@ use TryCatch;
 BEGIN { extends 'Catalyst::Controller' }
 
 
+sub throw {
+	Text::Tradition::Error->throw(
+		'ident' => 'Collation error',
+		'message' => $_[0],
+		);
+}
+
+
 =head1 NAME
 
 stemmaweb::Controller::Relation - Controller for the relationship mapper
@@ -70,7 +78,10 @@ sub main :Chained('text') :PathPart('') :Args(0) {
 	my( $self, $c ) = @_;
 	my $tradition = delete $c->stash->{'tradition'};
 	my $collation = $tradition->collation;
-	
+
+	# Stash text direction to use in JS.
+	$c->stash->{'direction'} = $collation->direction;
+
 	# Stash the relationship definitions
 	$c->stash->{'relationship_scopes'} = 
 		to_json( find_type_constraint( 'RelationshipScope' )->values );
@@ -133,7 +144,7 @@ sub main :Chained('text') :PathPart('') :Args(0) {
 	$c->stash->{'startseg'} = $startseg if defined $startseg;
 	$c->stash->{'svg_string'} = $svg_str;
 	$c->stash->{'text_title'} = $tradition->name;
-	if( $tradition->can('language') ) {
+	if( $tradition->can('language') && $tradition->language ) {
 		$c->stash->{'text_lang'} = $tradition->language;
 		$c->stash->{'can_morphologize'} = 1;
 	} else {
@@ -425,6 +436,114 @@ sub reading :Chained('text') :PathPart :Args(1) {
 
 }
 
+sub compress :Chained('text') :PathPart :Args(0) {
+	my( $self, $c ) = @_;
+	my $tradition = delete $c->stash->{'tradition'};
+	my $collation = $tradition->collation;
+	my $m = $c->model('Directory');
+
+	my @rids = $c->request->param('readings[]');
+	my @readings;
+
+	foreach my $rid (@rids) {
+		my $rdg = $collation->reading( $rid );
+
+		push @readings, $rdg;
+	}
+
+	my $len = scalar @readings;
+
+	if( $c->request->method eq 'POST' ) {
+		if( $c->stash->{'permission'} ne 'full' ) {
+			$c->response->status( '403' );
+			$c->stash->{'result'} = { 
+				'error' => 'You do not have permission to modify this tradition.' };
+			$c->detach('View::JSON');
+			return;
+		}
+
+		# Sanity check: first save the original text of each witness.
+		my %origtext;
+		foreach my $wit ( $tradition->witnesses ) {
+			$origtext{$wit->sigil} = $collation->path_text( $wit->sigil );
+			if( $wit->is_layered ) {
+				my $acsig = $wit->sigil . $collation->ac_label;
+				$origtext{$acsig} = $collation->path_text( $acsig );
+			}
+		}
+
+		my $first = 0;
+
+		for (my $i = 0; $i < $len; $i++) {
+			my $rdg = $readings[$i];
+
+			if ($rdg->is_combinable) {
+				$first = $i;
+				last;
+			}
+		}
+
+		my @nodes;
+		push @nodes, "$readings[$first]";
+
+		for (my $i = $first+1; $i < $len; $i++) {
+			my $rdg = $readings[$first];
+			my $next = $readings[$i];
+
+			last unless $next->is_combinable;
+			push @nodes, "$next";
+
+			try {
+				$collation->merge_readings( "$rdg", "$next", 1 );
+			} catch ($e) {
+				$c->stash->{result} = {
+					error_msg => $e->message,
+				};
+
+				$c->detach('View::JSON');
+			}
+		}
+		
+		try {
+			# Finally, make sure we haven't screwed anything up.
+			foreach my $wit ( $tradition->witnesses ) {
+				my $pathtext = $collation->path_text( $wit->sigil );
+				throw( "Text differs for witness " . $wit->sigil )
+					unless $pathtext eq $origtext{$wit->sigil};
+				if( $wit->is_layered ) {
+					my $acsig = $wit->sigil . $collation->ac_label;
+					$pathtext = $collation->path_text( $acsig );
+					throw( "Layered text differs for witness " . $wit->sigil )
+						unless $pathtext eq $origtext{$acsig};
+				}
+			}
+		} catch ($e) {
+			$c->stash->{result} = {
+				error_msg => $e->message,
+			};
+
+			$c->detach('View::JSON');
+		}
+
+
+		$collation->relations->rebuild_equivalence();
+		$collation->calculate_ranks();
+
+		$m->save($collation);
+
+		if ($collation->direction eq 'RL') {
+			@nodes = reverse @nodes;
+		}
+
+		$c->stash->{'result'} = {
+			success => 1,
+			nodes   => \@nodes,
+		};
+
+		$c->forward('View::JSON');
+	}
+}
+
 =head2 merge
 
  POST relation/$textid/merge { data }