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