SL::Presenter -- die neue Präsentationsschicht
[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 IO::File;
9 use List::Util qw(first);
10 use SL::Request qw(flatten);
11 use SL::MoreCommon qw(uri_encode);
12 use SL::Presenter;
13
14 use Rose::Object::MakeMethods::Generic
15 (
16   scalar => [ qw(action_name) ],
17 );
18
19 #
20 # public/helper functions
21 #
22
23 sub url_for {
24   my $self = shift;
25
26   return $_[0] if (scalar(@_) == 1) && !ref($_[0]);
27
28   my %params      = ref($_[0]) eq 'HASH' ? %{ $_[0] } : @_;
29   my $controller  = delete($params{controller}) || $self->controller_name;
30   my $action      = $params{action}             || 'dispatch';
31
32   my $script;
33   if ($controller =~ m/\.pl$/) {
34     # Old-style controller
35     $script = $controller;
36   } else {
37     $params{action} = "${controller}/${action}";
38     $script         = "controller.pl";
39   }
40
41   my $query       = join '&', map { uri_encode($_->[0]) . '=' . uri_encode($_->[1]) } @{ flatten(\%params) };
42
43   return "${script}?${query}";
44 }
45
46 sub redirect_to {
47   my $self = shift;
48   my $url  = $self->url_for(@_);
49
50   if ($self->delay_flash_on_redirect) {
51     require SL::Helper::Flash;
52     SL::Helper::Flash::delay_flash();
53   }
54
55   print $::request->{cgi}->redirect($url);
56 }
57
58 sub render {
59   my $self               = shift;
60   my $template           = shift;
61   my ($options, %locals) = (@_ && ref($_[0])) ? @_ : ({ }, @_);
62
63   $options->{type}       = lc($options->{type} || 'html');
64   $options->{no_layout}  = 1 if $options->{type} eq 'js';
65
66   if (!$options->{partial} && !$options->{inline} && !$::form->{header}) {
67     if ($options->{no_layout}) {
68       $::form->{header} = 1;
69       my $content_type  = $options->{type} eq 'js' ? 'text/javascript' : 'text/html';
70
71       print $::form->create_http_response(content_type => $content_type,
72                                           charset      => $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET());
73
74     } else {
75       $::form->{title} = $locals{title} if $locals{title};
76       $::form->header(no_menu => $options->{no_menu});
77     }
78   }
79
80   my $output;
81   if ($options->{raw}) {
82     $output = $$template;
83   } else {
84     $output = $self->presenter->render(
85       $template, $options,
86       %locals,
87       SELF => $self,
88     );
89   }
90
91   print $output unless $options->{inline} || $options->{no_output};
92
93   return $output;
94 }
95
96 sub send_file {
97   my ($self, $file_name, %params) = @_;
98
99   my $file            = IO::File->new($file_name, 'r') || croak("Cannot open file '${file_name}'");
100   my $content_type    =  $params{type} || 'application/octet_stream';
101   my $attachment_name =  $params{name} || $file_name;
102   $attachment_name    =~ s:.*//::g;
103
104   print $::form->create_http_response(content_type        => $content_type,
105                                       content_disposition => 'attachment; filename="' . $attachment_name . '"',
106                                       content_length      => -s $file);
107
108   $::locale->with_raw_io(\*STDOUT, sub { print while <$file> });
109   $file->close;
110 }
111
112 sub presenter {
113   return SL::Presenter->get;
114 }
115
116 sub controller_name {
117   my $class = ref($_[0]) || $_[0];
118   $class    =~ s/^SL::Controller:://;
119   return $class;
120 }
121
122 #
123 # Before/after run hooks
124 #
125
126 sub run_before {
127   _add_hook('before', @_);
128 }
129
130 sub run_after {
131   _add_hook('after', @_);
132 }
133
134 my %hooks;
135
136 sub _add_hook {
137   my ($when, $class, $sub, %params) = @_;
138
139   foreach my $key (qw(only except)) {
140     $params{$key} = { map { ( $_ => 1 ) } @{ $params{$key} } } if $params{$key};
141   }
142
143   my $idx = "${when}/${class}";
144   $hooks{$idx} ||= [ ];
145   push @{ $hooks{$idx} }, { %params, code => $sub };
146 }
147
148 sub _run_hooks {
149   my ($self, $when, $action) = @_;
150
151   my $idx = "${when}/" . ref($self);
152
153   foreach my $hook (@{ $hooks{$idx} || [] }) {
154     next if ($hook->{only  } && !$hook->{only  }->{$action})
155          || ($hook->{except} &&  $hook->{except}->{$action});
156
157     if (ref($hook->{code}) eq 'CODE') {
158       $hook->{code}->($self, $action);
159     } else {
160       my $sub = $hook->{code};
161       $self->$sub($action);
162     }
163   }
164 }
165
166 #
167 #  behaviour. override these
168 #
169
170 sub delay_flash_on_redirect {
171   0;
172 }
173
174 sub get_auth_level {
175   # Ignore the 'action' parameter.
176   return 'user';
177 }
178
179 sub keep_auth_vars_in_form {
180   return 0;
181 }
182
183 #
184 # private functions -- for use in Base only
185 #
186
187 sub _run_action {
188   my $self   = shift;
189   my $action = shift;
190   my $sub    = "action_${action}";
191
192   return $self->_dispatch(@_) if $action eq 'dispatch';
193
194   $::form->error("Invalid action '${action}' for controller " . ref($self)) if !$self->can($sub);
195
196   $self->action_name($action);
197   $self->_run_hooks('before', $action);
198   $self->$sub(@_);
199   $self->_run_hooks('after', $action);
200 }
201
202 sub _dispatch {
203   my $self    = shift;
204
205   no strict 'refs';
206   my @actions = map { s/^action_//; $_ } grep { m/^action_/ } keys %{ ref($self) . "::" };
207   my $action  = first { $::form->{"action_${_}"} } @actions;
208   my $sub     = "action_${action}";
209
210   if ($self->can($sub)) {
211     $self->action_name($action);
212     $self->_run_hooks('before', $action);
213     $self->$sub(@_);
214     $self->_run_hooks('after', $action);
215   } else {
216     $::form->error($::locale->text('Oops. No valid action found to dispatch. Please report this case to the kivitendo team.'));
217   }
218 }
219
220 1;
221
222 __END__
223
224 =head1 NAME
225
226 SL::Controller::Base - base class for all action controllers
227
228 =head1 SYNOPSIS
229
230 =head2 OVERVIEW
231
232 This is a base class for all action controllers. Action controllers
233 provide subs that are callable by special URLs.
234
235 For each request made to the web server an instance of the controller
236 will be created. After the request has been served that instance will
237 handed over to garbage collection.
238
239 This base class is derived from L<Rose::Object>.
240
241 =head2 CONVENTIONS
242
243 The URLs have the following properties:
244
245 =over 2
246
247 =item *
248
249 The script part of the URL must be C<controller.pl>.
250
251 =item *
252
253 There must be a GET or POST parameter named C<action> containing the
254 name of the controller and the sub to call separated by C</>,
255 e.g. C<Message/list>.
256
257 =item *
258
259 The controller name is the package's name without the
260 C<SL::Controller::> prefix. At the moment only packages in the
261 C<SL::Controller> namespace are valid; sub-namespaces are not
262 allowed. The package name must start with an upper-case letter.
263
264 =item *
265
266 The sub part of the C<action> parameter is the name of the sub to
267 call. However, the sub's name is automatically prefixed with
268 C<action_>. Therefore for the example C<Message/list> the sub
269 C<SL::DB::Message::action_list> would be called. This in turn means
270 that subs whose name does not start with C<action_> cannot be invoked
271 directly via the URL.
272
273 =back
274
275 =head2 INDIRECT DISPATCHING
276
277 In the case that there are several submit buttons on a page it is
278 often impractical to have a single C<action> parameter match up
279 properly. For such a case a special dispatcher method is available. In
280 that case the C<action> parameter of the URL must be
281 C<Controller/dispatch>.
282
283 The C<SL::Controller::Base::_dispatch> method will iterate over all
284 subs in the controller package whose names start with C<action_>. The
285 first one for which there's a GET or POST parameter with the same name
286 and that's trueish is called.
287
288 Usage from a template usually looks like this:
289
290   <form method="POST" action="controller.pl">
291     ...
292     <input type="hidden" name="action" value="Message/dispatch">
293     <input type="submit" name="action_mark_as_read" value="Mark messages as read">
294     <input type="submit" name="action_delete" value="Delete messages">
295   </form>
296
297 The dispatching is handled by the function L</_dispatch>.
298
299 =head2 HOOKS
300
301 Hooks are functions that are called before or after the controller's
302 action is called. The controller package defines the hooks, and those
303 hooks themselves are run as instance methods.
304
305 Hooks are run in the order they're added.
306
307 The hooks receive a single parameter: the name of the action that is
308 about to be called (for C<before> hooks) / was called (for C<after>
309 hooks).
310
311 The return value of the hooks is discarded.
312
313 Hooks can be defined to run for all actions, for only specific actions
314 or for all actions except a list of actions. Each entry is the action
315 name, not the sub's name. Therefore in order to run a hook before one
316 of the subs C<action_edit> or C<action_save> is called the following
317 code can be used:
318
319   __PACKAGE__->run_before('things_to_do_before_edit_and_save', only => [ 'edit', 'save' ]);
320
321 =head1 FUNCTIONS
322
323 =head2 PUBLIC HELPER FUNCTIONS
324
325 These functions are supposed to be called by sub-classed controllers.
326
327 =over 4
328
329 =item C<render $template, [ $options, ] %locals>
330
331 Renders the template C<$template>. Provides other variables than
332 C<Form::parse_html_template> does.
333
334 C<$options>, if present, must be a hash reference. All remaining
335 parameters are slurped into C<%locals>.
336
337 What is rendered and how C<$template> is interpreted is determined by
338 the options I<type>, I<inline>, I<partial> and I<no_layout>. The
339 actual rendering is handled by L<SL::Presenter/render>.
340
341 If C<< $options->{inline} >> is trueish then C<$template> is a string
342 containing the template code to interprete. Additionally the output
343 will not be sent to the browser. Instead it is only returned to the
344 caller.
345
346 If C<< $options->{raw} >> is trueish, the function will treat the
347 input as already parsed, and will not filter the input through
348 Template. This also means that L<SL::Presenter/render> is not
349 called either. Unlike C<inline>, the input is taken as a reference.
350
351 If C<< $options->{inline} >> is falsish then C<$template> is
352 interpreted as the name of a template file. It is prefixed with
353 "templates/webpages/" and postfixed with a file extension based on
354 C<< $options->{type} >>. C<< $options->{type} >> can be either C<html>
355 or C<js> and defaults to C<html>. An exception will be thrown if that
356 file does not exist.
357
358 If C<< $options->{partial} >> or C<< $options->{inline} >> is trueish
359 then neither the HTTP response header nor the standard HTML header is
360 generated.
361
362 Otherwise at least the HTTP response header will be generated based on
363 the template type (C<< $options->{type} >>).
364
365 If the template type is C<html> then the standard HTML header will be
366 output via C<< $::form->header >> with C<< $::form->{title} >> set to
367 C<$locals{title}> (the latter only if C<$locals{title}> is
368 trueish). Setting C<< $options->{no_layout} >> to trueish will prevent
369 this.
370
371 The template itself has access to several variables. These are listed
372 in the documentation to L<SL::Presenter/render>.
373
374 Unless C<< $options->{inline} >> is trueish the function will send the
375 output to the browser.
376
377 The function will always return the output.
378
379 Example: Render a HTML template with a certain title and a few locals
380
381   $self->render('todo/list',
382                 title      => 'List TODO items',
383                 TODO_ITEMS => SL::DB::Manager::Todo->get_all_sorted);
384
385 Example: Render a string and return its content for further processing
386 by the calling function. No header is generated due to C<inline>.
387
388   my $content = $self->render('[% USE JavaScript %][% JavaScript.replace_with("#someid", "js/something") %]',
389                               { type => 'js', inline => 1 });
390
391 Example: Render a JavaScript template and send it to the
392 browser. Typical use for actions called via AJAX:
393
394   $self->render('todo/single_item', { type => 'js' },
395                 item => $employee->most_important_todo_item);
396
397 =item C<send_file $file_name, [%params]>
398
399 Sends the file C<$file_name> to the browser including appropriate HTTP
400 headers for a download. C<%params> can include the following:
401
402 =over 2
403
404 =item * C<type> -- the file's content type; defaults to
405 'application/octet_stream'
406
407 =item * C<name> -- the name presented to the browser; defaults to
408 C<$file_name>
409
410 =back
411
412 =item C<url_for $url>
413
414 =item C<url_for $params>
415
416 =item C<url_for %params>
417
418 Creates an URL for the given parameters suitable for calling an action
419 controller. If there's only one scalar parameter then it is returned
420 verbatim.
421
422 Otherwise the parameters are given either as a single hash ref
423 parameter or as a normal hash.
424
425 The controller to call is given by C<$params{controller}>. It defaults
426 to the current controller as returned by
427 L</controller_name>.
428
429 The action to call is given by C<$params{action}>. It defaults to
430 C<dispatch>.
431
432 All other key/value pairs in C<%params> are appended as GET parameters
433 to the URL.
434
435 Usage from a template might look like this:
436
437   <a href="[% SELF.url_for(controller => 'Message', action => 'new', recipient_id => 42) %]">create new message</a>
438
439 =item C<redirect_to %url_params>
440
441 Redirects the browser to a new URL by outputting a HTTP redirect
442 header. The URL is generated by calling L</url_for> with
443 C<%url_params>.
444
445 =item C<run_before $sub, %params>
446
447 =item C<run_after $sub, %params>
448
449 Adds a hook to run before or after certain actions are run for the
450 current package. The code to run is C<$sub> which is either the name
451 of an instance method or a code reference. If it's the latter then the
452 first parameter will be C<$self>.
453
454 C<%params> can contain two possible values that restrict the code to
455 be run only for certain actions:
456
457 =over 2
458
459 =item C<< only => \@list >>
460
461 Only run the code for actions given in C<@list>. The entries are the
462 action names, not the names of the sub (so it's C<list> instead of
463 C<action_list>).
464
465 =item C<< except => \@list >>
466
467 Run the code for all actions but for those given in C<@list>. The
468 entries are the action names, not the names of the sub (so it's
469 C<list> instead of C<action_list>).
470
471 =back
472
473 If neither restriction is used then the code will be run for any
474 action.
475
476 The hook's return values are discarded.
477
478 =item C<delay_flash_on_redirect>
479
480 May be overridden by a controller. If this method returns true, redirect_to
481 will delay all flash messages for the current request. Defaults to false for
482 compatibility reasons.
483
484 =item C<get_auth_level $action>
485
486 May be overridden by a controller. Determines what kind of
487 authentication is required for a particular action. Must return either
488 C<admin> (which means that authentication as an admin is required),
489 C<user> (authentication as a normal user suffices) with a possible
490 future value C<none> (which would require no authentication but is not
491 yet implemented).
492
493 =item C<keep_auth_vars_in_form>
494
495 May be overridden by a controller. If falsish (the default) all form
496 variables whose name starts with C<{AUTH}> are removed before the
497 request is routed. Only controllers that handle login requests
498 themselves should return trueish for this function.
499
500 =item C<controller_name>
501
502 Returns the name of the curernt controller package without the
503 C<SL::Controller::> prefix. This method can be called both as a class
504 method and an instance method.
505
506 =item C<action_name>
507
508 Returns the name of the currently executing action. If the dispatcher
509 mechanism was used then this is not C<dispatch> but the actual method
510 name the dispatching resolved to.
511
512 =item C<presenter>
513
514 Returns the global presenter object by calling
515 L<SL::Presenter/get>.
516
517 =back
518
519 =head2 PRIVATE FUNCTIONS
520
521 These functions are supposed to be used from this base class only.
522
523 =over 4
524
525 =item C<_dispatch>
526
527 Implements the method lookup for indirect dispatching mentioned in the
528 section L</INDIRECT DISPATCHING>.
529
530 =item C<_run_action $action>
531
532 Executes a sub based on the value of C<$action>. C<$action> is the sub
533 name part of the C<action> GET or POST parameter as described in
534 L</CONVENTIONS>.
535
536 If C<$action> equals C<dispatch> then the sub L</_dispatch> in this
537 base class is called for L</INDIRECT DISPATCHING>. Otherwise
538 C<$action> is prefixed with C<action_>, and that sub is called on the
539 current controller instance.
540
541 =back
542
543 =head1 AUTHOR
544
545 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
546
547 =cut