[scpubgit/stemmaweb.git] / 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( !$newownerid || 
				( $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
b8a92065	1	package stemmaweb::Controller::Root;
	2	use Moose;
	3	use namespace::autoclean;
	4	use Text::Tradition::Analysis qw/ run_analysis /;
41279a86	5	use TryCatch;
b8a92065	6
	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
	18	stemmaweb::Controller::Root - Root Controller for stemmaweb
	19
	20	=head1 DESCRIPTION
	21
	22	Serves up the main container pages.
	23
	24	=head1 URLs
	25
	26	=head2 index
	27
	28	The root page (/). Serves the main container page, from which the various
	29	components will be loaded.
	30
	31	=cut
	32
	33	sub index :Path :Args(0) {
	34	my ( $self, $c ) = @_;
	35
	36	$c->stash->{template} = 'index.tt';
	37	}
	38
	39	=head1 Elements of index page
	40
	41	=head2 directory
	42
	43	GET /directory
	44
70ccaf75	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.
b8a92065	46
b8a92065	47	=cut
70ccaf75	48
b8a92065	49	sub directory :Local :Args(0) {
	50	my( $self, $c ) = @_;
	51	my $m = $c->model('Directory');
69799996	52	# Is someone logged in?
98a45925	53	my %usertexts;
69799996	54	if( $c->user_exists ) {
69799996	55	my $user = $c->user->get_object;
98a45925	56	my @list = $m->traditionlist( $user );
	57	map { $usertexts{$_->{id}} = 1 } @list;
	58	$c->stash->{usertexts} = \@list;
69799996	59	$c->stash->{is_admin} = 1 if $user->is_admin;
69799996	60	}
98a45925	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;
b8a92065	66	$c->stash->{template} = 'directory.tt';
	67	}
	68
75354c3a	69	=head1 AJAX methods for traditions and their properties
fb6e49b3	70
75354c3a	71	=head2 newtradition
	72
	73	POST /newtradition,
	74	{ name: <name>,
	75	language: <language>,
	76	public: <is_public>,
	77	file: <fileupload> }
fb6e49b3	78
75354c3a	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.
fb6e49b3	169
	170	=cut
	171
75354c3a	172	sub textinfo :Local :Args(1) {
fb6e49b3	173	my( $self, $c, $textid ) = @_;
98a45925	174	my $tradition = $c->model('Directory')->tradition( $textid );
75354c3a	175	unless( $tradition ) {
	176	return _json_error( $c, 500, "No tradition with ID $textid" );
	177	}
41279a86	178	my $ok = _check_permission( $c, $tradition );
41279a86	179	return unless $ok;
75354c3a	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;
ce1c5863	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 );
75354c3a	194	$changed = 1;
ce1c5863	195	} catch {
ce1c5863	196	return _json_error( $c, 500, "Error setting name to $newname" );
75354c3a	197	}
	198	}
	199	}
ce1c5863	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
75354c3a	211	# Handle our boolean
ce1c5863	212	my $ispublic = $tradition->public;
75354c3a	213	if( delete $params->{'public'} ) { # if it's any true value...
75354c3a	214	$tradition->public( 1 );
ce1c5863	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;
75354c3a	219	}
ce1c5863	220
ce1c5863	221	# Handle ownership change
75354c3a	222	my $newuser;
	223	if( exists $params->{'owner'} ) {
	224	# Only admins can update user / owner
	225	my $newownerid = delete $params->{'owner'};
4f849eea	226	unless( !$newownerid \|\|
4f849eea	227	( $tradition->has_user && $tradition->user->id eq $newownerid ) ) {
75354c3a	228	unless( $c->user->get_object->is_admin ) {
	229	return _json_error( $c, 403,
	230	"Only admin users can change tradition ownership" );
	231	}
ce1c5863	232	$newuser = $m->find_user({ username => $newownerid });
75354c3a	233	unless( $newuser ) {
ce1c5863	234	return _json_error( $c, 500, "No such user " . $newownerid );
75354c3a	235	}
	236	$newuser->add_tradition( $tradition );
	237	$changed = 1;
	238	}
	239	}
	240	# TODO check for rogue parameters
	241	if( scalar keys %$params ) {
	242	my $rogueparams = join( ', ', keys %$params );
	243	return _json_error( $c, 403, "Request parameters $rogueparams not recognized" );
	244	}
	245	# If we safely got to the end, then write to the database.
	246	$m->save( $tradition ) if $changed;
	247	$m->save( $newuser ) if $newuser;
	248	}
