-
Notifications
You must be signed in to change notification settings - Fork 3
/
Controller.pm
290 lines (207 loc) · 7.47 KB
/
Controller.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
package Squatting::Controller;
use strict;
no strict 'refs';
#use warnings;
#no warnings 'redefine';
# constructor
sub new {
bless { name => $_[1], urls => $_[2], @_[3..$#_] } => $_[0];
}
# (shallow) copy constructor
sub clone {
bless { %{$_[0]}, @_[1..$#_] } => ref($_[0]);
}
# name - name of controller
# urls - arrayref of URL patterns that this controller responds to
# cr - Continuity::Request object
# env - incoming request headers and misc info like %ENV in the CGI days
# input - incoming CGI variables
# cookies - incoming *AND* outgoing cookies
# state - your session data
# v - outgoing vars
# status - outgoing HTTP Response status
# headers - outgoing HTTP headers
# view - name of default view
# log - logging object
# app - name of our app
for my $m (qw/name urls cr env input cookies state v status headers log view app/) {
*{$m} = sub : lvalue { $_[0]->{$m} }
}
# HTTP methods
for my $m (qw/get post head put delete options trace connect/) {
*{$m} = sub { $_[0]->{$m}->(@_) }
}
# For (sufficient) compatibility w/ the ubiquitous API that CGI.pm introduced
sub param {
my ($self, $k, @v) = @_;
if (defined $k) {
if (@v) {
$self->input->{$k} = ((@v > 1) ? \@v : $v[0]);
} else {
$self->input->{$k};
}
} else {
keys %{$self->input};
}
}
# $content = $self->render($template, $view)
sub render {
my ($self, $template, $vn) = @_;
my $view;
$vn ||= $self->view;
my $app = $self->app;
if (defined($vn)) {
$view = ${$app."::Views::V"}{$vn}; # hash
} else { # vs
$view = ${$app."::Views::V"}[0]; # array -- Perl provides a lot of 'namespaces' so why not use them?
}
$view->headers = $self->headers;
$view->$template($self->v);
}
# $self->redirect($url, $status_code)
sub redirect {
my ($self, $l, $s) = @_;
$self->headers->{Location} = $l || '/';
$self->status = $s || 302;
}
# default 404 controller
my $not_found = sub { $_[0]->status = 404; $_[0]->env->{REQUEST_PATH}." not found." };
our $r404 = Squatting::Controller->new(
R404 => [],
get => $not_found,
post => $not_found,
app => 'Squatting'
);
1;
=head1 NAME
Squatting::Controller - default controller class for Squatting
=head1 SYNOPSIS
package App::Controllers;
use Squatting ':controllers';
our @C = (
C(
Thread => [ '/forum/(\d+)/thread/(\d+)-(\w+)' ],
get => sub {
my ($self, $forum_id, $thread_id, $slug) = @_;
#
# get thread from database...
#
$self->render('thread');
},
post => sub {
my ($self, $forum_id, $thread_id, $slug) = @_;
#
# add post to thread
#
$self->redirect(R('Thread', $forum_id, $thread_id, $slug));
}
)
);
=head1 DESCRIPTION
Squatting::Controller is the default controller class for Squatting
applications. Its job is to take HTTP requests and construct an appropriate
response by setting up output headers and returning content.
=head1 API
=head2 Object Construction
=head3 Squatting::Controller->new($name => \@urls, %methods)
The constructor takes a name, an arrayref or URL patterns, and a hash of
method definitions. There is a helper function called C() that makes this
slightly less verbose.
=head3 $self->clone([ %opts ])
This will create a shallow copy of the controller. You may optionally pass in
a hash of options that will be merged into the new clone.
=head2 HTTP Request Handlers
=head3 $self->get(@args)
=head3 $self->post(@args)
=head3 $self->put(@args)
=head3 $self->delete(@args)
=head3 $self->head(@args)
=head3 $self->options(@args)
=head3 $self->trace(@args)
=head3 $self->connect(@args)
These methods are called when their respective HTTP requests are sent to the
controller. @args is the list of regex captures from the URL pattern in
$self->urls that matched $self->env->{REQUEST_PATH}.
=head2 Attribute Accessors
The following methods are lvalue subroutines that contain information
relevant to the current controller and current request/response cycle.
=head3 $self->name
This returns the name of the controller.
=head3 $self->urls
This returns the arrayref of URL patterns that the controller responds to.
=head3 $self->cr
This returns the L<Continuity::Request> object for the current session.
=head3 $self->env
This returns a hashref populated with a CGI-like environment. This is where
you'll find the incoming HTTP headers.
=head3 $self->input
This returns a hashref containing the incoming CGI parameters.
B<Example>: Interpreting the query ?x=5&y=true&z=2&z=1&z=3 .
$self->input->{x} is 5
$self->input->{y} is "true"
$self->input->{z} is [2, 1, 3]
=head3 @keys = $self->param
=head3 $value = $self->param($key)
=head3 $self->param($key, $value)
This is an accessor for C<$self-E<gt>input> that provides an API that's a
subset of the L<CGI> module's C<param()> function. It exists, because there
are many perl modules that can make use of an object that follows this API. It
is not complete, but it should be good enough for L<WWW::Facebook::API::Canvas>
and many other modules.
=head3 $self->cookies
This returns a hashref that holds both the incoming and outgoing cookies.
Incoming cookies are just simple scalar values, whereas outgoing cookies are
hashrefs that can be passed to L<CGI::Cookie> to construct a cookie string.
B<Example>: Setting a cookie named 'foo'
$self->cookies->{foo} = { -Value => 'bar', -Expires => '+1d' };
B<Example>: Getting the value of a cookie named 'baz'
my $baz = $self->cookies->{baz};
=head3 $self->state
If you've setup sessions, this method will return the current session
data as a hashref.
=head3 $self->v
This returns a hashref that represents the outgoing variables for this
request. This hashref will be passed to a view's templates when render()
is called.
=head3 $self->status
This returns an integer representing the outgoing HTTP status code.
See L<HTTP::Status> for more details.
$self->status = 404; # Resource Not Found
=head3 $self->headers
This returns a hashref representing the outgoing HTTP headers.
B<Example>: Setting the outgoing Content-Type to text/plain
$self->headers->{'Content-Type'} = 'text/plain';
=head3 $self->log
This returns a logging object if one has been set up for your app. If it
exists, you should be able to call methods like C<debug()>, C<info()>,
C<warn()>, C<error()>, and C<fatal()> against it, and the output of this would
typically end up in an error log.
=head3 $self->view
This returns the name of the default view for the current request. If
it's undefined, the first view in @App::Views::V will be considered the
default.
=head3 $self->app
This returns the name of the app that this controller belongs to.
=head2 Output
=head3 $self->render($template, [ $view ])
This method will return a string generated by the specified template and view.
If a view is not specified, the first view object in @App::Views::V will be
used.
=head3 $self->redirect($path, [ $status ])
This method is a shortcut for setting $self->status to 302 and
$self->headers->{Location} to the specified URL. You may optionally pass in a
different status code as the second parameter.
=head1 SEE ALSO
L<Squatting>,
L<Squatting::View>
=cut
# Local Variables: ***
# mode: cperl ***
# indent-tabs-mode: nil ***
# cperl-close-paren-offset: -2 ***
# cperl-continued-statement-offset: 2 ***
# cperl-indent-level: 2 ***
# cperl-indent-parens-as-block: t ***
# cperl-tab-always-indent: nil ***
# End: ***
# vim:tabstop=8 softtabstop=2 shiftwidth=2 shiftround expandtab