1 package SL::Controller::Base;
 
   5 use parent qw(Rose::Object);
 
   9 use List::Util qw(first);
 
  10 use SL::Request qw(flatten);
 
  11 use SL::MoreCommon qw(uri_encode);
 
  14 use Rose::Object::MakeMethods::Generic
 
  16   scalar                  => [ qw(action_name) ],
 
  17   'scalar --get_set_init' => [ qw(js) ],
 
  21 # public/helper functions
 
  27   return $_[0] if (scalar(@_) == 1) && !ref($_[0]);
 
  29   my %params      = ref($_[0]) eq 'HASH' ? %{ $_[0] } : @_;
 
  30   my $controller  = delete($params{controller}) || $self->controller_name;
 
  31   my $action      = $params{action}             || 'dispatch';
 
  34   if ($controller =~ m/\.pl$/) {
 
  35     # Old-style controller
 
  36     $script = $controller;
 
  38     $params{action} = "${controller}/${action}";
 
  39     $script         = "controller.pl";
 
  42   my $query       = join '&', map { uri_encode($_->[0]) . '=' . uri_encode($_->[1]) } @{ flatten(\%params) };
 
  44   return "${script}?${query}";
 
  49   my $url  = $self->url_for(@_);
 
  51   if ($self->delay_flash_on_redirect) {
 
  52     require SL::Helper::Flash;
 
  53     SL::Helper::Flash::delay_flash();
 
  56   return $self->render(SL::ClientJS->new->redirect_to($self->url_for(@_))) if $::request->is_ajax;
 
  58   print $::request->{cgi}->redirect($url);
 
  64   my ($options, %locals) = (@_ && ref($_[0])) ? @_ : ({ }, @_);
 
  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';
 
  69   # Set defaults for all available options.
 
  77   $options->{$_} //= $defaults{$_} for keys %defaults;
 
  78   $options->{type} = lc $options->{type};
 
  80   # Check supplied options for validity.
 
  81   foreach (keys %{ $options }) {
 
  82     croak "Unsupported option: $_" unless $defaults{$_};
 
  85   # Only certain types are supported.
 
  86   croak "Unsupported type: " . $options->{type} unless $options->{type} =~ m/^(?:html|js|json|text)$/;
 
  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)$/);
 
  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;
 
  98     # Layout only makes sense if we're outputting HTML.
 
  99     $options->{layout} = 0 if $options->{type} ne 'html';
 
 102   # Let the presenter do the rest of the work.
 
 105     local $::form->{title} = $locals{title} if $locals{title};
 
 106     $output = $self->presenter->render(
 
 108       { type => $options->{type}, process => $options->{process} },
 
 114   if ($options->{header}) {
 
 115     # Output the HTTP response and the layout in case of HTML output.
 
 117     if ($options->{layout}) {
 
 118       $::form->{title} = $locals{title} if $locals{title};
 
 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';
 
 131       print $::form->create_http_response(content_type => $content_type,
 
 136   # Print the output if wanted.
 
 137   print $output if $options->{output};
 
 143   my ($self, $file_name_or_content, %params) = @_;
 
 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;
 
 151     $size = length $$file_name_or_content;
 
 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;
 
 158   print $::form->create_http_response(content_type        => $content_type,
 
 159                                       content_disposition => 'attachment; filename="' . $attachment_name . '"',
 
 160                                       content_length      => $size);
 
 162   if (!ref $file_name_or_content) {
 
 163     $::locale->with_raw_io(\*STDOUT, sub { print while <$file> });
 
 165     unlink $file_name_or_content if $params{unlink};
 
 167     $::locale->with_raw_io(\*STDOUT, sub { print $$file_name_or_content });
 
 174   return SL::Presenter->get;
 
 177 sub controller_name {
 
 178   my $class = ref($_[0]) || $_[0];
 
 179   $class    =~ s/^SL::Controller:://;
 
 184   SL::ClientJS->new(controller => $_[0])
 
 188 # Before/after run hooks
 
 192   _add_hook('before', @_);
 
 196   _add_hook('after', @_);
 
 202   my ($when, $class, $sub, %params) = @_;
 
 204   foreach my $key (qw(only except)) {
 
 205     $params{$key} = { map { ( $_ => 1 ) } @{ $params{$key} } } if $params{$key};
 
 208   my $idx = "${when}/${class}";
 
 209   $hooks{$idx} ||= [ ];
 
 210   push @{ $hooks{$idx} }, { %params, code => $sub };
 
 214   my ($self, $when, $action) = @_;
 
 216   my $idx = "${when}/" . ref($self);
 
 218   foreach my $hook (@{ $hooks{$idx} || [] }) {
 
 219     next if ($hook->{only  } && !$hook->{only  }->{$action})
 
 220          || ($hook->{except} &&  $hook->{except}->{$action});
 
 222     if (ref($hook->{code}) eq 'CODE') {
 
 223       $hook->{code}->($self, $action);
 
 225       my $sub = $hook->{code};
 
 226       $self->$sub($action);
 
 232 #  behaviour. override these
 
 235 sub delay_flash_on_redirect {
 
 240   # Ignore the 'action' parameter.
 
 244 sub keep_auth_vars_in_form {
 
 249 # private functions -- for use in Base only
 
 255   my $sub    = "action_${action}";
 
 257   return $self->_dispatch(@_) if $action eq 'dispatch';
 
 259   $::form->error("Invalid action '${action}' for controller " . ref($self)) if !$self->can($sub);
 
 261   $self->action_name($action);
 
 262   $self->_run_hooks('before', $action);
 
 264   $self->_run_hooks('after', $action);
 
 271   my @actions = map { s/^action_//; $_ } grep { m/^action_/ } keys %{ ref($self) . "::" };
 
 272   my $action  = first { $::form->{"action_${_}"} } @actions;
 
 273   my $sub     = "action_${action}";
 
 275   if ($self->can($sub)) {
 
 276     $self->action_name($action);
 
 277     $self->_run_hooks('before', $action);
 
 279     $self->_run_hooks('after', $action);
 
 281     $::form->error($::locale->text('Oops. No valid action found to dispatch. Please report this case to the kivitendo team.'));
 
 291 SL::Controller::Base - base class for all action controllers
 
 297 This is a base class for all action controllers. Action controllers
 
 298 provide subs that are callable by special URLs.
 
 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.
 
 304 This base class is derived from L<Rose::Object>.
 
 308 The URLs have the following properties:
 
 314 The script part of the URL must be C<controller.pl>.
 
 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>.
 
 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.
 
 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.
 
 340 =head2 INDIRECT DISPATCHING
 
 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>.
 
 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.
 
 353 Usage from a template usually looks like this:
 
 355   <form method="POST" action="controller.pl">
 
 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">
 
 362 The dispatching is handled by the function L</_dispatch>.
 
 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.
 
 370 Hooks are run in the order they're added.
 
 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>
 
 376 The return value of the hooks is discarded.
 
 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
 
 384   __PACKAGE__->run_before('things_to_do_before_edit_and_save', only => [ 'edit', 'save' ]);
 
 388 =head2 PUBLIC HELPER FUNCTIONS
 
 390 These functions are supposed to be called by sub-classed controllers.
 
 394 =item C<render $template, [ $options, ] %locals>
 
 396 Renders the template C<$template>. Provides other variables than
 
 397 C<Form::parse_html_template> does.
 
 399 C<$options>, if present, must be a hash reference. All remaining
 
 400 parameters are slurped into C<%locals>.
 
 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>.
 
 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.
 
 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.
 
 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.
 
 419 Other reference types, unknown options and unknown arguments to the
 
 420 C<type> option cause the function to L<croak>.
 
 422 The following options are available (defaults: C<type> = 'html',
 
 423 C<process> = 1, C<output> = 1, C<header> = 1, C<layout> = 1):
 
 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
 
 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.
 
 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.
 
 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.
 
 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.
 
 463 The template itself has access to several variables. These are listed
 
 464 in the documentation to L<SL::Presenter/render>.
 
 466 The function will always return the output.
 
 468 Example: Render a HTML template with a certain title and a few locals
 
 470   $self->render('todo/list',
 
 471                 title      => 'List TODO items',
 
 472                 TODO_ITEMS => SL::DB::Manager::Todo->get_all_sorted);
 
 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>.
 
 477   my $content = $self->render(\'[% USE JavaScript %][% JavaScript.replace_with("#someid", "js/something") %]',
 
 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:
 
 484   $self->render('todo/single_item', { type => 'js' },
 
 485                 item => $employee->most_important_todo_item);
 
 487 =item C<send_file $file_name_or_content, [%params]>
 
 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.
 
 495 C<%params> can include the following:
 
 499 =item * C<type> -- the file's content type; defaults to
 
 500 'application/octet_stream'
 
 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
 
 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)
 
 511 =item C<url_for $url>
 
 513 =item C<url_for $params>
 
 515 =item C<url_for %params>
 
 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
 
 521 Otherwise the parameters are given either as a single hash ref
 
 522 parameter or as a normal hash.
 
 524 The controller to call is given by C<$params{controller}>. It defaults
 
 525 to the current controller as returned by
 
 528 The action to call is given by C<$params{action}>. It defaults to
 
 531 All other key/value pairs in C<%params> are appended as GET parameters
 
 534 Usage from a template might look like this:
 
 536   <a href="[% SELF.url_for(controller => 'Message', action => 'new', recipient_id => 42) %]">create new message</a>
 
 538 =item C<redirect_to %url_params>
 
 540 Redirects the browser to a new URL. The URL is generated by calling
 
 541 L</url_for> with C<%url_params>.
 
 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.
 
 550 =item C<run_before $sub, %params>
 
 552 =item C<run_after $sub, %params>
 
 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>.
 
 559 C<%params> can contain two possible values that restrict the code to
 
 560 be run only for certain actions:
 
 564 =item C<< only => \@list >>
 
 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
 
 570 =item C<< except => \@list >>
 
 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>).
 
 578 If neither restriction is used then the code will be run for any
 
 581 The hook's return values are discarded.
 
 583 =item C<delay_flash_on_redirect>
 
 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.
 
 589 =item C<get_auth_level $action>
 
 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
 
 598 =item C<keep_auth_vars_in_form %params>
 
 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.
 
 605 C<$params{action}> contains the action name that the request will be
 
 608 =item C<controller_name>
 
 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.
 
 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.
 
 622 Returns the global presenter object by calling
 
 623 L<SL::Presenter/get>.
 
 627 Returns an L<SL::ClientJS> instance for this controller.
 
 631 =head2 PRIVATE FUNCTIONS
 
 633 These functions are supposed to be used from this base class only.
 
 639 Implements the method lookup for indirect dispatching mentioned in the
 
 640 section L</INDIRECT DISPATCHING>.
 
 642 =item C<_run_action $action>
 
 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
 
 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.
 
 657 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>