[scpubgit/stemmatology.git] / stemmaweb / lib / stemmaweb / Controller / Root.pm

package stemmaweb::Controller::Root;
use Moose;
use namespace::autoclean;
use Text::Tradition::Analysis qw/ run_analysis /;
use TryCatch;


BEGIN { extends 'Catalyst::Controller' }

#
# Sets the actions in this controller to be registered with no prefix
# so they function identically to actions created in MyApp.pm
#
__PACKAGE__->config(namespace => '');

=head1 NAME

stemmaweb::Controller::Root - Root Controller for stemmaweb

=head1 DESCRIPTION

Serves up the main container pages.

=head1 URLs

=head2 index

The root page (/).  Serves the main container page, from which the various
components will be loaded.

=cut

sub index :Path :Args(0) {
    my ( $self, $c ) = @_;

    $c->stash->{template} = 'index.tt';
}

=head1 Elements of index page

=head2 directory

 GET /directory

Serves a snippet of HTML that lists the available texts.  This returns texts belonging to the logged-in user if any, otherwise it returns all public texts.

=cut

sub directory :Local :Args(0) {
	my( $self, $c ) = @_;
    my $m = $c->model('Directory');
    # Is someone logged in?
    my %usertexts;
    if( $c->user_exists ) {
    	my $user = $c->user->get_object;
    	my @list = $m->traditionlist( $user );
    	map { $usertexts{$_->{id}} = 1 } @list;
		$c->stash->{usertexts} = \@list;
		$c->stash->{is_admin} = 1 if $user->is_admin;
	}
	# List public (i.e. readonly) texts separately from any user (i.e.
	# full access) texts that exist. Admin users therefore have nothing
	# in this list.
	my @plist = grep { !$usertexts{$_->{id}} } $m->traditionlist('public');
	$c->stash->{publictexts} = \@plist;
	$c->stash->{template} = 'directory.tt';
}

=head1 AJAX methods for traditions and their properties

=head2 newtradition

 POST /newtradition,
 	{ name: <name>,
 	  language: <language>,
 	  public: <is_public>,
 	  file: <fileupload> }
 
Creates a new tradition belonging to the logged-in user, with the given name
and the collation given in the uploaded file. The file type is indicated via
the filename extension (.csv, .txt, .xls, .xlsx, .xml). Returns the ID and 
name of the new tradition.
 
=cut

sub newtradition :Local :Args(0) {
	my( $self, $c ) = @_;
	return _json_error( $c, 403, 'Cannot save a tradition without being logged in' )
		unless $c->user_exists;

	my $user = $c->user->get_object;
	# Grab the file upload, check its name/extension, and call the
	# appropriate parser(s).
	my $upload = $c->request->upload('file');
	my $name = $c->request->param('name') || 'Uploaded tradition';
	my $lang = $c->request->param( 'language' ) || 'Default';
	my $public = $c->request->param( 'public' ) ? 1 : undef;
	my( $ext ) = $upload->filename =~ /\.(\w+)$/;
	my %newopts = (
		'name' => $name,
		'language' => $lang,
		'public' => $public,
		'file' => $upload->tempname
		);

	my $tradition;
	my $errmsg;
	if( $ext eq 'xml' ) {
		# Try the different XML parsing options to see if one works.
		foreach my $type ( qw/ CollateX CTE TEI / ) {
			try {
				$tradition = Text::Tradition->new( %newopts, 'input' => $type );
			} catch ( Text::Tradition::Error $e ) {
				$errmsg = $e->message;
			} catch {
				$errmsg = "Unexpected parsing error";
			}
			last if $tradition;
		}
	} elsif( $ext =~ /^(txt|csv|xls(x)?)$/ ) {
		# If it's Excel we need to pass excel => $ext;
		# otherwise we need to pass sep_char => [record separator].
		if( $ext =~ /xls/ ) {
			$newopts{'excel'} = $ext;
		} else {
			$newopts{'sep_char'} = $ext eq 'txt' ? "\t" : ',';
		}
		try {
			$tradition = Text::Tradition->new( 
				%newopts,
				'input' => 'Tabular',
				);
		} catch ( Text::Tradition::Error $e ) {
			$errmsg = $e->message;
		} catch {
			$errmsg = "Unexpected parsing error";
		}
	} else {
		# Error unless we have a recognized filename extension
		return _json_error( $c, 500, "Unrecognized file type extension $ext" );
	}
	
	# Save the tradition if we have it, and return its data or else the
	# error that occurred trying to make it.
	if( $errmsg ) {
		return _json_error( $c, 500, "Error parsing tradition .$ext file: $errmsg" );
	} elsif( !$tradition ) {
		return _json_error( $c, 500, "No error caught but tradition not created" );
	}

	my $m = $c->model('Directory');
	$user->add_tradition( $tradition );
	my $id = $c->model('Directory')->store( $tradition );
	$c->model('Directory')->store( $user );
	$c->stash->{'result'} = { 'id' => $id, 'name' => $tradition->name };
	$c->forward('View::JSON');
}

