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