Pod Fixes.
[kivitendo-erp.git] / SL / Controller / Base.pm
1 package SL::Controller::Base;
2
3 use strict;
4
5 use parent qw(Rose::Object);
6
7 use Carp;
8 use List::Util qw(first);
9
10 #
11 # public/helper functions
12 #
13
14 sub url_for {
15   my $self = shift;
16
17   return $_[0] if (scalar(@_) == 1) && !ref($_[0]);
18
19   my %params      = ref($_[0]) eq 'HASH' ? %{ $_[0] } : @_;
20   my $controller  = delete($params{controller}) || $self->_controller_name;
21   my $action      = delete($params{action})     || 'dispatch';
22   $params{action} = "${controller}/${action}";
23   my $query       = join('&', map { $::form->escape($_) . '=' . $::form->escape($params{$_}) } keys %params);
24
25   return "controller.pl?${query}";
26 }
27
28 sub redirect_to {
29   my $self = shift;
30   my $url  = $self->url_for(@_);
31
32   print $::cgi->redirect($url);
33 }
34
35 sub render {
36   my $self               = shift;
37   my $template           = shift;
38   my ($options, %locals) = (@_ && ref($_[0])) ? @_ : ({ }, @_);
39
40   $options->{type}       = lc($options->{type} || 'html');
41   $options->{no_layout}  = 1 if $options->{type} eq 'js';
42
43   my $source;
44   if ($options->{inline}) {
45     $source = \$template;
46
47   } else {
48     $source = "templates/webpages/${template}." . $options->{type};
49     croak "Template file ${source} not found" unless -f $source;
50   }
51
52   if (!$options->{partial} && !$options->{inline} && !$::form->{header}) {
53     if ($options->{no_layout}) {
54       $::form->{header} = 1;
55       my $content_type  = $options->{type} eq 'js' ? 'text/javascript' : 'text/html';
56
57       print $::form->create_http_response(content_type => $content_type,
58                                           charset      => $::dbcharset || Common::DEFAULT_CHARSET());
59
60     } else {
61       $::form->{title} = $locals{title} if $locals{title};
62       $::form->header;
63     }
64   }
65
66   my %params = ( %locals,
67                  AUTH     => $::auth,
68                  FORM     => $::form,
69                  LOCALE   => $::locale,
70                  LXCONFIG => { dbcharset              => $::dbcharset,
71                                webdav                 => $::webdav,
72                                lizenzen               => $::lizenzen,
73                                latex_templates        => $::latex,
74                                opendocument_templates => $::opendocument_templates,
75                                vertreter              => $::vertreter,
76                                show_best_before       => $::show_best_before,
77                              },
78                  LXDEBUG  => $::lxdebug,
79                  MYCONFIG => \%::myconfig,
80                  SELF     => $self,
81                );
82
83   my $output;
84   my $parser = $self->_template_obj;
85   $parser->process($source, \%params, \$output) || croak $parser->error;
86
87   print $output unless $options->{inline} || $options->{no_output};
88
89   return $output;
90 }
91
92 #
93 # Before/after run hooks
94 #
95
96 sub run_before {
97   _add_hook('before', @_);
98 }
99
100 sub run_after {
101   _add_hook('after', @_);
102 }
103
104 my %hooks;
105
106 sub _add_hook {
107   my ($when, $class, $sub, %params) = @_;
108
109   foreach my $key (qw(only except)) {
110     $params{$key} = { map { ( $_ => 1 ) } @{ $params{$key} } } if $params{$key};
111   }
112
113   my $idx = "${when}/${class}";
114   $hooks{$idx} ||= [ ];
115   push @{ $hooks{$idx} }, { %params, code => $sub };
116 }
117
118 sub _run_hooks {
119   my ($self, $when, $action) = @_;
120
121   my $idx = "${when}/" . ref($self);
122
123   foreach my $hook (@{ $hooks{$idx} || [] }) {
124     next if ($hook->{only  } && !$hook->{only  }->{$action})
125          || ($hook->{except} &&  $hook->{except}->{$action});
126
127     if (ref($hook->{code}) eq 'CODE') {
128       $hook->{code}->($self);
129     } else {
130       my $sub = $hook->{code};
131       $self->$sub;
132     }
133   }
134 }
135
136 #
137 # private functions -- for use in Base only
138 #
139
140 sub _run_action {
141   my $self   = shift;
142   my $action = shift;
143   my $sub    = "action_${action}";
144
145   return $self->_dispatch(@_) if $action eq 'dispatch';
146
147   $::form->error("Invalid action '${action}' for controller " . ref($self)) if !$self->can($sub);
148
149   $self->_run_hooks('before', $action);
150   $self->$sub(@_);
151   $self->_run_hooks('after', $action);
152 }
153
154 sub _controller_name {
155   return (split(/::/, ref($_[0])))[-1];
156 }
157
158 sub _dispatch {
159   my $self    = shift;
160
161   no strict 'refs';
162   my @actions = map { s/^action_//; $_ } grep { m/^action_/ } keys %{ ref($self) . "::" };
163   my $action  = first { $::form->{"action_${_}"} } @actions;
164   my $sub     = "action_${action}";
165
166   $self->_run_hooks('before', $action);
167   $self->$sub(@_);
168   $self->_run_hooks('after', $action);
169 }
170
171 sub _template_obj {
172   my ($self) = @_;
173
174   $self->{__basepriv_template_obj} ||=
175     Template->new({ INTERPOLATE  => 0,
176                     EVAL_PERL    => 0,
177                     ABSOLUTE     => 1,
178                     CACHE_SIZE   => 0,
179                     PLUGIN_BASE  => 'SL::Template::Plugin',
180                     INCLUDE_PATH => '.:templates/webpages',
181                     COMPILE_EXT  => '.tcc',
182                     COMPILE_DIR  => $::userspath . '/templates-cache',
183                   }) || croak;
184
185   return $self->{__basepriv_template_obj};
186 }
187
188 1;
189
190 __END__
191
192 =head1 NAME
193
194 SL::Controller::Base - base class for all action controllers
195
196 =head1 SYNOPSIS
197
198 =head2 OVERVIEW
199
200 This is a base class for all action controllers. Action controllers
201 provide subs that are callable by special URLs.
202
203 For each request made to the web server an instance of the controller
204 will be created. After the request has been served that instance will
205 handed over to garbage collection.
206
207 This base class is derived from L<Rose::Object>.
208
209 =head2 CONVENTIONS
210
211 The URLs have the following properties:
212
213 =over 2
214
215 =item *
216
217 The script part of the URL must be C<controller.pl>.
218
219 =item *
220
221 There must be a GET or POST parameter named C<action> containing the
222 name of the controller and the sub to call separated by C</>,
223 e.g. C<Message/list>.
224
225 =item *
226
227 The controller name is the package's name without the
228 C<SL::Controller::> prefix. At the moment only packages in the
229 C<SL::Controller> namespace are valid; sub-namespaces are not
230 allowed. The package name must start with an upper-case letter.
231
232 =item *
233
234 The sub part of the C<action> parameter is the name of the sub to
235 call. However, the sub's name is automatically prefixed with
236 C<action_>. Therefore for the example C<Message/list> the sub
237 C<SL::DB::Message::action_list> would be called. This in turn means
238 that subs whose name does not start with C<action_> cannot be invoked
239 directly via the URL.
240
241 =back
242
243 =head2 INDIRECT DISPATCHING
244
245 In the case that there are several submit buttons on a page it is
246 often impractical to have a single C<action> parameter match up
247 properly. For such a case a special dispatcher method is available. In
248 that case the C<action> parameter of the URL must be
249 C<Controller/dispatch>.
250
251 The C<SL::Controller::Base::_dispatch> method will iterate over all
252 subs in the controller package whose names start with C<action_>. The
253 first one for which there's a GET or POST parameter with the same name
254 and that's trueish is called.
255
256 Usage from a template usually looks like this:
257
258   <form method="POST" action="controller.pl">
259     ...
260     <input type="hidden" name="action" value="Message/dispatch">
261     <input type="submit" name="action_mark_as_read" value="Mark messages as read">
262     <input type="submit" name="action_delete" value="Delete messages">
263   </form>
264
265 The dispatching is handled by the function L</_dispatch>.
266
267 =head2 HOOKS
268
269 Hooks are functions that are called before or after the controller's
270 action is called. The controller package defines the hooks, and those
271 hooks themselves are run as instance methods.
272
273 Hooks are run in the order they're added.
274
275 The return value of the hooks is discarded.
276
277 Hooks can be defined to run for all actions, for only specific actions
278 or for all actions except a list of actions. Each entry is the action
279 name, not the sub's name. Therefore in order to run a hook before one
280 of the subs C<action_edit> or C<action_save> is called the following
281 code can be used:
282
283   __PACKAGE__->run_before('things_to_do_before_edit_and_save', only => [ 'edit', 'save' ]);
284
285 =head1 FUNCTIONS
286
287 =head2 PUBLIC HELPER FUNCTIONS
288
289 These functions are supposed to be called by sub-classed controllers.
290
291 =over 4
292
293 =item C<render $template, [ $options, ] %locals>
294
295 Renders the template C<$template>. Provides other variables than
296 C<Form::parse_html_template> does.
297
298 C<$options>, if present, must be a hash reference. All remaining
299 parameters are slurped into C<%locals>.
300
301 What is rendered and how C<$template> is interpreted is determined by
302 the options I<type>, I<inline>, I<partial> and I<no_layout>.
303
304 If C<< $options->{inline} >> is trueish then C<$template> is a string
305 containing the template code to interprete. Additionally the output
306 will not be sent to the browser. Instead it is only returned to the
307 caller.
308
309 If C<< $options->{inline} >> is falsish then C<$template> is
310 interpreted as the name of a template file. It is prefixed with
311 "templates/webpages/" and postfixed with a file extension based on
312 C<< $options->{type} >>. C<< $options->{type} >> can be either C<html>
313 or C<js> and defaults to C<html>. An exception will be thrown if that
314 file does not exist.
315
316 If C<< $options->{partial} >> or C<< $options->{inline} >> is trueish
317 then neither the HTTP response header nor the standard HTML header is
318 generated.
319
320 Otherwise at least the HTTP response header will be generated based on
321 the template type (C<< $options->{type} >>).
322
323 If the template type is C<html> then the standard HTML header will be
324 output via C<< $::form->header >> with C<< $::form->{title} >> set to
325 C<$locals{title}> (the latter only if C<$locals{title}> is
326 trueish). Setting C<< $options->{no_layout} >> to trueish will prevent
327 this.
328
329 The template itself has access to the following variables:
330
331 =over 2
332
333 =item * C<AUTH> -- C<$::auth>
334
335 =item * C<FORM> -- C<$::form>
336
337 =item * C<LOCALE> -- C<$::locale>
338
339 =item * C<LXCONFIG> -- all parameters from C<config/lx-erp.conf> with
340 the same name they appear in the file (e.g. C<dbcharset>, C<webdav>
341 etc)
342
343 =item * C<LXDEBUG> -- C<$::lxdebug>
344
345 =item * C<MYCONFIG> -- C<%::myconfig>
346
347 =item * C<SELF> -- the controller instance
348
349 =item * All items from C<%locals>
350
351 =back
352
353 Unless C<< $options->{inline} >> is trueish the function will send the
354 output to the browser.
355
356 The function will always return the output.
357
358 Example: Render a HTML template with a certain title and a few locals
359
360   $self->render('todo/list',
361                 title      => 'List TODO items',
362                 TODO_ITEMS => SL::DB::Manager::Todo->get_all_sorted);
363
364 Example: Render a string and return its content for further processing
365 by the calling function. No header is generated due to C<inline>.
366
367   my $content = $self->render('[% USE JavaScript %][% JavaScript.replace_with("#someid", "js/something") %]',
368                               { type => 'js', inline => 1 });
369
370 Example: Render a JavaScript template and send it to the
371 browser. Typical use for actions called via AJAX:
372
373   $self->render('todo/single_item', { type => 'js' },
374                 item => $employee->most_important_todo_item);
375
376 =item C<url_for $url>
377
378 =item C<url_for $params>
379
380 =item C<url_for %params>
381
382 Creates an URL for the given parameters suitable for calling an action
383 controller. If there's only one scalar parameter then it is returned
384 verbatim.
385
386 Otherwise the parameters are given either as a single hash ref
387 parameter or as a normal hash.
388
389 The controller to call is given by C<$params{controller}>. It defaults
390 to the current controller as returned by
391 L</_controller_name>.
392
393 The action to call is given by C<$params{action}>. It defaults to
394 C<dispatch>.
395
396 All other key/value pairs in C<%params> are appended as GET parameters
397 to the URL.
398
399 Usage from a template might look like this:
400
401   <a href="[% SELF.url_for(controller => 'Message', action => 'new', recipient_id => 42) %]">create new message</a>
402
403 =item C<redirect_to %url_params>
404
405 Redirects the browser to a new URL by outputting a HTTP redirect
406 header. The URL is generated by calling L</url_for> with
407 C<%url_params>.
408
409 =item C<run_before $sub, %params>
410
411 =item C<run_after $sub, %params>
412
413 Adds a hook to run before or after certain actions are run for the
414 current package. The code to run is C<$sub> which is either the name
415 of an instance method or a code reference. If it's the latter then the
416 first parameter will be C<$self>.
417
418 C<%params> can contain two possible values that restrict the code to
419 be run only for certain actions:
420
421 =over 2
422
423 =item C<< only => \@list >>
424
425 Only run the code for actions given in C<@list>. The entries are the
426 action names, not the names of the sub (so it's C<list> instead of
427 C<action_list>).
428
429 =item C<< except => \@list >>
430
431 Run the code for all actions but for those given in C<@list>. The
432 entries are the action names, not the names of the sub (so it's
433 C<list> instead of C<action_list>).
434
435 =back
436
437 If neither restriction is used then the code will be run for any
438 action.
439
440 The hook's return values are discarded.
441
442 =back
443
444 =head2 PRIVATE FUNCTIONS
445
446 These functions are supposed to be used from this base class only.
447
448 =over 4
449
450 =item C<_controller_name>
451
452 Returns the name of the curernt controller package without the
453 C<SL::Controller::> prefix.
454
455 =item C<_dispatch>
456
457 Implements the method lookup for indirect dispatching mentioned in the
458 section L</INDIRECT DISPATCHING>.
459
460 =item C<_run_action $action>
461
462 Executes a sub based on the value of C<$action>. C<$action> is the sub
463 name part of the C<action> GET or POST parameter as described in
464 L</CONVENTIONS>.
465
466 If C<$action> equals C<dispatch> then the sub L</_dispatch> in this
467 base class is called for L</INDIRECT DISPATCHING>. Otherwise
468 C<$action> is prefixed with C<action_>, and that sub is called on the
469 current controller instance.
470
471 =back
472
473 =head1 AUTHOR
474
475 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
476
477 =cut