=head2 textinfo

 GET /textinfo/$textid
 POST /textinfo/$textid, 
 	{ name: $new_name, 
 	  language: $new_language,
 	  public: $is_public, 
 	  owner: $new_userid } # only admin users can update the owner
 
Returns information about a particular text.

=cut

sub textinfo :Local :Args(1) {
	my( $self, $c, $textid ) = @_;
	my $tradition = $c->model('Directory')->tradition( $textid );
	unless( $tradition ) {
		return _json_error( $c, 500, "No tradition with ID $textid" );
	}	
	my $ok = _check_permission( $c, $tradition );
	return unless $ok;
	if( $c->req->method eq 'POST' ) {
		return _json_error( $c, 403, 
			'You do not have permission to update this tradition' ) 
			unless $ok eq 'full';
		my $params = $c->request->parameters;
		# Handle changes to owner-accessible parameters
		my $m = $c->model('Directory');
		my $changed;
		# Handle name param - easy
		if( exists $params->{name} ) {
			my $newname = delete $params->{name};
			unless( $tradition->name eq $newname ) {
				try {
					$tradition->name( $newname );
					$changed = 1;
				} catch {
					return _json_error( $c, 500, "Error setting name to $newname" );
				}
			}
		}
		# Handle language param, making Default => null
		my $langval = delete $params->{language} || 'Default';
		unless( $tradition->language eq $langval ) {
			try {
				$tradition->language( $langval );
				$changed = 1;
			} catch {
				return _json_error( $c, 500, "Error setting language to $langval" );
			}
		}

		# Handle our boolean
		my $ispublic = $tradition->public;
		if( delete $params->{'public'} ) {  # if it's any true value...
			$tradition->public( 1 );
			$changed = 1 unless $ispublic;
		} else {  # the checkbox was unchecked, ergo it should not be public
			$tradition->public( 0 );
			$changed = 1 if $ispublic;
		}
		
		# Handle ownership change
		my $newuser;
		if( exists $params->{'owner'} ) {
			# Only admins can update user / owner
			my $newownerid = delete $params->{'owner'};
			unless( $tradition->has_user && $tradition->user->id eq $newownerid ) {
				unless( $c->user->get_object->is_admin ) {
					return _json_error( $c, 403, 
						"Only admin users can change tradition ownership" );
				}
				$newuser = $m->find_user({ username => $newownerid });
				unless( $newuser ) {
					return _json_error( $c, 500, "No such user " . $newownerid );
				}
				$newuser->add_tradition( $tradition );
				$changed = 1;
			}
		}
		# TODO check for rogue parameters
		if( scalar keys %$params ) {
			my $rogueparams = join( ', ', keys %$params );
			return _json_error( $c, 403, "Request parameters $rogueparams not recognized" );
		}
		# If we safely got to the end, then write to the database.
		$m->save( $tradition ) if $changed;
		$m->save( $newuser ) if $newuser;		
	}

	# Now return the current textinfo, whether GET or successful POST.
	my $textinfo = {
		textid => $textid,
		name => $tradition->name,
		language => $tradition->language,
		public => $tradition->public,
		owner => $tradition->user ? $tradition->user->id : undef,
		witnesses => [ map { $_->sigil } $tradition->witnesses ],
	};
	my @stemmasvg = map { $_->as_svg({ size => [ 500, 375 ] }) } $tradition->stemmata;
	map { $_ =~ s/\n/ /mg } @stemmasvg;
	$textinfo->{stemmata} = \@stemmasvg;
	$c->stash->{'result'} = $textinfo;
	$c->forward('View::JSON');
}

