lib/stemmaweb/Controller/Relation.pm

   1 package stemmaweb::Controller::Relation;
   2 use JSON qw/ to_json from_json /;
   3 use Moose;
   4 use Moose::Util::TypeConstraints qw/ find_type_constraint /;
   5 use Module::Load;
   6 use namespace::autoclean;
   7 use Text::Tradition::Datatypes;
   8 use TryCatch;
   9
  10 BEGIN { extends 'Catalyst::Controller' }
  11
  12
  13 =head1 NAME
  14
  15 stemmaweb::Controller::Relation - Controller for the relationship mapper
  16
  17 =head1 DESCRIPTION
  18
  19 The reading relationship mapper with draggable nodes.
  20
  21 =head1 METHODS
  22
  23 =head2 index
  24
  25  GET relation/$textid
  26
  27 Renders the application for the text identified by $textid.
  28
  29 =cut
  30
  31 sub index :Path :Args(0) {
  32         my( $self, $c ) = @_;
  33         $c->stash->{'template'} = 'relate.tt';
  34 }
  35
  36 =head2 text
  37
  38  GET relation/$textid/
  39
  40  Runs the relationship mapper for the specified text ID.
  41
  42 =cut
  43
  44 sub text :Chained('/') :PathPart('relation') :CaptureArgs(1) {
  45         my( $self, $c, $textid ) = @_;
  46         my $tradition = $c->model('Directory')->tradition( $textid );
  47         unless( $tradition ) {
  48                 $c->response->status('404');
  49                 $c->response->body("No such tradition with ID $textid");
  50                 $c->detach('View::Plain');
  51                 return;
  52         }
  53
  54     # Account for a bad interaction between FastCGI and KiokuDB
  55     unless( $tradition->collation->tradition ) {
  56         $c->log->warn( "Fixing broken tradition link" );
  57         $tradition->collation->_set_tradition( $tradition );
  58         $c->model('Directory')->save( $tradition );
  59     }
  60     # Check permissions. Will return 403 if denied, otherwise will
  61     # put the appropriate value in the stash.
  62     my $ok = _check_permission( $c, $tradition );
  63     return unless $ok;
  64
  65         $c->stash->{'textid'} = $textid;
  66         $c->stash->{'tradition'} = $tradition;
  67 }
  68
  69 sub main :Chained('text') :PathPart('') :Args(0) {
  70         my( $self, $c ) = @_;
  71         my $tradition = delete $c->stash->{'tradition'};
  72         my $collation = $tradition->collation;
  73
  74         # Stash text direction to use in JS.
  75         $c->stash->{'direction'} = $collation->direction;
  76
  77         # Stash the relationship definitions
  78         $c->stash->{'relationship_scopes'} =
  79                 to_json( find_type_constraint( 'RelationshipScope' )->values );
  80         $c->stash->{'ternary_values'} =
  81                 to_json( find_type_constraint( 'Ternary' )->values );
  82         my @reltypeinfo;
  83         foreach my $type ( sort { _typesort( $a, $b ) } $collation->relations->types ) {
  84                 next if $type->is_weak;
  85                 my $struct = { name => $type->name, description => $type->description };
  86                 push( @reltypeinfo, $struct );
  87         }
  88         $c->stash->{'relationship_types'} = to_json( \@reltypeinfo );
  89
  90         # See how big the tradition is. Edges are more important than nodes
  91         # when it comes to rendering difficulty.
  92         my $numnodes = scalar $collation->readings;
  93         my $numedges = scalar $collation->paths;
  94         my $length = $collation->end->rank;
  95         # We should display no more than roughly 500 nodes, or roughly 700
  96         # edges, at a time.
  97         my $segments = $numnodes / 500;
  98         if( $numedges / 700 > $segments ) {
  99                 $segments = $numedges / 700;
 100         }
 101         my $segsize = sprintf( "%.0f", $length / $segments );
 102         my $margin = sprintf( "%.0f", $segsize / 10 );
 103         if( $segments > 1 ) {
 104                 # Segment the tradition in order not to overload the browser.
 105                 my @divs;
 106                 my $r = 0;
 107                 while( $r + $margin < $length ) {
 108                         push( @divs, $r );
 109                         $r += $segsize;
 110                 }
 111                 $c->stash->{'textsegments'} = [];
 112                 foreach my $i ( 0..$#divs ) {
 113                         my $seg = { 'start' => $divs[$i] };
 114                         $seg->{'display'} = "Segment " . ($i+1);
 115                         push( @{$c->stash->{'textsegments'}}, $seg );
 116                 }
 117         }
 118         my $startseg = $c->req->param('start');
 119         my $svgopts;
 120         if( $startseg ) {
 121                 # Only render the subgraph from startseg to endseg or to END,
 122                 # whichever is less.
 123                 my $endseg = $startseg + $segsize + $margin;
 124                 $svgopts = { 'from' => $startseg };
 125                 $svgopts->{'to'} = $endseg if $endseg < $collation->end->rank;
 126         } elsif( exists $c->stash->{'textsegments'} ) {
 127                 # This is the unqualified load of a long tradition. We implicitly start
 128                 # at zero, but go only as far as our segment size.
 129                 my $endseg = $segsize + $margin;
 130                 $startseg = 0;
 131                 $svgopts = { 'to' => $endseg };
 132         }
 133         # Spit out the SVG
 134         my $svg_str = $collation->as_svg( $svgopts );
 135         $svg_str =~ s/\n//gs;
 136         $c->stash->{'startseg'} = $startseg if defined $startseg;
 137         $c->stash->{'svg_string'} = $svg_str;
 138         $c->stash->{'text_title'} = $tradition->name;
 139         if( $tradition->can('language') && $tradition->language ) {
 140                 $c->stash->{'text_lang'} = $tradition->language;
 141                 $c->stash->{'can_morphologize'} = 1;
 142         } else {
 143                 $c->stash->{'text_lang'} = 'Default';
 144         }
 145         $c->stash->{'template'} = 'relate.tt';
 146 }
 147
 148 sub _typesort {
 149         my( $a, $b ) = @_;
 150         my $blsort = $a->bindlevel <=> $b->bindlevel;
 151         return $blsort if $blsort;
 152         return $a->name cmp $b->name;
 153 }
 154
 155 =head2 help
 156
 157  GET relation/help/$language
 158
 159 Returns the help window HTML.
 160
 161 =cut
 162
 163 sub help :Local :Args(1) {
 164         my( $self, $c, $lang ) = @_;
 165         # Display the morphological help for the language if it is defined.
 166         if( $lang && $lang ne 'Default' ) {
 167                 my $mod = 'Text::Tradition::Language::' . $lang;
 168                 try {
 169                         load( $mod );
 170                 } catch {
 171                         $c->log->debug("Warning: could not load $mod");
 172                 }
 173                 my $has_mod = $mod->can('morphology_tags');
 174                 if( $has_mod ) {
 175                         my $tagset = &$has_mod;
 176                         $c->stash->{'tagset'} = $tagset;
 177                 }
 178         }
 179         $c->stash->{'template'} = 'relatehelp.tt';
 180 }
 181
 182 =head2 relationships
 183
 184  GET relation/$textid/relationships
 185
 186 Returns the list of relationships defined for this text.
 187
 188  POST relation/$textid/relationships { request }
 189
 190 Attempts to define the requested relationship within the text. Returns 200 on
 191 success or 403 on error.
 192
 193  DELETE relation/$textid/relationships { request }
 194
 195
 196 =cut
 197
 198 sub relationships :Chained('text') :PathPart :Args(0) {
 199         my( $self, $c ) = @_;
 200         my $tradition = delete $c->stash->{'tradition'};
 201         my $ok = _check_permission( $c, $tradition );
 202         return unless $ok;
 203         my $collation = $tradition->collation;
 204         my $m = $c->model('Directory');
 205         if( $c->request->method eq 'GET' ) {
 206                 my @pairs = $collation->relationships; # returns the edges
 207                 my @all_relations;
 208                 foreach my $p ( @pairs ) {
 209                         my $relobj = $collation->relations->get_relationship( @$p );
 210                         next if $relobj->type eq 'collated'; # Don't show these
 211                         next if $p->[0] eq $p->[1]; # HACK until bugfix
 212                         my $relhash = { source_id => $p->[0], target_id => $p->[1],
 213                                   source_text => $collation->reading( $p->[0] )->text,
 214                                   target_text => $collation->reading( $p->[1] )->text,
 215                                   type => $relobj->type, scope => $relobj->scope,
 216                                   a_derivable_from_b => $relobj->a_derivable_from_b,
 217                                   b_derivable_from_a => $relobj->b_derivable_from_a,
 218                                   non_independent => $relobj->non_independent,
 219                                   is_significant => $relobj->is_significant
 220                                   };
 221                         $relhash->{'note'} = $relobj->annotation if $relobj->has_annotation;
 222                         push( @all_relations, $relhash );
 223                 }
 224                 $c->stash->{'result'} = \@all_relations;
 225         } else {
 226                 # Check write permissions first of all
 227                 if( $c->stash->{'permission'} ne 'full' ) {
 228                         $c->response->status( '403' );
 229                         $c->stash->{'result'} = {
 230                                 'error' => 'You do not have permission to modify this tradition.' };
 231                         $c->detach( 'View::JSON' );
 232                 } elsif( $c->request->method eq 'POST' ) {
 233                         my $opts = $c->request->params;
 234
 235                         # Retrieve the source / target from the options
 236                         my $node = delete $opts->{source_id};
 237                         my $target = delete $opts->{target_id};
 238
 239                         # Make sure we didn't send a blank or invalid relationship type
 240                         my $relation = $opts->{type};
 241                         unless( $collation->get_relationship_type( $relation ) ) {
 242                                 my $errmsg = $relation ? "No such relationship type $relation" :
 243                                         "You must specify a relationship type";
 244                                 $c->stash->{'result'} = { error => $errmsg };
 245                                 $c->response->status( '400' );
 246                                 $c->detach( 'View::JSON' );
 247                         }
 248
 249                         # Keep the data clean
 250                         my @booleans = qw/ a_derivable_from_b b_derivable_from_a non_independent /;
 251                         foreach my $k ( keys %$opts ) {
 252                                 if( $opts->{$k} && grep { $_ eq $k } @booleans ) {
 253                                         $opts->{$k} = 1;
 254                                 }
 255                         }
 256
 257                         delete $opts->{scope} unless $opts->{scope};
 258                         delete $opts->{annotation} unless $opts->{annotation};
 259                         delete $opts->{is_significant} unless $opts->{is_significant};
 260                         $opts->{propagate} = 1;
 261
 262                         try {
 263                                 my @vectors = $collation->add_relationship( $node, $target, $opts );
 264                                 $c->stash->{'result'} = \@vectors;
 265                                 $m->save( $tradition );
 266                         } catch( Text::Tradition::Error $e ) {
 267                                 $c->response->status( '403' );
 268                                 $c->stash->{'result'} = { error => $e->message };
 269                         } catch {
 270                                 $c->response->status( '500' );
 271                                 $c->stash->{'result'} = { error => "Something went wrong with the request" };
 272                         }
 273                 } elsif( $c->request->method eq 'DELETE' ) {
 274                         my $node = $c->request->param('source_id');
 275                         my $target = $c->request->param('target_id');
 276                         my $scopewide = $c->request->param('scopewide')
 277                                 && $c->request->param('scopewide') eq 'true';
 278                         try {
 279                                 my @vectors = $collation->del_relationship( $node, $target, $scopewide );
 280                                 $m->save( $tradition );
 281                                 $c->stash->{'result'} = \@vectors;
 282                         } catch( Text::Tradition::Error $e ) {
 283                                 $c->response->status( '403' );
 284                                 $c->stash->{'result'} = { 'error' => $e->message };
 285                         } catch {
 286                                 $c->response->status( '500' );
 287                                 $c->stash->{'result'} = { error => "Something went wrong with the request" };
 288                         }
 289                 }
 290         }
 291         $c->forward('View::JSON');
 292 }
 293
 294 =head2 readings
 295
 296  GET relation/$textid/readings
 297
 298 Returns the list of readings defined for this text along with their metadata.
 299
 300 =cut
 301
 302 my %read_write_keys = (
 303         'id' => 0,
 304         'text' => 0,
 305         'is_meta' => 0,
 306         'grammar_invalid' => 1,
 307         'is_nonsense' => 1,
 308         'normal_form' => 1,
 309 );
 310
 311 sub _reading_struct {
 312         my( $reading ) = @_;
 313         # Return a JSONable struct of the useful keys.  Keys meant to be writable
 314         # have a true value; read-only keys have a false value.
 315         my $struct = {};
 316         map { $struct->{$_} = $reading->$_ if $reading->can( $_ ) } keys( %read_write_keys );
 317         # Special case
 318         $struct->{'lexemes'} = $reading->can( 'lexemes' ) ? [ $reading->lexemes ] : [];
 319         # Look up any words related via spelling or orthography
 320         my $sameword = sub {
 321                 my $t = $_[0]->type;
 322                 return $t eq 'spelling' || $t eq 'orthographic';
 323         };
 324         # Now add the list data
 325         $struct->{'variants'} = [ map { $_->text } $reading->related_readings( $sameword ) ];
 326         $struct->{'witnesses'} = [ $reading->witnesses ];
 327         return $struct;
 328 }
 329
 330 sub readings :Chained('text') :PathPart :Args(0) {
 331         my( $self, $c ) = @_;
 332         my $tradition = delete $c->stash->{'tradition'};
 333         my $ok = _check_permission( $c, $tradition );
 334         return unless $ok;
 335         my $collation = $tradition->collation;
 336         my $m = $c->model('Directory');
 337         if( $c->request->method eq 'GET' ) {
 338                 my $rdginfo = {};
 339                 foreach my $rdg ( $collation->readings ) {
 340                         $rdginfo->{$rdg->id} = _reading_struct( $rdg );
 341                 }
 342                 $c->stash->{'result'} = $rdginfo;
 343         }
 344         $c->forward('View::JSON');
 345 }
 346
 347 =head2 reading
 348
 349  GET relation/$textid/reading/$id
 350
 351 Returns the list of readings defined for this text along with their metadata.
 352
 353  POST relation/$textid/reading/$id { request }
 354
 355 Alters the reading according to the values in request. Returns 403 Forbidden if
 356 the alteration isn't allowed.
 357
 358 =cut
 359
 360 sub reading :Chained('text') :PathPart :Args(1) {
 361         my( $self, $c, $reading_id ) = @_;
 362         my $tradition = delete $c->stash->{'tradition'};
 363         my $collation = $tradition->collation;
 364         my $rdg = $collation->reading( $reading_id );
 365         my $m = $c->model('Directory');
 366         if( $c->request->method eq 'GET' ) {
 367                 $c->stash->{'result'} = $rdg ? _reading_struct( $rdg )
 368                         : { 'error' => "No reading with ID $reading_id" };
 369         } elsif ( $c->request->method eq 'POST' ) {
 370                 if( $c->stash->{'permission'} ne 'full' ) {
 371                         $c->response->status( '403' );
 372                         $c->stash->{'result'} = {
 373                                 'error' => 'You do not have permission to modify this tradition.' };
 374                         $c->detach('View::JSON');
 375                         return;
 376                 }
 377                 my $errmsg;
 378                 if( $rdg && $rdg->does('Text::Tradition::Morphology') ) {
 379                         # Are we re-lemmatizing?
 380                         if( $c->request->param('relemmatize') ) {
 381                                 my $nf = $c->request->param('normal_form');
 382                                 # TODO throw error unless $nf
 383                                 $rdg->normal_form( $nf );
 384                                 # TODO throw error if lemmatization fails
 385                                 # TODO skip this if normal form hasn't changed
 386                                 $rdg->lemmatize();
 387                         } else {
 388                                 # Set all the values that we have for the reading.
 389                                 # TODO error handling
 390                                 foreach my $p ( keys %{$c->request->params} ) {
 391                                         if( $p =~ /^morphology_(\d+)$/ ) {
 392                                                 # Set the form on the correct lexeme
 393                                                 my $morphval = $c->request->param( $p );
 394                                                 next unless $morphval;
 395                                                 my $midx = $1;
 396                                                 my $lx = $rdg->lexeme( $midx );
 397                                                 my $strrep = $rdg->language . ' // ' . $morphval;
 398                                                 my $idx = $lx->has_form( $strrep );
 399                                                 unless( defined $idx ) {
 400                                                         # Make the word form and add it to the lexeme.
 401                                                         try {
 402                                                                 $idx = $lx->add_matching_form( $strrep ) - 1;
 403                                                         } catch( Text::Tradition::Error $e ) {
 404                                                                 $c->response->status( '403' );
 405                                                                 $errmsg = $e->message;
 406                                                         } catch {
 407                                                                 # Something else went wrong, probably a Moose error
 408                                                                 $c->response->status( '500' );
 409                                                                 $errmsg = 'Something went wrong with the request';
 410                                                         }
 411                                                 }
 412                                                 $lx->disambiguate( $idx ) if defined $idx;
 413                                         } elsif( $read_write_keys{$p} ) {
 414                                                 my $val = _clean_booleans( $rdg, $p, $c->request->param( $p ) );
 415                                                 $rdg->$p( $val );
 416                                         }
 417                                 }
 418                         }
 419                         $m->save( $rdg );
 420                 } else {
 421                         $errmsg = "Reading does not exist or cannot be morphologized";
 422                 }
 423                 $c->stash->{'result'} = $errmsg ? { 'error' => $errmsg }
 424                         : _reading_struct( $rdg );
 425
 426         }
 427         $c->forward('View::JSON');
 428
 429 }
 430
 431 =head2 merge
 432
 433  POST relation/$textid/merge { data }
 434
 435 Merges the requested readings, combining the witnesses of both readings into
 436 the target reading. All non-conflicting source relationships are inherited by
 437 the target relationship.
 438
 439 =cut
 440
 441 sub merge :Chained('text') :PathPart :Args(0) {
 442         my( $self, $c ) = @_;
 443         my $tradition = delete $c->stash->{'tradition'};
 444         my $collation = $tradition->collation;
 445         my $m = $c->model('Directory');
 446         if( $c->request->method eq 'POST' ) {
 447                 if( $c->stash->{'permission'} ne 'full' ) {
 448                         $c->response->status( '403' );
 449                         $c->stash->{'result'} = {
 450                                 'error' => 'You do not have permission to modify this tradition.' };
 451                         $c->detach('View::JSON');
 452                         return;
 453                 }
 454                 my $errmsg;
 455                 my $response;
 456
 457                 my $main = $c->request->param('target_id');
 458                 my $second = $c->request->param('source_id');
 459                 # Find the common successor of these, so that we can detect other
 460                 # potentially identical readings.
 461                 my $csucc = $collation->common_successor( $main, $second );
 462
 463                 # Try the merge if these are parallel readings.
 464                 if( $csucc->id eq $main || $csucc->id eq $second ) {
 465                         $errmsg = "Cannot merge readings in the same path";
 466                 } else {
 467                         try {
 468                                 $collation->merge_readings( $main, $second );
 469                         } catch( Text::Tradition::Error $e ) {
 470                                 $c->response->status( '403' );
 471                                 $errmsg = $e->message;
 472                         } catch {
 473                                 # Something else went wrong, probably a Moose error
 474                                 $c->response->status( '403' );
 475                                 $errmsg = 'Something went wrong with the request';
 476                         }
 477                 }
 478
 479                 # Look for readings that are now identical.
 480                 if( $errmsg ) {
 481                         $response = { status => 'error', error => $errmsg };
 482                 } else {
 483                         $response = { status => 'ok' };
 484                         unless( $c->request->param('single') ) {
 485                                 my @identical = $collation->identical_readings(
 486                                         start => $main, end => $csucc->id );
 487                                 if( @identical ) {
 488                                         $response->{'checkalign'} = [
 489                                                 map { [ $_->[0]->id, $_->[1]->id ] } @identical ];
 490                                 }
 491                         }
 492                         $m->save( $collation );
 493                 }
 494                 $c->stash->{'result'} = $response;
 495                 $c->forward('View::JSON');
 496         }
 497 }
 498
 499 =head2 duplicate
 500
 501  POST relation/$textid/duplicate { data }
 502
 503 Duplicates the requested readings, detaching the witnesses specified in
 504 the list to use the new reading(s) instead of the old. The data to be
 505 passed should be a JSON structure:
 506
 507  { readings: rid1,rid2,rid3,...
 508    witnesses: [ wit1, ... ] }
 509
 510 =cut
 511
 512 sub duplicate :Chained('text') :PathPart :Args(0) {
 513         my( $self, $c ) = @_;
 514         my $tradition = delete $c->stash->{'tradition'};
 515         my $collation = $tradition->collation;
 516         my $m = $c->model('Directory');
 517         if( $c->request->method eq 'POST' ) {
 518                 if( $c->stash->{'permission'} ne 'full' ) {
 519                         $c->response->status( '403' );
 520                         $c->stash->{'result'} = {
 521                                 'error' => 'You do not have permission to modify this tradition.' };
 522                         $c->detach('View::JSON');
 523                         return;
 524                 }
 525                 my $errmsg;
 526                 my $response = {};
 527                 # Sort out which readings need to be duplicated from the set given, and
 528                 # ensure that all the given wits bear each relevant reading.
 529
 530                 my %wits = ();
 531                 map { $wits{$_} = 1 } $c->request->param('witnesses[]');
 532                 my %rdgranks = ();
 533                 foreach my $rid ( $c->request->param('readings[]') ) {
 534                         my $numwits = 0;
 535                         my $rdg = $collation->reading( $rid );
 536                         foreach my $rwit ( $rdg->witnesses( $rid ) ) {
 537                                 $numwits++ if exists $wits{$rwit};
 538                         }
 539                         next unless $numwits; # Disregard readings with none of our witnesses
 540                         if( $numwits < keys( %wits ) ) {
 541                                 $errmsg = "Reading $rid contains some but not all of the specified witnesses.";
 542                                 last;
 543                         } elsif( exists $rdgranks{ $rdg->rank } ) {
 544                                 $errmsg = "More than one reading would be detached along with $rid at rank " . $rdg->rank;
 545                                 last;
 546                         } else {
 547                                 $rdgranks{ $rdg->rank } = $rid;
 548                         }
 549                 }
 550
 551                 # Now check that the readings make a single sequence.
 552                 unless( $errmsg ) {
 553                         my $prior;
 554                         foreach my $rank ( sort { $a <=> $b } keys %rdgranks ) {
 555                                 my $rid = $rdgranks{$rank};
 556                                 if( $prior ) {
 557                                         # Check that there is only one path between $prior and $rdg.
 558                                         foreach my $wit ( keys %wits ) {
 559                                                 unless( $collation->prior_reading( $rid, $wit ) eq $prior ) {
 560                                                         $errmsg = "Diverging witness paths from $prior to $rid at $wit";
 561                                                         last;
 562                                                 }
 563                                         }
 564                                 }
 565                                 $prior = $rid;
 566                         }
 567                 }
 568
 569                 # Abort if we've run into a problem.
 570                 if( $errmsg ) {
 571                         $c->stash->{'result'} = { 'error' => $errmsg };
 572                         $c->response->status( '403' );
 573                         $c->forward('View::JSON');
 574                         return;
 575                 }
 576
 577                 # Otherwise, do the dirty work.
 578                 my @witlist = keys %wits;
 579                 my @deleted_relations;
 580                 foreach my $rank ( sort { $a <=> $b } keys %rdgranks ) {
 581                         my $newrdg;
 582                         my $reading_id = $rdgranks{$rank};
 583                         my @delrels;
 584                         try {
 585                                 ( $newrdg, @delrels ) =
 586                                         $collation->duplicate_reading( $reading_id, @witlist );
 587                         } catch( Text::Tradition::Error $e ) {
 588                                 $c->response->status( '403' );
 589                                 $errmsg = $e->message;
 590                         } catch {
 591                                 # Something else went wrong, probably a Moose error
 592                                 $c->response->status( '500' );
 593                                 $errmsg = 'Something went wrong with the request';
 594                         }
 595                         if( $newrdg ) {
 596                                 my $data = _reading_struct( $newrdg );
 597                                 $data->{'orig_rdg'} = $reading_id;
 598                                 $response->{"$newrdg"} = $data;
 599                                 push( @deleted_relations, @delrels );
 600                         }
 601                 }
 602                 if( $errmsg ) {
 603                         $c->stash->{'result'} = { 'error' => $errmsg };
 604                 } else {
 605                         $m->save( $collation );
 606                         $response->{'DELETED'} = \@deleted_relations;
 607                         $c->stash->{'result'} = $response;
 608                 }
 609         }
 610         $c->forward('View::JSON');
 611 }
 612
 613
 614
 615 sub _check_permission {
 616         my( $c, $tradition ) = @_;
 617     my $user = $c->user_exists ? $c->user->get_object : undef;
 618     # Does this user have access?
 619     if( $user ) {
 620                 if( $user->is_admin ||
 621                         ( $tradition->has_user && $tradition->user->id eq $user->id ) ) {
 622                         $c->stash->{'permission'} = 'full';
 623                         return 1;
 624                 }
 625     }
 626     # Is it public?
 627     if( $tradition->public ) {
 628         $c->stash->{'permission'} = 'readonly';
 629         return 1;
 630     }
 631         # Forbidden!
 632         $c->response->status( 403 );
 633         $c->response->body( 'You do not have permission to view this tradition.' );
 634         $c->detach( 'View::Plain' );
 635         return 0;
 636 }
 637
 638 sub _clean_booleans {
 639         my( $obj, $param, $val ) = @_;
 640         if( $obj->meta->get_attribute( $param )->type_constraint->name eq 'Bool' ) {
 641                 $val = 1 if $val eq 'true';
 642                 $val = undef if $val eq 'false';
 643         }
 644         return $val;
 645 }
 646
 647 =head2 end
 648
 649 Attempt to render a view, if needed.
 650
 651 =cut
 652
 653 sub end : ActionClass('RenderView') {}
 654
 655 =head1 AUTHOR
 656
 657 Tara L Andrews
 658
 659 =head1 LICENSE
 660
 661 This library is free software. You can redistribute it and/or modify
 662 it under the same terms as Perl itself.
 663
 664 =cut
 665
 666 __PACKAGE__->meta->make_immutable;
 667
 668 1;