[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';
}

=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 );
	my $ok = _check_permission( $c, $tradition );
	return unless $ok;

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

 GET /alignment/$textid

Returns an alignment table for the text specified at $textid.

=cut

sub alignment :Local :Args(1) {
	my( $self, $c, $textid ) = @_;
	my $tradition = $c->model('Directory')->tradition( $textid );
	my $ok = _check_permission( $c, $tradition );
	return unless $ok;

	my $collation = $tradition->collation;
	my $alignment = $collation->alignment_table;
	
	# Turn the table, so that witnesses are by column and the rows
	# are by rank.
	my $wits = [ map { $_->{'witness'} } @{$alignment->{'alignment'}} ];
	my $rows;
	foreach my $i ( 0 .. $alignment->{'length'} - 1 ) {
		my @rankrdgs = map { $_->{'tokens'}->[$i]->{'t'} } 
			@{$alignment->{'alignment'}};
		push( @$rows, { 'rank' => $i+1, 'readings' => \@rankrdgs } );
	}
	$c->stash->{'witnesses'} = $wits;
	$c->stash->{'table'} = $rows;
	$c->stash->{'template'} = 'alignment.tt';
}

=head2 stemma

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

Returns an SVG representation of the stemma hypothesis for the text.  If 
the URL is called with POST and a new dot string, updates the stemma and
returns the SVG as with GET.

=cut

sub stemma :Local :Args {
	my( $self, $c, $textid, $stemmaid ) = @_;
	my $m = $c->model('Directory');
	my $tradition = $m->tradition( $textid );
	my $ok = _check_permission( $c, $tradition );
	return unless $ok;

	$stemmaid = 0 unless defined $stemmaid;
	$c->stash->{'result'} = '';
	if( $tradition ) {
		if( $c->req->method eq 'POST' ) {
			# Update the stemma
			my $dot = $c->request->body_params->{'dot'};
			$tradition->add_stemma( $dot );
			$m->store( $tradition );
			$stemmaid = scalar( $tradition->stemma_count ) - 1;
		}
		
		$c->stash->{'result'} = $tradition->stemma_count > $stemmaid
			? $tradition->stemma( $stemmaid )->as_svg( { size => [ 500, 375 ] } )
			: '';
	}
	$c->forward('View::SVG');
}

=head2 stemmadot

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

=cut

sub stemmadot :Local :Args(1) {
	my( $self, $c, $textid ) = @_;
	my $m = $c->model('Directory');
	my $tradition = $m->tradition( $textid );
	my $ok = _check_permission( $c, $tradition );
	return unless $ok;
	
	$c->response->body( $tradition->stemma->editable );
	$c->forward('View::Plain');
}

=head1 AJAX methods for index page

=head2 textinfo

 GET /textinfo/$textid
 
Returns information about a particular text.

=cut

sub textinfo :Local :Args(1) {
	my( $self, $c, $textid ) = @_;
	my $tradition = $c->model('Directory')->tradition( $textid );
	my $ok = _check_permission( $c, $tradition );
	return unless $ok;

	# Need text name, witness list, scalar readings, scalar relationships, stemmata
	my $textinfo = {
		textid => $textid,
		traditionname => $tradition->name,
		witnesses => [ map { $_->sigil } $tradition->witnesses ],
		readings => scalar $tradition->collation->readings,
		relationships => scalar $tradition->collation->relationships
	};
	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');
}

# TODO alter text parameters

=head2 new

 POST /newtradition { name: <name>, inputfile: <fileupload> }
 
Creates a new tradition belonging to the logged-in user, according to the detected
file type. Returns the ID and name of the new tradition.
 
=cut