=head2 variantgraph

 GET /variantgraph/$textid
 
Returns the variant graph for the text specified at $textid, in SVG form.

=cut

sub variantgraph :Local :Args(1) {
	my( $self, $c, $textid ) = @_;
	my $tradition = $c->model('Directory')->tradition( $textid );
	unless( $tradition ) {
		return _json_error( $c, 500, "No tradition with ID $textid" );
	}	
	my $ok = _check_permission( $c, $tradition );
	return unless $ok;

	my $collation = $tradition->collation;
	$c->stash->{'result'} = $collation->as_svg;
	$c->forward('View::SVG');
}
	
=head2 stemma

 GET /stemma/$textid/$stemmaseq
 POST /stemma/$textid/$stemmaseq, { 'dot' => $dot_string }

Returns an SVG representation of the given stemma hypothesis for the text.  
If the URL is called with POST, the stemma at $stemmaseq will be altered
to reflect the definition in $dot_string. If $stemmaseq is 'n', a new
stemma will be added.

=cut

sub stemma :Local :Args(2) {
	my( $self, $c, $textid, $stemmaid ) = @_;
	my $m = $c->model('Directory');
	my $tradition = $m->tradition( $textid );
	unless( $tradition ) {
		return _json_error( $c, 500, "No tradition with ID $textid" );
	}	
	my $ok = _check_permission( $c, $tradition );
	return unless $ok;

	$c->stash->{'result'} = '';
	my $stemma;
	if( $c->req->method eq 'POST' ) {
		if( $ok eq 'full' ) {
			my $dot = $c->request->body_params->{'dot'};
			try {
				if( $stemmaid eq 'n' ) {
					# We are adding a new stemma.
					$stemma = $tradition->add_stemma( 'dot' => $dot );
					$stemmaid = $tradition->stemma_count - 1;
				} elsif( $stemmaid < $tradition->stemma_count ) {
					# We are updating an existing stemma.
					$stemma = $tradition->stemma( $stemmaid );
					$stemma->alter_graph( $dot );
				} else {
					# Unrecognized stemma ID
					return _json_error( $c, 500, "No stemma at index $stemmaid, cannot update" );
				}
			} catch ( Text::Tradition::Error $e ) {
				return _json_error( $c, 500, $e->message );
			}
			$m->store( $tradition );
		} else {
			# No permissions to update the stemma
			return _json_error( $c, 403, 
				'You do not have permission to update stemmata for this tradition' );
		}
	}
	
	# For a GET or a successful POST request, return the SVG representation
	# of the stemma in question, if any.
	if( !$stemma && $tradition->stemma_count > $stemmaid ) {
		$stemma = $tradition->stemma( $stemmaid );
	}
	my $stemma_xml = $stemma ? $stemma->as_svg( { size => [ 500, 375 ] } ) : '';
	# What was requested, XML or JSON?
	my $return_view = 'SVG';
	if( my $accept_header = $c->req->header('Accept') ) {
		$c->log->debug( "Received Accept header: $accept_header" );
		foreach my $type ( split( /,\s*/, $accept_header ) ) {
			# If we were first asked for XML, return SVG
			last if $type =~ /^(application|text)\/xml$/;
			# If we were first asked for JSON, return JSON
			if( $type eq 'application/json' ) {
				$return_view = 'JSON';
				last;
			}
		}
	}
	if( $return_view eq 'SVG' ) {
		$c->stash->{'result'} = $stemma_xml;
		$c->forward('View::SVG');
	} else { # JSON
		$stemma_xml =~ s/\n/ /mg;
		$c->stash->{'result'} = { 'stemmaid' => $stemmaid, 'stemmasvg' => $stemma_xml };
		$c->forward('View::JSON');
	}
}

=head2 stemmadot

 GET /stemmadot/$textid/$stemmaseq
 
Returns the 'dot' format representation of the current stemma hypothesis.

=cut

