File Coverage

blib/lib/Rapi/Blog/Scaffold.pm
Criterion Covered Total %
statement 45 104 43.2
branch 0 38 0.0
condition 0 14 0.0
subroutine 15 34 44.1
pod 0 13 0.0
total 60 203 29.5


line stmt bran cond sub pod time code
1             package Rapi::Blog::Scaffold;
2 1     1   6 use strict;
  1         2  
  1         25  
3 1     1   5 use warnings;
  1         2  
  1         33  
4              
5 1     1   6 use RapidApp::Util qw(:all);
  1         2  
  1         368  
6 1     1   346 use Rapi::Blog::Util;
  1         4  
  1         36  
7 1     1   9 use Scalar::Util 'blessed';
  1         2  
  1         53  
8 1     1   5 use List::Util;
  1         2  
  1         41  
9 1     1   5 use String::Random;
  1         1  
  1         32  
10              
11 1     1   687 use Moo;
  1         11158  
  1         5  
12 1     1   3992 use Types::Standard ':all';
  1         3  
  1         19  
13              
14 1     1   40546 use Rapi::Blog::Scaffold::Config;
  1         3  
  1         33  
15 1     1   373 use Rapi::Blog::Scaffold::ViewWrapper;
  1         4  
  1         36  
16              
17 1     1   423 use Plack::App::File;
  1         9718  
  1         28  
18 1     1   369 use Plack::Builder;
  1         3301  
  1         89  
19 1     1   383 use Plack::Middleware::ConditionalGET;
  1         480  
  1         40  
20              
21             require Path::Class;
22 1     1   6 use YAML::XS 0.64 'LoadFile';
  1         23  
  1         1170  
