view release on metacpan or  search on metacpan

lib/Catalyst/View/Template/Pure.pm  view on Meta::CPAN

use strict;
use warnings;

package Catalyst::View::Template::Pure;

use Scalar::Util qw/blessed refaddr weaken/;
use Catalyst::Utils;
use HTTP::Status ();
use File::Spec;
use Mojo::DOM58;
use Template::Pure::ParseUtils;
use Template::Pure::DataContext;

use base 'Catalyst::View';

our $VERSION = '0.017';

sub COMPONENT {
  my ($class, $app, $args) = @_;
  $args = $class->merge_config_hashes($class->config, $args);
  $args = $class->modify_init_args($app, $args) if $class->can('modify_init_args');
  $class->inject_http_status_helpers($args);
  $class->load_auto_template($app, $args);
  $class->find_fields;

  return bless $args, $class;
}

my @fields;
sub find_fields {
  my $class = shift;
  for ($class->meta->get_all_attributes) {
    next unless $_->has_init_arg;
    push @fields, $_->init_arg;
  }
}

sub load_auto_template {
  my ($class, $app, $args) = @_;
  my @parts = split("::", $class);
  my $filename = lc(pop @parts);
  
  if(delete $args->{auto_template_src}) {
    my $file = $app->path_to('lib', @parts, $filename.'.html');
    my $contents = $file->slurp;
    my $dom = Mojo::DOM58->new($contents);
    if(my $node = $dom->at('pure-component')) {
      if(my $script_node = $node->at('script')) {
        $class->config(script => "$script_node");
        $script_node->remove('script');
      }
      if(my $style_node = $node->at('style')) {
        $class->config(style => "$style_node");
        $style_node->remove('style');
      }
      $contents = $node->content;
    }
    $class->config(template => $contents);
  }
  if(delete $args->{auto_script_src}) {
    my $file = $app->path_to('lib', @parts, $filename.'.js');
    $class->config(script => $file->slurp);    
  }
  if(delete $args->{auto_style_src}) {
    my $file = $app->path_to('lib', @parts, $filename.'.css');
    $class->config(style => $file->slurp);    
  }
}

sub inject_http_status_helpers {
  my ($class, $args) = @_;
  return unless $args->{returns_status};
  foreach my $helper( grep { $_=~/^http/i} @HTTP::Status::EXPORT_OK) {
    my $subname = lc $helper;
    my $code = HTTP::Status->$helper;
    my $codename = "http_".$code;
    if(grep { $code == $_ } @{ $args->{returns_status}||[]}) {
       eval "sub ${\$class}::${\$subname} { return shift->response(HTTP::Status::$helper,\@_) }";
       eval "sub ${\$class}::${\$codename} { return shift->response(HTTP::Status::$helper,\@_) }";
    }
  }
}

sub ACCEPT_CONTEXT {
  my ($self, $c, @args) = @_;
  die "Can't call in Application context" unless blessed $c;

  my $proto = (scalar(@args) % 2) ? shift(@args) : undef;
  my %args = @args;

  my $key = blessed($self) ? refaddr($self) : $self;
  my $stash_key = "__Pure_${key}";
  delete $c->stash->{$stash_key} if delete($args{clear_stash});

  weaken $c;
  $c->stash->{$stash_key} ||= do {

    if($proto) {
      foreach my $field (@fields) {
        if(ref $proto eq 'HASH') {
          $args{$field} = $proto->{$field} if exists $proto->{$field};
        } else {
          if(my $cb = $proto->can($field)) {
            $args{$field} = $proto->$field;
          }
        }
      }
    }

    my $args = $self->merge_config_hashes($self->config, \%args);
    $args = $self->modify_context_args($c, $args) if $self->can('modify_context_args');
    $self->handle_request($c, %$args) if $self->can('handle_request');

    my $template;
    if(exists($args->{template})) {
      $template = delete ($args->{template});
    } elsif(exists($args->{template_src})) {
      $template = (delete $args->{template_src})->slurp;
    }

    my $directives = delete $args->{directives};
    my $filters = delete $args->{filters};
    my $pure_class = exists($args->{pure_class}) ?
      delete($args->{pure_class}) :
      'Template::Pure';

    Catalyst::Utils::ensure_class_loaded($pure_class);

    my $view = ref($self)->new(
      %{$args},
      %{$c->stash},
      ctx => $c,
    );

    weaken(my $weak_view = $view);
    my $pure = $pure_class->new(
      template => $template,
      directives => $directives,
      filters => $filters,
      components => $self->build_comp_hash($c, $view),
      view => $weak_view,
      %$args,
    );

    $view->{pure} = $pure;
    $view;
  };
  return $c->stash->{$stash_key};
}

sub build_comp_hash {
  my ($self, $c, $view) = @_;
  return $self->{__components} if $self->{__components};
  my %components = (
    map {
      my $v = $_;
      my $key = lc($v);
      $key =~s/::/-/g;
      $key => sub {
        my ($pure, %params) = @_;
        my $data = Template::Pure::DataContext->new($view);
        foreach $key (%{$params{node}->attr ||+{}}) {
          next unless $key && $params{$key};
          next unless my $proto = ($params{$key} =~m/^\$(.+)$/)[0];
          my %spec = Template::Pure::ParseUtils::parse_data_spec($proto);
          $params{$key} = $data->at(%spec)->value;
        }

        return $c->view($v, %params, clear_stash=>1);
      }
    } ($c->views),
  );
  $self->{__components} = \%components;
  return \%components;
}

sub apply {
  my $self = shift;
  my @args = (@_,
    template => $self->render,
    %{$self->{ctx}->stash});
  return $self->{ctx}->view(@args);
}

sub wrap {
  my $self = shift;
  my @args = (@_,
    content => $self->render,
    %{$self->{ctx}->stash});
  return $self->{ctx}->view(@args);
}

sub response {
  my ($self, $status, @proto) = @_;
  die "You need a context to build a response" unless $self->{ctx};