sub stemmadot :Local :Args(2) {
	my( $self, $c, $textid, $stemmaid ) = @_;
	my $m = $c->model('Directory');
	my $tradition = $m->tradition( $textid );
	unless( $tradition ) {
		return _json_error( $c, 500, "No tradition with ID $textid" );
	}	
	my $ok = _check_permission( $c, $tradition );
	return unless $ok;
	my $stemma = $tradition->stemma( $stemmaid );
	unless( $stemma ) {
		return _json_error( $c, 500, "Tradition $textid has no stemma ID $stemmaid" );
	}
	# Get the dot and transmute its line breaks to literal '|n'
	$c->stash->{'result'} = { 'dot' =>  $stemma->editable( { linesep => '|n' } ) };
	$c->forward('View::JSON');
}

####################
### Helper functions
####################

# Helper to check what permission, if any, the active user has for
# the given tradition
sub _check_permission {
	my( $c, $tradition ) = @_;
    my $user = $c->user_exists ? $c->user->get_object : undef;
    if( $user ) {
    	return 'full' if ( $user->is_admin || 
    		( $tradition->has_user && $tradition->user->id eq $user->id ) );
    }
	# Text doesn't belong to us, so maybe it's public?
	return 'readonly' if $tradition->public;

	# ...nope. Forbidden!
	return _json_error( $c, 403, 'You do not have permission to view this tradition.' );
}

# Helper to throw a JSON exception
sub _json_error {
	my( $c, $code, $errmsg ) = @_;
	$c->response->status( $code );
	$c->stash->{'result'} = { 'error' => $errmsg };
	$c->forward('View::JSON');
	return 0;
}

=head2 default

Standard 404 error page

=cut

sub default :Path {
    my ( $self, $c ) = @_;
    $c->response->body( 'Page not found' );
    $c->response->status(404);
}

=head2 end

Attempt to render a view, if needed.

=cut

sub end : ActionClass('RenderView') {}

=head1 AUTHOR

Tara L Andrews

=head1 LICENSE

This library is free software. You can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

__PACKAGE__->meta->make_immutable;

1;
Commit	Line	Data
5c9ecf66	1	package stemmaweb::Controller::Root;
dbcf12a6	2	use Moose;
dbcf12a6	3	use namespace::autoclean;
3837c155	4	use Text::Tradition::Analysis qw/ run_analysis /;
852190b9	5	use TryCatch;
3837c155	6
dbcf12a6	7
	8	BEGIN { extends 'Catalyst::Controller' }
	9
	10	#
	11	# Sets the actions in this controller to be registered with no prefix
	12	# so they function identically to actions created in MyApp.pm
	13	#
	14	__PACKAGE__->config(namespace => '');
	15
	16	=head1 NAME
	17
5c9ecf66	18	stemmaweb::Controller::Root - Root Controller for stemmaweb
dbcf12a6	19
	20	=head1 DESCRIPTION
	21
6b70c348	22	Serves up the main container pages.
dbcf12a6	23
6b70c348	24	=head1 URLs
dbcf12a6	25
	26	=head2 index
	27
6b70c348	28	The root page (/). Serves the main container page, from which the various
6b70c348	29	components will be loaded.
dbcf12a6	30
	31	=cut
	32
	33	sub index :Path :Args(0) {
	34	my ( $self, $c ) = @_;
	35
6b70c348	36	$c->stash->{template} = 'index.tt';
	37	}
	38
	39	=head1 Elements of index page
	40
	41	=head2 directory
	42
	43	GET /directory
	44
7c256818	45	Serves a snippet of HTML that lists the available texts. This returns texts belonging to the logged-in user if any, otherwise it returns all public texts.
6b70c348	46
6b70c348	47	=cut
7c256818	48
2376359f	49	sub directory :Local :Args(0) {
6b70c348	50	my( $self, $c ) = @_;
3837c155	51	my $m = $c->model('Directory');
27a20fbe	52	# Is someone logged in?
3524c08f	53	my %usertexts;
27a20fbe	54	if( $c->user_exists ) {
27a20fbe	55	my $user = $c->user->get_object;
3524c08f	56	my @list = $m->traditionlist( $user );
	57	map { $usertexts{$_->{id}} = 1 } @list;
	58	$c->stash->{usertexts} = \@list;
27a20fbe	59	$c->stash->{is_admin} = 1 if $user->is_admin;
27a20fbe	60	}
3524c08f	61	# List public (i.e. readonly) texts separately from any user (i.e.
	62	# full access) texts that exist. Admin users therefore have nothing
	63	# in this list.
	64	my @plist = grep { !$usertexts{$_->{id}} } $m->traditionlist('public');
	65	$c->stash->{publictexts} = \@plist;
6b70c348	66	$c->stash->{template} = 'directory.tt';
	67	}
	68