23              
24              
25             sub factory {
26 0     0 0   my ($self, $new) = @_;
27            
28             # passthrough is its already one of us:
29 0 0 0       return $new if (ref($new) && ref($new) eq __PACKAGE__);
30            
31 0           __PACKAGE__->new( dir => $new )
32             }
33              
34              
35             has 'uuid', is => 'ro', init_arg => undef,
36             default => sub { join('-','scfld',String::Random->new->randregex('[a-z0-9A-Z]{20}')) };
37              
38             has 'dir',
39             is => 'ro',
40             required => 1,
41             isa => InstanceOf['Path::Class::Dir'],
42             coerce => sub { Path::Class::dir($_[0]) };
43              
44              
45             has 'config',
46             is => 'ro',
47             isa => InstanceOf['Rapi::Blog::Scaffold::Config'],
48             default => sub {{}},
49             coerce => sub { blessed $_[0] ? $_[0] : Rapi::Blog::Scaffold::Config->new($_[0]) };
50              
51             # The Scaffold needs to be able to check if a given Post exists in the database
52             #has 'Post_exists_fn', is => 'ro', required => 1, isa => CodeRef;
53              
54              
55 0     0 0   sub static_paths { (shift)->config->static_paths }
56 0     0 0   sub private_paths { (shift)->config->private_paths }
57 0     0 0   sub default_ext { (shift)->config->default_ext }
58 0     0 0   sub view_wrappers { (shift)->config->view_wrappers }
59 0     0 0   sub internal_post_path { (shift)->config->internal_post_path }
60              
61             # This is a unique, private path which is automatically generated that allows this
62             # scaffold to own a path which it can use fetch a post, and be sure another scaffold
63             # wont claim the path
64             has 'unique_int_post_path', is => 'ro', init_arg => undef, lazy => 1, default => sub {
65             my $self = shift;
66             join('','_',$self->uuid,'/private/post/')
67             };
68              
69 0     0 0   sub not_found_template { (shift)->config->not_found }
70              
71              
72              
73             has 'ViewWrappers', is => 'ro', init_arg => undef, lazy => 1, default => sub {
74             my $self = shift;
75             return [ map {
76             Rapi::Blog::Scaffold::ViewWrapper->new(
77             Scaffold => $self, %$_
78             )
79             } @{$self->config->view_wrappers} ]
80             }, isa => ArrayRef[InstanceOf['Rapi::Blog::Scaffold::ViewWrapper']];
81              
82              
83              
84              
85             sub BUILD {
86 0     0 0   my $self = shift;
87 0           $self->_load_yaml_config;
88             }
89              
90              
91             sub _load_yaml_config {
92 0     0     my $self = shift;
93            
94 0           my $yaml_file = $self->dir->file('scaffold.yml');
95 0 0         $self->config->_load_from_yaml($yaml_file) if (-f $yaml_file);
96             }
97              
98              
99             sub resolve_ViewWrapper {
100 0     0 0   my $self = shift;
101 0 0         my $path = shift or return undef;
102            
103 0           my $subpath;
104 0     0     my $VW = List::Util::first { $subpath = $_->resolve_subpath($path) } @{ $self->ViewWrappers };
  0            
  0            
105 0 0         return undef unless $VW;
106            
107 0 0         wantarray ? ($VW, $subpath) : $VW
108             }
109              
110              
111              
112              
113             sub owns_path {
114 0     0 0   my ($self, $path) = @_;
115 0 0         $self->owns_path_as($path) ? 1 : 0
116             }
117              
118             sub _resolve_path_to_post {
119 0     0     my ($self, $path) = @_;
120            
121 0           my ($pfx,$name) = split($self->unique_int_post_path,$path,2);
122 0 0 0       ($name && $pfx eq '') ? $name : undef
123             }
124              
125              
126              
127             has '_static_path_regexp', is => 'ro', lazy => 1, default => sub {
128             my $self = shift;
129             return $self->_compile_path_list_regex(@{$self->static_paths});
130             };
131              
132             has '_private_path_regexp', is => 'ro', lazy => 1, default => sub {
133             my $self = shift;
134             return $self->_compile_path_list_regex(@{$self->private_paths});
135             };
136              
137             sub _compile_path_list_regex {
138 0     0     my ($self, @paths) = @_;
139 0 0         return undef unless (scalar(@paths) > 0);
140            
141 0           my @list = ();
142 0           for my $path (@paths) {
143 0 0         next if ($path eq ''); # empty string match nothing
144 0 0 0       push @list, '^.*$' and next if($path eq '/') ; # special handling for '/' -- match everything
145              
146 0           $path =~ s/^\///; # strip and ignore leading /
147 0 0         if ($path =~ /\/$/) {
148             # ends in slash, matches begining of the path
149 0           push @list, join('','^',$path);
150             }
151             else {
152             # does not end in slash, match as if it did AND the whole path
153 0           push @list, join('','^',$path,'/');
154 0           push @list, join('','^',$path,'$');
155             }
156             }
157            
158 0 0         return undef unless (scalar(@list) > 0);
159            
160 0           my $reStr = join('','(',join('|', @list ),')');
161            
162 0           return qr/$reStr/
163             }
164              
165              
166             has 'static_path_app', is => 'ro', lazy => 1, default => sub {
167             my $self = shift;
168             my $app = builder {
169             enable "ConditionalGET";
170             Plack::App::File->new(root => $self->dir)->to_app;
171             };
172            
173             sub {
174             my $env = shift;
175             my $res = $app->($env);
176             # limit caching to 10 minutes now that we return 304s
177             push @{$res->[1]}, 'Cache-Control', 'public, max-age=600';
178            
179             $res
180             }
181             };
182              
183              
184              
185             sub _is_static_path {
186 0     0     my ($self, $template) = @_;
187 0           my $Regexp = $self->_static_path_regexp;
188 0 0         $Regexp ? $template =~ $Regexp : 0
189             }
190              
191             sub _is_private_path {
192 0     0     my ($self, $template) = @_;
193 0           my $Regexp = $self->_private_path_regexp;
194 0 0         $Regexp ? $template =~ $Regexp : 0
195             }
196              
197              
198             sub resolve_path {
199 0     0 0   my $self = shift;
200 0 0         my $path = shift or return undef;
201            
202 0           my $File = $self->resolve_file($path);
203            
204             # If not found, try once more by appending the default file extenson:
205 0 0 0       $File = $self->resolve_file(join('.',$path,$self->default_ext)) if (!$File && $self->default_ext);
206            
207 0           $File
208             }
209              
210              
211             sub resolve_file {
212 0     0 0   my $self = shift;
213 0 0         my $path = shift or return undef;
214            
215 0           my $File = $self->dir->file($path);
216 0 0         -f $File ? $File : undef
217             }
218              
219              
220             sub resolve_static_file {
221 0     0 0   my ($self, $path) = @_;
222 0 0 0       $path && $self->_is_static_path($path) or return undef;
223 0           $self->resolve_file($path)
224             }
225              
226              
227             1;