X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fstemmaweb%2FController%2FRoot.pm;h=be1ba727cb6c1351c169c2f2c76492fda17227cf;hb=161434162a8c2c998c9b98095969696e5798dd18;hp=8cbf5c91e4fc642d1b14e0038c2c3372be223ed8;hpb=3f9d7ae52124ba47d54d45a7c8e9f57455c9d389;p=scpubgit%2Fstemmaweb.git diff --git a/lib/stemmaweb/Controller/Root.pm b/lib/stemmaweb/Controller/Root.pm index 8cbf5c9..be1ba72 100644 --- a/lib/stemmaweb/Controller/Root.pm +++ b/lib/stemmaweb/Controller/Root.pm @@ -3,6 +3,8 @@ use Moose; use namespace::autoclean; use Text::Tradition::Analysis qw/ run_analysis /; use TryCatch; +use XML::LibXML; +use XML::LibXML::XPathContext; BEGIN { extends 'Catalyst::Controller' } @@ -51,6 +53,17 @@ sub about :Local :Args(0) { $c->stash->{template} = 'about.tt'; } +=head2 help/* + +A dispatcher for documentation of various aspects of the application. + +=cut + +sub help :Local :Args(1) { + my( $self, $c, $topic ) = @_; + $c->stash->{template} = "$topic.tt"; +} + =head1 Elements of index page =head2 directory @@ -121,16 +134,41 @@ sub newtradition :Local :Args(0) { 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 / ) { + my $type; + # Parse the XML to see which flavor it is. + my $parser = XML::LibXML->new(); + my $doc; + try { + $doc = $parser->parse_file( $newopts{'file'} ); + } catch( $err ) { + $errmsg = "XML file parsing error: $err"; + } + if( $doc ) { + if( $doc->documentElement->nodeName eq 'GraphML' ) { + $type = 'CollateX'; + } elsif( $doc->documentElement->nodeName ne 'TEI' ) { + $errmsg = 'Unrecognized XML type ' . $doc->documentElement->nodeName; + } else { + my $xpc = XML::LibXML::XPathContext->new( $doc->documentElement ); + my $venc = $xpc->findvalue( '/TEI/teiHeader/encodingDesc/variantEncoding/attribute::method' ); + if( $venc && $venc eq 'double-end-point' ) { + $type = 'CTE'; + } else { + $type = 'TEI'; + } + } + } + # Try the relevant XML parsing option. + if( $type ) { + delete $newopts{'file'}; + $newopts{'xmlobj'} = $doc; try { $tradition = Text::Tradition->new( %newopts, 'input' => $type ); } catch ( Text::Tradition::Error $e ) { $errmsg = $e->message; - } catch { - $errmsg = "Unexpected parsing error"; + } catch ( $e ) { + $errmsg = "Unexpected parsing error: $e"; } - last if $tradition; } } elsif( $ext =~ /^(txt|csv|xls(x)?)$/ ) { # If it's Excel we need to pass excel => $ext; @@ -147,8 +185,8 @@ sub newtradition :Local :Args(0) { ); } catch ( Text::Tradition::Error $e ) { $errmsg = $e->message; - } catch { - $errmsg = "Unexpected parsing error"; + } catch ( $e ) { + $errmsg = "Unexpected parsing error: $e"; } } else { # Error unless we have a recognized filename extension @@ -187,6 +225,9 @@ Returns information about a particular text. sub textinfo :Local :Args(1) { my( $self, $c, $textid ) = @_; my $tradition = $c->model('Directory')->tradition( $textid ); + ## Have to keep users in the same scope as tradition + my $newuser; + my $olduser; unless( $tradition ) { return _json_error( $c, 404, "No tradition with ID $textid" ); } @@ -214,7 +255,8 @@ sub textinfo :Local :Args(1) { } # Handle language param, making Default => null my $langval = delete $params->{language} || 'Default'; - unless( $tradition->language eq $langval ) { + + unless( $tradition->language eq $langval || !$tradition->can('language') ) { try { $tradition->language( $langval ); $changed = 1; @@ -234,20 +276,23 @@ sub textinfo :Local :Args(1) { } # 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 ) ) { + ( $tradition->has_user && $tradition->user->email 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 }); + $newuser = $m->find_user({ email => $newownerid }); unless( $newuser ) { return _json_error( $c, 500, "No such user " . $newownerid ); } + if( $tradition->has_user ) { + $olduser = $tradition->user; + $olduser->remove_tradition( $tradition ); + } $newuser->add_tradition( $tradition ); $changed = 1; } @@ -266,12 +311,15 @@ sub textinfo :Local :Args(1) { my $textinfo = { textid => $textid, name => $tradition->name, - language => $tradition->language, - public => $tradition->public, - owner => $tradition->user ? $tradition->user->id : undef, + #language => $tradition->language, + public => $tradition->public || 0, + owner => $tradition->user ? $tradition->user->email : undef, witnesses => [ map { $_->sigil } $tradition->witnesses ], }; - my @stemmasvg = map { $_->as_svg({ size => [ 500, 375 ] }) } $tradition->stemmata; + if( $tradition->can('language') ) { + $textinfo->{'language'} = $tradition->language; + } + my @stemmasvg = map { $_->as_svg() } $tradition->stemmata; map { $_ =~ s/\n/ /mg } @stemmasvg; $textinfo->{stemmata} = \@stemmasvg; $c->stash->{'result'} = $textinfo; @@ -327,6 +375,11 @@ sub stemma :Local :Args(2) { if( $c->req->method eq 'POST' ) { if( $ok eq 'full' ) { my $dot = $c->request->body_params->{'dot'}; + # Graph::Reader::Dot does not handle bare unicode. We get around this + # by wrapping all words in double quotes, as long as they aren't already + # wrapped, and as long as they aren't the initial 'digraph stemma'. + # Horrible HACK. + $dot =~ s/(?stemma_count > $stemmaid ) { $stemma = $tradition->stemma( $stemmaid ); } - my $stemma_xml = $stemma ? $stemma->as_svg( { size => [ 500, 375 ] } ) : ''; + my $stemma_xml = $stemma ? $stemma->as_svg() : ''; # What was requested, XML or JSON? my $return_view = 'SVG'; if( my $accept_header = $c->req->header('Accept') ) { @@ -409,6 +462,30 @@ sub stemmadot :Local :Args(2) { $c->forward('View::JSON'); } +=head2 download + + GET /download/$textid + +Returns the full XML definition of the tradition and its stemmata, if any. + +=cut + +sub download :Local :Args(1) { + my( $self, $c, $textid ) = @_; + my $tradition = $c->model('Directory')->tradition( $textid ); + unless( $tradition ) { + return _json_error( $c, 404, "No tradition with ID $textid" ); + } + my $ok = _check_permission( $c, $tradition ); + return unless $ok; + try { + $c->stash->{'result'} = $tradition->collation->as_graphml(); + } catch( Text::Tradition::Error $e ) { + return _json_error( $c, 500, $e->message ); + } + $c->forward('View::GraphML'); +} + #################### ### Helper functions ####################