0bded693	69	=head1 AJAX methods for traditions and their properties
cf9626aa	70
0bded693	71	=head2 newtradition
	72
	73	POST /newtradition,
	74	{ name: <name>,
	75	language: <language>,
	76	public: <is_public>,
	77	file: <fileupload> }
cf9626aa	78
0bded693	79	Creates a new tradition belonging to the logged-in user, with the given name
	80	and the collation given in the uploaded file. The file type is indicated via
	81	the filename extension (.csv, .txt, .xls, .xlsx, .xml). Returns the ID and
	82	name of the new tradition.
	83
	84	=cut
	85
	86	sub newtradition :Local :Args(0) {
	87	my( $self, $c ) = @_;
	88	return _json_error( $c, 403, 'Cannot save a tradition without being logged in' )
	89	unless $c->user_exists;
	90
	91	my $user = $c->user->get_object;
	92	# Grab the file upload, check its name/extension, and call the
	93	# appropriate parser(s).
	94	my $upload = $c->request->upload('file');
	95	my $name = $c->request->param('name') \|\| 'Uploaded tradition';
	96	my $lang = $c->request->param( 'language' ) \|\| 'Default';
	97	my $public = $c->request->param( 'public' ) ? 1 : undef;
	98	my( $ext ) = $upload->filename =~ /\.(\w+)$/;
	99	my %newopts = (
	100	'name' => $name,
	101	'language' => $lang,
	102	'public' => $public,
	103	'file' => $upload->tempname
	104	);
	105
	106	my $tradition;
	107	my $errmsg;
	108	if( $ext eq 'xml' ) {
	109	# Try the different XML parsing options to see if one works.
	110	foreach my $type ( qw/ CollateX CTE TEI / ) {
	111	try {
	112	$tradition = Text::Tradition->new( %newopts, 'input' => $type );
	113	} catch ( Text::Tradition::Error $e ) {
	114	$errmsg = $e->message;
	115	} catch {
	116	$errmsg = "Unexpected parsing error";
	117	}
	118	last if $tradition;
	119	}
	120	} elsif( $ext =~ /^(txt\|csv\|xls(x)?)$/ ) {
	121	# If it's Excel we need to pass excel => $ext;
	122	# otherwise we need to pass sep_char => [record separator].
	123	if( $ext =~ /xls/ ) {
	124	$newopts{'excel'} = $ext;
	125	} else {
	126	$newopts{'sep_char'} = $ext eq 'txt' ? "\t" : ',';
	127	}
	128	try {
	129	$tradition = Text::Tradition->new(
	130	%newopts,
	131	'input' => 'Tabular',
	132	);
	133	} catch ( Text::Tradition::Error $e ) {
	134	$errmsg = $e->message;
	135	} catch {
	136	$errmsg = "Unexpected parsing error";
	137	}
	138	} else {
	139	# Error unless we have a recognized filename extension
	140	return _json_error( $c, 500, "Unrecognized file type extension $ext" );
	141	}
	142
143	# Save the tradition if we have it, and return its data or else the
144	# error that occurred trying to make it.
145	if( $errmsg ) {
146	return _json_error( $c, 500, "Error parsing tradition .$ext file: $errmsg" );
147	} elsif( !$tradition ) {
148	return _json_error( $c, 500, "No error caught but tradition not created" );
149	}
150
151	my $m = $c->model('Directory');
152	$user->add_tradition( $tradition );
153	my $id = $c->model('Directory')->store( $tradition );
154	$c->model('Directory')->store( $user );
155	$c->stash->{'result'} = { 'id' => $id, 'name' => $tradition->name };
156	$c->forward('View::JSON');
157	}
158
159	=head2 textinfo
160
161	GET /textinfo/$textid
162	POST /textinfo/$textid,
163	{ name: $new_name,
164	language: $new_language,
165	public: $is_public,
166	owner: $new_userid } # only admin users can update the owner
167
168	Returns information about a particular text.
cf9626aa	169
	170	=cut
	171
