view release on metacpan or  search on metacpan

lib/Web/Components/Model.pm  view on Meta::CPAN

=over 3

=item C<error>

Stash exception handler output to print an exception page.  Also called by
component loader if model dies

=cut

sub error {
   my ($self, $context, $proto, $bindv, @args) = @_;

   my $exception;
   my $class = blessed $proto;

   if ($class and $class->isa('Unexpected')) { $exception = $proto }
   elsif ($class) { $exception = exception $proto, $bindv // [], @args }
   else { $exception = exception $proto, $bindv // [], level => 2, @args }

   $self->log->error($exception, $context) if $self->can('log');

   my $code = $exception->rv || HTTP_INTERNAL_SERVER_ERROR;
   my $nav  = $context->stash($self->navigation_key);

   $code = HTTP_OK if $nav && $nav->is_script_request;

   $context->stash(
      code      => $code,
      exception => $exception,
      page      => {
         %{$self->_template_wrappers},
         layout => $self->_exception_layout
      },
      view      => $self->_default_view,
   );

   $self->_finalise_stash($context);

   $nav->finalise_script_request if $nav;

   return;
}

=item C<execute>

Called by component loader for all model method calls

=cut

sub execute {
   my ($self, $context, $methods) = @_;

   my $stash    = $context->stash;
   my $nav_key  = $self->navigation_key;
   my $options  = { optional => TRUE, scrubber => FALSE };
   my $uri_args = $context->request->uri_params->($options);
   my $last_method;

   $stash->{method_chain} = $methods;

   for my $method (split m{ / }mx, $methods) {
      my $coderef = $self->can($method)
         or throw UnknownMethod, [blessed $self, $method];

      $method = NUL unless $self->is_authorised($context, $coderef);

      $self->$method($context, @{$uri_args}) if $method;

      return $stash->{response} if $stash->{response};

      $stash->{$nav_key}->finalise_script_request if exists $stash->{$nav_key};

      return if $stash->{finalised} || exists $stash->{redirect};

      $last_method = $method;
   }

   $self->_finalise_stash($context, $last_method);
   return;
}

=item C<get_context>

Creates and returns a new context object from the request

=cut

sub get_context {
   my ($self, $args) = @_;

   return $self->context_class->new({ %{$args}, config => $self->config });
}

=item C<verify_form_post>

Stash an exception if the CSRF token is bad

=cut

sub verify_form_post {
   my ($self, $context) = @_;

   my $reason = $context->verify_form_post;

   return TRUE unless $reason;

   $self->error($context, BadCSRFToken, [$reason], level => 3);
   return FALSE;
}

# Private methods
sub _finalise_stash { # Add necessary defaults for the view to render
   my ($self, $context, $method) = @_;

   my $stash = $context->stash;

   $stash->{code} //= HTTP_OK unless exists $stash->{redirect};
   $stash->{finalised} = TRUE;
   $stash->{page} //= { %{$self->_template_wrappers} };
   $stash->{page}->{layout} //= $self->moniker . "/${method}";
   $stash->{view} //= $self->_default_view;