sub newtradition :Local :Args(0) {
	my( $self, $c ) = @_;
	if( $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( $ext ) = $upload->filename =~ /\.(\w+)$/;
		my %newopts = (
			'name' => $name,
			'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 eq 'txt' || $ext eq 'csv' || $ext eq 'xls' ) {
			# If it's Excel we need to pass xls => [true value];
			# otherwise we need to pass sep_char => [record separator].
			# Good thing record separators are true values.
			my $extrafield = $ext eq 'xls' ? 'xls' : 'sep_char';
			my $extraarg = $ext eq 'txt' ? "\t" : ',';
			try {
				$tradition = Text::Tradition->new( 
					%newopts,
					'input' => 'Tabular',
					$extrafield => $extraarg
					);
			} catch ( Text::Tradition::Error $e ) {
				$errmsg = $e->message;
			} catch {
				$errmsg = "Unexpected parsing error";
			}
		} elsif( $ext eq 'xlsx' ) {
			$c->stash->{'result'} = 
				{ 'error' => "Excel XML parsing not supported yet" };
			$c->response->status( 500 );
		} else {
			# Error unless we have a recognized filename extension
			$c->stash->{'result'} = 
				{ 'error' => "Unrecognized file type extension $ext" };
			$c->response->status( 500 );
		}
		
		# Save the tradition if we have it, and return its data or else the
		# error that occurred trying to make it.
		if( $tradition ) {
			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 };
		} else {
			$c->stash->{'result'} = 
				{ 'error' => "Error parsing tradition .$ext file: $errmsg" };
			$c->response->status( 500 );
		}
	} else {
		$c->stash->{'result'} = 
			{ 'error' => 'Cannot save a tradition without being logged in' };
		$c->response->status( 403 );
	}
	$c->forward('View::JSON');
}
 
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!
	$c->response->status( 403 );
	$c->response->body( 'You do not have permission to view this tradition.' );
	$c->detach( 'View::Plain' );
	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
fb6e49b3	69	=head2 variantgraph
	70
	71	GET /variantgraph/$textid
	72
	73	Returns the variant graph for the text specified at $textid, in SVG form.
	74
	75	=cut
	76
	77	sub variantgraph :Local :Args(1) {
	78	my( $self, $c, $textid ) = @_;
98a45925	79	my $tradition = $c->model('Directory')->tradition( $textid );
41279a86	80	my $ok = _check_permission( $c, $tradition );
	81	return unless $ok;
	82
b9a04e24	83	my $collation = $tradition->collation;
fb6e49b3	84	$c->stash->{'result'} = $collation->as_svg;
	85	$c->forward('View::SVG');
	86	}
	87
b8a92065	88	=head2 alignment
	89
	90	GET /alignment/$textid
	91
	92	Returns an alignment table for the text specified at $textid.
	93
	94	=cut
	95
	96	sub alignment :Local :Args(1) {
	97	my( $self, $c, $textid ) = @_;
98a45925	98	my $tradition = $c->model('Directory')->tradition( $textid );
41279a86	99	my $ok = _check_permission( $c, $tradition );
	100	return unless $ok;
	101
98a45925	102	my $collation = $tradition->collation;
ce956045	103	my $alignment = $collation->alignment_table;
b8a92065	104
	105	# Turn the table, so that witnesses are by column and the rows
	106	# are by rank.
	107	my $wits = [ map { $_->{'witness'} } @{$alignment->{'alignment'}} ];
	108	my $rows;
	109	foreach my $i ( 0 .. $alignment->{'length'} - 1 ) {
	110	my @rankrdgs = map { $_->{'tokens'}->[$i]->{'t'} }
	111	@{$alignment->{'alignment'}};
	112	push( @$rows, { 'rank' => $i+1, 'readings' => \@rankrdgs } );
	113	}
b8a92065	114	$c->stash->{'witnesses'} = $wits;
	115	$c->stash->{'table'} = $rows;
	116	$c->stash->{'template'} = 'alignment.tt';
	117	}
	118
	119	=head2 stemma
	120
41279a86	121	GET /stemma/$textid/$stemmaid
b8a92065	122	POST /stemma/$textid, { 'dot' => $dot_string }
	123
	124	Returns an SVG representation of the stemma hypothesis for the text. If
	125	the URL is called with POST and a new dot string, updates the stemma and
	126	returns the SVG as with GET.
	127
	128	=cut
	129