0bded693	172	sub textinfo :Local :Args(1) {
cf9626aa	173	my( $self, $c, $textid ) = @_;
3524c08f	174	my $tradition = $c->model('Directory')->tradition( $textid );
0bded693	175	unless( $tradition ) {
	176	return _json_error( $c, 500, "No tradition with ID $textid" );
	177	}
852190b9	178	my $ok = _check_permission( $c, $tradition );
852190b9	179	return unless $ok;
0bded693	180	if( $c->req->method eq 'POST' ) {
	181	return _json_error( $c, 403,
	182	'You do not have permission to update this tradition' )
	183	unless $ok eq 'full';
	184	my $params = $c->request->parameters;
	185	# Handle changes to owner-accessible parameters
	186	my $m = $c->model('Directory');
	187	my $changed;
789cbe47	188	# Handle name param - easy
	189	if( exists $params->{name} ) {
	190	my $newname = delete $params->{name};
	191	unless( $tradition->name eq $newname ) {
	192	try {
	193	$tradition->name( $newname );
0bded693	194	$changed = 1;
789cbe47	195	} catch {
789cbe47	196	return _json_error( $c, 500, "Error setting name to $newname" );
0bded693	197	}
	198	}
	199	}
789cbe47	200	# Handle language param, making Default => null
	201	my $langval = delete $params->{language} \|\| 'Default';
	202	unless( $tradition->language eq $langval ) {
	203	try {
	204	$tradition->language( $langval );
	205	$changed = 1;
	206	} catch {
	207	return _json_error( $c, 500, "Error setting language to $langval" );
	208	}
	209	}
	210
0bded693	211	# Handle our boolean
789cbe47	212	my $ispublic = $tradition->public;
0bded693	213	if( delete $params->{'public'} ) { # if it's any true value...
0bded693	214	$tradition->public( 1 );
789cbe47	215	$changed = 1 unless $ispublic;
	216	} else { # the checkbox was unchecked, ergo it should not be public
	217	$tradition->public( 0 );
	218	$changed = 1 if $ispublic;
0bded693	219	}
789cbe47	220
789cbe47	221	# Handle ownership change
0bded693	222	my $newuser;
	223	if( exists $params->{'owner'} ) {
	224	# Only admins can update user / owner
	225	my $newownerid = delete $params->{'owner'};
	226	unless( $tradition->has_user && $tradition->user->id eq $newownerid ) {
	227	unless( $c->user->get_object->is_admin ) {
	228	return _json_error( $c, 403,
	229	"Only admin users can change tradition ownership" );
	230	}
789cbe47	231	$newuser = $m->find_user({ username => $newownerid });
0bded693	232	unless( $newuser ) {
789cbe47	233	return _json_error( $c, 500, "No such user " . $newownerid );
0bded693	234	}
	235	$newuser->add_tradition( $tradition );
	236	$changed = 1;
	237	}
	238	}
	239	# TODO check for rogue parameters
	240	if( scalar keys %$params ) {
	241	my $rogueparams = join( ', ', keys %$params );
	242	return _json_error( $c, 403, "Request parameters $rogueparams not recognized" );
	243	}
	244	# If we safely got to the end, then write to the database.
	245	$m->save( $tradition ) if $changed;
	246	$m->save( $newuser ) if $newuser;
	247	}
852190b9	248
0bded693	249	# Now return the current textinfo, whether GET or successful POST.
	250	my $textinfo = {
	251	textid => $textid,
	252	name => $tradition->name,
	253	language => $tradition->language,
	254	public => $tradition->public,
	255	owner => $tradition->user ? $tradition->user->id : undef,
	256	witnesses => [ map { $_->sigil } $tradition->witnesses ],
	257	};
	258	my @stemmasvg = map { $_->as_svg({ size => [ 500, 375 ] }) } $tradition->stemmata;
	259	map { $_ =~ s/\n/ /mg } @stemmasvg;
	260	$textinfo->{stemmata} = \@stemmasvg;
	261	$c->stash->{'result'} = $textinfo;
	262	$c->forward('View::JSON');
cf9626aa	263	}
6b70c348	264
0bded693	265	=head2 variantgraph
6b70c348	266
0bded693	267	GET /variantgraph/$textid
	268
	269	Returns the variant graph for the text specified at $textid, in SVG form.
