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