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