6b70c348	270
	271	=cut
	272
0bded693	273	sub variantgraph :Local :Args(1) {
6b70c348	274	my( $self, $c, $textid ) = @_;
3524c08f	275	my $tradition = $c->model('Directory')->tradition( $textid );
0bded693	276	unless( $tradition ) {
	277	return _json_error( $c, 500, "No tradition with ID $textid" );
	278	}
852190b9	279	my $ok = _check_permission( $c, $tradition );
	280	return unless $ok;
	281
3524c08f	282	my $collation = $tradition->collation;
0bded693	283	$c->stash->{'result'} = $collation->as_svg;
0bded693	284	$c->forward('View::SVG');
6b70c348	285	}
0bded693	286
6b70c348	287	=head2 stemma
6b70c348	288
0bded693	289	GET /stemma/$textid/$stemmaseq
0bded693	290	POST /stemma/$textid/$stemmaseq, { 'dot' => $dot_string }
6b70c348	291
0bded693	292	Returns an SVG representation of the given stemma hypothesis for the text.
	293	If the URL is called with POST, the stemma at $stemmaseq will be altered
	294	to reflect the definition in $dot_string. If $stemmaseq is 'n', a new
	295	stemma will be added.
6b70c348	296
	297	=cut
	298
0bded693	299	sub stemma :Local :Args(2) {
852190b9	300	my( $self, $c, $textid, $stemmaid ) = @_;
6b70c348	301	my $m = $c->model('Directory');
6b70c348	302	my $tradition = $m->tradition( $textid );
0bded693	303	unless( $tradition ) {
	304	return _json_error( $c, 500, "No tradition with ID $textid" );
	305	}
852190b9	306	my $ok = _check_permission( $c, $tradition );
	307	return unless $ok;
	308
852190b9	309	$c->stash->{'result'} = '';
0bded693	310	my $stemma;
	311	if( $c->req->method eq 'POST' ) {
	312	if( $ok eq 'full' ) {
852190b9	313	my $dot = $c->request->body_params->{'dot'};
0bded693	314	try {
	315	if( $stemmaid eq 'n' ) {
	316	# We are adding a new stemma.
	317	$stemma = $tradition->add_stemma( 'dot' => $dot );
789cbe47	318	$stemmaid = $tradition->stemma_count - 1;
0bded693	319	} elsif( $stemmaid < $tradition->stemma_count ) {
	320	# We are updating an existing stemma.
	321	$stemma = $tradition->stemma( $stemmaid );
	322	$stemma->alter_graph( $dot );
	323	} else {
	324	# Unrecognized stemma ID
	325	return _json_error( $c, 500, "No stemma at index $stemmaid, cannot update" );
	326	}
	327	} catch ( Text::Tradition::Error $e ) {
	328	return _json_error( $c, 500, $e->message );
	329	}
852190b9	330	$m->store( $tradition );
0bded693	331	} else {
	332	# No permissions to update the stemma
	333	return _json_error( $c, 403,
	334	'You do not have permission to update stemmata for this tradition' );
852190b9	335	}
6b70c348	336	}
0bded693	337
	338	# For a GET or a successful POST request, return the SVG representation
	339	# of the stemma in question, if any.
0bded693	340	if( !$stemma && $tradition->stemma_count > $stemmaid ) {
	341	$stemma = $tradition->stemma( $stemmaid );
	342	}
789cbe47	343	my $stemma_xml = $stemma ? $stemma->as_svg( { size => [ 500, 375 ] } ) : '';
	344	# What was requested, XML or JSON?
	345	my $return_view = 'SVG';
	346	if( my $accept_header = $c->req->header('Accept') ) {
	347	$c->log->debug( "Received Accept header: $accept_header" );
	348	foreach my $type ( split( /,\s*/, $accept_header ) ) {
	349	# If we were first asked for XML, return SVG
	350	last if $type =~ /^(application\|text)\/xml$/;
	351	# If we were first asked for JSON, return JSON
	352	if( $type eq 'application/json' ) {
	353	$return_view = 'JSON';
	354	last;
	355	}
	356	}
	357	}
	358	if( $return_view eq 'SVG' ) {
	359	$c->stash->{'result'} = $stemma_xml;
	360	$c->forward('View::SVG');
	361	} else { # JSON
	362	$stemma_xml =~ s/\n/ /mg;
	363	$c->stash->{'result'} = { 'stemmaid' => $stemmaid, 'stemmasvg' => $stemma_xml };
	364	$c->forward('View::JSON');
	365	}
dbcf12a6	366	}
dbcf12a6	367
6b70c348	368	=head2 stemmadot
12720144	369
0bded693	370	GET /stemmadot/$textid/$stemmaseq
6b70c348	371
	372	Returns the 'dot' format representation of the current stemma hypothesis.
	373
	374	=cut
	375
