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

=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 =~ /^(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";
			}
		} 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
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
cf9626aa	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 ) = @_;
3524c08f	79	my $tradition = $c->model('Directory')->tradition( $textid );
852190b9	80	my $ok = _check_permission( $c, $tradition );
	81	return unless $ok;
	82
b365fbae	83	my $collation = $tradition->collation;
cf9626aa	84	$c->stash->{'result'} = $collation->as_svg;
	85	$c->forward('View::SVG');
	86	}
	87
6b70c348	88	=head2 alignment
	89
	90	GET /alignment/$textid
	91
	92	Returns an alignment table for the text specified at $textid.
	93
	94	=cut
	95
2376359f	96	sub alignment :Local :Args(1) {
6b70c348	97	my( $self, $c, $textid ) = @_;
3524c08f	98	my $tradition = $c->model('Directory')->tradition( $textid );
852190b9	99	my $ok = _check_permission( $c, $tradition );
	100	return unless $ok;
	101
3524c08f	102	my $collation = $tradition->collation;
7f52eac8	103	my $alignment = $collation->alignment_table;
6b70c348	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	}
6b70c348	114	$c->stash->{'witnesses'} = $wits;
	115	$c->stash->{'table'} = $rows;
	116	$c->stash->{'template'} = 'alignment.tt';
	117	}
	118
	119	=head2 stemma
	120
852190b9	121	GET /stemma/$textid/$stemmaid
6b70c348	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
852190b9	130	sub stemma :Local :Args {
852190b9	131	my( $self, $c, $textid, $stemmaid ) = @_;
6b70c348	132	my $m = $c->model('Directory');
6b70c348	133	my $tradition = $m->tradition( $textid );
852190b9	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	: '';
6b70c348	151	}
6b70c348	152	$c->forward('View::SVG');
dbcf12a6	153	}
dbcf12a6	154
6b70c348	155	=head2 stemmadot
12720144	156
6b70c348	157	GET /stemmadot/$textid
	158
	159	Returns the 'dot' format representation of the current stemma hypothesis.
	160
	161	=cut
	162
2376359f	163	sub stemmadot :Local :Args(1) {
6b70c348	164	my( $self, $c, $textid ) = @_;
	165	my $m = $c->model('Directory');
	166	my $tradition = $m->tradition( $textid );
852190b9	167	my $ok = _check_permission( $c, $tradition );
852190b9	168	return unless $ok;
6b70c348	169
	170	$c->response->body( $tradition->stemma->editable );
	171	$c->forward('View::Plain');
	172	}
12720144	173
852190b9	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).
2b4baccc	222	my $upload = $c->request->upload('file');
852190b9	223	my $name = $c->request->param('name') \|\| 'Uploaded tradition';
	224	my( $ext ) = $upload->filename =~ /\.(\w+)$/;
	225	my %newopts = (
	226	'name' => $name,
2b4baccc	227	'file' => $upload->tempname
852190b9	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	}
3a3b8213	243	} elsif( $ext =~ /^(txt\|csv\|xls(x)?)$/ ) {
3a3b8213	244	# If it's Excel we need to pass excel => $ext;
4b2a244a	245	# otherwise we need to pass sep_char => [record separator].
3a3b8213	246	if( $ext =~ /xls/ ) {
	247	$newopts{'excel'} = $ext;
	248	} else {
	249	$newopts{'sep_char'} = $ext eq 'txt' ? "\t" : ',';
	250	}
852190b9	251	try {
	252	$tradition = Text::Tradition->new(
	253	%newopts,
	254	'input' => 'Tabular',
852190b9	255	);
	256	} catch ( Text::Tradition::Error $e ) {
	257	$errmsg = $e->message;
	258	} catch {
	259	$errmsg = "Unexpected parsing error";
	260	}
4b2a244a	261	} elsif( $ext eq 'xlsx' ) {
852190b9	262	$c->stash->{'result'} =
4b2a244a	263	{ 'error' => "Excel XML parsing not supported yet" };
852190b9	264	$c->response->status( 500 );
	265	} else {
	266	# Error unless we have a recognized filename extension
	267	$c->stash->{'result'} =
	268	{ 'error' => "Unrecognized file type extension $ext" };
	269	$c->response->status( 500 );
	270	}
	271
	272	# Save the tradition if we have it, and return its data or else the
	273	# error that occurred trying to make it.
	274	if( $tradition ) {
2b4baccc	275	my $m = $c->model('Directory');
2b4baccc	276	$user->add_tradition( $tradition );
852190b9	277	my $id = $c->model('Directory')->store( $tradition );
2b4baccc	278	$c->model('Directory')->store( $user );
852190b9	279	$c->stash->{'result'} = { 'id' => $id, 'name' => $tradition->name };
	280	} else {
	281	$c->stash->{'result'} =
	282	{ 'error' => "Error parsing tradition .$ext file: $errmsg" };
	283	$c->response->status( 500 );
	284	}
	285	} else {
	286	$c->stash->{'result'} =
	287	{ 'error' => 'Cannot save a tradition without being logged in' };
	288	$c->response->status( 403 );
	289	}
	290	$c->forward('View::JSON');
	291	}
	292
	293	sub _check_permission {
	294	my( $c, $tradition ) = @_;
	295	my $user = $c->user_exists ? $c->user->get_object : undef;
	296	if( $user ) {
2b4baccc	297	return 'full' if ( $user->is_admin \|\|
2b4baccc	298	( $tradition->has_user && $tradition->user->id eq $user->id ) );
75ce4f7a	299	}
	300	# Text doesn't belong to us, so maybe it's public?
	301	return 'readonly' if $tradition->public;
	302
	303	# ...nope. Forbidden!
2b4baccc	304	$c->response->status( 403 );
	305	$c->response->body( 'You do not have permission to view this tradition.' );
	306	$c->detach( 'View::Plain' );
	307	return 0;
852190b9	308	}
852190b9	309
dbcf12a6	310	=head2 default
	311
	312	Standard 404 error page
	313
	314	=cut
	315
	316	sub default :Path {
	317	my ( $self, $c ) = @_;
	318	$c->response->body( 'Page not found' );
	319	$c->response->status(404);
	320	}
	321
	322	=head2 end
	323
	324	Attempt to render a view, if needed.
	325
	326	=cut
	327
	328	sub end : ActionClass('RenderView') {}
	329
	330	=head1 AUTHOR
	331
	332	Tara L Andrews
	333
	334	=head1 LICENSE
	335
	336	This library is free software. You can redistribute it and/or modify
	337	it under the same terms as Perl itself.
	338
	339	=cut
	340
	341	__PACKAGE__->meta->make_immutable;
	342
	343	1;