view release on metacpan or  search on metacpan

lib/App/AutoCRUD/Context.pm  view on Meta::CPAN

package App::AutoCRUD::Context;

use 5.010;
use strict;
use warnings;

use Moose;
use MooseX::SemiAffordanceAccessor; # writer methods as "set_*"
use Carp;
use Scalar::Does qw/does/;
use Encode       ();

use namespace::clean -except => 'meta';


has 'app'          => (is => 'ro', isa => 'App::AutoCRUD', required => 1,
                       handles => [qw/config dir/]);
has 'req'          => (is => 'ro', isa => 'Plack::Request', required => 1,
                       handles => [qw/logger/]);
has 'req_data'     => (is => 'ro', isa => 'HashRef',
                       builder => '_req_data', lazy => 1, init_arg => undef);
has 'base'         => (is => 'ro', isa => 'Str',
                       builder => '_base', lazy => 1, init_arg => undef);
has 'path'         => (is => 'rw', isa => 'Str',
                       builder => '_path', lazy => 1);
has 'template'     => (is => 'rw', isa => 'Str');
has 'view'         => (is => 'rw', isa => 'App::AutoCRUD::View',
                       builder => '_view', lazy => 1);
has 'process_time' => (is => 'rw', isa => 'Num');

has 'datasource'   => (is => 'rw', isa => 'App::AutoCRUD::DataSource',
                       handles => [qw/dbh schema/]);
has 'title'        => (is => 'rw', isa => 'Str',
                       builder => '_title', lazy => 1);


sub _view {
  my $self = shift;

  # default view, if no specific view was required from the URL
  return $self->app->find_class("View::TT")->new;
}


sub _req_data {
  my $self = shift;

  require CGI::Expand;
  my $req_data = CGI::Expand->expand_cgi($self->req);
  _decode_utf8($req_data);
  return $req_data;
}

sub _base {
  my $self = shift;

  my $base = $self->req->base->as_string;
  $base .= "/" unless $base =~ m[/$]; # force trailing slash
  return $base
}

sub _path {
  my $self = shift;

  return $self->req->path;
}

sub _title {
  my $self = shift;

  my $title      = $self->app->name;
  my $datasource = $self->datasource;
  $title        .= "-" . $datasource->name if $datasource;

  return $title;
}


sub extract_path_segments {
  my ($self, $n_segments) = @_;

  # check argument
  $n_segments >= 0             or croak "illegal n_segments: $n_segments";
  $n_segments < 2 or wantarray or croak "n_segments too big for scalar context";

  # extract segments
  my $path = $self->path;
  my @segments;
  while ($n_segments-- && $path =~ s[^/([^/]*)][]) {
    push @segments, $1;
  }

  # inject remaining path (without segments) back into context
  $self->set_path($path);

  # contextual return
  return wantarray ? @segments : $segments[0];
}



sub maybe_set_view_from_path {
  my $self = shift;

  my $path = $self->path;
  if ($path =~ s/\.(\w+)$//) { # e.g. /TABLE/foo/list.yaml?...
    my $requested_view = $1;
    my $view_class = $self->app->find_class("View::".ucfirst $requested_view);
    if ($view_class) {