0bded693	376	sub stemmadot :Local :Args(2) {
0bded693	377	my( $self, $c, $textid, $stemmaid ) = @_;
6b70c348	378	my $m = $c->model('Directory');
6b70c348	379	my $tradition = $m->tradition( $textid );
0bded693	380	unless( $tradition ) {
	381	return _json_error( $c, 500, "No tradition with ID $textid" );
	382	}
852190b9	383	my $ok = _check_permission( $c, $tradition );
852190b9	384	return unless $ok;
0bded693	385	my $stemma = $tradition->stemma( $stemmaid );
	386	unless( $stemma ) {
	387	return _json_error( $c, 500, "Tradition $textid has no stemma ID $stemmaid" );
	388	}
	389	# Get the dot and transmute its line breaks to literal '\|n'
	390	$c->stash->{'result'} = { 'dot' => $stemma->editable( { linesep => '\|n' } ) };
852190b9	391	$c->forward('View::JSON');
	392	}
	393
0bded693	394	####################
	395	### Helper functions
	396	####################
852190b9	397
0bded693	398	# Helper to check what permission, if any, the active user has for
0bded693	399	# the given tradition
852190b9	400	sub _check_permission {
	401	my( $c, $tradition ) = @_;
	402	my $user = $c->user_exists ? $c->user->get_object : undef;
	403	if( $user ) {
2b4baccc	404	return 'full' if ( $user->is_admin \|\|
2b4baccc	405	( $tradition->has_user && $tradition->user->id eq $user->id ) );
75ce4f7a	406	}
	407	# Text doesn't belong to us, so maybe it's public?
	408	return 'readonly' if $tradition->public;
	409
	410	# ...nope. Forbidden!
0bded693	411	return _json_error( $c, 403, 'You do not have permission to view this tradition.' );
	412	}
	413
	414	# Helper to throw a JSON exception
	415	sub _json_error {
	416	my( $c, $code, $errmsg ) = @_;
	417	$c->response->status( $code );
	418	$c->stash->{'result'} = { 'error' => $errmsg };
	419	$c->forward('View::JSON');
2b4baccc	420	return 0;
852190b9	421	}
852190b9	422
dbcf12a6	423	=head2 default
	424
	425	Standard 404 error page
	426
	427	=cut
	428
	429	sub default :Path {
	430	my ( $self, $c ) = @_;
	431	$c->response->body( 'Page not found' );
	432	$c->response->status(404);
	433	}
	434
	435	=head2 end
	436
	437	Attempt to render a view, if needed.
	438
	439	=cut
	440
	441	sub end : ActionClass('RenderView') {}
	442
	443	=head1 AUTHOR
	444
	445	Tara L Andrews
	446
	447	=head1 LICENSE
	448
	449	This library is free software. You can redistribute it and/or modify
	450	it under the same terms as Perl itself.
	451
	452	=cut
	453
	454	__PACKAGE__->meta->make_immutable;
	455
	456	1;