41279a86	249
75354c3a	250	# Now return the current textinfo, whether GET or successful POST.
	251	my $textinfo = {
	252	textid => $textid,
	253	name => $tradition->name,
	254	language => $tradition->language,
	255	public => $tradition->public,
	256	owner => $tradition->user ? $tradition->user->id : undef,
	257	witnesses => [ map { $_->sigil } $tradition->witnesses ],
	258	};
	259	my @stemmasvg = map { $_->as_svg({ size => [ 500, 375 ] }) } $tradition->stemmata;
	260	map { $_ =~ s/\n/ /mg } @stemmasvg;
	261	$textinfo->{stemmata} = \@stemmasvg;
	262	$c->stash->{'result'} = $textinfo;
	263	$c->forward('View::JSON');
fb6e49b3	264	}
b8a92065	265
75354c3a	266	=head2 variantgraph
b8a92065	267
75354c3a	268	GET /variantgraph/$textid
	269
	270	Returns the variant graph for the text specified at $textid, in SVG form.
b8a92065	271
	272	=cut
	273
75354c3a	274	sub variantgraph :Local :Args(1) {
b8a92065	275	my( $self, $c, $textid ) = @_;
98a45925	276	my $tradition = $c->model('Directory')->tradition( $textid );
75354c3a	277	unless( $tradition ) {
	278	return _json_error( $c, 500, "No tradition with ID $textid" );
	279	}
41279a86	280	my $ok = _check_permission( $c, $tradition );
	281	return unless $ok;
	282
98a45925	283	my $collation = $tradition->collation;
75354c3a	284	$c->stash->{'result'} = $collation->as_svg;
75354c3a	285	$c->forward('View::SVG');
b8a92065	286	}
75354c3a	287
b8a92065	288	=head2 stemma
b8a92065	289
75354c3a	290	GET /stemma/$textid/$stemmaseq
75354c3a	291	POST /stemma/$textid/$stemmaseq, { 'dot' => $dot_string }
b8a92065	292
75354c3a	293	Returns an SVG representation of the given stemma hypothesis for the text.
	294	If the URL is called with POST, the stemma at $stemmaseq will be altered
	295	to reflect the definition in $dot_string. If $stemmaseq is 'n', a new
	296	stemma will be added.
b8a92065	297
	298	=cut
	299
75354c3a	300	sub stemma :Local :Args(2) {
41279a86	301	my( $self, $c, $textid, $stemmaid ) = @_;
b8a92065	302	my $m = $c->model('Directory');
b8a92065	303	my $tradition = $m->tradition( $textid );
75354c3a	304	unless( $tradition ) {
	305	return _json_error( $c, 500, "No tradition with ID $textid" );
	306	}
41279a86	307	my $ok = _check_permission( $c, $tradition );
	308	return unless $ok;
	309
41279a86	310	$c->stash->{'result'} = '';
75354c3a	311	my $stemma;
	312	if( $c->req->method eq 'POST' ) {
	313	if( $ok eq 'full' ) {
41279a86	314	my $dot = $c->request->body_params->{'dot'};
75354c3a	315	try {
	316	if( $stemmaid eq 'n' ) {
	317	# We are adding a new stemma.
	318	$stemma = $tradition->add_stemma( 'dot' => $dot );
ce1c5863	319	$stemmaid = $tradition->stemma_count - 1;
75354c3a	320	} elsif( $stemmaid < $tradition->stemma_count ) {
	321	# We are updating an existing stemma.
	322	$stemma = $tradition->stemma( $stemmaid );
	323	$stemma->alter_graph( $dot );
	324	} else {
	325	# Unrecognized stemma ID
	326	return _json_error( $c, 500, "No stemma at index $stemmaid, cannot update" );
	327	}
	328	} catch ( Text::Tradition::Error $e ) {
	329	return _json_error( $c, 500, $e->message );
	330	}
41279a86	331	$m->store( $tradition );
75354c3a	332	} else {
	333	# No permissions to update the stemma
	334	return _json_error( $c, 403,
	335	'You do not have permission to update stemmata for this tradition' );
41279a86	336	}
b8a92065	337	}
75354c3a	338
	339	# For a GET or a successful POST request, return the SVG representation
	340	# of the stemma in question, if any.
75354c3a	341	if( !$stemma && $tradition->stemma_count > $stemmaid ) {
	342	$stemma = $tradition->stemma( $stemmaid );
	343	}
ce1c5863	344	my $stemma_xml = $stemma ? $stemma->as_svg( { size => [ 500, 375 ] } ) : '';
	345	# What was requested, XML or JSON?
	346	my $return_view = 'SVG';
	347	if( my $accept_header = $c->req->header('Accept') ) {
	348	$c->log->debug( "Received Accept header: $accept_header" );
	349	foreach my $type ( split( /,\s*/, $accept_header ) ) {
	350	# If we were first asked for XML, return SVG
	351	last if $type =~ /^(application\|text)\/xml$/;
	352	# If we were first asked for JSON, return JSON
	353	if( $type eq 'application/json' ) {
	354	$return_view = 'JSON';
	355	last;
	356	}
	357	}
	358	}
	359	if( $return_view eq 'SVG' ) {
	360	$c->stash->{'result'} = $stemma_xml;
	361	$c->forward('View::SVG');
	362	} else { # JSON
	363	$stemma_xml =~ s/\n/ /mg;
	364	$c->stash->{'result'} = { 'stemmaid' => $stemmaid, 'stemmasvg' => $stemma_xml };
	365	$c->forward('View::JSON');
	366	}
b8a92065	367	}
	368
	369	=head2 stemmadot
	370