41279a86	130	sub stemma :Local :Args {
41279a86	131	my( $self, $c, $textid, $stemmaid ) = @_;
b8a92065	132	my $m = $c->model('Directory');
b8a92065	133	my $tradition = $m->tradition( $textid );
41279a86	134	my $ok = _check_permission( $c, $tradition );
	135	return unless $ok;
	136
	137	$stemmaid = 0 unless defined $stemmaid;
	138	$c->stash->{'result'} = '';
	139	if( $tradition ) {
	140	if( $c->req->method eq 'POST' ) {
	141	# Update the stemma
	142	my $dot = $c->request->body_params->{'dot'};
	143	$tradition->add_stemma( $dot );
	144	$m->store( $tradition );
	145	$stemmaid = scalar( $tradition->stemma_count ) - 1;
	146	}
	147
	148	$c->stash->{'result'} = $tradition->stemma_count > $stemmaid
	149	? $tradition->stemma( $stemmaid )->as_svg( { size => [ 500, 375 ] } )
	150	: '';
b8a92065	151	}
b8a92065	152	$c->forward('View::SVG');
	153	}
	154
	155	=head2 stemmadot
	156
	157	GET /stemmadot/$textid
	158
	159	Returns the 'dot' format representation of the current stemma hypothesis.
	160
	161	=cut
	162
	163	sub stemmadot :Local :Args(1) {
	164	my( $self, $c, $textid ) = @_;
	165	my $m = $c->model('Directory');
	166	my $tradition = $m->tradition( $textid );
41279a86	167	my $ok = _check_permission( $c, $tradition );
41279a86	168	return unless $ok;
b8a92065	169
	170	$c->response->body( $tradition->stemma->editable );
	171	$c->forward('View::Plain');
	172	}
	173
