File Coverage

blib/lib/Rapi/Blog/Template/Dispatcher.pm
Criterion Covered Total %
statement 24 78 30.7
branch 0 34 0.0
condition 0 24 0.0
subroutine 8 21 38.1
pod 0 6 0.0
total 32 163 19.6


line stmt bran cond sub pod time code
1             package Rapi::Blog::Template::Dispatcher;
2 1     1   8 use strict;
  1         4  
  1         30  
3 1     1   5 use warnings;
  1         2  
  1         59  
4              
5 1     1   8 use RapidApp::Util qw(:all);
  1         2  
  1         437  
6 1     1   10 use Rapi::Blog::Util;
  1         3  
  1         41  
7 1     1   11 use List::Util;
  1         2  
  1         44  
8 1     1   6 use Module::Runtime;
  1         4  
  1         11  
9              
10 1     1   41 use Moo;
  1         3  
  1         5  
11 1     1   2650 use Types::Standard ':all';
  1         3  
  1         7  
12              
13              
14             has 'AccessStore', is => 'ro', required => 1, isa => InstanceOf['Rapi::Blog::Template::AccessStore'];
15             has 'path', is => 'ro', required => 1, isa => Str;
16             has 'ctx', is => 'ro', required => 1;
17              
18             has 'Scaffold', is => 'ro', isa => Maybe[InstanceOf['Rapi::Blog::Scaffold']], default => sub { undef };
19              
20              
21             has 'parent', is => 'ro', default => sub { undef };
22              
23             has 'type', is => 'ro', init_arg => undef, lazy => 1, default => sub {
24             my $self = shift;
25             my ($pfx,$type) = split('Rapi::Blog::Template::Dispatcher::',(ref $self),2);
26             $type
27             };
28              
29             sub is_type {
30 0     0 0   my ($self, $type) = @_;
31 0 0 0       $type && $self->type && $type eq $self->type
32             }
33              
34             sub find_parent_type {
35 0     0 0   my ($self, $type) = @_;
36 0 0         return undef unless ($self->parent);
37 0 0         $self->parent->is_type($type) ? $self->parent : $self->parent->find_parent_type($type)
38             }
39              
40              
41             has 'claimed', is => 'ro', init_arg => undef, lazy => 1, default => sub {
42             my $self = shift;
43             $self->parent ? 1 : 0
44             }, isa => Bool;
45              
46              
47             has 'exists', is => 'ro', lazy => 1, isa => Bool, default => sub { 0 };
48             has 'mtime', is => 'ro', lazy => 1, isa => Maybe[Str], default => sub { undef };
49             has 'content', is => 'ro', lazy => 1, isa => Maybe[Str], default => sub { undef };
50              
51             has 'restrict', is => 'ro', lazy => 1, isa => Bool, default => sub { 0 };
52              
53             has 'template_vars', is => 'ro', lazy => 1, isa => HashRef, default => sub {{}};
54              
55              
56             has 'is_static', is => 'ro', lazy => 1, default => sub {
57             my $self = shift;
58             $self->Scaffold->_is_static_path($self->path)
59             }, isa => Bool;
60              
61             has 'is_private', is => 'ro', lazy => 1, default => sub {
62             my $self = shift;
63             $self->Scaffold->_is_private_path($self->path)
64             }, isa => Bool;
65              
66             has 'valid_not_found_tpl', is => 'ro', init_arg => undef, lazy => 1, default => sub {
67             my $self = shift;
68             my $tpl = $self->Scaffold->not_found_template or return undef;
69             $self->Scaffold->resolve_file($tpl) ? $tpl : undef
70             }, isa => Maybe[Str];
71              
72              
73 0     0 0   sub rank { 0 }
74              
75 0     0 0   sub resolved { (shift) }
76              
77             sub _factory_for {
78 0     0     my ($self,$type,@args) = @_;
79            
80 0           my $class = join('::',__PACKAGE__,$type);
81 0           Module::Runtime::require_module($class);
82            
83 0           my %opts = $self->_get_factory_opts(@args);
84            
85 0           $class->_factory_class(%opts)
86             }
87              
88              
89             sub _get_factory_opts {
90 0     0     my $self = shift;
91 0 0         my %opts = (ref($_[0]) eq 'HASH') ? %{ $_[0] } : @_; # <-- arg as hash or hashref
  0            
92            
93 0           my @attrs = qw(AccessStore path ctx Scaffold);
94 0   0       exists $opts{$_} or $opts{$_} = $self->$_ for (@attrs);
95            
96 0 0         $opts{parent} = $self if ($self->Scaffold);
97              
98 0           %opts
99             }
100              
101             sub _factory {
102 0     0     my $self = shift;
103 0           my ($class, %opts);
104            
105 0 0         if(ref($self)) {
106 0           %opts = $self->_get_factory_opts(@_);
107 0           $class = ref($self)
108             }
109             else {
110 0 0         %opts = (ref($_[0]) eq 'HASH') ? %{ $_[0] } : @_; # <-- arg as hash or hashref
  0            
111 0           $class = $self
112             }
113            
114 0           $class->_factory_class(%opts)
115             }
116              
117              
118             sub _factory_class {
119 0     0     my $class = shift;
120 0           $class->new(@_)->resolved
121             }
122              
123              
124             sub us_or_better {
125 0     0 0   my ($this,$that) = @_;
126 0 0 0       $that && $that->rank > $this->rank ? $that : $this
127             }
128              
129              
130             sub _resolve_best_scaffold {
131 0     0     my $self = shift;
132            
133 0           my @scaffolds = $self->AccessStore->ScaffoldSet->all;
134 0 0         scalar(@scaffolds) > 0 or die "Fatal error -- no Scaffolds detected. At least one Scaffold must be loaded.";
135            
136 0 0         if (my $uuid = $self->ctx->stash->{rapi_blog_only_scaffold_uuid}) {
137 0           @scaffolds = grep { $_->uuid eq $uuid } @scaffolds;
  0            
138 0 0         scalar(@scaffolds) > 0 or die join('',
139             "Fatal error -- rapi_blog_only_scaffold_uuid is set ('$uuid') but there ",
140             "is no Scaffold with that uuid"
141             );
142             }
143            
144 0           my $Best = undef;
145 0           for (@scaffolds) {
146 0           my $Next = $self->_factory( Scaffold => $_ )->resolve;
147 0 0         $Best = $Best ? $Best->us_or_better($Next) : $Next;
148             }
149            
150             $Best
151 0           }
152              
153              
154             sub resolve {
155 0     0 0   my $self = shift;
156            
157 0 0         $self->Scaffold or return $self->_resolve_best_scaffold;
158            
159 0           my $FileDispatch = $self->_factory_for('ScaffoldFile');
160            
161 0 0 0       ($FileDispatch && $FileDispatch->exists ? $FileDispatch : undef) ||
    0 0        
      0        
      0        
162             $self->_resolve_DirectPost ||
163             $self->_resolve_ViewWrapper ||
164             $FileDispatch ||
165             $self->_factory_for('Unclaimed')
166             }
167              
168              
169              
170              
171             sub _resolve_DirectPost {
172 0     0     my $self = shift;
173 0           my ($pfx,$name) = split($self->Scaffold->unique_int_post_path,$self->path,2);
174 0 0 0       ($name && $pfx eq '')
175             ? $self->_factory_for('Post', name => $name, direct => 1)
176             : undef
177             }
178              
179              
180              
181             sub _resolve_ViewWrapper {
182 0     0     my $self = shift;
183 0           my ($VW, $path) = $self->Scaffold->resolve_ViewWrapper($self->path);
184 0 0         $VW ? $self->_factory_for('ViewWrapper', ViewWrapper => $VW, subpath => $path) : undef
185             }
186              
187              
188              
189              
190             has 'maybe_psgi_response', is => 'ro', init_arg => undef, lazy => 1, default => sub { undef };
191              
192              
193             1;