75354c3a	371	GET /stemmadot/$textid/$stemmaseq
b8a92065	372
	373	Returns the 'dot' format representation of the current stemma hypothesis.
	374
	375	=cut
	376
75354c3a	377	sub stemmadot :Local :Args(2) {
75354c3a	378	my( $self, $c, $textid, $stemmaid ) = @_;
b8a92065	379	my $m = $c->model('Directory');
b8a92065	380	my $tradition = $m->tradition( $textid );
75354c3a	381	unless( $tradition ) {
	382	return _json_error( $c, 500, "No tradition with ID $textid" );
	383	}
41279a86	384	my $ok = _check_permission( $c, $tradition );
41279a86	385	return unless $ok;
75354c3a	386	my $stemma = $tradition->stemma( $stemmaid );
	387	unless( $stemma ) {
	388	return _json_error( $c, 500, "Tradition $textid has no stemma ID $stemmaid" );
	389	}
	390	# Get the dot and transmute its line breaks to literal '\|n'
	391	$c->stash->{'result'} = { 'dot' => $stemma->editable( { linesep => '\|n' } ) };
41279a86	392	$c->forward('View::JSON');
	393	}
	394
75354c3a	395	####################
	396	### Helper functions
	397	####################
41279a86	398
75354c3a	399	# Helper to check what permission, if any, the active user has for
75354c3a	400	# the given tradition
41279a86	401	sub _check_permission {
	402	my( $c, $tradition ) = @_;
	403	my $user = $c->user_exists ? $c->user->get_object : undef;
	404	if( $user ) {
929ba7c8	405	return 'full' if ( $user->is_admin \|\|
929ba7c8	406	( $tradition->has_user && $tradition->user->id eq $user->id ) );
080f8a02	407	}
	408	# Text doesn't belong to us, so maybe it's public?
	409	return 'readonly' if $tradition->public;
	410
	411	# ...nope. Forbidden!
75354c3a	412	return _json_error( $c, 403, 'You do not have permission to view this tradition.' );
	413	}
	414
	415	# Helper to throw a JSON exception
	416	sub _json_error {
	417	my( $c, $code, $errmsg ) = @_;
	418	$c->response->status( $code );
	419	$c->stash->{'result'} = { 'error' => $errmsg };
	420	$c->forward('View::JSON');
929ba7c8	421	return 0;
41279a86	422	}
41279a86	423
b8a92065	424	=head2 default
	425
	426	Standard 404 error page
	427
	428	=cut
	429
	430	sub default :Path {
	431	my ( $self, $c ) = @_;
	432	$c->response->body( 'Page not found' );
	433	$c->response->status(404);
	434	}
	435
	436	=head2 end
	437
	438	Attempt to render a view, if needed.
	439
	440	=cut
	441
	442	sub end : ActionClass('RenderView') {}
	443
	444	=head1 AUTHOR
	445
	446	Tara L Andrews
	447
	448	=head1 LICENSE
	449
	450	This library is free software. You can redistribute it and/or modify
	451	it under the same terms as Perl itself.
	452
	453	=cut
	454
	455	__PACKAGE__->meta->make_immutable;
	456
	457	1;