41279a86	174	=head1 AJAX methods for index page
	175
	176	=head2 textinfo
	177
	178	GET /textinfo/$textid
	179
	180	Returns information about a particular text.
	181
	182	=cut
	183
	184	sub textinfo :Local :Args(1) {
	185	my( $self, $c, $textid ) = @_;
	186	my $tradition = $c->model('Directory')->tradition( $textid );
	187	my $ok = _check_permission( $c, $tradition );
	188	return unless $ok;
	189
	190	# Need text name, witness list, scalar readings, scalar relationships, stemmata
	191	my $textinfo = {
	192	textid => $textid,
	193	traditionname => $tradition->name,
	194	witnesses => [ map { $_->sigil } $tradition->witnesses ],
	195	readings => scalar $tradition->collation->readings,
	196	relationships => scalar $tradition->collation->relationships
	197	};
	198	my @stemmasvg = map { $_->as_svg({ size => [ 500, 375 ] }) } $tradition->stemmata;
	199	map { $_ =~ s/\n/ /mg } @stemmasvg;
	200	$textinfo->{stemmata} = \@stemmasvg;
	201	$c->stash->{'result'} = $textinfo;
	202	$c->forward('View::JSON');
	203	}
	204
	205	# TODO alter text parameters
	206
	207	=head2 new
	208
	209	POST /newtradition { name: <name>, inputfile: <fileupload> }
	210
	211	Creates a new tradition belonging to the logged-in user, according to the detected
	212	file type. Returns the ID and name of the new tradition.
	213
	214	=cut
	215
	216	sub newtradition :Local :Args(0) {
	217	my( $self, $c ) = @_;
	218	if( $c->user_exists ) {
	219	my $user = $c->user->get_object;
	220	# Grab the file upload, check its name/extension, and call the
	221	# appropriate parser(s).
929ba7c8	222	my $upload = $c->request->upload('file');
41279a86	223	my $name = $c->request->param('name') \|\| 'Uploaded tradition';
	224	my( $ext ) = $upload->filename =~ /\.(\w+)$/;
	225	my %newopts = (
	226	'name' => $name,
929ba7c8	227	'file' => $upload->tempname
41279a86	228	);
	229	my $tradition;
	230	my $errmsg;
	231	if( $ext eq 'xml' ) {
	232	# Try the different XML parsing options to see if one works.
	233	foreach my $type ( qw/ CollateX CTE TEI / ) {
	234	try {
	235	$tradition = Text::Tradition->new( %newopts, 'input' => $type );
	236	} catch ( Text::Tradition::Error $e ) {
	237	$errmsg = $e->message;
	238	} catch {
	239	$errmsg = "Unexpected parsing error";
	240	}
	241	last if $tradition;
	242	}
6988c178	243	} elsif( $ext eq 'txt' \|\| $ext eq 'csv' \|\| $ext eq 'xls' ) {
	244	# If it's Excel we need to pass xls => [true value];
	245	# otherwise we need to pass sep_char => [record separator].
	246	# Good thing record separators are true values.
	247	my $extrafield = $ext eq 'xls' ? 'xls' : 'sep_char';
	248	my $extraarg = $ext eq 'txt' ? "\t" : ',';
41279a86	249	try {
	250	$tradition = Text::Tradition->new(
	251	%newopts,
	252	'input' => 'Tabular',
6988c178	253	$extrafield => $extraarg
41279a86	254	);
	255	} catch ( Text::Tradition::Error $e ) {
	256	$errmsg = $e->message;
	257	} catch {
	258	$errmsg = "Unexpected parsing error";
	259	}
6988c178	260	} elsif( $ext eq 'xlsx' ) {
41279a86	261	$c->stash->{'result'} =
6988c178	262	{ 'error' => "Excel XML parsing not supported yet" };
41279a86	263	$c->response->status( 500 );
	264	} else {
	265	# Error unless we have a recognized filename extension
	266	$c->stash->{'result'} =
	267	{ 'error' => "Unrecognized file type extension $ext" };
	268	$c->response->status( 500 );
	269	}
	270
	271	# Save the tradition if we have it, and return its data or else the
	272	# error that occurred trying to make it.
	273	if( $tradition ) {
929ba7c8	274	my $m = $c->model('Directory');
929ba7c8	275	$user->add_tradition( $tradition );
41279a86	276	my $id = $c->model('Directory')->store( $tradition );
929ba7c8	277	$c->model('Directory')->store( $user );
41279a86	278	$c->stash->{'result'} = { 'id' => $id, 'name' => $tradition->name };
	279	} else {
	280	$c->stash->{'result'} =
	281	{ 'error' => "Error parsing tradition .$ext file: $errmsg" };
	282	$c->response->status( 500 );
	283	}
	284	} else {
	285	$c->stash->{'result'} =
	286	{ 'error' => 'Cannot save a tradition without being logged in' };
	287	$c->response->status( 403 );
	288	}
	289	$c->forward('View::JSON');
	290	}
	291
	292	sub _check_permission {
	293	my( $c, $tradition ) = @_;
	294	my $user = $c->user_exists ? $c->user->get_object : undef;
	295	if( $user ) {
929ba7c8	296	return 'full' if ( $user->is_admin \|\|
929ba7c8	297	( $tradition->has_user && $tradition->user->id eq $user->id ) );
080f8a02	298	}
	299	# Text doesn't belong to us, so maybe it's public?
	300	return 'readonly' if $tradition->public;
	301
	302	# ...nope. Forbidden!
929ba7c8	303	$c->response->status( 403 );
	304	$c->response->body( 'You do not have permission to view this tradition.' );
	305	$c->detach( 'View::Plain' );
	306	return 0;
41279a86	307	}
41279a86	308
b8a92065	309	=head2 default
	310
	311	Standard 404 error page
	312
	313	=cut
	314
	315	sub default :Path {
	316	my ( $self, $c ) = @_;
	317	$c->response->body( 'Page not found' );
	318	$c->response->status(404);
	319	}
	320
	321	=head2 end
	322
	323	Attempt to render a view, if needed.
	324
	325	=cut
	326
	327	sub end : ActionClass('RenderView') {}
	328
	329	=head1 AUTHOR
	330
	331	Tara L Andrews
	332
	333	=head1 LICENSE
	334
	335	This library is free software. You can redistribute it and/or modify
	336	it under the same terms as Perl itself.
	337
	338	=cut
	339
	340	__PACKAGE__->meta->make_immutable;
	341
	342	1;