Merge branch 'master' of github.com:kivitendo/kivitendo-erp
[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   return $self->render(SL::ClientJS->new->redirect_to($self->url_for(@_))) if $::request->is_ajax;
56
57   print $::request->{cgi}->redirect($url);
58 }
59
60 sub render {
61   my $self               = shift;
62   my $template           = shift;
63   my ($options, %locals) = (@_ && ref($_[0])) ? @_ : ({ }, @_);
64
65   # Special handling/shortcut for an instance of SL::ClientJS:
66   return $self->render(\$template->to_json, { type => 'json' }) if ref($template) eq 'SL::ClientJS';
67
68   # Set defaults for all available options.
69   my %defaults = (
70     type       => 'html',
71     output     => 1,
72     header     => 1,
73     layout     => 1,
74     process    => 1,
75   );
76   $options->{$_} //= $defaults{$_} for keys %defaults;
77   $options->{type} = lc $options->{type};
78
79   # Check supplied options for validity.
80   foreach (keys %{ $options }) {
81     croak "Unsupported option: $_" unless $defaults{$_};
82   }
83
84   # Only certain types are supported.
85   croak "Unsupported type: " . $options->{type} unless $options->{type} =~ m/^(?:html|js|json|text)$/;
86
87   # The "template" argument must be a string or a reference to one.
88   $template = ${ $template }                                       if ((ref($template) || '') eq 'REF') && (ref(${ $template }) eq 'SL::Presenter::EscapedText');
89   croak "Unsupported 'template' reference type: " . ref($template) if ref($template) && (ref($template) !~ m/^(?:SCALAR|SL::Presenter::EscapedText)$/);
90
91   # If all output is turned off then don't output the header either.
92   if (!$options->{output}) {
93     $options->{header} = 0;
94     $options->{layout} = 0;
95
96   } else {
97     # Layout only makes sense if we're outputting HTML.
98     $options->{layout} = 0 if $options->{type} ne 'html';
99   }
100
101   # Let the presenter do the rest of the work.
102   my $output;
103   {
104     local $::form->{title} = $locals{title} if $locals{title};
105     $output = $self->presenter->render(
106       $template,
107       { type => $options->{type}, process => $options->{process} },
108       %locals,
109       SELF => $self,
110     );
111   }
112
113   if ($options->{header}) {
114     # Output the HTTP response and the layout in case of HTML output.
115
116     if ($options->{layout}) {
117       $::form->{title} = $locals{title} if $locals{title};
118       $::form->header;
119
120     } else {
121       # No layout: just the standard HTTP response. Also notify
122       # $::form that the header has already been output so that
123       # $::form->header() won't output it again.
124       $::form->{header} = 1;
125       my $content_type  = $options->{type} eq 'html' ? 'text/html'
126                         : $options->{type} eq 'js'   ? 'text/javascript'
127                         : $options->{type} eq 'text' ? 'text/plain'
128                         :                              'application/json';
129
130       print $::form->create_http_response(content_type => $content_type,
131                                           charset      => 'UTF-8');
132     }
133   }
134
135   # Print the output if wanted.
136   print $output if $options->{output};
137
138   return $output;
139 }
140
141 sub send_file {
142   my ($self, $file_name_or_content, %params) = @_;
143
144   my ($file, $size);
145
146   if (!ref $file_name_or_content) {
147     $file = IO::File->new($file_name_or_content, 'r') || croak("Cannot open file '${file_name_or_content}'");
148     $size = -s $file_name_or_content;
149   } else {
150     $size = length $$file_name_or_content;
151   }
152
153   my $content_type    =  $params{type} || 'application/octet_stream';
154   my $attachment_name =  $params{name} || (!ref($file_name_or_content) ? $file_name_or_content : '');
155   $attachment_name    =~ s:.*//::g;
156
157   print $::form->create_http_response(content_type        => $content_type,
158                                       content_disposition => 'attachment; filename="' . $attachment_name . '"',
159                                       content_length      => $size);
160
161   if (!ref $file_name_or_content) {
162     $::locale->with_raw_io(\*STDOUT, sub { print while <$file> });
163     $file->close;
164     unlink $file_name_or_content if $params{unlink};
165   } else {
166     $::locale->with_raw_io(\*STDOUT, sub { print $$file_name_or_content });
167   }
168 }
169
170 sub presenter {
171   return SL::Presenter->get;
172 }
173
174 sub controller_name {
175   my $class = ref($_[0]) || $_[0];
176   $class    =~ s/^SL::Controller:://;
177   return $class;
178 }
179
180 #
181 # Before/after run hooks
182 #
183
184 sub run_before {
185   _add_hook('before', @_);
186 }
187
188 sub run_after {
189   _add_hook('after', @_);
190 }
191
192 my %hooks;
193
194 sub _add_hook {
195   my ($when, $class, $sub, %params) = @_;
196
197   foreach my $key (qw(only except)) {
198     $params{$key} = { map { ( $_ => 1 ) } @{ $params{$key} } } if $params{$key};
199   }
200
201   my $idx = "${when}/${class}";
202   $hooks{$idx} ||= [ ];
203   push @{ $hooks{$idx} }, { %params, code => $sub };
204 }
205
206 sub _run_hooks {
207   my ($self, $when, $action) = @_;
208
209   my $idx = "${when}/" . ref($self);
210
211   foreach my $hook (@{ $hooks{$idx} || [] }) {
212     next if ($hook->{only  } && !$hook->{only  }->{$action})
213          || ($hook->{except} &&  $hook->{except}->{$action});
214
215     if (ref($hook->{code}) eq 'CODE') {
216       $hook->{code}->($self, $action);
217     } else {
218       my $sub = $hook->{code};
219       $self->$sub($action);
220     }
221   }
222 }
223
224 #
225 #  behaviour. override these
226 #
227
228 sub delay_flash_on_redirect {
229   0;
230 }
231
232 sub get_auth_level {
233   # Ignore the 'action' parameter.
234   return 'user';
235 }
236
237 sub keep_auth_vars_in_form {
238   return 0;
239 }
240
241 #
242 # private functions -- for use in Base only
243 #
244
245 sub _run_action {
246   my $self   = shift;
247   my $action = shift;
248   my $sub    = "action_${action}";
249
250   return $self->_dispatch(@_) if $action eq 'dispatch';
251
252   $::form->error("Invalid action '${action}' for controller " . ref($self)) if !$self->can($sub);
253
254   $self->action_name($action);
255   $self->_run_hooks('before', $action);
256   $self->$sub(@_);
257   $self->_run_hooks('after', $action);
258 }
259
260 sub _dispatch {
261   my $self    = shift;
262
263   no strict 'refs';
264   my @actions = map { s/^action_//; $_ } grep { m/^action_/ } keys %{ ref($self) . "::" };
265   my $action  = first { $::form->{"action_${_}"} } @actions;
266   my $sub     = "action_${action}";
267
268   if ($self->can($sub)) {
269     $self->action_name($action);
270     $self->_run_hooks('before', $action);
271     $self->$sub(@_);
272     $self->_run_hooks('after', $action);
273   } else {
274     $::form->error($::locale->text('Oops. No valid action found to dispatch. Please report this case to the kivitendo team.'));
275   }
276 }
277
278 1;
279
280 __END__
281
282 =head1 NAME
283
284 SL::Controller::Base - base class for all action controllers
285
286 =head1 SYNOPSIS
287
288 =head2 OVERVIEW
289
290 This is a base class for all action controllers. Action controllers
291 provide subs that are callable by special URLs.
292
293 For each request made to the web server an instance of the controller
294 will be created. After the request has been served that instance will
295 handed over to garbage collection.
296
297 This base class is derived from L<Rose::Object>.
298
299 =head2 CONVENTIONS
300
301 The URLs have the following properties:
302
303 =over 2
304
305 =item *
306
307 The script part of the URL must be C<controller.pl>.
308
309 =item *
310
311 There must be a GET or POST parameter named C<action> containing the
312 name of the controller and the sub to call separated by C</>,
313 e.g. C<Message/list>.
314
315 =item *
316
317 The controller name is the package's name without the
318 C<SL::Controller::> prefix. At the moment only packages in the
319 C<SL::Controller> namespace are valid; sub-namespaces are not
320 allowed. The package name must start with an upper-case letter.
321
322 =item *
323
324 The sub part of the C<action> parameter is the name of the sub to
325 call. However, the sub's name is automatically prefixed with
326 C<action_>. Therefore for the example C<Message/list> the sub
327 C<SL::DB::Message::action_list> would be called. This in turn means
328 that subs whose name does not start with C<action_> cannot be invoked
329 directly via the URL.
330
331 =back
332
333 =head2 INDIRECT DISPATCHING
334
335 In the case that there are several submit buttons on a page it is
336 often impractical to have a single C<action> parameter match up
337 properly. For such a case a special dispatcher method is available. In
338 that case the C<action> parameter of the URL must be
339 C<Controller/dispatch>.
340
341 The C<SL::Controller::Base::_dispatch> method will iterate over all
342 subs in the controller package whose names start with C<action_>. The
343 first one for which there's a GET or POST parameter with the same name
344 and that's trueish is called.
345
346 Usage from a template usually looks like this:
347
348   <form method="POST" action="controller.pl">
349     ...
350     <input type="hidden" name="action" value="Message/dispatch">
351     <input type="submit" name="action_mark_as_read" value="Mark messages as read">
352     <input type="submit" name="action_delete" value="Delete messages">
353   </form>
354
355 The dispatching is handled by the function L</_dispatch>.
356
357 =head2 HOOKS
358
359 Hooks are functions that are called before or after the controller's
360 action is called. The controller package defines the hooks, and those
361 hooks themselves are run as instance methods.
362
363 Hooks are run in the order they're added.
364
365 The hooks receive a single parameter: the name of the action that is
366 about to be called (for C<before> hooks) / was called (for C<after>
367 hooks).
368
369 The return value of the hooks is discarded.
370
371 Hooks can be defined to run for all actions, for only specific actions
372 or for all actions except a list of actions. Each entry is the action
373 name, not the sub's name. Therefore in order to run a hook before one
374 of the subs C<action_edit> or C<action_save> is called the following
375 code can be used:
376
377   __PACKAGE__->run_before('things_to_do_before_edit_and_save', only => [ 'edit', 'save' ]);
378
379 =head1 FUNCTIONS
380
381 =head2 PUBLIC HELPER FUNCTIONS
382
383 These functions are supposed to be called by sub-classed controllers.
384
385 =over 4
386
387 =item C<render $template, [ $options, ] %locals>
388
389 Renders the template C<$template>. Provides other variables than
390 C<Form::parse_html_template> does.
391
392 C<$options>, if present, must be a hash reference. All remaining
393 parameters are slurped into C<%locals>.
394
395 What is rendered and how C<$template> is interpreted is determined
396 both by C<$template>'s reference type and by the supplied options. The
397 actual rendering is handled by L<SL::Presenter/render>.
398
399 If C<$template> is a normal scalar (not a reference) then it is meant
400 to be a template file name relative to the C<templates/webpages>
401 directory. The file name to use is determined by the C<type> option.
402
403 If C<$template> is a reference to a scalar then the referenced
404 scalar's content is used as the content to process. The C<type> option
405 is not considered in this case.
406
407 C<$template> can also be an instance of L<SL::Presenter::EscapedText>
408 or a reference to such an instance. Both of these cases are handled
409 the same way as if C<$template> were a reference to a scalar: its
410 content is processed, and C<type> is not considered.
411
412 Other reference types, unknown options and unknown arguments to the
413 C<type> option cause the function to L<croak>.
414
415 The following options are available (defaults: C<type> = 'html',
416 C<process> = 1, C<output> = 1, C<header> = 1, C<layout> = 1):
417
418 =over 2
419
420 =item C<type>
421
422 The template type. Can be C<html> (the default), C<js> for JavaScript,
423 C<json> for JSON and C<text> for plain text content. Affects the
424 extension that's added to the file name given with a non-reference
425 C<$template> argument, the content type HTTP header that is output and
426 whether or not the layout will be output as well (see description of
427 C<layout> below).
428
429 =item C<process>
430
431 If trueish (which is also the default) it causes the template/content
432 to be processed by the Template toolkit. Otherwise the
433 template/content is output as-is.
434
435 =item C<output>
436
437 If trueish (the default) then the generated output will be sent to the
438 browser in addition to being returned. If falsish then the options
439 C<header> and C<layout> are set to 0 as well.
440
441 =item C<header>
442
443 Determines whether or not to output the HTTP response
444 headers. Defaults to the same value that C<output> is set to. If set
445 to falsish then the layout is not output either.
446
447 =item C<layout>
448
449 Determines whether or not the basic HTML layout structure should be
450 output (HTML header, common JavaScript and stylesheet inclusions, menu
451 etc.). Defaults to 0 if C<type> is not C<html> and to the same value
452 C<header> is set to otherwise.
453
454 =back
455
456 The template itself has access to several variables. These are listed
457 in the documentation to L<SL::Presenter/render>.
458
459 The function will always return the output.
460
461 Example: Render a HTML template with a certain title and a few locals
462
463   $self->render('todo/list',
464                 title      => 'List TODO items',
465                 TODO_ITEMS => SL::DB::Manager::Todo->get_all_sorted);
466
467 Example: Render a string and return its content for further processing
468 by the calling function. No header is generated due to C<output>.
469
470   my $content = $self->render(\'[% USE JavaScript %][% JavaScript.replace_with("#someid", "js/something") %]',
471                               { output => 0 });
472
473 Example: Render a JavaScript template
474 "templates/webpages/todo/single_item.js" and send it to the
475 browser. Typical use for actions called via AJAX:
476
477   $self->render('todo/single_item', { type => 'js' },
478                 item => $employee->most_important_todo_item);
479
480 =item C<send_file $file_name_or_content, [%params]>
481
482 Sends the file C<$file_name_or_content> to the browser including
483 appropriate HTTP headers for a download. If C<$file_name_or_content>
484 is a scalar then it is interpreted as a file name which is opened and
485 whose content is sent. Otherwise (C<$file_name_or_content> being a
486 reference) the referenced scalar's data itself is sent.
487
488 C<%params> can include the following:
489
490 =over 2
491
492 =item * C<type> -- the file's content type; defaults to
493 'application/octet_stream'
494
495 =item * C<name> -- the name presented to the browser; defaults to
496 C<$file_name>; mandatory if C<$file_name_or_content> is a reference
497
498 =item * C<unlink> -- if trueish and C<$file_name_or_content> refers to
499 a file name then unlink the file after it has been sent to the browser
500 (e.g. for temporary files)
501
502 =back
503
504 =item C<url_for $url>
505
506 =item C<url_for $params>
507
508 =item C<url_for %params>
509
510 Creates an URL for the given parameters suitable for calling an action
511 controller. If there's only one scalar parameter then it is returned
512 verbatim.
513
514 Otherwise the parameters are given either as a single hash ref
515 parameter or as a normal hash.
516
517 The controller to call is given by C<$params{controller}>. It defaults
518 to the current controller as returned by
519 L</controller_name>.
520
521 The action to call is given by C<$params{action}>. It defaults to
522 C<dispatch>.
523
524 All other key/value pairs in C<%params> are appended as GET parameters
525 to the URL.
526
527 Usage from a template might look like this:
528
529   <a href="[% SELF.url_for(controller => 'Message', action => 'new', recipient_id => 42) %]">create new message</a>
530
531 =item C<redirect_to %url_params>
532
533 Redirects the browser to a new URL. The URL is generated by calling
534 L</url_for> with C<%url_params>.
535
536 This function implements the redirection depending on whether or not
537 the current request is an AJAX request as determined by
538 L<SL::Request/is_ajax>. If it is a normal request then it outputs a
539 standard HTTP redirect header (HTTP code 302). If it is an AJAX
540 request then it outputs an AJAX response suitable for the
541 C<kivi.eval_json_result> function from the L<SL::ClientJS> module.
542
543 =item C<run_before $sub, %params>
544
545 =item C<run_after $sub, %params>
546
547 Adds a hook to run before or after certain actions are run for the
548 current package. The code to run is C<$sub> which is either the name
549 of an instance method or a code reference. If it's the latter then the
550 first parameter will be C<$self>.
551
552 C<%params> can contain two possible values that restrict the code to
553 be run only for certain actions:
554
555 =over 2
556
557 =item C<< only => \@list >>
558
559 Only run the code for actions given in C<@list>. The entries are the
560 action names, not the names of the sub (so it's C<list> instead of
561 C<action_list>).
562
563 =item C<< except => \@list >>
564
565 Run the code for all actions but for those given in C<@list>. The
566 entries are the action names, not the names of the sub (so it's
567 C<list> instead of C<action_list>).
568
569 =back
570
571 If neither restriction is used then the code will be run for any
572 action.
573
574 The hook's return values are discarded.
575
576 =item C<delay_flash_on_redirect>
577
578 May be overridden by a controller. If this method returns true, redirect_to
579 will delay all flash messages for the current request. Defaults to false for
580 compatibility reasons.
581
582 =item C<get_auth_level $action>
583
584 May be overridden by a controller. Determines what kind of
585 authentication is required for a particular action. Must return either
586 C<admin> (which means that authentication as an admin is required),
587 C<user> (authentication as a normal user suffices) with a possible
588 future value C<none> (which would require no authentication but is not
589 yet implemented).
590
591 =item C<keep_auth_vars_in_form %params>
592
593 May be overridden by a controller. If falsish (the default) all form
594 variables whose name starts with C<{AUTH}> are removed before the
595 request is routed. Only controllers that handle login requests
596 themselves should return trueish for this function.
597
598 C<$params{action}> contains the action name that the request will be
599 dispatched to.
600
601 =item C<controller_name>
602
603 Returns the name of the curernt controller package without the
604 C<SL::Controller::> prefix. This method can be called both as a class
605 method and an instance method.
606
607 =item C<action_name>
608
609 Returns the name of the currently executing action. If the dispatcher
610 mechanism was used then this is not C<dispatch> but the actual method
611 name the dispatching resolved to.
612
613 =item C<presenter>
614
615 Returns the global presenter object by calling
616 L<SL::Presenter/get>.
617
618 =back
619
620 =head2 PRIVATE FUNCTIONS
621
622 These functions are supposed to be used from this base class only.
623
624 =over 4
625
626 =item C<_dispatch>
627
628 Implements the method lookup for indirect dispatching mentioned in the
629 section L</INDIRECT DISPATCHING>.
630
631 =item C<_run_action $action>
632
633 Executes a sub based on the value of C<$action>. C<$action> is the sub
634 name part of the C<action> GET or POST parameter as described in
635 L</CONVENTIONS>.
636
637 If C<$action> equals C<dispatch> then the sub L</_dispatch> in this
638 base class is called for L</INDIRECT DISPATCHING>. Otherwise
639 C<$action> is prefixed with C<action_>, and that sub is called on the
640 current controller instance.
641
642 =back
643
644 =head1 AUTHOR
645
646 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
647
648 =cut